X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=src%2Fobject.h;h=1435f5d353098a0105296df4b9fe01ac116a996d;hb=refs%2Fheads%2Fmaster;hp=b62cacbd7793db78966e9cc86da31715d05b6491;hpb=c25d7ca5386582feba3d02f69a7425ea5b868bc7;p=muddle-interpreter.git

diff --git a/src/object.h b/src/object.h
index b62cacb..1435f5d 100644
--- a/src/object.h
+++ b/src/object.h
@@ -1,5 +1,5 @@
 /*
-Copyright (C) 2017 Keziah Wesley
+Copyright (C) 2017-2018 Keziah Wesley
 
 You can redistribute and/or modify this file under the terms of the
 GNU Affero General Public License as published by the Free Software
@@ -31,14 +31,18 @@ typedef uint32_t evaltype;
 enum
 {
 // pool OK
+  TYPEPRIM_LOSE = 0x00000000,
   TYPEPRIM_FIX32 = 0x00010000,
   TYPEPRIM_FIX64 = 0x00020000,
   TYPEPRIM_LIST = 0x00030000,
   TYPEPRIM_VECTOR = 0x00040000,
-  TYPEPRIM_SUBR = 0x00050000,
+  TYPEPRIM_UVECTOR = 0x00050000,
+  TYPEPRIM_SUBR = 0x00060000,
+  TYPEPRIM_ATOM = 0x00070000,
 
 // can't be in pool
   TYPEPRIM_NOPOOL_MASK = 0x70000000,
+  TYPEPRIM_VECTOR_BODY = 0x70000000,
   TYPEPRIM_TUPLE = 0x70010000,
 
 // TYPEPRIM is half of EVALTYPE
@@ -47,6 +51,8 @@ enum
 
 enum
 {
+  EVALTYPE_LOSE = TYPEPRIM_LOSE,
+
   EVALTYPE_FIX32 = TYPEPRIM_FIX32,
 
   EVALTYPE_FIX64 = TYPEPRIM_FIX64,
@@ -57,8 +63,16 @@ enum
 
   EVALTYPE_VECTOR = TYPEPRIM_VECTOR,
 
+  EVALTYPE_UVECTOR = TYPEPRIM_UVECTOR,
+  EVALTYPE_OBLIST,
+
   EVALTYPE_SUBR = TYPEPRIM_SUBR,
 
+  EVALTYPE_ATOM = TYPEPRIM_ATOM,
+
+  EVALTYPE_VECTOR_BODY = TYPEPRIM_VECTOR_BODY,
+  EVALTYPE_ATOM_BODY,
+
   EVALTYPE_TUPLE = TYPEPRIM_TUPLE,
 };
 
@@ -106,44 +120,97 @@ about types.
 
 typedef union object object;
 
+typedef struct
+{
+  alignas (8)
+    // layout so that value can be upcast by reinterpreting as a fix64
+#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
+  int32_t n;
+  uint32_t _pad;
+#elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
+  uint32_t _pad;
+  int32_t n;
+#else
+#error Unusual endianness?
+#endif
+} fix32_val;
 typedef struct
 {
   alignas (16) evaltype type;
   pool_ptr rest;
-  uint32_t _pad;
-  int32_t val;
+  fix32_val val;
 } fix32_object;
 
+typedef struct
+{
+  alignas (8) int64_t n;
+} fix64_val;
 typedef struct
 {
   alignas (16) evaltype type;
   pool_ptr rest;
-  int64_t val;
+  fix64_val val;
 } fix64_object;
 
+typedef struct
+{
+  alignas (8) uint32_t _pad;
+  pool_ptr head;
+} list_val;
 typedef struct
 {
   alignas (16) evaltype type;
   pool_ptr rest;
-  uint32_t _pad;
-  pool_ptr head;
+  list_val val;
 } list_object;
 
+typedef struct
+{
+  alignas (8) uint32_t len;
+  heap_ptr body;
+} vector_val;
 typedef struct
 {
   alignas (16) evaltype type;
   pool_ptr rest;
-  uint32_t len;
-  heap_ptr body;
+  vector_val val;
 } vector_object;
 
+typedef struct
+{
+  alignas (8) uint32_t len;
+  heap_ptr body;
+} uvector_val;
 typedef struct
 {
   alignas (16) evaltype type;
   pool_ptr rest;
-  void (*fn) ();
+  uvector_val val;
+} uvector_object;
+
+typedef struct
+{
+  alignas (8) void (*fn) ();
+} subr_val;
+typedef struct
+{
+  alignas (16) evaltype type;
+  pool_ptr rest;
+  subr_val val;
 } subr_object;
 
+typedef struct
+{
+  alignas (8) uint32_t namelen;
+  heap_ptr body;
+} atom_val;
+typedef struct
+{
+  alignas (16) evaltype type;
+  pool_ptr rest;
+  atom_val val;
+} atom_object;
+
 typedef struct
 {
   alignas (16)
@@ -155,6 +222,26 @@ typedef struct
   // uniq_id uid ??
 } tuple_object;
 
+typedef struct
+{
+  alignas (16) evaltype type;
+  uint32_t grow;
+  uint32_t len;
+  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
@@ -162,15 +249,19 @@ typedef union pool_object
   /// any pool object has a type and a rest
   struct
   {
+    // 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;
   fix64_object fix64;
   list_object list;
   vector_object vector;
+  uvector_object uvector;
+  atom_object atom;
+  subr_object subr;
 } pool_object;
 
 union object
@@ -178,9 +269,14 @@ union object
   /// any object has a type
   struct
   {
+    // NB. never take the address of these type-punned fields!
     alignas (16) evaltype type;
     opaque32 _unknown0;
-    opaque64 _unknown1;
+    union
+    {
+      opaque64 _unknown1;
+      uv_val uv_val;
+    };
   };
   /// objects of statically known type
   /// use as_X() for checked downcast
@@ -189,7 +285,10 @@ union object
   fix64_object fix64;
   list_object list;
   vector_object vector;
+  uvector_object uvector;
+  atom_object atom;
   tuple_object tuple;
+  subr_object subr;
 };
 
 /**
@@ -201,7 +300,10 @@ new_fix32 (int32_t n)
 {
   return (fix32_object)
   {
-  .type = EVALTYPE_FIX32,.rest = 0,.val = n};
+    .type = EVALTYPE_FIX32,.rest = 0,.val = (fix32_val)
+    {
+    .n = n}
+  };
 }
 
 static inline fix64_object
@@ -209,7 +311,10 @@ new_fix64 (int64_t n)
 {
   return (fix64_object)
   {
-  .type = EVALTYPE_FIX64,.rest = 0,.val = n};
+    .type = EVALTYPE_FIX64,.rest = 0,.val = (fix64_val)
+    {
+    .n = n}
+  };
 }
 
 static inline list_object
@@ -217,7 +322,10 @@ new_list (pool_ptr head)
 {
   return (list_object)
   {
-  .type = EVALTYPE_LIST,.rest = 0,.head = head,};
+    .type = EVALTYPE_LIST,.rest = 0,.val = (list_val)
+    {
+    .head = head}
+  ,};
 }
 
 static inline vector_object
@@ -225,7 +333,21 @@ new_vector (heap_ptr body, uint32_t length)
 {
   return (vector_object)
   {
-  .type = EVALTYPE_VECTOR,.rest = 0,.len = length,.body = body,};
+    .type = EVALTYPE_VECTOR,.rest = 0,.val = (vector_val)
+    {
+    .len = length,.body = body}
+  ,};
+}
+
+static inline uvector_object
+new_uvector (heap_ptr body, uint32_t length)
+{
+  return (uvector_object)
+  {
+    .type = EVALTYPE_UVECTOR,.rest = 0,.val = (uvector_val)
+    {
+    .len = length,.body = body}
+  };
 }
 
 static inline tuple_object
@@ -233,7 +355,7 @@ new_tuple (object * body, uint32_t length)
 {
   return (tuple_object)
   {
-  .type = EVALTYPE_TUPLE,.len = length,.body = body,};
+  .type = EVALTYPE_TUPLE,.len = length,.body = body};
 }
 
 static inline subr_object
@@ -241,7 +363,29 @@ new_subr (void (*fn) ())
 {
   return (subr_object)
   {
-  .type = EVALTYPE_SUBR,.rest = 0,.fn = fn,};
+    .type = EVALTYPE_SUBR,.rest = 0,.val = (subr_val)
+    {
+    .fn = fn}
+  };
+}
+
+static inline atom_object
+new_atom (pool_ptr body, uint32_t namelen)
+{
+  return (atom_object)
+  {
+    .type = EVALTYPE_ATOM,.rest = 0,.val = (atom_val)
+    {
+    .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};
 }
 
 /**
@@ -250,10 +394,45 @@ Common object operations.
 
 uint32_t list_length (const list_object * o);
 
+dope_object *vec_dope (const vector_object * o);
+
+dope_object *uv_dope (const uvector_object * o);
+
+static inline evaltype
+utype (const uvector_object * o)
+{
+  return uv_dope (o)->type;
+}
+
+object
+uv_get (const uvector_object * o, uint32_t i);
+
+
+// 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;
+}
+
+// Allocate an vector of LOSEs and return a handle with length=0.
+vector_object vector_create (uint32_t capacity);
+
+// Stack-like interface to a VECTOR (with automatic GROW!)
+object *stack_push (vector_object * v);
+
 /**
 Checked downcasts.
 */
 
+static inline fix32_object *
+as_fix32 (object * o)
+{
+  assert (TYPEPRIM_EQ (o->type, TYPEPRIM_FIX32));
+  return &o->fix32;
+}
+
 static inline list_object *
 as_list (object * o)
 {
@@ -268,6 +447,13 @@ as_vector (object * o)
   return &o->vector;
 }
 
+static inline uvector_object *
+as_uvector (object * o)
+{
+  assert (TYPEPRIM_EQ (o->type, EVALTYPE_UVECTOR));
+  return &o->uvector;
+}
+
 static inline pool_object *
 as_pool (object * p)
 {
@@ -275,4 +461,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