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

add car cdr macro prevent SEGV

Browse Source
This commit is contained in:
yoyo 2024-09-11 13:44:05 +09:00
parent f467712907
commit b1451a2380
1 changed files with 82 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

156
eval.c
View File

@ -1,14 +1,32 @@
#include "dat.h" #include "dat.h"
#include "fn.h" #include "fn.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 int static int
exprlen(Object *expr) exprlen(Object *expr)
{ {
int l = 0; int l = 0;
for(;expr->type==OCELL; expr=expr->cdr) while(expr != &Nil){
++l; expr = cdr(expr);
l += 1;
}
return l; return l;
} }
@ -23,14 +41,17 @@ clone(Object *p)
{ {
switch(p->type){ switch(p->type){
default: panic("unreachable"); default: panic("unreachable");
case OENV:
case OSYMBOL: case OSYMBOL:
case OBLTIN: return p; case OINT:
case OINT: return newint(gc, p->num); case OIDENT:
case OIDENT: return newsymbol(gc, p->beg, p->ptr - p->beg); case OBLTIN:
case OCELL: return newcons(gc, clone(p->car), clone(p->cdr)); return p;
case OENV: return p;
case OMACRO: case OMACRO:
case OFUNC: return newfn(gc, p->env, clone(p->params), clone(p->body), p->type); case OFUNC:
return newfn(gc, p->env, 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);
@ -43,9 +64,11 @@ static Object*
find(Object *env, Object *obj) find(Object *env, Object *obj)
{ {
for(Object *cur=env; cur!=&Nil; cur=cur->up) for(Object *cur=env; cur!=&Nil; cur=cur->up)
for(Object *p=cur->vars; p!=&Nil; p=p->cdr) for(Object *p=cur->vars; p!=&Nil; p=cdr(p)){
if(strequal(obj, p->car->car)) Object *v = car(p);
return clone(p->car->cdr); if(strequal(obj, car(v)))
return clone(cdr(v));
}
error("not exist variable"); error("not exist variable");
return 0; return 0;
} }
@ -55,7 +78,7 @@ _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=p->cdr) for(Object *p=l->car; p->type==OCELL; p=cdr(p))
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;
@ -66,8 +89,8 @@ _newfn(Object *env, Object *l, enum OType type)
static Object* static Object*
defvar(Object *env, Object *id, Object *val) 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=cdr(p))
if(strequal(id, p->car->car)) if(strequal(id, car(car(p))))
error("already exist variable. use setq plz..."); error("already exist variable. use setq plz...");
return newacons(gc, id, val, env->vars); return newacons(gc, id, val, env->vars);
} }
@ -81,6 +104,8 @@ fnlambda(Object *env, Object *l)
Object* Object*
fnmacro(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);
env->vars = defvar(env, l->car, macro); env->vars = defvar(env, l->car, macro);
return macro; return macro;
@ -89,9 +114,9 @@ fnmacro(Object *env, Object *l)
static Object* static Object*
progn(Object *env, Object *list) progn(Object *env, Object *list)
{ {
Object *r = 0; Object *r = &Nil;
for(Object *p=list; p!=&Nil; p=p->cdr){ for(Object *p=list; p!=&Nil; p=cdr(p)){
r = eval(env, p->car); r = eval(env, car(p));
} }
return r; return r;
} }
@ -142,16 +167,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(p->cdr->type == OCELL && p->cdr->car == &Splice){ if(car(cdr(p)) == &Splice){
return newcons(gc, &Splice, eval(env, p->cdr->cdr)); return newcons(gc, &Splice, eval(env, p->cdr->cdr));
}else }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(p->car->type == OCELL && p->car->car == &Splice){ if(car(car(p)) == &Splice){
Object *i = p->car; Object *i = p->car;
while(i->cdr->type == OCELL && i->cdr != &Nil) while(cdr(i) != &Nil)
i = i->cdr; i = i->cdr;
if(i->type == OCELL){ if(i->type == OCELL){
i->cdr = p->cdr; i->cdr = p->cdr;
@ -174,22 +199,18 @@ Object*
fncar(Object *env, Object *list) fncar(Object *env, Object *list)
{ {
list = evallist(env, list); list = evallist(env, list);
if(list->car == &Nil) if(exprlen(list) < 1)
return &Nil;
if(list->car->type != OCELL)
error("car: expected list"); error("car: expected list");
return list->car->car; return car(car(list));
} }
Object* Object*
fncdr(Object *env, Object *list) fncdr(Object *env, Object *list)
{ {
list = evallist(env, list); list = evallist(env, list);
if(list->car == &Nil) if(exprlen(list) < 1)
return &Nil;
if(list->car->type != OCELL)
error("cdr: expected list"); error("cdr: expected list");
return list->car->cdr; return cdr(car(list));
} }
Object* Object*
@ -198,7 +219,9 @@ 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);
list->cdr = list->cdr->car; if(list->type != OCELL)
error("cons:bad list");
list->cdr = car(list->cdr);
return list; return list;
} }
@ -207,7 +230,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=p->cdr){ for(;p!=&Nil; p=cdr(p)){
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;
@ -219,11 +242,11 @@ Object*
fnmul(Object *env, Object *list) fnmul(Object *env, Object *list)
{ {
Object *p = evallist(env, list); Object *p = evallist(env, list);
if(p->car->type != OINT) if(car(p)->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=p->cdr){ for(p=p->cdr;p!=&Nil; p=cdr(p)){
if(p->car->type != OINT) if(car(p)->type != OINT)
error("* take only [INT]"); error("* take only [INT]");
sum *= p->car->num; sum *= p->car->num;
} }
@ -237,8 +260,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=p->cdr){ for(p=p->cdr;p!=&Nil; p=cdr(p)){
if(p->car->type != OINT) if(car(p)->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");
@ -254,8 +277,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=p->cdr){ for(p=p->cdr;p!=&Nil; p=cdr(p)){
if(p->car->type != OINT) if(car(p)->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");
@ -267,8 +290,8 @@ fnmod(Object *env, Object *list)
static long static long
cmp(Object *env, Object *list) cmp(Object *env, Object *list)
{ {
Object *a = eval(env, list->car); Object *a = eval(env, car(list));
Object *b = eval(env, list->cdr->car); Object *b = eval(env, car(cdr(list)));
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;
@ -285,9 +308,9 @@ _newint(int n)
Object* Object*
fnnot(Object *env, Object *list) fnnot(Object *env, Object *list)
{ {
if(list->type != OCELL) if(exprlen(list) != 1)
error("Malformed not"); error("Malformed not");
return _newint(eval(env, list->car) == &Nil); return _newint(eval(env, car(list)) == &Nil);
} }
Object* Object*
@ -329,15 +352,14 @@ fnne(Object *env, Object *list)
Object* Object*
fnif(Object *env, Object *list) fnif(Object *env, Object *list)
{ {
if(list->type != OCELL || list->cdr->type != OCELL) if(cdr(list)->type != OCELL)
error("Malformed if stmt"); error("Malformed if stmt");
if(eval(env, list->car)!=&Nil) Object *test = list->car;
return eval(env, list->cdr->car); Object *then = car(cdr(list));
if(list->cdr->cdr == &Nil) Object *else_ = car(cdr(cdr(list)));
return &Nil; if(eval(env, test)!=&Nil)
if(list->cdr->cdr->type != OCELL) return eval(env, then);
error("Malformed else stmt"); return eval(env, else_);
return eval(env, list->cdr->cdr->car);
} }
static Object* static Object*
@ -345,33 +367,25 @@ evallist(Object *env, Object *list)
{ {
if(list == &Nil) if(list == &Nil)
return &Nil; return &Nil;
if(list->type != OCELL) Object *car = eval(env, car(list));
error("expected list"); Object *cdr = evallist(env, cdr(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*
enter(Object *env, Object *vars, 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;
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->type!=OCELL)
error("Cna't apply function argment dose not match"); error("Cna't apply function argment dose not match");
Object *id = vars->car; Object *id = car(vars);
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 newenv(gc, &Nil, map, env); return newenv(gc, &Nil, map, env);
#undef car
#undef cdr
} }
static Object* static Object*
@ -386,9 +400,8 @@ applymacro(Object *env, Object* fn, Object *args)
{ {
Object *nenv = enter(fn->env, fn->params, args); Object *nenv = enter(fn->env, fn->params, args);
Object *r = 0; Object *r = 0;
for(Object *p=fn->body; p!=&Nil; p=p->cdr){ for(Object *p=fn->body; p!=&Nil; p=cdr(p)){
r = p->car; r = eval(nenv, car(p));
r = eval(nenv, r);
} }
return eval(env, r); return eval(env, r);
} }
@ -397,16 +410,14 @@ static Object*
apply(Object *env, Object *fn, Object *args) apply(Object *env, Object *fn, Object *args)
{ {
if(islist(args) == 0) if(islist(args) == 0)
error("args is not list type"); error("apply:args is not list type");
switch(fn->type){ switch(fn->type){
default: default:
error("apply only tabke [MACRO BLTIN FUNC]"); error("apply:can't eval type");
case OMACRO: case OMACRO:
return applymacro(env, fn, args); 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 OFUNC:{ case OFUNC:{
@ -422,19 +433,16 @@ eval(Object *env, Object *obj)
{ {
switch(obj->type){ switch(obj->type){
default: default:
error("can't eval"); error("eval: can't eval type");
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);
if(fn == &Nil)
return &Nil;
Object *res = apply(env, fn, obj->cdr); Object *res = apply(env, fn, obj->cdr);
return res; return res;
} }