Commit ccd0b9a27dc749ba045ddf0d48f1fef43f83266e

Thomas de Grivel 2024-10-29T11:28:52

wip httpd

diff --git a/httpd/fx/app/models/fx.kc3 b/httpd/fx/app/models/fx.kc3
index 741dd30..a23232a 100644
--- a/httpd/fx/app/models/fx.kc3
+++ b/httpd/fx/app/models/fx.kc3
@@ -1,38 +1,34 @@
 defmodule Fx do
 
-  def db = Facts.database()
-
-  Facts.open(db, "db/fx.facts")
-
   def property_index = fn (path) {
     if Str.starts_with?(path, "./") do
       path = Str.slice(path, 2, -1)
     end
-    Facts.collect_with_tags(db, path, p = ?, o = ?, fn (fact) {
+    Facts.collect_with_tags(Config.db, path, p = ?, o = ?, fn (fact) {
       {p, o}
     })
   }
 
   def property_add = fn (path, property, value) {
-    Facts.add_tags(db, path, property, value)
+    Facts.add_tags(Config.db, path, property, value)
   }
 
   def property_remove = fn (path, property, value) {
-    Facts.remove_tags(db, path, property, value)
+    Facts.remove_tags(Config.db, path, property, value)
   }
 
   def tag_index = fn (path) {
-    Facts.collect_with_tags(db, path, :tag, tag = ?, fn (fact) {
+    Facts.collect_with_tags(Config.db, path, :tag, tag = ?, fn (fact) {
       tag
     })
   }
 
   def tag_add = fn (path, tag) {
-    Facts.add_tags(db, path, :tag, tag)
+    Facts.add_tags(Config.db, path, :tag, tag)
   }
 
   def tag_remove = fn (path, tag) {
-    Facts.remove_tags(db, path, :tag, tag)
+    Facts.remove_tags(Config.db, path, :tag, tag)
   }
 
 end
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index 2c65485..e2d5968 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -353,3 +353,5 @@ replace {KC3.load_directory, :symbol_value, fn (dir) {
 }}
 add {KC3, :symbol, KC3.args}
 replace {KC3.args, :symbol_value, cfn List "kc3_args" (Result)}
+add {KC3, :symbol, KC3.stacktrace}
+replace {KC3.stacktrace, :symbol_value, cfn List "kc3_stacktrace" (Result)}
diff --git a/libkc3/env.c b/libkc3/env.c
index 69d733e..73e7f73 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -183,8 +183,11 @@ bool env_call_get (s_env *env, s_call *call)
     err_puts(" :symbol_value not found");
     return false;
   }
-  if (tag_var.type == TAG_FN)
+  if (tag_var.type == TAG_FN) {
     call->fn = fn_new_copy(&tag_var.data.fn);
+    fn_set_name_if_null(call->fn, call->ident.module,
+                        call->ident.sym);
+  }
   else if (tag_var.type == TAG_CFN)
     call->cfn = cfn_new_copy(&tag_var.data.cfn);
   else {
@@ -488,7 +491,7 @@ void env_error_tag (s_env *env, const s_tag *tag)
   error_handler = env->error_handler;
   if (error_handler) {
     tag_init_copy(&error_handler->tag, tag);
-    error_handler->backtrace = env->backtrace;
+    error_handler->stacktrace = list_new_copy(env->stacktrace);
     env_longjmp(env, &error_handler->jmp_buf);
     /* never reached */
     return;
@@ -687,6 +690,7 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
   s_list *search_modules;
   s_tag tag;
   s_list *tmp = NULL;
+  s_list *trace;
   assert(env);
   assert(fn);
   assert(dest);
@@ -746,6 +750,16 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
     frame_init(&frame, env->frame, fn->frame);
     env->frame = &frame;
   }
+  if (! (trace = list_new(env->stacktrace))) {
+    list_delete_all(args);
+    list_delete_all(tmp);
+    list_delete_all(env->search_modules);
+    env->search_modules = search_modules;
+    env->frame = env_frame;
+    frame_clean(&frame);
+    return false;
+  }
+  tag_init_ident(&trace->tag, &fn->ident);
   if (! env_eval_block(env, &clause->algo, &tag)) {
     list_delete_all(args);
     list_delete_all(tmp);
@@ -3413,6 +3427,14 @@ s_list ** env_search_modules (s_env *env, s_list **dest)
   return list_init_copy(dest, (const s_list * const *) &env->search_modules);
 }
 
+s_list ** env_stacktrace (s_env *env, s_list **dest)
+{
+  assert(env);
+  assert(dest);
+  *dest = list_new_copy(env->stacktrace);
+  return dest;
+}
+
 bool env_sym_search_modules (s_env *env, const s_sym *sym,
                              const s_sym **dest)
 {
diff --git a/libkc3/env.h b/libkc3/env.h
index a86f4f6..5c98308 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -38,6 +38,7 @@ s_list **       env_module_search_modules (s_env *env,
                                            const s_sym * const *module,
                                            s_list **dest);
 s_list **       env_search_modules (s_env *env, s_list **dest);
+s_list **       env_stacktrace (s_env *env, s_list **dest);
 bool            env_sym_search_modules (s_env *env,
                                         const s_sym *sym,
                                         const s_sym **dest);
diff --git a/libkc3/error.c b/libkc3/error.c
index aaf48f2..ce58770 100644
--- a/libkc3/error.c
+++ b/libkc3/error.c
@@ -21,14 +21,14 @@ void error_print (s_buf *buf, const s_error_handler *error_handler)
 {
   buf_write_1(buf, "error: ");
   buf_inspect_tag(buf, &error_handler->tag);
-  buf_write_1(buf, "\nBacktrace:\n");
-  error_print_backtrace(buf, error_handler->backtrace);
+  buf_write_1(buf, "\nStacktrace:\n");
+  error_print_stacktrace(buf, error_handler->stacktrace);
 }
 
-void error_print_backtrace (s_buf *buf, const s_list *backtrace)
+void error_print_stacktrace (s_buf *buf, const s_list *stacktrace)
 {
-  while (backtrace) {
-    buf_inspect_tag(buf, &backtrace->tag);
+  while (stacktrace) {
+    buf_inspect_tag(buf, &stacktrace->tag);
     buf_write_1(buf, "\n");
   }
 }
diff --git a/libkc3/error.h b/libkc3/error.h
index 2a0df97..da5ae78 100644
--- a/libkc3/error.h
+++ b/libkc3/error.h
@@ -23,6 +23,6 @@
   } while (0)
 
 void error_print (s_buf *buf, const s_error_handler *error_handler);
-void error_print_backtrace (s_buf *buf, const s_list *backtrace);
+void error_print_stacktrace (s_buf *buf, const s_list *stacktrace);
 
 #endif /* LIBKC3_ERROR_H */
diff --git a/libkc3/fn.c b/libkc3/fn.c
index 9021146..1d27b84 100644
--- a/libkc3/fn.c
+++ b/libkc3/fn.c
@@ -149,3 +149,13 @@ s_fn * fn_new_copy (const s_fn *src)
   }
   return fn;
 }
+
+s_fn * fn_set_name_if_null (s_fn *fn, const s_sym *module,
+                            const s_sym *name)
+{
+  if (! fn->ident.sym) {
+    fn->ident.module = module;
+    fn->ident.sym = name;
+  }
+  return fn;
+}
diff --git a/libkc3/fn.h b/libkc3/fn.h
index 568e325..16dec5b 100644
--- a/libkc3/fn.h
+++ b/libkc3/fn.h
@@ -37,4 +37,8 @@ s_fn * fn_new_copy (const s_fn *fn);
 /* Observers. */
 s8 fn_arity (const s_fn *fn);
 
+/* Operators. */
+s_fn * fn_set_name_if_null (s_fn *fn, const s_sym *module,
+                            const s_sym *name);
+
 #endif /* LIBKC3_FN_H */
diff --git a/libkc3/frame.c b/libkc3/frame.c
index afbd9f3..e19af11 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -13,7 +13,9 @@
 #include "alloc.h"
 #include "assert.h"
 #include "binding.h"
+#include "fn.h"
 #include "frame.h"
+#include "ident.h"
 #include "list.h"
 #include "sym.h"
 #include "tag.h"
@@ -41,23 +43,25 @@ s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name,
                                   s_tag *value)
 {
   s_tag *tag;
-  frame_binding_new(frame, name);
-  tag = binding_get_w(frame->bindings, name);
-  if (tag == NULL) {
-    err_puts("frame_binding_new_copy: binding new");
-    assert(! "frame_binding_new_copy: binding new");
+  if (! (tag = frame_binding_new(frame, name))) {
+    err_puts("frame_binding_new_copy: frame_binding_new");
+    assert(! "frame_binding_new_copy: frame_binding_new");
     return NULL;
   }
   if (value->type == TAG_VAR) {
     tag_init_var(tag, value->data.var.type);
     value->data.var.ptr = tag->data.var.ptr;
   }
-  else if (! tag_init_copy(tag, value)) {
-    err_puts("frame_binding_new_copy: tag_init_copy");
-    assert(! "frame_binding_new_copy: tag_init_copy");
-    frame = frame_binding_delete(frame, name);
-    return NULL;
-  }
+  else {
+    if (! tag_init_copy(tag, value)) {
+      err_puts("frame_binding_new_copy: tag_init_copy");
+      assert(! "frame_binding_new_copy: tag_init_copy");
+      frame = frame_binding_delete(frame, name);
+      return NULL;
+    }
+    if (tag->type == TAG_FN)
+      fn_set_name_if_null(&tag->data.fn, NULL, name);
+  }    
   return frame;
 }
 
@@ -237,8 +241,15 @@ s_frame * frame_replace (s_frame *frame, const s_sym *sym,
       tag_init_var(result, value->data.var.type);
       value->data.var.ptr = result->data.var.ptr;
     }
-    else
-      tag_init_copy(result, value);
+    else {
+      if (! tag_init_copy(result, value)) {
+        err_puts("frame_replace: tag_init_copy");
+        assert(! "frame_replace: tag_init_copy");
+        return NULL;
+      }
+      if (result->type == TAG_FN)
+        fn_set_name_if_null(&result->data.fn, NULL, sym);
+    }
     return frame;
   }
   return frame_binding_new_copy(frame, sym, value);
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index 729bcf3..7334ff9 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -484,6 +484,11 @@ s_list ** kc3_search_modules (s_list **dest)
   return env_search_modules(&g_kc3_env, dest);
 }
 
+s_list ** kc3_stacktrace (s_list **dest)
+{
+  return env_stacktrace(&g_kc3_env, dest);
+}
+
 s_str * kc3_str (const s_tag *tag, s_str *dest)
 {
   const s_sym *sym;
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index 1761696..0cd419f 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -49,6 +49,7 @@ const s_sym ** kc3_module (const s_sym **dest);
 uw *           kc3_offsetof (const s_sym * const *module,
                              const s_sym * const *field, uw *dest);
 sw             kc3_puts (const s_tag *tag);
+s_list **      kc3_stacktrace (s_list **dest);
 s_str *        kc3_str (const s_tag *tag, s_str *dest);
 s_tag *        kc3_struct_put (const s_tag *s,
                                const s_sym * const *key,
diff --git a/libkc3/types.h b/libkc3/types.h
index d5b651d..ea77d6c 100644
--- a/libkc3/types.h
+++ b/libkc3/types.h
@@ -402,14 +402,6 @@ struct file_stat {
   s_time st_ctim; /* Time of last status change */
 };
 
-struct fn {
-  s_fn_clause *clauses;
-  bool macro;
-  bool special_operator;
-  const s_sym *module;
-  s_frame *frame;
-};
-
 struct ident {
   const s_sym *module;
   const s_sym *sym;
@@ -465,6 +457,15 @@ struct cfn {
   bool special_operator;
 };
 
+struct fn {
+  s_fn_clause *clauses;
+  bool macro;
+  bool special_operator;
+  s_ident ident;
+  const s_sym *module;
+  s_frame *frame;
+};
+
 struct log {
   s_buf  buf;
   u64    count;
@@ -571,7 +572,7 @@ struct complex {
 
 struct error_handler
 {
-  s_list *backtrace;
+  s_list *stacktrace;
   jmp_buf jmp_buf;
   s_error_handler *next;
   s_tag tag;
@@ -705,7 +706,7 @@ struct env {
   sw                argc;
   char            **argv;
   s_str             argv0_dir;
-  s_list           *backtrace;
+  s_list           *stacktrace;
   const s_sym      *current_defmodule;
   s_buf             err;
   s_error_handler  *error_handler;
diff --git a/test/httpd/config/db.kc3 b/test/httpd/config/db.kc3
new file mode 100644
index 0000000..ee9b5ff
--- /dev/null
+++ b/test/httpd/config/db.kc3
@@ -0,0 +1,7 @@
+defmodule Config do
+
+  def db = Facts.database()
+
+  Facts.open(db, "db/app.facts")
+
+end
diff --git a/test/httpd/db/app.facts b/test/httpd/db/app.facts
new file mode 120000
index 0000000..f5ce1fe
--- /dev/null
+++ b/test/httpd/db/app.facts
@@ -0,0 +1 @@
+../../../httpd/fx/db/fx.facts
\ No newline at end of file
diff --git a/test/httpd/db/fx.facts b/test/httpd/db/fx.facts
deleted file mode 120000
index f5ce1fe..0000000
--- a/test/httpd/db/fx.facts
+++ /dev/null
@@ -1 +0,0 @@
-../../../httpd/fx/db/fx.facts
\ No newline at end of file