Add numerical comparison primitive procedures

4 files changed, 201 insertions, 3 deletions

diff --git a/examples/booleans.bdl b/examples/booleans.bdl
index 24d57a0..8828ac2 100644
--- a/examples/booleans.bdl
+++ b/examples/booleans.bdl
@@ -75,3 +75,17 @@
 (cond ((and true true true) (+ 1 2 3))
       ((or true true false) 2)
       (else 3))
+
+;; Numeric comparisons.
+(print "(< 1 2 3) -> ")             (< 1 2 3)
+(print "(< 3 2 1) -> ")             (< 3 2 1)
+(print "(> 1 2 3) -> ")             (> 1 2 3)
+(print "(> 3 2 1) -> ")             (> 3 2 1)
+(print "(= 1 2 3) -> ")             (= 1 2 3)
+(print "(= 3 2 1) -> ")             (= 3 2 1)
+(print "(= 3 3 3) -> ")             (= 3 3 3)
+(print "(= (+ 1 2) 3 (- 6 3)) -> ") (= (+ 1 2) 3 (- 6 3))
+(print "(< 1 1 3) -> ")             (< 1 1 3)
+(print "(<= 1 1 3) -> ")            (<= 1 1 3)
+(print "(> 3 3 1) -> ")             (> 3 3 1)
+(print "(>= 3 3 1) -> ")            (>= 3 3 1)
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c
index c0f2e50..b8bab47 100755
--- a/src/bootstrap/main.c
+++ b/src/bootstrap/main.c
@@ -36,6 +36,11 @@ init(void) {
     environment[env_n++] = (EnvSymbol){MAKE_SYM("-"), make_procedure(proc_sub)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("*"), make_procedure(proc_mul)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("/"), make_procedure(proc_div)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("<"), make_procedure(proc_num_less_than)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM(">"), make_procedure(proc_num_greater_than)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("="), make_procedure(proc_num_equal)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("<="), make_procedure(proc_num_lesseq_than)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM(">="), make_procedure(proc_num_greatereq_than)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)};
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index 29a1df8..485799d 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -346,13 +346,180 @@ proc_cond(Object *args) {
         if (eval(clause->car) == obj_true) {
             return eval(clause->cdr->car);
         }
-
         args = args->cdr;
-        clause = args->car;
     }
 
     return obj_nil;
 }
 
-// TODO: equality greater than smaller than...
+Object *
+proc_num_less_than(Object *args) {
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_FIXNUM) {
+        fprintf(stderr, "error: wrong argument type.\n");
+        return NULL;
+    }
+    ssize_t prev = obj->fixnum;
+    args = args->cdr;
+
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+    while (args != obj_nil) {
+        Object *obj = eval(args->car);
+        if (obj->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "error: wrong argument type.\n");
+            return NULL;
+        }
+        if (prev >= obj->fixnum) {
+            return obj_false;
+        }
+        prev = obj->fixnum;
+        args = args->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_greater_than(Object *args) {
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_FIXNUM) {
+        fprintf(stderr, "error: wrong argument type.\n");
+        return NULL;
+    }
+    ssize_t prev = obj->fixnum;
+    args = args->cdr;
+
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+    while (args != obj_nil) {
+        Object *obj = eval(args->car);
+        if (obj->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "error: wrong argument type.\n");
+            return NULL;
+        }
+        if (prev <= obj->fixnum) {
+            return obj_false;
+        }
+        prev = obj->fixnum;
+        args = args->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_lesseq_than(Object *args) {
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_FIXNUM) {
+        fprintf(stderr, "error: wrong argument type.\n");
+        return NULL;
+    }
+    ssize_t prev = obj->fixnum;
+    args = args->cdr;
+
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+    while (args != obj_nil) {
+        Object *obj = eval(args->car);
+        if (obj->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "error: wrong argument type.\n");
+            return NULL;
+        }
+        if (prev > obj->fixnum) {
+            return obj_false;
+        }
+        prev = obj->fixnum;
+        args = args->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_greatereq_than(Object *args) {
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_FIXNUM) {
+        fprintf(stderr, "error: wrong argument type.\n");
+        return NULL;
+    }
+    ssize_t prev = obj->fixnum;
+    args = args->cdr;
+
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+    while (args != obj_nil) {
+        Object *obj = eval(args->car);
+        if (obj->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "error: wrong argument type.\n");
+            return NULL;
+        }
+        if (prev < obj->fixnum) {
+            return obj_false;
+        }
+        prev = obj->fixnum;
+        args = args->cdr;
+    }
+    return obj_true;
+}
+
+Object *
+proc_num_equal(Object *args) {
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+
+    Object *obj = eval(args->car);
+    if (obj->type != OBJ_TYPE_FIXNUM) {
+        fprintf(stderr, "error: wrong argument type.\n");
+        return NULL;
+    }
+    ssize_t prev = obj->fixnum;
+    args = args->cdr;
+
+    if (args == obj_nil) {
+        fprintf(stderr, "error: wrong number of arguments type.\n");
+        return NULL;
+    }
+    while (args != obj_nil) {
+        Object *obj = eval(args->car);
+        if (obj->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "error: wrong argument type.\n");
+            return NULL;
+        }
+        if (prev != obj->fixnum) {
+            return obj_false;
+        }
+        prev = obj->fixnum;
+        args = args->cdr;
+    }
+    return obj_true;
+}
+
 // TODO: fixnum left/right shift, mask, invert
diff --git a/tests/booleans_expected.txt b/tests/booleans_expected.txt
index f0612b8..5919767 100644
--- a/tests/booleans_expected.txt
+++ b/tests/booleans_expected.txt
@@ -46,3 +46,15 @@
 (cond ((and true true false) 1) ((or false false false) 2) (else 3)) -> 3
 (cond ((and true true true) 1) ((or true true false) 2)) -> ()
 (cond ((and true true true) (+ 1 2 3)) ((or true true false) 2) (else 3)) -> 6
+(< 1 2 3) -> true
+(< 3 2 1) -> false
+(> 1 2 3) -> false
+(> 3 2 1) -> true
+(= 1 2 3) -> false
+(= 3 2 1) -> false
+(= 3 3 3) -> true
+(= (+ 1 2) 3 (- 6 3)) -> true
+(< 1 1 3) -> false
+(<= 1 1 3) -> true
+(> 3 3 1) -> false
+(>= 3 3 1) -> true