diff --git a/extlib/benz/codegen.c b/extlib/benz/codegen.c index e43f19c0..39b4bfc4 100644 --- a/extlib/benz/codegen.c +++ b/extlib/benz/codegen.c @@ -35,6 +35,7 @@ typedef struct analyze_state { pic_state *pic; analyze_scope *scope; pic_sym rCONS, rCAR, rCDR, rNILP; + pic_sym rSYMBOL_P, rPAIR_P; pic_sym rADD, rSUB, rMUL, rDIV; pic_sym rEQ, rLT, rLE, rGT, rGE, rNOT; pic_sym rVALUES, rCALL_WITH_VALUES; @@ -73,6 +74,8 @@ new_analyze_state(pic_state *pic) register_renamed_symbol(pic, state, rCAR, pic->PICRIN_BASE, "car"); register_renamed_symbol(pic, state, rCDR, pic->PICRIN_BASE, "cdr"); register_renamed_symbol(pic, state, rNILP, pic->PICRIN_BASE, "null?"); + register_renamed_symbol(pic, state, rSYMBOL_P, pic->PICRIN_BASE, "symbol?"); + register_renamed_symbol(pic, state, rPAIR_P, pic->PICRIN_BASE, "pair?"); register_renamed_symbol(pic, state, rADD, pic->PICRIN_BASE, "+"); register_renamed_symbol(pic, state, rSUB, pic->PICRIN_BASE, "-"); register_renamed_symbol(pic, state, rMUL, pic->PICRIN_BASE, "*"); @@ -788,6 +791,14 @@ analyze_node(analyze_state *state, pic_value obj, bool tailpos) ARGC_ASSERT(1); return CONSTRUCT_OP1(pic->sNILP); } + else if (sym == state->rSYMBOL_P) { + ARGC_ASSERT(1); + return CONSTRUCT_OP1(pic->sSYMBOL_P); + } + else if (sym == state->rPAIR_P) { + ARGC_ASSERT(1); + return CONSTRUCT_OP1(pic->sPAIR_P); + } else if (sym == state->rADD) { return analyze_add(state, obj, tailpos); } @@ -1299,6 +1310,18 @@ codegen(codegen_state *state, pic_value obj) cxt->clen++; return; } + else if (sym == pic->sSYMBOL_P) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_SYMBOL_P; + cxt->clen++; + return; + } + else if (sym == pic->sPAIR_P) { + codegen(state, pic_list_ref(pic, obj, 1)); + cxt->code[cxt->clen].insn = OP_PAIR_P; + cxt->clen++; + return; + } else if (sym == pic->sADD) { codegen(state, pic_list_ref(pic, obj, 1)); codegen(state, pic_list_ref(pic, obj, 2)); diff --git a/extlib/benz/gc.c b/extlib/benz/gc.c index 633445e8..1e50649e 100644 --- a/extlib/benz/gc.c +++ b/extlib/benz/gc.c @@ -30,7 +30,7 @@ union header { size_t size; unsigned int mark : 1; } s; - long alignment[4]; + long alignment[2]; }; struct heap_page { diff --git a/extlib/benz/include/picrin.h b/extlib/benz/include/picrin.h index 00c1cbe4..98b96d0c 100644 --- a/extlib/benz/include/picrin.h +++ b/extlib/benz/include/picrin.h @@ -89,6 +89,7 @@ typedef struct { pic_sym sCOND_EXPAND, sAND, sOR, sELSE, sLIBRARY; pic_sym sONLY, sRENAME, sPREFIX, sEXCEPT; pic_sym sCONS, sCAR, sCDR, sNILP; + pic_sym sSYMBOL_P, sPAIR_P; pic_sym sADD, sSUB, sMUL, sDIV, sMINUS; pic_sym sEQ, sLT, sLE, sGT, sGE, sNOT; pic_sym sREAD, sFILE; diff --git a/extlib/benz/include/picrin/irep.h b/extlib/benz/include/picrin/irep.h index fe924bbc..5b10628a 100644 --- a/extlib/benz/include/picrin/irep.h +++ b/extlib/benz/include/picrin/irep.h @@ -35,6 +35,8 @@ enum pic_opcode { OP_CAR, OP_CDR, OP_NILP, + OP_SYMBOL_P, + OP_PAIR_P, OP_ADD, OP_SUB, OP_MUL, @@ -149,6 +151,12 @@ pic_dump_code(pic_code c) case OP_NILP: puts("OP_NILP"); break; + case OP_SYMBOL_P: + puts("OP_SYMBOL_P"); + break; + case OP_PAIR_P: + puts("OP_PAIR_P"); + break; case OP_CDR: puts("OP_CDR"); break; diff --git a/extlib/benz/state.c b/extlib/benz/state.c index 688e4a6f..75e940f3 100644 --- a/extlib/benz/state.c +++ b/extlib/benz/state.c @@ -123,6 +123,8 @@ pic_open(int argc, char *argv[], char **envp) S(sCAR, "car"); S(sCDR, "cdr"); S(sNILP, "null?"); + S(sSYMBOL_P, "symbol?"); + S(sPAIR_P, "pair?"); S(sADD, "+"); S(sSUB, "-"); S(sMUL, "*"); diff --git a/extlib/benz/vm.c b/extlib/benz/vm.c index 8eb67b71..66ed3871 100644 --- a/extlib/benz/vm.c +++ b/extlib/benz/vm.c @@ -693,6 +693,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args) &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_LSET, &&L_OP_CREF, &&L_OP_CSET, &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_NOT, &&L_OP_CALL, &&L_OP_TAILCALL, &&L_OP_RET, &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP, + &&L_OP_SYMBOL_P, &&L_OP_PAIR_P, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_MINUS, &&L_OP_EQ, &&L_OP_LT, &&L_OP_LE, &&L_OP_STOP }; @@ -1035,6 +1036,20 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args) NEXT; } + CASE(OP_SYMBOL_P) { + pic_value p; + p = POP(); + PUSH(pic_bool_value(pic_sym_p(p))); + NEXT; + } + + CASE(OP_PAIR_P) { + pic_value p; + p = POP(); + PUSH(pic_bool_value(pic_pair_p(p))); + NEXT; + } + #define DEFINE_ARITH_OP(opcode, op, guard) \ CASE(opcode) { \ pic_value a, b; \