;; [41]> (typep '(1 2 3) '(restricted-list fixnum))
;; T
;; [42]> (typep '(1 2 3) '(restricted-list (integer 1 2)))
;; NIL
;; [43]> (typep '(1 2 3) '(restricted-list (integer 1 5)))
;; T


(defpackage "$$RESTRICTED-LIST-PREDICATES$$" (:USE))


(defun find-restricted-list-predicate (element-type)
  (let* ((name (with-standard-io-syntax (format nil "~S-P" element-type)))
         (predicate (FIND-SYMBOL name "$$RESTRICTED-LIST-PREDICATES$$")))
    (unless predicate
      (setf predicate (intern name "$$RESTRICTED-LIST-PREDICATES$$"))
      (eval `(defun ,predicate (list)
               (every (lambda (item) (typep item ',element-type)) list))))
    predicate))


(deftype restricted-list (element-type)
  `(or null
       (and cons
            (satisfies ,(find-restricted-list-predicate element-type)))))