kc3-lang/kc3

diff --git a/lib/c3/0.1/integer.facts b/lib/c3/0.1/integer.facts
index c149de8..ff8d8e7 100644
--- a/lib/c3/0.1/integer.facts
+++ b/lib/c3/0.1/integer.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {Integer, :is_a, :module}
-add {Integer, :symbol, Integer.cast}
-replace {Integer.cast, :cfn, cfn :integer "integer_cast" (:tag, :&result)}
+replace {Integer, :is_a, :module}
+replace {Integer, :symbol, Integer.cast}
+replace {Integer.cast, :cfn, cfn Integer "integer_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/s16.facts b/lib/c3/0.1/s16.facts
index d343ddd..2a202d1 100644
--- a/lib/c3/0.1/s16.facts
+++ b/lib/c3/0.1/s16.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {S16, :is_a, :module}
-add {S16, :symbol, S16.cast}
-replace {S16.cast, :cfn, cfn :s16 "s16_cast" (:tag)}
+replace {S16, :is_a, :module}
+replace {S16, :symbol, S16.cast}
+replace {S16.cast, :cfn, cfn S16 "s16_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/s32.facts b/lib/c3/0.1/s32.facts
index 1ffcd84..fcbce6e 100644
--- a/lib/c3/0.1/s32.facts
+++ b/lib/c3/0.1/s32.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {S32, :is_a, :module}
-add {S32, :symbol, S32.cast}
-replace {S32.cast, :cfn, cfn :s32 "s32_cast" (:tag)}
+replace {S32, :is_a, :module}
+replace {S32, :symbol, S32.cast}
+replace {S32.cast, :cfn, cfn S32 "s32_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/s64.facts b/lib/c3/0.1/s64.facts
index 7ad5bd7..0e39a05 100644
--- a/lib/c3/0.1/s64.facts
+++ b/lib/c3/0.1/s64.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {S64, :is_a, :module}
-add {S64, :symbol, S64.cast}
-replace {S64.cast, :cfn, cfn :s64 "s64_cast" (:tag)}
+replace {S64, :is_a, :module}
+replace {S64, :symbol, S64.cast}
+replace {S64.cast, :cfn, cfn S64 "s64_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/s8.facts b/lib/c3/0.1/s8.facts
index 86d97b2..746d7ff 100644
--- a/lib/c3/0.1/s8.facts
+++ b/lib/c3/0.1/s8.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {S8, :is_a, :module}
-add {S8, :symbol, S8.cast}
-replace {S8.cast, :cfn, cfn :s8 "s8_cast" (:tag)}
+replace {S8, :is_a, :module}
+replace {S8, :symbol, S8.cast}
+replace {S8.cast, :cfn, cfn S8 "s8_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/sw.facts b/lib/c3/0.1/sw.facts
index 943c169..f9ec974 100644
--- a/lib/c3/0.1/sw.facts
+++ b/lib/c3/0.1/sw.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {Sw, :is_a, :module}
-add {Sw, :symbol, Sw.cast}
-replace {Sw.cast, :cfn, cfn :sw "sw_cast" (:tag)}
+replace {Sw, :is_a, :module}
+replace {Sw, :symbol, Sw.cast}
+replace {Sw.cast, :cfn, cfn Sw "sw_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/u16.facts b/lib/c3/0.1/u16.facts
index 0bff34a..ee7d50c 100644
--- a/lib/c3/0.1/u16.facts
+++ b/lib/c3/0.1/u16.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {U16, :is_a, :module}
-add {U16, :symbol, U16.cast}
-replace {U16.cast, :cfn, cfn :u16 "u16_cast" (:tag)}
+replace {U16, :is_a, :module}
+replace {U16, :symbol, U16.cast}
+replace {U16.cast, :cfn, cfn U16 "u16_cast" (Tag, Result)}
diff --git a/lib/c3/0.1/u8.facts b/lib/c3/0.1/u8.facts
index e86c023..39e73d0 100644
--- a/lib/c3/0.1/u8.facts
+++ b/lib/c3/0.1/u8.facts
@@ -1,5 +1,5 @@
 %{module: C3.Facts.Dump,
   version: 1}
-add {U8, :is_a, :module}
-add {U8, :symbol, U8.cast}
-replace {U8.cast, :cfn, cfn :u8 "u8_cast" (:tag)}
+replace {U8, :is_a, :module}
+replace {U8, :symbol, U8.cast}
+replace {U8.cast, :cfn, cfn U8 "u8_cast" (Tag, Result)}
diff --git a/libc3/array.c b/libc3/array.c
index d2921d2..c7f5521 100644
--- a/libc3/array.c
+++ b/libc3/array.c
@@ -66,7 +66,7 @@ void array_clean (s_array *a)
     tag.type = array_type_to_tag_type(a->type);
     i = 0;
     while (i < a->count) {
-      data_tag = tag_to_pointer(&tag, tag.type);
+      data_tag = tag_to_pointer(&tag, a->type);
       memcpy(data_tag, data, size);
       tag_clean(&tag);
       data += size;
@@ -184,8 +184,7 @@ s_tag * array_data_tag (s_tag *a, const s_tag *address, s_tag *dest)
                            address->data.array.data))) {
     tag_init(dest);
     copy = array_type_to_copy(a->data.array.type);
-    dest->type = array_type_to_tag_type(a->data.array.type);
-    dest_data = tag_to_pointer(dest, dest->type);
+    dest_data = tag_to_pointer(dest, a->data.array.type);
     if (copy(a_data, dest_data) != dest_data)
       return NULL;
     return dest;
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index aee8cb5..e874407 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -1240,7 +1240,7 @@ sw buf_inspect_ptr (s_buf *buf, const s_ptr *ptr)
   if ((r = buf_write_1(buf, "(")) < 0)
     return r;
   result += r;
-  if ((r = buf_inspect_sym(buf, tag_type_to_sym(ptr->type))) < 0)
+  if ((r = buf_inspect_sym(buf, ptr->type)) < 0)
     return r;
   result += r;
   if ((r = buf_write_1(buf, " *) ")) < 0)
@@ -1258,7 +1258,7 @@ sw buf_inspect_ptr_size (const s_ptr *ptr)
   sw result = 0;
   (void) ptr;
   result += strlen("(");
-  if ((r = buf_inspect_sym_size(tag_type_to_sym(ptr->type))) < 0)
+  if ((r = buf_inspect_sym_size(ptr->type)) < 0)
     return r;
   result += r;
   result += strlen(" *) ");
diff --git a/libc3/cfn.c b/libc3/cfn.c
index d9b87a3..850bdc2 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -20,6 +20,7 @@
 #include "str.h"
 #include "sym.h"
 #include "tag.h"
+#include "type.h"
 
 s_tag * cfn_tag_init (s_tag *tag, const s_sym *type);
 
@@ -44,8 +45,10 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
           arity, num_args);
     return NULL;
   }
-  if (cfn->arg_result)
+  if (cfn->arg_result) {
     cfn_tag_init(&tmp2, cfn->result_type);
+    cfn->result_type = type_pointer(cfn->result_type);
+  }
   cfn_tag_init(&tmp, cfn->result_type);
   /* make result point to tmp value */
   result = tag_to_ffi_pointer(&tmp, cfn->result_type);
@@ -237,6 +240,7 @@ s_cfn * cfn_prep_cif (s_cfn *cfn)
 s_tag * cfn_tag_init (s_tag *tag, const s_sym *type)
 {
   assert(tag);
+  assert(type);
   bzero(tag, sizeof(s_tag));
   if (! sym_to_tag_type(type, &tag->type)) {
     assert(! "cfn_tag_init: invalid type");
diff --git a/libc3/env.c b/libc3/env.c
index 5dcc4db..13bb540 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -142,7 +142,6 @@ bool env_eval_array_cast (s_env *env, s_array *array, const s_tag *tag,
 {
   s_call call;
   s_tag tag_eval;
-  e_tag_type tag_type;
   void *data_eval;
   assert(env);
   assert(array);
@@ -155,8 +154,7 @@ bool env_eval_array_cast (s_env *env, s_array *array, const s_tag *tag,
     call_clean(&call);
     return false;
   }
-  tag_type = array_type_to_tag_type(array->type);
-  data_eval = tag_to_pointer(&tag_eval, tag_type);
+  data_eval = tag_to_pointer(&tag_eval, array->type);
   memcpy(data, data_eval, size);
   call_clean(&call);
   return true;
diff --git a/libc3/list.c b/libc3/list.c
index e98b2c9..7677e9e 100644
--- a/libc3/list.c
+++ b/libc3/list.c
@@ -190,7 +190,7 @@ s_array * list_to_array (s_list *list, const s_sym *type,
   copy = array_type_to_copy(type);
   l = list;
   while (l) {
-    data_list = tag_to_pointer(&l->tag, array_type_to_tag_type(type));
+    data_list = tag_to_pointer(&l->tag, type);
     copy(data_list, data);
     data += size;
     l = list_next(l);
diff --git a/libc3/s16.c b/libc3/s16.c
index 604c9f5..e0d1301 100644
--- a/libc3/s16.c
+++ b/libc3/s16.c
@@ -64,7 +64,6 @@ s16 s16_cast (s_tag *tag)
     return (s16) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/s32.c b/libc3/s32.c
index 70eb5ca..38022e3 100644
--- a/libc3/s32.c
+++ b/libc3/s32.c
@@ -64,7 +64,6 @@ s32 s32_cast (s_tag *tag)
     return (s32) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/s64.c b/libc3/s64.c
index 54d8d65..222e464 100644
--- a/libc3/s64.c
+++ b/libc3/s64.c
@@ -64,7 +64,6 @@ s64 s64_cast (s_tag *tag)
     return (s64) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/s8.c b/libc3/s8.c
index ebbc200..4f5057b 100644
--- a/libc3/s8.c
+++ b/libc3/s8.c
@@ -64,7 +64,6 @@ s8 s8_cast (s_tag *tag)
     return (s8) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/sw.c b/libc3/sw.c
index aeb41d1..99132fa 100644
--- a/libc3/sw.c
+++ b/libc3/sw.c
@@ -64,7 +64,6 @@ sw sw_cast (s_tag *tag)
     return (sw) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/sym.c b/libc3/sym.c
index 92b74d0..a04a3cb 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -153,12 +153,15 @@ const s_sym * sym_new (const s_str *src)
 
 ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
 {
+  assert(sym);
   if (sym == sym_1("Result") ||
       sym == sym_1("&result")) {
     if (! result_type)
       warnx("invalid result type: &result");
     return result_type;
   }
+  if (sym->str.ptr.ps8[sym->str.size - 1] == '*')
+    return &ffi_type_pointer;
   if (sym == sym_1("Integer") ||
       sym == sym_1("integer"))
     return &ffi_type_pointer;
@@ -210,6 +213,10 @@ ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
 
 bool sym_to_tag_type (const s_sym *sym, e_tag_type *dest)
 {
+  if (sym->str.ptr.ps8[sym->str.size - 2] == '*') {
+    *dest = TAG_PTR;
+    return true;
+  }
   if (sym == sym_1("Void") ||
       sym == sym_1("void")) {
     *dest = TAG_VOID;
diff --git a/libc3/tag.c b/libc3/tag.c
index 777a910..cf368dc 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -8406,7 +8406,7 @@ void * tag_to_ffi_pointer (s_tag *tag, const s_sym *type)
       return (void *) tag->data.ptag;
     goto invalid_type;
   case TAG_PTR:
-    if (type->str.ptr.ps8[type->str.size - 1] == '*')
+    if (type->str.ptr.ps8[type->str.size - 2] == '*')
       return &tag->data.ptr.p;
     goto invalid_type;
   case TAG_QUOTE:
@@ -8451,12 +8451,14 @@ void * tag_to_ffi_pointer (s_tag *tag, const s_sym *type)
   return NULL;
 }
 
-void * tag_to_pointer (s_tag *tag, e_tag_type type)
+void * tag_to_pointer (s_tag *tag, const s_sym *type)
 {
-  if (tag->type != type) {
+  e_tag_type tag_type;
+  sym_to_tag_type(type, &tag_type);
+  if (tag->type != tag_type) {
     warnx("tag_to_pointer: cannot cast %s to %s",
           tag_type_to_sym(tag->type)->str.ptr.ps8,
-          tag_type_to_sym(type)->str.ptr.ps8);
+          type->str.ptr.ps8);
     return NULL;
   }
   switch (tag->type) {
@@ -8527,7 +8529,7 @@ void * tag_to_pointer (s_tag *tag, e_tag_type type)
  invalid_type:
   warnx("tag_to_pointer: cannot cast %s to %s",
         tag_type_to_sym(tag->type)->str.ptr.ps8,
-        tag_type_to_sym(type)->str.ptr.ps8);
+        type->str.ptr.ps8);
   return NULL;
 
 }
diff --git a/libc3/tag.h b/libc3/tag.h
index 1a78748..9c97735 100644
--- a/libc3/tag.h
+++ b/libc3/tag.h
@@ -105,7 +105,7 @@ s8                 tag_number_compare (const s_tag *a, const s_tag *b);
 sw                 tag_size (const s_tag *tag);
 void *             tag_to_ffi_pointer (s_tag *tag, const s_sym *type);
 ffi_type           tag_to_ffi_type(const s_tag *tag);
-void *             tag_to_pointer (s_tag *tag, e_tag_type type);
+void *             tag_to_pointer (s_tag *tag, const s_sym *type);
 sw                 tag_type_size (e_tag_type type);
 f_buf_inspect      tag_type_to_buf_inspect (e_tag_type type);
 f_buf_inspect_size tag_type_to_buf_inspect_size (e_tag_type type);
diff --git a/libc3/type.c b/libc3/type.c
index c0cfb48..cc2388e 100644
--- a/libc3/type.c
+++ b/libc3/type.c
@@ -10,10 +10,27 @@
  * AUTHOR BE CONSIDERED LIABLE FOR THE USE AND PERFORMANCE OF
  * THIS SOFTWARE.
  */
+#include <assert.h>
+#include <err.h>
+#include <stdlib.h>
+#include <string.h>
+#include "str.h"
 #include "type.h"
 
-void     type_clean (s_type *t);
-s_type * type_copy (const s_type *t, s_type *dest);
-s_type * type_init (s_type *t, const s_ident *ident);
-sw       type_size (const s_type *t);
-bool     type_to_tag_type (const s_type *t, e_tag_type *tag_type);
+const s_sym * type_pointer (const s_sym *type)
+{
+  uw len;
+  s8 *mem;
+  s_str str;
+  const s_sym *tmp;
+  assert(type);
+  len = type->str.size + 2;
+  if (! (mem = malloc(len)))
+    errx(1, "type_pointer: out of memory");
+  memcpy(mem, type->str.ptr.ps8, type->str.size);
+  memcpy(mem + type->str.size, "*", 2);
+  str_init(&str, mem, len, mem);
+  tmp = str_to_sym(&str);
+  str_clean(&str);
+  return tmp;
+}
diff --git a/libc3/type.h b/libc3/type.h
index dce133d..7e420f1 100644
--- a/libc3/type.h
+++ b/libc3/type.h
@@ -21,13 +21,6 @@
 
 #include "types.h"
 
-/* Stack allocation compatible functions, call type_clean after use. */
-void     type_clean (s_type *t);
-s_type * type_init (s_type *t, const s_ident *ident);
-
-/* Observers */
-s_type * type_copy (const s_type *t, s_type *dest);
-sw       type_size (const s_type *t);
-bool     type_to_tag_type (const s_type *t, e_tag_type *tag_type);
+const s_sym * type_pointer (const s_sym *type);
 
 #endif /* TYPE_H */
diff --git a/libc3/types.h b/libc3/types.h
index 180f7ca..5363cdd 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -205,7 +205,7 @@ struct frame {
 };
 
 struct ptr {
-  e_tag_type type;
+  const s_sym *type;
   void *p;
 };
 
diff --git a/libc3/u16.c b/libc3/u16.c
index 415f8a9..8772877 100644
--- a/libc3/u16.c
+++ b/libc3/u16.c
@@ -64,7 +64,6 @@ u16 u16_cast (s_tag *tag)
     return (u16) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/u32.c b/libc3/u32.c
index d12dcc5..c6fc325 100644
--- a/libc3/u32.c
+++ b/libc3/u32.c
@@ -64,7 +64,6 @@ u32 u32_cast (s_tag *tag)
     return (u32) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/u64.c b/libc3/u64.c
index c45d19e..0c65ba8 100644
--- a/libc3/u64.c
+++ b/libc3/u64.c
@@ -64,7 +64,6 @@ u64 u64_cast (s_tag *tag)
     return (u64) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/u8.c b/libc3/u8.c
index ff4aaf4..6f00b8d 100644
--- a/libc3/u8.c
+++ b/libc3/u8.c
@@ -64,7 +64,6 @@ u8 u8_cast (s_tag *tag)
     return (u8) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM:
diff --git a/libc3/uw.c b/libc3/uw.c
index b40d2f8..a43e148 100644
--- a/libc3/uw.c
+++ b/libc3/uw.c
@@ -64,7 +64,6 @@ uw uw_cast (s_tag *tag)
     return (uw) tag->data.uw;
   case TAG_LIST:
   case TAG_PTAG:
-  case TAG_PTR:
   case TAG_QUOTE:
   case TAG_STR:
   case TAG_SYM: