From 757d86cfecc4a260a8c6e2ee38bf250b7da6262d Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Tue, 7 Apr 1992 19:26:42 +0000 Subject: [PATCH] Export REALP from LISP now that it's a real function. Minor tweek to bounds testing in %%typep of complex numbers. --- code/pred.lisp | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/code/pred.lisp b/code/pred.lisp index d6e2639f5..086d7c5d3 100644 --- a/code/pred.lisp +++ b/code/pred.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (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 @@ ;;; (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") (export '(system-area-pointer system-area-pointer-p)) @@ -28,7 +28,7 @@ floatp complexp characterp stringp bit-vector-p vectorp simple-vector-p simple-string-p simple-bit-vector-p arrayp 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... array atom bignum bit bit-vector character common compiled-function complex cons double-float @@ -250,7 +250,7 @@ (double-float (typep object 'double-float)) (long-float (typep object 'long-float)) ((nil) (floatp num)))) - ((nil) t))) + (nil t))) (flet ((bound-test (val) (let ((low (numeric-type-low type)) (high (numeric-type-high type))) @@ -264,10 +264,8 @@ ((nil) t) (:complex (and (complexp object) - (let ((re (realpart object)) - (im (imagpart object))) - (and (bound-test (min re im)) - (bound-test (max re im)))))) + (bound-test (realpart object)) + (bound-test (imagpart object)))) (:real (and (not (complexp object)) (bound-test object))))))) -- GitLab