From 9a12d2ac9fcbbdb7954d58c67d5500dcf30f5301 Mon Sep 17 00:00:00 2001 From: yoyo Date: Thu, 12 Sep 2024 18:30:28 +0900 Subject: [PATCH] add frame --- bltin.c | 7 +-- dat.h | 16 +++++-- eval.c | 119 ++++++++++++++++++++++++++++++++------------------- fn.h | 5 ++- gc.c | 25 ++++++++--- lib/lib.lisp | 12 +++--- main.c | 6 ++- obj.c | 22 +++++++--- repl.c | 5 ++- 9 files changed, 141 insertions(+), 76 deletions(-) diff --git a/bltin.c b/bltin.c index 1d3a086..6b0e5e3 100644 --- a/bltin.c +++ b/bltin.c @@ -2,6 +2,7 @@ #include "fn.h" Object Nil = (Object){.type=OSYMBOL, .beg="nil"}; +Object Top = (Object){.type=OSYMBOL, .beg="top"}; Object Splice= (Object){.type=OSYMBOL, .beg="@"}; Object Comma= (Object){.type=OSYMBOL, .beg=","}; Object Minus= (Object){.type=OBLTIN, .beg="-"}; @@ -27,7 +28,7 @@ Object Cdr = (Object){.type=OBLTIN, .beg="cdr"}; 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 Macro= (Object){.type=OBLTIN, .beg="defmacro"}; Object Setq = (Object){.type=OBLTIN, .beg="setq"}; Object If = (Object){.type=OBLTIN, .beg="if"}; @@ -39,7 +40,7 @@ extern Object* fnlambda(Object *, Object *); extern Object* fnlet(Object *, Object *); extern Object* fnprogn(Object *, Object *); extern Object* fndefine(Object *, Object *); -extern Object* fnmacro(Object *, Object *); +extern Object* fndefmacro(Object *, Object *); extern Object* fnsetq(Object *, Object *); extern Object* fnundef(Object *, Object *); extern Object* fnquote(Object *, Object *); @@ -72,7 +73,7 @@ bltinlookup(Object *obj) {&Mod , fnmod}, {&Div , fndiv}, {&Define ,fndefine}, - {&Macro ,fnmacro}, + {&Macro ,fndefmacro}, {&Setq ,fnsetq}, {&Let ,fnlet}, {&Quote ,fnquote}, diff --git a/dat.h b/dat.h index cfd3dc2..c7ccad7 100644 --- a/dat.h +++ b/dat.h @@ -13,6 +13,7 @@ enum OType OINT, OFUNC, OMACRO, + OFRAME, OENV, }; @@ -39,19 +40,26 @@ struct Object struct{ Object *params; Object *body; - Object *env; + Object *frame; /* running frame */ }; - /* env */ + /* Frame */ struct{ - Object *name; + Object *tag; /* block name */ + Object *local; /* local vars */ Object *up; - Object *vars; + }; + /* Env */ + struct{ + Object *frames; + Object *bp; + Object *sp; /* current */ }; }; }; extern GC *gc; extern Object Nil; +extern Object Top; extern Object Comma; extern Object Splice; extern Object Bquote; diff --git a/eval.c b/eval.c index 1548200..b0fce9b 100644 --- a/eval.c +++ b/eval.c @@ -1,5 +1,6 @@ #include "dat.h" #include "fn.h" +#include #define cdr(x) ((x)!= &Nil && (x)->type == OCELL ? (x)->cdr : &Nil) #define car(x) ((x)!= &Nil && (x)->type == OCELL ? (x)->car : &Nil) @@ -41,6 +42,7 @@ clone(Object *p) { switch(p->type){ default: panic("unreachable"); + case OFRAME: case OENV: case OSYMBOL: case OINT: @@ -49,7 +51,7 @@ clone(Object *p) return p; case OMACRO: case OFUNC: - return newfn(gc, p->env, clone(p->params), clone(p->body), p->type); + return newfn(gc, p->frame, clone(p->params), clone(p->body), p->type); case OCELL: return newcons(gc, clone(p->car), clone(p->cdr)); case OSTRING:{ @@ -63,14 +65,16 @@ clone(Object *p) static Object* find(Object *env, Object *obj) { - for(Object *cur=env; cur!=&Nil; cur=cur->up) - for(Object *p=cur->vars; p!=&Nil; p=cdr(p)){ - Object *v = car(p); - if(strequal(obj, car(v))) - return clone(cdr(v)); - } - error("not exist variable"); - return 0; + Object *res = 0; + for(Object *cur=env->sp->car; cur!=&Nil; cur=cur->up) + for(Object *p=cur->local; p!=&Nil; p=cdr(p)) + if(strequal(obj, car(car(p)))){ + res = p; + break; + } + if(res == 0) + error("not exist variable"); + return clone(cdr(car(res))); } static Object* @@ -83,18 +87,19 @@ _newfn(Object *env, Object *l, enum OType type) error("parameter is not IDNET"); Object *params = l->car; Object *body = l->cdr; - return newfn(gc, env, params, body, type); + return newfn(gc, env->sp->car, params, body, type); } -static Object* +static void defvar(Object *env, Object *id, Object *val) { if(id->type != OIDENT) error("can't define, already using id"); - for(Object *p=env->vars; p!=&Nil; p=cdr(p)) + Object *frame = env->bp->car; + for(Object *p=frame->local; p!=&Nil; p=cdr(p)) if(strequal(id, car(car(p)))) error("already exist variable. use setq plz..."); - return newacons(gc, id, val, env->vars); + frame->local = newacons(gc, id, val, frame->local); } Object* @@ -104,12 +109,12 @@ fnlambda(Object *env, Object *l) } Object* -fnmacro(Object *env, Object *l) +fndefmacro(Object *env, Object *l) { if(l->type != OCELL) error("Malformed macro"); Object *macro = _newfn(env, l->cdr, OMACRO); - env->vars = defvar(env, l->car, macro); + defvar(env, l->car, macro); return macro; } @@ -134,28 +139,49 @@ fnsetq(Object *env, Object *list) { if(list->type != OCELL || exprlen(list)!=2 || list->car->type!=OIDENT) error("Malformed setq"); - Object *cur = env; - Object *p = &Nil; - for(; cur!=&Nil; cur=cur->up) - for(p=cur->vars; p!=&Nil; p=cdr(p)) + for(Object *frame=env->sp->car; frame!=&Nil; frame=frame->up) + for(Object *p=frame->local; p!=&Nil; p=cdr(p)) if(strequal(list->car, car(car(p)))) - return p->car->cdr = eval(env, car(cdr(list))); + return p->car->cdr = eval(env, car(cdr(list))); + error("setq not exist variable"); return 0; } +static void +enter(Object *env, Object *tag, Object *local, Object *up) +{ + assert(env->bp != &Nil); + Object *frame = newframe(gc, tag, local, up); + env->sp = env->sp->cdr = newcons(gc, frame, &Nil); +} + +static void +leave(Object *env) +{ + assert(env->sp != env->bp); + Object *p = env->bp; + while(cdr(p) != env->sp) + p = p->cdr; + p->cdr = &Nil; + env->sp = p; +} + Object* fnlet(Object *env, Object *list) { if(exprlen(list) < 2) error("let (vars) bodys"); - Object *nenv = newenv(gc, &Nil, &Nil, env) ; - for(Object *p=list->car; p!=&Nil; p=cdr(p)){ - Object *var = car(car(p)); + Object *local = &Nil; + for(Object *p=car(list); p!=&Nil; p=cdr(p)){ + Object *id = car(car(p)); Object *val = eval(env, car(cdr(car(p)))); - nenv->vars = defvar(nenv, var, val); + local = newacons(gc, id, val, local); } - return progn(nenv, cdr(list)); + enter(env, &Let, local, env->sp->car); + Object *res = progn(env, cdr(list)); + leave(env); + return res; } Object* @@ -164,7 +190,7 @@ fndefine(Object *env, Object *list) if(exprlen(list)!=2) error("Malformed define"); Object *val = eval(env, car(cdr(list))); - env->vars = defvar(env, car(list), val); + defvar(env, car(list), val); return val; } @@ -206,7 +232,7 @@ fnbquote(Object *env, Object *list) { if(exprlen(list) != 1) error("Malformed fnbquote"); - return evalcomma(env, list->car); + return evalcomma(env, car(list)); } Object* @@ -387,9 +413,10 @@ evallist(Object *env, Object *list) } static Object* -enter(Object *env, Object *vars, Object *args) +applyargs(Object *fn, Object *args) { Object *map = &Nil; + Object *vars = fn->params; for(;vars->type==OCELL; vars=cdr(vars), args=cdr(args)){ if(args != &Nil && args->type!=OCELL) error("Cna't apply function argment dose not match"); @@ -399,44 +426,45 @@ enter(Object *env, Object *vars, Object *args) } if(vars != &Nil) map = newacons(gc, vars, args, map); - return newenv(gc, &Nil, map, env); + return map; } static Object* -applyfn(Object *fn, Object *args) +applyfn(Object *env, Object *tag, Object *fn, Object *args) { - Object *env = enter(fn->env, fn->params, args); - return progn(env, fn->body); + Object *local = applyargs(fn, args); + enter(env, tag, local,fn->frame); + Object *res = progn(env, fn->body); + leave(env); + return res; } static Object* -applymacro(Object *env, Object* fn, Object *args) +applymacro(Object *env, Object *tag, Object* fn, Object *args) { - Object *nenv = enter(fn->env, fn->params, args); - Object *r = 0; - for(Object *p=fn->body; p!=&Nil; p=cdr(p)){ - r = eval(nenv, car(p)); - } + Object *local = applyargs(fn, args); + enter(env, tag, local, fn->frame); + Object *r = progn(env, fn->body); + leave(env); return eval(env, r); } static Object* -apply(Object *env, Object *fn, Object *args) +apply(Object *env, Object *tag, Object *fn, Object *args) { - if(islist(args) == 0) - error("apply:args is not list type"); switch(fn->type){ default: error("apply:can't eval type"); - case OMACRO: - return applymacro(env, fn, args); + return 0; case OBLTIN:{ Bltinfn blt = bltinlookup(fn); return blt(env, args); } + case OMACRO: + return applymacro(env, tag, fn, args); case OFUNC:{ Object *elist = evallist(env, args); - Object*res = applyfn(fn, elist); + Object*res = applyfn(env, tag, fn, elist); return res; } } @@ -448,6 +476,7 @@ eval(Object *env, Object *obj) switch(obj->type){ default: error("eval: can't eval type"); + return 0; case OSTRING: case OINT: case OBLTIN: @@ -457,7 +486,7 @@ eval(Object *env, Object *obj) return find(env, obj); case OCELL:{ Object *fn = eval(env, obj->car); - Object *res = apply(env, fn, obj->cdr); + Object *res = apply(env, obj->car, fn, obj->cdr); return res; } } diff --git a/fn.h b/fn.h index 76002f0..07f2fda 100644 --- a/fn.h +++ b/fn.h @@ -12,11 +12,12 @@ 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); +Object* newenv(GC *gc, Object *frames, Object *bp, Object *sp); +Object* newframe(GC *gc, Object* tag, Object *local, Object *up); Object* newacons(GC *,Object*, Object*, Object*); Object* newsymbol(GC *,char*, int); Object* newstr(GC *,int); -Object* newfn(GC *,Object *env, Object *params, Object *body, enum OType type); +Object* newfn(GC *,Object *frame, Object *params, Object *body, enum OType type); /* gc.c */ GC* newgc(void *top, int cap); diff --git a/gc.c b/gc.c index 24d3677..19bf5c0 100644 --- a/gc.c +++ b/gc.c @@ -65,9 +65,15 @@ cloneobj(GC *dst, GC *src, Object *obj) p->cdr = cloneobj(dst, src, obj->cdr); break; case OENV: - obj->forward = p = newenv(dst, &Nil, &Nil, &Nil); - p->name = cloneobj(dst, src, obj->name); - p->vars = cloneobj(dst, src, obj->vars); + obj->forward = p = newenv(dst,&Nil, &Nil, &Nil); + p->frames = cloneobj(dst, src, obj->frames); + p->bp = cloneobj(dst, src, obj->bp); + p->sp = cloneobj(dst, src, obj->sp); + break; + case OFRAME: + obj->forward = p = newframe(dst, &Nil, &Nil, &Nil); + p->tag = cloneobj(dst, src, obj->tag); + p->local = cloneobj(dst, src, obj->local); p->up = cloneobj(dst, src, obj->up); break; case OMACRO: @@ -75,7 +81,7 @@ cloneobj(GC *dst, GC *src, Object *obj) obj->forward = p = newfn(dst, &Nil, &Nil, &Nil, obj->type); p->params = cloneobj(dst, src, obj->params); p->body = cloneobj(dst, src, obj->body); - p->env = cloneobj(dst, src, obj->env); + p->frame = cloneobj(dst, src, obj->frame); break; } return p; @@ -128,15 +134,20 @@ mark(GC *gc, Object *obj) mark(gc, obj->cdr); break; case OENV: - mark(gc, obj->name); - mark(gc, obj->vars); + mark(gc, obj->frames); + mark(gc, obj->bp); + mark(gc, obj->sp); + break; + case OFRAME: + mark(gc, obj->tag); + mark(gc, obj->local); mark(gc, obj->up); break; case OMACRO: case OFUNC: mark(gc, obj->params); mark(gc, obj->body); - mark(gc, obj->env); + mark(gc, obj->frame); break; } } diff --git a/lib/lib.lisp b/lib/lib.lisp index f9ba664..17de461 100644 --- a/lib/lib.lisp +++ b/lib/lib.lisp @@ -1,7 +1,7 @@ -(macro defun (name args body) +(defmacro defun (name args body) `(define ,name (lambda ,args ,body))) -(macro cond (expr . rest) +(defmacro cond (expr . rest) (if (not expr) nil (let ((test (car expr))) @@ -9,22 +9,22 @@ (progn ,test ,@(cdr expr)) (cond ,@rest))))) -(macro and (expr . rest) +(defmacro and (expr . rest) (if (not rest) expr (if (cond (not expr) nil) `(and ,@rest)))) -(macro or (expr . rest) +(defmacro or (expr . rest) (if rest (cond (expr) (`(or ,@rest))) expr)) -(macro when (test . rest) +(defmacro when (test . rest) `(if ,test (progn ,@rest))) -(macro unless (test . rest) +(defmacro unless (test . rest) `(if (not ,test) (progn ,@rest))) diff --git a/main.c b/main.c index e943d04..f26a1be 100644 --- a/main.c +++ b/main.c @@ -31,9 +31,13 @@ SExprint(Object *obj) case OSYMBOL: printf("%s", obj->beg); break; + case OFRAME: + printf(" %s\n", obj->tag->beg); + printexpr(obj->local); + break; case OENV: printf(""); - SExprint(obj->vars); + printexpr(obj->frames); break; case OMACRO: printf(""); diff --git a/obj.c b/obj.c index 8e1213e..dd214e8 100644 --- a/obj.c +++ b/obj.c @@ -29,15 +29,25 @@ newcons(GC *gc, Object *car, Object *cdr) } Object* -newenv(GC *gc, Object* name, Object *vars, Object *up) +newframe(GC *gc, Object* tag, Object *local, Object *up) { - Object *obj = newobj(gc, OENV, 0); - obj->name = name; + Object *obj = newobj(gc, OFRAME, 0); + obj->tag = tag; + obj->local = local; obj->up = up; - obj->vars = vars; return obj; } +Object* +newenv(GC *gc, Object *frames, Object *bp, Object *sp) +{ + Object *env = newobj(gc, OENV, 0); + env->frames = frames; + env->bp = bp; + env->sp = sp; + return env; +} + Object* newacons(GC *gc, Object *x, Object *y, Object *z) { @@ -46,13 +56,13 @@ newacons(GC *gc, Object *x, Object *y, Object *z) } Object* -newfn(GC *gc, Object *env, Object *params, Object *body, enum OType type) +newfn(GC *gc, Object *frame, Object *params, Object *body, enum OType type) { Object *fn = newobj(gc, type, 0); fn->type = type; fn->params = params; fn->body = body; - fn->env = env; + fn->frame = frame; return fn; } diff --git a/repl.c b/repl.c index 79a4e1d..e2bf01f 100644 --- a/repl.c +++ b/repl.c @@ -46,7 +46,6 @@ repl(Object *env, FILE *f, char *pre) Object *res = nextexpr(f); res = eval(env, res); printexpr(res); - printgc("status", gc); } } @@ -67,7 +66,9 @@ readlib(FILE *f, Object *env) void lispmain(char *argv[]) { - Object *env = newenv(gc , &Nil, &Nil, &Nil); + Object *frame = newframe(gc, &Top, &Nil, &Nil); + Object *cons = newcons(gc, frame, &Nil); + Object *env = newenv(gc, cons, cons, cons); for(; *argv; ++argv){ FILE *f = fopen(*argv, "r"); if(f == 0)