kc3-lang/kc3

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index 36e61a9..641aaf4 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -1,6 +1,6 @@
 %{module: C3.Facts.Dump,
   version: 0x0000000000000001,
-  count: 0x0000000000000019}
+  count: 0x000000000000001B}
 {C3, :is_a, :module}
 {C3, :name, "C3"}
 {C3, :path, "c3.facts"}
@@ -8,6 +8,7 @@
 {C3, :symbol, C3.-}
 {C3, :symbol, C3.*}
 {C3, :symbol, C3./}
+{C3, :symbol, C3.break}
 {C3, :symbol, C3.first}
 {C3.+, :cfn, cfn :tag "tag_add" (:tag, :tag, :&result)}
 {C3.+, :is_a, :operator}
@@ -25,6 +26,7 @@
 {C3./, :is_a, :operator}
 {C3./, :operator_precedence, 2}
 {C3./, :operator_associativity, :left}
+{C3.break, :cfn, cfn :void "c3_break" ()}
 {C3.first, :fn, fn {
  ((a | _b)) { a }
  ({a, _b}) { a }
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index 2b56ee2..0b8ca3e 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -270,7 +270,7 @@ sw buf_inspect_cfn (s_buf *buf, const s_cfn *cfn)
   sw r;
   sw result = 0;
   assert(cfn);
-  if ((r = buf_inspect_str(buf, &cfn->name)) < 0)
+  if ((r = buf_inspect_str(buf, &cfn->name->str)) < 0)
     return r;
   result += r;
   if ((r = buf_write_1(buf, "(")) < 0)
@@ -299,7 +299,7 @@ sw buf_inspect_cfn_size (const s_cfn *cfn)
   sw r;
   sw result = 0;
   assert(cfn);
-  if ((r = buf_inspect_str_size(&cfn->name)) < 0)
+  if ((r = buf_inspect_str_size(&cfn->name->str)) < 0)
     return r;
   result += r;
   result += strlen("(");
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 835b95f..f5b8fb1 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -45,7 +45,8 @@ sw buf_parse_array (s_buf *buf, s_array *dest)
   if ((r = buf_parse_sym(buf, &type)) <= 0)
     goto restore;
   result += r;
-  tmp.type = sym_to_tag_type(type);
+  if (! sym_to_tag_type(type, &tmp.type))
+    goto restore;
   item_size = tag_type_size(tmp.type);
   item = tag_to_pointer(&tag, type);
   if ((r = buf_ignore_spaces(buf)) < 0)
@@ -473,6 +474,8 @@ sw buf_parse_call_op_rec (s_buf *buf, s_call *dest, u8 min_precedence)
 sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
 {
   s_list *arg_types = NULL;
+  s_str name_str;
+  const s_sym *name_sym;
   sw r;
   sw result = 0;
   const s_sym *result_type;
@@ -493,17 +496,19 @@ sw buf_parse_cfn (s_buf *buf, s_cfn *dest)
   if ((r = buf_ignore_spaces(buf)) <= 0)
     goto restore;
   result += r;
-  if ((r = buf_parse_str(buf, &tmp.name)) <= 0)
+  if ((r = buf_parse_str(buf, &name_str)) <= 0)
     goto restore;
   result += r;
+  if (! (name_sym = str_to_sym(&name_str)))
+    goto restore;
   if ((r = buf_ignore_spaces(buf)) <= 0)
     goto restore;
   result += r;
   if ((r = buf_parse_cfn_arg_types(buf, &arg_types)) <= 0)
     goto restore;
   result += r;
-  tmp.arity = list_length(arg_types);
-  cfn_set_type(&tmp, arg_types, result_type);
+  cfn_init(&tmp, name_sym, arg_types, result_type);
+  cfn_prep_cif(&tmp);
   cfn_link(&tmp);
   *dest = tmp;
   r = result;
diff --git a/libc3/c3.c b/libc3/c3.c
index 9518a8e..a6e7df1 100644
--- a/libc3/c3.c
+++ b/libc3/c3.c
@@ -10,10 +10,19 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
+#include <assert.h>
+#include <err.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include "c3.h"
 
+void c3_break ()
+{
+  assert(! "break");
+  errx(1, "break");
+  exit(1);
+}
+
 void c3_init (s_env *env)
 {
   if (! env)
diff --git a/libc3/c3.h b/libc3/c3.h
index 5182316..bf186f4 100644
--- a/libc3/c3.h
+++ b/libc3/c3.h
@@ -49,7 +49,11 @@
 
 #define C3_EXT ".c3"
 
+/* stack-allocation compatible functions */
 void c3_init (s_env *env);
 void c3_clean (s_env *env);
 
+/* debug */
+void c3_break ();
+
 #endif /* C3_H */
diff --git a/libc3/cfn.c b/libc3/cfn.c
index 84354ad..7ef78a1 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -29,7 +29,7 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
   void **arg_pointers = NULL;
   void **arg_values = NULL;
   u8 arity;
-  s_list *cfn_arg_type;
+  s_list *cfn_arg_types;
   sw i = 0;
   sw num_args;
   void *result;
@@ -54,11 +54,11 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
       err(1, "cfn_apply");
     if (! (arg_values = calloc(sizeof(void *), cfn->arity + 1)))
       err(1, "cfn_apply");
-    cfn_arg_type = cfn->arg_types;
+    cfn_arg_types = cfn->arg_types;
     a = args;
-    while (cfn_arg_type) {
-      assert(cfn_arg_type->tag.type.type == TAG_SYM);
-      if (cfn_arg_type->tag.data.sym == sym_1("&result"))
+    while (cfn_arg_types) {
+      assert(cfn_arg_types->tag.type.type == TAG_SYM);
+      if (cfn_arg_types->tag.data.sym == sym_1("&result"))
         if (cfn->cif.rtype == &ffi_type_pointer) {
           arg_pointers[i] = tag_to_pointer(&tmp2, cfn->result_type);
           arg_values[i] = &arg_pointers[i];
@@ -68,15 +68,15 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
       else {
         if (cfn->cif.arg_types[i] == &ffi_type_pointer) {
           arg_pointers[i] = tag_to_pointer(&a->tag,
-                                           cfn_arg_type->tag.data.sym);
+                                           cfn_arg_types->tag.data.sym);
           arg_values[i] = &arg_pointers[i];
         }
         else
           arg_values[i] = tag_to_pointer(&a->tag,
-                                         cfn_arg_type->tag.data.sym);
+                                         cfn_arg_types->tag.data.sym);
         a = list_next(a);
       }
-      cfn_arg_type = list_next(cfn_arg_type);
+      cfn_arg_types = list_next(cfn_arg_types);
       i++;
     }
   }
@@ -101,7 +101,6 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
 void cfn_clean (s_cfn *cfn)
 {
   assert(cfn);
-  str_clean(&cfn->name);
   list_delete_all(cfn->arg_types);
   if (cfn->cif.nargs)
     free(cfn->cif.arg_types);
@@ -111,7 +110,7 @@ s_cfn * cfn_copy (const s_cfn *cfn, s_cfn *dest)
 {
   assert(cfn);
   assert(dest);
-  str_copy(&cfn->name, &dest->name);
+  dest->name = cfn->name;
   dest->arg_result = cfn->arg_result;
   list_copy(cfn->arg_types, &dest->arg_types);
   dest->arity = cfn->arity;
@@ -124,46 +123,56 @@ s_cfn * cfn_copy (const s_cfn *cfn, s_cfn *dest)
   return dest;
 }
 
-s_cfn * cfn_init (s_cfn *cfn)
+s_cfn * cfn_init (s_cfn *cfn, const s_sym *name, s_list *arg_types,
+                  const s_sym *result_type)
 {
+  sw arity;
   assert(cfn);
   bzero(cfn, sizeof(s_cfn));
+  cfn->name = name;
+  cfn->arg_types = arg_types;
+  arity = list_length(arg_types);
+  if (arity > 255) {
+    assert(arity <= 255);
+    errx(1, "cfn_init: arity > 255");
+    return NULL;
+  }
+  cfn->arity = arity;
+  cfn->result_type = result_type;
   return cfn;
 }
 
 s_cfn * cfn_link (s_cfn *cfn)
 {
   assert(cfn);
-  if (! (cfn->ptr.p = dlsym(RTLD_DEFAULT, cfn->name.ptr.ps8)))
-    warnx("cfn_link: %s: %s", cfn->name.ptr.ps8, dlerror());
+  if (! (cfn->ptr.p = dlsym(RTLD_DEFAULT, cfn->name->str.ptr.ps8)))
+    warnx("cfn_link: %s: %s", cfn->name->str.ptr.ps8, dlerror());
   return cfn;
 }
 
-s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_type,
-                      const s_sym *result_type)
+s_cfn * cfn_prep_cif (s_cfn *cfn)
 {
   s_list *a;
   ffi_type **arg_ffi_type = NULL;
-  sw arity;
   u8 i = 0;
   ffi_type *result_ffi_type;
   ffi_status status;
   assert(cfn);
-  if (! (result_ffi_type = sym_to_ffi_type(result_type, NULL)))
+  if (! (result_ffi_type = sym_to_ffi_type(cfn->result_type, NULL))) {
+    assert(! "cfn_prep_cif: sym_to_ffi_type");
+    errx(1, "cfn_prep_cif: sym_to_ffi_type: %s",
+         cfn->result_type->str.ptr.ps8);
     return NULL;
-  if ((arity = list_length(arg_type))) {
-    if (arity > 255) {
-      assert(arity <= 255);
-      errx(1, "cfn_set_arg_types: arity > 255");
-    }
-    if (! (arg_ffi_type = calloc(sizeof(ffi_type *), arity + 1)))
-      err(1, "cfn_set_arg_types");
-    a = arg_type;
+  }
+  if (cfn->arity) {
+    if (! (arg_ffi_type = calloc(sizeof(ffi_type *), cfn->arity + 1)))
+      err(1, "cfn_prep_cif");
+    a = cfn->arg_types;
     while (a) {
-      assert(i < arity);
+      assert(i < cfn->arity);
       if (a->tag.type.type != TAG_SYM) {
-        assert(! "cfn_set_type: invalid type");
-        errx(1, "cfn_set_type: invalid type");
+        assert(! "cfn_prep_cif: invalid type");
+        errx(1, "cfn_prep_cif: invalid type");
       }
       if (! (arg_ffi_type[i] = sym_to_ffi_type(a->tag.data.sym, result_ffi_type))) {
         free(arg_ffi_type);
@@ -175,21 +184,18 @@ s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_type,
       a = list_next(a);
     }
   }
-  cfn->arg_types = arg_type;
-  cfn->arity = arity;
-  cfn->result_type = result_type;
   status = ffi_prep_cif(&cfn->cif, FFI_DEFAULT_ABI, cfn->arity,
                         result_ffi_type, arg_ffi_type);
   if (status == FFI_BAD_TYPEDEF) {
-    warnx("cfn_set_type: ffi_prep_cif: FFI_BAD_TYPEDEF");
+    warnx("cfn_prep_cif: ffi_prep_cif: FFI_BAD_TYPEDEF");
     return NULL;
   }
   if (status == FFI_BAD_ABI) {
-    warnx("cfn_set_type: ffi_prep_cif: FFI_BAD_ABI");
+    warnx("cfn_prep_cif: ffi_prep_cif: FFI_BAD_ABI");
     return NULL;
   }
   if (status != FFI_OK) {
-    warnx("cfn_set_type: ffi_prep_cif: unknown error");
+    warnx("cfn_prep_cif: ffi_prep_cif: unknown error");
     return NULL;
   }
   return cfn;
@@ -199,6 +205,10 @@ s_tag * cfn_tag_init (s_tag *tag, const s_sym *type)
 {
   assert(tag);
   bzero(tag, sizeof(s_tag));
-  tag->type.type = sym_to_tag_type(type);
+  if (! sym_to_tag_type(type, &tag->type.type)) {
+    assert(! "cfn_tag_init: invalid type");
+    errx(1, "cfn_tag_init: invalid type: %s", type->str.ptr.ps8);
+    return NULL;
+  }
   return tag;
 }
diff --git a/libc3/cfn.h b/libc3/cfn.h
index e756a61..ce790f2 100644
--- a/libc3/cfn.h
+++ b/libc3/cfn.h
@@ -16,7 +16,8 @@
 #include "types.h"
 
 /* stack-allocation compatible functions */
-s_cfn * cfn_init (s_cfn *cfn);
+s_cfn * cfn_init (s_cfn *cfn, const s_sym *name, s_list *arg_types,
+                  const s_sym *result_type);
 void    cfn_clean (s_cfn *cfn);
 
 /* observers */
@@ -25,7 +26,6 @@ s_cfn * cfn_copy (const s_cfn *cfn, s_cfn *dest);
 
 /* modifiers */
 s_cfn * cfn_link (s_cfn *cfn);
-s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_types,
-                      const s_sym *result_type);
+s_cfn * cfn_prep_cif (s_cfn *cfn);
 
 #endif /* CFN_H */
diff --git a/libc3/compare.c b/libc3/compare.c
index 9b8d161..03b4dfc 100644
--- a/libc3/compare.c
+++ b/libc3/compare.c
@@ -86,7 +86,7 @@ s8 compare_cfn (const s_cfn *a, const s_cfn *b)
     return -1;
   if (!b)
     return 1;
-  if ((r = compare_str(&a->name, &b->name)))
+  if ((r = compare_sym(a->name, b->name)))
     return r;
   return compare_list(a->arg_types, b->arg_types);
 }
diff --git a/libc3/hash.c b/libc3/hash.c
index 988a600..767fe74 100644
--- a/libc3/hash.c
+++ b/libc3/hash.c
@@ -114,7 +114,7 @@ void hash_update_cfn (t_hash *hash, const s_cfn *cfn)
   assert(hash);
   assert(cfn);
   hash_update(hash, type, sizeof(type));
-  hash_update_str(hash, &cfn->name);
+  hash_update_sym(hash, cfn->name);
   hash_update_list(hash, cfn->arg_types);
 }
 
diff --git a/libc3/sym.c b/libc3/sym.c
index 72fcd76..620a874 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -177,63 +177,117 @@ ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
   return NULL;
 }
 
-e_tag_type sym_to_tag_type (const s_sym *sym)
+bool sym_to_tag_type (const s_sym *sym, e_tag_type *dest)
 {
-  if (sym == sym_1("void"))
-    return TAG_VOID;
-  if (sym == sym_1("bool"))
-    return TAG_BOOL;
-  if (sym == sym_1("call"))
-    return TAG_CALL;
-  if (sym == sym_1("call_fn"))
-    return TAG_CALL_FN;
-  if (sym == sym_1("call_macro"))
-    return TAG_CALL_MACRO;
-  if (sym == sym_1("cfn"))
-    return TAG_CFN;
-  if (sym == sym_1("character"))
-    return TAG_CHARACTER;
-  if (sym == sym_1("f32"))
-    return TAG_F32;
-  if (sym == sym_1("f64"))
-    return TAG_F64;
-  if (sym == sym_1("fn"))
-    return TAG_FN;
-  if (sym == sym_1("ident"))
-    return TAG_IDENT;
-  if (sym == sym_1("integer"))
-    return TAG_INTEGER;
-  if (sym == sym_1("s64"))
-    return TAG_S64;
-  if (sym == sym_1("s32"))
-    return TAG_S32;
-  if (sym == sym_1("s16"))
-    return TAG_S16;
-  if (sym == sym_1("s8"))
-    return TAG_S8;
-  if (sym == sym_1("u8"))
-    return TAG_U8;
-  if (sym == sym_1("u16"))
-    return TAG_U16;
-  if (sym == sym_1("u32"))
-    return TAG_U32;
-  if (sym == sym_1("u64"))
-    return TAG_U64;
-  if (sym == sym_1("list"))
-    return TAG_LIST;
-  if (sym == sym_1("ptag"))
-    return TAG_PTAG;
-  if (sym == sym_1("quote"))
-    return TAG_QUOTE;
-  if (sym == sym_1("str"))
-    return TAG_STR;
-  if (sym == sym_1("sym"))
-    return TAG_SYM;
-  if (sym == sym_1("tag"))
-    return TAG_VOID;
-  if (sym == sym_1("tuple"))
-    return TAG_TUPLE;
+  if (sym == sym_1("void")) {
+    *dest = TAG_VOID;
+    return true;
+  }
+  if (sym == sym_1("bool")) {
+    *dest = TAG_BOOL;
+    return true;
+  }
+  if (sym == sym_1("call")) {
+    *dest = TAG_CALL;
+    return true;
+  }
+  if (sym == sym_1("call_fn")) {
+    *dest = TAG_CALL_FN;
+    return true;
+  }
+  if (sym == sym_1("call_macro")) {
+    *dest = TAG_CALL_MACRO;
+    return true;
+  }
+  if (sym == sym_1("cfn")) {
+    *dest = TAG_CFN;
+    return true;
+  }
+  if (sym == sym_1("character")) {
+    *dest = TAG_CHARACTER;
+    return true;
+  }
+  if (sym == sym_1("f32")) {
+    *dest = TAG_F32;
+    return true;
+  }
+  if (sym == sym_1("f64")) {
+    *dest = TAG_F64;
+    return true;
+  }
+  if (sym == sym_1("fn")) {
+    *dest = TAG_FN;
+    return true;
+  }
+  if (sym == sym_1("ident")) {
+    *dest = TAG_IDENT;
+    return true;
+  }
+  if (sym == sym_1("integer")) {
+    *dest = TAG_INTEGER;
+    return true;
+  }
+  if (sym == sym_1("s64")) {
+    *dest = TAG_S64;
+    return true;
+  }
+  if (sym == sym_1("s32")) {
+    *dest = TAG_S32;
+    return true;
+  }
+  if (sym == sym_1("s16")) {
+    *dest = TAG_S16;
+    return true;
+  }
+  if (sym == sym_1("s8")) {
+    *dest = TAG_S8;
+    return true;
+  }
+  if (sym == sym_1("u8")) {
+    *dest = TAG_U8;
+    return true;
+  }
+  if (sym == sym_1("u16")) {
+    *dest = TAG_U16;
+    return true;
+  }
+  if (sym == sym_1("u32")) {
+    *dest = TAG_U32;
+    return true;
+  }
+  if (sym == sym_1("u64")) {
+    *dest = TAG_U64;
+    return true;
+  }
+  if (sym == sym_1("list")) {
+    *dest = TAG_LIST;
+    return true;
+  }
+  if (sym == sym_1("ptag")) {
+    *dest = TAG_PTAG;
+    return true;
+  }
+  if (sym == sym_1("quote")) {
+    *dest = TAG_QUOTE;
+    return true;
+  }
+  if (sym == sym_1("str")) {
+    *dest = TAG_STR;
+    return true;
+  }
+  if (sym == sym_1("sym")) {
+    *dest = TAG_SYM;
+    return true;
+  }
+  if (sym == sym_1("tag")) {
+    *dest = TAG_VOID;
+    return true;
+  }
+  if (sym == sym_1("tuple")) {
+    *dest = TAG_TUPLE;
+    return true;
+  }
   assert(! "sym_to_tag_type: unknown type");
   errx(1, "sym_to_tag_type: unknown type: %s", sym->str.ptr.ps8);
-  return -1;
+  return false;
 }
diff --git a/libc3/sym.h b/libc3/sym.h
index 59e9f61..2747721 100644
--- a/libc3/sym.h
+++ b/libc3/sym.h
@@ -49,6 +49,6 @@ e_bool sym_is_module (const s_sym *sym);
 const s_sym * sym_new (const s_str *src);
 
 ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type);
-e_tag_type sym_to_tag_type (const s_sym *sym);
+bool       sym_to_tag_type (const s_sym *sym, e_tag_type *dest);
 
 #endif /* SYM_H */
diff --git a/libc3/types.h b/libc3/types.h
index 89dd58c..f7cb963 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -302,7 +302,7 @@ struct call {
 };
 
 struct cfn {
-  s_str name;
+  const s_sym *name;
   union {
     void (*f) (void);
     void *p;
diff --git a/test/cfn_test.c b/test/cfn_test.c
new file mode 100644
index 0000000..e66df12
--- /dev/null
+++ b/test/cfn_test.c
@@ -0,0 +1,62 @@
+/* c3
+ * Copyright 2022,2023 kmx.io <contact@kmx.io>
+ *
+ * Permission is hereby granted to use this software granted the above
+ * copyright notice and this permission paragraph are included in all
+ * copies and substantial portions of this software.
+ *
+ * THIS SOFTWARE IS PROVIDED "AS-IS" WITHOUT ANY GUARANTEE OF
+ * PURPOSE AND PERFORMANCE. IN NO EVENT WHATSOEVER SHALL THE
+ * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
+ * THIS SOFTWARE.
+ */
+#include <string.h>
+#include "../libc3/cfn.h"
+#include "test.h"
+
+void cfn_test ();
+void cfn_test_init_clean ();
+void cfn_test_apply ();
+void cfn_test_copy ();
+void cfn_test_link ();
+void cfn_test_set_type ();
+
+void cfn_test ()
+{
+  cfn_test_init_clean();
+  cfn_test_apply();
+  cfn_test_copy();
+  cfn_test_link();
+  cfn_test_set_type();
+}
+
+void cfn_test_init_clean ()
+{
+  s_cfn tmp;
+  TEST_EQ(cfn_init(&tmp), &tmp);
+  cfn_clean(&tmp);
+  test_ok();
+}
+
+void cfn_test_apply ()
+{
+  s_cfn tmp;
+  cfn_init(&tmp);
+  cfn_clean(&tmp);
+}
+
+void cfn_test_copy ()
+{
+  s_cfn a;
+  s_cfn b;
+  cfn_init(&a);
+  cfn_clean(&a);
+}
+
+void cfn_test_link ()
+{
+}
+
+void cfn_test_set_type ()
+{
+}