From 173758463f663305dc1c85084dd2e8966668039a Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 18 Oct 1990 02:53:50 +0000 Subject: [PATCH] Added transforms to pick off the real cases of the irrational functions and directly call the C interface stub (which can be inline expanded.) Also, generalized the rational-constant/float compare to work for any constant that has a precise single-float representation, not just for 0. --- compiler/float-tran.lisp | 65 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 60 insertions(+), 5 deletions(-) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 0b2abf4f0..51a887746 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.3 1990/09/28 06:41:54 ram Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.4 1990/10/18 02:53:50 ram Exp $ ;;; ;;; This file contains floating-point specific transforms, and may be somewhat ;;; implementation dependent in its assumptions of what the formats are. @@ -176,12 +176,16 @@ ;;; Prevent zerop, plusp, minusp from losing horribly. We can't in general do ;;; float contagion on args to comparison, since Common Lisp semantics says we -;;; are supposed to compare as rationals. But I think this is harmless, since -;;; 0 will have a precise representation in any float format. +;;; are supposed to compare as rationals, but we can do it for any rational +;;; that has a precise representation as a float (such as 0). ;;; (macrolet ((frob (op) - `(deftransform ,op ((x y) (float (constant-argument (member 0)))) - `(,',op x (float 0 x))))) + `(deftransform ,op ((x y) (float (constant-argument rational))) + (let ((val (continuation-value y))) + (unless (eql (rational (float val)) val) + (give-up "~S doesn't have a precise float representation." + val))) + `(,',op x (float y x))))) (frob <) (frob >) (frob =)) @@ -195,3 +199,54 @@ (* &optional (constant-argument (member 1)))) '(let ((res (%unary-truncate x))) (values res (- x res)))) + + +;;;; Irrational stuff: + +(defknown (%sin %cos %tan %asin %acos %atan %sinh %cosh %tanh %asinh + %acosh %atanh %exp %expm1 %log %log10 %log1p %cbrt %sqrt) + (double-float) double-float + (movable foldable flushable)) + +(defknown (%atan2 %pow %hypot) + (double-float double-float) double-float + (movable foldable flushable)) + + +(defmacro def-irrat-transforms (name prim args &optional assert-result) + (flet ((frob (type) + (mapcar #'(lambda (x) + (declare (ignore x)) + type) + args))) + (let ((rtype (when assert-result '(float)))) + `(progn + (deftransform ,name (,args ,(frob 'single-float) ,@rtype) + '(coerce (,prim ,@(mapcar #'(lambda (arg) + `(coerce ,arg 'double-float)) + args)) + 'single-float)) + (deftransform ,name (,args ,(frob 'double-float) ,@rtype) + '(,prim ,@args)))))) + +(def-irrat-transforms exp %exp (x)) +(def-irrat-transforms expt %pow (x y) t) +(def-irrat-transforms log %log (x) t) + +(deftransform log ((x y) (float float) float) + '(/ (log x) (log y))) + +(def-irrat-transforms sqrt %sqrt (x) t) +(def-irrat-transforms sin %sin (x)) +(def-irrat-transforms cos %cos (x)) +(def-irrat-transforms tan %tan (x)) +(def-irrat-transforms asin %asin (x) t) +(def-irrat-transforms acos %acos (x) t) +(def-irrat-transforms atan %atan (x) t) +(def-irrat-transforms atan %atan2 (x y) t) +(def-irrat-transforms sinh %sinh (x)) +(def-irrat-transforms cosh %cosh (x)) +(def-irrat-transforms tanh %tanh (x)) +(def-irrat-transforms asinh %asinh (x)) +(def-irrat-transforms acosh %acosh (x) t) +(def-irrat-transforms atanh %atanh (x) t) -- GitLab