From 9cb28f31565c6a7c3d3326fe2b6883dda7c49a9f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Thu, 24 Oct 2013 21:10:13 +0900
Subject: [PATCH] add OP_EQ/OP_LT/OP_LE

---
 include/picrin.h      |  1 +
 include/picrin/irep.h |  3 +++
 src/codegen.c         | 44 +++++++++++++++++++++++++++++++++++++++++++
 src/gc.c              |  5 +++++
 src/number.c          | 16 ----------------
 src/state.c           |  5 +++++
 src/vm.c              | 24 ++++++++++++++++++++++-
 7 files changed, 81 insertions(+), 17 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index 6461dc38..97b76051 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -30,6 +30,7 @@ typedef struct {
   pic_value sQUASIQUOTE, sUNQUOTE, sUNQUOTE_SPLICING;
   pic_value sCONS, sCAR, sCDR, sNILP;
   pic_value sADD, sSUB, sMUL, sDIV;
+  pic_value sEQ, sLT, sLE, sGT, sGE;
 
   struct sym_tbl *sym_tbl;
 
diff --git a/include/picrin/irep.h b/include/picrin/irep.h
index 5b33711d..1771d3ed 100644
--- a/include/picrin/irep.h
+++ b/include/picrin/irep.h
@@ -27,6 +27,9 @@ enum pic_opcode {
   OP_SUB,
   OP_MUL,
   OP_DIV,
+  OP_EQ,
+  OP_LT,
+  OP_LE,
   OP_STOP
 };
 
diff --git a/src/codegen.c b/src/codegen.c
index eceb9d95..b27df0ee 100644
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -348,6 +348,41 @@ codegen(codegen_state *state, pic_value obj)
       irep->clen++;
       break;
     }
+    else if (pic_eq_p(pic, proc, pic->sEQ)) {
+      codegen(state, pic_car(pic, pic_cdr(pic, obj)));
+      codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
+      irep->code[irep->clen].insn = OP_EQ;
+      irep->clen++;
+      break;
+    }
+    else if (pic_eq_p(pic, proc, pic->sLT)) {
+      codegen(state, pic_car(pic, pic_cdr(pic, obj)));
+      codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
+      irep->code[irep->clen].insn = OP_LT;
+      irep->clen++;
+      break;
+    }
+    else if (pic_eq_p(pic, proc, pic->sLE)) {
+      codegen(state, pic_car(pic, pic_cdr(pic, obj)));
+      codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
+      irep->code[irep->clen].insn = OP_LE;
+      irep->clen++;
+      break;
+    }
+    else if (pic_eq_p(pic, proc, pic->sGT)) {
+      codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
+      codegen(state, pic_car(pic, pic_cdr(pic, obj)));
+      irep->code[irep->clen].insn = OP_LT;
+      irep->clen++;
+      break;
+    }
+    else if (pic_eq_p(pic, proc, pic->sGE)) {
+      codegen(state, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))));
+      codegen(state, pic_car(pic, pic_cdr(pic, obj)));
+      irep->code[irep->clen].insn = OP_LE;
+      irep->clen++;
+      break;
+    }
     else {
       codegen_call(state, obj);
       break;
@@ -599,6 +634,15 @@ print_irep(pic_state *pic, struct pic_irep *irep)
     case OP_DIV:
       puts("OP_DIV");
       break;
+    case OP_EQ:
+      puts("OP_EQ");
+      break;
+    case OP_LT:
+      puts("OP_LT");
+      break;
+    case OP_LE:
+      puts("OP_LE");
+      break;
     case OP_STOP:
       puts("OP_STOP");
       break;
diff --git a/src/gc.c b/src/gc.c
index 48e2b3ca..9dee4aec 100644
--- a/src/gc.c
+++ b/src/gc.c
@@ -251,6 +251,11 @@ gc_mark_phase(pic_state *pic)
   gc_mark(pic, pic->sADD);
   gc_mark(pic, pic->sSUB);
   gc_mark(pic, pic->sMUL);
+  gc_mark(pic, pic->sEQ);
+  gc_mark(pic, pic->sLT);
+  gc_mark(pic, pic->sLE);
+  gc_mark(pic, pic->sGT);
+  gc_mark(pic, pic->sGE);
   gc_mark(pic, pic->sDIV);
 }
 
diff --git a/src/number.c b/src/number.c
index 4b05dfc3..a7a0deb4 100644
--- a/src/number.c
+++ b/src/number.c
@@ -55,20 +55,6 @@ pic_number_nan_p(pic_state *pic)
     return pic_false_value();
 }
 
-static pic_value
-pic_number_lt(pic_state *pic)
-{
-  double f,g;
-
-  pic_get_args(pic, "ff", &f, &g);
-  if (f < g) {
-    return pic_true_value();
-  }
-  else {
-    return pic_false_value();
-  }
-}
-
 static pic_value
 pic_number_abs(pic_state *pic)
 {
@@ -293,8 +279,6 @@ pic_init_number(pic_state *pic)
   pic_defun(pic, "nan?", pic_number_nan_p);
   pic_gc_arena_restore(pic, ai);
 
-  pic_defun(pic, "<", pic_number_lt);
-
   pic_defun(pic, "abs", pic_number_abs);
 
   pic_defun(pic, "floor-quotient", pic_number_floor_quotient);
diff --git a/src/state.c b/src/state.c
index 935361f3..f72ea5d3 100644
--- a/src/state.c
+++ b/src/state.c
@@ -92,6 +92,11 @@ pic_open(int argc, char *argv[], char **envp)
   pic->sSUB = pic_intern_cstr(pic, "-");
   pic->sMUL = pic_intern_cstr(pic, "*");
   pic->sDIV = pic_intern_cstr(pic, "/");
+  pic->sEQ = pic_intern_cstr(pic, "=");
+  pic->sLT = pic_intern_cstr(pic, "<");
+  pic->sLE = pic_intern_cstr(pic, "<=");
+  pic->sGT = pic_intern_cstr(pic, ">");
+  pic->sGE = pic_intern_cstr(pic, ">=");
   pic_gc_arena_restore(pic, ai);
 
   pic_init_core(pic);
diff --git a/src/vm.c b/src/vm.c
index bc3c78bc..5e569beb 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -121,7 +121,8 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
     &&L_OP_PUSHCONST, &&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_CALL, &&L_OP_RET,
     &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP,
-    &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_STOP
+    &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV,
+    &&L_OP_EQ, &&L_OP_LT, &&L_OP_LE, &&L_OP_STOP
   };
 #endif
 
@@ -347,6 +348,27 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args)
       PUSH(pic_float_value(pic_float(a) / pic_float(b)));
       NEXT;
     }
+    CASE(OP_EQ) {
+      pic_value a, b;
+      b = POP();
+      a = POP();
+      PUSH(pic_bool_value(pic_float(a) == pic_float(b)));
+      NEXT;
+    }
+    CASE(OP_LT) {
+      pic_value a, b;
+      b = POP();
+      a = POP();
+      PUSH(pic_bool_value(pic_float(a) < pic_float(b)));
+      NEXT;
+    }
+    CASE(OP_LE) {
+      pic_value a, b;
+      b = POP();
+      a = POP();
+      PUSH(pic_bool_value(pic_float(a) <= pic_float(b)));
+      NEXT;
+    }
     CASE(OP_STOP) {
       pic_value val;