commit 47913d2f552463ccfebb34dbb18542508ee6815a
parent 03d3b747f9c6708a2df6bb6d6e72aeaf076cd8aa
Author: sin <sin@2f30.org>
Date: Fri, 16 May 2014 11:22:26 +0100
Add support for primitive procedures
Diffstat:
| M | parser.c | | | 152 | +++++++++++++++++++++++++++++++++++++++++++++++++------------------------------ |
1 file changed, 94 insertions(+), 58 deletions(-)
diff --git a/parser.c b/parser.c
@@ -18,6 +18,7 @@ enum objtype {
OString,
OEmptylist,
OPair,
+ OProc,
};
struct object {
@@ -56,41 +57,45 @@ struct object {
struct object *car;
struct object *cdr;
} pair;
+ /* proc */
+ struct {
+ char *name;
+ struct object *(*fn)(struct object *);
+ } proc;
} d;
};
+/* builtins */
static struct object *evaldefine(struct object *);
-static struct object *evaldiff(struct object *);
static struct object *evalif(struct object *);
static struct object *evalok(struct object *);
-static struct object *evalplus(struct object *);
static struct object *evalquote(struct object *);
static struct object *evalset(struct object *);
+/* primitive procedures */
+static struct object *evaldiff(struct object *);
+static struct object *evalplus(struct object *);
+
struct {
char *name;
struct object *o;
struct object *(*fn)(struct object *);
} builtins[] = {
{ .name = "define", .fn = evaldefine },
- { .name = "diff", .fn = evaldiff },
{ .name = "if", .fn = evalif },
{ .name = "ok", .fn = evalok },
- { .name = "plus", .fn = evalplus },
{ .name = "quote", .fn = evalquote },
{ .name = "set", .fn = evalset },
};
-static int
-builtin(char *name)
-{
- size_t i;
-
- for (i = 0; i < LEN(builtins); i++)
- if (strcmp(builtins[i].name, name) == 0)
- return 1;
- return 0;
-}
+struct {
+ char *name;
+ struct object *o;
+ struct object *(*fn)(struct object *);
+} procs[] = {
+ { .name = "diff", .fn = evaldiff },
+ { .name = "plus", .fn = evalplus },
+};
static struct object *
newobject(void)
@@ -221,6 +226,18 @@ pair(FILE *in)
return cons(car, cdr);
}
+static struct object *
+proc(char *s, struct object *(*fn)(struct object *))
+{
+ struct object *o;
+
+ o = newobject();
+ o->type = OProc;
+ o->d.proc.name = estrdup(s);
+ o->d.proc.fn = fn;
+ return o;
+}
+
struct object *
sexpression(FILE *in)
{
@@ -356,6 +373,48 @@ evalok(struct object *o)
}
static struct object *
+evalquote(struct object *o)
+{
+ struct object *ocar;
+
+ if (o->type == OPair) {
+ ocar = car(o);
+ if (ocar->type == OIdentifier &&
+ strcmp(ocar->d.i.s, "quote") == 0)
+ return cadr(o);
+ }
+ return NULL;
+}
+
+static struct object *
+evalset(struct object *o)
+{
+ struct object *ocar;
+ struct object *var, *val;
+
+ if (o->type != OPair)
+ return NULL;
+ ocar = car(o);
+ if (ocar->type != OIdentifier ||
+ strcmp(ocar->d.i.s, "set") != 0)
+ return NULL;
+ var = cadr(o);
+ if (var->type != OIdentifier)
+ return error("expected identifier");
+ if (!lookupsym(var->d.i.s))
+ return error("unbound identifier");
+ if (!caddr(o))
+ return error("expected sexpression");
+ if (cadddr(o))
+ return error("multiple arguments to set");
+ val = eval(caddr(o));
+ if (val->type == OError)
+ return val;
+ addsym(var->d.i.s, val);
+ return lookupsym("ok");
+}
+
+static struct object *
dodiff(struct object *o, struct object *n)
{
struct object *otmp;
@@ -425,48 +484,6 @@ evalplus(struct object *o)
return doplus(cdr(o), number(0));
}
-static struct object *
-evalquote(struct object *o)
-{
- struct object *ocar;
-
- if (o->type == OPair) {
- ocar = car(o);
- if (ocar->type == OIdentifier &&
- strcmp(ocar->d.i.s, "quote") == 0)
- return cadr(o);
- }
- return NULL;
-}
-
-static struct object *
-evalset(struct object *o)
-{
- struct object *ocar;
- struct object *var, *val;
-
- if (o->type != OPair)
- return NULL;
- ocar = car(o);
- if (ocar->type != OIdentifier ||
- strcmp(ocar->d.i.s, "set") != 0)
- return NULL;
- var = cadr(o);
- if (var->type != OIdentifier)
- return error("expected identifier");
- if (!lookupsym(var->d.i.s))
- return error("unbound identifier");
- if (!caddr(o))
- return error("expected sexpression");
- if (cadddr(o))
- return error("multiple arguments to set");
- val = eval(caddr(o));
- if (val->type == OError)
- return val;
- addsym(var->d.i.s, val);
- return lookupsym("ok");
-}
-
struct object *
eval(struct object *o)
{
@@ -485,8 +502,9 @@ eval(struct object *o)
}
/* evaluate identifiers */
if (o->type == OIdentifier) {
- if (builtin(o->d.i.s) == 1)
- return error("cannot eval builtin in this context");
+ for (i = 0; i < LEN(builtins); i++)
+ if (strcmp(o->d.i.s, builtins[i].name) == 0)
+ return error("cannot eval builtin in this context");
otmp = lookupsym(o->d.i.s);
if (!otmp)
return error("unbound identifier");
@@ -498,6 +516,15 @@ eval(struct object *o)
if (otmp)
return otmp;
}
+ /* evalute primitive procedures */
+ if (o->type == OPair) {
+ otmp = lookupsym(car(o)->d.i.s);
+ if (otmp && otmp->type == OProc) {
+ for (i = 0; i < LEN(procs); i++)
+ if (strcmp(otmp->d.proc.name, procs[i].name) == 0)
+ return procs[i].fn(o);
+ }
+ }
return error("cannot eval object");
}
@@ -556,6 +583,9 @@ print(struct object *o)
printpair(o);
putchar(')');
break;
+ case OProc:
+ printf("%s#<procedure>", o->d.proc.name);
+ break;
}
}
@@ -565,9 +595,15 @@ init(void)
size_t i;
initenv();
+ /* add builtins */
for (i = 0; i < LEN(builtins); i++) {
builtins[i].o = identifier(builtins[i].name);
addsym(builtins[i].name, builtins[i].o);
}
+ /* add primitive procedures */
+ for (i = 0; i < LEN(procs); i++) {
+ procs[i].o = proc(procs[i].name, procs[i].fn);
+ addsym(procs[i].name, procs[i].o);
+ }
return 0;
}
