Before implementing import name resolution, then after fic macro imports

bin/tests/class_macro.slime

@@ -1,35 +1,6 @@
-(define (type-wrap obj type)
-  (set-type obj type)
-  obj)
+(import "oo.slime")
 
-(define-syntax (defclass name members :rest body)
-  "Macro for creating classes."
-  (define (underscore sym)
-    (string->symbol (concat-strings "_" (symbol->string sym))))
-
-  (define underscored-members (map underscore members))
-
-  ;; the wrapping let environment
-  (define let-body `(let ,(zip members underscored-members)))
-
-  ;; the body
-  (map (lambda (fun) (append let-body fun)) body)
-
-  ;; the dispatch function
-  (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
-  `(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-class vector3 (x y z)
   (define (get-x) x)
   (define (get-y) y)
   (define (get-z) z)

bin/tests/class_macro.slime.expanded

@@ -1,6 +1,6 @@
-(define (type-wrap obj type) (set-type obj type) obj)
+(import "oo.slime")
 
-(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 (print) (printf :sep "" "[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-class vector3 (x y 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 (print) (printf :sep "" "[vector3] (" x y z ")")))
 
 (define v1 (make-vector3 1 2 3))
 

bin/tests/lexical_scope.slime

@@ -1,3 +1,5 @@
+;; regular arguments
+
 (define (make-counter)
   (let ((var 0))
     (lambda ()
@@ -5,12 +7,47 @@
       var)))
 
 (define counter1 (make-counter))
+
 (assert (= (counter1) 1))
 
 (define counter2 (make-counter))
+
 (assert (= (counter2) 1))
 
 (assert (= (counter2) 2))
 (assert (= (counter1) 2))
 (assert (= (counter1) 3))
 (assert (= (counter2) 3))
+(assert (= (counter2) 4))
+(assert (= (counter2) 5))
+(assert (= (counter1) 4))
+(assert (= (counter1) 5))
+
+;; key arguments
+
+(define (make-key-counter)
+  ((lambda (:keys var)
+     (lambda ()
+       (mutate var (+ 1 var))
+       var))
+   :var 0))
+
+
+(define key-counter1 (make-key-counter))
+
+(assert (= (key-counter1) 1))
+
+(define key-counter2 (make-key-counter))
+
+(assert (= (key-counter2) 1))
+
+(assert (= (key-counter2) 2))
+(assert (= (key-counter1) 2))
+(assert (= (key-counter1) 3))
+(assert (= (key-counter2) 3))
+(assert (= (key-counter2) 4))
+(assert (= (key-counter2) 5))
+(assert (= (key-counter1) 4))
+(assert (= (key-counter1) 5))
+
+;; rest arguments will no be copied so we don't need to test them here

bin/tests/lexical_scope.slime.expanded

@@ -16,3 +16,37 @@
 
 (assert (= (counter2) 3))
 
+(assert (= (counter2) 4))
+
+(assert (= (counter2) 5))
+
+(assert (= (counter1) 4))
+
+(assert (= (counter1) 5))
+
+(define (make-key-counter) ((lambda (:keys var) (lambda () (mutate var (+ 1 var)) var)) :var 0))
+
+(define key-counter1 (make-key-counter))
+
+(assert (= (key-counter1) 1))
+
+(define key-counter2 (make-key-counter))
+
+(assert (= (key-counter2) 1))
+
+(assert (= (key-counter2) 2))
+
+(assert (= (key-counter1) 2))
+
+(assert (= (key-counter1) 3))
+
+(assert (= (key-counter2) 3))
+
+(assert (= (key-counter2) 4))
+
+(assert (= (key-counter2) 5))
+
+(assert (= (key-counter1) 4))
+
+(assert (= (key-counter1) 5))
+

bin/tests/macro_expand.slime

@@ -0,0 +1,13 @@
+(define-syntax (error)
+  (assert t))
+
+
+(define-syntax (test)
+  `(begin
+    (+ 1 1)
+    (error)
+    (+ 1 1)))
+
+(test)
+
+(assert t)