Skip to content
Snippets Groups Projects
Commit 757d86cf authored by wlott's avatar wlott
Browse files

Export REALP from LISP now that it's a real function. Minor tweek to

bounds testing in %%typep of complex numbers.
parent 9aecb1a2
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.25 1992/03/08 18:31:58 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.26 1992/04/07 19:26:42 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
;;; ;;;
(in-package "EXTENSIONS") (in-package "EXTENSIONS")
(export '(structurep fixnump bignump bitp ratiop realp weak-pointer-p)) (export '(structurep fixnump bignump bitp ratiop weak-pointer-p))
(in-package "SYSTEM") (in-package "SYSTEM")
(export '(system-area-pointer system-area-pointer-p)) (export '(system-area-pointer system-area-pointer-p))
...@@ -28,7 +28,7 @@ ...@@ -28,7 +28,7 @@
floatp complexp characterp stringp bit-vector-p vectorp floatp complexp characterp stringp bit-vector-p vectorp
simple-vector-p simple-string-p simple-bit-vector-p arrayp simple-vector-p simple-string-p simple-bit-vector-p arrayp
functionp compiled-function-p commonp eq eql equal equalp not functionp compiled-function-p commonp eq eql equal equalp not
type-of upgraded-array-element-type type-of upgraded-array-element-type realp
;; Names of types... ;; Names of types...
array atom bignum bit bit-vector character common array atom bignum bit bit-vector character common
compiled-function complex cons double-float compiled-function complex cons double-float
...@@ -250,7 +250,7 @@ ...@@ -250,7 +250,7 @@
(double-float (typep object 'double-float)) (double-float (typep object 'double-float))
(long-float (typep object 'long-float)) (long-float (typep object 'long-float))
((nil) (floatp num)))) ((nil) (floatp num))))
((nil) t))) (nil t)))
(flet ((bound-test (val) (flet ((bound-test (val)
(let ((low (numeric-type-low type)) (let ((low (numeric-type-low type))
(high (numeric-type-high type))) (high (numeric-type-high type)))
...@@ -264,10 +264,8 @@ ...@@ -264,10 +264,8 @@
((nil) t) ((nil) t)
(:complex (:complex
(and (complexp object) (and (complexp object)
(let ((re (realpart object)) (bound-test (realpart object))
(im (imagpart object))) (bound-test (imagpart object))))
(and (bound-test (min re im))
(bound-test (max re im))))))
(:real (:real
(and (not (complexp object)) (and (not (complexp object))
(bound-test object))))))) (bound-test object)))))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment