diff --git a/bltin.c b/bltin.c index 71696c5..c3060ca 100644 --- a/bltin.c +++ b/bltin.c @@ -25,7 +25,6 @@ Object Quote= (Object){.type=OBLTIN, .beg="'"}; Object Cons = (Object){.type=OBLTIN, .beg="cons"}; Object Define= (Object){.type=OBLTIN, .beg="define"}; Object Macro= (Object){.type=OBLTIN, .beg="macro"}; -Object Defn= (Object){.type=OBLTIN, .beg="defn"}; Object Setq = (Object){.type=OBLTIN, .beg="setq"}; Object If = (Object){.type=OBLTIN, .beg="if"}; @@ -37,7 +36,6 @@ extern Object* fnlambda(Object *, Object *); extern Object* fnprogn(Object *, Object *); extern Object* fndefine(Object *, Object *); extern Object* fnmacro(Object *, Object *); -extern Object* fndefn(Object *, Object *); extern Object* fnsetq(Object *, Object *); extern Object* fnundef(Object *, Object *); extern Object* fnquote(Object *, Object *); @@ -70,7 +68,6 @@ bltinlookup(Object *obj) {&Div , fndiv}, {&Define ,fndefine}, {&Macro ,fnmacro}, - {&Defn ,fndefn}, {&Setq ,fnsetq}, {&Quote ,fnquote}, {&Bquote, fnbquote}, diff --git a/dat.h b/dat.h index 5b96415..3eb6166 100644 --- a/dat.h +++ b/dat.h @@ -67,7 +67,6 @@ extern Object Cons; extern Object Define; extern Object Progn; extern Object Macro; -extern Object Defn; extern Object Setq; extern Object Eq; extern Object Ne; diff --git a/eval.c b/eval.c index fccf097..07dc211 100644 --- a/eval.c +++ b/eval.c @@ -45,22 +45,17 @@ _newfn(Object *env, Object *l, enum OType type) return newfn(gc, env, params, body, type); } -static void +static Object* setvar(Object *env, Object *id, Object *val) { + printexpr(id); Object *obj = find(env, id); if(obj == 0) - env->vars = newacons(gc, id, val, env->vars); - else + return newacons(gc, id, val, env->vars); + else{ obj->cdr = val; -} - -Object* -fndefn(Object *env, Object *list) -{ - Object *fn = _newfn(env, list->cdr, OFUNC); - setvar(env, list->car, fn); - return fn; + return env->vars; + } } Object* @@ -73,7 +68,7 @@ Object* fnmacro(Object *env, Object *l) { Object *macro = _newfn(env, l->cdr, OMACRO); - setvar(env, l->car, macro); + env->vars = setvar(env, l->car, macro); return macro; } @@ -111,7 +106,7 @@ fndefine(Object *env, Object *list) if(exprlen(list)!=2 || list->car->type!=OIDENT) error("Malformed define"); Object *val = eval(env, list->cdr->car); - setvar(env, list->car, val); + env->vars = setvar(env, list->car, val); return val; } @@ -123,22 +118,16 @@ fnquote(Object *env, Object *list) return list->car; } -static Object* +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); + if(p->car == &Comma) + return eval(env, p->cdr); + Object *dst = newcons(gc, p->car, p->cdr); + dst->car = evalcomma(env, p->car); + dst->cdr = evalcomma(env, p->cdr); + return dst; } return p; } @@ -146,12 +135,9 @@ evalcomma(Object *env, Object *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; + if(exprlen(list) != 1) + error("Malformed fnbquote"); + return evalcomma(env, list->car); } Object* @@ -387,7 +373,9 @@ apply(Object *env, Object *fn, Object *args) if(islist(args) == 0) error("args is not list type"); switch(fn->type){ - default: error("can't apply"); + default: error("apply only tabke [MACRO BLTIN FUNC]"); + case OMACRO: + return applymacro(env, fn, args); case OBLTIN:{ Bltinfn blt = bltinlookup(fn); if(blt==0) @@ -421,10 +409,6 @@ eval(Object *env, Object *obj) } case OCELL:{ Object *fn = eval(env, obj->car); - if(fn->type == OMACRO) - return applymacro(env, fn, obj->cdr); - if(fn->type!=OFUNC&&fn->type!=OBLTIN) - error("expected function type"); Object *res = apply(env, fn, obj->cdr); return res; } diff --git a/fn.h b/fn.h index d6a5552..76002f0 100644 --- a/fn.h +++ b/fn.h @@ -4,14 +4,12 @@ Object* nextexpr(FILE*); void skipline(FILE*); /* repl.c */ -void repl(Object *env, FILE*, char *pre); -void readlibs(char *argv[], Object *env); +void lispmain(char *argv[]); /* eval.c */ Object* eval(Object *env, Object *expr); /* new */ - Object* newint(GC *,long); Object* newcons(GC *,Object*,Object*); Object* newenv(GC *,Object*name, Object *vars, Object *up); diff --git a/lib/lib.lisp b/lib/lib.lisp new file mode 100644 index 0000000..863822d --- /dev/null +++ b/lib/lib.lisp @@ -0,0 +1,14 @@ +(macro defun (name args body) + `(define ,name (lambda ,args ,body))) + +(defun list (x . y) (cons x y)) + +(macro and (expr . rest) + (if rest (list 'if expr (cons 'and rest)) expr)) + +(macro cond (expr. rest) + (if rest (list 'if (car expr) (car (cdr expr)) (cons 'cond rest)) + expr)) + +;exampe (cond ((== 1 0) 0) ((== 1 1) -1) (+ 100000000)) +;exampe (cond ((== 1 0) 0) ((== 1 0) -1) (+ 100000000)) diff --git a/macro.lisp b/macro.lisp deleted file mode 100644 index 801477e..0000000 --- a/macro.lisp +++ /dev/null @@ -1,10 +0,0 @@ -(defn list (x . y) (cons x y)) - -(macro cond (expr. rest) - (if rest (list 'if (car expr) (car (cdr expr)) (cons 'cond rest)) - expr)) - -(macro and (expr . rest) - (if rest (list 'if expr (cons 'and rest)) expr)) - -;(cond ((== 1 0) 0) ((== 1 1) -1) (+ 100000000)) diff --git a/main.c b/main.c index 8063b06..e943d04 100644 --- a/main.c +++ b/main.c @@ -59,8 +59,8 @@ printexpr(Object *obj) int main(int argc, char *argv[]) { + *argv = "lib/lib.lisp"; gc = newgc(&argc, 400); - Object *env = newenv(gc, &Nil, &Nil, &Nil); - readlibs(argv + 1, env); - repl(env, stdin, ">> "); + lispmain(argv); + panic("unreachable"); } diff --git a/obj.c b/obj.c index 5729386..82f04db 100644 --- a/obj.c +++ b/obj.c @@ -62,8 +62,8 @@ newsymbol(GC *gc, char *str, int len) static Object *syms[] = { &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, + &Define, &Setq, &Eq, &If, &Macro, &Progn, &Bquote, + &Comma, }; for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){ Object *c = syms[i]; diff --git a/repl.c b/repl.c index ee4a2ed..79a4e1d 100644 --- a/repl.c +++ b/repl.c @@ -31,14 +31,14 @@ error(char *fmt, ...) exit(1); } -void +static void repl(Object *env, FILE *f, char *pre) { jmp_buf err; errptr = &err; if(setjmp(err) == 1){ if(feof(f)) - return; + exit(1); skipline(f); } while(1){ @@ -50,14 +50,30 @@ repl(Object *env, FILE *f, char *pre) } } -void -readlibs(char *argv[], Object *env) +static void +readlib(FILE *f, Object *env) { - for(;*argv; argv++){ + jmp_buf buf; + errptr = &buf; + if(setjmp(buf) == 1) + return; + while(1){ + eval(env, nextexpr(f)); + } + panic("unreachable"); + errptr = 0; +} + +void +lispmain(char *argv[]) +{ + Object *env = newenv(gc , &Nil, &Nil, &Nil); + for(; *argv; ++argv){ FILE *f = fopen(*argv, "r"); if(f == 0) - panic("can't open %s", *argv); - repl(env, f, ""); - printf("\n"); + panic("can't open %s'", *argv); + readlib(f, env); + fclose(f); } -} + repl(env, stdin, ">> "); +} \ No newline at end of file