Now usable

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))

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

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))
+    ))
+

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  ^

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;
 

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);

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);
         }

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);
+
     }
 
 

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;
     }