Commit ca42988da38f15bc36ecf65251fab24885fd50dc

Thomas de Grivel 2023-09-22T21:03:12

wip integer arrays

diff --git a/lib/c3/0.1/integer.facts b/lib/c3/0.1/integer.facts
new file mode 100644
index 0000000..080ce8a
--- /dev/null
+++ b/lib/c3/0.1/integer.facts
@@ -0,0 +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)}
diff --git a/lib/c3/0.1/s16.facts b/lib/c3/0.1/s16.facts
new file mode 100644
index 0000000..d343ddd
--- /dev/null
+++ b/lib/c3/0.1/s16.facts
@@ -0,0 +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)}
diff --git a/lib/c3/0.1/s32.facts b/lib/c3/0.1/s32.facts
new file mode 100644
index 0000000..1ffcd84
--- /dev/null
+++ b/lib/c3/0.1/s32.facts
@@ -0,0 +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)}
diff --git a/lib/c3/0.1/s64.facts b/lib/c3/0.1/s64.facts
new file mode 100644
index 0000000..7ad5bd7
--- /dev/null
+++ b/lib/c3/0.1/s64.facts
@@ -0,0 +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)}
diff --git a/lib/c3/0.1/s8.facts b/lib/c3/0.1/s8.facts
new file mode 100644
index 0000000..86d97b2
--- /dev/null
+++ b/lib/c3/0.1/s8.facts
@@ -0,0 +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)}
diff --git a/lib/c3/0.1/sw.facts b/lib/c3/0.1/sw.facts
new file mode 100644
index 0000000..943c169
--- /dev/null
+++ b/lib/c3/0.1/sw.facts
@@ -0,0 +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)}
diff --git a/lib/c3/0.1/u16.facts b/lib/c3/0.1/u16.facts
index d39c249..0bff34a 100644
--- a/lib/c3/0.1/u16.facts
+++ b/lib/c3/0.1/u16.facts
@@ -2,6 +2,4 @@
   version: 1}
 add {U16, :is_a, :module}
 add {U16, :symbol, U16.cast}
-add {U16, :symbol, U16.size}
 replace {U16.cast, :cfn, cfn :u16 "u16_cast" (:tag)}
-replace {U16.size, :value, 2}
diff --git a/lib/c3/0.1/u32.facts b/lib/c3/0.1/u32.facts
index 8097e29..3ef55f0 100644
--- a/lib/c3/0.1/u32.facts
+++ b/lib/c3/0.1/u32.facts
@@ -2,6 +2,4 @@
   version: 1}
 add {U32, :is_a, :module}
 add {U32, :symbol, U32.cast}
-add {U32, :symbol, U32.size}
 replace {U32.cast, :cfn, cfn :u32 "u32_cast" (:tag)}
-replace {U32.size, :value, 4}
diff --git a/lib/c3/0.1/u64.facts b/lib/c3/0.1/u64.facts
index 350c9d4..1b7fd15 100644
--- a/lib/c3/0.1/u64.facts
+++ b/lib/c3/0.1/u64.facts
@@ -2,6 +2,4 @@
   version: 1}
 add {U64, :is_a, :module}
 add {U64, :symbol, U64.cast}
-add {U64, :symbol, U64.size}
 replace {U64.cast, :cfn, cfn :u64 "u64_cast" (:tag)}
-replace {U64.size, :value, 8}
diff --git a/lib/c3/0.1/u8.facts b/lib/c3/0.1/u8.facts
index b87308b..e86c023 100644
--- a/lib/c3/0.1/u8.facts
+++ b/lib/c3/0.1/u8.facts
@@ -2,6 +2,4 @@
   version: 1}
 add {U8, :is_a, :module}
 add {U8, :symbol, U8.cast}
-add {U8, :symbol, U8.size}
 replace {U8.cast, :cfn, cfn :u8 "u8_cast" (:tag)}
-replace {U8.size, :value, 1}
diff --git a/lib/c3/0.1/uw.facts b/lib/c3/0.1/uw.facts
index 1198f79..888555a 100644
--- a/lib/c3/0.1/uw.facts
+++ b/lib/c3/0.1/uw.facts
@@ -2,6 +2,4 @@
   version: 1}
 add {Uw, :is_a, :module}
 add {Uw, :symbol, Uw.cast}
-add {Uw, :symbol, Uw.size}
 replace {Uw.cast, :cfn, cfn :uw "uw_cast" (:tag)}
-replace {Uw.size, :value, 8}
diff --git a/libc3/integer.c b/libc3/integer.c
index 0abfff1..4e5848e 100644
--- a/libc3/integer.c
+++ b/libc3/integer.c
@@ -17,6 +17,7 @@
 #include "buf_parse.h"
 #include "compare.h"
 #include "integer.h"
+#include "tag.h"
 
 s_integer * integer_abs (const s_integer *a, s_integer *dest)
 {
@@ -102,6 +103,69 @@ uw integer_bytes (const s_integer *i)
   return (integer_bits(i) + 7) / 8;
 }
 
+s_integer * integer_cast (const s_tag *tag, s_integer *dest)
+{
+  switch (tag->type) {
+  case TAG_VOID:
+    return integer_init_zero(dest);
+  case TAG_ARRAY:
+    goto ko;
+  case TAG_BOOL:
+    return integer_init_u8(dest, tag->data.bool ? 1 : 0);
+  case TAG_CALL:
+    goto ko;
+  case TAG_CFN:
+    goto ko;
+  case TAG_CHARACTER:
+    return integer_init_u64(dest, tag->data.character);
+  case TAG_F32:
+    return integer_init_f32(dest, tag->data.f32);
+  case TAG_F64:
+    return integer_init_f64(dest, tag->data.f64);
+  case TAG_FACT:
+  case TAG_FN:
+  case TAG_IDENT:
+    goto ko;
+  case TAG_INTEGER:
+    return integer_copy(&tag->data.integer, dest);
+  case TAG_SW:
+    return integer_init_sw(dest, tag->data.sw);
+  case TAG_S64:
+    return integer_init_s64(dest, tag->data.s64);
+  case TAG_S32:
+    return integer_init_s32(dest, tag->data.s32);
+  case TAG_S16:
+    return integer_init_s16(dest, tag->data.s16);
+  case TAG_S8:
+    return integer_init_s8(dest, tag->data.s8);
+  case TAG_U8:
+    return integer_init_u8(dest, tag->data.u8);
+  case TAG_U16:
+    return integer_init_u16(dest, tag->data.u16);
+  case TAG_U32:
+    return integer_init_u32(dest, tag->data.u32);
+  case TAG_U64:
+    return integer_init_u64(dest, tag->data.u64);
+  case TAG_UW:
+    return integer_init_uw(dest, tag->data.uw);
+  case TAG_LIST:
+  case TAG_PTAG:
+  case TAG_QUOTE:
+  case TAG_STR:
+  case TAG_SYM:
+  case TAG_TUPLE:
+  case TAG_VAR:
+    goto ko;
+  }
+  assert(! "u8_cast: unknown tag type");
+  errx(1, "u8_cast: unknown tag type: %d", tag->type);
+  return 0;
+ ko:
+  warnx("u8_cast: cannot cast %s to u8",
+        tag_type_to_sym(tag->type)->str.ptr.ps8);
+  return 0;
+}
+
 void integer_clean (s_integer *dest)
 {
   assert(dest);
@@ -163,7 +227,14 @@ s_integer * integer_init_1 (s_integer *i, const s8 *p)
   return i;
 }
 
-s_integer * integer_init_double (s_integer *a, double x)
+s_integer * integer_init_f64 (s_integer *a, f64 x)
+{
+  assert(a);
+  integer_init(a);
+  return integer_set_double(a, x);
+}
+
+s_integer * integer_init_f32 (s_integer *a, f32 x)
 {
   assert(a);
   integer_init(a);
diff --git a/libc3/integer.h b/libc3/integer.h
index ef1941c..67b5eeb 100644
--- a/libc3/integer.h
+++ b/libc3/integer.h
@@ -28,7 +28,8 @@
 /* Stack allocation compatible functions */
 s_integer * integer_init (s_integer *i);
 s_integer * integer_init_1 (s_integer *i, const s8 *p);
-s_integer * integer_init_double (s_integer *a, double x);
+s_integer * integer_init_f32 (s_integer *a, f32 x);
+s_integer * integer_init_f64 (s_integer *a, f64 x);
 s_integer * integer_init_s8 (s_integer *a, s8 x);
 s_integer * integer_init_s16 (s_integer *a, s16 x);
 s_integer * integer_init_s32 (s_integer *a, s32 x);
@@ -62,6 +63,7 @@ s_integer * integer_bor (const s_integer *a, const s_integer *b,
                          s_integer *dest);
 s_integer * integer_bxor (const s_integer *a, const s_integer *b,
                           s_integer *dest);
+s_integer * integer_cast (const s_tag *tag, s_integer *dest);
 s_integer * integer_copy (const s_integer *a, s_integer *dest);
 s_integer * integer_div (const s_integer *a, const s_integer *b,
                          s_integer *dest);
diff --git a/libc3/sym.c b/libc3/sym.c
index 8c5361d..c6192ed 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -150,6 +150,8 @@ ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
       warnx("invalid result type: &result");
     return result_type;
   }
+  if (sym == sym_1("integer"))
+    return &ffi_type_pointer;
   if (sym == sym_1("s8"))
     return &ffi_type_sint8;
   if (sym == sym_1("s16"))
diff --git a/libc3/tag.c b/libc3/tag.c
index 42c08fe..7db367f 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -1486,7 +1486,7 @@ s_tag * tag_div (const s_tag *a, const s_tag *b, s_tag *dest)
     case TAG_F64:
       return tag_init_f64(dest, (f64) a->data.f32 / b->data.f64);
     case TAG_INTEGER:
-      integer_init_double(&tmp, (f64) a->data.f32);
+      integer_init_f32(&tmp, a->data.f32);
       integer_div(&tmp, &b->data.integer, &tmp);
       tag_init_integer(dest, &tmp);
       integer_clean(&tmp);
@@ -1517,7 +1517,7 @@ s_tag * tag_div (const s_tag *a, const s_tag *b, s_tag *dest)
     case TAG_F64:
       return tag_init_f64(dest, a->data.f64 / b->data.f64);
     case TAG_INTEGER:
-      integer_init_double(&tmp, a->data.f64);
+      integer_init_f64(&tmp, a->data.f64);
       integer_div(&tmp, &b->data.integer, &tmp);
       tag_init_integer(dest, &tmp);
       integer_clean(&tmp);
@@ -3110,7 +3110,7 @@ s_tag * tag_sub (const s_tag *a, const s_tag *b, s_tag *dest)
     case TAG_F64:
       return tag_init_f64(dest, a->data.f32 - b->data.f64);
     case TAG_INTEGER:
-      integer_init_double(&tmp, a->data.f32);
+      integer_init_f32(&tmp, a->data.f32);
       integer_sub(&tmp, &b->data.integer, &tmp);
       tag_init_integer(dest, &tmp);
       integer_clean(&tmp);
@@ -3141,7 +3141,7 @@ s_tag * tag_sub (const s_tag *a, const s_tag *b, s_tag *dest)
     case TAG_F64:
       return tag_init_f64(dest, a->data.f64 - b->data.f64);
     case TAG_INTEGER:
-      integer_init_double(&tmp, a->data.f64);
+      integer_init_f64(&tmp, a->data.f64);
       integer_sub(&tmp, &b->data.integer, &tmp);
       tag_init_integer(dest, &tmp);
       integer_clean(&tmp);