diff --git a/README.md b/README.md index 7c24007..697092c 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,5 @@ +* see lib/lib.lisp + * (define fac (lambda (n) (if (== n 0) 1 (* n (fac (+ n -1)))))) * macro diff --git a/bltin.c b/bltin.c index 8fa0ecc..09c7e95 100644 --- a/bltin.c +++ b/bltin.c @@ -3,6 +3,7 @@ Object Nil = (Object){.type=OSYMBOL, .beg="nil"}; Object Splice= (Object){.type=OSYMBOL, .beg="@"}; +Object Comma= (Object){.type=OSYMBOL, .beg=","}; Object Minus= (Object){.type=OBLTIN, .beg="-"}; Object Plus = (Object){.type=OBLTIN, .beg="+"}; Object Mul = (Object){.type=OBLTIN, .beg="*"}; @@ -17,7 +18,6 @@ Object Ne = (Object){.type=OBLTIN, .beg= "!="}; Object Eq = (Object){.type=OBLTIN, .beg= "=="}; Object Not = (Object){.type=OBLTIN, .beg= "not"}; -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"}; diff --git a/eval.c b/eval.c index 70ad46d..9a1e1b0 100644 --- a/eval.c +++ b/eval.c @@ -9,8 +9,6 @@ exprlen(Object *expr) int l = 0; for(;expr->type==OCELL; expr=expr->cdr) ++l; - if(expr != &Nil) - error("Not list type"); return l; } @@ -20,14 +18,35 @@ islist(Object *obj) return obj == &Nil || obj->type == OCELL; } +static Object* +clone(Object *p) +{ + switch(p->type){ + default: panic("unreachable"); + case OSYMBOL: + case OBLTIN: return p; + case OINT: return newint(gc, p->num); + case OIDENT: return newsymbol(gc, p->beg, p->ptr - p->beg); + case OCELL: return newcons(gc, clone(p->car), clone(p->cdr)); + case OENV: return p; + case OMACRO: + case OFUNC: return newfn(gc, p->env, clone(p->params), clone(p->body), p->type); + case OSTRING:{ + Object *s = newstr(gc, p->end - p->beg); + strinit(s, p); + return s; + } + } +} + static Object* find(Object *env, Object *obj) { - for(Object *cur=env; cur!=&Nil; cur=cur->up){ - for(Object *p=cur->vars; p!=&Nil; p=p->cdr) - if(strequal(obj, p->car->car)) - return p->car; - } + for(Object *cur=env; cur!=&Nil; cur=cur->up) + for(Object *p=cur->vars; p!=&Nil; p=p->cdr) + if(strequal(obj, p->car->car)) + return clone(p->car->cdr); + error("not exist variable"); return 0; } @@ -36,10 +55,9 @@ _newfn(Object *env, Object *l, enum OType type) { if(l->type!=OCELL || islist(l->car)==0 || l->cdr->type!=OCELL) error("malformed function"); - for(Object *p=l->car; p->type==OCELL; p=p->cdr){ + for(Object *p=l->car; p->type==OCELL; p=p->cdr) if(p->car->type!=OIDENT) error("parameter is not IDNET"); - } Object *params = l->car; Object *body = l->cdr; return newfn(gc, env, params, body, type); @@ -48,10 +66,9 @@ _newfn(Object *env, Object *l, enum OType type) static Object* defvar(Object *env, Object *id, Object *val) { - for(Object *p=env->vars; p!=&Nil; p=p->cdr){ + for(Object *p=env->vars; p!=&Nil; p=p->cdr) if(strequal(id, p->car->car)) error("already exist variable. use setq plz..."); - } return newacons(gc, id, val, env->vars); } @@ -74,8 +91,7 @@ progn(Object *env, Object *list) { Object *r = 0; for(Object *p=list; p!=&Nil; p=p->cdr){ - r = p->car; - r = eval(env, r); + r = eval(env, p->car); } return r; } @@ -91,10 +107,15 @@ fnsetq(Object *env, Object *list) { if(exprlen(list)!=2 || list->car->type!=OIDENT) error("Malformed setq"); - Object *obj = find(env, list->car); - if(obj == 0) - error("Not exist variable"); - return obj->cdr = eval(env, list->cdr->car); + Object *cur = env; + Object *p = 0; + for(; cur!=&Nil; cur=cur->up) + for(p=cur->vars; p!=&Nil; p=p->cdr) + if(strequal(list->car, p->car->car)) + goto found; + error("setq not exist variable"); +found:; + return p->car->cdr = eval(env, list->cdr->car); } Object* @@ -115,29 +136,30 @@ fnquote(Object *env, Object *list) return list->car; } -static Object* +static Object* evalcomma(Object *env, Object *p) { if(p->type != OCELL) return p; if(p->car == &Comma){ if(p->cdr->type == OCELL && p->cdr->car == &Splice){ - Object *obj = eval(env, p->cdr->cdr); - return newcons(gc, &Splice, obj); + return newcons(gc, &Splice, eval(env, p->cdr->cdr)); }else return eval(env, p->cdr); } - Object *car = evalcomma(env, p->car); - Object *cdr = evalcomma(env, p->cdr); - if(cdr->type == OCELL && cdr->car == &Splice){ - cdr = cdr->cdr; + p->car = evalcomma(env, p->car); + p->cdr = evalcomma(env, p->cdr); + if(p->car->type == OCELL && p->car->car == &Splice){ + Object *i = p->car; + while(i->cdr->type == OCELL && i->cdr != &Nil) + i = i->cdr; + if(i->type == OCELL){ + i->cdr = p->cdr; + return p->car->cdr; + } + p->car = i; } - if(car->type == OCELL && car->car == &Splice){ - car = car->cdr; - if(cdr == &Nil) - return car; - } - return newcons(gc, car, cdr); + return p; } Object* @@ -155,7 +177,7 @@ fncar(Object *env, Object *list) if(list->car == &Nil) return &Nil; if(list->car->type != OCELL) - error("Malformed Car"); + error("car: expected list"); return list->car->car; } @@ -166,7 +188,7 @@ fncdr(Object *env, Object *list) if(list->car == &Nil) return &Nil; if(list->car->type != OCELL) - error("Malformed Car"); + error("cdr: expected list"); return list->car->cdr; } @@ -180,10 +202,11 @@ fncons(Object *env, Object *list) return list; } -static Object* -plusint(Object *env, Object *p) +Object* +fnplus(Object *env, Object *list) { long sum = 0; + Object *p=evallist(env, list); for(;p!=&Nil; p=p->cdr){ if(p->car->type != OINT) error("+ take only number"); @@ -192,29 +215,6 @@ plusint(Object *env, Object *p) return newint(gc, sum); } -static Object* -plusstr(Object *env, Object *p) -{ - Object *str = newstr(gc, 16); - for(;p!=&Nil; p=p->cdr){ - if(p->car->type != OSTRING) - error("+ take only number"); - str = strputs(str, p->car); - } - return str; -} - -Object* -fnplus(Object *env, Object *list) -{ - Object *p=evallist(env, list); - switch(p->car->type){ - default: error("+ take only [STRING, INT]"); - case OSTRING: return plusstr(env ,p); - case OINT: return plusint(env, p); - } -} - Object* fnmul(Object *env, Object *list) { @@ -285,9 +285,9 @@ _newint(int n) Object* fnnot(Object *env, Object *list) { - if(list->type != OCELL || exprlen(list)!= 1) + if(list->type != OCELL) error("Malformed not"); - return _newint(list->car == &Nil); + return _newint(eval(env, list->car) == &Nil); } Object* @@ -346,7 +346,7 @@ evallist(Object *env, Object *list) if(list == &Nil) return &Nil; if(list->type != OCELL) - error("type is not list"); + error("expected list"); Object *car = eval(env, list->car); Object *cdr = evallist(env, list->cdr); return newcons(gc, car, cdr); @@ -355,17 +355,23 @@ evallist(Object *env, Object *list) static Object* enter(Object *env, Object *vars, Object *args) { +#define cdr(x) (x!=&Nil ? x->cdr : &Nil) +#define car(x) (x!=&Nil ? x->car : &Nil) + Object *map = &Nil; - for(;vars->type==OCELL; vars=vars->cdr,args=args->cdr){ - if(args->type!=OCELL) + for(;vars->type==OCELL; vars=vars->cdr, args=cdr(args)){ + if(args != &Nil && args->type!=OCELL) error("Cna't apply function argment dose not match"); Object *id = vars->car; - Object *val = args->car; + Object *val = car(args); map = newacons(gc, id, val, map); } if(vars != &Nil) map = newacons(gc, vars, args, map); return newenv(gc, &Nil, map, env); + +#undef car +#undef cdr } static Object* @@ -423,13 +429,12 @@ eval(Object *env, Object *obj) case OSYMBOL: return obj; case OIDENT:{ - Object* val = find(env, obj); - if(val == 0) - error("not exist '%s'", obj->beg); - return val->cdr; + return find(env, obj); } case OCELL:{ Object *fn = eval(env, obj->car); + if(fn == &Nil) + return &Nil; Object *res = apply(env, fn, obj->cdr); return res; } diff --git a/lib/lib.lisp b/lib/lib.lisp index 863822d..3ac5c01 100644 --- a/lib/lib.lisp +++ b/lib/lib.lisp @@ -3,12 +3,6 @@ (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)) +(macro cond (expr . rest) + (if (not expr) nil + `(if ,(car expr) (progn ,@expr) (cond ,@rest)))) diff --git a/main.c b/main.c index 2f37c66..e943d04 100644 --- a/main.c +++ b/main.c @@ -60,7 +60,7 @@ int main(int argc, char *argv[]) { *argv = "lib/lib.lisp"; - gc = newgc(&argc, 12000); + gc = newgc(&argc, 400); lispmain(argv); panic("unreachable"); }