;;;; 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))