diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 5bb24b1dfe5ad55ce8027185543536d57219b1db..5f9e4b5f9e0f900589f6e541f2b3805f6e156694 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.74 1998/09/20 15:13:09 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.75 1998/09/20 15:17:34 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -587,7 +587,7 @@ ;;; Compute a specifier like '(or float (complex float)), except float ;;; should be the right kind of float. Allow bounds for the float ;;; part too. -(defun float-or-complex-type (arg &optional lo hi) +(defun float-or-complex-float-type (arg &optional lo hi) (declare (type numeric-type arg)) (let* ((format (case (numeric-type-class arg) ((integer rational) 'single-float) @@ -612,13 +612,16 @@ ;;; ;;; Handle monotonic functions of a single variable whose domain is ;;; possibly part of the real line. ARG is the variable, FCN is the -;;; function, and CSPEC is a specifier that gives the (real) domain of -;;; the function. If ARG is not a subtype of CSPEC, then the function -;;; is assumed to return either a float or a complex number. +;;; function, and DOMAIN is a specifier that gives the (real) domain +;;; of the function. If ARG is a subset of the DOMAIN, we compute the +;;; bounds directly. Otherwise, we compute the bounds for the +;;; intersection between ARG and DOMAIN, and then append a complex +;;; result, which occurs for the parts of ARG not in the DOMAIN. +;;; ;;; DEFAULT-LO and DEFAULT-HI are the lower and upper bounds if we ;;; can't compute the bounds using FCN. ;;; -(defun elfun-derive-type-simple (arg fcn cspec default-lo default-hi +(defun elfun-derive-type-simple (arg fcn domain default-lo default-hi &optional (increasingp t)) (etypecase arg (numeric-type @@ -627,36 +630,58 @@ :format (numeric-type-format arg) :complexp :complex)) ((numeric-type-real-p arg) - (if (csubtypep arg cspec) - (let* ((low (numeric-type-low arg)) - (high (numeric-type-high arg)) - (res-lo (or (bound-func fcn (if increasingp low high)) - default-lo)) - (res-hi (or (bound-func fcn (if increasingp high low)) - default-hi)) - ;; Result specifier type. - (format (case (numeric-type-class arg) - ((integer rational) 'single-float) - (t (numeric-type-format arg)))) - (bound-type (or format 'float))) - (make-numeric-type - :class 'float - :format format - :low (coerce-numeric-bound res-lo bound-type) - :high (coerce-numeric-bound res-hi bound-type))) - (float-or-complex-type arg))) + ;; The argument is real, so let's find the intersection + ;; between the argument and the domain of the function. + ;; We compute the bounds on the intersection, and for + ;; everything else, we return a complex number of the + ;; appropriate type. + (multiple-value-bind (intersection difference) + (interval-intersection/difference + (numeric-type->interval arg) + (if (numeric-type-p domain) + (numeric-type->interval domain) + (make-interval))) + (cond + (intersection + ;; Process the intersection. + (let* ((low (interval-low intersection)) + (high (interval-high intersection)) + (res-lo (or (bound-func fcn (if increasingp low high)) + default-lo)) + (res-hi (or (bound-func fcn (if increasingp high low)) + default-hi)) + ;; Result specifier type. + (format (case (numeric-type-class arg) + ((integer rational) 'single-float) + (t (numeric-type-format arg)))) + (bound-type (or format 'float)) + (result-type + (make-numeric-type + :class 'float + :format format + :low (coerce-numeric-bound res-lo bound-type) + :high (coerce-numeric-bound res-hi bound-type)))) + ;; If the ARG is a subset of the domain, we don't + ;; have to worry about the difference, because that + ;; can't occur. + (if (or (null difference) (csubtypep arg domain)) + result-type + (list result-type + (specifier-type `(complex ,bound-type)))))) + (t + (float-or-complex-float-type arg))))) (t - (float-or-complex-type arg default-lo default-hi)))))) + (float-or-complex-float-type arg default-lo default-hi)))))) (macrolet - ((frob (name cspec def-lo-bnd def-hi-bnd &key (increasingp t)) + ((frob (name domain def-lo-bnd def-hi-bnd &key (increasingp t)) (let ((num (gensym))) `(defoptimizer (,name derive-type) ((,num)) (one-arg-derive-type ,num #'(lambda (arg) (elfun-derive-type-simple arg #',name - ,cspec + ,domain ,def-lo-bnd ,def-hi-bnd ,increasingp)) #',name))))) @@ -905,7 +930,7 @@ (t ;; A real to some power. The result could be a real ;; or a complex. - (float-or-complex-type (numeric-contagion x y))))))) + (float-or-complex-float-type (numeric-contagion x y))))))) (defoptimizer (expt derive-type) ((x y)) (two-arg-derive-type x y #'expt-derive-type-aux #'expt)) @@ -963,7 +988,7 @@ :high (coerce pi bound-format)))) (t ;; The result is a float or a complex number - (float-or-complex-type result-type))))) + (float-or-complex-float-type result-type))))) (defoptimizer (atan derive-type) ((y &optional x)) (if x @@ -1252,7 +1277,7 @@ :low (and def-lo (coerce def-lo bound-type)) :high (and def-hi (coerce def-hi bound-type)))))) (t - (float-or-complex-type arg def-lo def-hi)))))) + (float-or-complex-float-type arg def-lo def-hi)))))) (defoptimizer (sin derive-type) ((num)) (one-arg-derive-type