kc3-lang/kc3

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index af5d265..f9c992b 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -1,10 +1,14 @@
 %{module: C3.Facts.Dump,
   version: 0x0000000000000001,
-  count: 0x0000000000000016}
+  count: 0x0000000000000019}
 {C3, :is_a, :module}
 {C3, :name, "C3"}
 {C3, :path, "c3.facts"}
 {C3, :symbol, C3.+}
+{C3, :symbol, C3.-}
+{C3, :symbol, C3.*}
+{C3, :symbol, C3./}
+{C3, :symbol, C3.first}
 {C3.+, :cfn, cfn :tag "tag_add" (:tag, :tag)}
 {C3.+, :is_a, :operator}
 {C3.+, :operator_precedence, 1}
@@ -21,11 +25,10 @@
 {C3./, :is_a, :operator}
 {C3./, :operator_precedence, 2}
 {C3./, :operator_associativity, :left}
-{C3, :symbol, C3.first}
 {C3.first, :fn, fn {
  ([a | _b]) { a }
  ({a, _b}) { a }
  ({a, _b, _c}) { a }
  ({a, _b, _c, _d}) { a }
 }}
-%{hash: 0x3EE20F4AF01A22E6}
+%{hash: 0xDD25EEBBF3BE6FD3}
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index a74b1e4..7f8fc28 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -312,6 +312,7 @@ sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
   if ((r = buf_parse_cfn_arg_types(buf, &tmp.arg_types)) <= 0)
     goto restore;
   result += r;
+  tmp.arity = list_length(tmp.arg_types);
   *dest = tmp;
   r = result;
   goto clean;
@@ -344,6 +345,7 @@ sw buf_parse_cfn_arg_types (s_buf *buf, s_list **dest)
     if ((r = buf_parse_tag_sym(buf, &(*tail)->tag)) <= 0)
       goto restore;
     result += r;
+    tail = &(*tail)->next.data.list;
     if ((r = buf_ignore_spaces(buf)) < 0)
       goto restore;
     result += r;
diff --git a/libc3/call.c b/libc3/call.c
index 3c62d29..6ec7833 100644
--- a/libc3/call.c
+++ b/libc3/call.c
@@ -35,6 +35,14 @@ s_call * call_copy (const s_call *src, s_call *dest)
   return dest;
 }
 
+s_call * call_init (s_call *call)
+{
+  assert(call);
+  call->cfn = NULL;
+  call->fn = NULL;
+  return call;
+}
+
 s_call * call_init_1 (s_call *call, const s8 *p)
 {
   s_buf buf;
@@ -47,7 +55,7 @@ s_call * call_init_1 (s_call *call, const s8 *p)
 s_call * call_init_op (s_call *call)
 {
   assert(call);
-  bzero(&call->ident, sizeof(s_ident));
+  bzero(call, sizeof(s_call));
   call->arguments = list_new(list_new(NULL));
   return call;
 }
diff --git a/libc3/call.h b/libc3/call.h
index 2966643..cb28cd5 100644
--- a/libc3/call.h
+++ b/libc3/call.h
@@ -17,6 +17,7 @@
 #include "types.h"
 
 void     call_clean (s_call *call);
+s_call * call_init (s_call *call);
 s_call * call_init_1 (s_call *call, const s8 *p);
 s_call * call_init_op (s_call *call);
 s_call * call_copy (const s_call *src, s_call *dest);
diff --git a/libc3/cfn.c b/libc3/cfn.c
index 23b16b4..af7f4da 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -23,7 +23,8 @@ ffi_type * cfn_sym_to_ffi_type (const s_sym *sym);
 s_tag * cfn_tag_init (s_tag *tag, const s_sym *type);
 void * cfn_tag_to_ffi_value (s_tag *tag, const s_sym *type);
 
-s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest) {
+s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
+{
   void **arg_values = NULL;
   s_list *cfn_arg_type;
   sw i;
diff --git a/libc3/cfn.h b/libc3/cfn.h
index cdaab31..2ddf28a 100644
--- a/libc3/cfn.h
+++ b/libc3/cfn.h
@@ -21,6 +21,7 @@ s_cfn * cfn_init (s_cfn *cfn);
 void    cfn_clean (s_cfn *cfn);
 
 /* observers */
+s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest);
 s_cfn * cfn_copy (const s_cfn *cfn, s_cfn *dest);
 
 #endif /* CFN_H */
diff --git a/libc3/env.c b/libc3/env.c
index 00d0600..88eb1d0 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -77,6 +77,7 @@ bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   s_call c;
   s_facts_with_cursor cursor;
   bool result;
+  s_tag tag_cfn;
   s_tag tag_fn;
   s_tag tag_ident;
   s_tag tag_is_a;
@@ -85,12 +86,13 @@ bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   s_tag tag_module_name;
   s_tag tag_sym;
   s_tag tag_symbol;
-  s_tag tag_var_fn;
+  s_tag tag_var;
   assert(env);
   assert(call);
   assert(dest);
   c = *call;
   ident_resolve_module(&c.ident, env);
+  tag_init_1(    &tag_cfn,      ":cfn");
   tag_init_1(    &tag_fn,       ":fn");
   tag_init_ident(&tag_ident, &c.ident);
   tag_init_1(    &tag_is_a,     ":is_a");
@@ -99,22 +101,38 @@ bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   tag_init_sym(  &tag_module_name, c.ident.module_name);
   tag_init_sym(  &tag_sym, call->ident.sym);
   tag_init_1(    &tag_symbol,   ":symbol");
-  tag_init_var(  &tag_var_fn);
+  tag_init_var(  &tag_var);
   facts_with(&env->facts, &cursor, (t_facts_spec) {
       &tag_module_name,
-      &tag_is_a, &tag_module,           /* module exists */
-      &tag_symbol, &tag_ident, NULL,    /* module exports symbol */
-      &tag_ident, &tag_fn, &tag_var_fn,
+      &tag_is_a, &tag_module,     /* module exists */
+      &tag_symbol, &tag_ident,    /* module exports symbol */
       NULL, NULL });
   if (! facts_with_cursor_next(&cursor))
     errx(1, "symbol %s not found in module %s",
          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_fn, &tag_var,
+      NULL, NULL });
+  if (facts_with_cursor_next(&cursor)) {
+    if (tag_var.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.data.fn;
+  }
+  facts_with_cursor_clean(&cursor);
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_ident, &tag_cfn, &tag_var,
+      NULL, NULL });
+  if (facts_with_cursor_next(&cursor)) {
+    if (tag_var.type.type != TAG_CFN)
+      errx(1, "%s.%s is not a C function",
+           c.ident.module_name->str.ptr.ps8,
+           c.ident.sym->str.ptr.ps8);
+    c.cfn = &tag_var.data.cfn;
+  }
   facts_with_cursor_clean(&cursor);
   facts_with(&env->facts, &cursor, (t_facts_spec) {
       &tag_ident, &tag_is_a, &tag_macro, NULL, NULL });
@@ -147,6 +165,36 @@ bool env_eval_call_arguments (s_env *env, s_list *args, s_list **dest)
   return true;
 }
 
+bool env_eval_call_cfn (s_env *env, const s_call *call, s_tag *dest)
+{
+  s_list *args = NULL;
+  s_cfn *cfn;
+  s_frame frame;
+  s_tag tag;
+  assert(env);
+  assert(call);
+  assert(dest);
+  cfn = call->cfn;
+  assert(cfn);
+  frame_init(&frame, env->frame);
+  env->frame = &frame;
+  if (call->arguments) {
+    if (! env_eval_call_arguments(env, call->arguments, &args)) {
+      env->frame = frame_clean(&frame);
+      return false;
+    }
+  }
+  if (! cfn_apply(cfn, args, &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;
+}
+
 bool env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
 {
   s_list *args = NULL;
@@ -157,6 +205,8 @@ bool env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
   assert(env);
   assert(call);
   assert(dest);
+  if (call->cfn)
+    return env_eval_call_cfn(env, call, dest);
   fn = call->fn;
   assert(fn);
   frame_init(&frame, env->frame);
diff --git a/libc3/types.h b/libc3/types.h
index 834a438..d0e95cb 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -276,6 +276,7 @@ struct call {
   s_list *arguments;
   s_list_map *keyword;
   /* value */
+  s_cfn *cfn;
   s_fn *fn;
 };