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);