add '`', '\''

This commit is contained in:
yoyo 2024-09-09 10:54:58 +09:00
parent 811a3b03eb
commit a72c323a25
6 changed files with 89 additions and 25 deletions

View File

@ -15,6 +15,8 @@ Object Gt = (Object){.type=OBLTIN, .beg= ">"};
Object Ne = (Object){.type=OBLTIN, .beg= "!="}; Object Ne = (Object){.type=OBLTIN, .beg= "!="};
Object Eq = (Object){.type=OBLTIN, .beg= "=="}; Object Eq = (Object){.type=OBLTIN, .beg= "=="};
Object Comma= (Object){.type=OBLTIN, .beg=","};
Object Bquote= (Object){.type=OBLTIN, .beg="`"};
Object Lambda= (Object){.type=OBLTIN, .beg="lambda"}; Object Lambda= (Object){.type=OBLTIN, .beg="lambda"};
Object Progn=(Object){.type=OBLTIN, .beg="progn"}; Object Progn=(Object){.type=OBLTIN, .beg="progn"};
Object Car = (Object){.type=OBLTIN, .beg="car"}; Object Car = (Object){.type=OBLTIN, .beg="car"};
@ -39,6 +41,7 @@ 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 *);
extern Object* fnbquote(Object *, Object *);
extern Object* fncar(Object *, Object *); extern Object* fncar(Object *, Object *);
extern Object* fncdr(Object *, Object *); extern Object* fncdr(Object *, Object *);
extern Object* fncons(Object *, Object *); extern Object* fncons(Object *, Object *);
@ -70,6 +73,7 @@ bltinlookup(Object *obj)
{&Defn ,fndefn}, {&Defn ,fndefn},
{&Setq ,fnsetq}, {&Setq ,fnsetq},
{&Quote ,fnquote}, {&Quote ,fnquote},
{&Bquote, fnbquote},
{&Car ,fncar}, {&Car ,fncar},
{&Cdr ,fncdr}, {&Cdr ,fncdr},
{&Cons ,fncons}, {&Cons ,fncons},

3
dat.h
View File

@ -11,7 +11,6 @@ enum OType
OIDENT, OIDENT,
OSTRING, OSTRING,
OINT, OINT,
OLAMBDA,
OFUNC, OFUNC,
OMACRO, OMACRO,
OENV, OENV,
@ -53,6 +52,8 @@ struct Object
extern GC *gc; extern GC *gc;
extern Object Nil; extern Object Nil;
extern Object Comma;
extern Object Bquote;
extern Object Minus; extern Object Minus;
extern Object Plus; extern Object Plus;
extern Object Mul; extern Object Mul;

31
eval.c
View File

@ -123,6 +123,37 @@ fnquote(Object *env, Object *list)
return list->car; return list->car;
} }
static Object*
evalcomma(Object *env, Object *p)
{
enum { VISITED = 1 << 9 };
if(p->type == OCELL){
if(p->flag & VISITED)
return p;
p->flag |= VISITED;
if(p->car == &Comma){
p = eval(env, p->cdr);
p->flag |= VISITED;
return p;
}
p->car = evalcomma(env, p->car);
p->cdr = evalcomma(env, p->cdr);
}
return p;
}
Object*
fnbquote(Object *env, Object *list)
{
if(list->cdr != &Nil){
printexpr(list);
error("fnbquote expected cdr is nil");
}
list = evalcomma(env, list->car);
return list;
}
Object* Object*
fncar(Object *env, Object *list) fncar(Object *env, Object *list)
{ {

3
main.c
View File

@ -38,9 +38,6 @@ SExprint(Object *obj)
case OMACRO: case OMACRO:
printf("<macro>"); printf("<macro>");
goto func; goto func;
case OLAMBDA:
printf("<lambda>");
goto func;
case OFUNC: case OFUNC:
printf("<func>"); printf("<func>");
func: func:

1
obj.c
View File

@ -63,6 +63,7 @@ newsymbol(GC *gc, char *str, int len)
&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, &Defn, &Macro, &Progn,
&Bquote, &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];

View File

@ -7,8 +7,8 @@
const char symbolchars[] = "!*/%-=+<>'"; const char symbolchars[] = "!*/%-=+<>'";
static Object* lparlist(FILE *); static Object* lparlist(FILE *, int *);
static Object* list(FILE *); static Object* list(FILE *, int *);
static char static char
get(FILE *f) get(FILE *f)
@ -74,10 +74,9 @@ number(FILE *f)
} }
static Object* static Object*
quote(FILE *f) quote(FILE *f, Object *car, int *bq)
{ {
Object *car = &Quote; Object *ccdr = list(f, bq);
Object *ccdr = list(f);
Object *cdr = newcons(gc, ccdr, &Nil); Object *cdr = newcons(gc, ccdr, &Nil);
return newcons(gc, car, cdr); return newcons(gc, car, cdr);
} }
@ -116,53 +115,79 @@ atom(FILE *f, char c)
} }
static Object* static Object*
lparlist(FILE *f) lparlist(FILE *f, int *bq)
{ {
Object *car = 0; Object *car = 0;
Object *cdr = 0; Object *cdr = 0;
Object *res = 0;
char c = slookup(f); char c = slookup(f);
switch(c){ switch(c){
case '`':
*bq += 1;
get(f);
car = quote(f, &Bquote, bq);
cdr = lparlist(f, bq);
res = newcons(gc, car, cdr);
*bq -= 1;
return res;
case '\'': case '\'':
get(f); get(f);
car = quote(f); car = quote(f, &Quote, bq);
cdr = lparlist(f); cdr = lparlist(f, bq);
return newcons(gc, car, cdr);
case ',':
if(*bq <= 0)
error("comma is illegal outside of backquote");
get(f);
car = newcons(gc, &Comma, list(f, bq));
cdr = lparlist(f, bq);
return newcons(gc, car, cdr); return newcons(gc, car, cdr);
case '.': case '.':
get(f); get(f);
return list(f); return list(f, bq);
case '(': case '(':
car = list(f); car = list(f, bq);
cdr = lparlist(f); cdr = lparlist(f, bq);
return newcons(gc, car, cdr); return newcons(gc, car, cdr);
case ')': case ')':
return &Nil; return &Nil;
default:
car = atom(f, c);
cdr = lparlist(f, bq);
return newcons(gc, car ,cdr);
} }
car = atom(f, c);
cdr = lparlist(f);
return newcons(gc, car ,cdr);
} }
static Object* static Object*
list(FILE *f) list(FILE *f, int *bq)
{ {
redo: redo:
Object *res = 0;
char c = slookup(f); char c = slookup(f);
switch(c){ switch(c){
case ';': case ';':
get(f);
skipline(f); skipline(f);
goto redo; goto redo;
case '`':
*bq += 1;
get(f);
res = quote(f, &Bquote, bq);
*bq -= 1;
return res;
case '\'': case '\'':
get(f); get(f);
return quote(f); return quote(f, &Quote, bq);
case '(':{ case '(':{
get(f); get(f);
Object *obj = lparlist(f); res = lparlist(f, bq);
slookup(f); slookup(f);
expect(f, ')'); expect(f, ')');
return obj; return res;
} }
default:
return atom(f, c);
} }
return atom(f, c);
} }
void void
@ -183,5 +208,10 @@ skipline(FILE *f)
Object* Object*
nextexpr(FILE *f) nextexpr(FILE *f)
{ {
return list(f); int bq = 0;
Object *expr = list(f, &bq);
if(bq != 0){
error("Bad backquote in expr");
}
return expr;
} }