src/object.h

   1 /*
   2 Copyright (C) 2017-2018 Keziah Wesley
   3
   4 You can redistribute and/or modify this file under the terms of the
   5 GNU Affero General Public License as published by the Free Software
   6 Foundation, either version 3 of the License, or (at your option) any
   7 later version.
   8
   9 This file is distributed in the hope that it will be useful, but
  10 WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12 Affero General Public License for more details.
  13
  14 You should have received a copy of the GNU Affero General Public
  15 License along with this file. If not, see
  16 <http://www.gnu.org/licenses/>.
  17 */
  18
  19 #ifndef OBJECT_H
  20 #define OBJECT_H
  21
  22 #include "alloc.h"
  23
  24 #include <assert.h>
  25 #include <stdalign.h>
  26 #include <stdbool.h>
  27 #include <stdint.h>
  28
  29 typedef uint32_t evaltype;
  30
  31 enum
  32 {
  33 // pool OK
  34   TYPEPRIM_LOSE = 0x00000000,
  35   TYPEPRIM_FIX32 = 0x00010000,
  36   TYPEPRIM_FIX64 = 0x00020000,
  37   TYPEPRIM_LIST = 0x00030000,
  38   TYPEPRIM_VECTOR = 0x00040000,
  39   TYPEPRIM_UVECTOR = 0x00050000,
  40   TYPEPRIM_SUBR = 0x00060000,
  41   TYPEPRIM_ATOM = 0x00070000,
  42
  43 // can't be in pool
  44   TYPEPRIM_NOPOOL_MASK = 0x70000000,
  45   TYPEPRIM_VECTOR_BODY = 0x70000000,
  46   TYPEPRIM_TUPLE = 0x70010000,
  47
  48 // TYPEPRIM is half of EVALTYPE
  49   TYPEPRIM_MASK = 0x7fff0000
  50 };
  51
  52 enum
  53 {
  54   EVALTYPE_LOSE = TYPEPRIM_LOSE,
  55
  56   EVALTYPE_FIX32 = TYPEPRIM_FIX32,
  57
  58   EVALTYPE_FIX64 = TYPEPRIM_FIX64,
  59
  60   EVALTYPE_LIST = TYPEPRIM_LIST,
  61   EVALTYPE_FORM,
  62   EVALTYPE_FALSE,
  63
  64   EVALTYPE_VECTOR = TYPEPRIM_VECTOR,
  65
  66   EVALTYPE_UVECTOR = TYPEPRIM_UVECTOR,
  67   EVALTYPE_OBLIST,
  68
  69   EVALTYPE_SUBR = TYPEPRIM_SUBR,
  70
  71   EVALTYPE_ATOM = TYPEPRIM_ATOM,
  72
  73   EVALTYPE_VECTOR_BODY = TYPEPRIM_VECTOR_BODY,
  74   EVALTYPE_ATOM_BODY,
  75
  76   EVALTYPE_TUPLE = TYPEPRIM_TUPLE,
  77 };
  78
  79 static inline uint32_t
  80 TYPEPRIM (evaltype x)
  81 {
  82   return x & TYPEPRIM_MASK;
  83 }
  84
  85 static inline bool
  86 TYPEPRIM_EQ (evaltype a, evaltype b)
  87 {
  88   return !((a ^ b) & TYPEPRIM_MASK);
  89 }
  90
  91 typedef struct
  92 {
  93   uint32_t _dummy;
  94 } opaque32;
  95 typedef struct
  96 {
  97   uint64_t _dummy;
  98 } opaque64;
  99
 100 /**
 101 Object types.
 102
 103 An Object's value is accessed through a concrete `foo_object`
 104 type.
 105
 106 `object` can be used to refer to Objects of unspecified type, which
 107 are opaque except for their `type` field. Checked downcasts can be
 108 performed via the `as_foo` functions; unchecked downcasts via
 109 `object.foo` (use only when type information is locally
 110 obvious). Some objects can be upcast to more specific supertypes,
 111 such as `pool_object` for objects that are known to be storeable in
 112 the pool.
 113
 114 The generic `object` type should not be used to accept parameters
 115 that have constraints on their type, and should not be used to
 116 return objects that are of a statically-known type. Encoding type
 117 information in function signatures allows strictly local reasoning
 118 about types.
 119 */
 120
 121 typedef union object object;
 122
 123 typedef struct
 124 {
 125   alignas (8) uint32_t _pad;
 126   int32_t n;
 127 } fix32_val;
 128 typedef struct
 129 {
 130   alignas (16) evaltype type;
 131   pool_ptr rest;
 132   fix32_val val;
 133 } fix32_object;
 134
 135 typedef struct
 136 {
 137   alignas (8) int64_t n;
 138 } fix64_val;
 139 typedef struct
 140 {
 141   alignas (16) evaltype type;
 142   pool_ptr rest;
 143   fix64_val val;
 144 } fix64_object;
 145
 146 typedef struct
 147 {
 148   alignas (8) uint32_t _pad;
 149   pool_ptr head;
 150 } list_val;
 151 typedef struct
 152 {
 153   alignas (16) evaltype type;
 154   pool_ptr rest;
 155   list_val val;
 156 } list_object;
 157
 158 typedef struct
 159 {
 160   alignas (8) uint32_t len;
 161   heap_ptr body;
 162 } vector_val;
 163 typedef struct
 164 {
 165   alignas (16) evaltype type;
 166   pool_ptr rest;
 167   vector_val val;
 168 } vector_object;
 169
 170 typedef struct
 171 {
 172   alignas (8) uint32_t len;
 173   heap_ptr body;
 174 } uvector_val;
 175 typedef struct
 176 {
 177   alignas (16) evaltype type;
 178   pool_ptr rest;
 179   uvector_val val;
 180 } uvector_object;
 181
 182 typedef struct
 183 {
 184   alignas (8) void (*fn) ();
 185 } subr_val;
 186 typedef struct
 187 {
 188   alignas (16) evaltype type;
 189   pool_ptr rest;
 190   subr_val val;
 191 } subr_object;
 192
 193 typedef struct
 194 {
 195   alignas (8) uint32_t namelen;
 196   heap_ptr body;
 197 } atom_val;
 198 typedef struct
 199 {
 200   alignas (16) evaltype type;
 201   pool_ptr rest;
 202   atom_val val;
 203 } atom_object;
 204
 205 typedef struct
 206 {
 207   alignas (16)
 208     /// no rest; is a NOPOOL type
 209   evaltype type;
 210   uint32_t len;
 211   /// allocation can be anywhere
 212   object *body;
 213   // uniq_id uid ??
 214 } tuple_object;
 215
 216 typedef struct
 217 {
 218   alignas (16) evaltype type;
 219   uint32_t grow;
 220   uint32_t len;
 221   uint32_t gc;
 222 } dope_object;
 223
 224 /// Value half of a poolable object, for storage in a uvector.
 225 typedef union uv_val
 226 {
 227   fix32_val fix32;
 228   fix64_val fix64;
 229   list_val list;
 230   vector_val vector;
 231   uvector_val uvector;
 232   subr_val subr;
 233   atom_val atom;
 234 } uv_val;
 235
 236 /// Object of a type that can be stored in the pool.
 237 /// NB. a pool_object* can point outside the pool; contrast with pool_ptr.
 238 typedef union pool_object
 239 {
 240   /// any pool object has a type and a rest
 241   struct
 242   {
 243     // NB. never take the address of these type-punned fields!
 244     alignas (16) evaltype type;
 245     pool_ptr rest;
 246     uv_val val;
 247   };
 248   /// objects of statically known type
 249   fix32_object fix32;
 250   fix64_object fix64;
 251   list_object list;
 252   vector_object vector;
 253   uvector_object uvector;
 254   atom_object atom;
 255   subr_object subr;
 256 } pool_object;
 257
 258 union object
 259 {
 260   /// any object has a type
 261   struct
 262   {
 263     // NB. never take the address of these type-punned fields!
 264     alignas (16) evaltype type;
 265     opaque32 _unknown0;
 266     opaque64 _unknown1;
 267   };
 268   /// objects of statically known type
 269   /// use as_X() for checked downcast
 270   pool_object pool;
 271   fix32_object fix32;
 272   fix64_object fix64;
 273   list_object list;
 274   vector_object vector;
 275   uvector_object uvector;
 276   atom_object atom;
 277   tuple_object tuple;
 278   subr_object subr;
 279 };
 280
 281 /**
 282 Initialization helpers.
 283 */
 284
 285 static inline fix32_object
 286 new_fix32 (int32_t n)
 287 {
 288   return (fix32_object)
 289   {
 290     .type = EVALTYPE_FIX32,.rest = 0,.val = (fix32_val)
 291     {
 292     .n = n}
 293   };
 294 }
 295
 296 static inline fix64_object
 297 new_fix64 (int64_t n)
 298 {
 299   return (fix64_object)
 300   {
 301     .type = EVALTYPE_FIX64,.rest = 0,.val = (fix64_val)
 302     {
 303     .n = n}
 304   };
 305 }
 306
 307 static inline list_object
 308 new_list (pool_ptr head)
 309 {
 310   return (list_object)
 311   {
 312     .type = EVALTYPE_LIST,.rest = 0,.val = (list_val)
 313     {
 314     .head = head}
 315   ,};
 316 }
 317
 318 // TODO: take a dope_object like uvector
 319 static inline vector_object
 320 new_vector (heap_ptr body, uint32_t length)
 321 {
 322   return (vector_object)
 323   {
 324     .type = EVALTYPE_VECTOR,.rest = 0,.val = (vector_val)
 325     {
 326     .len = length,.body = body}
 327   ,};
 328 }
 329
 330 static inline uvector_object
 331 new_uvector (heap_ptr body, uint32_t length)
 332 {
 333   return (uvector_object)
 334   {
 335     .type = EVALTYPE_UVECTOR,.rest = 0,.val = (uvector_val)
 336     {
 337     .len = length,.body = body}
 338   };
 339 }
 340
 341 static inline tuple_object
 342 new_tuple (object * body, uint32_t length)
 343 {
 344   return (tuple_object)
 345   {
 346   .type = EVALTYPE_TUPLE,.len = length,.body = body};
 347 }
 348
 349 static inline subr_object
 350 new_subr (void (*fn) ())
 351 {
 352   return (subr_object)
 353   {
 354     .type = EVALTYPE_SUBR,.rest = 0,.val = (subr_val)
 355     {
 356     .fn = fn}
 357   };
 358 }
 359
 360 static inline atom_object
 361 new_atom (pool_ptr body, uint32_t namelen)
 362 {
 363   return (atom_object)
 364   {
 365     .type = EVALTYPE_ATOM,.rest = 0,.val = (atom_val)
 366     {
 367     .body = body,.namelen = namelen}
 368   };
 369 }
 370
 371 static inline dope_object
 372 new_dope (uint32_t len, evaltype type)
 373 {
 374   return (dope_object)
 375   {
 376   .type = type,.grow = 0,.len = len,.gc = 0};
 377 }
 378
 379 /**
 380 Common object operations.
 381 */
 382
 383 uint32_t list_length (const list_object * o);
 384
 385 dope_object *vec_dope (const vector_object * o);
 386
 387 dope_object *uv_dope (const uvector_object * o);
 388
 389 static inline evaltype
 390 utype (const uvector_object * o)
 391 {
 392   return uv_dope (o)->type;
 393 }
 394
 395 // Change the EVALTYPE of an object. New type must have same PRIMTYPE.
 396 static inline void
 397 chtype (object * o, evaltype type)
 398 {
 399   assert (TYPEPRIM_EQ (o->type, type));
 400   o->type = type;
 401 }
 402
 403 // Allocate an vector of LOSEs and return a handle with length=0.
 404 vector_object vector_create (uint32_t capacity);
 405
 406 // Stack-like interface to a VECTOR (with automatic GROW!)
 407 object *stack_push (vector_object * v);
 408
 409 /**
 410 Checked downcasts.
 411 */
 412
 413 static inline list_object *
 414 as_list (object * o)
 415 {
 416   assert (TYPEPRIM_EQ (o->type, EVALTYPE_LIST));
 417   return &o->list;
 418 }
 419
 420 static inline vector_object *
 421 as_vector (object * o)
 422 {
 423   assert (TYPEPRIM_EQ (o->type, EVALTYPE_VECTOR));
 424   return &o->vector;
 425 }
 426
 427 static inline uvector_object *
 428 as_uvector (object * o)
 429 {
 430   assert (TYPEPRIM_EQ (o->type, EVALTYPE_UVECTOR));
 431   return &o->uvector;
 432 }
 433
 434 static inline pool_object *
 435 as_pool (object * p)
 436 {
 437   assert (!(TYPEPRIM (p->type) & TYPEPRIM_NOPOOL_MASK));
 438   return (pool_object *) p;
 439 }
 440
 441 static inline atom_object *
 442 as_atom (object * o)
 443 {
 444   assert (TYPEPRIM_EQ (o->type, EVALTYPE_ATOM));
 445   return &o->atom;
 446 }
 447
 448 #endif // OBJECT_H