iris

small scheme interpreter
git clone git://git.2f30.org/iris
Log | Files | Refs | LICENSE

commit 47913d2f552463ccfebb34dbb18542508ee6815a
parent 03d3b747f9c6708a2df6bb6d6e72aeaf076cd8aa
Author: sin <sin@2f30.org>
Date:   Fri, 16 May 2014 11:22:26 +0100

Add support for primitive procedures

Diffstat:
Mparser.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; }