diff options
Diffstat (limited to 'petty-types.lisp')
| -rw-r--r-- | petty-types.lisp | 28 |
1 files changed, 28 insertions, 0 deletions
diff --git a/petty-types.lisp b/petty-types.lisp index 9392191..c48f37a 100644 --- a/petty-types.lisp +++ b/petty-types.lisp @@ -55,6 +55,30 @@ member is the NTH member of TYPES." :always (typep x ty) :finally (return (and (endp xs2) (endp types2))))))))))) + +(defun hash-table-predicate (from to) + "Returns the name of the predicate that checks whether its argument is +a hasth table with keys of type FROM and values of type TO." + (assert (type-specifier-p from) (from) "~a is not a type specifier" from) + (assert (type-specifier-p to) (to) "~a is not a type specifier" to) + (let ((name + (let ((*package* #.(find-package :petty-types))) + (apply #'a:symbolicate + (nconc + (list :hash-table-from-) + (mapcar #'write-to-string (a:flatten from)) + (list :-to-) + (mapcar #'write-to-string (a:flatten to))))))) + (prog1 name + (unless (fboundp name) + (setf (symbol-function name) + (lambda (tb) + (and (hash-table-p tb) + (loop :for key :being :the :hash-keys :of tb + :using (:hash-value val) + :always (typep key from) + :always (typep val to))))))))) + (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)))) @@ -74,3 +98,7 @@ member is the NTH member of TYPES." (deftype optional (type) "Type specifier for an optional type." `(or null ,type)) + +(deftype table (from to) + "Type specifier for typed hash table." + `(and hash-table (satisfies ,(hash-table-predicate from to)))) |