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 @@
Release
x64
-
- testfile
+
+ run tests
Win32
-
- testfile
- x64
-
-
- Tests
- Win32
-
-
- Tests
+
+ run tests
x64
@@ -48,7 +40,7 @@
v141
MultiByte
-
+
Application
true
v141
@@ -67,7 +59,7 @@
v141
MultiByte
-
+
Application
true
v141
@@ -80,13 +72,6 @@
true
MultiByte
-
- v141
-
-
- v141
- MultiByte
-
@@ -95,7 +80,7 @@
-
+
@@ -104,14 +89,13 @@
-
+
-
Level3
@@ -122,7 +106,7 @@
true
-
+
Level3
Disabled
@@ -144,12 +128,12 @@
true
-
+
Level3
Disabled
true
- CompileAsC
+ Default
stdcpplatest
@@ -185,13 +169,6 @@
NotSet
-
-
- Disabled
- EnableFastChecks
- stdcpplatest
-
-