Commit a5aa00a402f05615efdcb2ee037c6bbed152f6de

Thomas de Grivel 2023-12-15T05:30:38

wip env_eval_struct

diff --git a/.ic3_history b/.ic3_history
index df2e675..23be3b4 100644
--- a/.ic3_history
+++ b/.ic3_history
@@ -29,11 +29,9 @@ to_list(%{a: 1, b: 2})
 to_list = fn (map) { Map.map(map, fn (k, v) { {k, v} }) }
 to_list(%{a: 1, b: 2})
 Map.to_list(%{a: 1, b: 2})
-"\libc3/window/cairo/quartz/demo/c3_window_cairo_quartz_demo.app/Contents/img/flaps.png b/libc3/window/cairo/quartz/demo/c3_window_cairo_quartz_demo.app/Contents/img/flaps.png
- "\U+1FAB0"
+"\U+1FAB0"
 1 + 10000000000000000000000000000
 Map.map
 Map.to_list
-%{name: "Quentin", id: 1000}
 make
 %GL.Sphere{}
diff --git a/ic3/.ic3_history b/ic3/.ic3_history
index ff867c0..7a802ef 100644
--- a/ic3/.ic3_history
+++ b/ic3/.ic3_history
@@ -5,3 +5,4 @@ quote %GL.Sphere{}
 quote %GL.Sphere{segments_u: 100}
 %GL.Sphere{segments_u: 100}
 %GL.Sphere{segments_u: 100 + 1}
+%GL.Sphere{segments_u: (Uw) (100 + 1)}
diff --git a/libc3/env.c b/libc3/env.c
index c5c82b5..757de1f 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -43,6 +43,8 @@
 #include "map.h"
 #include "module.h"
 #include "str.h"
+#include "struct.h"
+#include "struct_type.h"
 #include "tag.h"
 #include "tuple.h"
 
@@ -665,7 +667,7 @@ bool env_eval_progn (s_env *env, const s_list *program, s_tag *dest)
   return true;
 }
 
-bool env_eval_quote(s_env *env, const s_quote *quote, s_tag *dest)
+bool env_eval_quote (s_env *env, const s_quote *quote, s_tag *dest)
 {
   assert(env);
   assert(quote);
@@ -676,6 +678,55 @@ bool env_eval_quote(s_env *env, const s_quote *quote, s_tag *dest)
   return true;
 }
 
+bool env_eval_struct (s_env *env, const s_struct *s, s_tag *dest)
+{
+  uw i;
+  s_struct *t;
+  s_tag tag = {0};
+  void *tag_data;
+  uw    tag_size;
+  s_tag tmp = {0};
+  assert(env);
+  assert(s);
+  assert(dest);
+  tmp.type = TAG_STRUCT;
+  t = &tmp.data.struct_;
+  if (s->data) {
+    if (! struct_init_copy(t, s))
+      return false;
+    *dest = tmp;
+    return true;
+  }
+  if (! struct_type_init_copy(&t->type, &s->type) ||
+      ! struct_allocate(t))
+    return false;
+  i = 0;
+  while (i < t->type.map.count) {
+    if (! env_eval_tag(env, s->tag + i, &tag))
+      goto ko;
+    if (tag.type != t->type.map.value[i].type) {
+      warnx("env_eval_struct:"
+            " invalid type %s for key %s, expected %s.",
+            tag_type_to_string(tag.type),
+            t->type.map.key[i].data.sym->str.ptr.ps8,
+            tag_type_to_string(t->type.map.value[i].type));
+      tag_clean(&tag);
+      goto ko;
+    }
+    tag_data = tag_to_pointer(&tag, tag_type_to_sym(tag.type));
+    tag_size = tag_type_size(tag.type);
+    if (tag_data && tag_size)
+      memcpy((s8 *) t->data + t->type.offset[i],
+             tag_data, tag_size);
+    i++;
+  }
+  *dest = tmp;
+  return true;
+ ko:
+  struct_clean(t);
+  return false;
+}
+
 bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
 {
   assert(env);
@@ -683,8 +734,7 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
   assert(dest);
   switch (tag->type) {
   case TAG_VOID:
-    tag_init_void(dest);
-    return true;
+    return env_eval_void(env, NULL, dest);
   case TAG_ARRAY:
     return env_eval_array_tag(env, &tag->data.array, dest);
   case TAG_CALL:
@@ -697,10 +747,8 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
     return env_eval_map(env, &tag->data.map, dest);
   case TAG_QUOTE:
     return env_eval_quote(env, &tag->data.quote, dest);
-  /*
   case TAG_STRUCT:
     return env_eval_struct(env, &tag->data.struct_, dest);
-  */
   case TAG_TUPLE:
     return env_eval_tuple(env, &tag->data.tuple, dest);
   case TAG_BOOL:
@@ -720,7 +768,6 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
   case TAG_S64:
   case TAG_SW:
   case TAG_STR:
-  case TAG_STRUCT:
   case TAG_SYM:
   case TAG_U8:
   case TAG_U16:
@@ -754,6 +801,16 @@ bool env_eval_tuple (s_env *env, const s_tuple *tuple, s_tag *dest)
   return true;
 }
 
+bool env_eval_void (s_env *env, const void *_, s_tag *dest)
+{
+  assert(env);
+  assert(dest);
+  (void) env;
+  (void) _;
+  tag_init_void(dest);
+  return true;
+}
+
 s_env * env_init (s_env *env, int argc, s8 **argv)
 {
   s_str path;
diff --git a/libc3/env.h b/libc3/env.h
index d9f4b98..6e412d0 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -60,6 +60,7 @@ bool          env_eval_struct (s_env *env, const s_struct *s,
 bool          env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest);
 bool          env_eval_tuple (s_env *env, const s_tuple *tuple,
                               s_tag *dest);
+bool          env_eval_void (s_env *env, const void *_, s_tag *dest);
 s_list **     env_get_struct_type_spec (s_env *env, const s_sym *module,
                                         s_list **dest);
 bool          env_module_load (s_env *env, const s_sym *module,
diff --git a/libc3/struct.c b/libc3/struct.c
index 9bc954f..69e5188 100644
--- a/libc3/struct.c
+++ b/libc3/struct.c
@@ -23,6 +23,23 @@
 #include "tag.h"
 #include "tag_type.h"
 
+s_struct * struct_allocate (s_struct *s)
+{
+  s_struct tmp;
+  assert(s);
+  assert(! s->data);
+  tmp = *s;
+  tmp.free_data = true;
+  tmp.data = calloc(1, tmp.type.size);
+  if (! tmp.data) {
+    warn("struct_allocate: data");
+    assert(! "struct_allocate: data: failed to allocate memory");
+    return NULL;
+  }
+  *s = tmp;
+  return s;
+}
+
 void struct_clean (s_struct *s)
 {
   f_clean clean;
@@ -90,23 +107,6 @@ s_struct * struct_init (s_struct *s, const s_sym *module)
   return s;
 }
 
-s_struct * struct_allocate (s_struct *s)
-{
-  s_struct tmp;
-  assert(s);
-  assert(! s->data);
-  tmp = *s;
-  tmp.free_data = true;
-  tmp.data = calloc(1, tmp.type.size);
-  if (! tmp.data) {
-    warn("struct_allocate: data");
-    assert(! "struct_allocate: data: failed to allocate memory");
-    return NULL;
-  }
-  *s = tmp;
-  return s;
-}
-
 s_struct * struct_init_1 (s_struct *s, const s8 *p)
 {
   assert(s);
diff --git a/libc3/struct.h b/libc3/struct.h
index fafc034..d448d80 100644
--- a/libc3/struct.h
+++ b/libc3/struct.h
@@ -40,6 +40,7 @@ s_struct * struct_new_with_data (const s_sym *module, bool free_data,
                                  void *data);
 
 /* Operators. */
+s_struct * struct_allocate (s_struct *s);
 s_struct * struct_set (s_struct *s, const s_sym *key,
                        const s_tag *value);
 
diff --git a/libc3/tag_type.c b/libc3/tag_type.c
index 0733104..2b3d376 100644
--- a/libc3/tag_type.c
+++ b/libc3/tag_type.c
@@ -375,6 +375,58 @@ f_clean tag_type_to_clean (e_tag_type type)
   return NULL;
 }
 
+f_env_eval tag_type_to_env_eval (e_tag_type type)
+{
+  switch (type) {
+  case TAG_VOID:
+    return (f_env_eval) env_eval_void;
+  case TAG_ARRAY:
+    return (f_env_eval) env_eval_array_tag;
+  case TAG_CALL:
+    return (f_env_eval) env_eval_call;
+  case TAG_IDENT:
+    return (f_env_eval) env_eval_ident;
+  case TAG_LIST:
+    return (f_env_eval) env_eval_list;
+  case TAG_MAP:
+    return (f_env_eval) env_eval_map;
+  case TAG_QUOTE:
+    return (f_env_eval) env_eval_quote;
+  case TAG_STRUCT:
+    return (f_env_eval) env_eval_struct;
+  case TAG_TUPLE:
+    return (f_env_eval) env_eval_tuple;
+  case TAG_BOOL:
+  case TAG_CFN:
+  case TAG_CHARACTER:
+  case TAG_F32:
+  case TAG_F64:
+  case TAG_FACT:
+  case TAG_FN:
+  case TAG_INTEGER:
+  case TAG_PTAG:
+  case TAG_PTR:
+  case TAG_PTR_FREE:
+  case TAG_S8:
+  case TAG_S16:
+  case TAG_S32:
+  case TAG_S64:
+  case TAG_SW:
+  case TAG_STR:
+  case TAG_SYM:
+  case TAG_U8:
+  case TAG_U16:
+  case TAG_U32:
+  case TAG_U64:
+  case TAG_UW:
+  case TAG_VAR:
+    return NULL;
+  }
+  warnx("tag_type_to_env_eval: unknown tag type: %d", type);
+  assert(! "tag_type_to_env_eval: unknown tag type");
+  return NULL;
+}
+
 ffi_type * tag_type_to_ffi_type (e_tag_type type)
 {
   switch (type) {
diff --git a/libc3/tag_type.h b/libc3/tag_type.h
index 9263519..6b21782 100644
--- a/libc3/tag_type.h
+++ b/libc3/tag_type.h
@@ -26,6 +26,7 @@ f_clean            tag_type_to_clean (e_tag_type type);
 f_buf_inspect      tag_type_to_buf_inspect (e_tag_type type);
 f_buf_inspect_size tag_type_to_buf_inspect_size (e_tag_type type);
 f_buf_parse        tag_type_to_buf_parse (e_tag_type type);
+f_env_eval         tag_type_to_env_eval (e_tag_type type);
 f_hash_update      tag_type_to_hash_update (e_tag_type type);
 f_init_copy        tag_type_to_init_copy (e_tag_type type);
 const s8 *         tag_type_to_string (e_tag_type type);
diff --git a/libc3/types.h b/libc3/types.h
index cfa2b47..b256996 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -183,6 +183,7 @@ typedef sw (* f_buf_inspect) (s_buf *buf, const void *x);
 typedef sw (* f_buf_inspect_size) (const void *x);
 typedef sw (* f_buf_parse) (s_buf *buf, void *dest);
 typedef void (* f_clean) (void *x);
+typedef bool (* f_env_eval) (s_env *env, const void *x, s_tag *dest);
 typedef void (* f_hash_update) (t_hash *hash, const void *x);
 typedef void * (* f_init_copy) (void *x, const void *src);
 typedef bool (* f_sequence_load) (s_sequence *seq, void *window);