about summary refs log tree commit diff
path: root/third_party/lisp/alexandria/types.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp/alexandria/types.lisp')
-rw-r--r--third_party/lisp/alexandria/types.lisp137
1 files changed, 0 insertions, 137 deletions
diff --git a/third_party/lisp/alexandria/types.lisp b/third_party/lisp/alexandria/types.lisp
deleted file mode 100644
index 1942d0ecdf2a..000000000000
--- a/third_party/lisp/alexandria/types.lisp
+++ /dev/null
@@ -1,137 +0,0 @@
-(in-package :alexandria)
-
-(deftype array-index (&optional (length (1- array-dimension-limit)))
-  "Type designator for an index into array of LENGTH: an integer between
-0 (inclusive) and LENGTH (exclusive). LENGTH defaults to one less than
-ARRAY-DIMENSION-LIMIT."
-  `(integer 0 (,length)))
-
-(deftype array-length (&optional (length (1- array-dimension-limit)))
-  "Type designator for a dimension of an array of LENGTH: an integer between
-0 (inclusive) and LENGTH (inclusive). LENGTH defaults to one less than
-ARRAY-DIMENSION-LIMIT."
-  `(integer 0 ,length))
-
-;; This MACROLET will generate most of CDR5 (http://cdr.eurolisp.org/document/5/)
-;; except the RATIO related definitions and ARRAY-INDEX.
-(macrolet
-    ((frob (type &optional (base-type type))
-       (let ((subtype-names (list))
-             (predicate-names (list)))
-         (flet ((make-subtype-name (format-control)
-                  (let ((result (format-symbol :alexandria format-control
-                                               (symbol-name type))))
-                    (push result subtype-names)
-                    result))
-                (make-predicate-name (sybtype-name)
-                  (let ((result (format-symbol :alexandria '#:~A-p
-                                               (symbol-name sybtype-name))))
-                    (push result predicate-names)
-                    result))
-		(make-docstring (range-beg range-end range-type)
-		  (let ((inf (ecase range-type (:negative "-inf") (:positive "+inf"))))
-		    (format nil "Type specifier denoting the ~(~A~) range from ~A to ~A."
-			    type
-			    (if (equal range-beg ''*) inf (ensure-car range-beg))
-			    (if (equal range-end ''*) inf (ensure-car range-end))))))
-           (let* ((negative-name     (make-subtype-name '#:negative-~a))
-                  (non-positive-name (make-subtype-name '#:non-positive-~a))
-                  (non-negative-name (make-subtype-name '#:non-negative-~a))
-                  (positive-name     (make-subtype-name '#:positive-~a))
-                  (negative-p-name     (make-predicate-name negative-name))
-                  (non-positive-p-name (make-predicate-name non-positive-name))
-                  (non-negative-p-name (make-predicate-name non-negative-name))
-                  (positive-p-name     (make-predicate-name positive-name))
-                  (negative-extremum)
-                  (positive-extremum)
-                  (below-zero)
-                  (above-zero)
-                  (zero))
-             (setf (values negative-extremum below-zero
-                           above-zero positive-extremum zero)
-                   (ecase type
-                     (fixnum       (values 'most-negative-fixnum -1 1 'most-positive-fixnum 0))
-                     (integer      (values ''* -1       1        ''* 0))
-                     (rational     (values ''* '(0)     '(0)     ''* 0))
-                     (real         (values ''* '(0)     '(0)     ''* 0))
-                     (float        (values ''* '(0.0E0) '(0.0E0) ''* 0.0E0))
-                     (short-float  (values ''* '(0.0S0) '(0.0S0) ''* 0.0S0))
-                     (single-float (values ''* '(0.0F0) '(0.0F0) ''* 0.0F0))
-                     (double-float (values ''* '(0.0D0) '(0.0D0) ''* 0.0D0))
-                     (long-float   (values ''* '(0.0L0) '(0.0L0) ''* 0.0L0))))
-             `(progn
-                (deftype ,negative-name ()
-		  ,(make-docstring negative-extremum below-zero :negative)
-		  `(,',base-type ,,negative-extremum ,',below-zero))
-
-                (deftype ,non-positive-name ()
-		  ,(make-docstring negative-extremum zero :negative)
-		  `(,',base-type ,,negative-extremum ,',zero))
-
-                (deftype ,non-negative-name ()
-		  ,(make-docstring zero positive-extremum :positive)
-		  `(,',base-type ,',zero ,,positive-extremum))
-
-                (deftype ,positive-name ()
-		  ,(make-docstring above-zero positive-extremum :positive)
-		  `(,',base-type ,',above-zero ,,positive-extremum))
-
-                (declaim (inline ,@predicate-names))
-
-                (defun ,negative-p-name (n)
-                  (and (typep n ',type)
-                       (< n ,zero)))
-
-                (defun ,non-positive-p-name (n)
-                  (and (typep n ',type)
-                       (<= n ,zero)))
-
-                (defun ,non-negative-p-name (n)
-                  (and (typep n ',type)
-                       (<= ,zero n)))
-
-                (defun ,positive-p-name (n)
-                  (and (typep n ',type)
-                       (< ,zero n)))))))))
-  (frob fixnum integer)
-  (frob integer)
-  (frob rational)
-  (frob real)
-  (frob float)
-  (frob short-float)
-  (frob single-float)
-  (frob double-float)
-  (frob long-float))
-
-(defun of-type (type)
-  "Returns a function of one argument, which returns true when its argument is
-of TYPE."
-  (lambda (thing) (typep thing type)))
-
-(define-compiler-macro of-type (&whole form type &environment env)
-  ;; This can yeild a big benefit, but no point inlining the function
-  ;; all over the place if TYPE is not constant.
-  (if (constantp type env)
-      (with-gensyms (thing)
-        `(lambda (,thing)
-           (typep ,thing ,type)))
-      form))
-
-(declaim (inline type=))
-(defun type= (type1 type2)
-  "Returns a primary value of T is TYPE1 and TYPE2 are the same type,
-and a secondary value that is true is the type equality could be reliably
-determined: primary value of NIL and secondary value of T indicates that the
-types are not equivalent."
-  (multiple-value-bind (sub ok) (subtypep type1 type2)
-    (cond ((and ok sub)
-           (subtypep type2 type1))
-          (ok
-           (values nil ok))
-          (t
-           (multiple-value-bind (sub ok) (subtypep type2 type1)
-             (declare (ignore sub))
-             (values nil ok))))))
-
-(define-modify-macro coercef (type-spec) coerce
-  "Modify-macro for COERCE.")