Bläddra i källkod

cleanup and sicp file, but crashes

master
FelixBrendel 7 år sedan
förälder
incheckning
c8807a04b2
11 ändrade filer med 498 tillägg och 130 borttagningar
  1. +9
    -8
      bin/pre.slime
  2. +340
    -0
      bin/tests/sicp.slime
  3. +33
    -10
      src/built_ins.cpp
  4. +5
    -7
      src/defines.cpp
  5. +2
    -3
      src/error.cpp
  6. +41
    -62
      src/eval.cpp
  7. +2
    -1
      src/forward_decls.cpp
  8. +3
    -4
      src/io.cpp
  9. +36
    -17
      src/memory.cpp
  10. +25
    -15
      src/parse.cpp
  11. +2
    -3
      src/testing.cpp

+ 9
- 8
bin/pre.slime Visa fil

@@ -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."


+ 340
- 0
bin/tests/sicp.slime Visa fil

@@ -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
src/built_ins.cpp Visa fil

@@ -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
src/defines.cpp Visa fil

@@ -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) { \


+ 2
- 3
src/error.cpp Visa fil

@@ -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
src/eval.cpp Visa fil

@@ -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;


+ 2
- 1
src/forward_decls.cpp Visa fil

@@ -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
src/io.cpp Visa fil

@@ -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
src/memory.cpp Visa fil

@@ -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
src/parse.cpp Visa fil

@@ -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);
} }


} }


+ 2
- 3
src/testing.cpp Visa fil

@@ -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;
} }


Laddar…
Avbryt
Spara