| @@ -41,14 +41,15 @@ | |||||
| ;; (print "\nbb\n") | ;; (print "\nbb\n") | ||||
| ;; (pair 'define (pair name value))))) | ;; (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) | (define (nil? x) | ||||
| "Checks if the argument is nil." | "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* { | proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env, bool is_special = false) -> Lisp_Object* { | ||||
| // Function* function = new(Function); | // 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); | Memory::set_type(ret, Lisp_Object_Type::Function); | ||||
| ret->value.function.parent_environment = env; | 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 | // we are now in the function body, just wrap it in an | ||||
| // implicit prog | // 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"), | Memory::get_or_create_lisp_object_symbol("prog"), | ||||
| arguments); | arguments); | ||||
| @@ -207,7 +208,6 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| sum += arguments->value.pair.first->value.number; | sum += arguments->value.pair.first->value.number; | ||||
| arguments = arguments->value.pair.rest; | arguments = arguments->value.pair.rest; | ||||
| } | } | ||||
| return Memory::create_lisp_object_number(sum); | return Memory::create_lisp_object_number(sum); | ||||
| }); | }); | ||||
| defun("-", cLambda { | defun("-", cLambda { | ||||
| @@ -217,8 +217,9 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| double difference = arguments->value.pair.first->value.number; | double difference = arguments->value.pair.first->value.number; | ||||
| if (arguments_length == 1) | |||||
| if (arguments_length == 1) { | |||||
| return Memory::create_lisp_object_number(-difference); | return Memory::create_lisp_object_number(-difference); | ||||
| } | |||||
| arguments = arguments->value.pair.rest; | arguments = arguments->value.pair.rest; | ||||
| while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) { | 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)); | 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 { | defun("assert", cLambda { | ||||
| int arguments_length; | 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); | 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, | symbol ->value.pair.rest, | ||||
| arguments->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 | //NOTE(Felix): Of fucking course we have to copy the | ||||
| // list. The quasiquote will be part of the body of a | // 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 | // we modify the body of the function and would bake | ||||
| // in the result... | // 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* newPairHead = newPair; | ||||
| Lisp_Object* head = expr; | Lisp_Object* head = expr; | ||||
| while (Memory::get_type(head) == Lisp_Object_Type::Pair) { | 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) | if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) | ||||
| break; | 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; | newPairHead = newPairHead->value.pair.rest; | ||||
| head = head->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 evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | ||||
| try assert_arguments_length(2, 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.first, | ||||
| evaluated_arguments->value.pair.rest->value.pair.first); | evaluated_arguments->value.pair.rest->value.pair.first); | ||||
| return ret; | |||||
| }); | }); | ||||
| defun("first", cLambda { | defun("first", cLambda { | ||||
| try evaluated_arguments = eval_arguments(arguments, env, &arguments_length); | 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); | Lisp_Object_Type type = Memory::get_type(evaluated_arguments->value.pair.first); | ||||
| switch (type) { | switch (type) { | ||||
| case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); | case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction"); | ||||
| case Lisp_Object_Type::Function: { | case Lisp_Object_Type::Function: { | ||||
| @@ -686,7 +708,8 @@ proc load_built_ins_into_environment(Environment* env) -> void { | |||||
| print(arguments->value.pair.first); | print(arguments->value.pair.first); | ||||
| Lisp_Object* type = eval_expr( | |||||
| Lisp_Object* type; | |||||
| try type = eval_expr( | |||||
| Memory::create_lisp_object_pair( | Memory::create_lisp_object_pair( | ||||
| Memory::get_or_create_lisp_object_symbol("type"), | Memory::get_or_create_lisp_object_symbol("type"), | ||||
| Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)), | Memory::create_lisp_object_pair(arguments->value.pair.first, Memory::nil)), | ||||
| @@ -29,7 +29,7 @@ constexpr bool is_debug_build = false; | |||||
| while (1) \ | while (1) \ | ||||
| if (1) { \ | if (1) { \ | ||||
| if(Globals::error) { \ | if(Globals::error) { \ | ||||
| if (log_level == Log_Level::Debug) { \ | |||||
| if (Globals::log_level == Log_Level::Debug) { \ | |||||
| printf("in %s:%d\n", __FILE__, __LINE__); \ | printf("in %s:%d\n", __FILE__, __LINE__); \ | ||||
| } \ | } \ | ||||
| return 0; \ | return 0; \ | ||||
| @@ -45,7 +45,7 @@ constexpr bool is_debug_build = false; | |||||
| while (1) \ | while (1) \ | ||||
| if (1) { \ | if (1) { \ | ||||
| if(Globals::error) { \ | if(Globals::error) { \ | ||||
| if (log_level == Log_Level::Debug) { \ | |||||
| if (Globals::log_level == Log_Level::Debug) { \ | |||||
| printf("in %s:%d\n", __FILE__, __LINE__); \ | printf("in %s:%d\n", __FILE__, __LINE__); \ | ||||
| } \ | } \ | ||||
| return; \ | return; \ | ||||
| @@ -59,15 +59,15 @@ constexpr bool is_debug_build = false; | |||||
| if (0) \ | if (0) \ | ||||
| label(finished,__LINE__): ; \ | label(finished,__LINE__): ; \ | ||||
| else \ | 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) { \ | if (1) { \ | ||||
| goto label(body,__LINE__); \ | goto label(body,__LINE__); \ | ||||
| } \ | } \ | ||||
| else \ | else \ | ||||
| while (1) \ | while (1) \ | ||||
| if (1) { \ | if (1) { \ | ||||
| log_level = log_level_before; \ | |||||
| Globals::log_level = log_level_before; \ | |||||
| goto label(finished,__LINE__); \ | goto label(finished,__LINE__); \ | ||||
| } \ | } \ | ||||
| else label(body,__LINE__): | else label(body,__LINE__): | ||||
| @@ -184,7 +184,6 @@ struct { | |||||
| } \ | } \ | ||||
| } while(0) | } while(0) | ||||
| // TODO(Felix): Shouldn't it be expected > actual here | |||||
| #define assert_arguments_length_less_equal(expected, actual) \ | #define assert_arguments_length_less_equal(expected, actual) \ | ||||
| do { \ | do { \ | ||||
| if (expected < actual) { \ | if (expected < actual) { \ | ||||
| @@ -192,7 +191,6 @@ struct { | |||||
| } \ | } \ | ||||
| } while(0) | } while(0) | ||||
| // TODO(Felix): Shouldn't it be expected < actual here | |||||
| #define assert_arguments_length_greater_equal(expected, actual) \ | #define assert_arguments_length_greater_equal(expected, actual) \ | ||||
| do { \ | do { \ | ||||
| if (expected > actual) { \ | 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 { | 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(); | delete_error(); | ||||
| debug_break(); | debug_break(); | ||||
| @@ -1,5 +1,6 @@ | |||||
| proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { | proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* { | ||||
| Environment* new_env = Memory::create_child_environment(function->parent_environment); | Environment* new_env = Memory::create_child_environment(function->parent_environment); | ||||
| Lisp_Object* sym, *val; // used as temp storage to use `try` | |||||
| // positional arguments | // positional arguments | ||||
| for (int i = 0; i < function->positional_arguments->next_index; ++i) { | 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 | // TODO(Felix): here we create new lisp_object_symbols from | ||||
| // their identifiers but before we converted them to | // their identifiers but before we converted them to | ||||
| // strings from symbols... Wo maybe just use the symbols? | // 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; | 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 | // 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); | 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 | // this one does have a default value, lets see if we have | ||||
| // to use it or if the user supplied his own | // to use it or if the user supplied his own | ||||
| if (!was_set) { | 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 (arguments == Memory::nil) { | ||||
| if (function->rest_argument) { | 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 { | } else { | ||||
| if (function->rest_argument) { | 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 { | } else { | ||||
| // rest was not declared but additional arguments were found | // rest was not declared but additional arguments were found | ||||
| create_generic_error( | create_generic_error( | ||||
| @@ -147,14 +144,9 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| } | } | ||||
| } | } | ||||
| Lisp_Object* result; | Lisp_Object* result; | ||||
| try { | |||||
| result = eval_expr(function->body, new_env); | |||||
| } | |||||
| try result = eval_expr(function->body, new_env); | |||||
| return result; | return result; | ||||
| } | } | ||||
| /* | /* | ||||
| @@ -345,19 +337,20 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments | |||||
| return 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* evaluated_arguments_head = evaluated_arguments; | ||||
| Lisp_Object* current_head = arguments; | Lisp_Object* current_head = arguments; | ||||
| while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { | 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; | evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation; | ||||
| current_head = current_head->value.pair.rest; | current_head = current_head->value.pair.rest; | ||||
| if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { | 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; | evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; | ||||
| } else if (current_head == Memory::nil) { | } else if (current_head == Memory::nil) { | ||||
| evaluated_arguments_head->value.pair.rest = current_head; | evaluated_arguments_head->value.pair.rest = current_head; | ||||
| @@ -383,9 +376,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* { | |||||
| return node; | return node; | ||||
| case Lisp_Object_Type::Symbol: { | case Lisp_Object_Type::Symbol: { | ||||
| Lisp_Object* symbol; | Lisp_Object* symbol; | ||||
| try { | |||||
| symbol = lookup_symbol(node, env); | |||||
| } | |||||
| try symbol = lookup_symbol(node, env); | |||||
| return symbol; | return symbol; | ||||
| } | } | ||||
| case Lisp_Object_Type::Pair: { | 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 && | if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && | ||||
| Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) | 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 { | } else { | ||||
| lispOperator = node->value.pair.first; | |||||
| lispOperator = node->value.pair.first; | |||||
| } | } | ||||
| Lisp_Object* arguments = node->value.pair.rest; | 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 | // only for lambdas we evaluate the arguments before | ||||
| // apllying | // apllying | ||||
| if (lispOperator->value.function.type == Function_Type::Lambda) { | 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; | 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; | 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; | 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* { | 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(); | Environment* env = Memory::create_empty_environment(); | ||||
| Parser::init(env); | 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); | 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; | 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; | Lisp_Object* result = Memory::nil; | ||||
| for (int i = 0; i < program->next_index; ++i) { | 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; | return result; | ||||
| @@ -19,6 +19,7 @@ namespace Memory { | |||||
| } | } | ||||
| namespace Globals { | namespace Globals { | ||||
| Log_Level log_level = Log_Level::Debug; | |||||
| Lisp_Object* current_source_code = nullptr; | Lisp_Object* current_source_code = nullptr; | ||||
| Error* error; | |||||
| Error* error = nullptr; | |||||
| } | } | ||||
| @@ -111,6 +111,8 @@ proc read_entire_file(char* filename) -> char* { | |||||
| } | } | ||||
| closeFile: | closeFile: | ||||
| fclose(fp); | fclose(fp); | ||||
| } else { | |||||
| create_generic_error("The file '%s' could not be read.", filename); | |||||
| } | } | ||||
| return fileContent; | return fileContent; | ||||
| @@ -205,11 +207,8 @@ proc read_line() -> char* { | |||||
| return linep; | return linep; | ||||
| } | } | ||||
| Log_Level log_level = Log_Level::Debug; | |||||
| proc log_message(Log_Level type, char* message) -> void { | proc log_message(Log_Level type, char* message) -> void { | ||||
| if (type > log_level) | |||||
| if (type > Globals::log_level) | |||||
| return; | return; | ||||
| const char* prefix; | const char* prefix; | ||||
| @@ -151,11 +151,11 @@ namespace Memory { | |||||
| next_free_spot_in_string_memory = string_memory; | next_free_spot_in_string_memory = string_memory; | ||||
| // init nil | // init nil | ||||
| nil = create_lisp_object(); | |||||
| try nil = create_lisp_object(); | |||||
| set_type(nil, Lisp_Object_Type::Nil); | set_type(nil, Lisp_Object_Type::Nil); | ||||
| // init t | // init t | ||||
| t = create_lisp_object(); | |||||
| try t = create_lisp_object(); | |||||
| set_type(t, Lisp_Object_Type::T); | set_type(t, Lisp_Object_Type::T); | ||||
| } | } | ||||
| @@ -167,21 +167,24 @@ namespace Memory { | |||||
| } | } | ||||
| proc create_lisp_object_number(double number) -> Lisp_Object* { | 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); | set_type(node, Lisp_Object_Type::Number); | ||||
| node->value.number = number; | node->value.number = number; | ||||
| return node; | return node; | ||||
| } | } | ||||
| proc create_lisp_object_string(String* str) -> Lisp_Object* { | 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); | set_type(node, Lisp_Object_Type::String); | ||||
| node->value.string = str; | node->value.string = str; | ||||
| return node; | return node; | ||||
| } | } | ||||
| proc create_lisp_object_string(const char* str) -> Lisp_Object* { | 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); | set_type(node, Lisp_Object_Type::String); | ||||
| node->value.string = create_string(str); | node->value.string = create_string(str); | ||||
| return node; | return node; | ||||
| @@ -190,7 +193,8 @@ namespace Memory { | |||||
| proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { | proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* { | ||||
| // TODO(Felix): if we already have it stored somewhere then | // TODO(Felix): if we already have it stored somewhere then | ||||
| // reuse it and dont create new one | // 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); | set_type(node, Lisp_Object_Type::Symbol); | ||||
| // node->value.symbol = new(Symbol); | // node->value.symbol = new(Symbol); | ||||
| node->value.identifier = identifier; | node->value.identifier = identifier; | ||||
| @@ -208,7 +212,8 @@ namespace Memory { | |||||
| proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* { | proc get_or_create_lisp_object_keyword(String* keyword) -> Lisp_Object* { | ||||
| // TODO(Felix): if we already have it stored somewhere then | // TODO(Felix): if we already have it stored somewhere then | ||||
| // reuse it and dont create new one | // 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); | set_type(node, Lisp_Object_Type::Keyword); | ||||
| // node->value.keyword = new(Keyword); | // node->value.keyword = new(Keyword); | ||||
| node->value.identifier = 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* { | 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); | set_type(node, Lisp_Object_Type::CFunction); | ||||
| // node->value.lambdaWrapper = new Lambda_Wrapper(function); | // node->value.lambdaWrapper = new Lambda_Wrapper(function); | ||||
| node->value.cFunction = new(cFunction); | node->value.cFunction = new(cFunction); | ||||
| @@ -233,7 +239,8 @@ namespace Memory { | |||||
| } | } | ||||
| proc create_lisp_object_pair(Lisp_Object* first, Lisp_Object* rest) -> Lisp_Object* { | 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); | set_type(node, Lisp_Object_Type::Pair); | ||||
| // node->value.pair = new(Pair); | // node->value.pair = new(Pair); | ||||
| node->value.pair.first = first; | node->value.pair.first = first; | ||||
| @@ -242,7 +249,8 @@ namespace Memory { | |||||
| } | } | ||||
| proc copy_lisp_object(Lisp_Object* n) -> Lisp_Object* { | 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; | *target = *n; | ||||
| return target; | return target; | ||||
| } | } | ||||
| @@ -272,27 +280,38 @@ namespace Memory { | |||||
| } | } | ||||
| inline proc create_list(Lisp_Object* o1) -> Lisp_Object* { | 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* { | 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* { | 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* { | 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* { | 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* { | 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 | // dont create a String first | ||||
| String* str_number = read_atom(text, index_in_text); | String* str_number = read_atom(text, index_in_text); | ||||
| sscanf(Memory::get_c_str(str_number), "%lf", &number); | 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); | inject_scl(ret); | ||||
| return ret; | return ret; | ||||
| @@ -122,7 +123,8 @@ namespace Parser { | |||||
| ++(*index_in_text); | ++(*index_in_text); | ||||
| ++parser_col; | ++parser_col; | ||||
| String* str_keyword = read_atom(text, index_in_text); | 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); | inject_scl(ret); | ||||
| return ret; | return ret; | ||||
| @@ -131,7 +133,9 @@ namespace Parser { | |||||
| proc parse_symbol(char* text, int* index_in_text) -> Lisp_Object* { | proc parse_symbol(char* text, int* index_in_text) -> Lisp_Object* { | ||||
| // we are now at the first char of the symbol | // we are now at the first char of the symbol | ||||
| String* str_symbol = read_atom(text, index_in_text); | 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); | inject_scl(ret); | ||||
| return ret; | return ret; | ||||
| } | } | ||||
| @@ -144,7 +148,8 @@ namespace Parser { | |||||
| // now we are at the first letter, if this is the closing '"' then | // now we are at the first letter, if this is the closing '"' then | ||||
| // it's easy | // it's easy | ||||
| if (text[*index_in_text] == '"') { | 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)); | Memory::create_string("", 0)); | ||||
| inject_scl(ret); | 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); | inject_scl(ret); | ||||
| return ret; | return ret; | ||||
| } | } | ||||
| @@ -259,16 +266,17 @@ namespace Parser { | |||||
| } | } | ||||
| Lisp_Object* ret = nullptr; | Lisp_Object* ret = nullptr; | ||||
| // TODO(Felix): use Memory::create_list() here | |||||
| if (quoteType == '\'') | if (quoteType == '\'') | ||||
| ret = Memory::create_lisp_object_pair( | |||||
| try ret = Memory::create_lisp_object_pair( | |||||
| Memory::get_or_create_lisp_object_symbol("quote"), | Memory::get_or_create_lisp_object_symbol("quote"), | ||||
| Memory::create_lisp_object_pair(result, Memory::nil)); | Memory::create_lisp_object_pair(result, Memory::nil)); | ||||
| else if (quoteType == '`') | 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::get_or_create_lisp_object_symbol("quasiquote"), | ||||
| Memory::create_lisp_object_pair(result, Memory::nil)); | Memory::create_lisp_object_pair(result, Memory::nil)); | ||||
| else if (quoteType == ',') | 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::get_or_create_lisp_object_symbol("unquote"), | ||||
| Memory::create_lisp_object_pair(result, Memory::nil)); | Memory::create_lisp_object_pair(result, Memory::nil)); | ||||
| inject_scl(ret); | inject_scl(ret); | ||||
| @@ -291,7 +299,8 @@ namespace Parser { | |||||
| } | } | ||||
| // okay there is something | // 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); | Memory::set_type(head, Lisp_Object_Type::Pair); | ||||
| // head->value.pair = new(Pair); | // head->value.pair = new(Pair); | ||||
| Lisp_Object* expression = head; | Lisp_Object* expression = head; | ||||
| @@ -346,7 +355,7 @@ namespace Parser { | |||||
| ++(*index_in_text); | ++(*index_in_text); | ||||
| break; | break; | ||||
| } else { | } 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; | head = head->value.pair.rest; | ||||
| } | } | ||||
| } | } | ||||
| @@ -377,7 +386,8 @@ namespace Parser { | |||||
| arguments = arguments->value.pair.first->value.pair.rest; | arguments = arguments->value.pair.first->value.pair.rest; | ||||
| // Function* function = new(Function); | // 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); | Memory::set_type(macro, Lisp_Object_Type::Function); | ||||
| macro->value.function.parent_environment = environment_for_macros; | macro->value.function.parent_environment = environment_for_macros; | ||||
| macro->value.function.type = Function_Type::Macro; | 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 | // we are now in the function body, just wrap it in an | ||||
| // implicit prog | // 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"), | Memory::get_or_create_lisp_object_symbol("prog"), | ||||
| body); | body); | ||||
| @@ -510,12 +520,12 @@ namespace Parser { | |||||
| ++end_pos; | ++end_pos; | ||||
| text[end_pos] = '\0'; | 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)); | Memory::create_string(text+index_in_text)); | ||||
| text[end_pos] = '\n'; | 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 { | proc run_all_tests() -> bool { | ||||
| Memory::init(4096 * 2, 4096 * 16); | |||||
| Memory::init(4096 * 2000, 4096 * 16); | |||||
| Parser::init(Memory::create_built_ins_environment()); | Parser::init(Memory::create_built_ins_environment()); | ||||
| bool result = true; | bool result = true; | ||||
| @@ -527,12 +527,11 @@ proc run_all_tests() -> bool { | |||||
| printf("\n-- Memory management --\n"); | printf("\n-- Memory management --\n"); | ||||
| invoke_test(test_singular_t_and_nil); | invoke_test(test_singular_t_and_nil); | ||||
| printf("\n-- Macros --\n"); | |||||
| printf("\n-- Test Files --\n"); | printf("\n-- Test Files --\n"); | ||||
| invoke_test_script("lexical_scope"); | invoke_test_script("lexical_scope"); | ||||
| invoke_test_script("class_macro"); | invoke_test_script("class_macro"); | ||||
| invoke_test_script("sicp"); | |||||
| return result; | return result; | ||||
| } | } | ||||