add frame

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},

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;

eval.c

@@ -1,5 +1,6 @@
 #include "dat.h"
 #include "fn.h"
+#include <assert.h>
 
 #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)
+	Object *res = 0;
-	for(Object *p=cur->vars; p!=&Nil; p=cdr(p)){
+	for(Object *cur=env->sp->car; cur!=&Nil; cur=cur->up)
-		Object *v = car(p);
+	for(Object *p=cur->local; p!=&Nil; p=cdr(p))
-		if(strequal(obj, car(v)))
+		if(strequal(obj, car(car(p)))){
-			return clone(cdr(v));
+			res = p;
-	}
+			break;
-	error("not exist variable");
+		}
-	return 0;
+	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;
+	for(Object *frame=env->sp->car; frame!=&Nil; frame=frame->up)
-	Object *p = &Nil;
+	for(Object *p=frame->local; p!=&Nil; p=cdr(p))
-	for(; cur!=&Nil; cur=cur->up)
-	for(p=cur->vars; 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) ;
+	Object *local = &Nil;
-	for(Object *p=list->car; p!=&Nil; p=cdr(p)){
+	for(Object *p=car(list); p!=&Nil; p=cdr(p)){
-		Object *var = car(car(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);
+	Object *local = applyargs(fn, args);
-	return progn(env, fn->body);
+	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 *local = applyargs(fn, args);
-	Object *r = 0;
+	enter(env, tag, local, fn->frame);
-	for(Object *p=fn->body; p!=&Nil; p=cdr(p)){
+	Object *r = progn(env, fn->body);
-		r = eval(nenv, car(p));
+	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 0;
-    	return applymacro(env, fn, args);
 	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;
 		}
 	}

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);

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);
+		obj->forward = p = newenv(dst,&Nil, &Nil, &Nil);
-		p->name = cloneobj(dst, src, obj->name);
+		p->frames = cloneobj(dst, src, obj->frames);
-		p->vars = cloneobj(dst, src, obj->vars);
+		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->frames);
-		mark(gc, obj->vars);
+		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;
 	}
 }

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)))
 

main.c

@@ -31,9 +31,13 @@ SExprint(Object *obj)
 	case OSYMBOL:
 		printf("%s", obj->beg);
 		break;
+	case OFRAME:
+		printf("<frame> %s\n", obj->tag->beg);
+		printexpr(obj->local);
+		break;
 	case OENV:
 		printf("<env>");
-		SExprint(obj->vars);
+		printexpr(obj->frames);
 		break;
 	case OMACRO:
 		printf("<macro>");

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);
+	Object *obj = newobj(gc, OFRAME, 0);
-	obj->name = name;
+	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;
 }
 

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)