Add: TUPLE deftype

1 files changed, 23 insertions, 0 deletions

diff --git a/petty-types.lisp b/petty-types.lisp
index 060f29d..a45e898 100644
--- a/petty-types.lisp
+++ b/petty-types.lisp
@@ -33,6 +33,25 @@
                        (or (not len) (= len (length xs)))
                        (every is-type xs)))))))))
 
+(defun ordered-sequence-of (types)
+  "Returns the name of a predicate that checks whether its argument is a
+list of exactly (LENGTH TYPES) members such that the type of the NTH
+member is the NTH member of TYPES."
+  (assert (every #'type-specifier-p types) (types)
+          "At least one member of ~s is not a type specifier"
+          types)
+  (let ((name
+          (apply #'a:symbolicate :tuple- (mapcar #'write-to-string (a:flatten types)))))
+    (prog1 name
+      (unless (fboundp name)
+        (setf (symbol-function name)
+              (lambda (xs)
+                (and (listp xs)
+                     (loop :for (x . xs2) :on xs
+                           :for (ty . types2) :on types
+                           :always (typep x ty)
+                           :finally (return (and (endp xs2) (endp types2)))))))))))
+
 (deftype list-of (type &optional len)
   "Type specifier for lists all of the same TYPE."
   `(and list (satisfies ,(sequence-of-predicate-for 'list type len))))
@@ -41,6 +60,10 @@
   "Type specifier for vectors all of the same TYPE."
   `(and vector (satisfies ,(sequence-of-predicate-for 'vector type len))))
 
+(deftype tuple (&rest types)
+  "Type specifier for a list of specific types"
+  `(and list (satisfies ,(ordered-sequence-of types))))
+
 (deftype optional (type)
   "Type specifier for an optional type."
   `(or null ,type))