Hojun-Cho/clisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Compare commits

base: Hojun-Cho:001eafc790ddb530655bca733fa259262a064389
Branches Tags
Hojun-Cho:master
..
compare: Hojun-Cho:f4677129071068b2ba8f1339f871edefc3fe9c50
Branches Tags
Hojun-Cho:master

No commits in common. "001eafc790ddb530655bca733fa259262a064389" and "f4677129071068b2ba8f1339f871edefc3fe9c50" have entirely different histories.
001eafc790 ... f467712907

9 changed files with 143 additions and 375 deletions
Show Stats Expand all files Collapse all files

16
bltin.c
View File

@ -2,7 +2,6 @@
#include "fn.h" #include "fn.h"
Object Nil = (Object){.type=OSYMBOL, .beg="nil"}; Object Nil = (Object){.type=OSYMBOL, .beg="nil"};
Object Top = (Object){.type=OSYMBOL, .beg="top"};
Object Splice= (Object){.type=OSYMBOL, .beg="@"}; Object Splice= (Object){.type=OSYMBOL, .beg="@"};
Object Comma= (Object){.type=OSYMBOL, .beg=","}; Object Comma= (Object){.type=OSYMBOL, .beg=","};
Object Minus= (Object){.type=OBLTIN, .beg="-"}; Object Minus= (Object){.type=OBLTIN, .beg="-"};
@ -21,16 +20,13 @@ Object Not = (Object){.type=OBLTIN, .beg= "not"};
Object Bquote= (Object){.type=OBLTIN, .beg="`"}; Object Bquote= (Object){.type=OBLTIN, .beg="`"};
Object Lambda= (Object){.type=OBLTIN, .beg="lambda"}; Object Lambda= (Object){.type=OBLTIN, .beg="lambda"};
Object Block= (Object){.type=OBLTIN, .beg="block"};
Object RetFrom = (Object){.type=OBLTIN, .beg="return-from"};
Object Let= (Object){.type=OBLTIN, .beg="let"};
Object Progn=(Object){.type=OBLTIN, .beg="progn"}; Object Progn=(Object){.type=OBLTIN, .beg="progn"};
Object Car = (Object){.type=OBLTIN, .beg="car"}; Object Car = (Object){.type=OBLTIN, .beg="car"};
Object Cdr = (Object){.type=OBLTIN, .beg="cdr"}; Object Cdr = (Object){.type=OBLTIN, .beg="cdr"};
Object Quote= (Object){.type=OBLTIN, .beg="'"}; Object Quote= (Object){.type=OBLTIN, .beg="'"};
Object Cons = (Object){.type=OBLTIN, .beg="cons"}; Object Cons = (Object){.type=OBLTIN, .beg="cons"};
Object Define= (Object){.type=OBLTIN, .beg="define"}; Object Define= (Object){.type=OBLTIN, .beg="define"};
Object Macro= (Object){.type=OBLTIN, .beg="defmacro"}; Object Macro= (Object){.type=OBLTIN, .beg="macro"};
Object Setq = (Object){.type=OBLTIN, .beg="setq"}; Object Setq = (Object){.type=OBLTIN, .beg="setq"};
Object If = (Object){.type=OBLTIN, .beg="if"}; Object If = (Object){.type=OBLTIN, .beg="if"};
@ -39,12 +35,9 @@ extern Object* fnmul(Object *, Object *);
extern Object* fndiv(Object *, Object *); extern Object* fndiv(Object *, Object *);
extern Object* fnmod(Object *, Object *); extern Object* fnmod(Object *, Object *);
extern Object* fnlambda(Object *, Object *); extern Object* fnlambda(Object *, Object *);
extern Object* fnlet(Object *, Object *);
extern Object* fnprogn(Object *, Object *); extern Object* fnprogn(Object *, Object *);
extern Object* fnblock(Object *, Object *);
extern Object* fnretfrom(Object *, Object *);
extern Object* fndefine(Object *, Object *); extern Object* fndefine(Object *, Object *);
extern Object* fndefmacro(Object *, Object *); extern Object* fnmacro(Object *, Object *);
extern Object* fnsetq(Object *, Object *); extern Object* fnsetq(Object *, Object *);
extern Object* fnundef(Object *, Object *); extern Object* fnundef(Object *, Object *);
extern Object* fnquote(Object *, Object *); extern Object* fnquote(Object *, Object *);
@ -72,16 +65,13 @@ bltinlookup(Object *obj)
}bltins[] = { }bltins[] = {
{&Lambda , fnlambda}, {&Lambda , fnlambda},
{&Progn , fnprogn}, {&Progn , fnprogn},
{&Block , fnblock},
{&RetFrom ,fnretfrom},
{&Plus , fnplus}, {&Plus , fnplus},
{&Mul , fnmul}, {&Mul , fnmul},
{&Mod , fnmod}, {&Mod , fnmod},
{&Div , fndiv}, {&Div , fndiv},
{&Define ,fndefine}, {&Define ,fndefine},
{&Macro ,fndefmacro}, {&Macro ,fnmacro},
{&Setq ,fnsetq}, {&Setq ,fnsetq},
{&Let ,fnlet},
{&Quote ,fnquote}, {&Quote ,fnquote},
{&Bquote, fnbquote}, {&Bquote, fnbquote},
{&Car ,fncar}, {&Car ,fncar},

29
dat.h
View File

@ -13,8 +13,6 @@ enum OType
OINT, OINT,
OFUNC, OFUNC,
OMACRO, OMACRO,
OBLOCK,
OFRAME,
OENV, OENV,
}; };
@ -37,41 +35,23 @@ struct Object
char *ptr; char *ptr;
char *end; char *end;
}; };
/* Block */
struct{
Object *_tag;
Object *_up;
Object *_body;
void *jmp;
};
/* function */ /* function */
struct{ struct{
Object *params; Object *params;
Object *frame; /* running frame */
Object *body; Object *body;
Object *block; Object *env;
}; };
/* Frame */ /* env */
struct{ struct{
Object *tag; /* Frame enter name */ Object *name;
Object *up; Object *up;
Object *local; /* local vars */ Object *vars;
};
/* Env */
struct{
Object *frames;
Object *bp;
Object *sp; /* current */
Object *retval; /* for return-from */
}; };
}; };
}; };
extern GC *gc; extern GC *gc;
extern Object Nil; extern Object Nil;
extern Object Top;
extern Object Block;
extern Object RetFrom;
extern Object Comma; extern Object Comma;
extern Object Splice; extern Object Splice;
extern Object Bquote; extern Object Bquote;
@ -89,7 +69,6 @@ extern Object Define;
extern Object Progn; extern Object Progn;
extern Object Macro; extern Object Macro;
extern Object Setq; extern Object Setq;
extern Object Let;
extern Object Eq; extern Object Eq;
extern Object Not; extern Object Not;
extern Object Ne; extern Object Ne;

321
eval.c
View File

@ -1,64 +1,14 @@
#include "dat.h" #include "dat.h"
#include "fn.h" #include "fn.h"
#include <assert.h>
#include <setjmp.h>
#include <string.h>
#define cdr(x) ((x)!= &Nil && (x)->type == OCELL ? (x)->cdr : &Nil)
#define car(x) ((x)!= &Nil && (x)->type == OCELL ? (x)->car : &Nil)
static char *typtab[] = {
[ONONE] = "error",
[OBLTIN] = "bltin",
[OSYMBOL] = "symbol",
[OCELL] = "cell",
[OIDENT] = "ident",
[OSTRING] = "string",
[OINT] = "int",
[OFUNC] = "func",
[OMACRO] = "macro",
[OENV] = "env",
};
static Object* evallist(Object *env, Object *list); static Object* evallist(Object *env, Object *list);
static Object* curblock(Object *env) { return env->sp->car->block; }
static Object* curframe(Object *env) { return env->sp->car; }
static int
_streq(Object *a, Object *b)
{
int la = strlen(a->beg);
return la == strlen(b->beg) && memcmp(a->beg, b->beg, la) == 0;
}
static void
enterframe(Object *env, Object *tag, Object *local, Object *up)
{
assert(env->bp != &Nil);
Object *frame = newframe(gc, tag, local, up, curblock(env));
env->sp = env->sp->cdr = newcons(gc, frame, &Nil);
}
static void
leaveframe(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;
}
static int static int
exprlen(Object *expr) exprlen(Object *expr)
{ {
int l = 0; int l = 0;
while(expr != &Nil){ for(;expr->type==OCELL; expr=expr->cdr)
expr = cdr(expr); ++l;
l += 1;
}
return l; return l;
} }
@ -73,18 +23,14 @@ clone(Object *p)
{ {
switch(p->type){ switch(p->type){
default: panic("unreachable"); default: panic("unreachable");
case OFRAME:
case OENV:
case OSYMBOL: case OSYMBOL:
case OINT: case OBLTIN: return p;
case OIDENT: case OINT: return newint(gc, p->num);
case OBLTIN: case OIDENT: return newsymbol(gc, p->beg, p->ptr - p->beg);
return p; case OCELL: return newcons(gc, clone(p->car), clone(p->cdr));
case OENV: return p;
case OMACRO: case OMACRO:
case OFUNC: 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:{ case OSTRING:{
Object *s = newstr(gc, p->end - p->beg); Object *s = newstr(gc, p->end - p->beg);
strinit(s, p); strinit(s, p);
@ -96,10 +42,10 @@ clone(Object *p)
static Object* static Object*
find(Object *env, Object *obj) find(Object *env, Object *obj)
{ {
for(Object *cur=curframe(env); cur!=&Nil; cur=cur->up) for(Object *cur=env; cur!=&Nil; cur=cur->up)
for(Object *p=cur->local; p!=&Nil; p=cdr(p)) for(Object *p=cur->vars; p!=&Nil; p=p->cdr)
if(strequal(obj, car(car(p)))) if(strequal(obj, p->car->car))
return clone(cdr(car(p))); return clone(p->car->cdr);
error("not exist variable"); error("not exist variable");
return 0; return 0;
} }
@ -109,24 +55,21 @@ _newfn(Object *env, Object *l, enum OType type)
{ {
if(l->type!=OCELL || islist(l->car)==0 || l->cdr->type!=OCELL) if(l->type!=OCELL || islist(l->car)==0 || l->cdr->type!=OCELL)
error("malformed function"); error("malformed function");
for(Object *p=l->car; p->type==OCELL; p=cdr(p)) for(Object *p=l->car; p->type==OCELL; p=p->cdr)
if(p->car->type!=OIDENT) if(p->car->type!=OIDENT)
error("parameter is not IDNET"); error("parameter is not IDNET");
Object *params = l->car; Object *params = l->car;
Object *body = l->cdr; Object *body = l->cdr;
return newfn(gc, curframe(env), params, body, type); return newfn(gc, env, params, body, type);
} }
static void static Object*
defvar(Object *env, Object *id, Object *val) defvar(Object *env, Object *id, Object *val)
{ {
if(id->type != OIDENT) for(Object *p=env->vars; p!=&Nil; p=p->cdr)
error("can't define, already using id"); if(strequal(id, p->car->car))
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..."); error("already exist variable. use setq plz...");
frame->local = newacons(gc, id, val, frame->local); return newacons(gc, id, val, env->vars);
} }
Object* Object*
@ -136,21 +79,19 @@ fnlambda(Object *env, Object *l)
} }
Object* Object*
fndefmacro(Object *env, Object *l) fnmacro(Object *env, Object *l)
{ {
if(l->type != OCELL)
error("Malformed macro");
Object *macro = _newfn(env, l->cdr, OMACRO); Object *macro = _newfn(env, l->cdr, OMACRO);
defvar(env, l->car, macro); env->vars = defvar(env, l->car, macro);
return macro; return macro;
} }
static Object* static Object*
progn(Object *env, Object *list) progn(Object *env, Object *list)
{ {
Object *r = &Nil; Object *r = 0;
for(Object *p=list; p!=&Nil; p=cdr(p)){ for(Object *p=list; p!=&Nil; p=p->cdr){
r = eval(env, car(p)); r = eval(env, p->car);
} }
return r; return r;
} }
@ -161,86 +102,29 @@ fnprogn(Object *env, Object *list)
return progn(env, list); return progn(env, list);
} }
Object*
fnblock(Object *env, Object *list)
{
if(list->type != OCELL|| (list->car->type != OSYMBOL&&list->car->type != OIDENT))
error("Malformed block");
Object *tag = car(list);
Object *body = cdr(list);
jmp_buf jmp;
Object *b = newblock(gc, tag, curblock(env), body, &jmp);
Object *sp = env->sp;
sp->car->block = b;
Object *res = &Nil;
if(setjmp(jmp) == 1){
env->sp->block = b->up;
env->sp = sp;
res = env->retval;
env->retval = &Nil;
return res;
}
res = progn(env, body);
sp->car->block = b->up;
return res;
}
Object*
fnretfrom(Object *env, Object *list)
{
if(list->type != OCELL)
error("Malformed return-from");
Object *tag = car(list);
Object *p = curblock(env);
for(; p!= &Top; p=p->up)
if(_streq(p->tag, tag)){
env->retval = eval(env, car(cdr(list)));
longjmp(*(jmp_buf*)p->jmp, 1);
}
error("can't excute return-from");
return 0;
}
Object* Object*
fnsetq(Object *env, Object *list) fnsetq(Object *env, Object *list)
{ {
if(list->type != OCELL || exprlen(list)!=2 || list->car->type!=OIDENT) if(exprlen(list)!=2 || list->car->type!=OIDENT)
error("Malformed setq"); error("Malformed setq");
for(Object *frame=curframe(env); frame!=&Nil; frame=frame->up) Object *cur = env;
for(Object *p=frame->local; p!=&Nil; p=cdr(p)) Object *p = 0;
if(strequal(list->car, car(car(p)))) for(; cur!=&Nil; cur=cur->up)
return p->car->cdr = eval(env, car(cdr(list))); for(p=cur->vars; p!=&Nil; p=p->cdr)
if(strequal(list->car, p->car->car))
goto found;
error("setq not exist variable"); error("setq not exist variable");
return 0; found:;
} return p->car->cdr = eval(env, list->cdr->car);
Object*
fnlet(Object *env, Object *list)
{
if(exprlen(list) < 2)
error("let (vars) bodys");
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))));
local = newacons(gc, id, val, local);
}
enterframe(env, &Let, local, curframe(env));
Object *res = progn(env, cdr(list));
leaveframe(env);
return res;
} }
Object* Object*
fndefine(Object *env, Object *list) fndefine(Object *env, Object *list)
{ {
if(exprlen(list)!=2) if(exprlen(list)!=2 || list->car->type!=OIDENT)
error("Malformed define"); error("Malformed define");
Object *val = eval(env, car(cdr(list))); Object *val = eval(env, list->cdr->car);
defvar(env, car(list), val); env->vars = defvar(env, list->car, val);
return val; return val;
} }
@ -258,15 +142,16 @@ evalcomma(Object *env, Object *p)
if(p->type != OCELL) if(p->type != OCELL)
return p; return p;
if(p->car == &Comma){ if(p->car == &Comma){
if(car(cdr(p)) == &Splice) if(p->cdr->type == OCELL && p->cdr->car == &Splice){
return newcons(gc, &Splice, eval(env, p->cdr->cdr)); return newcons(gc, &Splice, eval(env, p->cdr->cdr));
}else
return eval(env, p->cdr); return eval(env, p->cdr);
} }
p->car = evalcomma(env, p->car); p->car = evalcomma(env, p->car);
p->cdr = evalcomma(env, p->cdr); p->cdr = evalcomma(env, p->cdr);
if(car(car(p)) == &Splice){ if(p->car->type == OCELL && p->car->car == &Splice){
Object *i = p->car; Object *i = p->car;
while(cdr(i) != &Nil) while(i->cdr->type == OCELL && i->cdr != &Nil)
i = i->cdr; i = i->cdr;
if(i->type == OCELL){ if(i->type == OCELL){
i->cdr = p->cdr; i->cdr = p->cdr;
@ -282,25 +167,29 @@ fnbquote(Object *env, Object *list)
{ {
if(exprlen(list) != 1) if(exprlen(list) != 1)
error("Malformed fnbquote"); error("Malformed fnbquote");
return evalcomma(env, car(list)); return evalcomma(env, list->car);
} }
Object* Object*
fncar(Object *env, Object *list) fncar(Object *env, Object *list)
{ {
list = evallist(env, list); list = evallist(env, list);
if(car(list)->type != OCELL) if(list->car == &Nil)
error("expected list"); return &Nil;
return car(car(list)); if(list->car->type != OCELL)
error("car: expected list");
return list->car->car;
} }
Object* Object*
fncdr(Object *env, Object *list) fncdr(Object *env, Object *list)
{ {
list = evallist(env, list); list = evallist(env, list);
if(car(list)->type != OCELL) if(list->car == &Nil)
error("expected list"); return &Nil;
return cdr(car(list)); if(list->car->type != OCELL)
error("cdr: expected list");
return list->car->cdr;
} }
Object* Object*
@ -309,9 +198,7 @@ fncons(Object *env, Object *list)
if(exprlen(list) != 2) if(exprlen(list) != 2)
error("Malformoed cons"); error("Malformoed cons");
list = evallist(env, list); list = evallist(env, list);
if(list->type != OCELL) list->cdr = list->cdr->car;
error("cons:bad list");
list->cdr = car(list->cdr);
return list; return list;
} }
@ -320,7 +207,7 @@ fnplus(Object *env, Object *list)
{ {
long sum = 0; long sum = 0;
Object *p=evallist(env, list); Object *p=evallist(env, list);
for(;p!=&Nil; p=cdr(p)){ for(;p!=&Nil; p=p->cdr){
if(p->car->type != OINT) if(p->car->type != OINT)
error("+ take only number"); error("+ take only number");
sum += p->car->num; sum += p->car->num;
@ -332,11 +219,11 @@ Object*
fnmul(Object *env, Object *list) fnmul(Object *env, Object *list)
{ {
Object *p = evallist(env, list); Object *p = evallist(env, list);
if(car(p)->type != OINT) if(p->car->type != OINT)
error("* take only [INT]"); error("* take only [INT]");
long sum = p->car->num; long sum = p->car->num;
for(p=p->cdr;p!=&Nil; p=cdr(p)){ for(p=p->cdr;p!=&Nil; p=p->cdr){
if(car(p)->type != OINT) if(p->car->type != OINT)
error("* take only [INT]"); error("* take only [INT]");
sum *= p->car->num; sum *= p->car->num;
} }
@ -350,8 +237,8 @@ fndiv(Object *env, Object *list)
if(p->car->type != OINT) if(p->car->type != OINT)
error("/ take only [INT]"); error("/ take only [INT]");
long sum = p->car->num; long sum = p->car->num;
for(p=p->cdr;p!=&Nil; p=cdr(p)){ for(p=p->cdr;p!=&Nil; p=p->cdr){
if(car(p)->type != OINT) if(p->car->type != OINT)
error("/ take only [INT]"); error("/ take only [INT]");
if(p->car->num == 0) if(p->car->num == 0)
error("Can't div zero"); error("Can't div zero");
@ -367,8 +254,8 @@ fnmod(Object *env, Object *list)
if(p->car->type != OINT) if(p->car->type != OINT)
error("%% take only [INT]"); error("%% take only [INT]");
long sum = p->car->num; long sum = p->car->num;
for(p=p->cdr;p!=&Nil; p=cdr(p)){ for(p=p->cdr;p!=&Nil; p=p->cdr){
if(car(p)->type != OINT) if(p->car->type != OINT)
error("%% take only [INT]"); error("%% take only [INT]");
if(p->car->num == 0) if(p->car->num == 0)
error("Can't mod zero"); error("Can't mod zero");
@ -380,8 +267,8 @@ fnmod(Object *env, Object *list)
static long static long
cmp(Object *env, Object *list) cmp(Object *env, Object *list)
{ {
Object *a = eval(env, car(list)); Object *a = eval(env, list->car);
Object *b = eval(env, car(cdr(list))); Object *b = eval(env, list->cdr->car);
if(a->type != OINT || b->type != OINT) if(a->type != OINT || b->type != OINT)
error("cmp only take [INT]"); error("cmp only take [INT]");
return a->num - b->num; return a->num - b->num;
@ -398,9 +285,9 @@ _newint(int n)
Object* Object*
fnnot(Object *env, Object *list) fnnot(Object *env, Object *list)
{ {
if(exprlen(list) != 1) if(list->type != OCELL)
error("Malformed not"); error("Malformed not");
return _newint(eval(env, car(list)) == &Nil); return _newint(eval(env, list->car) == &Nil);
} }
Object* Object*
@ -442,14 +329,15 @@ fnne(Object *env, Object *list)
Object* Object*
fnif(Object *env, Object *list) fnif(Object *env, Object *list)
{ {
if(cdr(list)->type != OCELL) if(list->type != OCELL || list->cdr->type != OCELL)
error("Malformed if stmt"); error("Malformed if stmt");
Object *test = list->car; if(eval(env, list->car)!=&Nil)
Object *then = car(cdr(list)); return eval(env, list->cdr->car);
Object *else_ = car(cdr(cdr(list))); if(list->cdr->cdr == &Nil)
if(eval(env, test)!=&Nil) return &Nil;
return eval(env, then); if(list->cdr->cdr->type != OCELL)
return eval(env, else_); error("Malformed else stmt");
return eval(env, list->cdr->cdr->car);
} }
static Object* static Object*
@ -457,64 +345,73 @@ evallist(Object *env, Object *list)
{ {
if(list == &Nil) if(list == &Nil)
return &Nil; return &Nil;
Object *car = eval(env, car(list)); if(list->type != OCELL)
Object *cdr = evallist(env, cdr(list)); error("expected list");
Object *car = eval(env, list->car);
Object *cdr = evallist(env, list->cdr);
return newcons(gc, car, cdr); return newcons(gc, car, cdr);
} }
static Object* static Object*
applyargs(Object *fn, Object *args) 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; Object *map = &Nil;
Object *vars = fn->params; for(;vars->type==OCELL; vars=vars->cdr, args=cdr(args)){
for(;vars->type==OCELL; vars=cdr(vars), args=cdr(args)){
if(args != &Nil && args->type!=OCELL) if(args != &Nil && args->type!=OCELL)
error("Cna't apply function argment dose not match"); error("Cna't apply function argment dose not match");
Object *id = car(vars); Object *id = vars->car;
Object *val = car(args); Object *val = car(args);
map = newacons(gc, id, val, map); map = newacons(gc, id, val, map);
} }
if(vars != &Nil) if(vars != &Nil)
map = newacons(gc, vars, args, map); map = newacons(gc, vars, args, map);
return map; return newenv(gc, &Nil, map, env);
#undef car
#undef cdr
} }
static Object* static Object*
applyfn(Object *env, Object *tag, Object *fn, Object *args) applyfn(Object *fn, Object *args)
{ {
Object *local = applyargs(fn, args); Object *env = enter(fn->env, fn->params, args);
enterframe(env, tag, local,fn->frame); return progn(env, fn->body);
Object *res = progn(env, fn->body);
leaveframe(env);
return res;
} }
static Object* static Object*
applymacro(Object *env, Object *tag, Object* fn, Object *args) applymacro(Object *env, Object* fn, Object *args)
{ {
Object *local = applyargs(fn, args); Object *nenv = enter(fn->env, fn->params, args);
enterframe(env, tag, local, fn->frame); Object *r = 0;
Object *r = progn(env, fn->body); for(Object *p=fn->body; p!=&Nil; p=p->cdr){
leaveframe(env); r = p->car;
r = eval(nenv, r);
}
return eval(env, r); return eval(env, r);
} }
static Object* static Object*
apply(Object *env, Object *tag, Object *fn, Object *args) apply(Object *env, Object *fn, Object *args)
{ {
if(islist(args) == 0)
error("args is not list type");
switch(fn->type){ switch(fn->type){
default: default:
error("apply:can't eval type"); error("apply only tabke [MACRO BLTIN FUNC]");
return 0; case OMACRO:
return applymacro(env, fn, args);
case OBLTIN:{ case OBLTIN:{
Bltinfn blt = bltinlookup(fn); Bltinfn blt = bltinlookup(fn);
if(blt==0)
error("not builtin type!");
return blt(env, args); return blt(env, args);
} }
case OMACRO:
return applymacro(env, tag, fn, args);
case OFUNC:{ case OFUNC:{
Object *elist = evallist(env, args); Object *elist = evallist(env, args);
Object*res = applyfn(env, tag, fn, elist); Object*res = applyfn(fn, elist);
return res; return res;
} }
} }
@ -525,18 +422,20 @@ eval(Object *env, Object *obj)
{ {
switch(obj->type){ switch(obj->type){
default: default:
error("eval: can't eval type"); error("can't eval");
return 0;
case OSTRING: case OSTRING:
case OINT: case OINT:
case OBLTIN: case OBLTIN:
case OSYMBOL: case OSYMBOL:
return obj; return obj;
case OIDENT: case OIDENT:{
return find(env, obj); return find(env, obj);
}
case OCELL:{ case OCELL:{
Object *fn = eval(env, obj->car); Object *fn = eval(env, obj->car);
Object *res = apply(env, obj->car, fn, obj->cdr); if(fn == &Nil)
return &Nil;
Object *res = apply(env, fn, obj->cdr);
return res; return res;
} }
} }

6
fn.h
View File

@ -12,13 +12,11 @@ Object* eval(Object *env, Object *expr);
/* new */ /* new */
Object* newint(GC *,long); Object* newint(GC *,long);
Object* newcons(GC *,Object*,Object*); Object* newcons(GC *,Object*,Object*);
Object* newenv(GC *gc, Object *frames, Object *bp, Object *sp); Object* newenv(GC *,Object*name, Object *vars, Object *up);
Object* newblock(GC *gc, Object* tag, Object *up, Object *body, void *jmp);
Object* newframe(GC *gc, Object* tag, Object *local, Object *up, Object *block);
Object* newacons(GC *,Object*, Object*, Object*); Object* newacons(GC *,Object*, Object*, Object*);
Object* newsymbol(GC *,char*, int); Object* newsymbol(GC *,char*, int);
Object* newstr(GC *,int); Object* newstr(GC *,int);
Object* newfn(GC *,Object *frame, Object *params, Object *body, enum OType type); Object* newfn(GC *,Object *env, Object *params, Object *body, enum OType type);
/* gc.c */ /* gc.c */
GC* newgc(void *top, int cap); GC* newgc(void *top, int cap);

39
gc.c
View File

@ -66,31 +66,16 @@ cloneobj(GC *dst, GC *src, Object *obj)
break; break;
case OENV: case OENV:
obj->forward = p = newenv(dst, &Nil, &Nil, &Nil); obj->forward = p = newenv(dst, &Nil, &Nil, &Nil);
p->frames = cloneobj(dst, src, obj->frames); p->name = cloneobj(dst, src, obj->name);
p->bp = cloneobj(dst, src, obj->bp); p->vars = cloneobj(dst, src, obj->vars);
p->sp = cloneobj(dst, src, obj->sp);
p->retval = cloneobj(dst, src, obj->retval);
break;
case OBLOCK:
obj->forward = p = newblock(dst, &Nil, &Nil, &Nil, obj->jmp);
p->tag = cloneobj(dst, src, obj->tag);
p->up = cloneobj(dst, src, obj->up); p->up = cloneobj(dst, src, obj->up);
p->body = cloneobj(dst, src, obj->body);
p->jmp = obj->jmp;
break;
case OFRAME:
obj->forward = p = newframe(dst, &Nil, &Nil, &Nil, &Nil);
p->tag = cloneobj(dst, src, obj->tag);
p->local = cloneobj(dst, src, obj->local);
p->up = cloneobj(dst, src, obj->up);
p->block = cloneobj(dst, src, obj->block);
break; break;
case OMACRO: case OMACRO:
case OFUNC: case OFUNC:
obj->forward = p = newfn(dst, &Nil, &Nil, &Nil, obj->type); obj->forward = p = newfn(dst, &Nil, &Nil, &Nil, obj->type);
p->params = cloneobj(dst, src, obj->params); p->params = cloneobj(dst, src, obj->params);
p->body = cloneobj(dst, src, obj->body); p->body = cloneobj(dst, src, obj->body);
p->frame = cloneobj(dst, src, obj->frame); p->env = cloneobj(dst, src, obj->env);
break; break;
} }
return p; return p;
@ -143,27 +128,15 @@ mark(GC *gc, Object *obj)
mark(gc, obj->cdr); mark(gc, obj->cdr);
break; break;
case OENV: case OENV:
mark(gc, obj->frames); mark(gc, obj->name);
mark(gc, obj->bp); mark(gc, obj->vars);
mark(gc, obj->sp);
mark(gc, obj->retval);
break;
case OBLOCK:
mark(gc, obj->tag);
mark(gc, obj->up); mark(gc, obj->up);
mark(gc, obj->body);
break;
case OFRAME:
mark(gc, obj->tag);
mark(gc, obj->local);
mark(gc, obj->up);
mark(gc, obj->block);
break; break;
case OMACRO: case OMACRO:
case OFUNC: case OFUNC:
mark(gc, obj->params); mark(gc, obj->params);
mark(gc, obj->body); mark(gc, obj->body);
mark(gc, obj->frame); mark(gc, obj->env);
break; break;
} }
} }

38
lib/lib.lisp
View File

@ -1,36 +1,8 @@
(defmacro defun (name args body) (macro defun (name args body)
`(define ,name (lambda ,args (block ,name ,body)))) `(define ,name (lambda ,args ,body)))
(defmacro cond (expr . rest)
(if (not expr)
nil
(let ((test (car expr)))
`(if ,test
(progn ,test ,@(cdr expr))
(cond ,@rest)))))
(defmacro and (expr . rest)
(if (not rest)
expr
(if (cond (not expr) nil)
`(and ,@rest))))
(defmacro or (expr . rest)
(if rest
(cond (expr) (`(or ,@rest)))
expr))
(defmacro when (test . rest)
`(if ,test
(progn ,@rest)))
(defmacro unless (test . rest)
`(if (not ,test)
(progn ,@rest)))
(defmacro return (res)
(return-from nil `,res))
(defun list (x . y) (cons x y)) (defun list (x . y) (cons x y))
(macro cond (expr . rest)
(if (not expr) nil
`(if ,(car expr) (progn ,@expr) (cond ,@rest))))

12
main.c
View File

@ -31,17 +31,9 @@ SExprint(Object *obj)
case OSYMBOL: case OSYMBOL:
printf("%s", obj->beg); printf("%s", obj->beg);
break; break;
case OBLOCK:
printf("\n<block-%s>\n", obj->tag->beg);
break;
case OFRAME:
printf("\n<frame-%s>\n", obj->tag->beg);
printexpr(obj->local);
printexpr(obj->block);
break;
case OENV: case OENV:
printf("<env>"); printf("<env>");
printexpr(obj->frames); SExprint(obj->vars);
break; break;
case OMACRO: case OMACRO:
printf("<macro>"); printf("<macro>");
@ -68,7 +60,7 @@ int
main(int argc, char *argv[]) main(int argc, char *argv[])
{ {
*argv = "lib/lib.lisp"; *argv = "lib/lib.lisp";
gc = newgc(&argc, 24000); gc = newgc(&argc, 400);
lispmain(argv); lispmain(argv);
panic("unreachable"); panic("unreachable");
} }

37
obj.c
View File

@ -29,38 +29,15 @@ newcons(GC *gc, Object *car, Object *cdr)
} }
Object* Object*
newblock(GC *gc, Object* tag, Object *up, Object *body, void *jmp) newenv(GC *gc, Object* name, Object *vars, Object *up)
{ {
Object *obj = newobj(gc, OBLOCK, 0); Object *obj = newobj(gc, OENV, 0);
obj->tag = tag; obj->name = name;
obj->up = up; obj->up = up;
obj->body = body; obj->vars = vars;
obj->jmp = jmp;
return obj; return obj;
} }
Object*
newframe(GC *gc, Object* tag, Object *local, Object *up, Object *block)
{
Object *obj = newobj(gc, OFRAME, 0);
obj->tag = tag;
obj->local = local;
obj->up = up;
obj->block = block;
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;
env->retval = &Nil;
return env;
}
Object* Object*
newacons(GC *gc, Object *x, Object *y, Object *z) newacons(GC *gc, Object *x, Object *y, Object *z)
{ {
@ -69,13 +46,13 @@ newacons(GC *gc, Object *x, Object *y, Object *z)
} }
Object* Object*
newfn(GC *gc, Object *frame, Object *params, Object *body, enum OType type) newfn(GC *gc, Object *env, Object *params, Object *body, enum OType type)
{ {
Object *fn = newobj(gc, type, 0); Object *fn = newobj(gc, type, 0);
fn->type = type; fn->type = type;
fn->params = params; fn->params = params;
fn->body = body; fn->body = body;
fn->frame = frame; fn->env = env;
return fn; return fn;
} }
@ -86,7 +63,7 @@ newsymbol(GC *gc, char *str, int len)
&Nil, &Minus, &Plus, &Mul, &Mod, &Div, &Ge, &Le, &Nil, &Minus, &Plus, &Mul, &Mod, &Div, &Ge, &Le,
&Lt, &Gt, &Ne, &Lambda, &Car, &Cdr, &Quote, &Cons, &Lt, &Gt, &Ne, &Lambda, &Car, &Cdr, &Quote, &Cons,
&Define, &Setq, &Eq, &If, &Macro, &Progn, &Bquote, &Define, &Setq, &Eq, &If, &Macro, &Progn, &Bquote,
&Comma, &Not, &Splice, &Let, &Block, &RetFrom, &Comma, &Not, &Splice,
}; };
for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){ for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){
Object *c = syms[i]; Object *c = syms[i];

16
repl.c
View File

@ -31,16 +31,6 @@ error(char *fmt, ...)
exit(1); exit(1);
} }
/* remove all frames except Top */
static void
clearenv(Object *env)
{
env->bp->cdr = &Nil;
env->bp->car->block = &Top;
env->sp = env->bp;
env->retval = &Nil;
}
static void static void
repl(Object *env, FILE *f, char *pre) repl(Object *env, FILE *f, char *pre)
{ {
@ -49,7 +39,6 @@ repl(Object *env, FILE *f, char *pre)
if(setjmp(err) == 1){ if(setjmp(err) == 1){
if(feof(f)) if(feof(f))
exit(1); exit(1);
clearenv(env);
skipline(f); skipline(f);
} }
while(1){ while(1){
@ -57,6 +46,7 @@ repl(Object *env, FILE *f, char *pre)
Object *res = nextexpr(f); Object *res = nextexpr(f);
res = eval(env, res); res = eval(env, res);
printexpr(res); printexpr(res);
printgc("status", gc);
} }
} }
@ -77,9 +67,7 @@ readlib(FILE *f, Object *env)
void void
lispmain(char *argv[]) lispmain(char *argv[])
{ {
Object *frame = newframe(gc, &Top, &Nil, &Nil, &Top); Object *env = newenv(gc , &Nil, &Nil, &Nil);
Object *cons = newcons(gc, frame, &Nil);
Object *env = newenv(gc, cons, cons, cons);
for(; *argv; ++argv){ for(; *argv; ++argv){
FILE *f = fopen(*argv, "r"); FILE *f = fopen(*argv, "r");
if(f == 0) if(f == 0)