From f4a370645f5f49669ce1cf646b6ab8243242a007 Mon Sep 17 00:00:00 2001 From: colin Date: Sun, 28 Jul 2024 08:24:03 -0700 Subject: Initial Commit --- petty-types.lisp | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 petty-types.lisp (limited to 'petty-types.lisp') diff --git a/petty-types.lisp b/petty-types.lisp new file mode 100644 index 0000000..1d092b9 --- /dev/null +++ b/petty-types.lisp @@ -0,0 +1,43 @@ +;;;; petty-types.lisp + +(in-package #:petty-types) + +(defun type-specifier-p (thing) + "Returns T if THING is a valid TYPE-SPECIFIER, otherwise returns NIL." + (ignore-errors + (typep nil thing) + t)) + +(deftype type-specifier () + '(satisfies type-specifier-p)) + +(defun sequence-of-predicate-for (cont type &optional len) + "Returns the name of a predicate that checks whether its argument is a + sequence of type CONT whose values are all of type TYPE." + (check-type type type-specifier "A TYPE-SPECIFIER") + (check-type cont type-specifier "A TYPE-SPECIFIER") + (assert (subtypep cont 'sequence) (cont) "~s is not a subtype of SEQUENCE." cont) + (check-type cont symbol "A SYMBOL") + (assert (or (eq len '*) (typep len 'fixnum)) (len) "LEN must be '* or a fixnum") + (let ((name + (apply #'a:symbolicate cont :-of- (write-to-string len) :- (a:flatten type))) + (len + (when (typep len 'fixnum) + len))) + (prog1 name + (unless (fboundp name) + (setf (symbol-function name) + (let ((is-type (lambda (xs) (typep xs type)))) + (lambda (xs) + (and (typep xs cont) + (or (not len) (= len (length xs))) + (every is-type xs))))))))) + +(deftype list-of (type &optional len) + "Type specifier for lists all of the same TYPE." + `(satisfies ,(sequence-of-predicate-for 'list type len))) + +(deftype vector-of (type &optional len) + "Type specifier for vectors all of the same TYPE." + `(satisfies ,(sequence-of-predicate-for 'vector type len))) + -- cgit v1.2.3