Add modulo primitive and stubs for other procs

4 files changed, 152 insertions, 4 deletions

diff --git a/examples/arithmetic.bdl b/examples/arithmetic.bdl
index 83404e2..c3ff230 100644
--- a/examples/arithmetic.bdl
+++ b/examples/arithmetic.bdl
@@ -3,20 +3,26 @@
 ;;
 
 ;; Addition.
-(print "(+ 10 100) -> ") (+ 10 100)
+(print "(+ 10 100) -> ")   (+ 10 100)
 (print "(+ 1 -2 3 4) -> ") (+ 1 -2 3 4)
 
 ;; Substraction.
-(print "(- 100 75) -> ") (- 100 75)
+(print "(- 100 75) -> ")   (- 100 75)
 (print "(- 10 20 30) -> ") (- 10 20 30)
 
 ;; Multiplication.
-(print "(* 10 7) -> ") (* 10 7)
+(print "(* 10 7) -> ")  (* 10 7)
 (print "(* -1 66) -> ") (* -1 66)
 
 ;; Division.
-(print "(/ 45 5) -> ") (/ 45 5)
+(print "(/ 45 5) -> ")   (/ 45 5)
 (print "(/ 10 5 2) -> ") (/ 10 5 2)
 
+;; Remainder/modulo.
+(print "(% 45 5) -> ")     (% 45 5)
+(print "(% 45 7) -> ")     (% 45 7)
+(print "(% 120 45) -> ")   (% 120 45)
+(print "(% 120 45 8) -> ") (% 120 45 8)
+
 ;; Nesting operations.
 (print "(* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> ") (* 20 (+ 100 (- 50 30) (/ 300 3)) 10)
diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c
index b8bab47..65e508f 100755
--- a/src/bootstrap/main.c
+++ b/src/bootstrap/main.c
@@ -36,18 +36,30 @@ 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_mod)};
     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("null?"), make_procedure(proc_is_null)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("boolean?"), make_procedure(proc_is_boolean)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("symbol?"), make_procedure(proc_is_symbol)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("string?"), make_procedure(proc_is_string)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("fixnum?"), make_procedure(proc_is_fixnum)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("pair?"), make_procedure(proc_is_pair)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("procedure?"), make_procedure(proc_is_procedure)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("not"), make_procedure(proc_not)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("and"), make_procedure(proc_and)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("or"), make_procedure(proc_or)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("if"), make_procedure(proc_if)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("else"), obj_true};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("cond"), make_procedure(proc_cond)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("car"), make_procedure(proc_car)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("cdr"), make_procedure(proc_cdr)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("cons"), make_procedure(proc_cons)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("list"), make_procedure(proc_list)};
+    environment[env_n++] = (EnvSymbol){MAKE_SYM("eq?"), make_procedure(proc_equal)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("display"), make_procedure(proc_display)};
     environment[env_n++] = (EnvSymbol){MAKE_SYM("print"), make_procedure(proc_print)};
 }
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index 485799d..f6b354e 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -92,6 +92,10 @@ eval(Object *root) {
     return obj_nil;
 }
 
+//
+// Arithmetic procedures.
+//
+
 Object *
 proc_add(Object *args) {
     // Extract first parameter.
@@ -213,6 +217,40 @@ proc_div(Object *args) {
 }
 
 Object *
+proc_mod(Object *args) {
+    // Extract first parameter.
+    Object *car = eval(args->car);
+    if (car == NULL) {
+        fprintf(stderr, "error: not enough arguments\n");
+        return obj_nil;
+    }
+    args = args->cdr;
+    ssize_t tot = car->fixnum;
+
+    while (args->type == OBJ_TYPE_PAIR) {
+        Object *car = eval(args->car);
+        if (car == NULL) {
+            car = obj_nil;
+        }
+        if (car->type != OBJ_TYPE_FIXNUM) {
+            fprintf(stderr, "error: div not supported for type %d\n", car->type);
+            return obj_nil;
+        }
+        if (car->fixnum == 0) {
+            fprintf(stderr, "error: division by zero\n");
+            return obj_nil;
+        }
+        tot %= car->fixnum;
+        args = args->cdr;
+    }
+    return make_fixnum(tot);
+}
+
+//
+// Display/Evaluation procedues.
+//
+
+Object *
 proc_display(Object *args) {
     if (args == NULL) {
         return obj_nil;
@@ -256,6 +294,10 @@ proc_print(Object *args) {
     return NULL;
 }
 
+//
+// Type info procedures.
+//
+
 Object *
 proc_is_boolean(Object *args) {
     Object *obj = NULL;
@@ -268,6 +310,46 @@ proc_is_boolean(Object *args) {
 }
 
 Object *
+proc_is_null(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_is_symbol(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_is_string(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_is_fixnum(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_is_pair(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_is_procedure(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+//
+// Boolean/conditional procedures.
+//
+
+Object *
 proc_not(Object *args) {
     if (args->type == OBJ_TYPE_PAIR) {
         return eval(args->car) == obj_false ? obj_true : obj_false;
@@ -522,4 +604,48 @@ proc_num_equal(Object *args) {
     return obj_true;
 }
 
+//
+// List operation procedures.
+//
+
+Object *
+proc_car(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_cdr(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_cons(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+Object *
+proc_list(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
+//
+// Polymorphic procedures.
+//
+
+Object *
+proc_equal(Object *args) {
+    // TODO: stub
+    return NULL;
+}
+
 // TODO: fixnum left/right shift, mask, invert
+// TODO: implement and test missing procedures
+// TODO: properly implement nested environments
+// TODO: implement support for quotes and semi-quotes
+// TODO: LAMBDA
+// TODO: let
+// TODO: better error handling?
diff --git a/tests/arithmetic_expected.txt b/tests/arithmetic_expected.txt
index 16445dc..a2a5a83 100644
--- a/tests/arithmetic_expected.txt
+++ b/tests/arithmetic_expected.txt
@@ -6,4 +6,8 @@
 (* -1 66) -> -66
 (/ 45 5) -> 9
 (/ 10 5 2) -> 1
+(% 45 5) -> 0
+(% 45 7) -> 3
+(% 120 45) -> 30
+(% 120 45 8) -> 6
 (* 20 (+ 100 (- 50 30) (/ 300 3)) 10) -> 44000