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

add macro

Browse Source
This commit is contained in:
yoyo 2024-09-06 18:18:30 +09:00
parent 8c3a666975
commit b2fd5d250d
8 changed files with 100 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
bltin.c
View File

@ -16,11 +16,14 @@ Object Ne = (Object){.type=OBLTIN, .beg= "!="};
Object Eq = (Object){.type=OBLTIN, .beg= "=="};
Object Lambda= (Object){.type=OBLTIN, .beg="lambda"};
Object Progn=(Object){.type=OBLTIN, .beg="progn"};
Object Car = (Object){.type=OBLTIN, .beg="car"};
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 Defn= (Object){.type=OBLTIN, .beg="defn"};
Object Setq = (Object){.type=OBLTIN, .beg="setq"};
Object If = (Object){.type=OBLTIN, .beg="if"};
@ -29,7 +32,10 @@ extern Object* fnmul(Object *, Object *);
extern Object* fndiv(Object *, Object *);
extern Object* fnmod(Object *, Object *);
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 *);
@ -54,11 +60,14 @@ bltinlookup(Object *obj)
Bltinfn fn;
}bltins[] = {
{&Lambda , fnlambda},
{&Progn , fnprogn},
{&Plus , fnplus},
{&Mul , fnmul},
{&Mod , fnmod},
{&Div , fndiv},
{&Define ,fndefine},
{&Macro ,fnmacro},
{&Defn ,fndefn},
{&Setq ,fnsetq},
{&Quote ,fnquote},
{&Car ,fncar},

4
dat.h
View File

@ -13,6 +13,7 @@ enum OType
OINT,
OLAMBDA,
OFUNC,
OMACRO,
OENV,
};
@ -63,6 +64,9 @@ extern Object Cdr;
extern Object Quote;
extern Object Cons;
extern Object Define;
extern Object Progn;
extern Object Macro;
extern Object Defn;
extern Object Setq;
extern Object Eq;
extern Object Ne;

97
eval.c
View File

@ -37,22 +37,8 @@ find(Object *env, Object *obj)
return 0;
}
static Object*
enter(Object *env, Object *vars, Object *args)
{
Object *map = &Nil;
for(;vars->type==OCELL; vars=vars->cdr,args=args->cdr){
if(args->type!=OCELL)
error("Cna't apply function argment dose not match");
Object *id = vars->car;
Object *val = args->car;
map = newacons(gc, id, val, map);
}
return newenv(gc, &Nil, map, env);
}
Object*
fnlambda(Object *env, Object *l)
_newfn(Object *env, Object *l, enum OType type)
{
if(l->type!=OCELL || islist(l->car)==0 || l->cdr->type!=OCELL)
error("malformed function");
@ -62,7 +48,46 @@ fnlambda(Object *env, Object *l)
}
Object *params = l->car;
Object *body = l->cdr;
return newfn(gc, env, params, body);
return newfn(gc, env, params, body, type);
}
Object*
fndefn(Object *env, Object *list)
{
Object *fn = _newfn(env, list->cdr, OFUNC);
env->vars = newacons(gc, list->car, fn, env->vars);
return env->vars;
}
Object*
fnlambda(Object *env, Object *l)
{
return _newfn(env, l, OFUNC);
}
Object*
fnmacro(Object *env, Object *l)
{
Object *macro = _newfn(env, l->cdr, OMACRO);
env->vars = newacons(gc, l->car, macro, env->vars);
return env->vars;
}
static Object*
progn(Object *env, Object *list)
{
Object *r = 0;
for(Object *p=list; p!=&Nil; p=p->cdr){
r = p->car;
r = eval(env, r);
}
return r;
}
Object*
fnprogn(Object *env, Object *list)
{
return progn(env, list);
}
Object*
@ -258,12 +283,11 @@ fnne(Object *env, Object *list)
Object*
fnif(Object *env, Object *list)
{
if(list == 0 || list == &Nil)
error("Malformed if stmt");
Object *t = eval(env, list->car->car);
if(istrue(t))
return eval(env, list->car->cdr->car);
return fnif(env, list->cdr);
Object *test = list->car;
test = eval(env, test);
if(istrue(test)) return eval(env, list->cdr->car);
if(list->cdr->cdr == &Nil) return &Nil;
return eval(env, list->cdr->cdr->car);
}
static Object*
@ -278,16 +302,39 @@ evallist(Object *env, Object *list)
return newcons(gc, car, cdr);
}
static Object*
enter(Object *env, Object *vars, Object *args)
{
Object *map = &Nil;
for(;vars->type==OCELL; vars=vars->cdr,args=args->cdr){
if(args->type!=OCELL)
error("Cna't apply function argment dose not match");
Object *id = vars->car;
Object *val = args->car;
map = newacons(gc, id, val, map);
}
if(vars != &Nil)
map = newacons(gc, vars, args, map);
return newenv(gc, &Nil, map, env);
}
static Object*
applyfn(Object *fn, Object *args)
{
Object *env = enter(fn->env, fn->params, args);
return progn(env, fn->body);
}
static Object*
applymacro(Object *env, Object* fn, Object *args)
{
Object *nenv = enter(fn->env, fn->params, args);
Object *r = 0;
for(Object *p=fn->body; p!=&Nil; p=p->cdr){
r = p->car;
r = eval(env, r);
r = eval(nenv, r);
}
return r;
return eval(env, r);
}
static Object*
@ -330,6 +377,8 @@ 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);

2
fn.h
View File

@ -13,7 +13,7 @@ Object* newenv(GC *,Object*name, Object *vars, 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);
Object* newfn(GC *,Object *env, Object *params, Object *body, enum OType type);
/* gc.c */
GC* newgc(void *top, int cap);

4
gc.c
View File

@ -71,8 +71,9 @@ cloneobj(GC *dst, GC *src, Object *obj)
p->vars = cloneobj(dst, src, obj->vars);
p->up = cloneobj(dst, src, obj->up);
break;
case OMACRO:
case OFUNC:
obj->forward = p = newfn(dst, &Nil, &Nil, &Nil);
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);
@ -132,6 +133,7 @@ mark(GC *gc, Object *obj)
mark(gc, obj->vars);
mark(gc, obj->up);
break;
case OMACRO:
case OFUNC:
mark(gc, obj->params);
mark(gc, obj->body);

6
main.c
View File

@ -38,6 +38,9 @@ SExprint(Object *obj)
printf("<env>");
SExprint(obj->vars);
break;
case OMACRO:
printf("<macro>");
goto func;
case OLAMBDA:
printf("<lambda>");
goto func;
@ -70,6 +73,7 @@ loop(void)
}
while(1){
Object *res = nextexpr();
printexpr(res);
res = eval(env, res);
printgc("status", gc);
printf("=============res===========\n");
@ -83,6 +87,6 @@ loop(void)
int
main(int argc, char *argv[])
{
gc = newgc(&argc, 500);
gc = newgc(&argc, 4000);
loop();
}

2
makefile
View File

@ -10,7 +10,7 @@ OFILES=\
parser.o
AS=$(CC) -c
CFLAGS=-c -g -O2 -Wall -std=c99
CFLAGS=-c -g -O0 -Wall -std=c99
all: $(NAME)

7
obj.c
View File

@ -46,9 +46,10 @@ newacons(GC *gc, Object *x, Object *y, Object *z)
}
Object*
newfn(GC *gc, Object *env, Object *params, Object *body)
newfn(GC *gc, Object *env, Object *params, Object *body, enum OType type)
{
Object *fn = newobj(gc, OFUNC, 0);
Object *fn = newobj(gc, type, 0);
fn->type = type;
fn->params = params;
fn->body = body;
fn->env = env;
@ -61,7 +62,7 @@ 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,
&Define, &Setq, &Eq, &If, &Defn, &Macro, &Progn,
};
for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){
Object *c = syms[i];