From fac0ed352d449b43a9e76d3039cdca7e630aea0f Mon Sep 17 00:00:00 2001
From: FelixBrendel <felix.brendel@freenet.de>
Date: Fri, 15 Mar 2019 12:58:23 +0100
Subject: [PATCH] Fixed symbol->keyword added type for the class handle in the
 test

---
 bin/tests/class_macro.slime          | 54 +++++++---------------------
 bin/tests/class_macro.slime.expanded |  6 ++--
 src/built_ins.cpp                    |  5 ++-
 src/eval.cpp                         |  5 +++
 vs/slime.sln                         | 14 +++++---
 vs/slime.vcxproj                     | 45 ++++++-----------------
 6 files changed, 43 insertions(+), 86 deletions(-)

diff --git a/bin/tests/class_macro.slime b/bin/tests/class_macro.slime
index 6761da0..bf391d9 100644
--- a/bin/tests/class_macro.slime
+++ b/bin/tests/class_macro.slime
@@ -10,55 +10,24 @@
   (define underscored-members (map underscore members))
 
   ;; the wrapping let environment
-  (define let-body (list 'let (zip members underscored-members)))
+  (define let-body `(let ,(zip members underscored-members)))
 
   ;; the body
   (map (lambda (fun) (append let-body fun)) body)
 
   ;; the dispatch function
-  (append let-body '(special-lambda
-                     (message :rest args)
-                     "This is the docs for the handle"
-                     (eval (extend (list message) args))))
+  (append let-body `(type-wrap
+                     (special-lambda
+                      (message :rest args)
+                      "This is the docs for the handle"
+                      (eval (extend (list message) args))) ,(symbol->keyword name)))
 
   ;; stuff it all in the constructor function
-  (list 'define
-        (pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
-        "This is the handle to an object of the class "
-        let-body))
-
-(define (make-vector3 _x _y _z)
-  "This is the handle to an object of the class "
-  (let ((x _x)
-        (y _y)
-        (z _z))
-
-    (define (get-x) x)
-    (define (get-y) y)
-    (define (get-z) z)
-
-    (define (set-x new-x) (mutate x new-x))
-    (define (set-y new-y) (mutate y new-y))
-    (define (set-z new-z) (mutate z new-z))
-
-    (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000))
-    (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac)
-    (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z))))
-    (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z))))
-    (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z))))
-    (define (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)))))
-    (define (printout) (printf "[vector3] (" x y z ")"))
-
-    (special-lambda
-     (message :rest args)
-     "This is the docs for the handle"
-     (eval (extend (list message) args)))))
-
-
-;; (v1 print)
-;; (v1 length)
-;; (v1 get-x)
-;; (v1 set-x 10)
+  `(define
+     ,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
+     ,(concat-strings "This is the handle to an object of the class " (symbol->string name))
+     ,let-body))
+
 
 (defclass vector3 (x y z)
   (define (get-x) x)
@@ -109,3 +78,4 @@
 (define v2 (make-vector3 3 2 1))
 
 (assert (= (v1 scalar-product v2) 10))
+(assert (= (type v1) :vector3))
diff --git a/bin/tests/class_macro.slime.expanded b/bin/tests/class_macro.slime.expanded
index 1c0d9fe..c6c6308 100644
--- a/bin/tests/class_macro.slime.expanded
+++ b/bin/tests/class_macro.slime.expanded
@@ -1,8 +1,6 @@
 (define (type-wrap obj type) (set-type obj type) obj)
 
-(define (make-vector3 _x _y _z) "This is the handle to an object of the class " (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (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))))) (define (printout) (printf "[vector3] (" x y z ")")) (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args)))))
-
-(define (make-vector3 _x _y _z) "This is the handle to an object of the class " (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (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))))) (define (printout) (printf "[vector3] (" x y z ")")) (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args)))))
+(define (make-vector3 _x _y _z) "This is the handle to an object of the class vector3" (let ((x _x) (y _y) (z _z)) (define (get-x) x) (define (get-y) y) (define (get-z) z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ x (other get-x)) (+ y (other get-y)) (+ z (other get-z)))) (define (subtract other) (make-vector3 (- x (other get-x)) (- y (other get-y)) (- z (other get-z)))) (define (scalar-product other) (+ (* x (other get-x)) (* y (other get-y)) (* z (other get-z)))) (define (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))))) (define (printout) (printf "[vector3] (" x y z ")")) (type-wrap (special-lambda (message :rest args) "This is the docs for the handle" (eval (extend (list message) args))) :vector3)))
 
 (define v1 (make-vector3 1.000000 2.000000 3.000000))
 
@@ -10,3 +8,5 @@
 
 (assert (= (v1 scalar-product v2) 10.000000))
 
+(assert (= (type v1) :vector3))
+
diff --git a/src/built_ins.cpp b/src/built_ins.cpp
index 5ef2e9b..0f094b6 100644
--- a/src/built_ins.cpp
+++ b/src/built_ins.cpp
@@ -339,7 +339,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
         });
     defun("assert", cLambda {
             int arguments_length;
-            debug_break();
+
             try {
                 arguments = eval_arguments(arguments, env, &arguments_length);
             }
@@ -872,7 +872,6 @@ proc load_built_ins_into_environment(Environment* env) -> void {
                 assert_type(type, Lisp_Object_Type::Keyword);
             }
 
-
             evaluated_arguments->value.pair->first->userType = type;
             return type;
         });
@@ -1164,7 +1163,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
                 report_error(Error_Type::Type_Missmatch);
             }
 
-            return Memory::get_or_create_lisp_object_keyword(source->value.string);
+            return Memory::get_or_create_lisp_object_keyword(source->value.symbol->identifier);
         });
     defun("string->symbol", cLambda {
 
diff --git a/src/eval.cpp b/src/eval.cpp
index 52ba6b2..4dd580c 100644
--- a/src/eval.cpp
+++ b/src/eval.cpp
@@ -42,6 +42,11 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) ->
             }
         }
         if (!accepted) {
+            // TODO(Felix): if we are actually done with all the
+            // necessary keywords then we have to count the rest
+            // as :rest here, instead od always creating an error
+            // (special case with default variables)
+            puts("??");
             create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
             return nullptr;
         }
diff --git a/vs/slime.sln b/vs/slime.sln
index 0eeeea2..ff3f603 100644
--- a/vs/slime.sln
+++ b/vs/slime.sln
@@ -11,6 +11,8 @@ Global
 		Debug|x86 = Debug|x86
 		Release|x64 = Release|x64
 		Release|x86 = Release|x86
+		run tests|x64 = run tests|x64
+		run tests|x86 = run tests|x86
 		Tests|x64 = Tests|x64
 		Tests|x86 = Tests|x86
 	EndGlobalSection
@@ -23,10 +25,14 @@ 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}.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
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.run tests|x64.ActiveCfg = run tests|x64
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.run tests|x64.Build.0 = run tests|x64
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.run tests|x86.ActiveCfg = run tests|Win32
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.run tests|x86.Build.0 = run tests|Win32
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x64.ActiveCfg = run tests|x64
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x64.Build.0 = run tests|x64
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x86.ActiveCfg = run tests|Win32
+		{1A47A3ED-871F-4CB4-875B-8CAA385B1771}.Tests|x86.Build.0 = run tests|Win32
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE
diff --git a/vs/slime.vcxproj b/vs/slime.vcxproj
index 95c5bf6..64909c5 100644
--- a/vs/slime.vcxproj
+++ b/vs/slime.vcxproj
@@ -17,20 +17,12 @@
       <Configuration>Release</Configuration>
       <Platform>x64</Platform>
     </ProjectConfiguration>
-    <ProjectConfiguration Include="testfile|Win32">
-      <Configuration>testfile</Configuration>
+    <ProjectConfiguration Include="run tests|Win32">
+      <Configuration>run tests</Configuration>
       <Platform>Win32</Platform>
     </ProjectConfiguration>
-    <ProjectConfiguration Include="testfile|x64">
-      <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>
+    <ProjectConfiguration Include="run tests|x64">
+      <Configuration>run tests</Configuration>
       <Platform>x64</Platform>
     </ProjectConfiguration>
   </ItemGroup>
@@ -48,7 +40,7 @@
     <PlatformToolset>v141</PlatformToolset>
     <CharacterSet>MultiByte</CharacterSet>
   </PropertyGroup>
-  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='testfile|Win32'" Label="Configuration">
+  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='run tests|Win32'" Label="Configuration">
     <ConfigurationType>Application</ConfigurationType>
     <UseDebugLibraries>true</UseDebugLibraries>
     <PlatformToolset>v141</PlatformToolset>
@@ -67,7 +59,7 @@
     <PlatformToolset>v141</PlatformToolset>
     <CharacterSet>MultiByte</CharacterSet>
   </PropertyGroup>
-  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='testfile|x64'" Label="Configuration">
+  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='run tests|x64'" Label="Configuration">
     <ConfigurationType>Application</ConfigurationType>
     <UseDebugLibraries>true</UseDebugLibraries>
     <PlatformToolset>v141</PlatformToolset>
@@ -80,13 +72,6 @@
     <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>
@@ -95,7 +80,7 @@
   <ImportGroup Label="PropertySheets" Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
     <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
   </ImportGroup>
-  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='testfile|Win32'" Label="PropertySheets">
+  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='run tests|Win32'" Label="PropertySheets">
     <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
   </ImportGroup>
   <ImportGroup Label="PropertySheets" Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
@@ -104,14 +89,13 @@
   <ImportGroup Label="PropertySheets" Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
     <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
   </ImportGroup>
-  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='testfile|x64'" Label="PropertySheets">
+  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='run tests|x64'" Label="PropertySheets">
     <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
   </ImportGroup>
   <ImportGroup Label="PropertySheets" Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
     <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
   </ImportGroup>
   <PropertyGroup Label="UserMacros" />
-  <PropertyGroup />
   <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
     <ClCompile>
       <WarningLevel>Level3</WarningLevel>
@@ -122,7 +106,7 @@
       <Profile>true</Profile>
     </Link>
   </ItemDefinitionGroup>
-  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='testfile|Win32'">
+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='run tests|Win32'">
     <ClCompile>
       <WarningLevel>Level3</WarningLevel>
       <Optimization>Disabled</Optimization>
@@ -144,12 +128,12 @@
       <Profile>true</Profile>
     </Link>
   </ItemDefinitionGroup>
-  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='testfile|x64'">
+  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='run tests|x64'">
     <ClCompile>
       <WarningLevel>Level3</WarningLevel>
       <Optimization>Disabled</Optimization>
       <SDLCheck>true</SDLCheck>
-      <CompileAs>CompileAsC</CompileAs>
+      <CompileAs>Default</CompileAs>
       <LanguageStandard>stdcpplatest</LanguageStandard>
     </ClCompile>
     <Link>
@@ -185,13 +169,6 @@
       <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>