diff options
| -rw-r--r-- | pez.c | 132 |
1 files changed, 127 insertions, 5 deletions
@@ -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; |