From 1a480c145a3c73bf109597f6f8a44a47fecf8132 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Fri, 2 Jan 1998 05:08:52 +0000 Subject: [PATCH] Revised version of the expt derive-type optimizer, fixing a number of problems, from Raymond Toy. --- compiler/float-tran.lisp | 154 ++++++++++++++++++++++++++++----------- 1 file changed, 110 insertions(+), 44 deletions(-) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index e82e09533..0ee63b13a 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.57 1997/12/20 15:40:21 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.58 1998/01/02 05:08:52 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -825,43 +825,109 @@ (defun fixup-interval-expt (bnd x-int y-int x-type y-type) (declare (ignore x-int)) - (let ((lo (bound-value (interval-low bnd))) - (hi (bound-value (interval-high bnd)))) - ;; Figure out what the return type should be - (multiple-value-bind (class format) - (cond ((eq (numeric-type-class x-type) 'integer) - (case (numeric-type-class y-type) - (integer - ;; Positive integer to a integer power - (if (and (interval-low y-int) - (>= (bound-value (interval-low y-int)) 0)) - (values 'integer nil) - (values 'rational nil))) - ((or rational float) - ;; Integer to rational or float power is a float. - (values 'float - (or (numeric-type-format y-type) 'single-float))))) - ((eq (numeric-type-class x-type) 'rational) - ;; Rational to a power - (case (numeric-type-class y-type) - (integer - (values 'rational nil)) - (float - (values 'float - (or (numeric-type-format y-type) 'single-float))))) - (t - ;; Rational or float to a power is general numeric contagion - (values 'float - (numeric-type-format - (numeric-contagion x-type y-type))))) - (when (member format '(single-float double-float)) - (setf lo (if lo (coerce lo format) lo)) - (setf hi (if hi (coerce hi format) hi))) - (make-numeric-type - :class class - :format format - :low lo - :high hi)))) + ;; Figure out what the return type should be, given the argument + ;; types and bounds and the result type and bounds. + (cond ((csubtypep x-type (specifier-type 'integer)) + ;; An integer to some power. Cases to consider: + (case (numeric-type-class y-type) + (integer + ;; Positive integer to an integer power is either an + ;; integer or a rational. + (let ((lo (or (interval-low bnd) '*)) + (hi (or (interval-high bnd) '*))) + (if (and (interval-low y-int) + (>= (bound-value (interval-low y-int)) 0)) + (specifier-type `(integer ,lo ,hi)) + (specifier-type `(rational ,lo ,hi))))) + (rational + ;; Positive integer to rational power is either a rational + ;; or a single-float. + (let* ((lo (interval-low bnd)) + (hi (interval-high bnd)) + (int-lo (if lo + (floor (bound-value lo)) + '*)) + (int-hi (if hi + (ceiling (bound-value hi)) + '*)) + (f-lo (if lo + (bound-func #'float lo) + '*)) + (f-hi (if hi + (bound-func #'float hi) + '*))) + (specifier-type `(or (rational ,int-lo ,int-hi) + (single-float ,f-lo, f-hi))))) + (float + ;; Positive integer to a float power is a float + (let ((res (copy-numeric-type y-type))) + (setf (numeric-type-low res) (interval-low bnd)) + (setf (numeric-type-high res) (interval-high bnd)) + res)) + (t + ;; Positive integer to a number is a number (for now) + (specifier-type 'number))) + ) + ((csubtypep x-type (specifier-type 'rational)) + ;; A rational to some power + (case (numeric-type-class y-type) + (integer + ;; Positive rational to an integer power is always a rational + (specifier-type `(rational ,(or (interval-low bnd) '*) + ,(or (interval-high bnd) '*)))) + (rational + ;; Positive rational to rational power is either a rational + ;; or a single-float. + (let* ((lo (interval-low bnd)) + (hi (interval-high bnd)) + (int-lo (if lo + (floor (bound-value lo)) + '*)) + (int-hi (if hi + (ceiling (bound-value hi)) + '*)) + (f-lo (if lo + (bound-func #'float lo) + '*)) + (f-hi (if hi + (bound-func #'float hi) + '*))) + (specifier-type `(or (rational ,int-lo ,int-hi) + (single-float ,f-lo, f-hi))))) + (float + ;; Positive rational to a float power is a float + (let ((res (copy-numeric-type y-type))) + (setf (numeric-type-low res) (interval-low bnd)) + (setf (numeric-type-high res) (interval-high bnd)) + res)) + (t + ;; Positive rational to a number is a number (for now) + (specifier-type 'number))) + ) + ((csubtypep x-type (specifier-type 'float)) + ;; A float to some power + (case (numeric-type-class y-type) + ((or integer rational) + ;; Positive float to an integer or rational power is always a float + (make-numeric-type + :class 'float + :format (numeric-type-format x-type) + :low (interval-low bnd) + :high (interval-high bnd))) + (float + ;; Positive float to a float power is a float of the higher type + (make-numeric-type + :class 'float + :format (float-format-max (numeric-type-format x-type) + (numeric-type-format y-type)) + :low (interval-low bnd) + :high (interval-high bnd))) + (t + ;; Positive float to a number is a number (for now) + (specifier-type 'number)))) + (t + ;; A number to some power is a number. + (specifier-type 'number)))) (defun merged-interval-expt (x y) (let* ((x-int (numeric-type->interval x)) @@ -872,9 +938,9 @@ (defun expt-derive-type-aux (x y same-arg) (declare (ignore same-arg)) - (cond ((or (eq (numeric-type-complexp x) :complex) - (eq (numeric-type-complexp x) :complex)) - ;; Use numeric contagion if either is complex + (cond ((or (not (numeric-type-real-p x)) + (not (numeric-type-real-p y))) + ;; Use numeric contagion if either is not real (numeric-contagion x y)) ((csubtypep y (specifier-type 'integer)) ;; A real raised to an integer power is well-defined @@ -882,7 +948,8 @@ (t ;; A real raised to a non-integral power can be a float or a ;; complex number. - (cond ((csubtypep x (specifier-type '(real 0d0))) + (cond ((or (csubtypep x (specifier-type '(rational 0))) + (csubtypep x (specifier-type '(float (0d0))))) ;; But a positive real to any power is well-defined. (merged-interval-expt x y)) (t @@ -890,7 +957,6 @@ ;; or a complex. (float-or-complex-type (numeric-contagion x y))))))) -#+nil (defoptimizer (expt derive-type) ((x y)) (two-arg-derive-type x y #'expt-derive-type-aux #'expt)) @@ -1182,7 +1248,7 @@ (dn (* iy (+ 1 (* r r))))) (complex (/ (+ (* rx r) ix) dn) (/ (- (* ix r) rx) dn)))))) - ;; Multiplye a complex by a float or vice versa + ;; Multiply a complex by a float or vice versa (deftransform * ((w z) ((complex ,type) ,type) *) '(complex (* (realpart w) z) (* (imagpart w) z))) (deftransform * ((z w) (,type (complex ,type)) *) -- GitLab