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

add frame

Browse Source
This commit is contained in:
yoyo 2024-09-12 18:30:28 +09:00
parent 023758b4a7
commit 9a12d2ac9f
9 changed files with 141 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
bltin.c
View File

@ -2,6 +2,7 @@
#include "fn.h"
Object Nil = (Object){.type=OSYMBOL, .beg="nil"};
Object Top = (Object){.type=OSYMBOL, .beg="top"};
Object Splice= (Object){.type=OSYMBOL, .beg="@"};
Object Comma= (Object){.type=OSYMBOL, .beg=","};
Object Minus= (Object){.type=OBLTIN, .beg="-"};
@ -27,7 +28,7 @@ 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 Macro= (Object){.type=OBLTIN, .beg="defmacro"};
Object Setq = (Object){.type=OBLTIN, .beg="setq"};
Object If = (Object){.type=OBLTIN, .beg="if"};
@ -39,7 +40,7 @@ extern Object* fnlambda(Object *, Object *);
extern Object* fnlet(Object *, Object *);
extern Object* fnprogn(Object *, Object *);
extern Object* fndefine(Object *, Object *);
extern Object* fnmacro(Object *, Object *);
extern Object* fndefmacro(Object *, Object *);
extern Object* fnsetq(Object *, Object *);
extern Object* fnundef(Object *, Object *);
extern Object* fnquote(Object *, Object *);
@ -72,7 +73,7 @@ bltinlookup(Object *obj)
{&Mod , fnmod},
{&Div , fndiv},
{&Define ,fndefine},
{&Macro ,fnmacro},
{&Macro ,fndefmacro},
{&Setq ,fnsetq},
{&Let ,fnlet},
{&Quote ,fnquote},

16
dat.h
View File

@ -13,6 +13,7 @@ enum OType
OINT,
OFUNC,
OMACRO,
OFRAME,
OENV,
};
@ -39,19 +40,26 @@ struct Object
struct{
Object *params;
Object *body;
Object *env;
Object *frame; /* running frame */
};
/* env */
/* Frame */
struct{
Object *name;
Object *tag; /* block name */
Object *local; /* local vars */
Object *up;
Object *vars;
};
/* Env */
struct{
Object *frames;
Object *bp;
Object *sp; /* current */
};
};
};
extern GC *gc;
extern Object Nil;
extern Object Top;
extern Object Comma;
extern Object Splice;
extern Object Bquote;

119
eval.c
View File

@ -1,5 +1,6 @@
#include "dat.h"
#include "fn.h"
#include <assert.h>
#define cdr(x) ((x)!= &Nil && (x)->type == OCELL ? (x)->cdr : &Nil)
#define car(x) ((x)!= &Nil && (x)->type == OCELL ? (x)->car : &Nil)
@ -41,6 +42,7 @@ clone(Object *p)
{
switch(p->type){
default: panic("unreachable");
case OFRAME:
case OENV:
case OSYMBOL:
case OINT:
@ -49,7 +51,7 @@ clone(Object *p)
return p;
case OMACRO:
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:{
@ -63,14 +65,16 @@ clone(Object *p)
static Object*
find(Object *env, Object *obj)
{
for(Object *cur=env; cur!=&Nil; cur=cur->up)
for(Object *p=cur->vars; p!=&Nil; p=cdr(p)){
Object *v = car(p);
if(strequal(obj, car(v)))
return clone(cdr(v));
}
error("not exist variable");
return 0;
Object *res = 0;
for(Object *cur=env->sp->car; cur!=&Nil; cur=cur->up)
for(Object *p=cur->local; p!=&Nil; p=cdr(p))
if(strequal(obj, car(car(p)))){
res = p;
break;
}
if(res == 0)
error("not exist variable");
return clone(cdr(car(res)));
}
static Object*
@ -83,18 +87,19 @@ _newfn(Object *env, Object *l, enum OType type)
error("parameter is not IDNET");
Object *params = l->car;
Object *body = l->cdr;
return newfn(gc, env, params, body, type);
return newfn(gc, env->sp->car, params, body, type);
}
static Object*
static void
defvar(Object *env, Object *id, Object *val)
{
if(id->type != OIDENT)
error("can't define, already using id");
for(Object *p=env->vars; p!=&Nil; p=cdr(p))
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...");
return newacons(gc, id, val, env->vars);
frame->local = newacons(gc, id, val, frame->local);
}
Object*
@ -104,12 +109,12 @@ fnlambda(Object *env, Object *l)
}
Object*
fnmacro(Object *env, Object *l)
fndefmacro(Object *env, Object *l)
{
if(l->type != OCELL)
error("Malformed macro");
Object *macro = _newfn(env, l->cdr, OMACRO);
env->vars = defvar(env, l->car, macro);
defvar(env, l->car, macro);
return macro;
}
@ -134,28 +139,49 @@ fnsetq(Object *env, Object *list)
{
if(list->type != OCELL || exprlen(list)!=2 || list->car->type!=OIDENT)
error("Malformed setq");
Object *cur = env;
Object *p = &Nil;
for(; cur!=&Nil; cur=cur->up)
for(p=cur->vars; p!=&Nil; p=cdr(p))
for(Object *frame=env->sp->car; frame!=&Nil; frame=frame->up)
for(Object *p=frame->local; p!=&Nil; p=cdr(p))
if(strequal(list->car, car(car(p))))
return p->car->cdr = eval(env, car(cdr(list)));
return p->car->cdr = eval(env, car(cdr(list)));
error("setq not exist variable");
return 0;
}
static void
enter(Object *env, Object *tag, Object *local, Object *up)
{
assert(env->bp != &Nil);
Object *frame = newframe(gc, tag, local, up);
env->sp = env->sp->cdr = newcons(gc, frame, &Nil);
}
static void
leave(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;
}
Object*
fnlet(Object *env, Object *list)
{
if(exprlen(list) < 2)
error("let (vars) bodys");
Object *nenv = newenv(gc, &Nil, &Nil, env) ;
for(Object *p=list->car; p!=&Nil; p=cdr(p)){
Object *var = car(car(p));
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))));
nenv->vars = defvar(nenv, var, val);
local = newacons(gc, id, val, local);
}
return progn(nenv, cdr(list));
enter(env, &Let, local, env->sp->car);
Object *res = progn(env, cdr(list));
leave(env);
return res;
}
Object*
@ -164,7 +190,7 @@ fndefine(Object *env, Object *list)
if(exprlen(list)!=2)
error("Malformed define");
Object *val = eval(env, car(cdr(list)));
env->vars = defvar(env, car(list), val);
defvar(env, car(list), val);
return val;
}
@ -206,7 +232,7 @@ fnbquote(Object *env, Object *list)
{
if(exprlen(list) != 1)
error("Malformed fnbquote");
return evalcomma(env, list->car);
return evalcomma(env, car(list));
}
Object*
@ -387,9 +413,10 @@ evallist(Object *env, Object *list)
}
static Object*
enter(Object *env, Object *vars, Object *args)
applyargs(Object *fn, Object *args)
{
Object *map = &Nil;
Object *vars = fn->params;
for(;vars->type==OCELL; vars=cdr(vars), args=cdr(args)){
if(args != &Nil && args->type!=OCELL)
error("Cna't apply function argment dose not match");
@ -399,44 +426,45 @@ enter(Object *env, Object *vars, Object *args)
}
if(vars != &Nil)
map = newacons(gc, vars, args, map);
return newenv(gc, &Nil, map, env);
return map;
}
static Object*
applyfn(Object *fn, Object *args)
applyfn(Object *env, Object *tag, Object *fn, Object *args)
{
Object *env = enter(fn->env, fn->params, args);
return progn(env, fn->body);
Object *local = applyargs(fn, args);
enter(env, tag, local,fn->frame);
Object *res = progn(env, fn->body);
leave(env);
return res;
}
static Object*
applymacro(Object *env, Object* fn, Object *args)
applymacro(Object *env, Object *tag, Object* fn, Object *args)
{
Object *nenv = enter(fn->env, fn->params, args);
Object *r = 0;
for(Object *p=fn->body; p!=&Nil; p=cdr(p)){
r = eval(nenv, car(p));
}
Object *local = applyargs(fn, args);
enter(env, tag, local, fn->frame);
Object *r = progn(env, fn->body);
leave(env);
return eval(env, r);
}
static Object*
apply(Object *env, Object *fn, Object *args)
apply(Object *env, Object *tag, Object *fn, Object *args)
{
if(islist(args) == 0)
error("apply:args is not list type");
switch(fn->type){
default:
error("apply:can't eval type");
case OMACRO:
return applymacro(env, fn, args);
return 0;
case OBLTIN:{
Bltinfn blt = bltinlookup(fn);
return blt(env, args);
}
case OMACRO:
return applymacro(env, tag, fn, args);
case OFUNC:{
Object *elist = evallist(env, args);
Object*res = applyfn(fn, elist);
Object*res = applyfn(env, tag, fn, elist);
return res;
}
}
@ -448,6 +476,7 @@ eval(Object *env, Object *obj)
switch(obj->type){
default:
error("eval: can't eval type");
return 0;
case OSTRING:
case OINT:
case OBLTIN:
@ -457,7 +486,7 @@ eval(Object *env, Object *obj)
return find(env, obj);
case OCELL:{
Object *fn = eval(env, obj->car);
Object *res = apply(env, fn, obj->cdr);
Object *res = apply(env, obj->car, fn, obj->cdr);
return res;
}
}

5
fn.h
View File

@ -12,11 +12,12 @@ Object* eval(Object *env, Object *expr);
/* new */
Object* newint(GC *,long);
Object* newcons(GC *,Object*,Object*);
Object* newenv(GC *,Object*name, Object *vars, Object *up);
Object* newenv(GC *gc, Object *frames, Object *bp, Object *sp);
Object* newframe(GC *gc, Object* tag, Object *local, 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, enum OType type);
Object* newfn(GC *,Object *frame, Object *params, Object *body, enum OType type);
/* gc.c */
GC* newgc(void *top, int cap);

25
gc.c
View File

@ -65,9 +65,15 @@ cloneobj(GC *dst, GC *src, Object *obj)
p->cdr = cloneobj(dst, src, obj->cdr);
break;
case OENV:
obj->forward = p = newenv(dst, &Nil, &Nil, &Nil);
p->name = cloneobj(dst, src, obj->name);
p->vars = cloneobj(dst, src, obj->vars);
obj->forward = p = newenv(dst,&Nil, &Nil, &Nil);
p->frames = cloneobj(dst, src, obj->frames);
p->bp = cloneobj(dst, src, obj->bp);
p->sp = cloneobj(dst, src, obj->sp);
break;
case OFRAME:
obj->forward = p = newframe(dst, &Nil, &Nil, &Nil);
p->tag = cloneobj(dst, src, obj->tag);
p->local = cloneobj(dst, src, obj->local);
p->up = cloneobj(dst, src, obj->up);
break;
case OMACRO:
@ -75,7 +81,7 @@ cloneobj(GC *dst, GC *src, Object *obj)
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);
p->frame = cloneobj(dst, src, obj->frame);
break;
}
return p;
@ -128,15 +134,20 @@ mark(GC *gc, Object *obj)
mark(gc, obj->cdr);
break;
case OENV:
mark(gc, obj->name);
mark(gc, obj->vars);
mark(gc, obj->frames);
mark(gc, obj->bp);
mark(gc, obj->sp);
break;
case OFRAME:
mark(gc, obj->tag);
mark(gc, obj->local);
mark(gc, obj->up);
break;
case OMACRO:
case OFUNC:
mark(gc, obj->params);
mark(gc, obj->body);
mark(gc, obj->env);
mark(gc, obj->frame);
break;
}
}

12
lib/lib.lisp
View File

@ -1,7 +1,7 @@
(macro defun (name args body)
(defmacro defun (name args body)
`(define ,name (lambda ,args ,body)))
(macro cond (expr . rest)
(defmacro cond (expr . rest)
(if (not expr)
nil
(let ((test (car expr)))
@ -9,22 +9,22 @@
(progn ,test ,@(cdr expr))
(cond ,@rest)))))
(macro and (expr . rest)
(defmacro and (expr . rest)
(if (not rest)
expr
(if (cond (not expr) nil)
`(and ,@rest))))
(macro or (expr . rest)
(defmacro or (expr . rest)
(if rest
(cond (expr) (`(or ,@rest)))
expr))
(macro when (test . rest)
(defmacro when (test . rest)
`(if ,test
(progn ,@rest)))
(macro unless (test . rest)
(defmacro unless (test . rest)
`(if (not ,test)
(progn ,@rest)))

6
main.c
View File

@ -31,9 +31,13 @@ SExprint(Object *obj)
case OSYMBOL:
printf("%s", obj->beg);
break;
case OFRAME:
printf("<frame> %s\n", obj->tag->beg);
printexpr(obj->local);
break;
case OENV:
printf("<env>");
SExprint(obj->vars);
printexpr(obj->frames);
break;
case OMACRO:
printf("<macro>");

22
obj.c
View File

@ -29,15 +29,25 @@ newcons(GC *gc, Object *car, Object *cdr)
}
Object*
newenv(GC *gc, Object* name, Object *vars, Object *up)
newframe(GC *gc, Object* tag, Object *local, Object *up)
{
Object *obj = newobj(gc, OENV, 0);
obj->name = name;
Object *obj = newobj(gc, OFRAME, 0);
obj->tag = tag;
obj->local = local;
obj->up = up;
obj->vars = vars;
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;
return env;
}
Object*
newacons(GC *gc, Object *x, Object *y, Object *z)
{
@ -46,13 +56,13 @@ newacons(GC *gc, Object *x, Object *y, Object *z)
}
Object*
newfn(GC *gc, Object *env, Object *params, Object *body, enum OType type)
newfn(GC *gc, Object *frame, Object *params, Object *body, enum OType type)
{
Object *fn = newobj(gc, type, 0);
fn->type = type;
fn->params = params;
fn->body = body;
fn->env = env;
fn->frame = frame;
return fn;
}

5
repl.c
View File

@ -46,7 +46,6 @@ repl(Object *env, FILE *f, char *pre)
Object *res = nextexpr(f);
res = eval(env, res);
printexpr(res);
printgc("status", gc);
}
}
@ -67,7 +66,9 @@ readlib(FILE *f, Object *env)
void
lispmain(char *argv[])
{
Object *env = newenv(gc , &Nil, &Nil, &Nil);
Object *frame = newframe(gc, &Top, &Nil, &Nil);
Object *cons = newcons(gc, frame, &Nil);
Object *env = newenv(gc, cons, cons, cons);
for(; *argv; ++argv){
FILE *f = fopen(*argv, "r");
if(f == 0)