From b2426dc8cc473a4b796f0f96136b2f254c84913f Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Wed, 13 Oct 2021 18:49:04 +0200
Subject: Cleanup primitive procedures

---
 src/bootstrap/primitives.c | 409 ++++++---------------------------------------
 1 file changed, 55 insertions(+), 354 deletions(-)

diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index 2a82782..39229ff 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -1,6 +1,8 @@
 Object *
 eval(Environment* env, Object *root) {
     switch (root->type) {
+        case OBJ_TYPE_ERR:
+        case OBJ_TYPE_PROCEDURE:
         case OBJ_TYPE_FIXNUM:
         case OBJ_TYPE_BOOL:
         case OBJ_TYPE_NIL:
@@ -38,15 +40,8 @@ eval(Environment* env, Object *root) {
                 return obj_err;
             }
         } break;
-        default: {
-            break;
-        } break;
     }
 
-    printf("DING\n");
-    display(root);
-    printf("\nTYPE: %d\n", root->type);
-
     error_push((Error){
         .type = ERR_TYPE_RUNTIME,
         .value = ERR_UNKNOWN_OBJ_TYPE,
@@ -60,13 +55,8 @@ proc_quote(Environment *env, Object *obj) {
     return obj->car;
 }
 
-//
-// Arithmetic procedures.
-//
-
-Object *
-proc_sum(Environment *env, Object *obj) {
-    // First argument.
+static inline Object *
+extract_car_with_type(Environment *env, Object *obj, ObjectType expected_type) {
     if (obj == obj_nil) {
         error_push((Error){
             .type = ERR_TYPE_RUNTIME,
@@ -78,29 +68,27 @@ proc_sum(Environment *env, Object *obj) {
     if (car == obj_err) {
         return obj_err;
     }
-    if (car->type != OBJ_TYPE_FIXNUM) {
+    if (car->type != expected_type) {
         error_push((Error){
             .type = ERR_TYPE_RUNTIME,
             .value = ERR_WRONG_ARG_TYPE,
         });
         return obj_err;
     }
+    return car;
+}
 
-    // Traverse the list.
+//
+// Arithmetic procedures.
+//
+
+Object *
+proc_sum(Environment *env, Object *obj) {
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t tot = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         tot += car->fixnum;
         obj = obj->cdr;
     }
@@ -109,41 +97,11 @@ proc_sum(Environment *env, Object *obj) {
 
 Object *
 proc_sub(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t tot = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         tot -= car->fixnum;
         obj = obj->cdr;
     }
@@ -152,41 +110,11 @@ proc_sub(Environment *env, Object *obj) {
 
 Object *
 proc_mul(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t tot = car->fixnum;
     while (obj != obj_nil) {
-        Object *car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         tot *= car->fixnum;
         obj = obj->cdr;
     }
@@ -195,41 +123,11 @@ proc_mul(Environment *env, Object *obj) {
 
 Object *
 proc_div(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t tot = car->fixnum;
     while (obj != obj_nil) {
-        Object *car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (car->fixnum == 0) {
             error_push((Error){
                 .type = ERR_TYPE_RUNTIME,
@@ -245,41 +143,11 @@ proc_div(Environment *env, Object *obj) {
 
 Object *
 proc_mod(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t tot = car->fixnum;
     while (obj != obj_nil) {
-        Object *car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (car->fixnum == 0) {
             error_push((Error){
                 .type = ERR_TYPE_RUNTIME,
@@ -305,25 +173,7 @@ proc_display(Environment *env, Object *obj) {
 
 Object *
 proc_print(Environment *env, Object *obj) {
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_STRING) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_STRING);
     StringView scanner = (StringView) {
         .start = car->string,
         .n = car->string_n,
@@ -522,17 +372,16 @@ proc_if(Environment *env, Object *obj) {
     }
     Object *car = obj->car;
     Object *cdr = obj->cdr;
-    Object *clause = eval(env, car);
-    if (obj == obj_err) {
+    Object *condition = eval(env, car);
+    if (condition == obj_err) {
         return obj_err;
     }
-    if (clause == obj_true) {
+    if (condition == obj_true) {
         return eval(env, cdr->car);
     }
-    if (obj->cdr->cdr != obj_nil) {
+    if (cdr->cdr != obj_nil) {
         return eval(env, cdr->cdr->car);
     }
-
     return obj_nil;
 }
 
@@ -545,24 +394,23 @@ proc_cond(Environment *env, Object *obj) {
         });
         return obj_err;
     }
-
-    if (obj->car->type != OBJ_TYPE_PAIR) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // TODO: review this, the cdr->car could cause issues?
     while (obj != obj_nil) {
         Object *clause = obj->car;
-        Object *result = eval(env, clause->car);
+        if (clause->type != OBJ_TYPE_PAIR || clause->cdr == obj_nil) {
+            error_push((Error){
+                .type = ERR_TYPE_RUNTIME,
+                .value = ERR_WRONG_ARG_TYPE,
+            });
+            return obj_err;
+        }
+        Object *test = clause->car;
+        Object *value = clause->cdr->car;
+        Object *result = eval(env, test);
         if (result == obj_err) {
             return obj_err;
         }
         if (result == obj_true) {
-            return eval(env, clause->cdr->car);
+            return eval(env, value);
         }
         obj = obj->cdr;
     }
@@ -571,41 +419,11 @@ proc_cond(Environment *env, Object *obj) {
 
 Object *
 proc_num_less_than(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t prev = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (prev >= car->fixnum) {
             return obj_false;
         }
@@ -617,41 +435,11 @@ proc_num_less_than(Environment *env, Object *obj) {
 
 Object *
 proc_num_greater_than(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t prev = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (prev <= car->fixnum) {
             return obj_false;
         }
@@ -663,41 +451,11 @@ proc_num_greater_than(Environment *env, Object *obj) {
 
 Object *
 proc_num_lesseq_than(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t prev = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (prev > car->fixnum) {
             return obj_false;
         }
@@ -709,41 +467,11 @@ proc_num_lesseq_than(Environment *env, Object *obj) {
 
 Object *
 proc_num_greatereq_than(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t prev = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (prev < car->fixnum) {
             return obj_false;
         }
@@ -755,41 +483,11 @@ proc_num_greatereq_than(Environment *env, Object *obj) {
 
 Object *
 proc_num_equal(Environment *env, Object *obj) {
-    // First argument.
-    if (obj == obj_nil) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_NOT_ENOUGH_ARGS,
-        });
-        return obj_err;
-    }
-    Object *car = eval(env, obj->car);
-    if (car == obj_err) {
-        return obj_err;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        error_push((Error){
-            .type = ERR_TYPE_RUNTIME,
-            .value = ERR_WRONG_ARG_TYPE,
-        });
-        return obj_err;
-    }
-
-    // Traverse the list.
+    Object *car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
     obj = obj->cdr;
     ssize_t prev = car->fixnum;
     while (obj != obj_nil) {
-        car = eval(env, obj->car);
-        if (car == obj_err) {
-            return obj_err;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            error_push((Error){
-                .type = ERR_TYPE_RUNTIME,
-                .value = ERR_WRONG_ARG_TYPE,
-            });
-            return obj_err;
-        }
+        car = extract_car_with_type(env, obj, OBJ_TYPE_FIXNUM);
         if (prev != car->fixnum) {
             return obj_false;
         }
@@ -851,9 +549,12 @@ proc_cdr(Environment *env, Object *obj) {
 
 Object *
 proc_cons(Environment *env, Object *obj) {
-    if (obj == obj_nil || obj->cdr == obj_nil) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
+    if (obj == obj_nil) {
+        error_push((Error){
+            .type = ERR_TYPE_RUNTIME,
+            .value = ERR_NOT_ENOUGH_ARGS,
+        });
+        return obj_err;
     }
     Object *a = eval(env, obj->car);
     Object *b = eval(env, obj->cdr->car);
-- 
cgit v1.2.1