From 4e4d5373328276ea6d49a60242555d5db03158ff Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Sun, 10 Oct 2021 14:48:30 +0200 Subject: Add numerical comparison primitive procedures --- examples/booleans.bdl | 14 ++++ src/bootstrap/main.c | 5 ++ src/bootstrap/primitives.c | 173 +++++++++++++++++++++++++++++++++++++++++++- tests/booleans_expected.txt | 12 +++ 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 -- cgit v1.2.1