Merge commit '536d59c7d4799208aed63309556d86bb92521470'

picrin-scheme · Jan 17, 2015 · 2652d97 · 2652d97
2 parents c399bd3 + 536d59c
commit 2652d97
Show file tree

Hide file tree

Showing 6 changed files with 50 additions and 1 deletion.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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;						\