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

Fixed symbol->keyword added type for the class handle in the test

Browse Source
This commit is contained in:
FelixBrendel
2019-03-15 12:58:23 +01:00
parent 31a833b5c9
commit fac0ed352d
6 changed files with 42 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/tests/class_macro.slime
+9 -39
View File
@@ -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))))
;; 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 ")"))
(append let-body `(type-wrap
(special-lambda
(message :rest args)
"This is the docs for the handle"
(eval (extend (list message) args)))))
(eval (extend (list message) args))) ,(symbol->keyword name)))
;; stuff it all in the constructor function
`(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))
;; (v1 print)
;; (v1 length)
;; (v1 get-x)
;; (v1 set-x 10)
(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))
bin/tests/class_macro.slime.expanded
+3 -3
View File
@@ -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))
src/built_ins.cpp
+2 -3
View File
@@ -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 {
src/eval.cpp
+5
View File
@@ -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;
}
vs/slime.sln
+10 -4
View File
@@ -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
vs/slime.vcxproj
+11 -34
View File
@@ -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>