cleanup and sicp file, but crashes

This commit is contained in:
FelixBrendel
2019-04-23 21:20:46 +02:00
parent b978f8b2b2
commit c8807a04b2
11 changed files with 498 additions and 130 deletions
+9 -8
View File
@@ -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) ;; TODO(Felix): else symbol
;; (define (rec clauses) (define-syntax (cond :rest clauses)
;; (if (= nil clauses) (define (rec clauses)
;; nil (if (= nil clauses)
;; (list 'if (first (first clauses)) nil
;; (pair 'prog (rest (first clauses))) (list 'if (first (first clauses))
;; (rec (rest clauses))))) (pair 'prog (rest (first clauses)))
;; (rec clauses)) (rec (rest clauses)))))
(rec clauses))
(define (nil? x) (define (nil? x)
"Checks if the argument is nil." "Checks if the argument is nil."
+340
View File
@@ -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))
+33 -10
View File
@@ -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)),
+5 -7
View File
@@ -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_before = Globals::log_level;;) \
for(log_level = Log_Level::None;;) \ 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) { \
+2 -3
View File
@@ -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();
+41 -62
View File
@@ -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]), try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]);
arguments->value.pair.first, new_env); 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( try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier),
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);
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( try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword);
Memory::get_or_create_lisp_object_symbol(defined_keyword), try val = Memory::copy_lisp_object(function->keyword_arguments->values->data[i]);
Memory::copy_lisp_object(function->keyword_arguments->values->data[i]), new_env); 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( try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
Memory::get_or_create_lisp_object_symbol(function->rest_argument), define_symbol(sym, Memory::nil, new_env);
Memory::nil, new_env);
} }
} else { } else {
if (function->rest_argument) { if (function->rest_argument) {
define_symbol( try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
Memory::get_or_create_lisp_object_symbol(function->rest_argument), define_symbol(sym, arguments, new_env);
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 { try result = eval_expr(function->body, new_env);
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 { try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first, env);
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 { try symbol = lookup_symbol(node, env);
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 { try lispOperator = eval_expr(node->value.pair.first, env);
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 { try arguments = eval_arguments(arguments, env, &arguments_length);
arguments = eval_arguments(arguments, env, &arguments_length);
}
} }
Lisp_Object* result; Lisp_Object* result;
try { try result = apply_arguments_to_function(arguments, &lispOperator->value.function);
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 { try result = eval_expr(expression, env);
result = eval_expr(expression, env); return result != Memory::nil;
}
if (result == Memory::nil)
return false;
return true;
} }
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); char* file_content;
if (!file_content) { try file_content = read_entire_file(file_name);
create_generic_error("The file '%s' could not be read.", 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;
+2 -1
View File
@@ -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;
} }
+3 -4
View File
@@ -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;
+36 -17
View File
@@ -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;
} }
} }
+25 -15
View File
@@ -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( return Memory::create_list(Memory::get_or_create_lisp_object_symbol(bare), str);
Memory::get_or_create_lisp_object_symbol(bare), str);
} }
} }
+2 -3
View File
@@ -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;
} }