io#write, pusbool, checksig

1 files changed, 40 insertions, 7 deletions

diff --git a/pez.c b/pez.c
index 1f50cab..fac8308 100644
--- a/pez.c
+++ b/pez.c
@@ -2319,10 +2319,7 @@ f_ioread(PezContext *cx, int argc)
     enum { CHUNK = 4096 };
     char *buf;
 
-    if (argc != 1 || !pez_isuserobj(cx, &file_ctype, -1)) {
-        pez_error(cx, "io#read", "expected FILE");
-        return 0;
-    }
+    TRY(pez_checksig(cx, argc, "io#open", "#FILE, ?string", &file_ctype));
     f = *(FILE **)pez_getuserobj(cx, &file_ctype, -1);
     buf = malloc(capty = CHUNK);
     while (!feof(f) && !ferror(f)) {
@@ -2340,6 +2337,24 @@ f_ioread(PezContext *cx, int argc)
 }
 
 static bool
+f_iowrite(PezContext *cx, int argc)
+{
+    FILE *f;
+    const char *s;
+    char s_[9];
+    int n;
+
+    TRY(pez_checksig(cx, argc, "io#write", "#FILE, string", &file_ctype));
+    f = *(FILE **)pez_getuserobj(cx, &file_ctype, -2);
+    s = pez_getstring(cx, s_, -1);
+    n = pez_length(cx, -1);
+    assert(f && s && n >= 0);
+    fwrite(s, 1, n, f);
+
+    return pez_push(cx, -2);
+}
+
+static bool
 f_ioclose(PezContext *cx, int argc)
 {
     FILE **pf;
@@ -2365,6 +2380,7 @@ static const struct coredef { const char *n; PezCFn *f; } core[] = {
     { "assert", f_assert },
     { "io#open", f_ioopen },
     { "io#read", f_ioread },
+    { "io#write", f_iowrite },
     { "io#close", f_ioclose },
 };
 
@@ -4385,6 +4401,12 @@ pez_pushnumber(PezContext *cx, PezNumber n)
 }
 
 bool
+pez_pushbool(PezContext *cx, bool x)
+{
+    return push(cx, box_bool(x));
+}
+
+bool
 pez_pushint(PezContext *cx, int idx)
 {
     return push(cx, box_num(inttofix(idx)));
@@ -4494,7 +4516,7 @@ sigget(const char **s, bool *opt)
 {
     const char *t;
     t = *s;
-    assert((*t == '*' || aisalpha(*t) || *t == '?') && "bad sig");
+    assert((*t == '*' || aisalpha(*t) || *t == '?' || *t == '#') && "bad sig");
     for (; **s && !aissep(**s); ++*s) ;
     *opt = 0;
     if (*t == '?') {
@@ -4509,10 +4531,13 @@ sigget(const char **s, bool *opt)
 }
 
 bool
-pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig)
+pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig, ...)
 {
     const char *osig = sig;
     int arg = 0;
+    va_list ap;
+    const PezUserType *usertype;
+    va_start(ap, sig);
     skipspaces(&sig);
     for (; *sig; ++arg) {
         uint mask = 0;
@@ -4523,6 +4548,7 @@ pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig)
         do {
             bool opt;
             const char *t = sigget(&sig, &opt);
+            usertype = NULL;
             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;
@@ -4533,6 +4559,12 @@ pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig)
             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 (*t == '#') {
+                assert(!usertype);
+                mask = 1 << PEZ_TUserObj;
+                usertype = va_arg(ap, PezUserType *);
+                ++this;
+            }
             else if (!strncmp(t, "applicable", 10)) {
                 mask |= 1 << PEZ_TFn | 1 << PEZ_TString | 1 << PEZ_TRecord
                       | 1 << PEZ_TArray | 1 << PEZ_TDilambda;
@@ -4556,7 +4588,7 @@ pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig)
             sig += *sig == '|';
             skipspaces(&sig);
         } while (*sig && *sig != ',');
-        if ((typ & mask) == 0) {
+        if ((typ & mask) == 0 || (usertype && !pez_getuserobj(cx, usertype, -argc + arg))) {
             pez_error(cx, fn, "arg #%d mismatch: expected %.*s, got %s",
                       arg, thisn, this + !aisalpha(*this), pez_typename(cx, -argc + arg));
             return 0;
@@ -4569,6 +4601,7 @@ pez_checksig(PezContext *cx, int argc, const char *fn, const char *sig)
         }
         skipspaces(&sig);
     }
+    va_end(ap);
     if (arg < argc) {
         pez_error(cx, fn, "too many args for [%s] (got %d)", osig, argc);
         return 0;