can eval '`' ','
This commit is contained in:
parent
a72c323a25
commit
d60accd444
3
bltin.c
3
bltin.c
@ -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
1
dat.h
@ -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
58
eval.c
@ -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
4
fn.h
@ -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
14
lib/lib.lisp
Normal 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))
|
||||||
10
macro.lisp
10
macro.lisp
@ -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
6
main.c
@ -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
4
obj.c
@ -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
34
repl.c
@ -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, ">> ");
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue
Block a user