1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Numeric
5 -- Copyright : (c) The University of Glasgow 2002
7 --
9 -- Stability : provisional
10 -- Portability : portable
11 --
12 -- Odds and ends, mostly functions for reading and showing
13 -- RealFloat-like kind of values.
14 --
15 -----------------------------------------------------------------------------
17 module Numeric (
19 fromRat, -- :: (RealFloat a) => Rational -> a
20 showSigned, -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
23 readInt, -- :: (Integral a) => a -> (Char -> Bool)
24 -- -> (Char -> Int) -> ReadS a
29 showInt, -- :: Integral a => a -> ShowS
30 showIntAtBase, -- :: Integral a => a -> (a -> Char) -> a -> ShowS
31 showHex, -- :: Integral a => a -> ShowS
32 showOct, -- :: Integral a => a -> ShowS
33 showBin, -- :: Integral a => a -> ShowS
35 showEFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
36 showFFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
37 showGFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
38 showFloat, -- :: (RealFloat a) => a -> ShowS
41 floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int)
42 lexDigits, -- :: ReadS String
44 ) where
46 import Data.Char
49 import GHC.Base
51 import GHC.Real
52 import GHC.Float
53 import GHC.Num
54 import GHC.Show
55 import Data.Maybe
57 import qualified Text.Read.Lex as L
58 #endif
60 #ifdef __HUGS__
61 import Hugs.Prelude
62 import Hugs.Numeric
63 #endif
66 -- -----------------------------------------------------------------------------
69 readInt :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
82 do tok <- L.lex
83 case tok of
84 L.Rat y -> return (fromRational y)
85 L.Int i -> return (fromInteger i)
86 other -> pfail
88 -- It's turgid to have readSigned work using list comprehensions,
90 -- With a bit of luck no one will use it.
94 (do
95 ("-",s) <- lex r
97 return (-x,t))
99 (str,s) <- lex r
101 return (n,s)
103 -- -----------------------------------------------------------------------------
104 -- Showing
106 showInt :: Integral a => a -> ShowS
107 showInt n cs
108 | n < 0 = error "Numeric.showInt: can't show negative numbers"
109 | otherwise = go n cs
110 where
111 go n cs
112 | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
113 c@(C# _) -> c:cs
114 | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
115 c@(C# _) -> go q (c:cs)
116 where
117 (q,r) = n `quotRem` 10
119 -- Controlling the format and precision of floats. The code that
120 -- implements the formatting itself is in @PrelNum@ to avoid
121 -- mutual module deps.
123 {-# SPECIALIZE showEFloat ::
124 Maybe Int -> Float -> ShowS,
125 Maybe Int -> Double -> ShowS #-}
126 {-# SPECIALIZE showFFloat ::
127 Maybe Int -> Float -> ShowS,
128 Maybe Int -> Double -> ShowS #-}
129 {-# SPECIALIZE showGFloat ::
130 Maybe Int -> Float -> ShowS,
131 Maybe Int -> Double -> ShowS #-}
133 showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
134 showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
135 showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
137 showEFloat d x = showString (formatRealFloat FFExponent d x)
138 showFFloat d x = showString (formatRealFloat FFFixed d x)
139 showGFloat d x = showString (formatRealFloat FFGeneric d x)
142 -- ---------------------------------------------------------------------------
143 -- Integer printing functions
145 showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
146 showIntAtBase base toChr n r
147 | n < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n)
148 | otherwise =
149 case quotRem n base of { (n', d) ->
150 let c = toChr d in
151 seq c \$ -- stricter than necessary
152 let
153 r' = c : r
154 in
155 if n' == 0 then r' else showIntAtBase base toChr n' r'
156 }
158 showHex :: Integral a => a -> ShowS
159 showHex n r =
160 showString "0x" \$
161 showIntAtBase 16 (toChrHex) n r
162 where
163 toChrHex d
164 | d < 10 = chr (ord '0' + fromIntegral d)
165 | otherwise = chr (ord 'a' + fromIntegral (d - 10))
167 showOct :: Integral a => a -> ShowS
168 showOct n r =
169 showString "0o" \$
170 showIntAtBase 8 (toChrOct) n r
171 where toChrOct d = chr (ord '0' + fromIntegral d)
173 showBin :: Integral a => a -> ShowS
174 showBin n r =
175 showString "0b" \$
176 showIntAtBase 2 (toChrOct) n r
177 where toChrOct d = chr (ord '0' + fromIntegral d)