X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffloat-tran.lisp;h=49b9cc7adc3cd073e65e951d5425e59ad10db556;hb=9e3a856afd1c42055b3a9d323179afbd78884186;hp=972a954742c37e943709c433495b825f9a8016b7;hpb=cc420058fedd26d85158b92285bf5a0ea9a826c1;p=sbcl.git diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 972a954..49b9cc7 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -18,12 +18,17 @@ (defknown %single-float (real) single-float (movable foldable flushable)) (defknown %double-float (real) double-float (movable foldable flushable)) -(deftransform float ((n &optional f) (* &optional single-float) *) +(deftransform float ((n f) (* single-float) *) '(%single-float n)) (deftransform float ((n f) (* double-float) *) '(%double-float n)) +(deftransform float ((n) *) + '(if (floatp n) + n + (%single-float n))) + (deftransform %single-float ((n) (single-float) *) 'n) @@ -51,10 +56,10 @@ ;; to let me scan for places that I made this mistake and didn't ;; catch myself. "use inline (UNSIGNED-BYTE 32) operations" - (let ((num-high (numeric-type-high (continuation-type num)))) + (let ((num-high (numeric-type-high (lvar-type num)))) (when (null num-high) (give-up-ir1-transform)) - (cond ((constant-continuation-p num) + (cond ((constant-lvar-p num) ;; Check the worst case sum absolute error for the random number ;; expectations. (let ((rem (rem (expt 2 32) num-high))) @@ -152,14 +157,14 @@ (deftransform scale-float ((f ex) (single-float *) *) (if (and #!+x86 t #!-x86 nil - (csubtypep (continuation-type ex) + (csubtypep (lvar-type ex) (specifier-type '(signed-byte 32)))) '(coerce (%scalbn (coerce f 'double-float) ex) 'single-float) '(scale-single-float f ex))) (deftransform scale-float ((f ex) (double-float *) *) (if (and #!+x86 t #!-x86 nil - (csubtypep (continuation-type ex) + (csubtypep (lvar-type ex) (specifier-type '(signed-byte 32)))) '(%scalbn f ex) '(scale-double-float f ex))) @@ -269,10 +274,10 @@ ;;; rational arithmetic, or different float types, and fix it up. If ;;; we don't, he won't even get so much as an efficiency note. (deftransform float-contagion-arg1 ((x y) * * :defun-only t :node node) - `(,(continuation-fun-name (basic-combination-fun node)) + `(,(lvar-fun-name (basic-combination-fun node)) (float x y) y)) (deftransform float-contagion-arg2 ((x y) * * :defun-only t :node node) - `(,(continuation-fun-name (basic-combination-fun node)) + `(,(lvar-fun-name (basic-combination-fun node)) x (float y x))) (dolist (x '(+ * / -)) @@ -293,10 +298,10 @@ (macrolet ((frob (op) `(deftransform ,op ((x y) (float rational) *) "open-code FLOAT to RATIONAL comparison" - (unless (constant-continuation-p y) + (unless (constant-lvar-p y) (give-up-ir1-transform "The RATIONAL value isn't known at compile time.")) - (let ((val (continuation-value y))) + (let ((val (lvar-value y))) (unless (eql (rational (float val)) val) (give-up-ir1-transform "~S doesn't have a precise float representation." @@ -321,17 +326,17 @@ (setf (fun-info-derive-type (fun-info-or-lose name)) (lambda (call) (declare (type combination call)) - (when (csubtypep (continuation-type + (when (csubtypep (lvar-type (first (combination-args call))) type) (specifier-type 'float))))))) #+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.) (defoptimizer (log derive-type) ((x &optional y)) - (when (and (csubtypep (continuation-type x) + (when (and (csubtypep (lvar-type x) (specifier-type '(real 0.0))) (or (null y) - (csubtypep (continuation-type y) + (csubtypep (lvar-type y) (specifier-type '(real 0.0))))) (specifier-type 'float))) @@ -419,7 +424,7 @@ (declare (ignorable prim-quick)) `(progn (deftransform ,name ((x) (single-float) *) - #!+x86 (cond ((csubtypep (continuation-type x) + #!+x86 (cond ((csubtypep (lvar-type x) (specifier-type '(single-float (#.(- (expt 2f0 64))) (#.(expt 2f0 64))))) @@ -429,11 +434,11 @@ (compiler-notify "unable to avoid inline argument range check~@ because the argument range (~S) was not within 2^64" - (type-specifier (continuation-type x))) + (type-specifier (lvar-type x))) `(coerce (,',prim (coerce x 'double-float)) 'single-float))) #!-x86 `(coerce (,',prim (coerce x 'double-float)) 'single-float)) (deftransform ,name ((x) (double-float) *) - #!+x86 (cond ((csubtypep (continuation-type x) + #!+x86 (cond ((csubtypep (lvar-type x) (specifier-type '(double-float (#.(- (expt 2d0 64))) (#.(expt 2d0 64))))) @@ -442,7 +447,7 @@ (compiler-notify "unable to avoid inline argument range check~@ because the argument range (~S) was not within 2^64" - (type-specifier (continuation-type x))) + (type-specifier (lvar-type x))) `(,',prim x))) #!-x86 `(,',prim x))))) (def sin %sin %sin-quick) @@ -693,14 +698,15 @@ ;;; have too much roundoff. Thus we have to do it the hard way. (defun safe-expt (x y) (handler-case - (expt x y) + (when (< (abs y) 10000) + (expt x y)) (error () nil))) ;;; Handle the case when x >= 1. (defun interval-expt-> (x y) (case (sb!c::interval-range-info y 0d0) - ('+ + (+ ;; Y is positive and log X >= 0. The range of exp(y * log(x)) is ;; obviously non-negative. We just have to be careful for ;; infinite bounds (given by nil). @@ -709,7 +715,7 @@ (hi (safe-expt (type-bound-number (sb!c::interval-high x)) (type-bound-number (sb!c::interval-high y))))) (list (sb!c::make-interval :low (or lo 1) :high hi)))) - ('- + (- ;; Y is negative and log x >= 0. The range of exp(y * log(x)) is ;; obviously [0, 1]. However, underflow (nil) means 0 is the ;; result. @@ -728,10 +734,10 @@ ;;; Handle the case when x <= 1 (defun interval-expt-< (x y) (case (sb!c::interval-range-info x 0d0) - ('+ + (+ ;; The case of 0 <= x <= 1 is easy (case (sb!c::interval-range-info y) - ('+ + (+ ;; Y is positive and log X <= 0. The range of exp(y * log(x)) is ;; obviously [0, 1]. We just have to be careful for infinite bounds ;; (given by nil). @@ -740,7 +746,7 @@ (hi (safe-expt (type-bound-number (sb!c::interval-high x)) (type-bound-number (sb!c::interval-low y))))) (list (sb!c::make-interval :low (or lo 0) :high (or hi 1))))) - ('- + (- ;; Y is negative and log x <= 0. The range of exp(y * log(x)) is ;; obviously [1, inf]. (let ((hi (safe-expt (type-bound-number (sb!c::interval-low x)) @@ -754,7 +760,7 @@ (sb!c::interval-split 0 y t) (list (interval-expt-< x y-) (interval-expt-< x y+)))))) - ('- + (- ;; The case where x <= 0. Y MUST be an INTEGER for this to work! ;; The calling function must insure this! For now we'll just ;; return the appropriate unbounded float type. @@ -768,10 +774,10 @@ ;;; Compute bounds for (expt x y). (defun interval-expt (x y) (case (interval-range-info x 1) - ('+ + (+ ;; X >= 1 (interval-expt-> x y)) - ('- + (- ;; X <= 1 (interval-expt-< x y)) (t @@ -983,14 +989,14 @@ (bound-type (or format 'float))) (cond ((numeric-type-real-p arg) (case (interval-range-info (numeric-type->interval arg) 0.0) - ('+ + (+ ;; The number is positive, so the phase is 0. (make-numeric-type :class 'float :format format :complexp :real :low (coerce 0 bound-type) :high (coerce 0 bound-type))) - ('- + (- ;; The number is always negative, so the phase is pi. (make-numeric-type :class 'float :format format @@ -1281,7 +1287,7 @@ ;;; FIXME: ANSI allows any subtype of REAL for the components of COMPLEX. ;;; So what if the input type is (COMPLEX (SINGLE-FLOAT 0 1))? (defoptimizer (conjugate derive-type) ((num)) - (continuation-type num)) + (lvar-type num)) (defoptimizer (cis derive-type) ((num)) (one-arg-derive-type num