made source_Code_Locations more reliable (sill oncorrect sometimes)

bin/test.slime

@@ -1,77 +0,0 @@
-(define-syntax defclass (name members :rest body)
-  "Macro for creatating classes."
-  (defun underscore (sym)
-    (string->symbol (concat-strings "_" (symbol->string sym))))
-
-  (define underscored-members (map underscore members))
-
-  ;; the wrapping let environment
-  (define let-body (list 'let (zip members underscored-members)))
-
-  ;; the body
-  (map (lambda (fun) (append let-body fun)) body)
-
-  ;; the dispatch function
-  (append let-body (list 'special-lambda '(message :rest args)
-                         "This is the docs for the handle"
-                         '(eval (extend (list message) args))))
-
-
-  ;; stuff it all in the constructor function
-  (eval (list 'defun (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members
-              "This is the handle to an object of the class "
-              let-body)))
-
-;; (v1 print)
-;; (v1 length)
-;; (v1 get-x)
-;; (v1 set-x 10)
-
-(defclass vector3 (x y z)
-  (defun get-x () x)
-  (defun get-y () y)
-  (defun get-z () z)
-
-  (defun set-x  (new-x) (mutate x new-x))
-  (defun set-y  (new-y) (mutate y new-y))
-  (defun set-z  (new-z) (mutate z new-z))
-
-  (defun length ()
-    (** (+ (* x x) (* y y) (* z z)) 0.5))
-
-  (defun scale (fac)
-    (mutate x (* fac x))
-    (mutate y (* fac y))
-    (mutate z (* fac z))
-    fac)
-
-  (defun add (other)
-    (make-vector3
-     (+ x (other get-x))
-     (+ y (other get-y))
-     (+ z (other get-z))))
-
-  (defun subtract (other)
-    (make-vector3
-     (- x (other get-x))
-     (- y (other get-y))
-     (- z (other get-z))))
-
-  (defun scalar-product (other)
-    (+ (* x (other get-x))
-       (* y (other get-y))
-       (* z (other get-z))))
-
-  (defun 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)))))
-
-  (defun printout ()
-    (printf "[vector3] (" x  y  z ")"))
-  )
-
-(define v1 (make-vector3 1 2 3))
-(define v2 (make-vector3 3 2 1))
-

bin/tests/class_macro.slime

@@ -78,4 +78,4 @@
 (define v1 (make-vector3 1 2 3))
 (define v2 (make-vector3 3 2 1))
 
-(v1 scalar-product v2)
+(assert (= (v1 scalar-product v2) 10))

bin/tests/lexical_scope.slime

@@ -0,0 +1,11 @@
+(defun make-counter ()
+  (let ((var 0))
+    (lambda ()
+      (mutate var (+ 1 var))
+      var)))
+
+(define counter (make-counter))
+
+(assert (= (counter) 1))
+(assert (= (counter) 3))
+(assert (= (counter) 3))

build.bat

@@ -17,7 +17,9 @@ if %errorlevel% == 0 (
    echo.
    echo Done
    echo.
-   call timecmd slime.exe --run-tests
+   pushd ..\bin
+   call timecmd ..\build\slime.exe --run-tests
+   popd
 ) else (
   echo.
   echo Fuckin' ell

src/built_ins.cpp

@@ -55,7 +55,7 @@ proc built_in_load(String* file_name, Environment* env) -> Lisp_Object* {
         }
         return result;
     } else {
-        create_error(Error_Type::Unknown_Error, nullptr);
+        create_error(Error_Type::File_Not_Found, nullptr);
         return nullptr;
     }
 }
@@ -66,7 +66,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
 
 #define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
 #define report_error(_type) {                                   \
-        create_error(_type, arguments->sourceCodeLocation);     \
+        create_error(_type, current_source_code_location);      \
         return nullptr;                                         \
     }
 
@@ -294,6 +294,23 @@ proc load_built_ins_into_environment(Environment* env) -> void {
 
             return Memory::create_lisp_object_number(pow(base, exponent));
         });
+    defun("assert", cLambda {
+            int arguments_length;
+            debug_break();
+            try {
+                arguments = eval_arguments(arguments, env, &arguments_length);
+            }
+
+            if (arguments_length != 1) {
+                report_error(Error_Type::Wrong_Number_Of_Arguments);
+            }
+
+            if (is_truthy(arguments->value.pair->first, env))
+                return Memory::t;
+
+            report_error(Error_Type::Assertion_Error);
+            return nullptr;
+        });
     defun("define", cLambda {
             try {
                 arguments_length = list_length(arguments);
@@ -1069,7 +1086,23 @@ proc load_built_ins_into_environment(Environment* env) -> void {
             }
             report_error(Error_Type::Unknown_Error);
         });
+    defun("symbol->keyword", cLambda {
+            try {
+                evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
+            }
 
+            if (arguments_length != 1) {
+                report_error(Error_Type::Wrong_Number_Of_Arguments);
+            }
+
+            Lisp_Object* source = evaluated_arguments->value.pair->first;
+
+            if (source->type != Lisp_Object_Type::Symbol) {
+                report_error(Error_Type::Type_Missmatch);
+            }
+
+            return Memory::get_or_create_lisp_object_keyword(source->value.string);
+        });
     defun("string->symbol", cLambda {
 
             // TODO(Felix): do some sanity checks on the string. For

src/error.cpp

@@ -18,6 +18,8 @@ proc create_error(Error_Type type, Source_Code_Location* location) -> void {
 
 proc Error_Type_to_string(Error_Type type) -> const char* {
     switch (type) {
+    case Error_Type::Assertion_Error:           return "Assertion failed";
+    case Error_Type::File_Not_Found:            return "File not found";
     case Error_Type::Ill_Formed_Arguments:      return "Evaluation-error: Ill formed arguments";
     case Error_Type::Ill_Formed_Lambda_List:    return "Evaluation-error: Ill formed lambda list";
     case Error_Type::Ill_Formed_List:           return "Evaluation-error: Ill formed list";
@@ -32,7 +34,7 @@ proc Error_Type_to_string(Error_Type type) -> const char* {
     case Error_Type::Unknown_Keyword_Argument:  return "Evaluation-error: Unknown keyword argument";
     case Error_Type::Wrong_Number_Of_Arguments: return "Evaluation-error: Wrong number of arguments";
     case Error_Type::Out_Of_Memory:             return "Runtime-error: Out of memory";
-    default:                                    return "Unknown Error";
+    default:                                    return "this error type doesn't have a desciption..";
     }
 }
 

src/eval.cpp

@@ -1,3 +1,5 @@
+Source_Code_Location* current_source_code_location = nullptr;
+
 proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* {
     Environment* new_env = Memory::create_child_environment(function->parent_environment);
 
@@ -330,6 +332,7 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
             evaluated_arguments_head->value.pair->first =
                 eval_expr(current_head->value.pair->first, env);
         }
+        evaluated_arguments_head->value.pair->first->sourceCodeLocation = current_head->value.pair->first->sourceCodeLocation;
         current_head = current_head->value.pair->rest;
 
         if (current_head->type == Lisp_Object_Type::Pair) {
@@ -368,6 +371,8 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
         return symbol;
     }
     case Lisp_Object_Type::Pair: {
+        current_source_code_location = node->sourceCodeLocation;
+        
         Lisp_Object* lispOperator;
         if (node->value.pair->first->type != Lisp_Object_Type::CFunction &&
             node->value.pair->first->type != Lisp_Object_Type::Function)
@@ -464,7 +469,6 @@ proc interprete_stdin() -> void {
     char* line;
 
     built_in_load(Memory::create_string("pre.slime"), env);
-    built_in_load(Memory::create_string("test.slime"), env);
 
     if (error) {
         log_error();

src/forward_decls.cpp

@@ -1,3 +1,4 @@
+proc built_in_load(String*, Environment*) -> Lisp_Object*;
 proc print_environment(Environment*) -> void;
 proc eval_arguments(Lisp_Object*, Environment*, int*) -> Lisp_Object*;
 proc eval_expr(Lisp_Object*, Environment*) -> Lisp_Object*;

src/io.cpp

@@ -200,7 +200,7 @@ proc read_line() -> char* {
     }
     (*line)--; // we dont want the \n actually
     *line = '\0';
-    
+
     return linep;
 }
 

src/main.cpp

@@ -3,8 +3,7 @@
 int main(int argc, char* argv[]) {
     if (argc > 1) {
         if (Slime::string_equal(argv[1], "--run-tests")) {
-            Slime::run_all_tests();
-            return 0;
+            return Slime::run_all_tests() ? 0 : 1;
         }
 
         Slime::interprete_file(argv[1]);

src/parse.cpp

@@ -4,15 +4,15 @@ namespace Parser {
     int parser_line;
     int parser_col;
     // NOTE(Felix): In this environment, the build in functions will
-    // be loaded, and the macros will be stroed in form of
+    // be loaded, and the macros will be stored in form of
     // special-lambdas, that get executed in this environment at
     // read-time. This should always be the global environment.
     Environment* environment_for_macros;
 
     proc init(Environment* env) -> void {
         // NOTE(Felix): it is important to keep the parser environment
-        // up to date with the global environment. When donig tests,
-        // or running a programm we have to reaload it.
+        // up to date with the global environment. When doing tests,
+        // or running a programm we have to reload it.
 
         // NOTE(Felix): For now we just allow executing built-ins at
         // read-time (while creating macros). If later we want to
@@ -241,18 +241,21 @@ namespace Parser {
                 }
             }
 
+            Lisp_Object* ret = nullptr;
             if (quoteType == '\'')
-                return Memory::create_lisp_object_pair(
+                ret =  Memory::create_lisp_object_pair(
                     Memory::get_or_create_lisp_object_symbol("quote"),
                     Memory::create_lisp_object_pair(result, Memory::nil));
             else if (quoteType == '`')
-                return Memory::create_lisp_object_pair(
+                ret =  Memory::create_lisp_object_pair(
                     Memory::get_or_create_lisp_object_symbol("quasiquote"),
                     Memory::create_lisp_object_pair(result, Memory::nil));
-            // it has to be an unquote
-            return Memory::create_lisp_object_pair(
-                Memory::get_or_create_lisp_object_symbol("unquote"),
-                Memory::create_lisp_object_pair(result, Memory::nil));
+            else if (quoteType == ',')
+                ret =  Memory::create_lisp_object_pair(
+                    Memory::get_or_create_lisp_object_symbol("unquote"),
+                    Memory::create_lisp_object_pair(result, Memory::nil));
+            inject_scl(ret);
+            return ret;
         }
 
 
@@ -277,6 +280,7 @@ namespace Parser {
         Lisp_Object* expression = head;
 
         while (true) {
+            inject_scl(head);
             if (text[*index_in_text] == '(' ||
                 text[*index_in_text] == '\''||
                 text[*index_in_text] == '`' ||

src/slime.h

@@ -18,8 +18,8 @@ namespace Slime {
 #include "./io.cpp"
 #include "./env.cpp"
 #include "./parse.cpp"
-#include "./built_ins.cpp"
 #include "./eval.cpp"
+#include "./built_ins.cpp"
 #include "./testing.cpp"
 #include "./undefines.cpp"
 }

src/structs.cpp

@@ -27,11 +27,14 @@ enum struct Function_Type {
 };
 
 enum struct Error_Type {
+    Assertion_Error,
+    File_Not_Found,
     Ill_Formed_Arguments,
     Ill_Formed_Lambda_List,
     Ill_Formed_List,
     Not_A_Function,
     Not_Yet_Implemented,
+    Out_Of_Memory,
     Symbol_Not_Defined,
     Syntax_Error,
     Trailing_Garbage,
@@ -41,7 +44,6 @@ enum struct Error_Type {
     Unknown_Error,
     Unknown_Keyword_Argument,
     Wrong_Number_Of_Arguments,
-    Out_Of_Memory,
 };
 
 enum struct Log_Level {

src/testing.cpp

@@ -85,8 +85,9 @@
         printf("%spassed%s\n", console_green, console_normal);  \
     }                                                           \
     else {                                                      \
+        result = false;                                         \
         for(int i = -1; i < 70; ++i)                            \
-        printf((i%3==1)? "." : " ");                            \
+            printf((i%3==1)? "." : " ");                        \
         printf("%sfailed%s\n", console_red, console_normal);    \
         if(error) {                                             \
             free(error);                                        \
@@ -455,16 +456,42 @@ proc test_singular_t_and_nil() -> testresult {
 
     assert_no_error();
     assert_not_null(result3);
-    assert_equal_int(result3, Memory::t);
 
     return pass;
 }
 
-proc run_all_tests() -> void {
-    log_level = Log_Level::None;
+proc test_class_macro() -> testresult {
+    Memory::init();
+    Environment* env = Memory::create_built_ins_environment();
+    Parser::init(env);
+
+    built_in_load(Memory::create_string("pre.slime"), env);
+    Lisp_Object* result = built_in_load(Memory::create_string("tests/class_macro.slime"), env);
+
+    assert_no_error();
+
+    return pass;
+}
+
+proc test_lexical_scope() -> testresult {
+    Memory::init();
+    Environment* env = Memory::create_built_ins_environment();
+    Parser::init(env);
+
+    built_in_load(Memory::create_string("pre.slime"), env);
+    Lisp_Object* result = built_in_load(Memory::create_string("tests/lexical_scope.slime"), env);
+
+    assert_no_error();
+    return pass;
+}
+
+proc run_all_tests() -> bool {
+    // log_level = Log_Level::None;
     Memory::init();
     Parser::init(Memory::create_built_ins_environment());
 
+    bool result = true;
+
     printf("-- Parsing --\n");
     invoke_test(test_parse_atom);
     invoke_test(test_parse_expression);
@@ -486,10 +513,13 @@ proc run_all_tests() -> void {
     printf("\n-- Memory management --\n");
     invoke_test(test_singular_t_and_nil);
 
-    printf("\n-- Lexical scope --\n");
     printf("\n-- Macros --\n");
 
+    printf("\n-- Test Files --\n");
+    invoke_test(test_class_macro);
+    invoke_test(test_lexical_scope);
 
+    return result;
 }
 
 #undef epsilon

vs/slime.sln

@@ -6,16 +6,13 @@ MinimumVisualStudioVersion = 10.0.40219.1
 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "slime", "slime.vcxproj", "{1A47A3ED-871F-4CB4-875B-8CAA385B1771}"
 EndProject
 Global
-	GlobalSection(Performance) = preSolution
-		HasPerformanceSessions = true
-	EndGlobalSection
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|x64 = Debug|x64
 		Debug|x86 = Debug|x86
 		Release|x64 = Release|x64
 		Release|x86 = Release|x86
-		testfile|x64 = testfile|x64
-		testfile|x86 = testfile|x86
+		Tests|x64 = Tests|x64
+		Tests|x86 = Tests|x86
 	EndGlobalSection
 	GlobalSection(ProjectConfigurationPlatforms) = postSolution
 		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Debug|x64.ActiveCfg = Debug|x64
@@ -26,10 +23,10 @@ Global
 		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Release|x64.Build.0 = Release|x64
 		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Release|x86.ActiveCfg = Release|Win32
 		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Release|x86.Build.0 = Release|Win32
-		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.testfile|x64.ActiveCfg = testfile|x64
-		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.testfile|x64.Build.0 = testfile|x64
-		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.testfile|x86.ActiveCfg = testfile|Win32
-		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.testfile|x86.Build.0 = testfile|Win32
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x64.ActiveCfg = Tests|x64
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x64.Build.0 = Tests|x64
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x86.ActiveCfg = Tests|Win32
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x86.Build.0 = Tests|Win32
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE
@@ -40,4 +37,7 @@ Global
 	GlobalSection(Performance) = preSolution
 		HasPerformanceSessions = true
 	EndGlobalSection
+	GlobalSection(Performance) = preSolution
+		HasPerformanceSessions = true
+	EndGlobalSection
 EndGlobal

vs/slime.vcxproj

@@ -25,6 +25,14 @@
       <Configuration>testfile</Configuration>
       <Platform>x64</Platform>
     </ProjectConfiguration>
+    <ProjectConfiguration Include="Tests|Win32">
+      <Configuration>Tests</Configuration>
+      <Platform>Win32</Platform>
+    </ProjectConfiguration>
+    <ProjectConfiguration Include="Tests|x64">
+      <Configuration>Tests</Configuration>
+      <Platform>x64</Platform>
+    </ProjectConfiguration>
   </ItemGroup>
   <PropertyGroup Label="Globals">
     <VCProjectVersion>15.0</VCProjectVersion>
@@ -72,6 +80,13 @@
     <WholeProgramOptimization>true</WholeProgramOptimization>
     <CharacterSet>MultiByte</CharacterSet>
   </PropertyGroup>
+  <PropertyGroup Label="Configuration" Condition="'$(Configuration)|$(Platform)'=='Tests|Win32'">
+    <PlatformToolset>v141</PlatformToolset>
+  </PropertyGroup>
+  <PropertyGroup Label="Configuration" Condition="'$(Configuration)|$(Platform)'=='Tests|x64'">
+    <PlatformToolset>v141</PlatformToolset>
+    <CharacterSet>MultiByte</CharacterSet>
+  </PropertyGroup>
   <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
   <ImportGroup Label="ExtensionSettings">
   </ImportGroup>
@@ -170,6 +185,13 @@
       <SubSystem>NotSet</SubSystem>
     </Link>
   </ItemDefinitionGroup>
+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Tests|x64'">
+    <ClCompile>
+      <Optimization>Disabled</Optimization>
+      <BasicRuntimeChecks>EnableFastChecks</BasicRuntimeChecks>
+      <LanguageStandard>stdcpplatest</LanguageStandard>
+    </ClCompile>
+  </ItemDefinitionGroup>
   <ItemGroup>
     <ClCompile Include="..\src\main.cpp" />
   </ItemGroup>