basic records

1 files changed, 127 insertions, 5 deletions

diff --git a/pez.c b/pez.c
index db36848..8201437 100644
--- a/pez.c
+++ b/pez.c
@@ -797,12 +797,50 @@ static void
 delarray(PezContext *cx, Array *arr)
 {
     if (arr->dat) {
-        cxfree(cx, arr->dat, arr->cap * sizeof(Val)); 
+        cxfree(cx, arr->dat, arr->cap * sizeof(Val));
         arr->dat = NULL;
     }
     arr->len = arr->cap = 0;
 }
 
+static size_t
+sizeofrecord(Record *rc)
+{
+    return sizeof *rc + sizeof(struct KV) * (1 << rc->exp);
+}
+
+static Record *
+newrecord(PezContext *cx, uint n, Val *kvs)
+{
+    int exp;
+    Record *rc = NULL;
+    for (exp = 1; (n * 2) >= (1 << exp); ++exp) ;
+    TRY(rc = newobj(cx, PEZ_TRecord, sizeof(Record) + sizeof(struct KV) * (1 << exp)));
+    rc->count = n;
+    rc->exp = exp;
+    for (Val *k = kvs; k < kvs + 2*n; k += 2) {
+        Val *v = k + 1;
+        uint M = (1 << exp) - 1;
+        uint32_t idx = splittable64(k->r) & M;
+        if (k->r == VOID.r) {
+            pez_error(cx, "", "attempt to create record with void key");
+            return NULL;
+        }
+        for (;; idx = (idx + 1) & M) {
+            if (rc->dat[idx].k.r == k->r) {
+                pez_error(cx, "", "duplicate key in record");
+                return NULL;
+            }
+            if (!rc->dat[idx].k.r) {
+                rc->dat[idx].k = *k;
+                rc->dat[idx].v = *v;
+                break;
+            }
+        }
+    }
+    return rc;
+}
+
 static void
 delstring(PezContext *cx, Str *str)
 {
@@ -861,6 +899,9 @@ delobj(PezContext *cx, Obj *o)
     case PEZ_TDilambda:
         sz = sizeof(Dilambda);
         break;
+    case PEZ_TRecord:
+        sz = sizeofrecord((Record *)o);
+        break;
     }
     assert(sz);
     cxfree(cx, o, sz);
@@ -1102,6 +1143,7 @@ fixtrunc(fixnum f) { return f & ~(uint32_t)0xFFF; }
     /* constructors */        \
     _(newarr, 000)            \
     _(arradd, 000)            \
+    _(newrec, 000)            \
     /* control flow */        \
     _(ret,    0)              \
     _(b,      0)              \
@@ -1250,7 +1292,7 @@ inspectproto(Proto *pr)
                 fprintf(stderr, "<%p>", opr);
             }
             break;
-        case Oapply: case Osetapp: case Onewarr: case Oarradd:
+        case Oapply: case Osetapp: case Onewarr: case Oarradd: case Onewrec:
             ++ip;
             fprintf(stderr, "%d", *argp);
             break;
@@ -1384,6 +1426,22 @@ apply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n)
         }
         TRY(checkindex(cx, &idx, srcfn, srcpc, "array", arr->len, arg));
         *ret = arr->dat[idx];
+    } else if (isobj_of(recv, PEZ_TRecord)) {
+        Record *rc = unbox_obj(recv);
+        if (n != 1) {
+            return runerr(cx, srcfn, srcpc, "record access takes one argument (got %d)", n), 0;
+        }
+        arg = args[0];
+        uint32_t idx = splittable64(arg.r), M = (1 << rc->exp) - 1;
+        for (idx &= M;; idx = (idx + 1) & M) {
+            if (!rc->count || !rc->dat[idx].k.r) {
+                return runerr(cx, srcfn, srcpc, "access of non existant entry in record"), 0;
+            }
+            if (rc->dat[idx].k.r == arg.r) {
+                *ret = rc->dat[idx].v;
+                break;
+            }
+        }
     } else if (issstr(recv) || isobj_of(recv, PEZ_TString)) {
         char buf[8];
         const char *str;
@@ -1442,6 +1500,22 @@ setapply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n, Val
         }
         TRY(checkindex(cx, &idx, srcfn, srcpc, "array", arr->len, arg));
         *ret = arr->dat[idx] = rval;
+    } else if (isobj_of(recv, PEZ_TRecord)) {
+        Record *rc = unbox_obj(recv);
+        if (n != 1) {
+            return runerr(cx, srcfn, srcpc, "record access takes one argument (got %d)", n), 0;
+        }
+        arg = args[0];
+        uint32_t idx = splittable64(arg.r), M = (1 << rc->exp) - 1;
+        for (idx &= M;; idx = (idx + 1) & M) {
+            if (!rc->count || !rc->dat[idx].k.r) {
+                return runerr(cx, srcfn, srcpc, "access of non existant entry in record"), 0;
+            }
+            if (rc->dat[idx].k.r == arg.r) {
+                *ret = rc->dat[idx].v = rval;
+                break;
+            }
+        }
     } else if (issstr(recv) || isobj_of(recv, PEZ_TString)) {
         return runerr(cx, srcfn, srcpc, "cannot mutate string"), 0;
     } else {
@@ -1828,6 +1902,13 @@ exefn(PezContext *cx, Fn *fn, uint nargs)
             TRY(arrpushn(cx, arr, stktop - n, n));
             stktop -= n;
         }
+        CASE(Onewrec) {
+            uint8_t n = code[ip++];
+            Record *rc;
+            TRY((rc = newrecord(cx, n, stktop - 2*n)) != NULL);
+            stktop -= n + 1;
+            push(box_obj(rc));
+        }
         CASE(Ob) {
             int16_t off;
             uint dst;
@@ -1882,8 +1963,8 @@ xprint1(PezContext *cx, struct vals *seen,
 {
     for (uint i = 0; i < seen->len; ++i) {
         if (seen->at[i].r == v.r) {
-            char buf[20];
-            int n = sprintf(buf, "#%d", i);
+            char buf[24];
+            int n = sprintf(buf, "#%d#", i);
             return cb(cx, u, buf, n);
         }
     }
@@ -1923,7 +2004,7 @@ xprint1(PezContext *cx, struct vals *seen,
             } else if (isprint(str[i])) {
                 ok &= cb(cx, u, &str[i], 1);
             } else {
-                char tmp[5];
+                char tmp[8];
                 sprintf(tmp, "\\x%.2X", (unsigned char)str[i]);
                 ok &= cb(cx, u, tmp, 4);
             }
@@ -1957,6 +2038,24 @@ xprint1(PezContext *cx, struct vals *seen,
         }
         ok &= cb(cx, u, "]", 1);
         TRY(ok);
+    } else if (isobj_of(v, PEZ_TRecord)) {
+        Record *rec= unbox_obj(v);
+        bool ok = 1;
+        TRY(vecpush(cx, seen, &v, 1));
+        ok &= cb(cx, u, "#{", 2);
+        for (uint i = 0, n = 0; i < (1 << rec->exp); ++i) {
+            struct KV *kv = &rec->dat[i];
+            if (kv->k.r) {
+                ok &= xprint1(cx, seen, cb, u, kv->k);
+                ok &= cb(cx, u, " ", 1);
+                ok &= xprint1(cx, seen, cb, u, kv->v);
+                if (n++ != rec->count - 1) {
+                    ok &= cb(cx, u, ", ", 2);
+                }
+            }
+        }
+        ok &= cb(cx, u, "}", 1);
+        TRY(ok);
     } else {
         TRY(cb(cx, u, "#<?\?\?>", 6));
     }
@@ -2926,8 +3025,31 @@ primaryexpr(Comp *cm)
                 }
             }
             TRY(compop(cm, big ? Oarradd : Onewarr));
+            TRY(compbyte(cm, n));
             compeffect(cm, big ? -n : -n + 1);
+            return 1;
+        } else if (c == '{') {
+            // record
+            int n = 0;
+            nextchr(cm);
+            cm->lvalue = 0;
+            for (; !matchspchr(cm, '}');) {
+                TRY(expr(cm));
+                TRY(flushconst(cm));
+                TRY(expr(cm));
+                TRY(flushconst(cm));
+                ++n;
+                if (!matchspchr(cm, ',')) {
+                    TRY(expectspchr(cm, '}'));
+                    break;
+                }
+            }
+            if (n > 255) {
+                return comperr(cm, peekchr(cm), "record literal too big"), 0;
+            }
+            TRY(compop(cm, Onewrec));
             TRY(compbyte(cm, n));
+            compeffect(cm, -n + 1);
             return 1;
         } else if (c == EOF || aisspace(c)) {
             return comperr(cm, c, "stray '#'"), 0;