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

add OP_NILP

This commit is contained in:
Yuichi Nishiwaki 2013-10-20 03:53:02 +09:00
parent 78f301794a
commit cfae6f3c59
4 changed files with 23 additions and 3 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 *cibase, *ciend; pic_callinfo *cibase, *ciend;
pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE; pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE;
pic_value sCONS, sCAR, sCDR; pic_value sCONS, sCAR, sCDR, sNILP;
pic_value sADD, sSUB, sMUL, sDIV; pic_value sADD, sSUB, sMUL, sDIV;
struct pic_env *global_env; struct pic_env *global_env;

1
include/picrin/irep.h
View File

@ -18,6 +18,7 @@ enum pic_opcode {
OP_CONS, OP_CONS,
OP_CAR, OP_CAR,
OP_CDR, OP_CDR,
OP_NILP,
OP_ADD, OP_ADD,
OP_SUB, OP_SUB,
OP_MUL, OP_MUL,

1
src/state.c
View File

@ -57,6 +57,7 @@ pic_open()
pic->sCONS = pic_intern_cstr(pic, "cons"); pic->sCONS = pic_intern_cstr(pic, "cons");
pic->sCAR = pic_intern_cstr(pic, "car"); pic->sCAR = pic_intern_cstr(pic, "car");
pic->sCDR = pic_intern_cstr(pic, "cdr"); pic->sCDR = pic_intern_cstr(pic, "cdr");
pic->sNILP = pic_intern_cstr(pic, "null?");
pic->sADD = pic_intern_cstr(pic, "+"); pic->sADD = pic_intern_cstr(pic, "+");
pic->sSUB = pic_intern_cstr(pic, "-"); pic->sSUB = pic_intern_cstr(pic, "-");
pic->sMUL = pic_intern_cstr(pic, "*"); pic->sMUL = pic_intern_cstr(pic, "*");

22
src/vm.c
View File

@ -188,6 +188,9 @@ print_irep(pic_state *pic, struct pic_irep *irep)
case OP_CAR: case OP_CAR:
puts("OP_CAR"); puts("OP_CAR");
break; break;
case OP_NILP:
puts("OP_NILP");
break;
case OP_CDR: case OP_CDR:
puts("OP_CDR"); puts("OP_CDR");
break; break;
@ -228,7 +231,9 @@ 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, sBEGIN, sCONS, sCAR, sCDR, sADD, sSUB, sMUL, sDIV; pic_value sDEFINE, sLAMBDA, sIF, sBEGIN;
pic_value sCONS, sCAR, sCDR, sNILP;
pic_value sADD, sSUB, sMUL, sDIV;
sDEFINE = pic->sDEFINE; sDEFINE = pic->sDEFINE;
sLAMBDA = pic->sLAMBDA; sLAMBDA = pic->sLAMBDA;
@ -237,6 +242,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
sCONS = pic->sCONS; sCONS = pic->sCONS;
sCAR = pic->sCAR; sCAR = pic->sCAR;
sCDR = pic->sCDR; sCDR = pic->sCDR;
sNILP = pic->sNILP;
sADD = pic->sADD; sADD = pic->sADD;
sSUB = pic->sSUB; sSUB = pic->sSUB;
sMUL = pic->sMUL; sMUL = pic->sMUL;
@ -344,6 +350,12 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en
irep->clen++; irep->clen++;
break; break;
} }
else if (pic_eq_p(pic, proc, sNILP)) {
pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env);
irep->code[irep->clen].insn = OP_NILP;
irep->clen++;
break;
}
else if (pic_eq_p(pic, proc, sADD)) { else if (pic_eq_p(pic, proc, sADD)) {
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);
@ -521,7 +533,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
&&L_OP_POP, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE, &&L_OP_PUSHFALSE, &&L_OP_PUSHNUM, &&L_OP_POP, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE, &&L_OP_PUSHFALSE, &&L_OP_PUSHNUM,
&&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_JMP, &&L_OP_JMPIF,
&&L_OP_CALL, &&L_OP_RET, &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_CALL, &&L_OP_RET, &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR,
&&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_STOP &&L_OP_NILP, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_STOP
}; };
#endif #endif
@ -646,6 +658,12 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
PUSH(pic_cdr(pic, p)); PUSH(pic_cdr(pic, p));
NEXT; NEXT;
} }
CASE(OP_NILP) {
pic_value p;
p = POP();
PUSH(pic_bool_value(pic_nil_p(p)));
NEXT;
}
CASE(OP_ADD) { CASE(OP_ADD) {
pic_value a, b; pic_value a, b;
a = POP(); a = POP();