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)
(** x 0.5))
(define-class vector3 (x y z)
(define (get-x) x)
(define (get-y) y)
(define (get-z) 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 (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.5))
;; (define (length)
;; (** (+ (* x x) (* y y) (* z z)) 0.5))
(define (scale fac)
(mutate x (* fac x))
(mutate y (* fac y))
(mutate z (* fac z))
fac)
;; (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 (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 (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 (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 (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 (print)
;; (printf :sep "" "[vector3] (" x y z ")"))
;; )
)
bin/oo.slime
+2 -4
View File
@@ -11,9 +11,7 @@
(let ,(zip members members)
@body
(set-type
(special-lambda (:rest args)
(lambda (:rest args)
"This is the docs for the handle"
(eval (first args)))
(eval args))
,(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")
(define-class vector3 (x y z)
(define-class (vector3 x y z)
(define (get-x) x)
(define (get-y) y)
(define (get-z) z)
@@ -20,26 +20,26 @@
(define (add other)
(make-vector3
(+ x (other get-x))
(+ y (other get-y))
(+ z (other get-z))))
(+ 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))))
(- 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))))
(+ (* 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)))))
(- (* 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 ")"))
@@ -49,4 +49,4 @@
(define v2 (make-vector3 3 2 1))
(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")
(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))
@@ -8,5 +8,5 @@
(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))
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*
proc defun = [&](const char* name, auto fun) {
define_symbol(
Memory::get_or_create_lisp_object_symbol(name),
Memory::create_lisp_object_cfunction(fun),
env);
// TODO(Felix): inline the params again after debugging
auto sym = Memory::get_or_create_lisp_object_symbol(name);
auto sfun = Memory::create_lisp_object_cfunction(fun);
define_symbol(sym, sfun, env);
};
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);
Lisp_Object* target = evaluated_arguments->value.pair.first;
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
#
if (target == Memory::nil ||
target == Memory::t ||
Memory::get_type(target) == Lisp_Object_Type::Keyword ||
@@ -519,6 +519,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
newPairHead = newPair;
} else {
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.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
// latest defined one first, but a bit messy. Later we should use
// a hashmap here. @refactor
if (env->next_index == env->capacity) {
env->capacity *= 2;
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::Keyword:
case Lisp_Object_Type::String:
case Lisp_Object_Type::Function:
case Lisp_Object_Type::CFunction:
return node;
case Lisp_Object_Type::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))";
Lisp_Object* operands = Parser::parse_single_expression(operands_string);
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_equal_int(list_length(operands), 4);
@@ -342,7 +342,7 @@ proc test_built_in_add() -> testresult {
char exp_string[] = "(+ 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
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_not_null(result);
@@ -356,7 +356,8 @@ proc test_built_in_substract() -> testresult {
char exp_string[] = "(- 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
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_not_null(result);
@@ -371,7 +372,7 @@ proc test_built_in_multiply() -> testresult {
char exp_string[] = "(* 10 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
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_not_null(result);
@@ -386,7 +387,7 @@ proc test_built_in_divide() -> testresult {
char exp_string[] = "(/ 20 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string);
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_not_null(result);
@@ -401,7 +402,7 @@ proc test_built_in_if() -> testresult {
char exp_string1[] = "(if 1 4 5)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
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_not_null(result);
@@ -410,7 +411,7 @@ proc test_built_in_if() -> testresult {
char exp_string2[] = "(if () 4 5)";
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_not_null(result);
@@ -424,7 +425,7 @@ proc test_built_in_and() -> testresult {
char exp_string1[] = "(and 1 \"asd\" 4)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
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_not_null(result);
@@ -433,7 +434,7 @@ proc test_built_in_and() -> testresult {
// a false case
char exp_string2[] = "(and () \"asd\" 4)";
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_not_null(result);
@@ -446,7 +447,7 @@ proc test_built_in_or() -> testresult {
char exp_string1[] = "(or \"asd\" nil)";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
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_not_null(result);
@@ -455,7 +456,7 @@ proc test_built_in_or() -> testresult {
// a false case
char exp_string2[] = "(or () ())";
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_not_null(result);
@@ -469,7 +470,7 @@ proc test_built_in_not() -> testresult {
char exp_string1[] = "(not ())";
Lisp_Object* expression = Parser::parse_single_expression(exp_string1);
Lisp_Object* result;
try result = eval_expr(expression, Memory::create_built_ins_environment());
try result = eval_expr(expression, Globals::root_environment);
// a true case
assert_no_error();
@@ -479,7 +480,7 @@ proc test_built_in_not() -> testresult {
// a false case
char exp_string2[] = "(not \"asd xD\")";
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_not_null(result);
@@ -490,7 +491,7 @@ proc test_built_in_not() -> testresult {
proc test_built_in_type() -> testresult {
Environment* env;
try env = Memory::create_built_ins_environment();
try env = Globals::root_environment;
// normal type testing
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 {
Environment* env;
try env = Memory::create_built_ins_environment();
try env = Globals::root_environment;
// nil testing
char exp_string1[] = "()";
@@ -589,7 +590,7 @@ proc test_file(const char* file) -> testresult {
}
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
char* exe_path = exe_dir();
@@ -628,12 +629,12 @@ proc run_all_tests() -> bool {
printf("\n-- Test Files --\n");
// invoke_test_script("evaluation_of_default_args");
// invoke_test_script("lexical_scope");
// invoke_test_script("class_macro");
// invoke_test_script("import_and_load");
// invoke_test_script("sicp");
// invoke_test_script("macro_expand");
invoke_test_script("evaluation_of_default_args");
invoke_test_script("lexical_scope");
invoke_test_script("class_macro");
invoke_test_script("import_and_load");
invoke_test_script("sicp");
invoke_test_script("macro_expand");
return result;
}