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

add splice for `(,@var)

Browse Source
This commit is contained in:
yoyo 2024-09-09 20:42:20 +09:00
parent 67788893b3
commit 2ddcc7578c
6 changed files with 44 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
bltin.c
View File

@ -2,6 +2,7 @@
#include "fn.h"
Object Nil = (Object){.type=OSYMBOL, .beg="nil"};
Object Splice= (Object){.type=OSYMBOL, .beg="@"};
Object Minus= (Object){.type=OBLTIN, .beg="-"};
Object Plus = (Object){.type=OBLTIN, .beg="+"};
Object Mul = (Object){.type=OBLTIN, .beg="*"};

1
dat.h
View File

@ -53,6 +53,7 @@ struct Object
extern GC *gc;
extern Object Nil;
extern Object Comma;
extern Object Splice;
extern Object Bquote;
extern Object Minus;
extern Object Plus;

36
eval.c
View File

@ -118,15 +118,26 @@ fnquote(Object *env, Object *list)
static Object*
evalcomma(Object *env, Object *p)
{
if(p->type == OCELL){
if(p->car == &Comma)
if(p->type != OCELL)
return p;
if(p->car == &Comma){
if(p->cdr->type == OCELL && p->cdr->car == &Splice){
Object *obj = eval(env, p->cdr->cdr);
return newcons(gc, &Splice, obj);
}else
return eval(env, p->cdr);
Object *dst = newcons(gc, p->car, p->cdr);
dst->car = evalcomma(env, p->car);
dst->cdr = evalcomma(env, p->cdr);
return dst;
}
return p;
Object *car = evalcomma(env, p->car);
Object *cdr = evalcomma(env, p->cdr);
if(cdr->type == OCELL && cdr->car == &Splice){
cdr = cdr->cdr;
}
if(car->type == OCELL && car->car == &Splice){
car = car->cdr;
if(cdr == &Nil)
return car;
}
return newcons(gc, car, cdr);
}
Object*
@ -141,7 +152,9 @@ Object*
fncar(Object *env, Object *list)
{
list = evallist(env, list);
if(list->car->type != OCELL || list->cdr != &Nil)
if(list->car == &Nil)
return &Nil;
if(list->car->type != OCELL)
error("Malformed Car");
return list->car->car;
}
@ -150,7 +163,9 @@ Object*
fncdr(Object *env, Object *list)
{
list = evallist(env, list);
if(list->car->type != OCELL || list->cdr != &Nil)
if(list->car == &Nil)
return &Nil;
if(list->car->type != OCELL)
error("Malformed Car");
return list->car->cdr;
}
@ -378,7 +393,8 @@ apply(Object *env, Object *fn, Object *args)
if(islist(args) == 0)
error("args is not list type");
switch(fn->type){
default: error("apply only tabke [MACRO BLTIN FUNC]");
default:
error("apply only tabke [MACRO BLTIN FUNC]");
case OMACRO:
return applymacro(env, fn, args);
case OBLTIN:{

2
main.c
View File

@ -60,7 +60,7 @@ int
main(int argc, char *argv[])
{
*argv = "lib/lib.lisp";
gc = newgc(&argc, 400);
gc = newgc(&argc, 12000);
lispmain(argv);
panic("unreachable");
}

2
obj.c
View File

@ -63,7 +63,7 @@ newsymbol(GC *gc, char *str, int len)
&Nil, &Minus, &Plus, &Mul, &Mod, &Div, &Ge, &Le,
&Lt, &Gt, &Ne, &Lambda, &Car, &Cdr, &Quote, &Cons,
&Define, &Setq, &Eq, &If, &Macro, &Progn, &Bquote,
&Comma, &Not,
&Comma, &Not, &Splice,
};
for(int i = 0; i < sizeof(syms)/sizeof(syms[0]); ++i){
Object *c = syms[i];

16
parser.c
View File

@ -140,6 +140,12 @@ lparlist(FILE *f, int *bq)
if(*bq <= 0)
error("comma is illegal outside of backquote");
get(f);
if(lookup(f) == '@'){
get(f);
res = newcons(gc, &Comma, &Nil);
res->cdr = newcons(gc, &Splice, list(f, bq));
return newcons(gc, res, lparlist(f, bq));
}
car = newcons(gc, &Comma, list(f, bq));
cdr = lparlist(f, bq);
return newcons(gc, car, cdr);
@ -180,9 +186,15 @@ redo:
if(*bq <= 0)
error("comma is illegal outside of backquote");
get(f);
return newcons(gc, &Comma, list(f, bq));
if(lookup(f) == '@'){
get(f);
res = newcons(gc, &Comma, &Nil);
res->cdr = newcons(gc, &Splice, list(f, bq));
}else
res = newcons(gc, &Comma, list(f, bq));
return res;
case '\'':
get(f);
get(f);
return quote(f, &Quote, bq);
case '(':{
get(f);