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

Now usable

Browse Source
This commit is contained in:
FelixBrendel
2020-03-27 15:31:00 +01:00
parent 77b9a8c6ae
commit af55ee1314
9 changed files with 88 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/pre.slime
+1 -2
View File
@@ -222,8 +222,7 @@ condition is false."
(concat-strings module-prefix (concat-strings module-prefix
(symbol->string orig-export-name))))) (symbol->string orig-export-name)))))
exports)) exports))
(disable-debug-log) (disable-debug-log)))
))
(define-syntax (generic-extend args . body) (define-syntax (generic-extend args . body)
(let ((fun-name (first args)) (let ((fun-name (first args))
bin/tests/modules.slime
+1 -1
View File
@@ -8,7 +8,7 @@
(define (sqrt a) (** a 0.5))) (define (sqrt a) (** a 0.5)))
(assert (= math::pi 3.1415)) (assert (= math::pi 3.1415))
(assert (= math::tau (* 2 math::tau))) (assert (= math::tau (* 2 math::pi)))
;; (tdefine-module 'math ;; (tdefine-module 'math
bin/tests/simple_built_ins.slime
+40 -40
View File
@@ -1,58 +1,58 @@
;; ;;
;; let testing ;; let testing
;; ;;
(assert (not (bound? var1))) ;; (assert (not (bound? var1)))
(assert (not (bound? var2))) ;; (assert (not (bound? var2)))
(assert (not (bound? var3))) ;; (assert (not (bound? var3)))
(let ((var1 1) ;; (let ((var1 1)
(var2 [1 2 3]) ;; (var2 [1 2 3])
(var3 {1 2 3 4})) ;; (var3 {1 2 3 4}))
(assert (bound? var1)) ;; (assert (bound? var1))
(assert (bound? var2)) ;; (assert (bound? var2))
(assert (bound? var3)) ;; (assert (bound? var3))
(assert (= var1 1)) ;; (assert (= var1 1))
(assert (= var2 [1 2 3])) ;; (assert (= var2 [1 2 3]))
(assert (= var3 {1 2 3 4}))) ;; (assert (= var3 {1 2 3 4})))
(assert (not (bound? var1))) ;; (assert (not (bound? var1)))
(assert (not (bound? var2))) ;; (assert (not (bound? var2)))
(assert (not (bound? var3))) ;; (assert (not (bound? var3)))
(assert (= (let ((val 'sym)) ;; (assert (= (let ((val 'sym))
val) ;; val)
'sym)) ;; 'sym))
(assert (= (let () ;; (assert (= (let ()
'sym) ;; 'sym)
'sym)) ;; 'sym))
;; ;; ;;
;; Quasiquote testing ;; ;; Quasiquote testing
;; ;; ;;
(assert (= '() `())) ;; (assert (= '() `()))
(assert (= '(1 1 2) ;; (assert (= '(1 1 2)
`(1 1 2))) ;; `(1 1 2)))
(assert (= '(1 1 2) ;; (assert (= '(1 1 2)
`(1 ,1 2))) ;; `(1 ,1 2)))
(assert (= '(1 1 2) ;; (assert (= '(1 1 2)
`(1 ,(- 10 9) 2))) ;; `(1 ,(- 10 9) 2)))
(assert (= '(1 1 2) ;; (assert (= '(1 1 2)
`(1 ,@(list 1 2)))) ;; `(1 ,@(list 1 2))))
(let ((body '(2 3))) ;; (let ((body '(2 3)))
(assert (= '(1 2 3) ;; (assert (= '(1 2 3)
`(1 ,@body)))) ;; `(1 ,@body))))
(let ((body '((define a 1) (let ((body '((define a 1)
(define b 2))) (define b 2)))
(imports '())) (imports '()))
(let ((expr `(begin ,@(map (lambda (x) `(import ,x)) imports) ,@body))) (let ((expr `(begin ,@(map (lambda (x) `(import ,x)) imports) ,@body)))
(assert (= '(begin (assert (= '(begin (define a 1) (define b 2)) expr))
(define a 1)
(define b 2))))
(eval expr) (eval expr)
(assert (= a 1)) (assert (= a 1))
(assert (= b 2)))) (assert (= b 2))
))
build.bat
+2 -1
View File
@@ -8,9 +8,10 @@ taskkill /F /IM %exeName% > NUL 2> NUL
echo ---------- Compiling ---------- echo ---------- Compiling ----------
call cl ^ call cl ^
/DEBUG:FULL^
../src/main.cpp^ ../src/main.cpp^
/I../3rd/ ^ /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 /Zi /std:c++latest /Fe%exeName% /W3 /wd4003 /wd4996 /nologo /EHsc
rem call ..\timecmd cl ^ rem call ..\timecmd cl ^
src/built_ins.cpp
+11 -11
View File
@@ -147,9 +147,8 @@ namespace Slime {
proc load_built_ins_into_environment() -> void* { proc load_built_ins_into_environment() -> void* {
profile_this(); profile_this();
String file_name_built_ins = Memory::create_string(__FILE__); String file_name_built_ins = Memory::create_string(__FILE__);
defer { defer_free(file_name_built_ins.data);
free(file_name_built_ins.data);
};
define((remove_when_double_free_is_fixed (:k1 ()) (:k2 ()) . rest), "") { define((remove_when_double_free_is_fixed (:k1 ()) (:k2 ()) . rest), "") {
return Memory::nil; return Memory::nil;
}; };
@@ -225,6 +224,9 @@ namespace Slime {
{ {
profile_with_name("(eval)"); profile_with_name("(eval)");
using namespace Globals::Current_Execution; 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; 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);
(nass.end()-1)->append(NasAction::Eval); (nass.end()-1)->append(NasAction::Eval);
@@ -957,25 +959,23 @@ namespace Slime {
profile_with_name("(set-type!)"); profile_with_name("(set-type!)");
fetch(node, new_type); fetch(node, new_type);
try assert_type(new_type, Lisp_Object_Type::Keyword); try assert_type(new_type, Lisp_Object_Type::Keyword);
// TODO(Felix): Enable again when we have user types again: Globals::user_types.set_object(node, new_type);
// node->userType = new_type;
return node; return node;
}; };
define((delete-type! n), "TODO") { define((delete-type! n), "TODO") {
profile_with_name("(delete-type!)"); profile_with_name("(delete-type!)");
fetch(n); fetch(n);
// TODO(Felix): Enable again when we have user types again: Globals::user_types.delete_object(n);
// n->userType = nullptr;
return Memory::t; return Memory::t;
}; };
define((type n), "TODO") { define((type n), "TODO") {
profile_with_name("(type)"); profile_with_name("(type)");
fetch(n); fetch(n);
// TODO(Felix): Enable again when we have user types again:
// if (n->userType) { if (Globals::user_types.key_exists(n)) {
// return n->userType; return (Lisp_Object*)Globals::user_types.get_object(n);
// } }
Lisp_Object_Type type = n->type; Lisp_Object_Type type = n->type;
src/eval.cpp
+5
View File
@@ -368,6 +368,11 @@ namespace Slime {
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
cs.data[cs.next_index-1] = pc->value.pair.first; cs.data[cs.next_index-1] = pc->value.pair.first;
ams.append(cs.next_index-1); 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); pcs.append(pc->value.pair.rest);
mes.append(pc); mes.append(pc);
nas->append(NasAction::TM); nas->append(NasAction::TM);
src/io.cpp
+21 -21
View File
@@ -326,10 +326,10 @@ namespace Slime {
}; };
switch (node->type) { switch (node->type) {
case (Lisp_Object_Type::Nil): return strdup("()"); case (Lisp_Object_Type::Nil): return _strdup("()");
case (Lisp_Object_Type::T): return strdup("t"); case (Lisp_Object_Type::T): return _strdup("t");
case (Lisp_Object_Type::Continuation): return strdup("[continuation]"); case (Lisp_Object_Type::Continuation): return _strdup("[continuation]");
case (Lisp_Object_Type::Pointer): return strdup("[pointer]"); case (Lisp_Object_Type::Pointer): return _strdup("[pointer]");
case (Lisp_Object_Type::Number): { case (Lisp_Object_Type::Number): {
if (abs(node->value.number - (int)node->value.number) < 0.000001f) if (abs(node->value.number - (int)node->value.number) < 0.000001f)
asprintf(&temp, "%d", (int)node->value.number); asprintf(&temp, "%d", (int)node->value.number);
@@ -369,18 +369,18 @@ namespace Slime {
free(escaped); free(escaped);
return temp; return temp;
} else } else
return strdup(Memory::get_c_str(node->value.string)); return _strdup(Memory::get_c_str(node->value.string));
} break; } break;
case (Lisp_Object_Type::Vector): { case (Lisp_Object_Type::Vector): {
string_builder.append(strdup("[")); string_builder.append(_strdup("["));
if (node->value.vector.length > 0) if (node->value.vector.length > 0)
string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr)); string_builder.append(lisp_object_to_string(node->value.vector.data, print_repr));
for (int i = 1; i < node->value.vector.length; ++i) { 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(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); temp = string_buider_to_string(string_builder);
for (auto str : string_builder) { for (auto str : string_builder) {
free(str); 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::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::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; case C_Function_Type::cMacro: asprintf(&temp, "[c-macro %s]", name->value.symbol.data); break;
default: return strdup("[c-??]"); default: return _strdup("[c-??]");
} }
} else { } else {
switch (node->value.function->type.c_function_type) { switch (node->value.function->type.c_function_type) {
case C_Function_Type::cFunction: asprintf(&temp, "[c-function]"); break; case C_Function_Type::cFunction: asprintf(&temp, "[c-function]"); break;
case C_Function_Type::cSpecial: asprintf(&temp, "[c-special]"); break; case C_Function_Type::cSpecial: asprintf(&temp, "[c-special]"); break;
case C_Function_Type::cMacro: asprintf(&temp, "[c-macro]"); break; case C_Function_Type::cMacro: asprintf(&temp, "[c-macro]"); break;
default: return strdup("[c-??]"); default: return _strdup("[c-??]");
} }
} }
return temp; return temp;
} else { } else {
switch (node->value.function->type.lisp_function_type) { switch (node->value.function->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: return strdup("[lambda]"); case Lisp_Function_Type::Lambda: return _strdup("[lambda]");
case Lisp_Function_Type::Macro: return strdup("[macro]"); case Lisp_Function_Type::Macro: return _strdup("[macro]");
default: return strdup("[??]"); default: return _strdup("[??]");
} }
} }
} break; } break;
@@ -444,11 +444,11 @@ namespace Slime {
if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym) if (symbol == quote_sym || symbol == unquote_sym || symbol == unquote_splicing_sym)
{ {
if (symbol == quote_sym) if (symbol == quote_sym)
string_builder.append(strdup("\'")); string_builder.append(_strdup("\'"));
else if (symbol == unquote_sym) else if (symbol == unquote_sym)
string_builder.append(strdup(",")); string_builder.append(_strdup(","));
else if (symbol == unquote_splicing_sym) 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_type(head->value.pair.rest, Lisp_Object_Type::Pair);
assert("The list must end here.", 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)); string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
return string_buider_to_string(string_builder); return string_buider_to_string(string_builder);
} else if (symbol == quasiquote_sym) { } else if (symbol == quasiquote_sym) {
string_builder.append(strdup("`")); string_builder.append(_strdup("`"));
assert_type(head->value.pair.rest, Lisp_Object_Type::Pair); 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)); string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
return string_buider_to_string(string_builder); 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 // NOTE(Felix): We could do a while true here, however in case
// we want to print a broken list (for logging the error) we // we want to print a broken list (for logging the error) we
@@ -475,15 +475,15 @@ namespace Slime {
head = head->value.pair.rest; head = head->value.pair.rest;
if (!head) break; if (!head) break;
if (head->type != Lisp_Object_Type::Pair) break; if (head->type != Lisp_Object_Type::Pair) break;
string_builder.append(strdup(" ")); string_builder.append(_strdup(" "));
} }
if (head && head != Memory::nil) { 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(lisp_object_to_string(head, print_repr));
} }
string_builder.append(strdup(")")); string_builder.append(_strdup(")"));
return string_buider_to_string(string_builder); return string_buider_to_string(string_builder);
} }
src/memory.cpp
+3 -3
View File
@@ -129,6 +129,7 @@ namespace Slime::Memory {
// free the exe dir: // free the exe dir:
free(Globals::load_path.data[0]); free(Globals::load_path.data[0]);
// Globals::load_path.dealloc(); // Globals::load_path.dealloc();
Globals::user_types.dealloc();
Globals::docs.dealloc(); Globals::docs.dealloc();
Globals::Current_Execution::envi_stack.dealloc(); Globals::Current_Execution::envi_stack.dealloc();
Globals::Current_Execution::cs.dealloc(); Globals::Current_Execution::cs.dealloc();
@@ -204,6 +205,7 @@ namespace Slime::Memory {
Globals::Current_Execution::mes.alloc(); Globals::Current_Execution::mes.alloc();
Globals::docs.alloc(); Globals::docs.alloc();
Globals::user_types.alloc();
// Globals::load_path.alloc(); // Globals::load_path.alloc();
add_to_load_path(exe_path); add_to_load_path(exe_path);
add_to_load_path("../bin/"); add_to_load_path("../bin/");
@@ -224,9 +226,7 @@ namespace Slime::Memory {
try_void env = create_built_ins_environment(); try_void env = create_built_ins_environment();
push_environment(env); push_environment(env);
Environment* user_env;
try_void user_env = Memory::create_child_environment(env);
push_environment(user_env);
} }
src/testing.cpp
+4 -4
View File
@@ -632,10 +632,10 @@ namespace Slime {
invoke_test_script("macro_expand"); invoke_test_script("macro_expand");
invoke_test_script("sicp"); invoke_test_script("sicp");
invoke_test_script("simple_built_ins"); invoke_test_script("simple_built_ins");
// invoke_test_script("modules"); invoke_test_script("modules");
// invoke_test_script("class_macro"); invoke_test_script("class_macro");
// invoke_test_script("automata"); invoke_test_script("automata");
// invoke_test_script("alists"); invoke_test_script("alists");
return result; return result;
} }