| @@ -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." | |||
| @@ -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)) | |||
| @@ -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)), | |||
| @@ -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) { \ | |||
| @@ -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(); | |||
| @@ -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; | |||
| @@ -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; | |||
| } | |||
| @@ -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; | |||
| @@ -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<Lisp_Object* (Lisp_Object*, Environment*)> 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; | |||
| } | |||
| } | |||
| @@ -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); | |||
| } | |||
| } | |||
| @@ -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; | |||
| } | |||