diff options
| -rw-r--r-- | pez.c | 158 | ||||
| -rw-r--r-- | test.pez | 40 |
2 files changed, 156 insertions, 42 deletions
@@ -98,6 +98,11 @@ typedef struct Fn { Upval *upval[]; } Fn; +typedef struct Dilambda { + OBJHEADER; + Fn *getf, *setf; +} Dilambda; + typedef struct Local Local; enum { NAMEMAX = 80 }; @@ -233,12 +238,13 @@ typestr(Val v) return "void"; if (isobj(v)) { switch (objtag(v)) { - case PEZ_TString: return "string"; - case PEZ_TTuple: return "tuple"; - case PEZ_TRecord: return "record"; - case PEZ_TArray: return "array"; - case PEZ_TFn: return "function"; - case PEZ_TFnProto: return "(function prototype)"; + case PEZ_TString: return "string"; + case PEZ_TTuple: return "tuple"; + case PEZ_TRecord: return "record"; + case PEZ_TArray: return "array"; + case PEZ_TFn: return "function"; + case PEZ_TFnProto: return "(function prototype)"; + case PEZ_TDilambda: return "dilambda"; } } if (isnum(v)) @@ -728,6 +734,18 @@ delstring(PezContext *cx, Str *str) --cx->strpool.count; } +static Dilambda * +newdilambda(PezContext *cx, Fn *getf, Fn *setf) +{ + Dilambda *dl = newobj(cx, PEZ_TDilambda, sizeof *dl); + assert(setf->proto->nparams >= 1); + if (dl) { + dl->getf = getf; + dl->setf = setf; + } + return dl; +} + /******/ /* GC */ /******/ @@ -756,6 +774,9 @@ delobj(PezContext *cx, Obj *o) case PEZ_TUpval: sz = sizeof(Upval); break; + case PEZ_TDilambda: + sz = sizeof(Dilambda); + break; } assert(sz); cxfree(cx, o, sz); @@ -795,6 +816,13 @@ markarray(PezContext *cx, Array *arr) } static void +markdilambda(PezContext *cx, Dilambda *dl) +{ + gcmark(cx, (Obj *)dl->getf); + gcmark(cx, (Obj *)dl->setf); +} + +static void gcmark(PezContext *cx, Obj *o) { assert(cx->gccanrun); @@ -815,6 +843,9 @@ gcmark(PezContext *cx, Obj *o) case PEZ_TArray: markarray(cx, (Array *)o); break; + case PEZ_TDilambda: + markdilambda(cx, (Dilambda *)o); + break; } } @@ -826,6 +857,8 @@ gc(PezContext *cx) fprintf(stderr, "--- GC running with %d bytes allocated\n", nalloc); } + + /* mark roots */ for (Val *stk = cx->stack; stk != cx->stktop; ++stk) { if (isobj(*stk)) { gcmark(cx, unbox_obj(*stk)); @@ -844,6 +877,8 @@ gc(PezContext *cx) } } } + + /* sweep */ for (Obj *o = cx->heap, *next, *prev = NULL; o; o = next) { next = o->next; if (o->gc) { @@ -1255,6 +1290,15 @@ apply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n) assert(cx->stktop > cx->stack); *ret = *peek(cx); cx->stktop = stktop; + } else if (isobj_of(recv, PEZ_TDilambda)) { + Fn *getf = ((Dilambda *)unbox_obj(recv))->getf; + if (getf->proto->variadic ? n < getf->proto->nparams : n != getf->proto->nparams) { + runerr(cx, srcfn, srcpc, "dilambda getter takes %d arg(s), %d %s given", + getf->proto->nparams, n, n == 1 ? "was" : "were"); + return 0; + } + TRY(exefn(cx, getf, n)); + *ret = pop(cx); } else if (isobj_of(recv, PEZ_TArray)) { Array *arr = unbox_obj(recv); if (n != 1) { @@ -1305,6 +1349,19 @@ setapply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n, Val if (isobj_of(recv, PEZ_TFn) || iscfn(recv)) { runerr(cx, srcfn, srcpc, "procedure has no setter"); return 0; + } else if (isobj_of(recv, PEZ_TDilambda)) { + Fn *setf = ((Dilambda *)unbox_obj(recv))->setf; + int nparams = setf->proto->nparams - 1; + assert(setf->proto->nparams >= 0); + if (setf->proto->variadic ? n < nparams : n != nparams) { + runerr(cx, srcfn, srcpc, "dilambda setter takes %d arg(s), %d %s given", + nparams, n, n == 1 ? "was" : "were"); + return 0; + } + TRY(push(cx, rval)); + TRY(exefn(cx, setf, n + 1)); + *ret = pop(cx); + pop(cx); } else if (isobj_of(recv, PEZ_TArray)) { Array *arr = unbox_obj(recv); if (n != 1) { @@ -1322,7 +1379,7 @@ setapply(PezContext *cx, Val *ret, void *srcfn, int srcpc, Val recv, uint n, Val runerr(cx, srcfn, srcpc, "cannot mutate string"); return 0; } else { - runerr(cx, srcfn, srcpc, "%s value is not applicable", typestr(recv)); + runerr(cx, srcfn, srcpc, "%s value is not settable", typestr(recv)); return 0; } return 1; @@ -1780,6 +1837,8 @@ xprint1(PezContext *cx, struct vals *seen, } else { TRY(cb(cx, u, "#<function>", 11)); } + } else if (isobj_of(v, PEZ_TDilambda)) { + TRY(cb(cx, u, "#<dilambda>", 12)); } else if (isobj_of(v, PEZ_TArray)) { Array *arr = unbox_obj(v); bool ok = 1; @@ -1895,9 +1954,54 @@ Err: return 0; } +static bool +f_dilambda(PezContext *cx, int argc) +{ + Dilambda *dl; + if (argc != 2) { + pez_error(cx, "dilambda", "expected two arguments"); + return 0; + } + if (!isobj_of(cx->stktop[-2], PEZ_TFn) || !isobj_of(cx->stktop[-1], PEZ_TFn)) { + pez_error(cx, "dilambda", "expected two function arguments"); + return 0; + } + if (((Fn *)unbox_obj(cx->stktop[-1]))->proto->nparams < 1) { + pez_error(cx, "dilambda", "setter should take at least one argument"); + return 0; + } + TRY(dl = newdilambda(cx, unbox_obj(cx->stktop[-2]), unbox_obj(cx->stktop[-1]))); + TRY(push(cx, box_obj(dl))); + return 1; +} + +static bool +f_arrayfill(PezContext *cx, int argc) +{ + fixnum n; + Array *arr; + if (argc != 2) { + pez_error(cx, "array#fill", "expected two arguments"); + return 0; + } + n = unbox_num(cx->stktop[-2]); + if (!isnum(cx->stktop[-2]) || n < 0 || fixtrunc(n) != n) { + pez_error(cx, "array#fill", "argument #1 should be positive integer"); + return 0; + } + TRY(arr = newarr(cx, fixtoint(n))); + arr->len = fixtoint(n); + for (int i = 0; i < fixtoint(n); ++i) { + arr->at[i] = cx->stktop[-1]; + } + return push(cx, box_obj(arr)); +} + static const struct coredef { const char *n; PezCFn *f; } core[] = { { "printf", f_printf }, - { "sprintf", f_sprintf } + { "sprintf", f_sprintf }, + { "dilambda", f_dilambda }, + { "array#fill", f_arrayfill }, }; static bool @@ -2160,7 +2264,7 @@ addupval(Comp *cm, struct fenv *fenv, uint8_t idx, bool arg, bool local) struct cmupval up = { idx, arg, local }; for (int i = 0; i < fenv->nupval; ++i) { struct cmupval *up = &fenv->upvals[i]; - if (up->idx == idx && up->local == local) { + if (up->idx == idx && up->local == local && up->arg == arg) { return up->idx; } } @@ -2204,7 +2308,7 @@ endscope(Comp *cm) } else { if (!l->has_k) { --cm->fenv.nvars; - if (l->mutable && l->scope > 0 && l->captured) { + if (l->scope > 0 && l->captured) { TRY(compop(cm, Oclose) && compbyte(cm, l->index)); } } @@ -2974,7 +3078,7 @@ Bail: static bool binexpr(Comp *cm, char okind, bool (*prev)(Comp *)) { - uint save = cm->code.len, save2, save3; + uint save = cm->code.len; char kind, chr; enum op op, op2; TRY(prev(cm)); @@ -2990,10 +3094,25 @@ binexpr(Comp *cm, char okind, bool (*prev)(Comp *)) int imm; enum op opx = op; + if (has_lk && isimm(&imm, lk) && commutate(&opx)) { + // when lhs is a constant and the operation can be + // commutative try use immediate op + cm->has_k = 0; + TRY(prev(cm)); + if (cm->has_k && (op == Oeq || op == One || (isnum(lk) && isnum(cm->k)))) { + // constant fold: undo previous exprs and binop and save constant result + cm->code.len = save; + cm->has_k = 1; + cm->k = uncheckedop(op, lk, cm->k); + continue; + } else { + goto TryImm; + } + } + TRY(flushconst(cm)); - save2 = cm->code.len; + has_lk = 0; TRY(prev(cm)); - save3 = cm->code.len; cm->lvalue = 0; if (has_lk && cm->has_k) { // lhs and rhs constant? // only fold when types check @@ -3004,19 +3123,6 @@ binexpr(Comp *cm, char okind, bool (*prev)(Comp *)) cm->k = uncheckedop(op, lk, cm->k); continue; } - } else if (has_lk && isimm(&imm, lk) && commutate(&opx)) { - // when lhs is a constant and the operation can be - // commutative try use immediate op - - // eliminate code generated for lhs - for (uint i = 0; i < save3 - save2; ++i) { - memmove(cm->code.at + save + i, cm->code.at + save2 + i, save2 - save); - } - cm->code.len -= (save2 - save); - - cm->has_k = 1; - cm->k = lk; - goto TryImm; } else if (cm->has_k && isimm(&imm, cm->k)) { // try immediate variants of ops TryImm: @@ -1,21 +1,29 @@ -@print: {[x] printf["%a\n", x]} - @Box: {[value] - @it = 0 - ( - @test = 7 - @h2 = 100 - it = #[{value}, - {[new] printf["test: %a\n", test] value = new}] - ) - ( - @hmm = 999 - ) - it + dilambda[ + { value }, + {[new] value = new } + ] } +@Array2d: {[w, h] + @data: array#fill[w * h, 0] + @w = w + dilambda[ + {[x, y] data[x + (y * w)] }, + {[x, y, new] data[x + (y * w)] = new } + ] +} +@print: {[x] printf["x -> %a\n", x] } @x = Box[-7] -print[x[0][]] -x[1]['awesome] -print[x[0][]] +x[] *= 2 +print[x[]] +x[] = 'abcdef +print[x[]] + +@m: Array2d[10, 10] +FOR [@x: 0][< 10][+ 1] + FOR [@y: 0][< 10][+ 1] + m[x, y] = x ^ y + +printf["%a == %a\n", m[3,7], 3^7] |