\begin{code}{-# OPTIONS_GHC -XNoImplicitPrelude #-}{-# OPTIONS_GHC -fno-warn-orphans #-}{-# OPTIONS_HADDOCK hide #-}------------------------------------------------------------------------------- |-- Module : GHC.Float-- Copyright : (c) The University of Glasgow 1994-2002-- License : see libraries/base/LICENSE-- -- Maintainer : cvs-ghc@haskell.org-- Stability : internal-- Portability : non-portable (GHC Extensions)---- The types 'Float' and 'Double', and the classes 'Floating' and 'RealFloat'.-------------------------------------------------------------------------------#include "ieee-flpt.h"-- #hidemoduleGHC.Float(moduleGHC.Float,Float(..),Double(..),Float#,Double#)whereimportData.MaybeimportData.BitsimportGHC.BaseimportGHC.ListimportGHC.EnumimportGHC.ShowimportGHC.NumimportGHC.RealimportGHC.Arrinfixr8**\end{code}%*********************************************************%**\subsection{Standardnumericclasses}%**%*********************************************************\begin{code}-- | Trigonometric and hyperbolic functions and related functions.---- Minimal complete definition:-- 'pi', 'exp', 'log', 'sin', 'cos', 'sinh', 'cosh',-- 'asin', 'acos', 'atan', 'asinh', 'acosh' and 'atanh'class(Fractionala)=>Floatingawherepi::aexp,log,sqrt::a->a(**),logBase::a->a->asin,cos,tan::a->aasin,acos,atan::a->asinh,cosh,tanh::a->aasinh,acosh,atanh::a->ax**y=exp(logx*y)logBasexy=logy/logxsqrtx=x**0.5tanx=sinx/cosxtanhx=sinhx/coshx-- | Efficient, machine-independent access to the components of a-- floating-point number.---- Minimal complete definition:-- all except 'exponent', 'significand', 'scaleFloat' and 'atan2'class(RealFraca,Floatinga)=>RealFloatawhere-- | a constant function, returning the radix of the representation-- (often @2@)floatRadix::a->Integer-- | a constant function, returning the number of digits of-- 'floatRadix' in the significandfloatDigits::a->Int-- | a constant function, returning the lowest and highest values-- the exponent may assumefloatRange::a->(Int,Int)-- | The function 'decodeFloat' applied to a real floating-point-- number returns the significand expressed as an 'Integer' and an-- appropriately scaled exponent (an 'Int'). If @'decodeFloat' x@-- yields @(m,n)@, then @x@ is equal in value to @m*b^^n@, where @b@-- is the floating-point radix, and furthermore, either @m@ and @n@-- are both zero or else @b^(d-1) <= m < b^d@, where @d@ is the value-- of @'floatDigits' x@. In particular, @'decodeFloat' 0 = (0,0)@.decodeFloat::a->(Integer,Int)-- | 'encodeFloat' performs the inverse of 'decodeFloat'encodeFloat::Integer->Int->a-- | the second component of 'decodeFloat'.exponent::a->Int-- | the first component of 'decodeFloat', scaled to lie in the open-- interval (@-1@,@1@)significand::a->a-- | multiplies a floating-point number by an integer power of the radixscaleFloat::Int->a->a-- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) valueisNaN::a->Bool-- | 'True' if the argument is an IEEE infinity or negative infinityisInfinite::a->Bool-- | 'True' if the argument is too small to be represented in-- normalized formatisDenormalized::a->Bool-- | 'True' if the argument is an IEEE negative zeroisNegativeZero::a->Bool-- | 'True' if the argument is an IEEE floating point numberisIEEE::a->Bool-- | a version of arctangent taking two real floating-point arguments.-- For real floating @x@ and @y@, @'atan2' y x@ computes the angle-- (from the positive x-axis) of the vector from the origin to the-- point @(x,y)@. @'atan2' y x@ returns a value in the range [@-pi@,-- @pi@]. It follows the Common Lisp semantics for the origin when-- signed zeroes are supported. @'atan2' y 1@, with @y@ in a type-- that is 'RealFloat', should return the same value as @'atan' y@.-- A default definition of 'atan2' is provided, but implementors-- can provide a more accurate implementation.atan2::a->a->aexponentx=ifm==0then0elsen+floatDigitsxwhere(m,n)=decodeFloatxsignificandx=encodeFloatm(negate(floatDigitsx))where(m,_)=decodeFloatxscaleFloatkx=encodeFloatm(n+k)where(m,n)=decodeFloatxatan2yx|x>0=atan(y/x)|x==0&&y>0=pi/2|x<0&&y>0=pi+atan(y/x)|(x<=0&&y<0)||(x<0&&isNegativeZeroy)||(isNegativeZerox&&isNegativeZeroy)=-atan2(-y)x|y==0&&(x<0||isNegativeZerox)=pi-- must be after the previous test on zero y|x==0&&y==0=y-- must be after the other double zero tests|otherwise=x+y-- x or y is a NaN, return a NaN (via +)\end{code}%*********************************************************%**\subsection{Type@Float@}%**%*********************************************************\begin{code}instanceEqFloatwhere(F#x)==(F#y)=x`eqFloat#`yinstanceOrdFloatwhere(F#x)`compare`(F#y)|x`ltFloat#`y=LT|x`eqFloat#`y=EQ|otherwise=GT(F#x)<(F#y)=x`ltFloat#`y(F#x)<=(F#y)=x`leFloat#`y(F#x)>=(F#y)=x`geFloat#`y(F#x)>(F#y)=x`gtFloat#`yinstanceNumFloatwhere(+)xy=plusFloatxy(-)xy=minusFloatxynegatex=negateFloatx(*)xy=timesFloatxyabsx|x>=0.0=x|otherwise=negateFloatxsignumx|x==0.0=0|x>0.0=1|otherwise=negate1{-# INLINE fromInteger #-}fromIntegeri=F#(floatFromIntegeri)instanceRealFloatwheretoRationalx=(m%1)*(b%1)^^nwhere(m,n)=decodeFloatxb=floatRadixxinstanceFractionalFloatwhere(/)xy=divideFloatxyfromRationalx=fromRatxrecipx=1.0/x{-# RULES "truncate/Float->Int" truncate = float2Int #-}instanceRealFracFloatwhere{-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}{-# SPECIALIZE round :: Float -> Int #-}{-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}{-# SPECIALIZE round :: Float -> Integer #-}-- ceiling, floor, and truncate are all small{-# INLINE ceiling #-}{-# INLINE floor #-}{-# INLINE truncate #-}-- We assume that FLT_RADIX is 2 so that we can use more efficient code#if FLT_RADIX != 2#error FLT_RADIX must be 2#endifproperFraction(F#x#)=casedecodeFloat_Int#x#of(#m#,n##)->letm=I#m#n=I#n#inifn>=0then(fromIntegralm*(2^n),0.0)elseleti=ifm>=0thenm`shiftR`negatenelsenegate(negatem`shiftR`negaten)f=m-(i`shiftL`negaten)in(fromIntegrali,encodeFloat(fromIntegralf)n)truncatex=caseproperFractionxof(n,_)->nroundx=caseproperFractionxof(n,r)->letm=ifr<0.0thenn-1elsen+1half_down=absr-0.5incase(comparehalf_down0.0)ofLT->nEQ->ifevennthennelsemGT->mceilingx=caseproperFractionxof(n,r)->ifr>0.0thenn+1elsenfloorx=caseproperFractionxof(n,r)->ifr<0.0thenn-1elseninstanceFloatingFloatwherepi=3.141592653589793238expx=expFloatxlogx=logFloatxsqrtx=sqrtFloatxsinx=sinFloatxcosx=cosFloatxtanx=tanFloatxasinx=asinFloatxacosx=acosFloatxatanx=atanFloatxsinhx=sinhFloatxcoshx=coshFloatxtanhx=tanhFloatx(**)xy=powerFloatxylogBasexy=logy/logxasinhx=log(x+sqrt(1.0+x*x))acoshx=log(x+(x+1.0)*sqrt((x-1.0)/(x+1.0)))atanhx=log((x+1.0)/sqrt(1.0-x*x))instanceRealFloatFloatwherefloatRadix_=FLT_RADIX-- from float.hfloatDigits_=FLT_MANT_DIG-- dittofloatRange_=(FLT_MIN_EXP,FLT_MAX_EXP)-- dittodecodeFloat(F#f#)=casedecodeFloat_Int#f#of(#i,e#)->(smallIntegeri,I#e)encodeFloati(I#e)=F#(encodeFloatIntegerie)exponentx=casedecodeFloatxof(m,n)->ifm==0then0elsen+floatDigitsxsignificandx=casedecodeFloatxof(m,_)->encodeFloatm(negate(floatDigitsx))scaleFloatkx=casedecodeFloatxof(m,n)->encodeFloatm(n+k)isNaNx=0/=isFloatNaNxisInfinitex=0/=isFloatInfinitexisDenormalizedx=0/=isFloatDenormalizedxisNegativeZerox=0/=isFloatNegativeZeroxisIEEE_=TrueinstanceShowFloatwhereshowsPrecx=showSignedFloatshowFloatxshowList=showList__(showsPrec0)\end{code}%*********************************************************%**\subsection{Type@Double@}%**%*********************************************************\begin{code}instanceEqDoublewhere(D#x)==(D#y)=x==##yinstanceOrdDoublewhere(D#x)`compare`(D#y)|x<##y=LT|x==##y=EQ|otherwise=GT(D#x)<(D#y)=x<##y(D#x)<=(D#y)=x<=##y(D#x)>=(D#y)=x>=##y(D#x)>(D#y)=x>##yinstanceNumDoublewhere(+)xy=plusDoublexy(-)xy=minusDoublexynegatex=negateDoublex(*)xy=timesDoublexyabsx|x>=0.0=x|otherwise=negateDoublexsignumx|x==0.0=0|x>0.0=1|otherwise=negate1{-# INLINE fromInteger #-}fromIntegeri=D#(doubleFromIntegeri)instanceRealDoublewheretoRationalx=(m%1)*(b%1)^^nwhere(m,n)=decodeFloatxb=floatRadixxinstanceFractionalDoublewhere(/)xy=divideDoublexyfromRationalx=fromRatxrecipx=1.0/xinstanceFloatingDoublewherepi=3.141592653589793238expx=expDoublexlogx=logDoublexsqrtx=sqrtDoublexsinx=sinDoublexcosx=cosDoublextanx=tanDoublexasinx=asinDoublexacosx=acosDoublexatanx=atanDoublexsinhx=sinhDoublexcoshx=coshDoublextanhx=tanhDoublex(**)xy=powerDoublexylogBasexy=logy/logxasinhx=log(x+sqrt(1.0+x*x))acoshx=log(x+(x+1.0)*sqrt((x-1.0)/(x+1.0)))atanhx=log((x+1.0)/sqrt(1.0-x*x)){-# RULES "truncate/Double->Int" truncate = double2Int #-}instanceRealFracDoublewhere{-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}{-# SPECIALIZE round :: Double -> Int #-}{-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}{-# SPECIALIZE round :: Double -> Integer #-}-- ceiling, floor, and truncate are all small{-# INLINE ceiling #-}{-# INLINE floor #-}{-# INLINE truncate #-}properFractionx=case(decodeFloatx)of{(m,n)->letb=floatRadixxinifn>=0then(fromIntegerm*fromIntegerb^n,0.0)elsecase(quotRemm(b^(negaten)))of{(w,r)->(fromIntegerw,encodeFloatrn)}}truncatex=caseproperFractionxof(n,_)->nroundx=caseproperFractionxof(n,r)->letm=ifr<0.0thenn-1elsen+1half_down=absr-0.5incase(comparehalf_down0.0)ofLT->nEQ->ifevennthennelsemGT->mceilingx=caseproperFractionxof(n,r)->ifr>0.0thenn+1elsenfloorx=caseproperFractionxof(n,r)->ifr<0.0thenn-1elseninstanceRealFloatDoublewherefloatRadix_=FLT_RADIX-- from float.hfloatDigits_=DBL_MANT_DIG-- dittofloatRange_=(DBL_MIN_EXP,DBL_MAX_EXP)-- dittodecodeFloat(D#x#)=casedecodeDoubleIntegerx#of(#i,j#)->(i,I#j)encodeFloati(I#j)=D#(encodeDoubleIntegerij)exponentx=casedecodeFloatxof(m,n)->ifm==0then0elsen+floatDigitsxsignificandx=casedecodeFloatxof(m,_)->encodeFloatm(negate(floatDigitsx))scaleFloatkx=casedecodeFloatxof(m,n)->encodeFloatm(n+k)isNaNx=0/=isDoubleNaNxisInfinitex=0/=isDoubleInfinitexisDenormalizedx=0/=isDoubleDenormalizedxisNegativeZerox=0/=isDoubleNegativeZeroxisIEEE_=TrueinstanceShowDoublewhereshowsPrecx=showSignedFloatshowFloatxshowList=showList__(showsPrec0)\end{code}%*********************************************************%**\subsection{@Enum@instances}%**%*********************************************************The@Enum@instancesforFloatsandDoublesareslightlyunusual.The@toEnum@functiontruncatesnumberstoInt.Thedefinitionsof@enumFrom@and@enumFromThen@allowfloatstobeusedinarithmeticseries:[0,0.1..1.0].However,roundofferrorsmakethesesomewhatdubious.Thisexamplemayhaveeither10or11elements,dependingonhow0.1isrepresented.NOTE:TheinstancesforFloatandDoubledonotmakeuseofthedefaultmethodsfor@enumFromTo@and@enumFromThenTo@,astheserelyontherebeinga`non-lossy'conversiontoandfromInts.Insteadwemakeuseofthe1.2defaultmethods(backinthedayswhenEnumhadOrdasasuperclass)forthese(@numericEnumFromTo@and@numericEnumFromThenTo@below.)\begin{code}instanceEnumFloatwheresuccx=x+1predx=x-1toEnum=int2FloatfromEnum=fromInteger.truncate-- may overflowenumFrom=numericEnumFromenumFromTo=numericEnumFromToenumFromThen=numericEnumFromThenenumFromThenTo=numericEnumFromThenToinstanceEnumDoublewheresuccx=x+1predx=x-1toEnum=int2DoublefromEnum=fromInteger.truncate-- may overflowenumFrom=numericEnumFromenumFromTo=numericEnumFromToenumFromThen=numericEnumFromThenenumFromThenTo=numericEnumFromThenTo\end{code}%*********************************************************%**\subsection{Printingfloatingpoint}%**%*********************************************************\begin{code}-- | Show a signed 'RealFloat' value to full precision-- using standard decimal notation for arguments whose absolute value lies -- between @0.1@ and @9,999,999@, and scientific notation otherwise.showFloat::(RealFloata)=>a->ShowSshowFloatx=showString(formatRealFloatFFGenericNothingx)-- These are the format types. This type is not exported.dataFFFormat=FFExponent|FFFixed|FFGenericformatRealFloat::(RealFloata)=>FFFormat->MaybeInt->a->StringformatRealFloatfmtdecsx|isNaNx="NaN"|isInfinitex=ifx<0then"-Infinity"else"Infinity"|x<0||isNegativeZerox='-':doFmtfmt(floatToDigits(toIntegerbase)(-x))|otherwise=doFmtfmt(floatToDigits(toIntegerbase)x)wherebase=10doFmtformat(is,e)=letds=mapintToDigitisincaseformatofFFGeneric->doFmt(ife<0||e>7thenFFExponentelseFFFixed)(is,e)FFExponent->casedecsofNothing->letshow_e'=show(e-1)incasedsof"0"->"0.0e0"[d]->d:".0e"++show_e'(d:ds')->d:'.':ds'++"e"++show_e'[]->error"formatRealFloat/doFmt/FFExponent: []"Justdec->letdec'=maxdec1incaseisof[0]->'0':'.':takedec'(repeat'0')++"e0"_->let(ei,is')=roundTobase(dec'+1)is(d:ds')=mapintToDigit(ifei>0theninitis'elseis')ind:'.':ds'++'e':show(e-1+ei)FFFixed->letmk0ls=caselsof{""->"0";_->ls}incasedecsofNothing|e<=0->"0."++replicate(-e)'0'++ds|otherwise->letf0srs=mk0(reverses)++'.':mk0rsfns""=f(n-1)('0':s)""fns(r:rs)=f(n-1)(r:s)rsinfe""dsJustdec->letdec'=maxdec0inife>=0thenlet(ei,is')=roundTobase(dec'+e)is(ls,rs)=splitAt(e+ei)(mapintToDigitis')inmk0ls++(ifnullrsthen""else'.':rs)elselet(ei,is')=roundTobasedec'(replicate(-e)0++is)d:ds'=mapintToDigit(ifei>0thenis'else0:is')ind:(ifnullds'then""else'.':ds')roundTo::Int->Int->[Int]->(Int,[Int])roundTobasedis=casefdisofx@(0,_)->x(1,xs)->(1,1:xs)_->error"roundTo: bad Value"whereb2=base`div`2fn[]=(0,replicaten0)f0(x:_)=(ifx>=b2then1else0,[])fn(i:xs)|i'==base=(1,0:ds)|otherwise=(0,i':ds)where(c,ds)=f(n-1)xsi'=c+i-- Based on "Printing Floating-Point Numbers Quickly and Accurately"-- by R.G. Burger and R.K. Dybvig in PLDI 96.-- This version uses a much slower logarithm estimator. It should be improved.-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,-- and returns a list of digits and an exponent. -- In particular, if @x>=0@, and---- > floatToDigits base x = ([d1,d2,...,dn], e)---- then---- (1) @n >= 1@---- (2) @x = 0.d1d2...dn * (base**e)@---- (3) @0 <= di <= base-1@floatToDigits::(RealFloata)=>Integer->a->([Int],Int)floatToDigits_0=([0],0)floatToDigitsbasex=let(f0,e0)=decodeFloatx(minExp0,_)=floatRangexp=floatDigitsxb=floatRadixxminExp=minExp0-p-- the real minimum exponent-- Haskell requires that f be adjusted so denormalized numbers-- will have an impossibly low exponent. Adjust for this.(f,e)=letn=minExp-e0inifn>0then(f0`div`(b^n),e0+n)else(f0,e0)(r,s,mUp,mDn)=ife>=0thenletbe=b^einiff==b^(p-1)then(f*be*b*2,2*b,be*b,b)else(f*be*2,2,be,be)elseife>minExp&&f==b^(p-1)then(f*b*2,b^(-e+1)*2,b,1)else(f*2,b^(-e)*2,1,1)k::Intk=letk0::Intk0=ifb==2&&base==10then-- logBase 10 2 is slightly bigger than 3/10 so-- the following will err on the low side. Ignoring-- the fraction will make it err even more.-- Haskell promises that p-1 <= logBase b f < p.(p-1+e0)*3`div`10else-- f :: Integer, log :: Float -> Float, -- ceiling :: Float -> Intceiling((log(fromInteger(f+1)::Float)+fromIntegrale*log(fromIntegerb))/log(fromIntegerbase))--WAS: fromInt e * log (fromInteger b))fixupn=ifn>=0thenifr+mUp<=exptbasen*sthennelsefixup(n+1)elseifexptbase(-n)*(r+mUp)<=sthennelsefixup(n+1)infixupk0gendsrnsNmUpNmDnN=let(dn,rn')=(rn*base)`divMod`sNmUpN'=mUpN*basemDnN'=mDnN*baseincase(rn'<mDnN',rn'+mUpN'>sN)of(True,False)->dn:ds(False,True)->dn+1:ds(True,True)->ifrn'*2<sNthendn:dselsedn+1:ds(False,False)->gen(dn:ds)rn'sNmUpN'mDnN'rds=ifk>=0thengen[]r(s*exptbasek)mUpmDnelseletbk=exptbase(-k)ingen[](r*bk)s(mUp*bk)(mDn*bk)in(mapfromIntegral(reverserds),k)\end{code}%*********************************************************%**\subsection{ConvertingfromaRationaltoaRealFloat%**%*********************************************************[InresponsetoarequestfordocumentationofhowfromRationalworks,JoeFaselwrites:]Aquitereasonablerequest!ThiscodewasaddedtothePreludejustbeforethe1.2release,whenLennart,workingwithanearlyversionofhbi,noticedthat(read.show)wasnottheidentityforfloating-pointnumbers.(Therewasaone-biterrorabouthalfthetime.)Theoriginalversionoftheconversionfunctionwasinfactsimplyafloating-pointdivide,asyousuggestabove.Thenewversionis,Igrantyou,somewhatdenser.Unfortunately,Joe'scodedoesn'twork!Here'sanexample:main=putStr(shows(1.82173691287639817263897126389712638972163e-300::Double)"\n")Thisprogramprints0.0000000000000000insteadof1.8217369128763981e-300Here'sJoe'scode:\begin{pseudocode}fromRat::(RealFloata)=>Rational->afromRatx=x'wherex'=fe-- If the exponent of the nearest floating-point number to x -- is e, then the significand is the integer nearest xb^(-e),-- where b is the floating-point radix. We start with a good-- guess for e, and if it is correct, the exponent of the-- floating-point number we construct will again be e. If-- not, one more iteration is needed.fe=ife'==ethenyelsefe'wherey=encodeFloat(round(x*(1%b)^^e))e(_,e')=decodeFloatyb=floatRadixx'-- We obtain a trial exponent by doing a floating-point-- division of x's numerator by its denominator. The-- result of this division may not itself be the ultimate-- result, because of an accumulation of three rounding-- errors.(s,e)=decodeFloat(fromInteger(numeratorx)`asTypeOf`x'/fromInteger(denominatorx))\end{pseudocode}Now,here'sLennart'scode(whichworks)\begin{code}-- | Converts a 'Rational' value into any type in class 'RealFloat'.{-# SPECIALISE fromRat :: Rational -> Double,
Rational -> Float #-}fromRat::(RealFloata)=>Rational->a-- Deal with special cases first, delegating the real work to fromRat'fromRat(n:%0)|n>0=1/0-- +Infinity|n<0=-1/0-- -Infinity|otherwise=0/0-- NaNfromRat(n:%d)|n>0=fromRat'(n:%d)|n<0=-fromRat'((-n):%d)|otherwise=encodeFloat00-- Zero-- Conversion process:-- Scale the rational number by the RealFloat base until-- it lies in the range of the mantissa (as used by decodeFloat/encodeFloat).-- Then round the rational to an Integer and encode it with the exponent-- that we got from the scaling.-- To speed up the scaling process we compute the log2 of the number to get-- a first guess of the exponent.fromRat'::(RealFloata)=>Rational->a-- Invariant: argument is strictly positivefromRat'x=rwhereb=floatRadixrp=floatDigitsr(minExp0,_)=floatRangerminExp=minExp0-p-- the real minimum exponentxMin=toRational(exptb(p-1))xMax=toRational(exptbp)p0=(integerLogBaseb(numeratorx)-integerLogBaseb(denominatorx)-p)`max`minExpf=ifp0<0then1%exptb(-p0)elseexptbp0%1(x',p')=scaleRat(toRationalb)minExpxMinxMaxp0(x/f)r=encodeFloat(roundx')p'-- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp.scaleRat::Rational->Int->Rational->Rational->Int->Rational->(Rational,Int)scaleRatbminExpxMinxMaxpx|p<=minExp=(x,p)|x>=xMax=scaleRatbminExpxMinxMax(p+1)(x/b)|x<xMin=scaleRatbminExpxMinxMax(p-1)(x*b)|otherwise=(x,p)-- Exponentiation with a cache for the most common numbers.minExpt,maxExpt::IntminExpt=0maxExpt=1100expt::Integer->Int->Integerexptbasen=ifbase==2&&n>=minExpt&&n<=maxExptthenexpts!nelsebase^nexpts::ArrayIntIntegerexpts=array(minExpt,maxExpt)[(n,2^n)|n<-[minExpt..maxExpt]]-- Compute the (floor of the) log of i in base b.-- Simplest way would be just divide i by b until it's smaller then b, but that would-- be very slow! We are just slightly more clever.integerLogBase::Integer->Integer->IntintegerLogBasebi|i<b=0|otherwise=doDiv(i`div`(b^l))lwhere-- Try squaring the base first to cut down the number of divisions.l=2*integerLogBase(b*b)idoDiv::Integer->Int->IntdoDivxy|x<b=y|otherwise=doDiv(x`div`b)(y+1)\end{code}%*********************************************************%**\subsection{Floatingpointnumericprimops}%**%*********************************************************DefinitionsoftheboxedPrimOps;thesewillbeusedinthecaseofpartialapplications,etc.\begin{code}plusFloat,minusFloat,timesFloat,divideFloat::Float->Float->FloatplusFloat(F#x)(F#y)=F#(plusFloat#xy)minusFloat(F#x)(F#y)=F#(minusFloat#xy)timesFloat(F#x)(F#y)=F#(timesFloat#xy)divideFloat(F#x)(F#y)=F#(divideFloat#xy)negateFloat::Float->FloatnegateFloat(F#x)=F#(negateFloat#x)gtFloat,geFloat,eqFloat,neFloat,ltFloat,leFloat::Float->Float->BoolgtFloat(F#x)(F#y)=gtFloat#xygeFloat(F#x)(F#y)=geFloat#xyeqFloat(F#x)(F#y)=eqFloat#xyneFloat(F#x)(F#y)=neFloat#xyltFloat(F#x)(F#y)=ltFloat#xyleFloat(F#x)(F#y)=leFloat#xyfloat2Int::Float->Intfloat2Int(F#x)=I#(float2Int#x)int2Float::Int->Floatint2Float(I#x)=F#(int2Float#x)expFloat,logFloat,sqrtFloat::Float->FloatsinFloat,cosFloat,tanFloat::Float->FloatasinFloat,acosFloat,atanFloat::Float->FloatsinhFloat,coshFloat,tanhFloat::Float->FloatexpFloat(F#x)=F#(expFloat#x)logFloat(F#x)=F#(logFloat#x)sqrtFloat(F#x)=F#(sqrtFloat#x)sinFloat(F#x)=F#(sinFloat#x)cosFloat(F#x)=F#(cosFloat#x)tanFloat(F#x)=F#(tanFloat#x)asinFloat(F#x)=F#(asinFloat#x)acosFloat(F#x)=F#(acosFloat#x)atanFloat(F#x)=F#(atanFloat#x)sinhFloat(F#x)=F#(sinhFloat#x)coshFloat(F#x)=F#(coshFloat#x)tanhFloat(F#x)=F#(tanhFloat#x)powerFloat::Float->Float->FloatpowerFloat(F#x)(F#y)=F#(powerFloat#xy)-- definitions of the boxed PrimOps; these will be-- used in the case of partial applications, etc.plusDouble,minusDouble,timesDouble,divideDouble::Double->Double->DoubleplusDouble(D#x)(D#y)=D#(x+##y)minusDouble(D#x)(D#y)=D#(x-##y)timesDouble(D#x)(D#y)=D#(x*##y)divideDouble(D#x)(D#y)=D#(x/##y)negateDouble::Double->DoublenegateDouble(D#x)=D#(negateDouble#x)gtDouble,geDouble,eqDouble,neDouble,leDouble,ltDouble::Double->Double->BoolgtDouble(D#x)(D#y)=x>##ygeDouble(D#x)(D#y)=x>=##yeqDouble(D#x)(D#y)=x==##yneDouble(D#x)(D#y)=x/=##yltDouble(D#x)(D#y)=x<##yleDouble(D#x)(D#y)=x<=##ydouble2Int::Double->Intdouble2Int(D#x)=I#(double2Int#x)int2Double::Int->Doubleint2Double(I#x)=D#(int2Double#x)double2Float::Double->Floatdouble2Float(D#x)=F#(double2Float#x)float2Double::Float->Doublefloat2Double(F#x)=D#(float2Double#x)expDouble,logDouble,sqrtDouble::Double->DoublesinDouble,cosDouble,tanDouble::Double->DoubleasinDouble,acosDouble,atanDouble::Double->DoublesinhDouble,coshDouble,tanhDouble::Double->DoubleexpDouble(D#x)=D#(expDouble#x)logDouble(D#x)=D#(logDouble#x)sqrtDouble(D#x)=D#(sqrtDouble#x)sinDouble(D#x)=D#(sinDouble#x)cosDouble(D#x)=D#(cosDouble#x)tanDouble(D#x)=D#(tanDouble#x)asinDouble(D#x)=D#(asinDouble#x)acosDouble(D#x)=D#(acosDouble#x)atanDouble(D#x)=D#(atanDouble#x)sinhDouble(D#x)=D#(sinhDouble#x)coshDouble(D#x)=D#(coshDouble#x)tanhDouble(D#x)=D#(tanhDouble#x)powerDouble::Double->Double->DoublepowerDouble(D#x)(D#y)=D#(x**##y)\end{code}\begin{code}foreignimportccallunsafe"isFloatNaN"isFloatNaN::Float->Intforeignimportccallunsafe"isFloatInfinite"isFloatInfinite::Float->Intforeignimportccallunsafe"isFloatDenormalized"isFloatDenormalized::Float->Intforeignimportccallunsafe"isFloatNegativeZero"isFloatNegativeZero::Float->Intforeignimportccallunsafe"isDoubleNaN"isDoubleNaN::Double->Intforeignimportccallunsafe"isDoubleInfinite"isDoubleInfinite::Double->Intforeignimportccallunsafe"isDoubleDenormalized"isDoubleDenormalized::Double->Intforeignimportccallunsafe"isDoubleNegativeZero"isDoubleNegativeZero::Double->Int\end{code}%*********************************************************%**\subsection{Coercionrules}%**%*********************************************************\begin{code}{-# RULES
"fromIntegral/Int->Float" fromIntegral = int2Float
"fromIntegral/Int->Double" fromIntegral = int2Double
"realToFrac/Float->Float" realToFrac = id :: Float -> Float
"realToFrac/Float->Double" realToFrac = float2Double
"realToFrac/Double->Float" realToFrac = double2Float
"realToFrac/Double->Double" realToFrac = id :: Double -> Double
"realToFrac/Int->Double" realToFrac = int2Double -- See Note [realToFrac int-to-float]
"realToFrac/Int->Float" realToFrac = int2Float -- ..ditto
#-}\end{code}Note[realToFracint-to-float]~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~DonfoundthattheRULESforrealToFrac/Int->DoubleandsimliarlyFloatmadeahugedifferencetosomestream-fusionprograms.Here'sanexampleimportData.Array.Vectorn=40000000main=doletc=replicateUn(2::Double)a=mapUrealToFrac(enumFromToU0(n-1))::UArrDoubleprint(sumU(zipWithU(*)ca))WithouttheRULEwegetthisloopbody:case$wtoRationalsc_sY4ofww_aM7{(#ww1_aM9,ww2_aMa#)->case$wfromRatww1_aM9ww2_aMaoftpl_X1P{D#ipv_sW3->Main.$s$wfold(+#sc_sY41)(+#wild_X1i1)(+##sc2_sY6(*##2.0ipv_sW3))Andwiththerule:Main.$s$wfold(+#sc_sXT1)(+#wild_X1h1)(+##sc2_sXV(*##2.0(int2Double#sc_sXT)))Therunningtimeoftheprogramgoesfrom120secondsto0.198secondswiththenativebackend,and0.143secondswiththeCbackend.AfewmoredetailsinTrac#2251,andthepatchmessage"Add RULES for realToFrac from Int".%*********************************************************%**\subsection{Utils}%**%*********************************************************\begin{code}showSignedFloat::(RealFloata)=>(a->ShowS)-- ^ a function that can show unsigned values->Int-- ^ the precedence of the enclosing context->a-- ^ the value to show->ShowSshowSignedFloatshowPospx|x<0||isNegativeZerox=showParen(p>6)(showChar'-'.showPos(-x))|otherwise=showPosx\end{code}