Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}{-# OPTIONS_HADDOCK not-home #-}------------------------------------------------------------------------------- |-- Module      :  GHC.Float.RealFracMethods-- Copyright   :  (c) Daniel Fischer 2010-- License     :  see libraries/base/LICENSE---- Maintainer  :  cvs-ghc@haskell.org-- Stability   :  internal-- Portability :  non-portable (GHC Extensions)---- Methods for the RealFrac instances for 'Float' and 'Double',-- with specialised versions for 'Int'.---- Moved to their own module to not bloat GHC.Float further.-------------------------------------------------------------------------------#include "MachDeps.h"moduleGHC.Float.RealFracMethods(-- * Double methods-- ** Integer resultsproperFractionDoubleInteger,truncateDoubleInteger,floorDoubleInteger,ceilingDoubleInteger,roundDoubleInteger-- ** Int results,properFractionDoubleInt,floorDoubleInt,ceilingDoubleInt,roundDoubleInt-- * Double/Int conversions, wrapped primops,double2Int,int2Double-- * Float methods-- ** Integer results,properFractionFloatInteger,truncateFloatInteger,floorFloatInteger,ceilingFloatInteger,roundFloatInteger-- ** Int results,properFractionFloatInt,floorFloatInt,ceilingFloatInt,roundFloatInt-- * Float/Int conversions, wrapped primops,float2Int,int2Float)whereimportGHC.IntegerimportGHC.BaseimportGHC.Num()#if WORD_SIZE_IN_BITS < 64importGHC.IntWord64#define TO64 integerToInt64#define FROM64 int64ToInteger#define MINUS64 minusInt64##define NEGATE64 negateInt64##else#define TO64 integerToInt#define FROM64 smallInteger#define MINUS64 ( -# )#define NEGATE64 negateInt#uncheckedIShiftRA64#::Int#->Int#->Int#uncheckedIShiftRA64# :: Int# -> Int# -> Int#uncheckedIShiftRA64#=Int# -> Int# -> Int#uncheckedIShiftRA#uncheckedIShiftL64#::Int#->Int#->Int#uncheckedIShiftL64# :: Int# -> Int# -> Int#uncheckedIShiftL64#=Int# -> Int# -> Int#uncheckedIShiftL##endifdefault()--------------------------------------------------------------------------------                              Float Methods                               ---------------------------------------------------------------------------------- Special Functions for Int, nice, easy and fast.-- They should be small enough to be inlined automatically.-- We have to test for ±0.0 to avoid returning -0.0 in the second-- component of the pair. Unfortunately the branching costs a lot-- of performance.properFractionFloatInt::Float->(Int,Float)properFractionFloatInt :: Float -> (Int, Float)properFractionFloatInt(F#Float#x)=ifInt# -> BoolisTrue#(Float#xFloat# -> Float# -> Int#`eqFloat#`Float#0.0#)then(Int# -> IntI#Int#0#,Float# -> FloatF#Float#0.0#)elsecaseFloat# -> Int#float2Int#Float#xofInt#n->(Int# -> IntI#Int#n,Float# -> FloatF#(Float#xFloat# -> Float# -> Float#`minusFloat#`Int# -> Float#int2Float#Int#n))-- truncateFloatInt = float2IntfloorFloatInt::Float->IntfloorFloatInt :: Float -> IntfloorFloatInt(F#Float#x)=caseFloat# -> Int#float2Int#Float#xofInt#n|Int# -> BoolisTrue#(Float#xFloat# -> Float# -> Int#`ltFloat#`Int# -> Float#int2Float#Int#n)->Int# -> IntI#(Int#nInt# -> Int# -> Int#-#Int#1#)|Boolotherwise->Int# -> IntI#Int#nceilingFloatInt::Float->IntceilingFloatInt :: Float -> IntceilingFloatInt(F#Float#x)=caseFloat# -> Int#float2Int#Float#xofInt#n|Int# -> BoolisTrue#(Int# -> Float#int2Float#Int#nFloat# -> Float# -> Int#`ltFloat#`Float#x)->Int# -> IntI#(Int#nInt# -> Int# -> Int#+#Int#1#)|Boolotherwise->Int# -> IntI#Int#nroundFloatInt::Float->IntroundFloatInt :: Float -> IntroundFloatIntFloatx=Float -> Intfloat2Int(Float -> Floatc_rintFloatFloatx)-- Functions with Integer results-- With the new code generator in GHC 7, the explicit bit-fiddling is-- slower than the old code for values of small modulus, but when the-- 'Int' range is left, the bit-fiddling quickly wins big, so we use that.-- If the methods are called on smallish values, hopefully people go-- through Int and not larger types.-- Note: For negative exponents, we must check the validity of the shift-- distance for the right shifts of the mantissa.{-# INLINEproperFractionFloatInteger#-}properFractionFloatInteger::Float->(Integer,Float)properFractionFloatInteger :: Float -> (Integer, Float)properFractionFloatIntegerv :: Floatv@(F#Float#x)=caseFloat# -> (# Int#, Int# #)decodeFloat_Int#Float#xof(#Int#m,Int#e#)|Int# -> BoolisTrue#(Int#eInt# -> Int# -> Int#<#Int#0#)->caseInt# -> Int#negateInt#Int#eofInt#s|Int# -> BoolisTrue#(Int#sInt# -> Int# -> Int#>#Int#23#)->(Integer0,Floatv)|Int# -> BoolisTrue#(Int#mInt# -> Int# -> Int#<#Int#0#)->caseInt# -> Int#negateInt#(Int# -> Int#negateInt#Int#mInt# -> Int# -> Int#`uncheckedIShiftRA#`Int#s)ofInt#k->(Int# -> IntegersmallIntegerInt#k,caseInt#mInt# -> Int# -> Int#-#(Int#kInt# -> Int# -> Int#`uncheckedIShiftL#`Int#s)ofInt#r->Float# -> FloatF#(Integer -> Int# -> Float#encodeFloatInteger(Int# -> IntegersmallIntegerInt#r)Int#e))|Boolotherwise->caseInt#mInt# -> Int# -> Int#`uncheckedIShiftRL#`Int#sofInt#k->(Int# -> IntegersmallIntegerInt#k,caseInt#mInt# -> Int# -> Int#-#(Int#kInt# -> Int# -> Int#`uncheckedIShiftL#`Int#s)ofInt#r->Float# -> FloatF#(Integer -> Int# -> Float#encodeFloatInteger(Int# -> IntegersmallIntegerInt#r)Int#e))|Boolotherwise->(Integer -> Int# -> IntegershiftLInteger(Int# -> IntegersmallIntegerInt#m)Int#e,Float# -> FloatF#Float#0.0#){-# INLINEtruncateFloatInteger#-}truncateFloatInteger::Float->IntegertruncateFloatInteger :: Float -> IntegertruncateFloatIntegerFloatx=caseFloat -> (Integer, Float)properFractionFloatIntegerFloatxof(Integern,Float_)->Integern-- floor is easier for negative numbers than truncate, so this gets its-- own implementation, it's a little faster.{-# INLINEfloorFloatInteger#-}floorFloatInteger::Float->IntegerfloorFloatInteger :: Float -> IntegerfloorFloatInteger(F#Float#x)=caseFloat# -> (# Int#, Int# #)decodeFloat_Int#Float#xof(#Int#m,Int#e#)|Int# -> BoolisTrue#(Int#eInt# -> Int# -> Int#<#Int#0#)->caseInt# -> Int#negateInt#Int#eofInt#s|Int# -> BoolisTrue#(Int#sInt# -> Int# -> Int#>#Int#23#)->ifInt# -> BoolisTrue#(Int#mInt# -> Int# -> Int#<#Int#0#)then(-Integer1)elseInteger0|Boolotherwise->Int# -> IntegersmallInteger(Int#mInt# -> Int# -> Int#`uncheckedIShiftRA#`Int#s)|Boolotherwise->Integer -> Int# -> IntegershiftLInteger(Int# -> IntegersmallIntegerInt#m)Int#e-- ceiling x = -floor (-x)-- If giving this its own implementation is faster at all,-- it's only marginally so, hence we keep it short.{-# INLINEceilingFloatInteger#-}ceilingFloatInteger::Float->IntegerceilingFloatInteger :: Float -> IntegerceilingFloatInteger(F#Float#x)=Integer -> IntegernegateInteger(Float -> IntegerfloorFloatInteger(Float# -> FloatF#(Float# -> Float#negateFloat#Float#x))){-# INLINEroundFloatInteger#-}roundFloatInteger::Float->IntegerroundFloatInteger :: Float -> IntegerroundFloatIntegerFloatx=Float -> Integerfloat2Integer(Float -> Floatc_rintFloatFloatx)--------------------------------------------------------------------------------                              Double Methods                              ---------------------------------------------------------------------------------- Special Functions for Int, nice, easy and fast.-- They should be small enough to be inlined automatically.-- We have to test for ±0.0 to avoid returning -0.0 in the second-- component of the pair. Unfortunately the branching costs a lot-- of performance.properFractionDoubleInt::Double->(Int,Double)properFractionDoubleInt :: Double -> (Int, Double)properFractionDoubleInt(D#Double#x)=ifInt# -> BoolisTrue#(Double#xDouble# -> Double# -> Int#==##Double#0.0##)then(Int# -> IntI#Int#0#,Double# -> DoubleD#Double#0.0##)elsecaseDouble# -> Int#double2Int#Double#xofInt#n->(Int# -> IntI#Int#n,Double# -> DoubleD#(Double#xDouble# -> Double# -> Double#-##Int# -> Double#int2Double#Int#n))-- truncateDoubleInt = double2IntfloorDoubleInt::Double->IntfloorDoubleInt :: Double -> IntfloorDoubleInt(D#Double#x)=caseDouble# -> Int#double2Int#Double#xofInt#n|Int# -> BoolisTrue#(Double#xDouble# -> Double# -> Int#<##Int# -> Double#int2Double#Int#n)->Int# -> IntI#(Int#nInt# -> Int# -> Int#-#Int#1#)|Boolotherwise->Int# -> IntI#Int#nceilingDoubleInt::Double->IntceilingDoubleInt :: Double -> IntceilingDoubleInt(D#Double#x)=caseDouble# -> Int#double2Int#Double#xofInt#n|Int# -> BoolisTrue#(Int# -> Double#int2Double#Int#nDouble# -> Double# -> Int#<##Double#x)->Int# -> IntI#(Int#nInt# -> Int# -> Int#+#Int#1#)|Boolotherwise->Int# -> IntI#Int#nroundDoubleInt::Double->IntroundDoubleInt :: Double -> IntroundDoubleIntDoublex=Double -> Intdouble2Int(Double -> Doublec_rintDoubleDoublex)-- Functions with Integer results-- The new Code generator isn't quite as good for the old 'Double' code-- as for the 'Float' code, so for 'Double' the bit-fiddling also wins-- when the values have small modulus.-- When the exponent is negative, all mantissae have less than 64 bits-- and the right shifting of sized types is much faster than that of-- 'Integer's, especially when we can-- Note: For negative exponents, we must check the validity of the shift-- distance for the right shifts of the mantissa.{-# INLINEproperFractionDoubleInteger#-}properFractionDoubleInteger::Double->(Integer,Double)properFractionDoubleInteger :: Double -> (Integer, Double)properFractionDoubleIntegerv :: Doublev@(D#Double#x)=caseDouble# -> (# Integer, Int# #)decodeDoubleIntegerDouble#xof(#Integerm,Int#e#)|Int# -> BoolisTrue#(Int#eInt# -> Int# -> Int#<#Int#0#)->caseInt# -> Int#negateInt#Int#eofInt#s|Int# -> BoolisTrue#(Int#sInt# -> Int# -> Int#>#Int#52#)->(Integer0,Doublev)|IntegermInteger -> Integer -> Boolforall a. Ord a => a -> a -> Bool<Integer0->caseTO64(negateIntegerm)ofInt#n->caseInt#nInt# -> Int# -> Int#`uncheckedIShiftRA64#`Int#sofInt#k->(FROM64(NEGATE64k),caseMINUS64nInt#(k`uncheckedIShiftL64#`s)ofInt#r->Double# -> DoubleD#(Integer -> Int# -> Double#encodeDoubleInteger(FROM64(NEGATE64r))e))|Boolotherwise->caseTO64mofInt#n->caseInt#nInt# -> Int# -> Int#`uncheckedIShiftRA64#`Int#sofInt#k->(FROM64k,caseMINUS64nInt#(k`uncheckedIShiftL64#`s)ofInt#r->Double# -> DoubleD#(Integer -> Int# -> Double#encodeDoubleInteger(FROM64r)e))|Boolotherwise->(Integer -> Int# -> IntegershiftLIntegerIntegermInt#e,Double# -> DoubleD#Double#0.0##){-# INLINEtruncateDoubleInteger#-}truncateDoubleInteger::Double->IntegertruncateDoubleInteger :: Double -> IntegertruncateDoubleIntegerDoublex=caseDouble -> (Integer, Double)properFractionDoubleIntegerDoublexof(Integern,Double_)->Integern-- floor is easier for negative numbers than truncate, so this gets its-- own implementation, it's a little faster.{-# INLINEfloorDoubleInteger#-}floorDoubleInteger::Double->IntegerfloorDoubleInteger :: Double -> IntegerfloorDoubleInteger(D#Double#x)=caseDouble# -> (# Integer, Int# #)decodeDoubleIntegerDouble#xof(#Integerm,Int#e#)|Int# -> BoolisTrue#(Int#eInt# -> Int# -> Int#<#Int#0#)->caseInt# -> Int#negateInt#Int#eofInt#s|Int# -> BoolisTrue#(Int#sInt# -> Int# -> Int#>#Int#52#)->ifIntegermInteger -> Integer -> Boolforall a. Ord a => a -> a -> Bool<Integer0then(-Integer1)elseInteger0|Boolotherwise->caseTO64mofInt#n->FROM64(n`uncheckedIShiftRA64#`s)|Boolotherwise->Integer -> Int# -> IntegershiftLIntegerIntegermInt#e{-# INLINEceilingDoubleInteger#-}ceilingDoubleInteger::Double->IntegerceilingDoubleInteger :: Double -> IntegerceilingDoubleInteger(D#Double#x)=Integer -> IntegernegateInteger(Double -> IntegerfloorDoubleInteger(Double# -> DoubleD#(Double# -> Double#negateDouble#Double#x))){-# INLINEroundDoubleInteger#-}roundDoubleInteger::Double->IntegerroundDoubleInteger :: Double -> IntegerroundDoubleIntegerDoublex=Double -> Integerdouble2Integer(Double -> Doublec_rintDoubleDoublex)-- Wrappers around double2Int#, int2Double#, float2Int# and int2Float#,-- we need them here, so we move them from GHC.Float and re-export them-- explicitly from there.double2Int::Double->Intdouble2Int :: Double -> Intdouble2Int(D#Double#x)=Int# -> IntI#(Double# -> Int#double2Int#Double#x)int2Double::Int->Doubleint2Double :: Int -> Doubleint2Double(I#Int#i)=Double# -> DoubleD#(Int# -> Double#int2Double#Int#i)float2Int::Float->Intfloat2Int :: Float -> Intfloat2Int(F#Float#x)=Int# -> IntI#(Float# -> Int#float2Int#Float#x)int2Float::Int->Floatint2Float :: Int -> Floatint2Float(I#Int#i)=Float# -> FloatF#(Int# -> Float#int2Float#Int#i)-- Quicker conversions from 'Double' and 'Float' to 'Integer',-- assuming the floating point value is integral.---- Note: Since the value is integral, the exponent can't be less than-- (-TYP_MANT_DIG), so we need not check the validity of the shift-- distance for the right shfts here.{-# INLINEdouble2Integer#-}double2Integer::Double->Integerdouble2Integer :: Double -> Integerdouble2Integer(D#Double#x)=caseDouble# -> (# Integer, Int# #)decodeDoubleIntegerDouble#xof(#Integerm,Int#e#)|Int# -> BoolisTrue#(Int#eInt# -> Int# -> Int#<#Int#0#)->caseTO64mofInt#n->FROM64(n`uncheckedIShiftRA64#`negateInt#e)|Boolotherwise->Integer -> Int# -> IntegershiftLIntegerIntegermInt#e{-# INLINEfloat2Integer#-}float2Integer::Float->Integerfloat2Integer :: Float -> Integerfloat2Integer(F#Float#x)=caseFloat# -> (# Int#, Int# #)decodeFloat_Int#Float#xof(#Int#m,Int#e#)|Int# -> BoolisTrue#(Int#eInt# -> Int# -> Int#<#Int#0#)->Int# -> IntegersmallInteger(Int#mInt# -> Int# -> Int#`uncheckedIShiftRA#`Int# -> Int#negateInt#Int#e)|Boolotherwise->Integer -> Int# -> IntegershiftLInteger(Int# -> IntegersmallIntegerInt#m)Int#e-- Foreign imports, the rounding is done faster in C when the value-- isn't integral, so we call out for rounding. For values of large-- modulus, calling out to C is slower than staying in Haskell, but-- presumably 'round' is mostly called for values with smaller modulus,-- when calling out to C is a major win.-- For all other functions, calling out to C gives at most a marginal-- speedup for values of small modulus and is much slower than staying-- in Haskell for values of large modulus, so those are done in Haskell.foreignimportccallunsafe"rintDouble"c_rintDouble::Double->Doubleforeignimportccallunsafe"rintFloat"c_rintFloat::Float->Float