define-typed working;; parsing keywords in lambdalists correctly next

bin/pre.slime

@@ -141,9 +141,6 @@ ithe sequence as arguemens."
        (assert-types= @lambda-list)
        @body)))
 
-(define-typed (ttt a :number b :alist)
-  (printf a b))
-
 (define-syntax (define-package name :rest body)
   `(define ,(string->symbol (concat-strings (symbol->string name) "->"))
      ((lambda ()
@@ -157,7 +154,6 @@ ithe sequence as arguemens."
                           (eval op))))
           :package)))))
 
-
 (define (null? x)
   "Checks if the argument is =nil=."
   (= x ()))
@@ -167,19 +163,25 @@ ithe sequence as arguemens."
   (= (type obj) typ))
 
 (define (types=? :rest objs)
-  ;; TODO make inner rec functoin to avoid evalutating every time
-  (if objs
-      (begin
-       (assert (keyword? (first (rest objs))))
-       (if (type=? (first objs) (first (rest objs)))
-           (apply types=? (rest (rest objs)))
-         ()))
+  (define (inner objs)
+    (if objs
+        (let ((actual-type  (type (first objs)))
+              (desired-type (first (rest objs))))
+          (if (= actual-type desired-type)
+              (inner (rest (rest objs)))
+            ()))
       t))
+  (inner objs))
 
 (define (assert-types= :rest objs)
-  (break)
-  (unless (apply types=? objs)
-    (error "assert-types=: types do not match")))
+  (define (inner objs)
+    (when objs
+        (let ((actual-type  (type (first objs)))
+              (desired-type (first (rest objs))))
+          (if (= actual-type desired-type)
+              (inner (rest (rest objs)))
+            (error "type missmatch" actual-type desired-type)))))
+  (inner objs))
 
 (define (number? x)
   "Checks if the argument is a number."