kc3-lang/kc3

diff --git a/.ic3_history b/.ic3_history
index 6e3377b..0206db5 100644
--- a/.ic3_history
+++ b/.ic3_history
@@ -1,29 +1,3 @@
-234
-123/123
-123/ 123
-do
-1
-1 + 1
-2 + 2
-end
-hello = fn (name) { "Hello, #{name} !" }
-m = macro (name) { "Hello, #{name} !" }
-m(plop)
-m(:plop)
-m("plop")
-m = macro (x) { quote 1 + unquote x }
-plop = 2
-m(plop)
-name = "Thomas"
-m = macro (x) { quote 1 + unquote x }
-m(name)
-name
-name = "Thomas"
-m = macro (x) { quote 1 + unquote x }
-m(name)
-name = "Thomas"
-m = macro (x) { quote 1 + unquote x }
-m(name)
 name = "Thomas"
 m = macro (x) { quote 1 + unquote x }
 m(name)
@@ -97,3 +71,29 @@ m(name)
 m("Plop")
 m(^ name)
 m = macro (name) { quote "Hello, " + unquote name + " !" }
+name = "Plop"
+^ name = plop
+plop
+name
+name = "Plop"
+m = macro (name) { quote "Hello, " + unquote name + " !" }
+m(name)
+m(^name)
+m(^ name)
+m = macro (name) { quote "Hello, " + unquote name + " !" }
+name = "Plop"
+m(name)
+m = macro (name) { quote "Hello, " + unquote name + " !" }
+name = "Plop"
+m(name)
+m(^ name)
+name
+type(name)
+m(name)
+n = "123"
+m(n)
+n
+m(n)
+m = macro (name) { quote "Hello, " + unquote name + " !" }
+n = "123"
+m(n)
diff --git a/README.md b/README.md
index 25c43e2..66092e9 100644
--- a/README.md
+++ b/README.md
@@ -293,6 +293,7 @@ Script interpreter. Works the same as ic3 but is not interactive.
      - height function `(TAG_VOID: 0, TAG_TUPLE: max(height(tuple->tags)))`
      - has_ident
      - collect_idents
+   - DONE pin operator (for pattern matching)
    - DONE macros
    - modules
      - defmodule
diff --git a/libc3/env.c b/libc3/env.c
index f92a8b0..c821ba7 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -274,7 +274,7 @@ bool env_eval_call_resolve (s_env *env, s_call *call)
   const s_tag *value;
   assert(env);
   assert(call);
-  if ((value = frame_get(env->frame, call->ident.sym))) {
+  if ((value = env_frames_get(env, call->ident.sym))) {
     if (value->type == TAG_CFN) {
       call->cfn = cfn_new_copy(&value->data.cfn);
       return true;
@@ -290,8 +290,8 @@ bool env_eval_call_resolve (s_env *env, s_call *call)
   return call_get(call, &env->facts);
 }
 
-bool env_eval_equal_list (s_env *env, const s_list *a, const s_list *b,
-                          s_list **dest)
+bool env_eval_equal_list (s_env *env, bool macro, const s_list *a,
+                          const s_list *b, s_list **dest)
 {
   s_list *a_next;
   s_list *b_next;
@@ -310,13 +310,13 @@ bool env_eval_equal_list (s_env *env, const s_list *a, const s_list *b,
     if (! b)
       goto ko;
     *t = list_new(NULL);
-    if (! env_eval_equal_tag(env, &a->tag, &b->tag,
+    if (! env_eval_equal_tag(env, macro, &a->tag, &b->tag,
                              &(*t)->tag))
       goto ko;
     a_next = list_next(a);
     b_next = list_next(b);
     if (! a_next || ! b_next) {
-      if (! env_eval_equal_tag(env, &a->next, &b->next,
+      if (! env_eval_equal_tag(env, macro, &a->next, &b->next,
                                &(*t)->next))
         goto ko;
       goto ok;
@@ -334,7 +334,7 @@ bool env_eval_equal_list (s_env *env, const s_list *a, const s_list *b,
   return false;
 }
 
-bool env_eval_equal_map (s_env *env, const s_map *a,
+bool env_eval_equal_map (s_env *env, bool macro, const s_map *a,
                          const s_map *b, s_map *dest)
 {
   const s_map *c;
@@ -363,7 +363,7 @@ bool env_eval_equal_map (s_env *env, const s_map *a,
     j = 0;
     while (j < b->count) {
       if (! compare_tag(a->key + i, b->key + j)) {
-        if (! env_eval_equal_tag(env, a->value + i, b->value + j,
+        if (! env_eval_equal_tag(env, macro, a->value + i, b->value + j,
                                  &tmp)) {
           return false;
         }
@@ -380,9 +380,8 @@ bool env_eval_equal_map (s_env *env, const s_map *a,
   return true;
 }
 
-// TODO: pin operator
-bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
-                         s_tag *dest)
+bool env_eval_equal_tag (s_env *env, bool macro, const s_tag *a,
+                         const s_tag *b, s_tag *dest)
 {
   bool is_unbound_a;
   bool is_unbound_b;
@@ -395,7 +394,7 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
   tag_init_void(&tmp_a);
   tag_init_void(&tmp_b);
   is_unbound_a = a->type == TAG_IDENT;
-  is_unbound_b = b->type == TAG_IDENT;
+  is_unbound_b = ! macro && b->type == TAG_IDENT;
   if (is_unbound_a && is_unbound_b) {
     err_write_1("env_eval_equal_tag: unbound equal on both sides: ");
     err_inspect_ident(&a->data.ident),
@@ -414,24 +413,26 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
     frame_binding_new(env->frame, b->data.ident.sym, dest);
     return true;
   }
-  if (a->type == TAG_CALL &&
+  if (! macro &&
+      a->type == TAG_CALL &&
       a->data.call.ident.module == &g_sym_C3 &&
       a->data.call.ident.sym == &g_sym_operator_pin) {
     if (! env_eval_tag(env, &a->data.call.arguments->tag, &tmp_a))
       return false;
-    if (! env_eval_equal_tag(env, &tmp_a, b, dest)) {
+    if (! env_eval_equal_tag(env, macro, &tmp_a, b, dest)) {
       tag_clean(&tmp_a);
       return false;
     }
     tag_clean(&tmp_a);
     return true;
   }
-  if (b->type == TAG_CALL &&
+  if (! macro &&
+      b->type == TAG_CALL &&
       b->data.call.ident.module == &g_sym_C3 &&
       b->data.call.ident.sym == &g_sym_operator_pin) {
     if (! env_eval_tag(env, &b->data.call.arguments->tag, &tmp_b))
       return false;
-    if (! env_eval_equal_tag(env, a, &tmp_b, dest)) {
+    if (! env_eval_equal_tag(env, macro, a, &tmp_b, dest)) {
       tag_clean(&tmp_b);
       return false;
     }
@@ -488,22 +489,22 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
     return true;
   case TAG_LIST:
     tag_init_list(dest, NULL);
-    return env_eval_equal_list(env, a->data.list, b->data.list,
+    return env_eval_equal_list(env, macro, a->data.list, b->data.list,
                                &dest->data.list);
   case TAG_MAP:
     dest->type = TAG_MAP;
-    return env_eval_equal_map(env, &a->data.map, &b->data.map,
+    return env_eval_equal_map(env, macro, &a->data.map, &b->data.map,
                               &dest->data.map);
   /*
   case TAG_STRUCT:
     dest->type = TAG_STRUCT;
-    return env_eval_equal_struct(env, &a->data.struct_,
+    return env_eval_equal_struct(env, macro, &a->data.struct_,
                                  &b->data.struct_, &dest->data.struct_);
   */
   case TAG_TUPLE:
     dest->type = TAG_TUPLE;
-    return env_eval_equal_tuple(env, &a->data.tuple, &b->data.tuple,
-                                &dest->data.tuple);
+    return env_eval_equal_tuple(env, macro, &a->data.tuple,
+                                &b->data.tuple, &dest->data.tuple);
   case TAG_CALL:
   case TAG_QUOTE:
   case TAG_ARRAY:
@@ -524,7 +525,7 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
   case TAG_SYM:
   case TAG_VAR:
     if (compare_tag(a, b)) {
-      warnx("env_eval_compare_tag: value mismatch");
+      err_puts("env_eval_compare_tag: value mismatch");
       return false;
     }
     tag_init_copy(dest, a);
@@ -536,7 +537,7 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
   return false;
 }
 
-bool env_eval_equal_tuple (s_env *env, const s_tuple *a,
+bool env_eval_equal_tuple (s_env *env, bool macro, const s_tuple *a,
                            const s_tuple *b, s_tuple *dest)
 {
   uw i;
@@ -550,7 +551,8 @@ bool env_eval_equal_tuple (s_env *env, const s_tuple *a,
   tuple_init(&tmp, a->count);
   i = 0;
   while (i < a->count) {
-    if (! env_eval_equal_tag(env, a->tag + i, b->tag + i, tmp.tag + i)) {
+    if (! env_eval_equal_tag(env, macro, a->tag + i, b->tag + i,
+                             tmp.tag + i)) {
       tuple_clean(&tmp);
       return false;
     }
@@ -572,8 +574,6 @@ bool env_eval_fn_call (s_env *env, const s_fn *fn,
   assert(env);
   assert(fn);
   assert(dest);
-  frame_init(&frame, env->frame);
-  env->frame = &frame;
   clause = fn->clauses;
   if (arguments) {
     if (fn->macro || fn->special_operator)
@@ -585,10 +585,15 @@ bool env_eval_fn_call (s_env *env, const s_fn *fn,
       }
       args_final = args;
     }
-    /* FIXME: bindings go through clauses */
-    while (clause && ! env_eval_equal_list(env, clause->pattern,
-                                           args_final, &tmp))
+    while (clause) {
+      frame_init(&frame, env->frame);
+      env->frame = &frame;
+      if (env_eval_equal_list(env, fn->macro || fn->special_operator,
+                              clause->pattern, args_final, &tmp))
+        break;
+      env->frame = frame_clean(&frame);
       clause = clause->next_clause;
+    }
     if (! clause) {
       err_puts("env_eval_call_fn: no clause matching.\nTried clauses :\n");
       clause = fn->clauses;
@@ -601,25 +606,31 @@ bool env_eval_fn_call (s_env *env, const s_fn *fn,
       err_inspect_fn_pattern(args);
       err_puts("\n");
       list_delete_all(args);
-      env->frame = frame_clean(&frame);
       return false;
     }
   }
+  else {
+    frame_init(&frame, env->frame);
+    env->frame = &frame;
+  }
   if (! env_eval_block(env, &clause->algo, &tag)) {
     list_delete_all(args);
     list_delete_all(tmp);
     env->frame = frame_clean(&frame);
     return false;
   }
+  list_delete_all(args);
+  list_delete_all(tmp);
+  env->frame = frame_clean(&frame);
   if (fn->macro) {
-    if (! env_eval_tag(env, &tag, dest))
+    if (! env_eval_tag(env, &tag, dest)) {
+      tag_clean(&tag);
       return false;
+    }
+    tag_clean(&tag);
   }
   else
     *dest = tag;
-  list_delete_all(args);
-  list_delete_all(tmp);
-  env->frame = frame_clean(&frame);
   return true;
 }
 
@@ -632,11 +643,11 @@ bool env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
   assert(ident);
   ident_init_copy(&tmp_ident, ident);
   ident_resolve_module(&tmp_ident, env);
-  if (! ((tag = frame_get(env->frame, tmp_ident.sym)) ||
+  if (! ((tag = env_frames_get(env, tmp_ident.sym)) ||
          (tag = ident_get(&tmp_ident, &env->facts, &tmp)))) {
-    warnx("unbound ident: %s.%s",
-          tmp_ident.module->str.ptr.pchar,
-          tmp_ident.sym->str.ptr.pchar);
+    err_write_1("env_eval_ident: unbound ident: ");
+    err_inspect_ident(ident);
+    err_write_1("\n");
     return false;
   }
   tag_init_copy(dest, tag);
@@ -649,7 +660,7 @@ bool env_eval_ident_is_bound (s_env *env, const s_ident *ident)
   s_tag tmp;
   assert(env);
   assert(ident);
-  if (frame_get(env->frame, ident->sym))
+  if (env_frames_get(env, ident->sym))
     return true;
   ident_init_copy(&tmp_ident, ident);
   ident_resolve_module(&tmp_ident, env);
@@ -1193,6 +1204,15 @@ bool env_eval_void (s_env *env, const void *_, s_tag *dest)
   return true;
 }
 
+const s_tag * env_frames_get (const s_env *env, const s_sym *name)
+{
+  const s_tag *tag;
+  if ((tag = frame_get(env->frame, name)) ||
+      (tag = frame_get(&env->global_frame, name)))
+    return tag;
+  return NULL;
+}
+
 s_env * env_init (s_env *env, int argc, char **argv)
 {
   s_str path;
@@ -1201,7 +1221,8 @@ s_env * env_init (s_env *env, int argc, char **argv)
     return NULL;
   sym_init_g_sym();
   env->error_handler = NULL;
-  env->frame = frame_new(NULL);
+  env->frame = frame_new(NULL);         // toplevel
+  frame_init(&env->global_frame, NULL); // globals
   buf_init_alloc(&env->in, BUF_SIZE);
   buf_file_open_r(&env->in, stdin);
   buf_init_alloc(&env->out, BUF_SIZE);
@@ -1739,7 +1760,7 @@ bool env_tag_ident_is_bound (const s_env *env, const s_tag *tag,
   assert(tag);
   assert(tag->type == TAG_IDENT);
   return tag->type == TAG_IDENT &&
-    (frame_get(env->frame, tag->data.ident.sym) ||
+    (env_frames_get(env, tag->data.ident.sym) ||
      ident_get(&tag->data.ident, facts, &tmp));
 }
 
diff --git a/libc3/env.h b/libc3/env.h
index ee5c789..5af1b69 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -21,6 +21,9 @@ extern s_env g_c3_env;
 void    env_clean (s_env *env);
 s_env * env_init (s_env *env, int argc, char **argv);
 
+/* Observers. */
+const s_tag * env_frames_get (const s_env *env, const s_sym *name);
+
 /* Operators. */
 bool          env_eval_array (s_env *env, const s_array *array,
                               s_array *dest);
@@ -37,17 +40,22 @@ bool          env_eval_call_cfn (s_env *env, const s_call *call,
 bool          env_eval_call_fn (s_env *env, const s_call *call,
                                 s_tag *dest);
 bool          env_eval_call_resolve (s_env *env, s_call *call);
-bool          env_eval_equal_block (s_env *env, const s_block *a,
-                                    const s_block *b, s_block *dest);
-bool          env_eval_equal_list (s_env *env, const s_list *a,
-                                   const s_list *b, s_list **dest);
-bool          env_eval_equal_struct (s_env *env, const s_struct *a,
+bool          env_eval_equal_block (s_env *env, bool macro,
+                                    const s_block *a, const s_block *b,
+                                    s_block *dest);
+bool          env_eval_equal_list (s_env *env, bool macro,
+                                   const s_list *a, const s_list *b,
+                                   s_list **dest);
+bool          env_eval_equal_struct (s_env *env, bool macro,
+                                     const s_struct *a,
                                      const s_struct *b,
                                      s_struct *dest);
-bool          env_eval_equal_tag (s_env *env, const s_tag *a,
-                                  const s_tag *b, s_tag *dest);
-bool          env_eval_equal_tuple (s_env *env, const s_tuple *a,
-                                    const s_tuple *b, s_tuple *dest);
+bool          env_eval_equal_tag (s_env *env, bool macro,
+                                  const s_tag *a, const s_tag *b,
+                                  s_tag *dest);
+bool          env_eval_equal_tuple (s_env *env, bool macro,
+                                    const s_tuple *a, const s_tuple *b,
+                                    s_tuple *dest);
 bool          env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest);
 bool          env_eval_fn_call (s_env *env, const s_fn *fn,
                                 const s_list *arguments, s_tag *dest);
diff --git a/libc3/frame.c b/libc3/frame.c
index 0a8a944..3e4c3c5 100644
--- a/libc3/frame.c
+++ b/libc3/frame.c
@@ -50,13 +50,7 @@ void frame_delete_all (s_frame *frame)
 
 const s_tag * frame_get (const s_frame *frame, const s_sym *sym)
 {
-  const s_tag *tag;
-  while (frame) {
-    if ((tag = binding_get(frame->bindings, sym)))
-      return tag;
-    frame = frame->next;
-  }
-  return NULL;
+  return binding_get(frame->bindings, sym);
 }
 
 s_frame * frame_init (s_frame *frame, s_frame *next)
diff --git a/libc3/tag.c b/libc3/tag.c
index 931d2fe..878dfb3 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -261,7 +261,7 @@ s_tag * tag_equal (const s_tag *a, const s_tag *b, s_tag *dest)
   assert(a);
   assert(b);
   assert(dest);
-  if (! env_eval_equal_tag (&g_c3_env, a, b, dest))
+  if (! env_eval_equal_tag (&g_c3_env, false, a, b, dest))
     return NULL;
   return dest;
 }
diff --git a/libc3/tag_add.c b/libc3/tag_add.c
index 1ddb007..9bb8639 100644
--- a/libc3/tag_add.c
+++ b/libc3/tag_add.c
@@ -10,9 +10,7 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
-#include <assert.h>
-#include <err.h>
-#include <math.h>
+#include "assert.h"
 #include "integer.h"
 #include "tag.h"
 
@@ -1218,7 +1216,9 @@ s_tag * tag_add (const s_tag *a, const s_tag *b, s_tag *dest)
     goto ko;
   }
  ko:
-  errx(1, "cannot add %s to %s",
-       tag_type_to_string(a->type),
-       tag_type_to_string(b->type));
+  err_write_1("tag_add: cannot add ");
+  err_write_1(tag_type_to_string(a->type));
+  err_write_1(" to ");
+  err_puts(tag_type_to_string(b->type));
+  return NULL;
 }
diff --git a/libc3/types.h b/libc3/types.h
index 682962e..894f31e 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -598,6 +598,7 @@ struct env {
   s_error_handler  *error_handler;
   s_facts           facts;
   s_frame          *frame;
+  s_frame           global_frame;
   s_buf             in;
   s_str             module_path;
   s_buf             out;
diff --git a/test/env_test.c b/test/env_test.c
index c84b949..43a6dad 100644
--- a/test/env_test.c
+++ b/test/env_test.c
@@ -66,8 +66,10 @@ TEST_CASE(env_eval_equal_tag)
   env_init(&env, 0, NULL);
   env.frame = frame_init(&frame, env.frame);
   test_context("x = 1");
-  TEST_ASSERT(env_eval_equal_tag(&env, tag_init_1(&x, "x"),
-                                 tag_init_1(&y, "1"), &z));
+  TEST_ASSERT(env_eval_equal_tag(&env, false,
+                                 tag_init_1(&x, "x"),
+                                 tag_init_1(&y, "1"),
+                                 &z));
   TEST_ASSERT(frame_get(&frame, x.data.ident.sym));
   TEST_EQ(compare_tag(&z, &y), 0);
   tag_clean(&z);
@@ -76,8 +78,10 @@ TEST_CASE(env_eval_equal_tag)
   env_init(&env, 0, NULL);
   env.frame = frame_init(&frame, env.frame);
   test_context("x = (1, 2]");
-  TEST_ASSERT(env_eval_equal_tag(&env, tag_init_1(&x, "x"),
-                                 tag_init_1(&y, "[1, 2]"), &z));
+  TEST_ASSERT(env_eval_equal_tag(&env, false,
+                                 tag_init_1(&x, "x"),
+                                 tag_init_1(&y, "[1, 2]"),
+                                 &z));
   TEST_ASSERT(frame_get(&frame, sym_1("x")));
   TEST_EQ(compare_tag(&z, &y), 0);
   tag_clean(&z);
@@ -86,8 +90,10 @@ TEST_CASE(env_eval_equal_tag)
   env_init(&env, 0, NULL);
   env.frame = frame_init(&frame, env.frame);
   test_context("[] = []");
-  TEST_ASSERT(env_eval_equal_tag(&env, tag_1(&x, "[]"),
-                                 tag_1(&y, "[]"), &z));
+  TEST_ASSERT(env_eval_equal_tag(&env, false,
+                                 tag_1(&x, "[]"),
+                                 tag_1(&y, "[]"),
+                                 &z));
   TEST_EQ(compare_tag(&z, &y), 0);
   tag_clean(&z);
   env.frame = frame_clean(&frame);
@@ -95,8 +101,10 @@ TEST_CASE(env_eval_equal_tag)
   env_init(&env, 0, NULL);
   env.frame = frame_init(&frame, env.frame);
   test_context("[a, b] = [1, 2]");
-  TEST_ASSERT(env_eval_equal_tag(&env, tag_1(&x, "[a, b]"),
-                                 tag_1(&y, "[1, 2]"), &z));
+  TEST_ASSERT(env_eval_equal_tag(&env, false,
+                                 tag_1(&x, "[a, b]"),
+                                 tag_1(&y, "[1, 2]"),
+                                 &z));
   TEST_ASSERT(frame_get(&frame, sym_1("a")));
   TEST_ASSERT(frame_get(&frame, sym_1("b")));
   TEST_EQ(compare_tag(&z, &y), 0);
@@ -106,8 +114,10 @@ TEST_CASE(env_eval_equal_tag)
   env_init(&env, 0, NULL);
   env.frame = frame_init(&frame, env.frame);
   test_context("x = [1, 2]");
-  TEST_ASSERT(env_eval_equal_tag(&env, tag_1(&x, "[a | b]"),
-                                 tag_1(&y, "[1, 2]"), &z));
+  TEST_ASSERT(env_eval_equal_tag(&env, false,
+                                 tag_1(&x, "[a | b]"),
+                                 tag_1(&y, "[1, 2]"),
+                                 &z));
   TEST_ASSERT(frame_get(&frame, sym_1("a")));
   TEST_ASSERT(frame_get(&frame, sym_1("b")));
   TEST_EQ(compare_tag(&z, &y), 0);