cleanup and sicp file, but crashes
This commit is contained in:
+9
-8
@@ -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))
|
||||
+33
-10
@@ -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)),
|
||||
|
||||
+5
-7
@@ -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) { \
|
||||
|
||||
+2
-3
@@ -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();
|
||||
|
||||
+41
-62
@@ -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;
|
||||
}
|
||||
|
||||
+3
-4
@@ -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;
|
||||
|
||||
+36
-17
@@ -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;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
+25
-15
@@ -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);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
+2
-3
@@ -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;
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user