Commit 0059a8aee522a92c4c86bcbce273b19fc3e5a3ab

Thomas de Grivel 2024-11-19T15:32:37

fix fn env frame

diff --git a/lib/kc3/0.1/httpd.kc3 b/lib/kc3/0.1/httpd.kc3
index 22e0f58..75ef0bc 100644
--- a/lib/kc3/0.1/httpd.kc3
+++ b/lib/kc3/0.1/httpd.kc3
@@ -28,8 +28,23 @@ defmodule HTTPd do
     load_directory("app/plugs/")
   }
 
+  def maybe_reload_app = fn () {
+    maybe_reload(__FILE__)
+    maybe_reload_directory("app/models/")
+    if (File.exists?("config/db.kc3")) do
+      maybe_reload("config/db.kc3")
+    end
+    maybe_reload_directory("app/controllers/")
+    maybe_reload_directory("app/views/")
+    if (File.exists?("config/routes.kc3")) do
+      maybe_reload("config/routes.kc3")
+    end
+    maybe_reload_directory("app/plugs/")
+  }
+
   def http_client = fn (socket, events, client_ev, client) do
     if List.has?(events, :read) do
+      maybe_reload_app()                        
       request = void
       request = HTTP.Request.buf_parse(client.buf_rw.r)
       if request do
@@ -245,20 +260,6 @@ defmodule HTTPd do
     }
   }
 
-  def url_eat = fn {
-    ([], 0) { "" }
-    (url, 0) {
-      if (type(url) == List) do
-        List.join(url, "/")
-      else
-        url
-      end
-    }
-    ([first | rest], i) { url_eat(rest, i - 1) }
-    ([], i) { "" }
-    (url, i) { "/" + url_eat(Str.split(url, "/"), i + 1) }
-  }
-
   def parse_range = fn {
     (false, max) { { (Sw) 0, (Sw) max } }
     (range, max) {
@@ -283,8 +284,9 @@ defmodule HTTPd do
   }
     
   def def_static_route = fn (prefix, root_dir, url_skip) {
+    puts("def_static_route: #{inspect(prefix)}, #{inspect(root_dir)}, #{url_skip}")
     directory_page = HTTPd.fn (request) {
-      url = url_eat(request.url, url_skip)
+      url = URL.eat(request.url, url_skip)
       files = List.sort(File.list(root_dir + url))
       file_li = HTTPd.fn (file) {
         slash = if Str.ends_with?(url, "/") do "" else "/" end
@@ -314,7 +316,7 @@ defmodule HTTPd do
       %HTTP.Response{body: body}
     }
     show_page = HTTPd.fn (request) {
-      url = url_eat(request.url, url_skip)
+      url = URL.eat(request.url, url_skip)
       ext = File.ext(url)
       path = root_dir + url
       if (! File.exists?(path)) do
@@ -337,11 +339,15 @@ defmodule HTTPd do
       end
     }
     route = HTTPd.fn (request) {
-      url = url_eat(request.url, url_skip)
+      puts("def_static_route: route: request.url: #{inspect(request.url)}")
+      puts("def_static_route: route: url_skip: #{url_skip}")
+      url = URL.eat(request.url, url_skip)
+      puts("def_static_route: route: url: #{inspect(url)}")
       render = if (Str.starts_with?(url, "/") &&
                    ! Str.has_str?(url, "/../") &&
                    ! Str.ends_with?(url, "/..")) do
         path = root_dir + url
+        puts("def_static_route: route: path: #{inspect(path)}")
         if File.exists?(path) do
           if File.is_directory?(path) do
             directory_page
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index e965be7..c0b5dd2 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -282,6 +282,8 @@ add {KC3, :symbol, KC3.puts}
 replace {KC3.puts, :symbol_value, cfn Sw "kc3_puts" (Tag)}
 add {KC3, :symbol, KC3.load}
 replace {KC3.load, :symbol_value, cfn Bool "kc3_load" (Str)}
+add {KC3, :symbol, KC3.maybe_reload}
+replace {KC3.maybe_reload, :symbol_value, cfn Bool "kc3_maybe_reload" (Str)}
 add {KC3, :symbol, KC3.must_clean}
 replace {KC3.must_clean, :symbol_value, cfn Bool "kc3_must_clean" (Sym, Result)}
 add {KC3, :symbol, KC3.while}
@@ -351,6 +353,24 @@ replace {KC3.load_directory, :symbol_value, fn (dir) {
     })
   end
 }}
+add {KC3, :symbol, KC3.maybe_reload_directory}
+replace {KC3.maybe_reload_directory, :symbol_value, fn (dir) {
+  if File.exists?(dir) && File.is_directory?(dir) do
+    files = List.sort(File.list(dir))
+    List.each(files, fn (file) {
+      if (! Str.starts_with?(file, ".")) do
+        path = dir + file
+        if File.is_directory?(path) do
+          maybe_reload_directory(path + "/")
+        else
+          if Str.ends_with?(path, ".kc3") do
+            maybe_reload(path)
+          end
+        end
+      end
+    })
+  end
+}}
 add {KC3, :symbol, KC3.args}
 replace {KC3.args, :symbol_value, cfn List "kc3_args" (Result)}
 add {KC3, :symbol, KC3.stacktrace}
diff --git a/lib/kc3/0.1/url.kc3 b/lib/kc3/0.1/url.kc3
index 07e23b5..7259535 100644
--- a/lib/kc3/0.1/url.kc3
+++ b/lib/kc3/0.1/url.kc3
@@ -2,6 +2,19 @@ defmodule URL do
 
   dlopen(__DIR__ + "http.so")
 
+  def eat = fn {
+    ([], _) { "/" }
+    (url, 0) {
+      if (type(url) == List) do
+        "/" + List.join(url, "/")
+      else
+        url
+      end
+    }
+    ([first | rest], i) { eat(rest, i - 1) }
+    (url, i) { eat(Str.split(url, "/"), i + 1) }
+  }
+
   def escape = cfn Str "url_escape" (Str, Result)
 
   def escapes = "%#<>'\\\""
diff --git a/libkc3/callable.c b/libkc3/callable.c
index 4a46b0e..a089aec 100644
--- a/libkc3/callable.c
+++ b/libkc3/callable.c
@@ -47,6 +47,31 @@ s_callable * callable_new (void)
   return callable;
 }
 
+s_callable * callable_new_copy (s_callable *src)
+{
+  s_callable *tmp;
+  if (! (tmp = callable_new()))
+    return NULL;
+  tmp->type = src->type;
+  switch (src->type) {
+  case CALLABLE_CFN:
+    if (! cfn_init_copy(&tmp->data.cfn, &src->data.cfn))
+      goto ko;
+    break;
+  case CALLABLE_FN:
+    if (! fn_init_copy(&tmp->data.fn, &src->data.fn))
+      goto ko;
+    break;
+  case CALLABLE_VOID:
+    break;
+  }
+  tmp->reference_count = 1;
+  return tmp;
+ ko:
+  free(tmp);
+  return NULL;
+}
+
 s_callable * callable_new_ref (s_callable *callable)
 {
   assert(callable);
diff --git a/libkc3/callable.h b/libkc3/callable.h
index 08a0df2..0ef39f1 100644
--- a/libkc3/callable.h
+++ b/libkc3/callable.h
@@ -28,6 +28,7 @@ p_callable * p_callable_init_copy (p_callable *callable,
 /* Heap-allocation functions, call callable_delete after use. */
 void         callable_delete (s_callable *callable);
 s_callable * callable_new (void);
+s_callable * callable_new_copy (s_callable *callable);
 s_callable * callable_new_ref (s_callable *callable);
 
 #endif /* LIBKC3_CALLABLE_H */
diff --git a/libkc3/compare.c b/libkc3/compare.c
index 77f40e9..6e041fb 100644
--- a/libkc3/compare.c
+++ b/libkc3/compare.c
@@ -119,9 +119,9 @@ s8 compare_callable (const s_callable *a, const s_callable *b)
   if (a->type > b->type)
     return 1;
   switch (a->type) {
-  case CALLABLE_VOID: return 0;
   case CALLABLE_CFN:  return compare_cfn(&a->data.cfn, &b->data.cfn);
   case CALLABLE_FN:   return compare_fn(&a->data.fn, &b->data.fn);
+  case CALLABLE_VOID: return 0;
   }
   err_puts("compare_callable: error");
   assert(! "compare_callable: error");
diff --git a/libkc3/env.c b/libkc3/env.c
index 191f0a8..9cd2180 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -894,10 +894,10 @@ bool env_eval_callable (s_env *env, s_callable *callable,
   assert(callable);
   assert(dest);
   (void) env;
-  if (! (tmp = callable_new_ref(callable)))
-    return false;
-  switch (tmp->type) {
+  switch (callable->type) {
   case CALLABLE_CFN:
+    if (! (tmp = callable_new_ref(callable)))
+      return false;
     if (! tmp->data.cfn.ready) {
       if (! cfn_prep_cif(&tmp->data.cfn))
         goto ko;
@@ -905,19 +905,22 @@ bool env_eval_callable (s_env *env, s_callable *callable,
         goto ko;
       tmp->data.cfn.ready = true;
     }
-    break;
+    goto ok;
   case CALLABLE_FN:
+    if (! (tmp = callable_new_copy(callable)))
+      return false;
     if (! tmp->data.fn.module)
       tmp->data.fn.module = env->current_defmodule;
-    if (! tmp->data.fn.frame &&
-        ! (tmp->data.fn.frame = frame_new_copy(env->frame)))
-      return false;
-    break;
+    if (! (tmp->data.fn.frame = frame_new_copy(env->frame)))
+      goto ko;
+    goto ok;
   case CALLABLE_VOID:
     err_puts("env_eval_callable: CALLABLE_VOID");
     assert(! "env_eval_callable: CALLABLE_VOID");
     return false;
   }
+  goto ko;
+ ok:
   dest->type = TAG_CALLABLE;
   dest->data.callable = tmp;
   return true;
@@ -2862,6 +2865,8 @@ bool env_load (s_env *env, const s_str *path)
   s_tag  file_dir_save;
   s_tag *file_path;
   s_tag  file_path_save;
+  s_tag load_time = {0};
+  s_tag now = {0};
   sw r;
   s_tag tag = {0};
   s_tag tmp = {0};
@@ -2919,6 +2924,12 @@ bool env_load (s_env *env, const s_str *path)
   *file_path = file_path_save;
   buf_getc_close(&buf);
   buf_clean(&buf);
+  tag = (s_tag) {0};
+  tag.type = TAG_STR;
+  tag.data.str = *path;
+  tag_init_time_now(&now);
+  tag_init_sym(&load_time, &g_sym_load_time);
+  facts_replace_tags(&env->facts, &tag, &load_time, &now);
   return true;
  ko:
   tag_clean(file_dir);
@@ -2929,6 +2940,45 @@ bool env_load (s_env *env, const s_str *path)
   return false;
 }
 
+bool env_maybe_reload (s_env *env, const s_str *path)
+{
+  s_facts_cursor cursor;
+  s_fact *fact = NULL;
+  s_tag load_time = {0};
+  s_tag load_time_sym = {0};
+  s_tag mtime = {0};
+  s_tag path_tag = {0};
+  bool r;
+  path_tag.type = TAG_STR;
+  path_tag.data.str = *path;
+  tag_init_sym(&load_time_sym, &g_sym_load_time);
+  tag_init_var(&load_time, &g_sym_Time);
+  if (! facts_with_tags(&env->facts, &cursor, &path_tag, &load_time_sym,
+                        &load_time))
+    return false;
+  if (! facts_cursor_next(&cursor, &fact))
+    return false;
+  if (! fact) {
+    err_write_1("env_maybe_reload: no load time for ");
+    err_inspect_str(path);
+    err_write_1("\n");
+    assert(! "env_maybe_reload: no load time");
+    return false;
+  }
+  if (load_time.type != TAG_TIME)
+    abort();
+  mtime.type = TAG_TIME;
+  if (! file_mtime(path, &mtime.data.time)) {
+    facts_cursor_clean(&cursor);
+    return false;
+  }
+  r = true;
+  if (compare_tag(&load_time, &mtime) == COMPARE_LT)
+    r = env_load(env, path);
+  facts_cursor_clean(&cursor);
+  return r;
+}
+
 void env_longjmp (s_env *env, jmp_buf *jmp_buf)
 {
   if (env->unwind_protect && *jmp_buf > env->unwind_protect->buf) {
diff --git a/libkc3/env.h b/libkc3/env.h
index 889f75a..6e234f6 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -100,6 +100,7 @@ s_tag *        env_kc3_def (s_env *env, const s_call *call,
 s_tag *        env_let (s_env *env, s_tag *vars, s_tag *tag,
                         s_tag *dest);
 bool           env_load (s_env *env, const s_str *path);
+bool           env_maybe_reload (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,
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index f1cf323..f27f086 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -433,6 +433,11 @@ bool kc3_load (const s_str *path)
   return env_load(&g_kc3_env, path);
 }
 
+bool kc3_maybe_reload (const s_str *path)
+{
+  return env_maybe_reload(&g_kc3_env, path);
+}
+
 const s_sym ** kc3_module (const s_sym **dest)
 {
   return env_module(&g_kc3_env, dest);
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index 7347970..dd5cfe8 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -110,6 +110,7 @@ s_tag *      kc3_identity (s_tag *tag, s_tag *dest);
 s_tag *      kc3_integer_reduce (s_tag *tag, s_tag *dest);
 s_tag *      kc3_let (s_tag *vars, s_tag *tag, s_tag *dest);
 bool         kc3_load (const s_str *path);
+bool         kc3_maybe_reload (const s_str *path);
 s_tag *      kc3_operator_find_by_sym (const s_sym * const *sym,
                                        s_tag *dest);
 bool *       kc3_or (s_tag *a, s_tag *b, bool *dest);
diff --git a/libkc3/list.c b/libkc3/list.c
index 29d05ba..3b16305 100644
--- a/libkc3/list.c
+++ b/libkc3/list.c
@@ -194,9 +194,6 @@ s_list * list_init_tag_copy (s_list *list, s_tag *tag, s_list *next)
 bool list_is_alist (const s_list *list)
 {
   const s_list *l;
-  assert(list);
-  if (! list)
-    return false;
   l = list;
   while (l) {
     if (l->tag.type != TAG_TUPLE ||