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

if syntax

This commit is contained in:
Yuichi Nishiwaki 2013-10-16 17:42:47 +09:00
parent 87dce75c78
commit 6c903db758
4 changed files with 40 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
include/picrin.h
View File

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

2
include/picrin/irep.h
View File

@ -9,6 +9,8 @@ enum pic_instruction {
OP_GREF,
OP_GSET,
OP_LREF,
OP_JMP,
OP_JMPIF,
OP_CALL,
OP_RET,
OP_LAMBDA,

1
src/state.c
View File

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

37
src/vm.c
View File

@ -210,10 +210,11 @@ static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_env *)
static void
pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env)
{
pic_value sDEFINE, sLAMBDA, sCONS, sADD, sSUB, sMUL, sDIV;
pic_value sDEFINE, sLAMBDA, sIF, sCONS, sADD, sSUB, sMUL, sDIV;
sDEFINE = pic->sDEFINE;
sLAMBDA = pic->sLAMBDA;
sIF = pic->sIF;
sCONS = pic->sCONS;
sADD = pic->sADD;
sSUB = pic->sSUB;
@ -268,6 +269,26 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
pic->irep[pic->ilen++] = pic_gen_lambda(pic, obj, env);
break;
}
else if (pic_eq_p(pic, proc, sIF)) {
int s,t;
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
irep->code[irep->clen].insn = OP_JMPIF;
s = irep->clen++;
/* if false branch */
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, pic_cdr(pic, obj)))), env);
irep->code[irep->clen].insn = OP_JMP;
t = irep->clen++;
irep->code[s].u.i = irep->clen - s;
/* if true branch */
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env);
irep->code[t].u.i = irep->clen - t;
break;
}
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, obj)), env);
@ -465,6 +486,20 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
PUSH(pic->ci[-1].sp[pc->u.i]);
NEXT;
}
CASE(OP_JMP) {
pc += pc->u.i;
JUMP;
}
CASE(OP_JMPIF) {
pic_value v;
v = POP();
if (! pic_false_p(v)) {
pc += pc->u.i;
JUMP;
}
NEXT;
}
CASE(OP_CALL) {
pic_value c, v;
struct pic_proc *proc;