diff options
| -rw-r--r-- | pez.c | 142 | ||||
| -rw-r--r-- | pez.h | 3 |
2 files changed, 123 insertions, 22 deletions
@@ -234,6 +234,25 @@ enum { static Val length_sstr; +static int +typeof1(Val v) +{ + if (isvoid(v)) + return PEZ_TVoid; + if (isobj(v)) { + return objtag(v); + } + if (isnum(v)) + return PEZ_TNumber; + if (isbool(v)) + return PEZ_TBool; + if (issstr(v)) + return PEZ_TString; + if (iscfn(v)) + return PEZ_TFn; + assert(0 && "type?"); +} + static const char * typestr(Val v) { @@ -258,7 +277,7 @@ typestr(Val v) return "string"; if (iscfn(v)) return "function"; - return NULL; + assert(0 && "type?"); } static int @@ -1886,14 +1905,7 @@ f_xprintf1(PezContext *cx, const char *fn, const char *fmt; int fmtlen; bool ok = 1; - if (argc < 1) { - pez_error(cx, fn, "missing format string"); - return 0; - } - if (!pez_isstring(cx, args + 0)) { - pez_error(cx, fn, "expected format string (got %s)", pez_typename(cx, args + 0)); - return 0; - } + TRY(pez_checksig(cx, argc, fn, "string, *")); fmtlen = pez_length(cx, args + 0); fmt = pez_getstring(cx, sbuf, args + 0); for (uint i = 0; i < fmtlen; ++i) { @@ -1977,14 +1989,7 @@ 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; - } + TRY(pez_checksig(cx, argc, "dilambda", "function, function")); if (((Fn *)unbox_obj(cx->stktop[-1]))->proto->nparams < 1) { pez_error(cx, "dilambda", "setter should take at least one argument"); return 0; @@ -1999,12 +2004,9 @@ f_arrayfill(PezContext *cx, int argc) { fixnum n; Array *arr; - if (argc != 2) { - pez_error(cx, "array#fill", "expected two arguments"); - return 0; - } + TRY(pez_checksig(cx, argc, "array#fill", "number, any")); n = unbox_num(cx->stktop[-2]); - if (!isnum(cx->stktop[-2]) || n < 0 || fixtrunc(n) != n) { + if (n < 0 || fixtrunc(n) != n) { pez_error(cx, "array#fill", "argument #1 should be positive integer"); return 0; } @@ -2016,11 +2018,23 @@ f_arrayfill(PezContext *cx, int argc) return push(cx, box_obj(arr)); } +static bool +f_arraypush(PezContext *cx, int argc) +{ + Array *arr; + TRY(pez_checksig(cx, argc, "array#fill", "array, any")); + assert(isobj_of(cx->stktop[-2], PEZ_TArray)); + arr = unbox_obj(cx->stktop[-2]); + TRY(arrpushn(cx, arr, peek(cx), 1)); + return push(cx, box_obj(arr)); +} + static const struct coredef { const char *n; PezCFn *f; } core[] = { { "printf", f_printf }, { "sprintf", f_sprintf }, { "dilambda", f_dilambda }, { "array#fill", f_arrayfill }, + { "array#push", f_arraypush }, }; static bool @@ -4012,12 +4026,96 @@ pez_isarray(PezContext *cx, int idx) return isobj_of1(cx, idx, PEZ_TArray); } +int +pez_typeof(PezContext *cx, int idx) +{ + return typeof1(*iget(cx, idx)); +} + const char * pez_typename(PezContext *cx, int idx) { return typestr(*iget(cx, idx)); } +static void +skipspaces(const char **s) +{ + for (; aisspace(**s); ++*s) ; +} + +static const char * +sigget(const char **s) +{ + const char *t = *s; + assert((*t == '*' || aisalpha(*t)) && "bad sig"); + for (; **s && !aissep(**s); ++*s) ; + return t; +} + +bool +pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig) +{ + const char *osig = sig; + int arg = 0; + skipspaces(&sig); + for (; *sig; ++arg) { + uint mask = 0; + const char *this = sig; + int thisn; + int typ; + typ = 1 << pez_typeof(cx, -argc + arg); + while (*sig && *sig != ',') { + const char *t = sigget(&sig); + if (!strncmp(t, "any", 3)) mask |= ~0u; + else if (!strncmp(t, "void", 4)) mask |= 1 << PEZ_TVoid; + else if (!strncmp(t, "number", 6)) mask |= 1 << PEZ_TNumber; + else if (!strncmp(t, "bool", 4)) mask |= 1 << PEZ_TBool; + else if (!strncmp(t, "string", 6)) mask |= 1 << PEZ_TString; + else if (!strncmp(t, "function", 8)) mask |= 1 << PEZ_TFn; + else if (!strncmp(t, "tuple", 5)) mask |= 1 << PEZ_TTuple; + else if (!strncmp(t, "record", 6)) mask |= 1 << PEZ_TRecord; + else if (!strncmp(t, "array", 5)) mask |= 1 << PEZ_TArray; + else if (!strncmp(t, "dilambda", 8)) mask |= 1 << PEZ_TDilambda; + else if (!strncmp(t, "applicable", 10)) { + mask |= 1 << PEZ_TFn | 1 << PEZ_TString | 1 << PEZ_TRecord + | 1 << PEZ_TArray | 1 << PEZ_TDilambda; + } + else if (*t == '*') { + ++sig; + skipspaces(&sig); + assert(!*sig && "bad sig"); + return 1; + } + else assert(0 && "bad sig type"); + if (arg >= argc) { + pez_error(cx, fn, "too few args for [%s] (got %d)", osig, argc); + return 0; + } + thisn = sig - this; + assert(!*sig || *sig == '|' || *sig == ','); + sig += *sig == '|'; + skipspaces(&sig); + } + if ((typ & mask) == 0) { + pez_error(cx, fn, "arg #%d mismatch: expected %.*s, got %s", + arg, thisn, this, pez_typename(cx, -argc + arg)); + return 0; + } + sig += *sig == ','; + if (!*sig) { + ++arg; + break; + } + skipspaces(&sig); + } + if (arg != argc) { + pez_error(cx, fn, "too many args for [%s] (got %d)", osig, argc); + return 0; + } + return 1; +} + bool pez_getnumber(PezContext *cx, PezNumber *out, int idx) { @@ -70,8 +70,11 @@ bool pez_isbool(PezContext *, int idx); bool pez_isstring(PezContext *, int idx); bool pez_isfunction(PezContext *, int idx); bool pez_isarray(PezContext *, int idx); +int pez_typeof(PezContext *, int idx); const char *pez_typename(PezContext *, int idx); +bool pez_checksig(PezContext *, int argc, const char *fn, const char *sig); + bool pez_getnumber(PezContext *, PezNumber *, int idx); bool pez_getbool(PezContext *, bool *, int idx); const char *pez_getstring(PezContext *, char buf[8], int idx); |