Commit e7f8646fc91fdc32e5c9f89d2adcf7901b7ac48e

Thomas de Grivel 2023-02-10T10:28:47

fn wip

diff --git a/lib/c3.facts b/lib/c3.facts
index eef3ffb..8359316 100644
--- a/lib/c3.facts
+++ b/lib/c3.facts
@@ -1,7 +1,9 @@
 %{module: C3.Facts.Dump,
   version: 0x0000000000000001,
-  count: 0x0000000000000003}
+  count: 0x0000000000000005}
 {C3, :is-a, :module}
 {C3, :name, "C3"}
 {C3, :path, "c3.facts"}
-%{hash: 0x895f440de1b5a7f5}
+{C3, :function, C3.first}
+{C3.first, :fn, :fn}
+%{hash: 0x55B52EDF4CF3E808}
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index c646723..5e23b9e 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -437,9 +437,9 @@ sw buf_parse_fn (s_buf *buf, s_fn *dest)
     goto restore;
   result += r;
   fn_init(dest);
-  if ((r = buf_parse_fn_args(buf, &dest->args)) < 0)
+  if ((r = buf_parse_fn_pattern(buf, &dest->pattern)) < 0)
     goto restore;
-  dest->arity = arg_length(dest->args);
+  dest->arity = list_length(dest->pattern);
   result += r;
   if ((r = buf_ignore_spaces(buf)) < 0)
     goto restore;
@@ -471,9 +471,6 @@ sw buf_parse_fn_algo (s_buf *buf, s_list **dest)
   result += r;
   while ((r = buf_parse_tag(buf, &tag)) > 0) {
     result += r;
-    if (tag.type.type == TAG_IDENT &&
-        tag.data.ident.sym == sym_1(";"))
-      break;
     *dest = list_new(NULL);
     (*dest)->tag = tag;
     tag_init_list(&(*dest)->next, NULL);
@@ -482,9 +479,14 @@ sw buf_parse_fn_algo (s_buf *buf, s_list **dest)
       goto restore;
     if ((r = buf_read_1(buf, ";")) < 0)
       goto restore;
+    if ((r = buf_ignore_spaces(buf)) < 0)
+      goto restore;
   }
   if (r < 0)
     goto restore;
+  if ((r = buf_read_1(buf, "}")) <= 0)
+    goto restore;
+  result += r;
   r = result;
   goto clean;
  restore:
@@ -494,12 +496,12 @@ sw buf_parse_fn_algo (s_buf *buf, s_list **dest)
   return r;
 }
 
-sw buf_parse_fn_args (s_buf *buf, s_arg **dest)
+sw buf_parse_fn_pattern (s_buf *buf, s_list **dest)
 {
   sw r;
   sw result = 0;
   s_buf_save save;
-  const s_sym *sym;
+  s_tag tag;
   assert(buf);
   assert(dest);
   buf_save_init(buf, &save);
@@ -509,29 +511,30 @@ sw buf_parse_fn_args (s_buf *buf, s_arg **dest)
   if ((r = buf_ignore_spaces(buf)) < 0)
     goto restore;
   result += r;
-  r = 0;
-  while (! r) {
-    if ((r = buf_parse_sym(buf, &sym)) <= 0)
+  while (1) {
+    if ((r = buf_parse_tag(buf, &tag)) <= 0)
       goto restore;
     result += r;
-    *dest = arg_new();
-    (*dest)->name = sym;
-    dest = &(*dest)->next;
+    *dest = list_new(NULL);
+    (*dest)->tag = tag;
+    tag_init_list(&(*dest)->next, NULL);
+    dest = &(*dest)->next.data.list;
     if ((r = buf_ignore_spaces(buf)) < 0)
       goto restore;
     result += r;
     if ((r = buf_read_1(buf, ",")) < 0)
       goto restore;
     result += r;
-    if (r > 0) {
-      if ((r = buf_ignore_spaces(buf)) < 0)
+    if (! r) {
+      if ((r = buf_read_1(buf, ")")) < 0)
         goto restore;
       result += r;
-      continue;
+      break;
     }
-    if ((r = buf_read_1(buf, ")")) < 0)
+    if ((r = buf_ignore_spaces(buf)) < 0)
       goto restore;
     result += r;
+    continue;
   }
   r = result;
   goto clean;
@@ -546,7 +549,7 @@ sw buf_parse_ident (s_buf *buf, s_ident *dest)
 {
   character c;
   sw csize;
-  const s_sym *module_name;
+  const s_sym *module_name = NULL;
   sw r;
   sw result = 0;
   s_buf_save save;
diff --git a/libc3/buf_parse.h b/libc3/buf_parse.h
index 6286201..b659357 100644
--- a/libc3/buf_parse.h
+++ b/libc3/buf_parse.h
@@ -42,7 +42,7 @@ sw buf_parse_f64 (s_buf *buf, f64 *dest);
 sw buf_parse_fact (s_buf *buf, s_fact_w *dest);
 sw buf_parse_fn (s_buf *buf, s_fn *dest);
 sw buf_parse_fn_algo (s_buf *buf, s_list **dest);
-sw buf_parse_fn_args (s_buf *buf, s_arg **dest);
+sw buf_parse_fn_pattern (s_buf *buf, s_list **dest);
 sw buf_parse_call (s_buf *buf, s_call *dest);
 sw buf_parse_call_args_paren (s_buf *buf, s_call *dest);
 sw buf_parse_comments (s_buf *buf);
diff --git a/libc3/env.c b/libc3/env.c
index 97b2866..6f61e11 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -76,33 +76,43 @@ s_tag * env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   s_facts_with_cursor cursor;
   s_tag *result;
   s_tag tag_fn;
+  s_tag tag_function;
   s_tag tag_ident;
   s_tag tag_is_a;
   s_tag tag_macro;
   s_tag tag_module;
   s_tag tag_module_name;
   s_tag tag_sym;
+  s_tag tag_var_fn;
   assert(env);
   assert(call);
   assert(dest);
   call_copy(call, &c);
   ident_resolve_module(&c.ident, env);
   tag_init_ident(&tag_ident, &c.ident);
-  tag_init_1(    &tag_is_a,   ":is-a");
-  tag_init_1(    &tag_macro,  ":macro");
-  tag_init_1(    &tag_module, ":module");
+  tag_init_1(    &tag_fn,       ":fn");
+  tag_init_1(    &tag_function, ":function");
+  tag_init_1(    &tag_is_a,     ":is-a");
+  tag_init_1(    &tag_macro,    ":macro");
+  tag_init_1(    &tag_module,   ":module");
   tag_init_sym(  &tag_module_name, c.ident.module_name);
   tag_init_sym(  &tag_sym, call->ident.sym);
+  tag_init_var(  &tag_var_fn);
   facts_with(&env->facts, &cursor, (t_facts_spec) {
       &tag_module_name,
       &tag_is_a, &tag_module,       /* module exists */
-      &tag_sym, &tag_ident, NULL,   /* module exports symbol */
-      &tag_ident, &tag_fn,          /* function */
+      &tag_function, &tag_ident, NULL,   /* module exports symbol */
+      &tag_ident, &tag_fn, &tag_var_fn,
       NULL, NULL });
   if (! facts_with_cursor_next(&cursor))
     errx(1, "symbol %s not found in module %s",
-         call->ident.sym->str.ptr.ps8,
-         call->ident.module_name->str.ptr.ps8);
+         c.ident.sym->str.ptr.ps8,
+         c.ident.module_name->str.ptr.ps8);
+  if (tag_var_fn.type.type != TAG_FN)
+    errx(1, "%s.%s is not a function",
+         c.ident.module_name->str.ptr.ps8,
+         c.ident.sym->str.ptr.ps8);
+  c.fn = &tag_var_fn.data.fn;
   facts_with_cursor_clean(&cursor);
   facts_with(&env->facts, &cursor, (t_facts_spec) {
       &tag_ident, &tag_is_a, &tag_macro, NULL, NULL });
diff --git a/libc3/facts.c b/libc3/facts.c
index 25df55c..70d16a9 100644
--- a/libc3/facts.c
+++ b/libc3/facts.c
@@ -262,7 +262,7 @@ sw facts_load (s_facts *facts, s_buf *buf)
     buf_inspect_u64_hex(&tmp, hash_u64);
     buf_write_s8(&tmp, 0);
     warnx("facts_load: invalid hash line %lu: 0x%s",
-          (unsigned long) i + 3,
+          (unsigned long) i + 4,
           tmp.ptr.ps8);
     return -1;
   }
@@ -272,11 +272,11 @@ sw facts_load (s_facts *facts, s_buf *buf)
   return -1;
  ko_fact:
   warnx("facts_load: %s fact line %lu", r ? "invalid" : "missing",
-        (unsigned long) i + 3);
+        (unsigned long) i + 4);
   return -1;
  ko_hash:
   warnx("facts_load: %s hash line %lu", r ? "invalid" : "missing",
-        (unsigned long) i + 3);
+        (unsigned long) i + 4);
   return -1;
 }
 
diff --git a/libc3/fn.c b/libc3/fn.c
index 9a6904e..2926e23 100644
--- a/libc3/fn.c
+++ b/libc3/fn.c
@@ -21,8 +21,7 @@
 void fn_clean (s_fn *fn)
 {
   assert(fn);
-  arg_delete_all(fn->args);
-  binding_delete_all(fn->bindings);
+  list_delete_all(fn->pattern);
   list_delete_all(fn->algo);
 }
 
diff --git a/libc3/types.h b/libc3/types.h
index 899be4e..5522e61 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -158,8 +158,7 @@ struct frame {
 
 struct fn {
   uw arity;
-  s_arg *args;
-  s_binding *bindings;
+  s_list *pattern;
   s_list *algo;
 };
 
diff --git a/test/ic3/call.in b/test/ic3/call.in
index ef69966..35e8a5a 100644
--- a/test/ic3/call.in
+++ b/test/ic3/call.in
@@ -8,4 +8,4 @@ quote Test.test(1, 2)
 quote Test.test(1, 2, 3)
 
 first([1, 2])
-Kernel.first([1, 2])
+C3.first([1, 2])
diff --git a/test/ic3/fn.err.expected b/test/ic3/fn.err.expected
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/test/ic3/fn.err.expected
diff --git a/test/ic3/fn.in b/test/ic3/fn.in
new file mode 100644
index 0000000..d2c618b
--- /dev/null
+++ b/test/ic3/fn.in
@@ -0,0 +1,3 @@
+fn (x) { x }
+fn (x, _y) { x }
+fn ([x | _y]) { x }
diff --git a/test/ic3/fn.out.expected b/test/ic3/fn.out.expected
new file mode 100644
index 0000000..3f20c4b
--- /dev/null
+++ b/test/ic3/fn.out.expected
@@ -0,0 +1,3 @@
+fn ...
+fn ...
+fn ...
diff --git a/test/ic3/fn.ret.expected b/test/ic3/fn.ret.expected
new file mode 100644
index 0000000..573541a
--- /dev/null
+++ b/test/ic3/fn.ret.expected
@@ -0,0 +1 @@
+0
diff --git a/test/ic3/function_call.err.expected b/test/ic3/function_call.err.expected
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/test/ic3/function_call.err.expected
diff --git a/test/ic3/function_call.out.expected b/test/ic3/function_call.out.expected
new file mode 100644
index 0000000..004a0c4
--- /dev/null
+++ b/test/ic3/function_call.out.expected
@@ -0,0 +1,10 @@
+fn {...}
+
+8
+16
+8
+16
+16000
+32000
+16000
+32000
diff --git a/test/ic3/function_call.ret.expected b/test/ic3/function_call.ret.expected
new file mode 100644
index 0000000..573541a
--- /dev/null
+++ b/test/ic3/function_call.ret.expected
@@ -0,0 +1 @@
+0