From c8807a04b2a21ab34071e8fa640c416d82e5b474 Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Tue, 23 Apr 2019 21:20:46 +0200 Subject: [PATCH] cleanup and sicp file, but crashes --- bin/pre.slime | 17 ++- bin/tests/sicp.slime | 340 ++++++++++++++++++++++++++++++++++++++++++ src/built_ins.cpp | 43 ++++-- src/defines.cpp | 12 +- src/error.cpp | 5 +- src/eval.cpp | 103 +++++-------- src/forward_decls.cpp | 3 +- src/io.cpp | 7 +- src/memory.cpp | 53 ++++--- src/parse.cpp | 40 +++-- src/testing.cpp | 5 +- 11 files changed, 498 insertions(+), 130 deletions(-) create mode 100644 bin/tests/sicp.slime diff --git a/bin/pre.slime b/bin/pre.slime index fe6b0c5..7e14df8 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -41,14 +41,15 @@ ;; (print "\nbb\n") ;; (pair 'define (pair name value))))) -;; (define-syntax cond (:rest clauses) -;; (define (rec clauses) -;; (if (= nil clauses) -;; nil -;; (list 'if (first (first clauses)) -;; (pair 'prog (rest (first clauses))) -;; (rec (rest clauses))))) -;; (rec clauses)) +;; TODO(Felix): else symbol +(define-syntax (cond :rest clauses) + (define (rec clauses) + (if (= nil clauses) + nil + (list 'if (first (first clauses)) + (pair 'prog (rest (first clauses))) + (rec (rest clauses))))) + (rec clauses)) (define (nil? x) "Checks if the argument is nil." diff --git a/bin/tests/sicp.slime b/bin/tests/sicp.slime new file mode 100644 index 0000000..16cf022 --- /dev/null +++ b/bin/tests/sicp.slime @@ -0,0 +1,340 @@ +(define (abs x) + (cond ((< x 0) (- x)) + (t x))) + +(assert (= (abs 1) 1)) +(assert (= (abs (- 2)) 2)) + + +(define (abs x) + (if (< x 0) + (- x) + x)) + +(assert (= (abs 12) 12)) +(assert (= (abs (- 32)) 32)) + + +(define (>= x y) + (or (> x y) + (= x y))) + +(assert (>= 2 2)) +(assert (>= 3 2)) +(assert (not (>= 1 2))) +(assert (not (>= 12 44))) + + +(define (>= x y) + (not (< x y))) + +(assert (>= 2 2)) +(assert (>= 3 2)) +(assert (not (>= 1 2))) +(assert (not (>= 12 44))) + + +(define (a-plus-abs-b a b) + ((if (> b 0) + -) a b)) + +(assert (= (a-plus-abs-b 1 2) 3)) +(assert (= (a-plus-abs-b 1 -2) 3)) + +(define (square x) (* x x)) +(define (cube x) (* x x x)) + +(assert (= ((lambda (x y z) + (+ x y (square z))) + 1 2 3) + 12)) + +;;; -------------------- +;;; newtons method +;;; -------------------- + +(define tolerance 0.001) + +(define (square x) + (* x x)) + +(define (average x y) + (/ (+ x y) 2)) + +(define (improve guess x) + (average guess (/ x guess))) + +(define (good-enough? guess x) + (< (abs (- (square guess) x)) tolerance)) + +(define (sqrt-iter guess x) + (if (good-enough? guess x) + guess + (sqrt-iter (improve guess x) x))) + +(define (sqrt x) + (sqrt-iter 1.0 x)) + +(define (sqrt2 x) + (define (good-enough? guess x) + (< (abs (- (square guess) x)) 0.001)) + + (define (improve guess x) + (average guess (/ x guess))) + + (define (sqrt-iter guess x) + (if (good-enough? guess x) + guess + (sqrt-iter (improve guess x) x))) + + (sqrt-iter 1.0 x)) + +(define (sqrt3 x) + (define (good-enough? guess) + (< (abs (- (square guess) x)) 0.001)) + + (define (improve guess) + (average guess (/ x guess))) + + (define (sqrt-iter guess) + (if (good-enough? guess) + guess + (sqrt-iter (improve guess)))) + + (sqrt-iter 1.0)) + +(assert (< (abs (- 3 (sqrt 9))) tolerance)) +(assert (< (abs (- 4 (sqrt 16))) tolerance)) +(assert (not (< (abs (- 4 (sqrt 15))) tolerance))) + +(assert (< (abs (- 3 (sqrt2 9))) tolerance)) +(assert (< (abs (- 4 (sqrt2 16))) tolerance)) +(assert (not (< (abs (- 4 (sqrt2 15))) tolerance))) + +(assert (< (abs (- 3 (sqrt3 9))) tolerance)) +(assert (< (abs (- 4 (sqrt3 16))) tolerance)) +(assert (not (< (abs (- 4 (sqrt3 15))) tolerance))) + + +;;; ----------------- +;;; factorial +;;; ----------------- + +(define (factorial n) + (if (= n 1) + 1 + (* n (factorial (- n 1))))) + +(define (factorial2 n) + (fact-iter 1 1 n)) + +(define (fact-iter product counter max-count) + (if (> counter max-count) + product + (fact-iter (* counter product) (+ counter 1) max-count))) + +(define (factorial3 n) + (define (iter product counter) + (if (> counter n) + product + (iter (* counter product) (+ counter 1)))) + + (iter 1 1)) + +(assert (= (factorial 6) 720)) +(assert (= (factorial2 6) 720)) +(assert (= (factorial3 6) 720)) + +;;; ---------------- +;;; ackermann +;;; ---------------- + +(define (A m n) + (cond ((= m 0) (+ n 1)) + ((= n 0) (A (- m 1) 1)) + (t (A (- m 1) (A m (- n 1)))))) + +(assert (= (A 0 0) 1)) +(assert (= (A 1 2) 4)) +(assert (= (A 3 1) 13)) + + +;;; --------------- +;;; Fibonacci +;;; --------------- + +(define (fib n) + (cond ((= n 0) 0) + ((= n 1) 1) + (t (+ (fib (- n 1)) (fib (- n 2)))))) + +(define (fib2 n) + (fib-iter 1 0 n)) + +(define (fib-iter a b count) + (if (= count 0) + b + (fib-iter (+ a b) a (- count 1)))) + +(assert (= (fib 2) 1)) +(assert (= (fib 3) 2)) +(assert (= (fib 4) 3)) +(assert (= (fib 5) 5)) +(assert (= (fib 6) 8)) + +(assert (= (fib2 2) 1)) +(assert (= (fib2 3) 2)) +(assert (= (fib2 4) 3)) +(assert (= (fib2 5) 5)) +(assert (= (fib2 6) 8)) + +;;; ------------------ +;;; count change +;;; ------------------ + +;; (define (count-change amount) +;; (define (cc amount kinds-of-coins) +;; (cond ((= amount 0) 1) +;; ((or (< amount 0) (= kinds-of-coins 0)) 0) +;; (t (+ (cc amount (- kinds-of-coins 1)) +;; (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins))))) + +;; (define (first-denomination kinds-of-coins) +;; (cond ((= kinds-of-coins 1) 1) +;; ((= kinds-of-coins 2) 5) +;; ((= kinds-of-coins 3) 10) +;; ((= kinds-of-coins 4) 25) +;; ((= kinds-of-coins 5) 50))) + +;; (cc amount 5)) + +;; (assert (= (count-change 100) 292)) + +;;; -------------------- +;;; exponentiation +;;; -------------------- + +(define (expt b n) + (if (= n 0) + 1 + (* b (expt b (- n 1))))) + +(define (expt2 b n) + (define (expt-iter b counter product) + (if (= counter 0) + product + (expt-iter b (- counter 1) (* b product)))) + + (expt-iter b n 1)) + +(define (fast-expt b n) + (define (even? n) + (= (% n 2) 0)) + + (cond ((= n 0) 1) + ((even? n) (square (fast-expt b (/ n 2)))) + (t (* b (fast-expt b (- n 1)))))) + +(assert (= (expt 1 2) 1)) +(assert (= (expt 2 2) 4)) +(assert (= (expt 2 3) 8)) + +(assert (= (expt2 1 2) 1)) +(assert (= (expt2 2 2) 4)) +(assert (= (expt2 2 3) 8)) + +(assert (= (fast-expt 1 2) 1)) +(assert (= (fast-expt 2 2) 4)) +(assert (= (fast-expt 2 3) 8)) + +;;; ---------- +;;; gcd +;;; ---------- + +(define (gcd a b) + (if (= b 0) + a + (gcd b (% a b)))) + +(assert (= (gcd 40 6) 2)) +(assert (= (gcd 13 4) 1)) + + +;;; ---------- +;;; primes +;;; ---------- + +(define (smallest-divisor n) + (find-divisor n 2)) + +(define (find-divisor n test-divisor) + (cond ((> (square test-divisor) n) n) + ((divides? test-divisor n) test-divisor) + (t (find-divisor n (+ test-divisor 1))))) + +(define (divides? a b) + (= (% b a) 0)) + +(define (prime? n) + (= n (smallest-divisor n))) + +(assert (prime? 13)) +(assert (prime? 11)) +(assert (not (prime? 12))) + + +;;; ---------------------- +;;; simple integral +;;; ---------------------- + +(define (sum term a next b) + (if (> a b) + 0 + (+ (term a) (sum term (next a) next b)))) + +(define (integral f a b dx) + (define (add-dx x) (+ x dx)) + (* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) + +(define (pi-sum a b) + (define (pi-term x) (/ 1.0 (* x (+ x 2)))) + (define (pi-next x) (+ x 4)) + (sum pi-term a pi-next b)) + +(assert (< (abs (- (* 8 (pi-sum 1 100)) 3.121595)) 0.0001)) +(assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001)) + + +;; ------------------------------------------------------------ +;; F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y) +;; ------------------------------------------------------------ + +(define (f x y) + (let ((a (+ 1 (* x y))) + (b (- 1 y))) + (+ (* x (square a)) + (* y b) + (* a b)))) + +(assert (= (f 0 0) 1)) +(assert (= (f 1 1) 4)) + + +;;; --------------- +;;; find zero +;;; --------------- + +(define (positive? x) (< 0 x)) +(define (negative? x) (< x 0)) + +(define (search f neg-point pos-point) + (let ((midpoint (average neg-point pos-point))) + (if (close-enough? neg-point pos-point) + midpoint + (let ((test-value (f midpoint))) + (cond ((positive? test-value) (search f neg-point midpoint)) + ((negative? test-value) (search f midpoint pos-point)) + (t midpoint)))))) + +(define (close-enough? x y) (< (abs (- x y)) 0.001)) + +(assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1)) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 9d5a82e..2e304c9 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -61,7 +61,8 @@ proc load_built_ins_into_environment(Environment* env) -> void { proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* { // Function* function = new(Function); - Lisp_Object* ret = Memory::create_lisp_object(); + Lisp_Object* ret; + try ret = Memory::create_lisp_object(); Memory::set_type(ret, Lisp_Object_Type::Function); ret->value.function.parent_environment = env; @@ -96,7 +97,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { // we are now in the function body, just wrap it in an // implicit prog - ret->value.function.body = Memory::create_lisp_object_pair( + try ret->value.function.body = Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("prog"), arguments); @@ -207,7 +208,6 @@ proc load_built_ins_into_environment(Environment* env) -> void { sum += arguments->value.pair.first->value.number; arguments = arguments->value.pair.rest; } - return Memory::create_lisp_object_number(sum); }); defun("-", cLambda { @@ -217,8 +217,9 @@ proc load_built_ins_into_environment(Environment* env) -> void { double difference = arguments->value.pair.first->value.number; - if (arguments_length == 1) + if (arguments_length == 1) { return Memory::create_lisp_object_number(-difference); + } arguments = arguments->value.pair.rest; while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { @@ -277,6 +278,22 @@ proc load_built_ins_into_environment(Environment* env) -> void { return Memory::create_lisp_object_number(pow(base, exponent)); }); + defun("%", cLambda { + int arguments_length; + try arguments = eval_arguments(arguments, env, &arguments_length); + try assert_arguments_length(2, arguments_length); + try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); + + double a = arguments->value.pair.first->value.number; + + arguments = arguments->value.pair.rest; + + try assert_type(arguments->value.pair.first, Lisp_Object_Type::Number); + + double b = arguments->value.pair.first->value.number; + + return Memory::create_lisp_object_number((int)a % (int)b); + }); defun("assert", cLambda { int arguments_length; @@ -321,7 +338,8 @@ proc load_built_ins_into_environment(Environment* env) -> void { try assert_type(real_symbol, Lisp_Object_Type::Symbol); - Lisp_Object* fake_lambda = Memory::create_lisp_object_pair( + Lisp_Object* fake_lambda; + try fake_lambda = Memory::create_lisp_object_pair( symbol ->value.pair.rest, arguments->value.pair.rest); @@ -417,10 +435,11 @@ proc load_built_ins_into_environment(Environment* env) -> void { //NOTE(Felix): Of fucking course we have to copy the // list. The quasiquote will be part of the body of a - // funciton, we can't jsut modify it because otherwise + // funciton, we can't just modify it because otherwise // we modify the body of the function and would bake // in the result... - Lisp_Object* newPair = Memory::create_lisp_object_pair(nullptr, nullptr); + Lisp_Object* newPair; + try newPair = Memory::create_lisp_object_pair(nullptr, nullptr); Lisp_Object* newPairHead = newPair; Lisp_Object* head = expr; while (Memory::get_type(head) == Lisp_Object_Type::Pair) { @@ -429,7 +448,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) break; - newPairHead->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); + try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); newPairHead = newPairHead->value.pair.rest; head = head->value.pair.rest; @@ -604,9 +623,11 @@ proc load_built_ins_into_environment(Environment* env) -> void { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); try assert_arguments_length(2, arguments_length); - return Memory::create_lisp_object_pair( + Lisp_Object* ret; + try ret = Memory::create_lisp_object_pair( evaluated_arguments->value.pair.first, evaluated_arguments->value.pair.rest->value.pair.first); + return ret; }); defun("first", cLambda { try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); @@ -658,6 +679,7 @@ proc load_built_ins_into_environment(Environment* env) -> void { } Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first); + switch (type) { case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); case Lisp_Object_Type::Function: { @@ -686,7 +708,8 @@ proc load_built_ins_into_environment(Environment* env) -> void { print(arguments->value.pair.first); - Lisp_Object* type = eval_expr( + Lisp_Object* type; + try type = eval_expr( Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("type"), Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)), diff --git a/src/defines.cpp b/src/defines.cpp index 13d9e01..37671de 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -29,7 +29,7 @@ constexpr bool is_debug_build = false; while (1) \ if (1) { \ if(Globals::error) { \ - if (log_level == Log_Level::Debug) { \ + if (Globals::log_level == Log_Level::Debug) { \ printf("in %s:%d\n", __FILE__, __LINE__); \ } \ return 0; \ @@ -45,7 +45,7 @@ constexpr bool is_debug_build = false; while (1) \ if (1) { \ if(Globals::error) { \ - if (log_level == Log_Level::Debug) { \ + if (Globals::log_level == Log_Level::Debug) { \ printf("in %s:%d\n", __FILE__, __LINE__); \ } \ return; \ @@ -59,15 +59,15 @@ constexpr bool is_debug_build = false; if (0) \ label(finished,__LINE__): ; \ else \ - for (Log_Level log_level_before = log_level;;) \ - for(log_level = Log_Level::None;;) \ + for (Log_Level log_level_before = Globals::log_level;;) \ + for(Globals::log_level = Log_Level::None;;) \ if (1) { \ goto label(body,__LINE__); \ } \ else \ while (1) \ if (1) { \ - log_level = log_level_before; \ + Globals::log_level = log_level_before; \ goto label(finished,__LINE__); \ } \ else label(body,__LINE__): @@ -184,7 +184,6 @@ struct { } \ } while(0) -// TODO(Felix): Shouldn't it be expected > actual here #define assert_arguments_length_less_equal(expected, actual) \ do { \ if (expected < actual) { \ @@ -192,7 +191,6 @@ struct { } \ } while(0) -// TODO(Felix): Shouldn't it be expected < actual here #define assert_arguments_length_greater_equal(expected, actual) \ do { \ if (expected > actual) { \ diff --git a/src/error.cpp b/src/error.cpp index 906a81c..35bd121 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -8,9 +8,8 @@ proc delete_error() -> void { } proc create_error(const char* c_file_name, int c_file_line, Lisp_Object* type, String* message) -> void { - if_debug { - printf("Error created in:\n%s:%d\n", c_file_name, c_file_line); - } + + printf("Error created in:\n%s:%d\n", c_file_name, c_file_line); delete_error(); debug_break(); diff --git a/src/eval.cpp b/src/eval.cpp index a5f1f38..5cbf120 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -1,5 +1,6 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { Environment* new_env = Memory::create_child_environment(function->parent_environment); + Lisp_Object* sym, *val; // used as temp storage to use `try` // positional arguments for (int i = 0; i < function->positional_arguments->next_index; ++i) { @@ -10,9 +11,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // TODO(Felix): here we create new lisp_object_symbols from // their identifiers but before we converted them to // strings from symbols... Wo maybe just use the symbols? - define_symbol( - Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]), - arguments->value.pair.first, new_env); + + try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]); + define_symbol(sym, arguments->value.pair.first, new_env); arguments = arguments->value.pair.rest; } @@ -77,10 +78,8 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> } // if not set it and then add it to the array list - define_symbol( - Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier), - arguments->value.pair.rest->value.pair.first, - new_env); + try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier), + define_symbol(sym, arguments->value.pair.rest->value.pair.first, new_env); append_to_array_list(read_in_keywords, arguments->value.pair.first->value.identifier); @@ -119,9 +118,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> // this one does have a default value, lets see if we have // to use it or if the user supplied his own if (!was_set) { - define_symbol( - Memory::get_or_create_lisp_object_symbol(defined_keyword), - Memory::copy_lisp_object(function->keyword_arguments->values->data[i]), new_env); + try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword); + try val = Memory::copy_lisp_object(function->keyword_arguments->values->data[i]); + define_symbol(sym, val, new_env); } } } @@ -129,15 +128,13 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> if (arguments == Memory::nil) { if (function->rest_argument) { - define_symbol( - Memory::get_or_create_lisp_object_symbol(function->rest_argument), - Memory::nil, new_env); + try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); + define_symbol(sym, Memory::nil, new_env); } } else { if (function->rest_argument) { - define_symbol( - Memory::get_or_create_lisp_object_symbol(function->rest_argument), - arguments, new_env); + try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); + define_symbol(sym, arguments, new_env); } else { // rest was not declared but additional arguments were found create_generic_error( @@ -147,14 +144,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> } } - Lisp_Object* result; - try { - result = eval_expr(function->body, new_env); - } - + try result = eval_expr(function->body, new_env); return result; - } /* @@ -345,19 +337,20 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments return arguments; } - Lisp_Object* evaluated_arguments = Memory::create_lisp_object_pair(nullptr, nullptr); + Lisp_Object* evaluated_arguments; + try evaluated_arguments = Memory::create_lisp_object_pair(nullptr, nullptr); + Lisp_Object* evaluated_arguments_head = evaluated_arguments; Lisp_Object* current_head = arguments; + while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { - try { - evaluated_arguments_head->value.pair.first = - eval_expr(current_head->value.pair.first, env); - } + try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first, env); + evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation; current_head = current_head->value.pair.rest; if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { - evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); + try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; } else if (current_head == Memory::nil) { evaluated_arguments_head->value.pair.rest = current_head; @@ -383,9 +376,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { return node; case Lisp_Object_Type::Symbol: { Lisp_Object* symbol; - try { - symbol = lookup_symbol(node, env); - } + try symbol = lookup_symbol(node, env); + return symbol; } case Lisp_Object_Type::Pair: { @@ -394,11 +386,9 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) { - try { - lispOperator = eval_expr(node->value.pair.first, env); - } + try lispOperator = eval_expr(node->value.pair.first, env); } else { - lispOperator = node->value.pair.first; + lispOperator = node->value.pair.first; } Lisp_Object* arguments = node->value.pair.rest; @@ -415,15 +405,11 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { // only for lambdas we evaluate the arguments before // apllying if (lispOperator->value.function.type == Function_Type::Lambda) { - try { - arguments = eval_arguments(arguments, env, &arguments_length); - } + try arguments = eval_arguments(arguments, env, &arguments_length); } Lisp_Object* result; - try { - result = apply_arguments_to_function(arguments, &lispOperator->value.function); - } + try result = apply_arguments_to_function(arguments, &lispOperator->value.function); return result; } } @@ -434,14 +420,10 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { } } -proc is_truthy (Lisp_Object* expression, Environment* env) -> bool { +proc is_truthy(Lisp_Object* expression, Environment* env) -> bool { Lisp_Object* result; - try { - result = eval_expr(expression, env); - } - if (result == Memory::nil) - return false; - return true; + try result = eval_expr(expression, env); + return result != Memory::nil; } proc interprete_file (char* file_name) -> Lisp_Object* { @@ -449,28 +431,25 @@ proc interprete_file (char* file_name) -> Lisp_Object* { Environment* env = Memory::create_empty_environment(); Parser::init(env); - char* file_content = read_entire_file(file_name); - if (!file_content) { - create_generic_error("The file '%s' could not be read.", file_name); - } + char* file_content; + try file_content = read_entire_file(file_name); load_built_ins_into_environment(env); - try { - built_in_load(Memory::create_string("pre.slime"), env); - } + built_in_load(Memory::create_string("pre.slime"), env); Lisp_Object_Array_List* program; - try { - program = Parser::parse_program( - Memory::create_string(file_name), file_content); - } + program = Parser::parse_program(Memory::create_string(file_name), file_content); Lisp_Object* result = Memory::nil; for (int i = 0; i < program->next_index; ++i) { - try { - result = eval_expr(program->data[i], env); - } + result = eval_expr(program->data[i], env); + + if (Globals::error) { + log_error(); + delete_error(); + return nullptr; + } } return result; diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index 53585ca..237c916 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -19,6 +19,7 @@ namespace Memory { } namespace Globals { + Log_Level log_level = Log_Level::Debug; Lisp_Object* current_source_code = nullptr; - Error* error; + Error* error = nullptr; } diff --git a/src/io.cpp b/src/io.cpp index 2d95825..187b99a 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -111,6 +111,8 @@ proc read_entire_file(char* filename) -> char* { } closeFile: fclose(fp); + } else { + create_generic_error("The file '%s' could not be read.", filename); } return fileContent; @@ -205,11 +207,8 @@ proc read_line() -> char* { return linep; } - -Log_Level log_level = Log_Level::Debug; - proc log_message(Log_Level type, char* message) -> void { - if (type > log_level) + if (type > Globals::log_level) return; const char* prefix; diff --git a/src/memory.cpp b/src/memory.cpp index dd7e177..5b5209e 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -151,11 +151,11 @@ namespace Memory { next_free_spot_in_string_memory = string_memory; // init nil - nil = create_lisp_object(); + try nil = create_lisp_object(); set_type(nil, Lisp_Object_Type::Nil); // init t - t = create_lisp_object(); + try t = create_lisp_object(); set_type(t, Lisp_Object_Type::T); } @@ -167,21 +167,24 @@ namespace Memory { } proc create_lisp_object_number(double number) -> Lisp_Object* { - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Number); node->value.number = number; return node; } proc create_lisp_object_string(String* str) -> Lisp_Object* { - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::String); node->value.string = str; return node; } proc create_lisp_object_string(const char* str) -> Lisp_Object* { - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::String); node->value.string = create_string(str); return node; @@ -190,7 +193,8 @@ namespace Memory { proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { // TODO(Felix): if we already have it stored somewhere then // reuse it and dont create new one - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Symbol); // node->value.symbol = new(Symbol); node->value.identifier = identifier; @@ -208,7 +212,8 @@ namespace Memory { proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* { // TODO(Felix): if we already have it stored somewhere then // reuse it and dont create new one - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Keyword); // node->value.keyword = new(Keyword); node->value.identifier = keyword; @@ -224,7 +229,8 @@ namespace Memory { } proc create_lisp_object_cfunction(std::function function) -> Lisp_Object* { - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::CFunction); // node->value.lambdaWrapper = new Lambda_Wrapper(function); node->value.cFunction = new(cFunction); @@ -233,7 +239,8 @@ namespace Memory { } proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* { - Lisp_Object* node = create_lisp_object(); + Lisp_Object* node; + try node = create_lisp_object(); set_type(node, Lisp_Object_Type::Pair); // node->value.pair = new(Pair); node->value.pair.first = first; @@ -242,7 +249,8 @@ namespace Memory { } proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { - Lisp_Object* target = create_lisp_object(); + Lisp_Object* target; + try target = create_lisp_object(); *target = *n; return target; } @@ -272,27 +280,38 @@ namespace Memory { } inline proc create_list(Lisp_Object* o1) -> Lisp_Object* { - return create_lisp_object_pair(o1, nil); + Lisp_Object* ret; + try ret = create_lisp_object_pair(o1, nil); + return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2) -> Lisp_Object* { - return create_lisp_object_pair(o1, create_list(o2)); + Lisp_Object* ret; + try ret = create_lisp_object_pair(o1, create_list(o2)); + return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3) -> Lisp_Object* { - return create_lisp_object_pair(o1, create_list(o2, o3)); + Lisp_Object* ret; + try ret = create_lisp_object_pair(o1, create_list(o2, o3)); + return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4) -> Lisp_Object* { - return create_lisp_object_pair(o1, create_list(o2, o3, o4)); + Lisp_Object* ret; + try ret = create_lisp_object_pair(o1, create_list(o2, o3, o4)); + return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5) -> Lisp_Object* { - return create_lisp_object_pair(o1, create_list(o2, o3, o4, o5)); + Lisp_Object* ret; + try ret = create_lisp_object_pair(o1, create_list(o2, o3, o4, o5)); + return ret; } inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5, Lisp_Object* o6) -> Lisp_Object* { - return create_lisp_object_pair(o1, create_list(o2, o3, o4, o5, o6)); + Lisp_Object* ret; + try ret = create_lisp_object_pair(o1, create_list(o2, o3, o4, o5, o6)); + return ret; } - } diff --git a/src/parse.cpp b/src/parse.cpp index 7820320..6d1f745 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -111,7 +111,8 @@ namespace Parser { // dont create a String first String* str_number = read_atom(text, index_in_text); sscanf(Memory::get_c_str(str_number), "%lf", &number); - Lisp_Object* ret = Memory::create_lisp_object_number(number); + Lisp_Object* ret; + try ret = Memory::create_lisp_object_number(number); inject_scl(ret); return ret; @@ -122,7 +123,8 @@ namespace Parser { ++(*index_in_text); ++parser_col; String* str_keyword = read_atom(text, index_in_text); - Lisp_Object* ret = Memory::get_or_create_lisp_object_keyword(str_keyword); + Lisp_Object* ret; + try ret = Memory::get_or_create_lisp_object_keyword(str_keyword); inject_scl(ret); return ret; @@ -131,7 +133,9 @@ namespace Parser { proc parse_symbol(char* text, int* index_in_text) -> Lisp_Object* { // we are now at the first char of the symbol String* str_symbol = read_atom(text, index_in_text); - Lisp_Object* ret = Memory::get_or_create_lisp_object_symbol(str_symbol); + Lisp_Object* ret; + try ret = Memory::get_or_create_lisp_object_symbol(str_symbol); + inject_scl(ret); return ret; } @@ -144,7 +148,8 @@ namespace Parser { // now we are at the first letter, if this is the closing '"' then // it's easy if (text[*index_in_text] == '"') { - Lisp_Object* ret = Memory::create_lisp_object_string( + Lisp_Object* ret; + try ret = Memory::create_lisp_object_string( Memory::create_string("", 0)); inject_scl(ret); @@ -200,7 +205,9 @@ namespace Parser { } } - Lisp_Object* ret = Memory::create_lisp_object_string(string); + Lisp_Object* ret; + try ret = Memory::create_lisp_object_string(string); + inject_scl(ret); return ret; } @@ -259,16 +266,17 @@ namespace Parser { } Lisp_Object* ret = nullptr; + // TODO(Felix): use Memory::create_list() here if (quoteType == '\'') - ret = Memory::create_lisp_object_pair( + try ret = Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("quote"), Memory::create_lisp_object_pair(result, Memory::nil)); else if (quoteType == '`') - ret = Memory::create_lisp_object_pair( + try ret = Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("quasiquote"), Memory::create_lisp_object_pair(result, Memory::nil)); else if (quoteType == ',') - ret = Memory::create_lisp_object_pair( + try ret = Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("unquote"), Memory::create_lisp_object_pair(result, Memory::nil)); inject_scl(ret); @@ -291,7 +299,8 @@ namespace Parser { } // okay there is something - Lisp_Object* head = Memory::create_lisp_object(); + Lisp_Object* head; + try head = Memory::create_lisp_object(); Memory::set_type(head, Lisp_Object_Type::Pair); // head->value.pair = new(Pair); Lisp_Object* expression = head; @@ -346,7 +355,7 @@ namespace Parser { ++(*index_in_text); break; } else { - head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); + try head->value.pair.rest = Memory::create_lisp_object_pair(nullptr, nullptr); head = head->value.pair.rest; } } @@ -377,7 +386,8 @@ namespace Parser { arguments = arguments->value.pair.first->value.pair.rest; // Function* function = new(Function); - Lisp_Object* macro = Memory::create_lisp_object(); + Lisp_Object* macro; + try macro = Memory::create_lisp_object(); Memory::set_type(macro, Lisp_Object_Type::Function); macro->value.function.parent_environment = environment_for_macros; macro->value.function.type = Function_Type::Macro; @@ -403,7 +413,7 @@ namespace Parser { // we are now in the function body, just wrap it in an // implicit prog - macro->value.function.body = Memory::create_lisp_object_pair( + try macro->value.function.body = Memory::create_lisp_object_pair( Memory::get_or_create_lisp_object_symbol("prog"), body); @@ -510,12 +520,12 @@ namespace Parser { ++end_pos; text[end_pos] = '\0'; - Lisp_Object* str = Memory::create_lisp_object_string( + Lisp_Object* str; + try str = Memory::create_lisp_object_string( Memory::create_string(text+index_in_text)); text[end_pos] = '\n'; - return Memory::create_list( - Memory::get_or_create_lisp_object_symbol(bare), str); + return Memory::create_list(Memory::get_or_create_lisp_object_symbol(bare), str); } } diff --git a/src/testing.cpp b/src/testing.cpp index 7197b45..7b793b7 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -501,7 +501,7 @@ proc test_file(const char* file) -> testresult { } proc run_all_tests() -> bool { - Memory::init(4096 * 2, 4096 * 16); + Memory::init(4096 * 2000, 4096 * 16); Parser::init(Memory::create_built_ins_environment()); bool result = true; @@ -527,12 +527,11 @@ proc run_all_tests() -> bool { printf("\n-- Memory management --\n"); invoke_test(test_singular_t_and_nil); - printf("\n-- Macros --\n"); - printf("\n-- Test Files --\n"); invoke_test_script("lexical_scope"); invoke_test_script("class_macro"); + invoke_test_script("sicp"); return result; }