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
(symbol->string orig-export-name)))))
exports))
(disable-debug-log)
))
(disable-debug-log)))
(define-syntax (generic-extend args . body)
(let ((fun-name (first args))
bin/tests/modules.slime
+1 -1
View File
@@ -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
bin/tests/simple_built_ins.slime
+40 -40
View File
@@ -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)))
;; (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 (not (bound? var1)))
;; (assert (not (bound? var2)))
;; (assert (not (bound? var3)))
(assert (= (let ((val 'sym))
val)
'sym))
;; (assert (= (let ((val 'sym))
;; val)
;; 'sym))
(assert (= (let ()
'sym)
'sym))
;;
;; Quasiquote testing
;;
(assert (= '() `()))
;; (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 ,1 2)))
;; (assert (= '(1 1 2)
;; `(1 ,1 2)))
(assert (= '(1 1 2)
`(1 ,(- 10 9) 2)))
;; (assert (= '(1 1 2)
;; `(1 ,(- 10 9) 2)))
(assert (= '(1 1 2)
`(1 ,@(list 1 2))))
;; (assert (= '(1 1 2)
;; `(1 ,@(list 1 2))))
(let ((body '(2 3)))
(assert (= '(1 2 3)
`(1 ,@body))))
;; (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))
))
build.bat
+2 -1
View File
@@ -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 ^
src/built_ins.cpp
+11 -11
View File
@@ -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;
src/eval.cpp
+5
View File
@@ -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);
src/io.cpp
+21 -21
View File
@@ -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);
}
src/memory.cpp
+3 -3
View File
@@ -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);
}
src/testing.cpp
+4 -4
View File
@@ -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;
}