Commit af40ba86e43b2484ee34f5138dfaa99f58ee7358

Thomas de Grivel 2023-10-01T18:14:02

wip (List) arrays

diff --git a/lib/c3/0.1/list.facts b/lib/c3/0.1/list.facts
index f12de0b..c3f5549 100644
--- a/lib/c3/0.1/list.facts
+++ b/lib/c3/0.1/list.facts
@@ -1,8 +1,10 @@
 %{module: C3.Facts.Dump,
   version: 1}
 add {List, :is_a, :module}
+add {List, :symbol, List.cast}
 add {List, :symbol, List.map}
 add {List, :symbol, List.reverse}
+replace {List.cast, :cfn, cfn :list "list_cast" (:tag, :&result)}
 replace {List.map, :fn, fn {
   ((), _) {
     ()
diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index cff786a..8d0a869 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -1107,7 +1107,7 @@ sw buf_inspect_integer_size (const s_integer *x)
   return size - 1;
 }
 
-sw buf_inspect_list (s_buf *buf, const s_list *x)
+sw buf_inspect_list (s_buf *buf, const s_list **x)
 {
   uw count = 0;
   const s_list *i;
@@ -1117,7 +1117,7 @@ sw buf_inspect_list (s_buf *buf, const s_list *x)
   if ((r = buf_write_u8(buf, '(')) <= 0)
     return r;
   result++;
-  i = x;
+  i = *x;
   while (i) {
     if ((r = buf_inspect_tag(buf, &i->tag)) < 0)
       return r;
@@ -1153,14 +1153,14 @@ sw buf_inspect_list (s_buf *buf, const s_list *x)
   return result;
 }
 
-sw buf_inspect_list_size (const s_list *list)
+sw buf_inspect_list_size (const s_list **list)
 {
   uw count = 0;
   const s_list *i;
   sw r;
   sw result = 0;
   result += strlen("(");
-  i = list;
+  i = *list;
   while (i) {
     if ((r = buf_inspect_tag_size(&i->tag)) < 0)
       return r;
@@ -1186,7 +1186,7 @@ sw buf_inspect_list_size (const s_list *list)
   return result;
 }
 
-sw buf_inspect_ptag (s_buf *buf, p_tag ptag)
+sw buf_inspect_ptag (s_buf *buf, const p_tag *ptag)
 {
   sw r;
   sw result = 0;
@@ -1194,13 +1194,13 @@ sw buf_inspect_ptag (s_buf *buf, p_tag ptag)
   if ((r = buf_write_1(buf, "@0x")) < 0)
     return r;
   result += r;
-  if ((r = buf_inspect_uw_hexadecimal(buf, (uw *) &ptag)) < 0)
+  if ((r = buf_inspect_uw_hexadecimal(buf, (uw *) ptag)) < 0)
     return r;
   result += r;
   return result;
 }
 
-sw buf_inspect_ptag_size (p_tag ptag)
+sw buf_inspect_ptag_size (const p_tag *ptag)
 {
   sw result = 0;
   (void) ptag;
@@ -1562,8 +1562,10 @@ sw buf_inspect_tag (s_buf *buf, const s_tag *tag)
   case TAG_FN:      return buf_inspect_fn(buf, &tag->data.fn);
   case TAG_IDENT:   return buf_inspect_ident(buf, &tag->data.ident);
   case TAG_INTEGER: return buf_inspect_integer(buf, &tag->data.integer);
-  case TAG_LIST:    return buf_inspect_list(buf, tag->data.list);
-  case TAG_PTAG:    return buf_inspect_ptag(buf, tag->data.ptag);
+  case TAG_LIST:
+    return buf_inspect_list(buf, (const s_list **) &tag->data.list);
+  case TAG_PTAG:
+    return buf_inspect_ptag(buf, &tag->data.ptag);
   case TAG_QUOTE:   return buf_inspect_quote(buf, &tag->data.quote);
   case TAG_S8:      return buf_inspect_s8(buf, &tag->data.s8);
   case TAG_S16:     return buf_inspect_s16(buf, &tag->data.s16);
@@ -1603,8 +1605,9 @@ sw buf_inspect_tag_size (const s_tag *tag)
   case TAG_IDENT:    return buf_inspect_ident_size(&tag->data.ident);
   case TAG_INTEGER:
     return buf_inspect_integer_size(&tag->data.integer);
-  case TAG_LIST:     return buf_inspect_list_size(tag->data.list);
-  case TAG_PTAG:     return buf_inspect_ptag_size(tag->data.ptag);
+  case TAG_LIST:
+    return buf_inspect_list_size((const s_list **) &tag->data.list);
+  case TAG_PTAG:     return buf_inspect_ptag_size(&tag->data.ptag);
   case TAG_QUOTE:    return buf_inspect_quote_size(&tag->data.quote);
   case TAG_S8:       return buf_inspect_s8_size(&tag->data.s8);
   case TAG_S16:      return buf_inspect_s16_size(&tag->data.s16);
diff --git a/libc3/buf_inspect.h b/libc3/buf_inspect.h
index e91faca..87abb32 100644
--- a/libc3/buf_inspect.h
+++ b/libc3/buf_inspect.h
@@ -93,12 +93,12 @@ sw buf_inspect_ident_reserved_size (const s_ident *ident);
 sw buf_inspect_ident_size (const s_ident *ident);
 sw buf_inspect_integer (s_buf *buf, const s_integer *x);
 sw buf_inspect_integer_size (const s_integer *x);
-sw buf_inspect_list (s_buf *buf, const s_list *list);
-sw buf_inspect_list_size (const s_list *list);
+sw buf_inspect_list (s_buf *buf, const s_list **list);
+sw buf_inspect_list_size (const s_list **list);
 sw buf_inspect_paren_sym (s_buf *buf, const s_sym *sym);
 sw buf_inspect_paren_sym_size (const s_sym *sym);
-sw buf_inspect_ptag (s_buf *buf, p_tag ptag);
-sw buf_inspect_ptag_size (p_tag ptag);
+sw buf_inspect_ptag (s_buf *buf, const p_tag *ptag);
+sw buf_inspect_ptag_size (const p_tag *ptag);
 sw buf_inspect_quote (s_buf *buf, const s_quote *quote);
 sw buf_inspect_quote_size (const s_quote *quote);
 BUF_INSPECT_S_PROTOTYPES(8);
diff --git a/libc3/io.c b/libc3/io.c
index 7ee1db0..ca8e638 100644
--- a/libc3/io.c
+++ b/libc3/io.c
@@ -34,7 +34,7 @@ sw err_inspect_fn_pattern (const s_list *list)
 sw err_inspect_list (const s_list *list)
 {
   sw r;
-  r = buf_inspect_list(&g_c3_env.err, list);
+  r = buf_inspect_list(&g_c3_env.err, &list);
   buf_flush(&g_c3_env.err);
   return r;
 }
diff --git a/libc3/list.c b/libc3/list.c
index 474ab99..104a491 100644
--- a/libc3/list.c
+++ b/libc3/list.c
@@ -44,6 +44,16 @@ void list_clean (s_list *list)
   }
 }
 
+s_list ** list_cast (const s_tag *tag, s_list **list)
+{
+  assert(tag);
+  if (tag->type == TAG_LIST) {
+    list_copy(tag->data.list, list);
+    return list;
+  }
+  return NULL;
+}
+
 /* FIXME: does not work on circular lists */
 s_list * list_copy (const s_list *src, s_list **dest)
 {
@@ -100,9 +110,9 @@ s_str * list_inspect (const s_list *x, s_str *dest)
   s_buf buf;
   sw r;
   sw size;
-  size = buf_inspect_list_size(x);
+  size = buf_inspect_list_size(&x);
   buf_init_alloc(&buf, size);
-  if ((r = buf_inspect_list(&buf, x)) < 0)
+  if ((r = buf_inspect_list(&buf, &x)) < 0)
     goto error;
   assert(r == size);
   if (r != size)
diff --git a/libc3/sym.c b/libc3/sym.c
index 0c8018f..c7ef9f4 100644
--- a/libc3/sym.c
+++ b/libc3/sym.c
@@ -160,6 +160,8 @@ ffi_type * sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
   }
   if (sym == sym_1("integer"))
     return &ffi_type_pointer;
+  if (sym == sym_1("list"))
+    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 4eff681..2951ec5 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -3756,7 +3756,7 @@ void * tag_to_ffi_pointer (s_tag *tag, const s_sym *type)
     goto invalid_type;
   case TAG_LIST:
     if (type == sym_1("list"))
-      return tag->data.list;
+      return &tag->data.list;
     goto invalid_type;
   case TAG_PTAG:
     if (type == sym_1("ptag"))
diff --git a/test/buf_inspect_test.c b/test/buf_inspect_test.c
index a072f3d..a68a45a 100644
--- a/test/buf_inspect_test.c
+++ b/test/buf_inspect_test.c
@@ -123,8 +123,10 @@
       errx(1, "BUF_INSPECT_TEST_LIST: buf_parse_list");                \
     }                                                                  \
     buf_init_alloc(&buf, 1024 * 1024);                                 \
-    TEST_EQ(buf_inspect_list_size(list_test), strlen(expected));       \
-    TEST_EQ(buf_inspect_list(&buf, list_test), strlen(expected));      \
+    TEST_EQ(buf_inspect_list_size((const s_list **) &list_test),       \
+            strlen(expected));                                         \
+    TEST_EQ(buf_inspect_list(&buf, (const s_list **) &list_test),      \
+            strlen(expected));                                         \
     TEST_EQ(buf.wpos, strlen(expected));                               \
     if (g_test_last_ok)                                                \
       TEST_STRNCMP(buf.ptr.p, (expected), buf.wpos);                   \
diff --git a/test/ic3/array.in b/test/ic3/array.in
index 0a81d8f..b4c9702 100644
--- a/test/ic3/array.in
+++ b/test/ic3/array.in
@@ -107,3 +107,7 @@ l = (Integer) { 1000000000000000000000000000000001,
                 2000000000000000000000000000000002 }
 l[0]
 l[1]
+quote (List) { (1, 2), (3, 4) }
+m = (List) { (1, 2), (3, 4) }
+m[0]
+m[1]