felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

we testing sucessfull again

Browse Source
This commit is contained in:
Felix Brendel
2019-06-06 15:28:57 +02:00
parent c0e79075bc
commit 582022601c
9 changed files with 87 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/math.slime
+36 -36
View File
@@ -10,48 +10,48 @@
(define (sqrt x) (define (sqrt x)
(** x 0.5)) (** x 0.5))
(define-class vector3 (x y z) ;; (define-class vector3 (x y z)
(define (get-x) x) ;; (define (get-x) x)
(define (get-y) y) ;; (define (get-y) y)
(define (get-z) z) ;; (define (get-z) z)
(define (set-x new-x) (mutate x new-x)) ;; (define (set-x new-x) (mutate x new-x))
(define (set-y new-y) (mutate y new-y)) ;; (define (set-y new-y) (mutate y new-y))
(define (set-z new-z) (mutate z new-z)) ;; (define (set-z new-z) (mutate z new-z))
(define (length) ;; (define (length)
(** (+ (* x x) (* y y) (* z z)) 0.5)) ;; (** (+ (* x x) (* y y) (* z z)) 0.5))
(define (scale fac) ;; (define (scale fac)
(mutate x (* fac x)) ;; (mutate x (* fac x))
(mutate y (* fac y)) ;; (mutate y (* fac y))
(mutate z (* fac z)) ;; (mutate z (* fac z))
fac) ;; fac)
(define (add other) ;; (define (add other)
(make-vector3 ;; (make-vector3
(+ x (other get-x)) ;; (+ x (other get-x))
(+ y (other get-y)) ;; (+ y (other get-y))
(+ z (other get-z)))) ;; (+ z (other get-z))))
(define (subtract other) ;; (define (subtract other)
(make-vector3 ;; (make-vector3
(- x (other get-x)) ;; (- x (other get-x))
(- y (other get-y)) ;; (- y (other get-y))
(- z (other get-z)))) ;; (- z (other get-z))))
(define (scalar-product other) ;; (define (scalar-product other)
(+ (* x (other get-x)) ;; (+ (* x (other get-x))
(* y (other get-y)) ;; (* y (other get-y))
(* z (other get-z)))) ;; (* z (other get-z))))
(define (cross-product other) ;; (define (cross-product other)
(make-vector3 ;; (make-vector3
(- (* y (other get-z)) (* z (other get-y))) ;; (- (* y (other get-z)) (* z (other get-y)))
(- (* z (other get-x)) (* x (other get-z))) ;; (- (* z (other get-x)) (* x (other get-z)))
(- (* x (other get-y)) (* y (other get-x))))) ;; (- (* x (other get-y)) (* y (other get-x)))))
(define (print) ;; (define (print)
(printf :sep "" "[vector3] (" x y z ")")) ;; (printf :sep "" "[vector3] (" x y z ")"))
) ;; )
) )
bin/oo.slime
+2 -4
View File
@@ -11,9 +11,7 @@
(let ,(zip members members) (let ,(zip members members)
@body @body
(set-type (set-type
(special-lambda (:rest args) (lambda (:rest args)
"This is the docs for the handle" "This is the docs for the handle"
(eval (first args))) (eval args))
,(symbol->keyword name)))))) ,(symbol->keyword name))))))
(define-class (vec x y z))
bin/tests/class_macro.slime
+14 -14
View File
@@ -1,6 +1,6 @@
(import "oo.slime") (import "oo.slime")
(define-class vector3 (x y z) (define-class (vector3 x y z)
(define (get-x) x) (define (get-x) x)
(define (get-y) y) (define (get-y) y)
(define (get-z) z) (define (get-z) z)
@@ -20,26 +20,26 @@
(define (add other) (define (add other)
(make-vector3 (make-vector3
(+ x (other get-x)) (+ x (other 'get-x))
(+ y (other get-y)) (+ y (other 'get-y))
(+ z (other get-z)))) (+ z (other 'get-z))))
(define (subtract other) (define (subtract other)
(make-vector3 (make-vector3
(- x (other get-x)) (- x (other 'get-x))
(- y (other get-y)) (- y (other 'get-y))
(- z (other get-z)))) (- z (other 'get-z))))
(define (scalar-product other) (define (scalar-product other)
(+ (* x (other get-x)) (+ (* x (other 'get-x))
(* y (other get-y)) (* y (other 'get-y))
(* z (other get-z)))) (* z (other 'get-z))))
(define (cross-product other) (define (cross-product other)
(make-vector3 (make-vector3
(- (* y (other get-z)) (* z (other get-y))) (- (* y (other 'get-z)) (* z (other 'get-y)))
(- (* z (other get-x)) (* x (other get-z))) (- (* z (other 'get-x)) (* x (other 'get-z)))
(- (* x (other get-y)) (* y (other get-x))))) (- (* x (other 'get-y)) (* y (other 'get-x)))))
(define (print) (define (print)
(printf :sep "" "[vector3] (" x y z ")")) (printf :sep "" "[vector3] (" x y z ")"))
@@ -49,4 +49,4 @@
(define v2 (make-vector3 3 2 1)) (define v2 (make-vector3 3 2 1))
(assert (= (type v1) (type v2) :vector3)) (assert (= (type v1) (type v2) :vector3))
(assert (= (v1 scalar-product v2) 10)) (assert (= (v1 'scalar-product v2) 10))
bin/tests/class_macro.slime.expanded
+2 -2
View File
@@ -1,6 +1,6 @@
(import "oo.slime") (import "oo.slime")
(define-class vector3 (x y z) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (cross-product other) (make-vector3 (- (* y (other get-z)) (* z (other get-y))) (- (* z (other get-x)) (* x (other get-z))) (- (* x (other get-y)) (* y (other get-x))))) (define (print) (printf :sep "" "[vector3] (" x y z ")"))) (define-class (vector3 x y z) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other 'get-x)) (+ y (other 'get-y)) (+ z (other 'get-z)))) (define (subtract other) (make-vector3 (- x (other 'get-x)) (- y (other 'get-y)) (- z (other 'get-z)))) (define (scalar-product other) (+ (* x (other 'get-x)) (* y (other 'get-y)) (* z (other 'get-z)))) (define (cross-product other) (make-vector3 (- (* y (other 'get-z)) (* z (other 'get-y))) (- (* z (other 'get-x)) (* x (other 'get-z))) (- (* x (other 'get-y)) (* y (other 'get-x))))) (define (print) (printf :sep "" "[vector3] (" x y z ")")))
(define v1 (make-vector3 1 2 3)) (define v1 (make-vector3 1 2 3))
@@ -8,5 +8,5 @@
(assert (= (type v1) (type v2) :vector3)) (assert (= (type v1) (type v2) :vector3))
(assert (= (v1 scalar-product v2) 10)) (assert (= (v1 'scalar-product v2) 10))
bin/tests/lexical_scope.slime.expanded
+1 -1
View File
@@ -1,4 +1,4 @@
(define (make-counter) ((lambda (var) (lambda () (mutate var (+ 1 var)) var)) 0)) (define (make-counter) (let ((var 0)) (lambda () (mutate var (+ 1 var)) var)))
(define counter1 (make-counter)) (define counter1 (make-counter))
src/built_ins.cpp
+6 -5
View File
@@ -90,10 +90,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object* #define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
proc defun = [&](const char* name, auto fun) { proc defun = [&](const char* name, auto fun) {
define_symbol( // TODO(Felix): inline the params again after debugging
Memory::get_or_create_lisp_object_symbol(name), auto sym = Memory::get_or_create_lisp_object_symbol(name);
Memory::create_lisp_object_cfunction(fun), auto sfun = Memory::create_lisp_object_cfunction(fun);
env); define_symbol(sym, sfun, env);
}; };
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* {
@@ -413,7 +413,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try assert_arguments_length(2, arguments_length); try assert_arguments_length(2, arguments_length);
Lisp_Object* target = evaluated_arguments->value.pair.first; Lisp_Object* target = evaluated_arguments->value.pair.first;
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first; Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
#
if (target == Memory::nil || if (target == Memory::nil ||
target == Memory::t || target == Memory::t ||
Memory::get_type(target) == Lisp_Object_Type::Keyword || Memory::get_type(target) == Lisp_Object_Type::Keyword ||
@@ -519,6 +519,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
newPairHead = newPair; newPairHead = newPair;
} else { } else {
try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
newPairHead = newPairHead->value.pair.rest;
newPairHead->value.pair.first = spliced->value.pair.first; newPairHead->value.pair.first = spliced->value.pair.first;
newPairHead->value.pair.rest = spliced->value.pair.rest; newPairHead->value.pair.rest = spliced->value.pair.rest;
src/env.cpp
+1
View File
@@ -4,6 +4,7 @@ proc define_symbol(Lisp_Object* symbol, Lisp_Object* value, Environment* env) ->
// also searching for thesymbol from the back, so we will find the // also searching for thesymbol from the back, so we will find the
// latest defined one first, but a bit messy. Later we should use // latest defined one first, but a bit messy. Later we should use
// a hashmap here. @refactor // a hashmap here. @refactor
if (env->next_index == env->capacity) { if (env->next_index == env->capacity) {
env->capacity *= 2; env->capacity *= 2;
env->keys = (char**)realloc(env->keys, env->capacity * sizeof(char*)); env->keys = (char**)realloc(env->keys, env->capacity * sizeof(char*));
src/eval.cpp
+2
View File
@@ -380,6 +380,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
case Lisp_Object_Type::Number: case Lisp_Object_Type::Number:
case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Keyword:
case Lisp_Object_Type::String: case Lisp_Object_Type::String:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::CFunction:
return node; return node;
case Lisp_Object_Type::Symbol: { case Lisp_Object_Type::Symbol: {
Lisp_Object* symbol; Lisp_Object* symbol;
src/testing.cpp
+23 -22
View File
@@ -197,7 +197,7 @@ proc test_eval_operands() -> testresult {
char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))"; char operands_string[] = "((eval 1) (+ 1 2) \"okay\" (eval :haha))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string); Lisp_Object* operands = Parser::parse_single_expression(operands_string);
int operands_length; int operands_length;
try operands = eval_arguments(operands, Memory::create_built_ins_environment(), &operands_length); try operands = eval_arguments(operands, Globals::root_environment, &operands_length);
assert_no_error(); assert_no_error();
assert_equal_int(list_length(operands), 4); assert_equal_int(list_length(operands), 4);
@@ -342,7 +342,7 @@ proc test_built_in_add() -> testresult {
char exp_string[] = "(+ 10 4)"; char exp_string[] = "(+ 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -356,7 +356,8 @@ proc test_built_in_substract() -> testresult {
char exp_string[] = "(- 10 4)"; char exp_string[] = "(- 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment());
try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -371,7 +372,7 @@ proc test_built_in_multiply() -> testresult {
char exp_string[] = "(* 10 4)"; char exp_string[] = "(* 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -386,7 +387,7 @@ proc test_built_in_divide() -> testresult {
char exp_string[] = "(/ 20 4)"; char exp_string[] = "(/ 20 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string); Lisp_Object* expression = Parser::parse_single_expression(exp_string);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -401,7 +402,7 @@ proc test_built_in_if() -> testresult {
char exp_string1[] = "(if 1 4 5)"; char exp_string1[] = "(if 1 4 5)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -410,7 +411,7 @@ proc test_built_in_if() -> testresult {
char exp_string2[] = "(if () 4 5)"; char exp_string2[] = "(if () 4 5)";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -424,7 +425,7 @@ proc test_built_in_and() -> testresult {
char exp_string1[] = "(and 1 \"asd\" 4)"; char exp_string1[] = "(and 1 \"asd\" 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -433,7 +434,7 @@ proc test_built_in_and() -> testresult {
// a false case // a false case
char exp_string2[] = "(and () \"asd\" 4)"; char exp_string2[] = "(and () \"asd\" 4)";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -446,7 +447,7 @@ proc test_built_in_or() -> testresult {
char exp_string1[] = "(or \"asd\" nil)"; char exp_string1[] = "(or \"asd\" nil)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -455,7 +456,7 @@ proc test_built_in_or() -> testresult {
// a false case // a false case
char exp_string2[] = "(or () ())"; char exp_string2[] = "(or () ())";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -469,7 +470,7 @@ proc test_built_in_not() -> testresult {
char exp_string1[] = "(not ())"; char exp_string1[] = "(not ())";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1); Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result; Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
// a true case // a true case
assert_no_error(); assert_no_error();
@@ -479,7 +480,7 @@ proc test_built_in_not() -> testresult {
// a false case // a false case
char exp_string2[] = "(not \"asd xD\")"; char exp_string2[] = "(not \"asd xD\")";
expression = Parser::parse_single_expression(exp_string2); expression = Parser::parse_single_expression(exp_string2);
try result = eval_expr(expression, Memory::create_built_ins_environment()); try result = eval_expr(expression, Globals::root_environment);
assert_no_error(); assert_no_error();
assert_not_null(result); assert_not_null(result);
@@ -490,7 +491,7 @@ proc test_built_in_not() -> testresult {
proc test_built_in_type() -> testresult { proc test_built_in_type() -> testresult {
Environment* env; Environment* env;
try env = Memory::create_built_ins_environment(); try env = Globals::root_environment;
// normal type testing // normal type testing
char exp_string1[] = "(begin (define a 10)(type a))"; char exp_string1[] = "(begin (define a 10)(type a))";
@@ -538,7 +539,7 @@ proc test_built_in_type() -> testresult {
proc test_singular_t_and_nil() -> testresult { proc test_singular_t_and_nil() -> testresult {
Environment* env; Environment* env;
try env = Memory::create_built_ins_environment(); try env = Globals::root_environment;
// nil testing // nil testing
char exp_string1[] = "()"; char exp_string1[] = "()";
@@ -589,7 +590,7 @@ proc test_file(const char* file) -> testresult {
} }
proc run_all_tests() -> bool { proc run_all_tests() -> bool {
Memory::init(4096 * 2000, 1024 * 32, 4096 * 16); Memory::init(4096 * 2000, 1024 * 32, 4096 * 16 * 10);
// get the direction of the exe // get the direction of the exe
char* exe_path = exe_dir(); char* exe_path = exe_dir();
@@ -628,12 +629,12 @@ proc run_all_tests() -> bool {
printf("\n-- Test Files --\n"); printf("\n-- Test Files --\n");
// invoke_test_script("evaluation_of_default_args"); invoke_test_script("evaluation_of_default_args");
// invoke_test_script("lexical_scope"); invoke_test_script("lexical_scope");
// invoke_test_script("class_macro"); invoke_test_script("class_macro");
// invoke_test_script("import_and_load"); invoke_test_script("import_and_load");
// invoke_test_script("sicp"); invoke_test_script("sicp");
// invoke_test_script("macro_expand"); invoke_test_script("macro_expand");
return result; return result;
} }