Commit ebdb6914e765dc405387c052b953b54a09affe26

Thomas de Grivel 2024-09-11T00:51:42

fix && and ||

diff --git a/lib/kc3/0.1/httpd/route.kc3 b/lib/kc3/0.1/httpd/route.kc3
index a854375..1251e15 100644
--- a/lib/kc3/0.1/httpd/route.kc3
+++ b/lib/kc3/0.1/httpd/route.kc3
@@ -6,7 +6,10 @@ defmodule HTTPd.Route do
              controller: ?]
 
   def match = fn (route, request) {
-    if Str.starts_with?(request.url, route.path) do
+    if (route.path == "/" ||
+        (Str.ends_with?(route.path, "/") &&
+         request.url == Str.slice(route.path, 0, -2)) ||
+        Str.starts_with?(request.url, route.path)) do
       route.controller
     end
   }
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index 5cffdb2..1ca62cf 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -180,14 +180,14 @@ add {KC3, :operator, KC3.operator_and}
 replace {KC3.operator_and, :is_a, :operator}
 replace {KC3.operator_and, :sym, :&&}
 replace {KC3.operator_and, :arity, 2}
-replace {KC3.operator_and, :symbol_value, cfn Bool "tag_and" (Tag, Tag, Result)}
+replace {KC3.operator_and, :symbol_value, cfn_macro Bool "kc3_and" (Tag, Tag, Result)}
 replace {KC3.operator_and, :operator_precedence, 5}
 replace {KC3.operator_and, :operator_associativity, :left}
 add {KC3, :operator, KC3.operator_or}
 replace {KC3.operator_or, :is_a, :operator}
 replace {KC3.operator_or, :sym, :||}
 replace {KC3.operator_or, :arity, 2}
-replace {KC3.operator_or, :symbol_value, cfn Bool "tag_or" (Tag, Tag, Result)}
+replace {KC3.operator_or, :symbol_value, cfn_macro Bool "kc3_or" (Tag, Tag, Result)}
 replace {KC3.operator_or, :operator_precedence, 4}
 replace {KC3.operator_or, :operator_associativity, :left}
 add {KC3, :operator, KC3.operator_assign}
diff --git a/libkc3/buf_parse.c b/libkc3/buf_parse.c
index ee92ab4..ff39e96 100644
--- a/libkc3/buf_parse.c
+++ b/libkc3/buf_parse.c
@@ -1147,6 +1147,7 @@ sw buf_parse_cast (s_buf *buf, s_call *dest)
 sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
 {
   s_list *arg_types = NULL;
+  bool macro = false;
   s_str name_str;
   const s_sym *name_sym;
   sw r;
@@ -1160,6 +1161,12 @@ sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
   if ((r = buf_read_1(buf, "cfn")) <= 0)
     goto clean;
   result += r;
+  if ((r = buf_read_1(buf, "_macro")) < 0)
+    goto restore;
+  if (r) {
+    result += r;
+    macro = true;
+  }
   if ((r = buf_ignore_spaces(buf)) <= 0)
     goto restore;
   result += r;
@@ -1182,6 +1189,7 @@ sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
     goto restore;
   result += r;
   cfn_init(&tmp, name_sym, arg_types, result_type);
+  tmp.macro = macro;
   // FIXME: implement env_eval_cfn
   /*
   cfn_prep_cif(&tmp);
diff --git a/libkc3/env.c b/libkc3/env.c
index e720437..064be64 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -17,6 +17,7 @@
 #include "assert.h"
 #include "binding.h"
 #include "block.h"
+#include "bool.h"
 #include "buf.h"
 #include "buf_file.h"
 #include "buf_getc.h"
@@ -68,6 +69,36 @@ static s_env * env_init_args (s_env *env, int *argc, char ***argv);
 static s_env * env_init_globals (s_env *env);
 static s_env * env_init_toplevel (s_env *env);
 
+bool * env_and (s_env *env, const s_tag *a, const s_tag *b, bool *dest)
+{
+  s_tag eval;
+  bool tmp;
+  const s_sym *type;
+  assert(env);
+  assert(a);
+  assert(b);
+  assert(dest);
+  type = &g_sym_Bool;
+  if (! env_eval_tag(env, a, &eval))
+    return NULL;
+  if (! bool_init_cast(&tmp, &type, &eval)) {
+    tag_clean(&eval);
+    return NULL;
+  }
+  tag_clean(&eval);
+  if (tmp) {
+    if (! env_eval_tag(env, b, &eval))
+      return NULL;
+    if (! bool_init_cast(&tmp, &type, &eval)) {
+      tag_clean(&eval);
+      return NULL;
+    }
+    tag_clean(&eval);
+  }
+  *dest = tmp;
+  return dest;
+}
+
 bool env_call_get (s_env *env, s_call *call)
 {
   s_facts_cursor cursor;
@@ -3249,6 +3280,36 @@ const s_sym ** env_operator_symbol (s_env *env, const s_ident *op,
   return result;
 }
 
+bool * env_or (s_env *env, const s_tag *a, const s_tag *b, bool *dest)
+{
+  s_tag eval;
+  bool tmp;
+  const s_sym *type;
+  assert(env);
+  assert(a);
+  assert(b);
+  assert(dest);
+  type = &g_sym_Bool;
+  if (! env_eval_tag(env, a, &eval))
+    return NULL;
+  if (! bool_init_cast(&tmp, &type, &eval)) {
+    tag_clean(&eval);
+    return NULL;
+  }
+  tag_clean(&eval);
+  if (! tmp) {
+    if (! env_eval_tag(env, b, &eval))
+      return NULL;
+    if (! bool_init_cast(&tmp, &type, &eval)) {
+      tag_clean(&eval);
+      return NULL;
+    }
+    tag_clean(&eval);
+  }
+  *dest = tmp;
+  return dest;
+}
+
 void env_pop_error_handler (s_env *env)
 {
   if (env->error_handler)
diff --git a/libkc3/env.h b/libkc3/env.h
index 0915642..574b244 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -42,87 +42,95 @@ bool            env_sym_search_modules (s_env *env,
                                         const s_sym **dest);
 
 /* Operators. */
-bool          env_def (s_env *env, const s_ident *ident,
-                       const s_tag *value);
-const s_sym * env_def_clean (s_env *env, const s_sym *module,
-                             const s_tag *tag_clean);
-s_tag *       env_defmodule (s_env *env, const s_sym * const *name,
-                             const s_block *block, s_tag *dest);
-s_tag *       env_defoperator (s_env *env, const s_sym * const *name,
-                               const s_sym * const *sym,
-                               const s_tag *symbol_value,
-                               u8 op_precedence,
-                               const s_sym * const *op_assoc,
+bool *         env_and (s_env *env, const s_tag *a, const s_tag *b,
+                        bool *dest);
+bool           env_def (s_env *env, const s_ident *ident,
+                        const s_tag *value);
+const s_sym *  env_def_clean (s_env *env, const s_sym *module,
+                              const s_tag *tag_clean);
+s_tag *        env_defmodule (s_env *env, const s_sym * const *name,
+                              const s_block *block, s_tag *dest);
+s_tag *        env_defoperator (s_env *env, const s_sym * const *name,
+                                const s_sym * const *sym,
+                                const s_tag *symbol_value,
+                                u8 op_precedence,
+                                const s_sym * const *op_assoc,
+                                s_tag *dest);
+const s_sym *  env_defstruct (s_env *env, const s_list *spec);
+s_fact_w *     env_fact_w_eval (s_env *env, const s_fact_w *fact,
+	         	       s_fact_w *dest);
+s_tag *        env_facts_first_with_tags (s_env *env, s_facts *facts,
+                                          s_tag *subject,
+                                          s_tag *predicate,
+                                          s_tag *object,
+                                          s_fn *callback, s_tag *dest);
+s_tag *        env_facts_with (s_env *env, s_facts *facts,
+                               s_list **spec, s_fn *callback,
                                s_tag *dest);
-const s_sym * env_defstruct (s_env *env, const s_list *spec);
-s_fact_w *    env_fact_w_eval (s_env *env, const s_fact_w *fact,
-			       s_fact_w *dest);
-s_tag *       env_facts_first_with_tags (s_env *env, s_facts *facts,
-                                         s_tag *subject,
-                                         s_tag *predicate,
-                                         s_tag *object,
-                                         s_fn *callback, s_tag *dest);
-s_tag *       env_facts_with (s_env *env, s_facts *facts, s_list **spec,
-                              s_fn *callback, s_tag *dest);
 s_facts_with_cursor *
-              env_facts_with_list (s_env *env, s_facts *facts,
-                                   s_facts_with_cursor *cursor,
-                                   s_list *spec);
-s_tag *       env_facts_with_tags (s_env *env, s_facts *facts,
-                                   s_tag *subject, s_tag *predicate,
-                                   s_tag *object, s_fn *callback,
-                                   s_tag *dest);
-s_tag *       env_ident_get (s_env *env, const s_ident *ident,
-                             s_tag *dest);
-bool *        env_ident_is_special_operator (s_env *env,
-                                             const s_ident *ident,
-                                             bool *dest);
-s_tag *       env_kc3_def (s_env *env, const s_call *call, s_tag *dest);
-s_tag *       env_let (s_env *env, const s_tag *tag,
-                       const s_block *block, s_tag *dest);
-bool          env_load (s_env *env, const s_str *path);
-bool *        env_module_is_loading (s_env *env, const s_sym *module,
-                                     bool *dest);
-bool          env_module_is_loading_set (s_env *env,
-                                         const s_sym *module,
-                                         bool value);
-bool          env_module_load (s_env *env, const s_sym *module);
-bool          env_module_maybe_reload (s_env *env,
-                                       const s_sym *module);
-s8            env_operator_arity (s_env *env, const s_ident *op);
-bool *        env_operator_find (s_env *env, const s_ident *op,
-                                 bool *dest);
-s_tag *       env_operator_find_by_sym (s_env *env,
-                                        const s_sym *sym,
-                                        s_tag *dest);
-s_ident *     env_operator_ident (s_env *env, const s_ident *op,
-                                  s_ident *dest);
-bool *        env_operator_is_right_associative (s_env *env,
-                                                 const s_ident *op,
-                                                 bool *dest);
-sw *          env_operator_precedence (s_env *env, const s_ident *op,
-                                       sw *dest);
-s_ident *     env_operator_resolve (s_env *env, const s_ident *op,
-                                    u8 arity, s_ident *dest);
+               env_facts_with_list (s_env *env, s_facts *facts,
+                                    s_facts_with_cursor *cursor,
+                                    s_list *spec);
+s_tag *        env_facts_with_tags (s_env *env, s_facts *facts,
+                                    s_tag *subject, s_tag *predicate,
+                                    s_tag *object, s_fn *callback,
+                                    s_tag *dest);
+s_tag *        env_ident_get (s_env *env, const s_ident *ident,
+                              s_tag *dest);
+bool *         env_ident_is_special_operator (s_env *env,
+                                              const s_ident *ident,
+                                              bool *dest);
+s_tag *        env_kc3_def (s_env *env, const s_call *call,
+                            s_tag *dest);
+s_tag *        env_let (s_env *env, const s_tag *tag,
+                        const s_block *block, s_tag *dest);
+bool           env_load (s_env *env, const s_str *path);
+bool *         env_module_is_loading (s_env *env, const s_sym *module,
+                                      bool *dest);
+bool           env_module_is_loading_set (s_env *env,
+                                          const s_sym *module,
+                                          bool value);
+bool           env_module_load (s_env *env, const s_sym *module);
+bool           env_module_maybe_reload (s_env *env,
+                                        const s_sym *module);
+s8             env_operator_arity (s_env *env, const s_ident *op);
+bool *         env_operator_find (s_env *env, const s_ident *op,
+                                  bool *dest);
+s_tag *        env_operator_find_by_sym (s_env *env,
+                                         const s_sym *sym,
+                                         s_tag *dest);
+s_ident *      env_operator_ident (s_env *env, const s_ident *op,
+                                   s_ident *dest);
+bool *         env_operator_is_right_associative (s_env *env,
+                                                  const s_ident *op,
+                                                  bool *dest);
+sw *           env_operator_precedence (s_env *env, const s_ident *op,
+                                        sw *dest);
+s_ident *      env_operator_resolve (s_env *env, const s_ident *op,
+                                     u8 arity, s_ident *dest);
 const s_sym ** env_operator_symbol (s_env *env, const s_ident *op,
                                     const s_sym **dest);
-u8            env_special_operator_arity (s_env *env,
-                                          const s_ident *ident);
-bool *        env_struct_type_exists (s_env *env, const s_sym *module,
-                                      bool *dest);
+bool *         env_or (s_env *env, const s_tag *a, const s_tag *b,
+                       bool *dest);
+u8             env_special_operator_arity (s_env *env,
+                                           const s_ident *ident);
+bool *         env_struct_type_exists (s_env *env, const s_sym *module,
+                                       bool *dest);
 const s_struct_type **
-              env_struct_type_find (s_env *env, const s_sym *module,
-                                    const s_struct_type **dest);
-f_clean       env_struct_type_get_clean (s_env *env,
-                                         const s_sym *module);
-s_list **     env_struct_type_get_spec (s_env *env, const s_sym *module,
-                                        s_list **dest);
-bool *        env_struct_type_has_spec (s_env *env, const s_sym *module,
-                                        bool *dest);
-bool          env_tag_ident_is_bound (s_env *env,
-                                      const s_tag *tag);
-s_tag *       env_while (s_env *env, const s_tag *cond,
-                         const s_tag *body, s_tag *dest);
+               env_struct_type_find (s_env *env, const s_sym *module,
+                                     const s_struct_type **dest);
+f_clean        env_struct_type_get_clean (s_env *env,
+                                          const s_sym *module);
+s_list **      env_struct_type_get_spec (s_env *env,
+                                         const s_sym *module,
+                                         s_list **dest);
+bool *         env_struct_type_has_spec (s_env *env,
+                                         const s_sym *module,
+                                         bool *dest);
+bool           env_tag_ident_is_bound (s_env *env,
+                                       const s_tag *tag);
+s_tag *        env_while (s_env *env, const s_tag *cond,
+                          const s_tag *body, s_tag *dest);
 
 /* Evaluator. */
 bool env_eval_array (s_env *env, const s_array *array,
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index 996e0b8..a48743d 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -66,6 +66,11 @@ s_tag * kc3_access (const s_tag *tag, const s_list * const *key,
   return NULL;
 }
 
+bool * kc3_and (const s_tag *a, const s_tag *b, bool *dest)
+{
+  return env_and(&g_kc3_env, a, b, dest);
+}
+
 void kc3_break (void)
 {
   err_puts("break");
@@ -328,6 +333,11 @@ s_tag * kc3_operator_find_by_sym (const s_sym * const *sym, s_tag *dest)
   return env_operator_find_by_sym(&g_kc3_env, *sym, dest);
 }
 
+bool * kc3_or (const s_tag *a, const s_tag *b, bool *dest)
+{
+  return env_or(&g_kc3_env, a, b, dest);
+}
+
 s_tag * kc3_identity (const s_tag *tag, s_tag *dest)
 {
   return tag_init_copy(dest, tag);
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index b263025..2a8f751 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -51,6 +51,7 @@ s_str *        kc3_str (const s_tag *tag, s_str *dest);
 /* Operators. */
 s_tag *      kc3_access (const s_tag *tag, const s_list * const *addr,
                          s_tag *dest);
+bool *       kc3_and (const s_tag *a, const s_tag *b, bool *dest);
 s_tag *      kc3_buf_parse_tag (s_buf *buf, s_tag *dest);
 s_tag *      kc3_def (const s_call *call, s_tag *dest);
 s_tag *      kc3_defmodule (const s_sym **name, const s_block *block,
@@ -74,6 +75,7 @@ s_tag *      kc3_identity (const s_tag *tag, s_tag *dest);
 bool         kc3_load (const s_str *path);
 s_tag *      kc3_operator_find_by_sym (const s_sym * const *sym,
                                        s_tag *dest);
+bool *       kc3_or (const s_tag *a, const s_tag *b, bool *dest);
 bool         kc3_require (const s_sym * const *module);
 s_str *      kc3_strerror (sw err_no, s_str *dest);