Implement OBLISTs

[muddle-interpreter.git] / src / object.h

diff --git a/src/object.h b/src/object.h
index ec322b5d219547c405b6632735a3a0130fce5663..8ebd80704a39ebdf8a70ba378bb070d34d9f9164 100644 (file)
--- a/src/object.h
+++ b/src/object.h
@@ -192,7 +192,7 @@ typedef struct
 
 typedef struct
 {
-  alignas (8) uint32_t _pad;
+  alignas (8) uint32_t namelen;
   heap_ptr body;
 } atom_val;
 typedef struct
@@ -221,6 +221,18 @@ typedef struct
   uint32_t gc;
 } dope_object;
 
+/// Value half of a poolable object, for storage in a uvector.
+typedef union uv_val
+{
+  fix32_val fix32;
+  fix64_val fix64;
+  list_val list;
+  vector_val vector;
+  uvector_val uvector;
+  subr_val subr;
+  atom_val atom;
+} uv_val;
+
 /// Object of a type that can be stored in the pool.
 /// NB. a pool_object* can point outside the pool; contrast with pool_ptr.
 typedef union pool_object
@@ -231,7 +243,7 @@ typedef union pool_object
     // NB. never take the address of these type-punned fields!
     alignas (16) evaltype type;
     pool_ptr rest;
-    opaque64 val;
+    uv_val val;
   };
   /// objects of statically known type
   fix32_object fix32;
@@ -242,18 +254,6 @@ typedef union pool_object
   atom_object atom;
 } pool_object;
 
-/// Value half of a poolable object, for storage in a uvector.
-typedef union
-{
-  fix32_val fix32;
-  fix64_val fix64;
-  list_val list;
-  vector_val vector;
-  uvector_val uvector;
-  subr_val subr;
-  atom_val atom;
-} uv_val;
-
 union object
 {
   /// any object has a type
@@ -313,6 +313,7 @@ new_list (pool_ptr head)
   ,};
 }
 
+// TODO: take a dope_object like uvector
 static inline vector_object
 new_vector (heap_ptr body, uint32_t length)
 {
@@ -329,7 +330,7 @@ new_uvector (heap_ptr body, uint32_t length)
 {
   return (uvector_object)
   {
-    .type = EVALTYPE_VECTOR,.rest = 0,.val = (uvector_val)
+    .type = EVALTYPE_UVECTOR,.rest = 0,.val = (uvector_val)
     {
     .len = length,.body = body}
   };
@@ -355,22 +356,46 @@ new_subr (void (*fn) ())
 }
 
 static inline atom_object
-new_atom (pool_ptr body)
+new_atom (pool_ptr body, uint32_t namelen)
 {
   return (atom_object)
   {
     .type = EVALTYPE_ATOM,.rest = 0,.val = (atom_val)
     {
-    .body = body}
+    .body = body,.namelen = namelen}
   };
 }
 
+static inline dope_object
+new_dope (uint32_t len, evaltype type)
+{
+  return (dope_object)
+  {
+  .type = type,.grow = 0,.len = len,.gc = 0};
+}
+
 /**
 Common object operations.
 */
 
 uint32_t list_length (const list_object * o);
 
+dope_object *uv_dope (const uvector_object * o);
+
+static inline evaltype
+utype (const uvector_object * o)
+{
+  return uv_dope (o)->type;
+}
+
+// Change the EVALTYPE of an object. New type must have same PRIMTYPE.
+static inline void
+chtype (object * o, evaltype type)
+{
+  assert (TYPEPRIM_EQ (o->type, type));
+  o->type = type;
+}
+
 /**
 Checked downcasts.
 */
@@ -403,4 +428,11 @@ as_pool (object * p)
   return (pool_object *) p;
 }
 
+static inline atom_object *
+as_atom (object * o)
+{
+  assert (TYPEPRIM_EQ (o->type, EVALTYPE_ATOM));
+  return &o->atom;
+}
+
 #endif // OBJECT_H