diff options
| -rw-r--r-- | README.org | 1 | ||||
| -rw-r--r-- | package.lisp | 4 | ||||
| -rw-r--r-- | petty-types.lisp | 28 |
3 files changed, 32 insertions, 1 deletions
@@ -7,6 +7,7 @@ A tiny library that provides + ~(list-of type &optional len)~ DEFTYPE for a LIST of elements with TYPE + ~(vector-of type &optional len)~ DEFTYPE for a VECTOR of elements with TYPE + ~(tuple &rest types)~ DEFTYPE for a list of exactly TYPES ++ ~(table from to)~ DEFTYPE for a hashtable Here are some examples: diff --git a/package.lisp b/package.lisp index 1bf33cb..0f5cf89 100644 --- a/package.lisp +++ b/package.lisp @@ -10,4 +10,6 @@ #:tuple ; deftype #:vector-of ; deftype #:sequence-of ; deftype - #:list-of)) ; deftype + #:list-of ; deftype + #:table ; deftype + )) 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)))) |