Commit dfcac69c23b6732a01280f709fe8b4fc7158b8e0

Thomas de Grivel 2023-04-02T15:38:55

wip array

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;