blob: 060f29daba5f91ceea81c8726150afedefbbca24 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;;;; 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."
`(and list (satisfies ,(sequence-of-predicate-for 'list type len))))
(deftype vector-of (type &optional len)
"Type specifier for vectors all of the same TYPE."
`(and vector (satisfies ,(sequence-of-predicate-for 'vector type len))))
(deftype optional (type)
"Type specifier for an optional type."
`(or null ,type))
|
