Commit b22134cc authored by Tobias C. Rittweiler's avatar Tobias C. Rittweiler
Browse files

alexandria-cdr5-types.diff

	* types.lisp: Fix quoting problem introduced by Attila's last
	patch; additionally add automatically generated docstrings to all
	the types defined.

	* tests.lisp (cdr5.*): New test cases.
parent a201af8b
......@@ -1305,6 +1305,28 @@
nil
t)
(macrolet
((test (type numbers)
`(deftest ,(format-symbol t "CDR5.~A" type)
(let ((numbers ,numbers))
(values (mapcar (of-type ',(format-symbol t "NEGATIVE-~A" type)) numbers)
(mapcar (of-type ',(format-symbol t "NON-POSITIVE-~A" type)) numbers)
(mapcar (of-type ',(format-symbol t "NON-NEGATIVE-~A" type)) numbers)
(mapcar (of-type ',(format-symbol t "POSITIVE-~A" type)) numbers)))
(t t t nil nil nil nil)
(t t t t nil nil nil)
(nil nil nil t t t t)
(nil nil nil nil t t t))))
(test fixnum (list most-negative-fixnum -42 -1 0 1 42 most-positive-fixnum))
(test integer (list (1- most-negative-fixnum) -42 -1 0 1 42 (1+ most-positive-fixnum)))
(test rational (list (1- most-negative-fixnum) -42/13 -1 0 1 42/13 (1+ most-positive-fixnum)))
(test real (list most-negative-long-float -42/13 -1 0 1 42/13 most-positive-long-float))
(test float (list most-negative-short-float -42.02 -1.0 0.0 1.0 42.02 most-positive-short-float))
(test short-float (list most-negative-short-float -42.02s0 -1.0s0 0.0s0 1.0s0 42.02s0 most-positive-short-float))
(test single-float (list most-negative-single-float -42.02f0 -1.0f0 0.0f0 1.0f0 42.02f0 most-positive-single-float))
(test double-float (list most-negative-double-float -42.02d0 -1.0d0 0.0d0 1.0d0 42.02d0 most-positive-double-float))
(test long-float (list most-negative-long-float -42.02l0 -1.0l0 0.0l0 1.0l0 42.02l0 most-positive-long-float)))
;;;; Bindings
(declaim (notinline opaque))
......
......@@ -27,7 +27,13 @@ ARRAY-DIMENSION-LIMIT."
(let ((result (format-symbol :alexandria "~A-P"
(symbol-name sybtype-name))))
(push result predicate-names)
result)))
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"))
......@@ -45,26 +51,30 @@ ARRAY-DIMENSION-LIMIT."
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))))
(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 ()
`(,',base-type ,',negative-extremum ,',below-zero))
,(make-docstring negative-extremum below-zero :negative)
`(,',base-type ,,negative-extremum ,',below-zero))
(deftype ,non-positive-name ()
`(,',base-type ,',negative-extremum ,',zero))
,(make-docstring negative-extremum zero :negative)
`(,',base-type ,,negative-extremum ,',zero))
(deftype ,non-negative-name ()
`(,',base-type ,',zero ,',positive-extremum))
,(make-docstring zero positive-extremum :positive)
`(,',base-type ,',zero ,,positive-extremum))
(deftype ,positive-name ()
`(,',base-type ,',above-zero ,',positive-extremum))
,(make-docstring above-zero positive-extremum :positive)
`(,',base-type ,',above-zero ,,positive-extremum))
(declaim (inline ,@predicate-names))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment