Commit 8386c20420d30d5aa923824baa36736732e50259

Thomas de Grivel 2024-07-14T23:22:09

wip let

diff --git a/.ic3_history b/.ic3_history
index 1b017bd..e107258 100644
--- a/.ic3_history
+++ b/.ic3_history
@@ -1,10 +1,3 @@
-(Sw) 123\
-(Sw) 123
-(Sw) 123/2
-(Sw) 123 / 2
-defmodule Plop do def a = 1 end
-Plop.a
-defmodule Plop do def a = 2 end
 Plop.a
 defmodule Plop do def a = 1; def double = fn (x) { x * 2 } end
 Plop.a
@@ -97,3 +90,10 @@ abc.def
 x = %C3.Operator{}
 x.sym
 quote x.sym
+x = %C3.Operator{}
+x.sym
+x = %{
+x = %C3.Operator{sym: :-}
+x = %C3.Operator{sym: 1}
+x = %C3.Operator{sym: (Sym) "1"}
+x = %C3.Operator{sym: :1}
diff --git a/ic3/.ic3_history b/ic3/.ic3_history
index 1b017bd..e107258 100644
--- a/ic3/.ic3_history
+++ b/ic3/.ic3_history
@@ -1,10 +1,3 @@
-(Sw) 123\
-(Sw) 123
-(Sw) 123/2
-(Sw) 123 / 2
-defmodule Plop do def a = 1 end
-Plop.a
-defmodule Plop do def a = 2 end
 Plop.a
 defmodule Plop do def a = 1; def double = fn (x) { x * 2 } end
 Plop.a
@@ -97,3 +90,10 @@ abc.def
 x = %C3.Operator{}
 x.sym
 quote x.sym
+x = %C3.Operator{}
+x.sym
+x = %{
+x = %C3.Operator{sym: :-}
+x = %C3.Operator{sym: 1}
+x = %C3.Operator{sym: (Sym) "1"}
+x = %C3.Operator{sym: :1}
diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index f9f8f0e..17c4e76 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -245,3 +245,7 @@ add {C3, :symbol, C3.search_modules}
 replace {C3.search_modules, :symbol_value, cfn List "c3_search_modules" (Result)}
 add {C3, :symbol, C3.access}
 replace {C3.access, :symbol_value, cfn Tag "c3_access" (Tag, Sym, Result)}
+add {C3, :symbol, C3.let}
+replace {C3.let, :arity, 2}
+replace {C3.let, :is_a, :special_operator}
+replace {C3.let, :symbol_value, cfn Tag "c3_let" (Tag, Block, Result)}
diff --git a/libc3/binding.c b/libc3/binding.c
index 33f0cfb..e696643 100644
--- a/libc3/binding.c
+++ b/libc3/binding.c
@@ -16,21 +16,22 @@
 #include "list.h"
 #include "tag.h"
 
-void binding_delete (s_binding *binding)
+s_binding * binding_delete (s_binding *binding)
 {
+  s_binding *next;
   assert(binding);
   tag_clean(&binding->value);
+  next = binding->next;
   free(binding);
+  return next;
 }
 
 void binding_delete_all (s_binding *binding)
 {
-  s_binding *next;
-  while (binding) {
-    next = binding->next;
-    binding_delete(binding);
-    binding = next;
-  }
+  s_binding *b;
+  b = binding;
+  while (b)
+    b = binding_delete(b);
 }
 
 const s_tag * binding_get (const s_binding *binding, const s_sym *name)
diff --git a/libc3/binding.h b/libc3/binding.h
index 2bc8db5..857816e 100644
--- a/libc3/binding.h
+++ b/libc3/binding.h
@@ -25,8 +25,8 @@ s_binding * binding_new (const s_sym *name, const s_tag *value,
                          s_binding *next);
 
 /* destructors */
-void binding_delete (s_binding *binding);
-void binding_delete_all (s_binding *binding);
+s_binding * binding_delete (s_binding *binding);
+void        binding_delete_all (s_binding *binding);
 
 /* observers */
 const s_tag * binding_get (const s_binding *binding, const s_sym *name);
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index e9c1b1f..ff27a37 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -766,7 +766,7 @@ sw buf_parse_call_access (s_buf *buf, s_call *dest)
   tmp.ident.sym = &g_sym_access;
   r = buf_parse_tag_primary_2(buf, &tmp.arguments->tag);
   if (r <= 0)
-    goto clean;
+    goto restore;
   result += r;
   while (1) {
     if ((r = buf_read_1(buf, ".")) <= 0)
diff --git a/libc3/c3.c b/libc3/c3.c
index 7f338de..35bb845 100644
--- a/libc3/c3.c
+++ b/libc3/c3.c
@@ -172,6 +172,11 @@ s_env * c3_init (s_env *env, int argc, char **argv)
   return env_init(env, argc, argv);
 }
 
+s_tag * c3_let (const s_tag *tag, const s_block *block, s_tag *dest)
+{
+  return env_let(&g_c3_env, tag, block, dest);
+}
+
 void c3_license (void)
 {
   buf_write_1(&g_c3_env.out, g_c3_license);
diff --git a/libc3/env.c b/libc3/env.c
index 2888d60..558e097 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -544,27 +544,35 @@ bool env_eval_call_cfn (s_env *env, const s_call *call, s_tag *dest)
   s_list *args = NULL;
   s_list *args_final = NULL;
   s_cfn *cfn;
+  s_frame frame;
   s_tag tag;
   assert(env);
   assert(call);
   assert(dest);
   cfn = call->cfn;
   assert(cfn);
+  if (! frame_init(&frame, env->frame))
+    return false;
+  env->frame = &frame;
   if (call->arguments) {
     if (cfn->macro || cfn->special_operator)
       args_final = call->arguments;
     else {
-      if (! env_eval_call_arguments(env, call->arguments, &args))
+      if (! env_eval_call_arguments(env, call->arguments, &args)) {
+        env->frame = frame_clean(&frame);
         return false;
+      }
       args_final = args;
     }
   }
   if (! cfn_apply(cfn, args_final, &tag)) {
     list_delete_all(args);
+    env->frame = frame_clean(&frame);
     return false;
   }
   *dest = tag;
   list_delete_all(args);
+  env->frame = frame_clean(&frame);
   return true;
 }
 
@@ -2003,6 +2011,60 @@ s_env * env_init_args (s_env *env, int argc, char **argv)
   return env;
 }
 
+s_tag * env_let (s_env *env, const s_tag *tag, const s_block *block,
+                 s_tag *dest)
+{
+  uw i;
+  const s_map *map;
+  s_tag tmp;
+  assert(env);
+  assert(tag);
+  assert(block);
+  assert(dest);
+  if (! env_eval_tag(env, tag, &tmp))
+    return NULL;
+  switch(tag->type) {
+  case TAG_MAP:
+    map = &tag->data.map;
+    break;
+  case TAG_STRUCT:
+    map = &tag->data.struct_.type->map;
+    break;
+  default:
+    tag_clean(&tmp);
+    err_write_1("env_let: unsupported associative tag type: ");
+    err_inspect_tag_type(tag->type);
+    err_write_1(": ");
+    err_inspect_tag(tag);
+    err_write_1("\n");
+    assert(! "env_let: unsupported associative tag type");
+    return NULL;
+  }
+  i = 0;
+  while (i < map->count) {
+    if (map->key[i].type != TAG_SYM) {
+      tag_clean(&tmp);
+      err_write_1("env_let: binding key is not a symbol: ");
+      err_inspect_tag(map->key + i);
+      err_write_1("\n");
+      assert(! "env_let: binding key is not a symbol");
+      return NULL;
+    }
+    if (! frame_binding_new(env->frame, map->key[i].data.sym,
+                            map->value + i)) {
+      tag_clean(&tmp);
+      return NULL;
+    }
+    i++;
+  }
+  if (! env_eval_block(env, block, dest)) {
+    tag_clean(&tmp);
+    return NULL;
+  }
+  tag_clean(&tmp);
+  return dest;
+}
+
 bool env_load (s_env *env, const s_str *path)
 {
   s_buf buf;
diff --git a/libc3/env.h b/libc3/env.h
index 59ecf2e..2cf3884 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -175,6 +175,8 @@ s_tag *       env_ident_get (s_env *env, const s_ident *ident,
 bool *        env_ident_is_special_operator (s_env *env,
                                              const s_ident *ident,
                                              bool *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);
diff --git a/libc3/io.c b/libc3/io.c
index 352dd98..0585e15 100644
--- a/libc3/io.c
+++ b/libc3/io.c
@@ -14,6 +14,7 @@
 #include "buf_inspect.h"
 #include "env.h"
 #include "io.h"
+#include "tag_type.h"
 
 #define DEF_ERR_INSPECT(name, type)                                    \
   sw err_inspect_ ## name (type x)                                     \
@@ -46,6 +47,11 @@ sw err_inspect (const s_tag *x)
   return err_inspect_tag(x);
 }
 
+sw err_inspect_tag_type (e_tag_type type)
+{
+  return err_write_1(tag_type_to_string(type));
+}
+
 sw err_puts (const char *x)
 {
   sw r;
@@ -82,6 +88,11 @@ sw io_inspect (const s_tag *x)
   return result;
 }
 
+sw io_inspect_tag_type (e_tag_type type)
+{
+  return io_write_1(tag_type_to_string(type));
+}
+
 sw io_puts (const char *x)
 {
   sw r;
diff --git a/libc3/io.h b/libc3/io.h
index 9fc98d5..389e6a3 100644
--- a/libc3/io.h
+++ b/libc3/io.h
@@ -60,6 +60,7 @@ PROTOTYPES_ERR_IO_INSPECT(str,        const s_str *);
 PROTOTYPES_ERR_IO_INSPECT(sw,         const sw *);
 PROTOTYPES_ERR_IO_INSPECT(sym,        const s_sym * const *);
 PROTOTYPES_ERR_IO_INSPECT(tag,        const s_tag *);
+PROTOTYPES_ERR_IO_INSPECT(tag_type,   e_tag_type);
 PROTOTYPES_ERR_IO_INSPECT(tuple,      const s_tuple *);
 PROTOTYPES_ERR_IO_INSPECT(u8,         const u8 *);
 PROTOTYPES_ERR_IO_INSPECT(u16,        const u16 *);
diff --git a/test/ec3/title.c3.in b/test/ec3/title.c3.in
new file mode 100644
index 0000000..a814e7c
--- /dev/null
+++ b/test/ec3/title.c3.in
@@ -0,0 +1,2 @@
+puts EC3.render(__DIR__ + "/title.html.ec3",
+  %{title: "EC3 test title"})
diff --git a/test/ec3/title.html.ec3 b/test/ec3/title.html.ec3
new file mode 100644
index 0000000..41bbd39
--- /dev/null
+++ b/test/ec3/title.html.ec3
@@ -0,0 +1,8 @@
+<html>
+  <head>
+    <title><%= title %></title>
+  </head>
+  <body>
+    <h1><%= title %></h1>
+  </body>
+</html>
diff --git a/test/ic3/let.in b/test/ic3/let.in
new file mode 100644
index 0000000..8542214
--- /dev/null
+++ b/test/ic3/let.in
@@ -0,0 +1,4 @@
+quote let %{a: 1} do a; end
+let %{a: 1} do a; end
+quote let %{a: 1, b: 2} do a + b; end
+let %{a: 1, b: 2} do a + b; end
diff --git a/test/ic3/let.out.expected b/test/ic3/let.out.expected
new file mode 100644
index 0000000..fe1a2bb
--- /dev/null
+++ b/test/ic3/let.out.expected
@@ -0,0 +1,8 @@
+let %{a: 1} do
+  a
+end
+1
+let %{a: 1, b: 2} do
+  a + b
+end
+3
diff --git a/test/ic3/let.ret.expected b/test/ic3/let.ret.expected
new file mode 100644
index 0000000..573541a
--- /dev/null
+++ b/test/ic3/let.ret.expected
@@ -0,0 +1 @@
+0