conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add begin syntax

This commit is contained in:
Yuichi Nishiwaki 2013-10-17 17:54:28 +09:00
parent 17f0c928da
commit d9e47bdd05
3 changed files with 14 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
include/picrin.h
View File

@ -23,7 +23,8 @@ typedef struct {
pic_callinfo *ci; pic_callinfo *ci;
pic_callinfo *cibase, *ciend; pic_callinfo *cibase, *ciend;
pic_value sDEFINE, sLAMBDA, sIF, sCONS; pic_value sDEFINE, sLAMBDA, sIF, sBEGIN;
pic_value sCONS;
pic_value sADD, sSUB, sMUL, sDIV; pic_value sADD, sSUB, sMUL, sDIV;
struct pic_env *global_env; struct pic_env *global_env;

1
src/state.c
View File

@ -48,6 +48,7 @@ pic_open()
pic->sDEFINE = pic_intern_cstr(pic, "define"); pic->sDEFINE = pic_intern_cstr(pic, "define");
pic->sLAMBDA = pic_intern_cstr(pic, "lambda"); pic->sLAMBDA = pic_intern_cstr(pic, "lambda");
pic->sIF = pic_intern_cstr(pic, "if"); pic->sIF = pic_intern_cstr(pic, "if");
pic->sBEGIN = pic_intern_cstr(pic, "begin");
pic->sCONS = pic_intern_cstr(pic, "cons"); pic->sCONS = pic_intern_cstr(pic, "cons");
pic->sADD = pic_intern_cstr(pic, "+"); pic->sADD = pic_intern_cstr(pic, "+");
pic->sSUB = pic_intern_cstr(pic, "-"); pic->sSUB = pic_intern_cstr(pic, "-");

12
src/vm.c
View File

@ -227,11 +227,12 @@ static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_env *)
static void static void
pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env) pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env)
{ {
pic_value sDEFINE, sLAMBDA, sIF, sCONS, sADD, sSUB, sMUL, sDIV; pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sCONS, sADD, sSUB, sMUL, sDIV;
sDEFINE = pic->sDEFINE; sDEFINE = pic->sDEFINE;
sLAMBDA = pic->sLAMBDA; sLAMBDA = pic->sLAMBDA;
sIF = pic->sIF; sIF = pic->sIF;
sBEGIN = pic->sBEGIN;
sCONS = pic->sCONS; sCONS = pic->sCONS;
sADD = pic->sADD; sADD = pic->sADD;
sSUB = pic->sSUB; sSUB = pic->sSUB;
@ -309,6 +310,15 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
irep->code[t].u.i = irep->clen - t; irep->code[t].u.i = irep->clen - t;
break; break;
} }
else if (pic_eq_p(pic, proc, sBEGIN)) {
pic_value v, seq;
seq = pic_cdr(pic, obj);
for (v = seq; ! pic_nil_p(v); v = pic_cdr(pic, v)) {
pic_gen(pic, irep, pic_car(pic, v), env);
}
break;
}
else if (pic_eq_p(pic, proc, sCONS)) { else if (pic_eq_p(pic, proc, sCONS)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);