From dc758810b463c1674991601edb0ba41d40831e7a Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Mon, 11 Oct 2021 09:59:42 +0200
Subject: Remove most code for step-by-step guide

---
 src/bootstrap/primitives.c | 710 ---------------------------------------------
 1 file changed, 710 deletions(-)
 delete mode 100644 src/bootstrap/primitives.c

(limited to 'src/bootstrap/primitives.c')

diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
deleted file mode 100644
index 3c03b99..0000000
--- a/src/bootstrap/primitives.c
+++ /dev/null
@@ -1,710 +0,0 @@
-bool display(Object *root);
-
-void
-display_pair(Object *root) {
-    display(root->car);
-    if (root->cdr->type == OBJ_TYPE_PAIR) {
-        printf(" ");
-        display_pair(root->cdr);
-    } else if (root->cdr == obj_nil) {
-        return;
-    } else {
-        printf(" . ");
-        display(root->cdr);
-    }
-}
-
-bool
-display(Object *root) {
-    if (root == NULL) {
-        return false;
-    }
-
-    switch (root->type) {
-        case OBJ_TYPE_FIXNUM: {
-            printf("%zd", root->fixnum);
-        } break;
-        case OBJ_TYPE_BOOL: {
-            if (root->boolean) {
-                printf("true");
-            } else {
-                printf("false");
-            }
-        } break;
-        case OBJ_TYPE_NIL: {
-            printf("()");
-        } break;
-        case OBJ_TYPE_STRING: {
-            printf("\"%.*s\"", (int)root->string_n, root->string);
-        } break;
-        case OBJ_TYPE_SYMBOL: {
-            printf(":%.*s", (int)root->symbol_n, root->symbol);
-        } break;
-        case OBJ_TYPE_PAIR: {
-            printf("(");
-            display_pair(root);
-            printf(")");
-        } break;
-        case OBJ_TYPE_PROCEDURE: {
-            printf("#{procedure}");
-        } break;
-    }
-    return true;
-}
-
-Object *
-eval(Object *root) {
-    switch (root->type) {
-        case OBJ_TYPE_FIXNUM:
-        case OBJ_TYPE_BOOL:
-        case OBJ_TYPE_NIL:
-        case OBJ_TYPE_STRING: {
-            return root;
-        } break;
-        case OBJ_TYPE_SYMBOL: {
-            Object *value = env_find_symbol(root);
-            if (value == NULL) {
-                printf("error: symbol not found: `");
-                display(root);
-                printf("`\n");
-                return obj_nil;
-            }
-            return value;
-        } break;
-        case OBJ_TYPE_PAIR: {
-            if (root->car->type == OBJ_TYPE_SYMBOL) {
-                Object *value = env_find_symbol(root->car);
-                if (value == NULL) {
-                    printf("error: symbol not found: `");
-                    display(root->car);
-                    printf("`\n");
-                    return obj_nil;
-                }
-                if (value->type == OBJ_TYPE_PROCEDURE) {
-                    return value->proc(root->cdr);
-                }
-            }
-        } break;
-        default: {
-            printf("error: can't eval type %d.\n", root->type);
-        } break;
-    }
-    return obj_nil;
-}
-
-//
-// Arithmetic procedures.
-//
-
-Object *
-proc_add(Object *args) {
-    // Extract first parameter.
-    Object *car = eval(args->car);
-    if (car == NULL) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        fprintf(stderr, "addition not supported for type %d\n", car->type);
-        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, "addition not supported for type %d\n", car->type);
-            return obj_nil;
-        }
-        tot += car->fixnum;
-        args = args->cdr;
-    }
-    return make_fixnum(tot);
-}
-
-Object *
-proc_sub(Object *args) {
-    // Extract first parameter.
-    Object *car = eval(args->car);
-    if (car == NULL) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        fprintf(stderr, "error: sub not supported for type %d\n", car->type);
-        return obj_nil;
-    }
-    args = args->cdr;
-    ssize_t tot = car->fixnum;
-
-    while (args->type == OBJ_TYPE_PAIR) {
-        car = eval(args->car);
-        if (car == NULL) {
-            car = obj_nil;
-        }
-        if (car->type != OBJ_TYPE_FIXNUM) {
-            fprintf(stderr, "error: sub not supported for type %d\n", car->type);
-            return obj_nil;
-        }
-        tot -= car->fixnum;
-        args = args->cdr;
-    }
-    return make_fixnum(tot);
-}
-
-Object *
-proc_mul(Object *args) {
-    // Extract first parameter.
-    Object *car = eval(args->car);
-    if (car == NULL) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
-    }
-    if (car->type != OBJ_TYPE_FIXNUM) {
-        fprintf(stderr, "error: mult not supported for type %d\n", car->type);
-        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: mult not supported for type %d\n", car->type);
-            return obj_nil;
-        }
-        tot *= car->fixnum;
-        args = args->cdr;
-    }
-    return make_fixnum(tot);
-}
-
-Object *
-proc_div(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);
-}
-
-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;
-    }
-    if (args->type == OBJ_TYPE_PAIR) {
-        display(eval(args->car));
-    }
-    return obj_nil;
-}
-
-Object *
-proc_print(Object *args) {
-    if (args == NULL) {
-        return NULL;
-    }
-    if (args->type == OBJ_TYPE_PAIR) {
-        Object *obj = args->car;
-        if (obj->type == OBJ_TYPE_STRING) {
-            StringView scanner = (StringView) {
-                .start = obj->string,
-                .n = obj->string_n,
-            };
-            while (scanner.n != 0) {
-                char c = sv_next(&scanner);
-                if (c == '\\' && sv_peek(&scanner) == 'n') {
-                    putchar('\n');
-                    sv_next(&scanner);
-                    continue;
-                }
-                if (c == '\\' && sv_peek(&scanner) == '"') {
-                    putchar('"');
-                    sv_next(&scanner);
-                    continue;
-                }
-                putchar(c);
-            }
-        } else {
-            fprintf(stderr, "error: print requires a string argument\n");
-        }
-    }
-    return NULL;
-}
-
-//
-// Type info procedures.
-//
-
-Object *
-proc_is_boolean(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return (obj == obj_true || obj == obj_false) ? obj_true : obj_false;
-}
-
-Object *
-proc_is_null(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return obj == obj_nil ? obj_true : obj_false;
-}
-
-Object *
-proc_is_symbol(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return obj->type == OBJ_TYPE_SYMBOL ? obj_true : obj_false;
-}
-
-Object *
-proc_is_string(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return obj->type == OBJ_TYPE_STRING ? obj_true : obj_false;
-}
-
-Object *
-proc_is_fixnum(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return obj->type == OBJ_TYPE_FIXNUM ? obj_true : obj_false;
-}
-
-Object *
-proc_is_pair(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return obj->type == OBJ_TYPE_PAIR ? obj_true : obj_false;
-}
-
-Object *
-proc_is_procedure(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-    Object *obj = eval(args->car);
-    return obj->type == OBJ_TYPE_PROCEDURE ? obj_true : obj_false;
-}
-
-//
-// Boolean/conditional procedures.
-//
-
-Object *
-proc_not(Object *args) {
-    if (args->type == OBJ_TYPE_PAIR) {
-        return eval(args->car) == obj_false ? obj_true : obj_false;
-    }
-    return eval(args) == obj_false ? obj_true : obj_false;
-}
-
-Object *
-proc_and(Object *args) {
-    while (args != NULL && args != obj_nil) {
-        Object *obj = args->car;
-        if (args->car->type == OBJ_TYPE_PAIR) {
-            obj = eval(args->car);
-        }
-        if (proc_not(obj) == obj_true) {
-            return obj_false;
-        }
-        args = args->cdr;
-    }
-    return obj_true;
-}
-
-Object *
-proc_or(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        return obj_false;
-    }
-
-    while (args != NULL && args != obj_nil) {
-        Object *obj = args->car;
-        if (args->car->type == OBJ_TYPE_PAIR) {
-            obj = eval(args->car);
-        }
-        if (proc_not(obj) == obj_false) {
-            return obj_true;
-        }
-        args = args->cdr;
-    }
-    return obj_false;
-}
-
-Object *
-proc_if(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR || args->cdr->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-
-    Object *condition = eval(args->car);
-    if (condition == obj_true) {
-        Object *ret = eval(args->cdr->car);
-        return ret;
-    }
-    if (args->cdr->cdr != obj_nil) {
-        Object *ret = eval(args->cdr->cdr->car);
-        return ret;
-    }
-
-    return obj_nil;
-}
-
-Object *
-proc_cond(Object *args) {
-    if (args->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong number of arguments.\n");
-        return NULL;
-    }
-
-    if (args->car->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong argument type.\n");
-        return NULL;
-    }
-
-    while (args != obj_nil) {
-        Object *clause = args->car;
-        if (eval(clause->car) == obj_true) {
-            return eval(clause->cdr->car);
-        }
-        args = args->cdr;
-    }
-
-    return obj_nil;
-}
-
-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;
-}
-
-//
-// List operation procedures.
-//
-
-Object *
-proc_car(Object *args) {
-    if (args == obj_nil) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
-    }
-    Object *obj = eval(args->car);
-    if (obj->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong argument type\n");
-        return obj_nil;
-    }
-    return obj->car;
-}
-
-Object *
-proc_cdr(Object *args) {
-    if (args == obj_nil) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
-    }
-    Object *obj = eval(args->car);
-    if (obj->type != OBJ_TYPE_PAIR) {
-        fprintf(stderr, "error: wrong argument type\n");
-        return obj_nil;
-    }
-    return obj->cdr;
-}
-
-Object *
-proc_cons(Object *args) {
-    if (args == obj_nil || args->cdr == obj_nil) {
-        fprintf(stderr, "error: not enough arguments\n");
-        return obj_nil;
-    }
-    Object *a = eval(args->car);
-    Object *b = eval(args->cdr->car);
-    return make_pair(a, b);
-}
-
-Object *
-proc_list(Object *args) {
-    if (args == obj_nil) {
-        return obj_nil;
-    }
-    Object *head = make_pair(eval(args->car), obj_nil);
-    Object *curr = head;
-    args = args->cdr;
-    while (args != obj_nil) {
-        curr->cdr = make_pair(eval(args->car), obj_nil);
-        curr = curr->cdr;
-        args = args->cdr;
-    }
-    return head;
-}
-
-//
-// Polymorphic procedures.
-//
-
-Object *
-proc_equal(Object *args) {
-    // TODO: stub
-    (void) args;
-    return NULL;
-}
-
-// TODO: fixnum left/right shift, mask, invert
-// TODO: implement and test missing procedures
-// TODO: add primitives for type transforms: string->symbol, symbol->string, etc
-// TODO: properly implement nested environments
-// TODO: implement support for quotes and semi-quotes
-// TODO: LAMBDA
-// TODO: let
-// TODO: better error handling?
-// TODO: Revise all instances where we are returning an object, since currently
-// we may be returning a pointer to an object instead of a new one. Check also
-// on eval function and everytime we do make_xxx(obj).
-- 
cgit v1.2.1