Before implementing import name resolution, then after fic macro imports

bin/a.slime

@@ -0,0 +1 @@
+(define-syntax (e x) x)

bin/b.slime

@@ -0,0 +1,3 @@
+(import "a.slime")
+
+(printf (e 2))

bin/math.slime

@@ -0,0 +1,57 @@
+(import "oo.slime")
+
+(define-package math
+
+  (define pi 3.14159265)
+
+  (define (abs x)
+    (if (> x 0) x (- x)))
+
+  (define (sqrt x)
+    (** x 0.5))
+
+  (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.5))
+
+    (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 ")"))
+    )
+)

bin/oo.slime

@@ -0,0 +1,29 @@
+(define-syntax (define-class 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
+  (extend let-body body)
+  ;; (map (lambda (fun) (append let-body fun)) body)
+
+  ;; the dispatch function
+  (append let-body `(set-type
+                     (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
+     ;; The function definition
+     ,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
+     ;; The docstring
+     ,(concat-strings "This is the handle to an object of the class " (symbol->string name))
+     ;; the body
+     ,let-body))

bin/pre.slime

@@ -53,7 +53,23 @@
 (define-syntax (define-special name-and-args :rest body)
   `(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body)))
 
-(define-syntax (do-list :rest body)
+(define-syntax (construct-list :rest body)
+  "
+(construct-list
+  i <- '(1 2 3 4 5)
+  yield (* i i))
+
+(construct-list
+  i <- '(1 2 3 4)
+  j <- '(A B)
+  yield (pair i j))
+
+(construct-list
+  i <- '(1 2 3 4 5 6 7 8)
+  when (evenp i)
+  yield i)
+
+"
   (define (append-map f ll)
     (unless (= ll ())
       (define val (f (first ll)))
@@ -73,32 +89,29 @@
       `(if ,(first (rest body)) ,(rec (rest (rest body)))))
      ((= (first body) 'yield)
       (first (rest body)))
-     (t (error "Not a do-able expression: ~S" `(quote ,body))))
-    )
+     (else (error "Not a do-able expression"))))
+
   (rec body))
 
+(define-syntax (apply fun seq)
+  "Applies the funciton to the sequence, as in calls the function with
+ithe sequence as arguemens."
+  `(eval (pair ,fun ,seq)))
 
-;; (define (append-map f ll)
-  ;; (unless (= ll ())
-    ;; (define val (f (first ll)))
-    ;; (if (= (first val) ())
-        ;; (append-map f (rest ll))
-      ;; (extend
-       ;; val
-       ;; (append-map f (rest ll))))))
 
-  ;; (define-special (do-list :rest body)
-    ;; (cond
-     ;; ((= () body) ())
-     ;; ((= () (rest body)) (first body))
-     ;; ((= (first (rest body)) '<-)
-      ;; `(,append-map (lambda (,(first body)) (list ,(eval `(do-list @(rest (rest (rest body))))))) ,(first (rest (rest body)))))
-     ;; ((= (first body) 'when)
-      ;; `(if ,(first (rest body)) ,(eval `(do-list @(rest (rest body))))))
-     ;; ((= (first body) 'yield)
-      ;; (first (rest body)))
-     ;; (t (error "Not a do-able expression: ~S" `(quote ,body))))
-    ;; )
+(define-syntax (define-package name :rest body)
+  `(define ,(string->symbol (concat-strings (symbol->string name) "->"))
+     ((lambda ()
+        @body
+        (set-type
+          (special-lambda (:rest args)
+                      (let ((op   (first args))
+                            (args (rest  args)))
+                        (cond ((= op 'pi)  3.14159265)
+                              (else (try (apply op args)
+                                         (error "The package does not contain this operation"))))))
+          :package)))))
+
 
 (define (nil? x)
   "Checks if the argument is nil."
@@ -136,11 +149,6 @@
   "Checks if the argument is a built-in function."
   (= (type x) :built-in-function))
 
-(define (apply fun seq)
-  "Applies the funciton to the sequence, as in calls the function with
-ithe sequence as arguemens."
-  (eval (pair fun seq)))
-
 (define (end seq)
   "Returns the last pair in the sqeuence."
   (if (or (nil? seq) (not (pair? (rest seq))))

bin/pre.slime.expanded

@@ -16,9 +16,6 @@
 
 (define (built-n-function? x) "Checks if the argument is a built-in function." (= (type x) :built-in-function))
 
-(define (apply fun seq) "Applies the funciton to the sequence, as in calls the function with
-ithe sequence as arguemens." (eval (pair fun seq)))
-
 (define (end seq) "Returns the last pair in the sqeuence." (if (or (nil? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
 
 (define (last seq) "Returns the (first) of the last (pair) of the given sequence." (first (end seq)))
@@ -52,7 +49,7 @@ elemens as argument to that function." (if (nil? seq) seq (pair (fun (first seq)
 function to the argument sequence. This only works correctly if
 the given function accepts a variable amount of parameters. If
 your funciton is limited to two arguments, use `reduce-binary'
-instead." (apply fun seq))
+instead." (eval (pair fun seq)))
 
 (define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the
 function to the argument sequence. reduce-binary applies the

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)