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

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