From af55ee1314d5005528a22ab1bfe9382535d8f38e Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Fri, 27 Mar 2020 15:31:00 +0100 Subject: [PATCH] Now usable --- bin/pre.slime | 3 +- bin/tests/modules.slime | 2 +- bin/tests/simple_built_ins.slime | 96 ++++++++++++++++---------------- build.bat | 3 +- src/built_ins.cpp | 22 ++++---- src/eval.cpp | 5 ++ src/io.cpp | 42 +++++++------- src/memory.cpp | 6 +- src/testing.cpp | 8 +-- 9 files changed, 96 insertions(+), 91 deletions(-) diff --git a/bin/pre.slime b/bin/pre.slime index 9f0cc94..8cca1fd 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -222,8 +222,7 @@ condition is false." (concat-strings module-prefix (symbol->string orig-export-name))))) exports)) - (disable-debug-log) - )) + (disable-debug-log))) (define-syntax (generic-extend args . body) (let ((fun-name (first args)) diff --git a/bin/tests/modules.slime b/bin/tests/modules.slime index ee2c57e..88277b3 100644 --- a/bin/tests/modules.slime +++ b/bin/tests/modules.slime @@ -8,7 +8,7 @@ (define (sqrt a) (** a 0.5))) (assert (= math::pi 3.1415)) -(assert (= math::tau (* 2 math::tau))) +(assert (= math::tau (* 2 math::pi))) ;; (tdefine-module 'math diff --git a/bin/tests/simple_built_ins.slime b/bin/tests/simple_built_ins.slime index b0ebc07..bfc8f67 100644 --- a/bin/tests/simple_built_ins.slime +++ b/bin/tests/simple_built_ins.slime @@ -1,58 +1,58 @@ ;; ;; let testing ;; -(assert (not (bound? var1))) -(assert (not (bound? var2))) -(assert (not (bound? var3))) -(let ((var1 1) - (var2 [1 2 3]) - (var3 {1 2 3 4})) - (assert (bound? var1)) - (assert (bound? var2)) - (assert (bound? var3)) - (assert (= var1 1)) - (assert (= var2 [1 2 3])) - (assert (= var3 {1 2 3 4}))) - -(assert (not (bound? var1))) -(assert (not (bound? var2))) -(assert (not (bound? var3))) - -(assert (= (let ((val 'sym)) - val) - 'sym)) - -(assert (= (let () - 'sym) - 'sym)) -;; -;; Quasiquote testing -;; -(assert (= '() `())) - -(assert (= '(1 1 2) - `(1 1 2))) - -(assert (= '(1 1 2) - `(1 ,1 2))) - -(assert (= '(1 1 2) - `(1 ,(- 10 9) 2))) - -(assert (= '(1 1 2) - `(1 ,@(list 1 2)))) - -(let ((body '(2 3))) - (assert (= '(1 2 3) - `(1 ,@body)))) +;; (assert (not (bound? var1))) +;; (assert (not (bound? var2))) +;; (assert (not (bound? var3))) +;; (let ((var1 1) +;; (var2 [1 2 3]) +;; (var3 {1 2 3 4})) +;; (assert (bound? var1)) +;; (assert (bound? var2)) +;; (assert (bound? var3)) +;; (assert (= var1 1)) +;; (assert (= var2 [1 2 3])) +;; (assert (= var3 {1 2 3 4}))) + +;; (assert (not (bound? var1))) +;; (assert (not (bound? var2))) +;; (assert (not (bound? var3))) + +;; (assert (= (let ((val 'sym)) +;; val) +;; 'sym)) + +;; (assert (= (let () +;; 'sym) +;; 'sym)) +;; ;; +;; ;; Quasiquote testing +;; ;; +;; (assert (= '() `())) + +;; (assert (= '(1 1 2) +;; `(1 1 2))) + +;; (assert (= '(1 1 2) +;; `(1 ,1 2))) + +;; (assert (= '(1 1 2) +;; `(1 ,(- 10 9) 2))) + +;; (assert (= '(1 1 2) +;; `(1 ,@(list 1 2)))) + +;; (let ((body '(2 3))) +;; (assert (= '(1 2 3) +;; `(1 ,@body)))) (let ((body '((define a 1) (define b 2))) (imports '())) (let ((expr `(begin ,@(map (lambda (x) `(import ,x)) imports) ,@body))) - (assert (= '(begin - (define a 1) - (define b 2)))) + (assert (= '(begin (define a 1) (define b 2)) expr)) (eval expr) (assert (= a 1)) - (assert (= b 2)))) + (assert (= b 2)) + )) + diff --git a/build.bat b/build.bat index 4256c4d..8490a22 100644 --- a/build.bat +++ b/build.bat @@ -8,9 +8,10 @@ taskkill /F /IM %exeName% > NUL 2> NUL echo ---------- Compiling ---------- call cl ^ + /DEBUG:FULL^ ../src/main.cpp^ /I../3rd/ ^ - /D_PROFILING /D_DEBUG ^ + /D_PROFILING /D_DEBUG /D_DONT_BREAK_ON_ERRORS ^ /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc rem call ..\timecmd cl ^ diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 75bcceb..a0c689e 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -147,9 +147,8 @@ namespace Slime { proc load_built_ins_into_environment() -> void* { profile_this(); String file_name_built_ins = Memory::create_string(__FILE__); - defer { - free(file_name_built_ins.data); - }; + defer_free(file_name_built_ins.data); + define((remove_when_double_free_is_fixed (:k1 ()) (:k2 ()) . rest), "") { return Memory::nil; }; @@ -225,6 +224,9 @@ namespace Slime { { profile_with_name("(eval)"); using namespace Globals::Current_Execution; + // TODO(Felix): ams index should be decremented in + // eval_expr when calling the macro + --ams.next_index; cs.data[cs.next_index-1] = pcs[--pcs.next_index]->value.pair.first; (nass.end()-1)->append(NasAction::Eval); (nass.end()-1)->append(NasAction::Eval); @@ -957,25 +959,23 @@ namespace Slime { profile_with_name("(set-type!)"); fetch(node, new_type); try assert_type(new_type, Lisp_Object_Type::Keyword); - // TODO(Felix): Enable again when we have user types again: - // node->userType = new_type; + Globals::user_types.set_object(node, new_type); return node; }; define((delete-type! n), "TODO") { profile_with_name("(delete-type!)"); fetch(n); - // TODO(Felix): Enable again when we have user types again: - // n->userType = nullptr; + Globals::user_types.delete_object(n); return Memory::t; }; define((type n), "TODO") { profile_with_name("(type)"); fetch(n); - // TODO(Felix): Enable again when we have user types again: - // if (n->userType) { - // return n->userType; - // } + + if (Globals::user_types.key_exists(n)) { + return (Lisp_Object*)Globals::user_types.get_object(n); + } Lisp_Object_Type type = n->type; diff --git a/src/eval.cpp b/src/eval.cpp index 76c1ca7..8aa472d 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -368,6 +368,11 @@ namespace Slime { case Lisp_Object_Type::Pair: { cs.data[cs.next_index-1] = pc->value.pair.first; ams.append(cs.next_index-1); + + assert("invalid ams state", + ams.data[ams.next_index-2] <= + ams.data[ams.next_index-1]); + pcs.append(pc->value.pair.rest); mes.append(pc); nas->append(NasAction::TM); diff --git a/src/io.cpp b/src/io.cpp index 80643d0..4f06874 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -326,10 +326,10 @@ namespace Slime { }; switch (node->type) { - case (Lisp_Object_Type::Nil): return strdup("()"); - case (Lisp_Object_Type::T): return strdup("t"); - case (Lisp_Object_Type::Continuation): return strdup("[continuation]"); - case (Lisp_Object_Type::Pointer): return strdup("[pointer]"); + case (Lisp_Object_Type::Nil): return _strdup("()"); + case (Lisp_Object_Type::T): return _strdup("t"); + case (Lisp_Object_Type::Continuation): return _strdup("[continuation]"); + case (Lisp_Object_Type::Pointer): return _strdup("[pointer]"); case (Lisp_Object_Type::Number): { if (abs(node->value.number - (int)node->value.number) < 0.000001f) asprintf(&temp, "%d", (int)node->value.number); @@ -369,18 +369,18 @@ namespace Slime { free(escaped); return temp; } else - return strdup(Memory::get_c_str(node->value.string)); + return _strdup(Memory::get_c_str(node->value.string)); } break; case (Lisp_Object_Type::Vector): { - string_builder.append(strdup("[")); + string_builder.append(_strdup("[")); if (node->value.vector.length > 0) string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr)); for (int i = 1; i < node->value.vector.length; ++i) { - string_builder.append(strdup(" ")); + string_builder.append(_strdup(" ")); string_builder.append(lisp_object_to_string(node->value.vector.data+i, print_repr)); } - string_builder.append(strdup("]")); + string_builder.append(_strdup("]")); temp = string_buider_to_string(string_builder); for (auto str : string_builder) { free(str); @@ -402,22 +402,22 @@ namespace Slime { case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",name->value.symbol.data); break; case C_Function_Type::cSpecial: asprintf(&temp, "[c-special %s]", name->value.symbol.data); break; case C_Function_Type::cMacro: asprintf(&temp, "[c-macro %s]", name->value.symbol.data); break; - default: return strdup("[c-??]"); + default: return _strdup("[c-??]"); } } else { switch (node->value.function->type.c_function_type) { case C_Function_Type::cFunction: asprintf(&temp, "[c-function]"); break; case C_Function_Type::cSpecial: asprintf(&temp, "[c-special]"); break; case C_Function_Type::cMacro: asprintf(&temp, "[c-macro]"); break; - default: return strdup("[c-??]"); + default: return _strdup("[c-??]"); } } return temp; } else { switch (node->value.function->type.lisp_function_type) { - case Lisp_Function_Type::Lambda: return strdup("[lambda]"); - case Lisp_Function_Type::Macro: return strdup("[macro]"); - default: return strdup("[??]"); + case Lisp_Function_Type::Lambda: return _strdup("[lambda]"); + case Lisp_Function_Type::Macro: return _strdup("[macro]"); + default: return _strdup("[??]"); } } } break; @@ -444,11 +444,11 @@ namespace Slime { if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) { if (symbol == quote_sym) - string_builder.append(strdup("\'")); + string_builder.append(_strdup("\'")); else if (symbol == unquote_sym) - string_builder.append(strdup(",")); + string_builder.append(_strdup(",")); else if (symbol == unquote_splicing_sym) - string_builder.append(strdup(",@")); + string_builder.append(_strdup(",@")); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); assert("The list must end here.", @@ -457,7 +457,7 @@ namespace Slime { string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr)); return string_buider_to_string(string_builder); } else if (symbol == quasiquote_sym) { - string_builder.append(strdup("`")); + string_builder.append(_strdup("`")); assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr)); return string_buider_to_string(string_builder); @@ -465,7 +465,7 @@ namespace Slime { } } - string_builder.append(strdup("(")); + string_builder.append(_strdup("(")); // NOTE(Felix): We could do a while true here, however in case // we want to print a broken list (for logging the error) we @@ -475,15 +475,15 @@ namespace Slime { head = head->value.pair.rest; if (!head) break; if (head->type != Lisp_Object_Type::Pair) break; - string_builder.append(strdup(" ")); + string_builder.append(_strdup(" ")); } if (head && head != Memory::nil) { - string_builder.append(strdup(" . ")); + string_builder.append(_strdup(" . ")); string_builder.append(lisp_object_to_string(head, print_repr)); } - string_builder.append(strdup(")")); + string_builder.append(_strdup(")")); return string_buider_to_string(string_builder); } diff --git a/src/memory.cpp b/src/memory.cpp index 3f48842..8694b57 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -129,6 +129,7 @@ namespace Slime::Memory { // free the exe dir: free(Globals::load_path.data[0]); // Globals::load_path.dealloc(); + Globals::user_types.dealloc(); Globals::docs.dealloc(); Globals::Current_Execution::envi_stack.dealloc(); Globals::Current_Execution::cs.dealloc(); @@ -204,6 +205,7 @@ namespace Slime::Memory { Globals::Current_Execution::mes.alloc(); Globals::docs.alloc(); + Globals::user_types.alloc(); // Globals::load_path.alloc(); add_to_load_path(exe_path); add_to_load_path("../bin/"); @@ -224,9 +226,7 @@ namespace Slime::Memory { try_void env = create_built_ins_environment(); push_environment(env); - Environment* user_env; - try_void user_env = Memory::create_child_environment(env); - push_environment(user_env); + } diff --git a/src/testing.cpp b/src/testing.cpp index 150b787..5bf3cd9 100644 --- a/src/testing.cpp +++ b/src/testing.cpp @@ -632,10 +632,10 @@ namespace Slime { invoke_test_script("macro_expand"); invoke_test_script("sicp"); invoke_test_script("simple_built_ins"); - // invoke_test_script("modules"); - // invoke_test_script("class_macro"); - // invoke_test_script("automata"); - // invoke_test_script("alists"); + invoke_test_script("modules"); + invoke_test_script("class_macro"); + invoke_test_script("automata"); + invoke_test_script("alists"); return result; }