diff --git a/libc3/array.c b/libc3/array.c
index bb0b402..1e9ed14 100644
--- a/libc3/array.c
+++ b/libc3/array.c
@@ -23,7 +23,7 @@ void array_clean (s_array *a)
free(a->data);
}
-s_array * array_init (s_array *a, uw dimension, uw *sizes)
+s_array * array_init (s_array *a, uw dimension, const uw *sizes)
{
uw i = 0;
uw sizeof_sizes;
@@ -44,7 +44,7 @@ s_array * array_init (s_array *a, uw dimension, uw *sizes)
return a;
}
-void * array_data (s_array *a, uw *address)
+void * array_data (const s_array *a, const uw *address)
{
uw i = 0;
uw offset = 0;
diff --git a/libc3/array.h b/libc3/array.h
index 155427b..72afdaf 100644
--- a/libc3/array.h
+++ b/libc3/array.h
@@ -16,7 +16,7 @@
#include "types.h"
void array_clean (s_array *a);
-s_array * array_init (s_array *a, uw dimension, uw *sizes);
-void * array_data (s_array *a, uw *address);
+s_array * array_init (s_array *a, uw dimension, const uw *sizes);
+void * array_data (const s_array *a, const uw *address);
#endif /* ARRAY_H */
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index 0c95a66..a978135 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -27,14 +27,14 @@ sw buf_inspect_sym_reserved_size (const s_sym *x);
sw buf_inspect_array (s_buf *buf, const s_array *a)
{
uw *address;
- sw (* buf_inspect) (s_buf *buf, void *x);
- sw i = 0;
+ uw i = 0;
+ f_buf_inspect inspect;
sw r;
- sw result;
+ sw result = 0;
assert(a);
assert(buf);
address = calloc(a->dimension, sizeof(uw));
- while (i >= 0 && i < a->dimension && address[i] < a->sizes[i]) {
+ while (i < a->dimension) {
if (i < a->dimension - 1) {
if (! address[i]) {
if ((r = buf_write_1(buf, "[")) < 0)
@@ -49,11 +49,59 @@ sw buf_inspect_array (s_buf *buf, const s_array *a)
errx(1, "void array");
return -1;
case TAG_ARRAY:
- inspect = buf_inspect_array;
+ inspect = (f_buf_inspect) buf_inspect_array;
break;
case TAG_BOOL:
- inspect = buf_inspect_bool;
+ inspect = (f_buf_inspect) buf_inspect_bool;
break;
+ case TAG_CALL:
+ case TAG_CALL_FN:
+ case TAG_CALL_MACRO:
+ inspect = (f_buf_inspect) buf_inspect_call;
+ case TAG_CFN:
+ inspect = (f_buf_inspect) buf_inspect_cfn;
+ case TAG_CHARACTER:
+ inspect = (f_buf_inspect) buf_inspect_character;
+ case TAG_F32:
+ inspect = (f_buf_inspect) buf_inspect_f32;
+ case TAG_F64:
+ inspect = (f_buf_inspect) buf_inspect_f64;
+ case TAG_FN:
+ inspect = (f_buf_inspect) buf_inspect_fn;
+ case TAG_IDENT:
+ inspect = (f_buf_inspect) buf_inspect_ident;
+ case TAG_INTEGER:
+ inspect = (f_buf_inspect) buf_inspect_integer;
+ case TAG_S64:
+ inspect = (f_buf_inspect) buf_inspect_s64;
+ case TAG_S32:
+ inspect = (f_buf_inspect) buf_inspect_s32;
+ case TAG_S16:
+ inspect = (f_buf_inspect) buf_inspect_s16;
+ case TAG_S8:
+ inspect = (f_buf_inspect) buf_inspect_s8;
+ case TAG_U8:
+ inspect = (f_buf_inspect) buf_inspect_u8;
+ case TAG_U16:
+ inspect = (f_buf_inspect) buf_inspect_u16;
+ case TAG_U32:
+ inspect = (f_buf_inspect) buf_inspect_u32;
+ case TAG_U64:
+ inspect = (f_buf_inspect) buf_inspect_u64;
+ case TAG_LIST:
+ inspect = (f_buf_inspect) buf_inspect_list;
+ case TAG_PTAG:
+ inspect = (f_buf_inspect) buf_inspect_ptag;
+ case TAG_QUOTE:
+ inspect = (f_buf_inspect) buf_inspect_quote;
+ case TAG_STR:
+ inspect = (f_buf_inspect) buf_inspect_str;
+ case TAG_SYM:
+ inspect = (f_buf_inspect) buf_inspect_sym;
+ case TAG_TUPLE:
+ inspect = (f_buf_inspect) buf_inspect_tuple;
+ case TAG_VAR:
+ inspect = (f_buf_inspect) buf_inspect_var;
}
if ((r = inspect(buf, array_data(a, address))) < 0)
return r;
@@ -64,12 +112,23 @@ sw buf_inspect_array (s_buf *buf, const s_array *a)
if ((r = buf_write_1(buf, "],\n")) < 0)
return r;
result += r;
+ if (! i)
+ return result;
i--;
}
break;
}
+ address[i]++;
i++;
}
+ return result;
+}
+
+sw buf_inspect_array_size (const s_array *a)
+{
+ assert(a);
+ (void) a;
+ return -1;
}
sw buf_inspect_bool (s_buf *buf, e_bool x)
@@ -635,7 +694,7 @@ sw buf_inspect_list (s_buf *buf, const s_list *x)
sw r;
sw result = 0;
assert(buf);
- if ((r = buf_write_u8(buf, '[')) <= 0)
+ if ((r = buf_write_u8(buf, '(')) <= 0)
return r;
result++;
i = x;
@@ -662,7 +721,7 @@ sw buf_inspect_list (s_buf *buf, const s_list *x)
i = NULL;
}
}
- if ((r = buf_write_1(buf, "]")) < 0)
+ if ((r = buf_write_1(buf, ")")) < 0)
return r;
result += r;
return result;
@@ -673,7 +732,7 @@ sw buf_inspect_list_size (const s_list *list)
const s_list *i;
sw r;
sw result = 0;
- result += strlen("[");
+ result += strlen("(");
i = list;
while (i) {
if ((r = buf_inspect_tag_size(&i->tag)) < 0)
@@ -693,7 +752,7 @@ sw buf_inspect_list_size (const s_list *list)
break;
}
}
- result += strlen("]");
+ result += strlen(")");
return result;
}
@@ -1068,6 +1127,7 @@ sw buf_inspect_tag (s_buf *buf, const s_tag *tag)
return buf_write_1(buf, "NULL");
switch(tag->type.type) {
case TAG_VOID: return 0;
+ case TAG_ARRAY: return buf_inspect_array(buf, &tag->data.array);
case TAG_BOOL: return buf_inspect_bool(buf, tag->data.bool);
case TAG_CALL:
case TAG_CALL_FN:
@@ -1106,6 +1166,7 @@ sw buf_inspect_tag_size (const s_tag *tag)
assert(tag);
switch(tag->type.type) {
case TAG_VOID: return 0;
+ case TAG_ARRAY: return buf_inspect_array_size(&tag->data.array);
case TAG_BOOL: return buf_inspect_bool_size(tag->data.bool);
case TAG_CALL:
case TAG_CALL_FN:
diff --git a/libc3/buf_inspect.h b/libc3/buf_inspect.h
index 1070c8e..d3de832 100644
--- a/libc3/buf_inspect.h
+++ b/libc3/buf_inspect.h
@@ -25,7 +25,10 @@
#define BUF_INSPECT_UW_HEX_SIZE (sizeof(uw) / 4)
#define BUF_INSPECT_VAR_SIZE (BUF_INSPECT_UW_HEX_SIZE + 7)
-sw buf_inspect_array (s_buf *buf, s_array *a);
+typedef sw (* f_buf_inspect) (s_buf *buf, void *x);
+
+sw buf_inspect_array (s_buf *buf, const s_array *a);
+sw buf_inspect_array_size (const s_array *a);
sw buf_inspect_bool (s_buf *buf, e_bool b);
sw buf_inspect_bool_size (e_bool b);
sw buf_inspect_call (s_buf *buf, const s_call *call);
diff --git a/libc3/c3.h b/libc3/c3.h
index 06b5e27..5182316 100644
--- a/libc3/c3.h
+++ b/libc3/c3.h
@@ -14,6 +14,7 @@
#define C3_H
#include "arg.h"
+#include "array.h"
#include "bool.h"
#include "buf.h"
#include "buf_file.h"
diff --git a/libc3/cfn.c b/libc3/cfn.c
index d7a5918..10c4acf 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -305,6 +305,7 @@ const s_sym * cfn_tag_type_to_sym (e_tag_type tag_type)
{
switch (tag_type) {
case TAG_VOID: return sym_1("void");
+ case TAG_ARRAY: return sym_1("array");
case TAG_BOOL: return sym_1("bool");
case TAG_CALL: return sym_1("call");
case TAG_CALL_FN: return sym_1("call_fn");
@@ -346,6 +347,10 @@ void * cfn_tag_to_ffi_value (s_tag *tag, const s_sym *type)
if (type == sym_1("void"))
return NULL;
goto invalid_type;
+ case TAG_ARRAY:
+ if (type == sym_1("array"))
+ return tag->data.array.data;
+ goto invalid_type;
case TAG_BOOL:
if (type == sym_1("bool"))
return &tag->data.bool;
diff --git a/libc3/compare.c b/libc3/compare.c
index e2f48e9..426f2c7 100644
--- a/libc3/compare.c
+++ b/libc3/compare.c
@@ -27,6 +27,33 @@
return 0; \
} \
+s8 compare_array (const s_array *a, const s_array *b)
+{
+ uw i = 0;
+ sw r;
+ assert(a);
+ assert(b);
+ if (a == b)
+ return 0;
+ if (a->dimension < b->dimension)
+ return -1;
+ if (a->dimension > b->dimension)
+ return 1;
+ while (i < a->dimension) {
+ if (a->sizes[i] < b->sizes[i])
+ return -1;
+ if (a->sizes[i] > b->sizes[i])
+ return 1;
+ i++;
+ }
+ assert(a->size == b->size);
+ if ((r = memcmp(a->data, b->data, a->size)) < 0)
+ return -1;
+ if (r > 0)
+ return 1;
+ return 0;
+}
+
s8 compare_bool (e_bool a, e_bool b)
{
if (! a && b)
@@ -345,6 +372,7 @@ s8 compare_tag (const s_tag *a, const s_tag *b) {
return 1;
switch (a->type.type) {
case TAG_VOID: return 0;
+ case TAG_ARRAY: return compare_array(&a->data.array, &b->data.array);
case TAG_BOOL: return compare_bool(a->data.bool, b->data.bool);
case TAG_CALL:
case TAG_CALL_FN:
diff --git a/libc3/env.c b/libc3/env.c
index 53b8cf9..595d58e 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -323,6 +323,7 @@ bool env_eval_equal_tag (s_env *env, const s_tag *a, const s_tag *b,
dest->type.type = TAG_TUPLE;
return env_eval_equal_tuple(env, &a->data.tuple, &b->data.tuple,
&dest->data.tuple);
+ case TAG_ARRAY:
case TAG_BOOL:
case TAG_CALL:
case TAG_CALL_FN:
@@ -427,6 +428,7 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
return env_eval_call_macro(env, &tag->data.call, dest);
case TAG_IDENT:
return env_eval_ident(env, &tag->data.ident, dest);
+ case TAG_ARRAY:
case TAG_BOOL:
case TAG_CFN:
case TAG_CHARACTER:
diff --git a/libc3/hash.c b/libc3/hash.c
index bc52903..61a580e 100644
--- a/libc3/hash.c
+++ b/libc3/hash.c
@@ -21,8 +21,12 @@
#define HASH_UPDATE_DEF(type) \
void hash_update_##type (t_hash *hash, type x) \
{ \
+ const s8 t[] = #type; \
+ assert(hash); \
+ assert(x); \
+ hash_update(hash, t, sizeof(t)); \
hash_update(hash, &x, sizeof(x)); \
- } \
+ }
void hash_clean (t_hash *hash)
{
@@ -58,11 +62,25 @@ void hash_update (t_hash *hash, const void *data, uw size)
void hash_update_1 (t_hash *hash, const s8 *p)
{
+ uw len;
+ const s8 type[] = "s8*";
assert(hash);
assert(p);
+ hash_update(hash, type, sizeof(type));
+ len = strlen(p);
+ hash_update(hash, &len, sizeof(len));
hash_update(hash, p, strlen(p));
}
+void hash_update_array (t_hash *hash, const s_array *a)
+{
+ const s8 type[] = "array";
+ assert(hash);
+ assert(a);
+ hash_update(hash, type, sizeof(type));
+
+}
+
void hash_update_bool (t_hash *hash, e_bool x)
{
bool b = x ? 1 : 0;
diff --git a/libc3/hash.h b/libc3/hash.h
index 28685ce..6fd7251 100644
--- a/libc3/hash.h
+++ b/libc3/hash.h
@@ -24,6 +24,7 @@ uw hash_to_uw (t_hash *hash);
u64 hash_to_u64 (t_hash *hash);
void hash_update (t_hash *hash, const void *data, uw size);
void hash_update_1 (t_hash *hash, const s8 *p);
+void hash_update_array (t_hash *hash, const s_array *a);
void hash_update_bool (t_hash *hash, e_bool b);
void hash_update_call (t_hash *hash, const s_call *call);
void hash_update_cfn (t_hash *hash, const s_cfn *cfn);
diff --git a/libc3/types.h b/libc3/types.h
index a1876c8..cc265ee 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -316,6 +316,7 @@ struct sym {
};
union tag_data {
+ s_array array;
bool bool;
s_call call;
s_cfn cfn;