-% ------------------------------------------------------------------------------
-% $Id: Float.lhs,v 1.3 2001/12/21 15:07:22 simonmar Exp $
-%
-% (c) The University of Glasgow, 1994-2000
-%
-
-\section[GHC.Num]{Module @GHC.Num@}
-
-The types
-
- Float
- Double
-
-and the classes
-
- Floating
- RealFloat
-
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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"
%*********************************************************
\begin{code}
+-- | Single-precision floating point numbers.
data Float = F# Float#
-data Double = D# Double#
-instance CCallable Float
-instance CReturnable Float
-
-instance CCallable Double
-instance CReturnable Double
+-- | Double-precision floating point numbers.
+data Double = D# Double#
\end{code}
{-# SPECIALIZE properFraction :: Float -> (Int, Float) #-}
{-# SPECIALIZE round :: Float -> Int #-}
- {-# SPECIALIZE ceiling :: Float -> Int #-}
- {-# SPECIALIZE floor :: Float -> Int #-}
- {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
- {-# SPECIALIZE truncate :: Float -> Integer #-}
+ {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-}
{-# SPECIALIZE round :: Float -> Integer #-}
- {-# SPECIALIZE ceiling :: Float -> Integer #-}
- {-# SPECIALIZE floor :: Float -> Integer #-}
+
+ -- ceiling, floor, and truncate are all small
+ {-# INLINE ceiling #-}
+ {-# INLINE floor #-}
+ {-# INLINE truncate #-}
properFraction x
= case (decodeFloat x) of { (m,n) ->
{-# SPECIALIZE properFraction :: Double -> (Int, Double) #-}
{-# SPECIALIZE round :: Double -> Int #-}
- {-# SPECIALIZE ceiling :: Double -> Int #-}
- {-# SPECIALIZE floor :: Double -> Int #-}
{-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-}
- {-# SPECIALIZE truncate :: Double -> Integer #-}
{-# SPECIALIZE round :: Double -> Integer #-}
- {-# SPECIALIZE ceiling :: Double -> Integer #-}
- {-# SPECIALIZE floor :: Double -> Integer #-}
+
+ -- ceiling, floor, and truncate are all small
+ {-# INLINE ceiling #-}
+ {-# INLINE floor #-}
+ {-# INLINE truncate #-}
properFraction x
= case (decodeFloat x) of { (m,n) ->
-- 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,
+-- | @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
--- (a) n >= 1
--- (b) x = 0.d1d2...dn * (base**e)
--- (c) 0 <= di <= base-1
+--
+-- (1) n >= 1
+--
+-- (2) x = 0.d1d2...dn * (base**e)
+--
+-- (3) 0 <= di <= base-1
floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int)
floatToDigits _ 0 = ([0], 0)
Now, here's Lennart's code (which works)
\begin{code}
-{-# SPECIALISE fromRat ::
- Rational -> Double,
- Rational -> Float #-}
+{-# SPECIALISE fromRat :: Rational -> Double,
+ Rational -> Float #-}
fromRat :: (RealFloat a) => Rational -> a
-fromRat x
- | x == 0 = encodeFloat 0 0 -- Handle exceptional cases
- | x < 0 = - fromRat' (-x) -- first.
- | otherwise = fromRat' x
+
+-- Deal with special cases first, delegating the real work to fromRat'
+fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity
+ | n == 0 = 0/0 -- NaN
+ | n < 0 = -1/0 -- -Infinity
+
+fromRat (n :% d) | n > 0 = fromRat' (n :% d)
+ | n == 0 = encodeFloat 0 0 -- Zero
+ | n < 0 = - fromRat' ((-n) :% d)
-- Conversion process:
-- Scale the rational number by the RealFloat base until
-- a first guess of the exponent.
fromRat' :: (RealFloat a) => Rational -> a
+-- Invariant: argument is strictly positive
fromRat' x = r
where b = floatRadix r
p = floatDigits r
timesFloat (F# x) (F# y) = F# (timesFloat# x y)
divideFloat (F# x) (F# y) = F# (divideFloat# x y)
-{-# RULES
-"plusFloat x 0.0" forall x#. plusFloat# x# 0.0# = x#
-"plusFloat 0.0 x" forall x#. plusFloat# 0.0# x# = x#
-"minusFloat x 0.0" forall x#. minusFloat# x# 0.0# = x#
-"minusFloat x x" forall x#. minusFloat# x# x# = 0.0#
-"timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0#
-"timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0#
-"timesFloat x 1.0" forall x#. timesFloat# x# 1.0# = x#
-"timesFloat 1.0 x" forall x#. timesFloat# 1.0# x# = x#
-"divideFloat x 1.0" forall x#. divideFloat# x# 1.0# = x#
- #-}
-
negateFloat :: Float -> Float
negateFloat (F# x) = F# (negateFloat# x)
timesDouble (D# x) (D# y) = D# (x *## y)
divideDouble (D# x) (D# y) = D# (x /## y)
-{-# RULES
-"plusDouble x 0.0" forall x#. (+##) x# 0.0## = x#
-"plusDouble 0.0 x" forall x#. (+##) 0.0## x# = x#
-"minusDouble x 0.0" forall x#. (-##) x# 0.0## = x#
-"minusDouble x x" forall x#. (-##) x# x# = 0.0##
-"timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0##
-"timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0##
-"timesDouble x 1.0" forall x#. (*##) x# 1.0## = x#
-"timesDouble 1.0 x" forall x#. (*##) 1.0## x# = x#
-"divideDouble x 1.0" forall x#. (/##) x# 1.0## = x#
- #-}
-
negateDouble :: Double -> Double
negateDouble (D# x) = D# (negateDouble# x)
\end{code}
\begin{code}
-foreign import ccall "__encodeFloat" unsafe
+foreign import ccall unsafe "__encodeFloat"
encodeFloat# :: Int# -> ByteArray# -> Int -> Float
-foreign import ccall "__int_encodeFloat" unsafe
+foreign import ccall unsafe "__int_encodeFloat"
int_encodeFloat# :: Int# -> Int -> Float
-foreign import ccall "isFloatNaN" unsafe isFloatNaN :: Float -> Int
-foreign import ccall "isFloatInfinite" unsafe isFloatInfinite :: Float -> Int
-foreign import ccall "isFloatDenormalized" unsafe isFloatDenormalized :: Float -> Int
-foreign import ccall "isFloatNegativeZero" unsafe isFloatNegativeZero :: Float -> Int
+foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int
+foreign import ccall unsafe "isFloatInfinite" isFloatInfinite :: Float -> Int
+foreign import ccall unsafe "isFloatDenormalized" isFloatDenormalized :: Float -> Int
+foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float -> Int
-foreign import ccall "__encodeDouble" unsafe
+foreign import ccall unsafe "__encodeDouble"
encodeDouble# :: Int# -> ByteArray# -> Int -> Double
-foreign import ccall "__int_encodeDouble" unsafe
+foreign import ccall unsafe "__int_encodeDouble"
int_encodeDouble# :: Int# -> Int -> Double
-foreign import ccall "isDoubleNaN" unsafe isDoubleNaN :: Double -> Int
-foreign import ccall "isDoubleInfinite" unsafe isDoubleInfinite :: Double -> Int
-foreign import ccall "isDoubleDenormalized" unsafe isDoubleDenormalized :: Double -> Int
-foreign import ccall "isDoubleNegativeZero" unsafe isDoubleNegativeZero :: Double -> Int
+foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int
+foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int
+foreign import ccall unsafe "isDoubleDenormalized" isDoubleDenormalized :: Double -> Int
+foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Double -> Int
\end{code}
%*********************************************************
projects / ghc-base.git / blobdiff