diff --git a/bltin.c b/bltin.c index 39c7ef6..71696c5 100644 --- a/bltin.c +++ b/bltin.c @@ -15,6 +15,8 @@ Object Gt = (Object){.type=OBLTIN, .beg= ">"}; Object Ne = (Object){.type=OBLTIN, .beg= "!="}; Object Eq = (Object){.type=OBLTIN, .beg= "=="}; +Object Comma= (Object){.type=OBLTIN, .beg=","}; +Object Bquote= (Object){.type=OBLTIN, .beg="`"}; Object Lambda= (Object){.type=OBLTIN, .beg="lambda"}; Object Progn=(Object){.type=OBLTIN, .beg="progn"}; Object Car = (Object){.type=OBLTIN, .beg="car"}; @@ -39,6 +41,7 @@ extern Object* fndefn(Object *, Object *); extern Object* fnsetq(Object *, Object *); extern Object* fnundef(Object *, Object *); extern Object* fnquote(Object *, Object *); +extern Object* fnbquote(Object *, Object *); extern Object* fncar(Object *, Object *); extern Object* fncdr(Object *, Object *); extern Object* fncons(Object *, Object *); @@ -70,6 +73,7 @@ bltinlookup(Object *obj) {&Defn ,fndefn}, {&Setq ,fnsetq}, {&Quote ,fnquote}, + {&Bquote, fnbquote}, {&Car ,fncar}, {&Cdr ,fncdr}, {&Cons ,fncons}, diff --git a/dat.h b/dat.h index b134db8..5b96415 100644 --- a/dat.h +++ b/dat.h @@ -11,7 +11,6 @@ enum OType OIDENT, OSTRING, OINT, - OLAMBDA, OFUNC, OMACRO, OENV, @@ -53,6 +52,8 @@ struct Object extern GC *gc; extern Object Nil; +extern Object Comma; +extern Object Bquote; extern Object Minus; extern Object Plus; extern Object Mul; diff --git a/eval.c b/eval.c index f9826d5..fccf097 100644 --- a/eval.c +++ b/eval.c @@ -123,6 +123,37 @@ fnquote(Object *env, Object *list) return list->car; } +static Object* +evalcomma(Object *env, Object *p) +{ + enum { VISITED = 1 << 9 }; + + if(p->type == OCELL){ + if(p->flag & VISITED) + return p; + p->flag |= VISITED; + if(p->car == &Comma){ + p = eval(env, p->cdr); + p->flag |= VISITED; + return p; + } + p->car = evalcomma(env, p->car); + p->cdr = evalcomma(env, p->cdr); + } + return p; +} + +Object* +fnbquote(Object *env, Object *list) +{ + if(list->cdr != &Nil){ + printexpr(list); + error("fnbquote expected cdr is nil"); + } + list = evalcomma(env, list->car); + return list; +} + Object* fncar(Object *env, Object *list) { diff --git a/main.c b/main.c index 799fbdb..8063b06 100644 --- a/main.c +++ b/main.c @@ -38,9 +38,6 @@ SExprint(Object *obj) case OMACRO: printf(""); goto func; - case OLAMBDA: - printf(""); - goto func; case OFUNC: printf(""); func: diff --git a/obj.c b/obj.c index 25b2a44..5729386 100644 --- a/obj.c +++ b/obj.c @@ -63,6 +63,7 @@ newsymbol(GC *gc, char *str, int len) &Nil, &Minus, &Plus, &Mul, &Mod, &Div, &Ge, &Le, &Lt, &Gt, &Ne, &Lambda, &Car, &Cdr, &Quote, &Cons, &Define, &Setq, &Eq, &If, &Defn, &Macro, &Progn, + &Bquote, &Comma, }; for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){ Object *c = syms[i]; @@ -84,4 +85,4 @@ newstr(GC *gc, int len) obj->ptr = obj->beg = (char*)&obj[1]; obj->end = obj->beg + len; return obj; -} \ No newline at end of file +} diff --git a/parser.c b/parser.c index 7d5e6ea..32ed727 100644 --- a/parser.c +++ b/parser.c @@ -7,8 +7,8 @@ const char symbolchars[] = "!*/%-=+<>'"; -static Object* lparlist(FILE *); -static Object* list(FILE *); +static Object* lparlist(FILE *, int *); +static Object* list(FILE *, int *); static char get(FILE *f) @@ -74,10 +74,9 @@ number(FILE *f) } static Object* -quote(FILE *f) +quote(FILE *f, Object *car, int *bq) { - Object *car = &Quote; - Object *ccdr = list(f); + Object *ccdr = list(f, bq); Object *cdr = newcons(gc, ccdr, &Nil); return newcons(gc, car, cdr); } @@ -116,53 +115,79 @@ atom(FILE *f, char c) } static Object* -lparlist(FILE *f) +lparlist(FILE *f, int *bq) { Object *car = 0; Object *cdr = 0; + Object *res = 0; char c = slookup(f); switch(c){ + case '`': + *bq += 1; + get(f); + car = quote(f, &Bquote, bq); + cdr = lparlist(f, bq); + res = newcons(gc, car, cdr); + *bq -= 1; + return res; case '\'': get(f); - car = quote(f); - cdr = lparlist(f); + car = quote(f, &Quote, bq); + cdr = lparlist(f, bq); + return newcons(gc, car, cdr); + case ',': + if(*bq <= 0) + error("comma is illegal outside of backquote"); + get(f); + car = newcons(gc, &Comma, list(f, bq)); + cdr = lparlist(f, bq); return newcons(gc, car, cdr); case '.': get(f); - return list(f); + return list(f, bq); case '(': - car = list(f); - cdr = lparlist(f); + car = list(f, bq); + cdr = lparlist(f, bq); return newcons(gc, car, cdr); case ')': return &Nil; + default: + car = atom(f, c); + cdr = lparlist(f, bq); + return newcons(gc, car ,cdr); } - car = atom(f, c); - cdr = lparlist(f); - return newcons(gc, car ,cdr); } static Object* -list(FILE *f) +list(FILE *f, int *bq) { redo: + Object *res = 0; char c = slookup(f); switch(c){ case ';': + get(f); skipline(f); goto redo; + case '`': + *bq += 1; + get(f); + res = quote(f, &Bquote, bq); + *bq -= 1; + return res; case '\'': get(f); - return quote(f); + return quote(f, &Quote, bq); case '(':{ get(f); - Object *obj = lparlist(f); + res = lparlist(f, bq); slookup(f); expect(f, ')'); - return obj; + return res; } + default: + return atom(f, c); } - return atom(f, c); } void @@ -183,5 +208,10 @@ skipline(FILE *f) Object* nextexpr(FILE *f) { - return list(f); + int bq = 0; + Object *expr = list(f, &bq); + if(bq != 0){ + error("Bad backquote in expr"); + } + return expr; }