can eval '`' ','

This commit is contained in:
yoyo 2024-09-09 15:29:17 +09:00
parent a72c323a25
commit d60accd444
9 changed files with 66 additions and 68 deletions

View File

@ -25,7 +25,6 @@ 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="macro"}; Object Macro= (Object){.type=OBLTIN, .beg="macro"};
Object Defn= (Object){.type=OBLTIN, .beg="defn"};
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"};
@ -37,7 +36,6 @@ extern Object* fnlambda(Object *, Object *);
extern Object* fnprogn(Object *, Object *); extern Object* fnprogn(Object *, Object *);
extern Object* fndefine(Object *, Object *); extern Object* fndefine(Object *, Object *);
extern Object* fnmacro(Object *, Object *); extern Object* fnmacro(Object *, Object *);
extern Object* fndefn(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 *);
@ -70,7 +68,6 @@ bltinlookup(Object *obj)
{&Div , fndiv}, {&Div , fndiv},
{&Define ,fndefine}, {&Define ,fndefine},
{&Macro ,fnmacro}, {&Macro ,fnmacro},
{&Defn ,fndefn},
{&Setq ,fnsetq}, {&Setq ,fnsetq},
{&Quote ,fnquote}, {&Quote ,fnquote},
{&Bquote, fnbquote}, {&Bquote, fnbquote},

1
dat.h
View File

@ -67,7 +67,6 @@ extern Object Cons;
extern Object Define; extern Object Define;
extern Object Progn; extern Object Progn;
extern Object Macro; extern Object Macro;
extern Object Defn;
extern Object Setq; extern Object Setq;
extern Object Eq; extern Object Eq;
extern Object Ne; extern Object Ne;

58
eval.c
View File

@ -45,22 +45,17 @@ _newfn(Object *env, Object *l, enum OType type)
return newfn(gc, env, params, body, type); return newfn(gc, env, params, body, type);
} }
static void static Object*
setvar(Object *env, Object *id, Object *val) setvar(Object *env, Object *id, Object *val)
{ {
printexpr(id);
Object *obj = find(env, id); Object *obj = find(env, id);
if(obj == 0) if(obj == 0)
env->vars = newacons(gc, id, val, env->vars); return newacons(gc, id, val, env->vars);
else else{
obj->cdr = val; obj->cdr = val;
} return env->vars;
}
Object*
fndefn(Object *env, Object *list)
{
Object *fn = _newfn(env, list->cdr, OFUNC);
setvar(env, list->car, fn);
return fn;
} }
Object* Object*
@ -73,7 +68,7 @@ Object*
fnmacro(Object *env, Object *l) fnmacro(Object *env, Object *l)
{ {
Object *macro = _newfn(env, l->cdr, OMACRO); Object *macro = _newfn(env, l->cdr, OMACRO);
setvar(env, l->car, macro); env->vars = setvar(env, l->car, macro);
return macro; return macro;
} }
@ -111,7 +106,7 @@ fndefine(Object *env, Object *list)
if(exprlen(list)!=2 || list->car->type!=OIDENT) if(exprlen(list)!=2 || list->car->type!=OIDENT)
error("Malformed define"); error("Malformed define");
Object *val = eval(env, list->cdr->car); Object *val = eval(env, list->cdr->car);
setvar(env, list->car, val); env->vars = setvar(env, list->car, val);
return val; return val;
} }
@ -123,22 +118,16 @@ fnquote(Object *env, Object *list)
return list->car; return list->car;
} }
static Object* static Object*
evalcomma(Object *env, Object *p) evalcomma(Object *env, Object *p)
{ {
enum { VISITED = 1 << 9 };
if(p->type == OCELL){ if(p->type == OCELL){
if(p->flag & VISITED) if(p->car == &Comma)
return p; return eval(env, p->cdr);
p->flag |= VISITED; Object *dst = newcons(gc, p->car, p->cdr);
if(p->car == &Comma){ dst->car = evalcomma(env, p->car);
p = eval(env, p->cdr); dst->cdr = evalcomma(env, p->cdr);
p->flag |= VISITED; return dst;
return p;
}
p->car = evalcomma(env, p->car);
p->cdr = evalcomma(env, p->cdr);
} }
return p; return p;
} }
@ -146,12 +135,9 @@ evalcomma(Object *env, Object *p)
Object* Object*
fnbquote(Object *env, Object *list) fnbquote(Object *env, Object *list)
{ {
if(list->cdr != &Nil){ if(exprlen(list) != 1)
printexpr(list); error("Malformed fnbquote");
error("fnbquote expected cdr is nil"); return evalcomma(env, list->car);
}
list = evalcomma(env, list->car);
return list;
} }
Object* Object*
@ -387,7 +373,9 @@ apply(Object *env, Object *fn, Object *args)
if(islist(args) == 0) if(islist(args) == 0)
error("args is not list type"); error("args is not list type");
switch(fn->type){ switch(fn->type){
default: error("can't apply"); default: error("apply only tabke [MACRO BLTIN FUNC]");
case OMACRO:
return applymacro(env, fn, args);
case OBLTIN:{ case OBLTIN:{
Bltinfn blt = bltinlookup(fn); Bltinfn blt = bltinlookup(fn);
if(blt==0) if(blt==0)
@ -421,10 +409,6 @@ eval(Object *env, Object *obj)
} }
case OCELL:{ case OCELL:{
Object *fn = eval(env, obj->car); 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); Object *res = apply(env, fn, obj->cdr);
return res; return res;
} }

4
fn.h
View File

@ -4,14 +4,12 @@ Object* nextexpr(FILE*);
void skipline(FILE*); void skipline(FILE*);
/* repl.c */ /* repl.c */
void repl(Object *env, FILE*, char *pre); void lispmain(char *argv[]);
void readlibs(char *argv[], Object *env);
/* eval.c */ /* eval.c */
Object* eval(Object *env, Object *expr); 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 *,Object*name, Object *vars, Object *up); Object* newenv(GC *,Object*name, Object *vars, Object *up);

14
lib/lib.lisp Normal file
View File

@ -0,0 +1,14 @@
(macro defun (name args body)
`(define ,name (lambda ,args ,body)))
(defun list (x . y) (cons x y))
(macro and (expr . rest)
(if rest (list 'if expr (cons 'and rest)) expr))
(macro cond (expr. rest)
(if rest (list 'if (car expr) (car (cdr expr)) (cons 'cond rest))
expr))
;exampe (cond ((== 1 0) 0) ((== 1 1) -1) (+ 100000000))
;exampe (cond ((== 1 0) 0) ((== 1 0) -1) (+ 100000000))

View File

@ -1,10 +0,0 @@
(defn list (x . y) (cons x y))
(macro cond (expr. rest)
(if rest (list 'if (car expr) (car (cdr expr)) (cons 'cond rest))
expr))
(macro and (expr . rest)
(if rest (list 'if expr (cons 'and rest)) expr))
;(cond ((== 1 0) 0) ((== 1 1) -1) (+ 100000000))

6
main.c
View File

@ -59,8 +59,8 @@ printexpr(Object *obj)
int int
main(int argc, char *argv[]) main(int argc, char *argv[])
{ {
*argv = "lib/lib.lisp";
gc = newgc(&argc, 400); gc = newgc(&argc, 400);
Object *env = newenv(gc, &Nil, &Nil, &Nil); lispmain(argv);
readlibs(argv + 1, env); panic("unreachable");
repl(env, stdin, ">> ");
} }

4
obj.c
View File

@ -62,8 +62,8 @@ newsymbol(GC *gc, char *str, int len)
static Object *syms[] = { static Object *syms[] = {
&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, &Defn, &Macro, &Progn, &Define, &Setq, &Eq, &If, &Macro, &Progn, &Bquote,
&Bquote, &Comma, &Comma,
}; };
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];

34
repl.c
View File

@ -31,14 +31,14 @@ error(char *fmt, ...)
exit(1); exit(1);
} }
void static void
repl(Object *env, FILE *f, char *pre) repl(Object *env, FILE *f, char *pre)
{ {
jmp_buf err; jmp_buf err;
errptr = &err; errptr = &err;
if(setjmp(err) == 1){ if(setjmp(err) == 1){
if(feof(f)) if(feof(f))
return; exit(1);
skipline(f); skipline(f);
} }
while(1){ while(1){
@ -50,14 +50,30 @@ repl(Object *env, FILE *f, char *pre)
} }
} }
void static void
readlibs(char *argv[], Object *env) readlib(FILE *f, Object *env)
{ {
for(;*argv; argv++){ jmp_buf buf;
errptr = &buf;
if(setjmp(buf) == 1)
return;
while(1){
eval(env, nextexpr(f));
}
panic("unreachable");
errptr = 0;
}
void
lispmain(char *argv[])
{
Object *env = newenv(gc , &Nil, &Nil, &Nil);
for(; *argv; ++argv){
FILE *f = fopen(*argv, "r"); FILE *f = fopen(*argv, "r");
if(f == 0) if(f == 0)
panic("can't open %s", *argv); panic("can't open %s'", *argv);
repl(env, f, ""); readlib(f, env);
printf("\n"); fclose(f);
} }
} repl(env, stdin, ">> ");
}