basic C user data, io

2 files changed, 156 insertions, 3 deletions

diff --git a/pez.c b/pez.c
index 87cf518..4b841dd 100644
--- a/pez.c
+++ b/pez.c
@@ -1,7 +1,6 @@
 #include "pez.h"
 
 #include <assert.h>
-#include <errno.h>
 #include <limits.h>
 #include <stdarg.h>
 #include <stdbool.h>
@@ -107,6 +106,12 @@ typedef struct Dilambda {
     Fn *getf, *setf;
 } Dilambda;
 
+typedef struct UserObj {
+    OBJHEADER;
+    const PezUserType *typeid;
+    char data[];
+} UserObj;
+
 enum { NAMEMAX = 80 };
 
 struct local {
@@ -229,6 +234,7 @@ enum {
 #define unbox_obj(v)  ((void *)(intptr_t)(v).r)
 #define unbox_bool(v) ((bool)((v).r >> 32))
 #define unbox_cfn(v)  ((PezCFn *)((intptr_t)(v).r >> 2))
+#define unbox_userobj(v) ((UserObj *)unbox_obj(v))
 #define objtag(v) (((Obj *)unbox_obj(v))->t)
 #define isobj_of(v, tag)  (isobj(v) && objtag(v) == (tag))
 #define box_obj(x)  ((Val){(intptr_t)(x)})
@@ -260,6 +266,7 @@ typeof1(Val v)
 static const char *
 typestr(Val v)
 {
+    const PezUserType *typeid;
     if (isvoid(v))
         return "void";
     if (isobj(v)) {
@@ -272,6 +279,9 @@ typestr(Val v)
         case PEZ_TFnProto:  return "(function prototype)";
         case PEZ_TUpval:    return "(upvalue)";
         case PEZ_TDilambda: return "dilambda";
+        case PEZ_TUserObj:
+            typeid = unbox_userobj(v)->typeid;
+            return typeid->name ? typeid->name : "(unknown obj)";
         }
     }
     if (isnum(v))
@@ -811,6 +821,12 @@ sizeofrecord(Record *rc)
     return sizeof *rc + sizeof(struct KV) * (1 << rc->exp);
 }
 
+static size_t
+sizeofuserobj(UserObj *o)
+{
+    return sizeof *o + o->typeid->size;
+}
+
 static Record *
 newrecord(PezContext *cx, uint n, Val *kvs)
 {
@@ -858,6 +874,14 @@ delstring(PezContext *cx, Str *str)
     --cx->strpool.count;
 }
 
+static void
+deluserobj(PezContext *cx, UserObj *obj)
+{
+    const PezUserType *typeid = obj->typeid;
+    if (typeid->dtor)
+        typeid->dtor(obj->data);
+}
+
 static Dilambda *
 newdilambda(PezContext *cx, Fn *getf, Fn *setf)
 {
@@ -870,6 +894,18 @@ newdilambda(PezContext *cx, Fn *getf, Fn *setf)
     return dl;
 }
 
+static bool
+box_userobj(PezContext *cx, Val *ret, const PezUserType *typ, void *data)
+{
+    UserObj *o = newobj(cx, PEZ_TUserObj, sizeof *o + typ->size);
+    if (!o) return 0;
+    o->typeid = typ;
+    memcpy(o->data, data, typ->size);
+    *ret = box_obj(o);
+    return 1;
+}
+
+
 /******/
 /* GC */
 /******/
@@ -904,6 +940,10 @@ delobj(PezContext *cx, Obj *o)
     case PEZ_TRecord:
         sz = sizeofrecord((Record *)o);
         break;
+    case PEZ_TUserObj:
+        sz = sizeofuserobj((UserObj *)o);
+        deluserobj(cx, (UserObj *)o);
+        break;
     }
     assert(sz);
     cxfree(cx, o, sz);
@@ -2075,6 +2115,12 @@ xprint1(PezContext *cx, struct vals *seen,
         }
         ok &= cb(cx, u, "}", 1);
         TRY(ok);
+    } else if (isobj_of(v, PEZ_TUserObj)) {
+        char tmp[100];
+        int n;
+        tmp[99] = 0;
+        n = snprintf(tmp, sizeof tmp - 1, "#<%s %p>", typestr(v), unbox_obj(v));
+        TRY(cb(cx, u, tmp, n));
     } else {
         TRY(cb(cx, u, "#<?\?\?>", 6));
     }
@@ -2236,6 +2282,79 @@ f_assert(PezContext *cx, int argc)
     return pez_pushvoid(cx);
 }
 
+static void
+file_dtor(void *d)
+{
+    FILE **pf = d;
+    if (*pf) fclose(*pf);
+    *pf = NULL;
+}
+
+static const PezUserType file_ctype = {
+    "FILE",
+    sizeof(FILE *),
+    file_dtor,
+};
+
+static bool
+f_ioopen(PezContext *cx, int argc)
+{
+    char buf[9];
+    FILE *f;
+    const char *mode = "r";
+    TRY(pez_checksig(cx, argc, "io#open", "string, ?string"));
+    if (argc == 2) {
+        mode = pez_getstring(cx, buf, -1);
+    }
+    f = fopen(pez_getstring(cx, buf, -argc), mode);
+
+    return f ? pez_pushuserobj(cx, &file_ctype, &f) : pez_pushvoid(cx);
+}
+
+static bool
+f_ioread(PezContext *cx, int argc)
+{
+    FILE *f;
+    size_t capty, n = 0;
+    enum { CHUNK = 4096 };
+    char *buf;
+
+    if (argc != 1 || !pez_isuserobj(cx, &file_ctype, -1)) {
+        pez_error(cx, "io#read", "expected FILE");
+        return 0;
+    }
+    f = *(FILE **)pez_getuserobj(cx, &file_ctype, -1);
+    buf = malloc(capty = CHUNK);
+    while (!feof(f) && !ferror(f)) {
+        if (n + CHUNK >= capty)
+            buf = realloc(buf, capty <<= 1);
+        n += fread(buf + n, 1, CHUNK, f);
+    }
+
+    if (!pez_pushstring(cx, buf, n)) {
+        free(buf);
+        return 0;
+    }
+    free(buf);
+    return 1;
+}
+
+static bool
+f_ioclose(PezContext *cx, int argc)
+{
+    FILE **pf;
+
+    if (argc != 1 || !pez_isuserobj(cx, &file_ctype, -1)) {
+        pez_error(cx, "io#read", "expected FILE");
+        return 0;
+    }
+    pf = pez_getuserobj(cx, &file_ctype, -1);
+    fclose(*pf);
+    *pf = NULL;
+
+    return 1;
+}
+
 static const struct coredef { const char *n; PezCFn *f; } core[] = {
     { "printf", f_printf },
     { "sprintf", f_sprintf },
@@ -2244,6 +2363,9 @@ static const struct coredef { const char *n; PezCFn *f; } core[] = {
     { "array#new", f_arraynew },
     { "array#push", f_arraypush },
     { "assert", f_assert },
+    { "io#open", f_ioopen },
+    { "io#read", f_ioread },
+    { "io#close", f_ioclose },
 };
 
 static bool
@@ -4282,6 +4404,15 @@ pez_pushglobal(PezContext *cx, const char *name)
 }
 
 bool
+pez_pushuserobj(PezContext *cx, const PezUserType *typeid, void *data)
+{
+    Val o;
+    assert(typeid);
+    TRY(box_userobj(cx, &o, typeid, data));
+    return push(cx, o);
+}
+
+bool
 pez_isvoid(PezContext *cx, int idx)
 {
     return isvoid(*iget(cx, idx));
@@ -4325,6 +4456,12 @@ pez_isarray(PezContext *cx, int idx)
 }
 
 bool
+pez_isuserobj(PezContext *cx, const PezUserType *typeid, int idx)
+{
+    return isobj_of1(cx, idx, PEZ_TUserObj) && (!typeid || unbox_userobj(*iget(cx, idx))->typeid == typeid);
+}
+
+bool
 pez_truthy(PezContext *cx, int idx)
 {
     return truthy(*iget(cx, idx));
@@ -4465,6 +4602,13 @@ pez_getstring(PezContext *cx, char buf[8], int idx)
     return NULL;
 }
 
+void *
+pez_getuserobj(PezContext *cx, const PezUserType *typeid, int idx)
+{
+    assert(typeid && pez_isuserobj(cx, typeid, idx));
+    return unbox_userobj(*iget(cx, idx))->data;
+}
+
 const char *
 pez_fnname(PezContext *cx, int idx)
 {
diff --git a/pez.h b/pez.h
index 075eb41..f99b58b 100644
--- a/pez.h
+++ b/pez.h
@@ -19,7 +19,8 @@ enum {
     PEZ_TTuple,
     PEZ_TRecord,
     PEZ_TArray,
-    PEZ_TDilambda
+    PEZ_TDilambda,
+    PEZ_TUserObj,
 };
 
 typedef enum PezError {
@@ -29,12 +30,17 @@ typedef enum PezError {
     PEZ_ERuntime,
 } PezError;
 
-
 typedef struct PezContext PezContext;
 typedef void *PezAllocFn(void *userdata, void *ptr, size_t oldsize, size_t newsize);
 typedef bool PezCFn(PezContext *, int argc);
 typedef int PezReadFn(void *userdata, char *dst, int n);
 
+typedef struct PezUserType {
+    const char *name;
+    size_t size;
+    void (*dtor)(void *);
+} PezUserType;
+
 PezContext *pez_new(PezAllocFn *alloc, void *userdata, size_t stacksize);
 void pez_del(PezContext *);
 
@@ -63,6 +69,7 @@ bool pez_pushnumber(PezContext *, PezNumber);
 bool pez_pushint(PezContext *, int);
 bool pez_pushstring(PezContext *, const char *str, int len);
 bool pez_pushglobal(PezContext *, const char *name);
+bool pez_pushuserobj(PezContext *, const PezUserType *, void *data);
 
 bool pez_isvoid(PezContext *, int idx);
 bool pez_isnumber(PezContext *, int idx);
@@ -70,6 +77,7 @@ bool pez_isbool(PezContext *, int idx);
 bool pez_isstring(PezContext *, int idx);
 bool pez_isfunction(PezContext *, int idx);
 bool pez_isarray(PezContext *, int idx);
+bool pez_isuserobj(PezContext *, const PezUserType *, int idx);
 bool pez_truthy(PezContext *, int idx);
 int pez_typeof(PezContext *, int idx);
 const char *pez_typename(PezContext *, int idx);
@@ -79,6 +87,7 @@ 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);
+void *pez_getuserobj(PezContext *cx, const PezUserType *, int idx);
 const char *pez_fnname(PezContext *, int idx);
 int pez_length(PezContext *cx, int idx);