X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FFloat.lhs;h=c133f094e833ff99ab36a4664af9e74359711be1;hb=a44b801ab0033970660396a42462c4f7b4df56bb;hp=186d29c427cfe9acc45b99655f7b53f89bede689;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git

diff --git a/GHC/Float.lhs b/GHC/Float.lhs
index 186d29c..c133f09 100644
--- a/GHC/Float.lhs
+++ b/GHC/Float.lhs
@@ -1,28 +1,25 @@
-% ------------------------------------------------------------------------------
-% $Id: Float.lhs,v 1.1 2001/06/28 14:15:03 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"
 
 module GHC.Float( module GHC.Float, Float#, Double# )  where
 
+import Data.Maybe
+
 import GHC.Base
 import GHC.List
 import GHC.Enum
@@ -30,7 +27,6 @@ import GHC.Show
 import GHC.Num
 import GHC.Real
 import GHC.Arr
-import GHC.Maybe
 
 infixr 8  **
 \end{code}
@@ -102,14 +98,11 @@ class  (RealFrac a, Floating a) => RealFloat a  where
 %*********************************************************
 
 \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}
 
 
@@ -165,14 +158,14 @@ instance  RealFrac Float  where
 
     {-# 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) ->
@@ -329,14 +322,14 @@ instance  RealFrac Double  where
 
     {-# 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) ->
@@ -495,13 +488,15 @@ formatRealFloat fmt decs x
        mk0 ls = case ls of { "" -> "0" ; _ -> ls}
       in
       case decs of
-       Nothing ->
-         let
-	  f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs
-	  f n s    ""  = f (n-1) ('0':s) ""
-	  f n s (r:rs) = f (n-1) (r:s) rs
-	 in
-	 f e "" ds
+       Nothing
+	  | e <= 0    -> "0." ++ replicate (-e) '0' ++ ds
+	  | otherwise ->
+	     let
+	  	f 0 s    rs  = mk0 (reverse s) ++ '.':mk0 rs
+	  	f n s    ""  = f (n-1) ('0':s) ""
+	  	f n s (r:rs) = f (n-1) (r:s) rs
+	     in
+	 	f e "" ds
        Just dec ->
         let dec' = max dec 0 in
 	if e >= 0 then
@@ -515,8 +510,8 @@ formatRealFloat fmt decs x
 	  (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is)
 	  d:ds' = map intToDigit (if ei > 0 then is' else 0:is')
 	 in
-	 d : '.' : ds'
-	 
+	 d : (if null ds' then "" else '.':ds')
+
 
 roundTo :: Int -> Int -> [Int] -> (Int,[Int])
 roundTo base d is =
@@ -535,13 +530,25 @@ roundTo base d is =
        (c,ds) = f (n-1) xs
        i'     = 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.
 
--- This function returns a list of digits (Ints in [0..base-1]) and an
--- exponent.
+-- | @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 :: (RealFloat a) => Integer -> a -> ([Int], Int)
 floatToDigits _ 0 = ([0], 0)
@@ -672,14 +679,18 @@ fromRat x = x'
 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
@@ -690,6 +701,7 @@ fromRat x
 -- 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
@@ -851,27 +863,27 @@ powerDouble  (D# x) (D# y) = D# (x **## y)
 \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}
 
 %*********************************************************