Selaa lähdekoodia

cleanup and sicp file, but crashes

master
FelixBrendel 7 vuotta sitten
vanhempi
commit
c8807a04b2
11 muutettua tiedostoa jossa 498 lisäystä ja 130 poistoa
  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 Näytä tiedosto

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


+ 340
- 0
bin/tests/sicp.slime Näytä tiedosto

@@ -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 Näytä tiedosto

@@ -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
src/defines.cpp Näytä tiedosto

@@ -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
src/error.cpp Näytä tiedosto

@@ -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
src/eval.cpp Näytä tiedosto

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


+ 2
- 1
src/forward_decls.cpp Näytä tiedosto

@@ -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
src/io.cpp Näytä tiedosto

@@ -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
src/memory.cpp Näytä tiedosto

@@ -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
src/parse.cpp Näytä tiedosto

@@ -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
src/testing.cpp Näytä tiedosto

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


Ladataan…
Peruuta
Tallenna