Test Trac #5962
[packages/base.git] / Numeric.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Numeric
7 -- Copyright : (c) The University of Glasgow 2002
8 -- License : BSD-style (see the file libraries/base/LICENSE)
9 --
10 -- Maintainer : libraries@haskell.org
11 -- Stability : provisional
12 -- Portability : portable
13 --
14 -- Odds and ends, mostly functions for reading and showing
15 -- 'RealFloat'-like kind of values.
16 --
17 -----------------------------------------------------------------------------
18
19 module Numeric (
20
21 -- * Showing
22
23 showSigned, -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
24
25 showIntAtBase, -- :: Integral a => a -> (a -> Char) -> a -> ShowS
26 showInt, -- :: Integral a => a -> ShowS
27 showHex, -- :: Integral a => a -> ShowS
28 showOct, -- :: Integral a => a -> ShowS
29
30 showEFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
31 showFFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
32 showGFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
33 showFloat, -- :: (RealFloat a) => a -> ShowS
34
35 floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int)
36
37 -- * Reading
38
39 -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
40 -- and 'readDec' is the \`dual\' of 'showInt'.
41 -- The inconsistent naming is a historical accident.
42
43 readSigned, -- :: (Real a) => ReadS a -> ReadS a
44
45 readInt, -- :: (Integral a) => a -> (Char -> Bool)
46 -- -> (Char -> Int) -> ReadS a
47 readDec, -- :: (Integral a) => ReadS a
48 readOct, -- :: (Integral a) => ReadS a
49 readHex, -- :: (Integral a) => ReadS a
50
51 readFloat, -- :: (RealFloat a) => ReadS a
52
53 lexDigits, -- :: ReadS String
54
55 -- * Miscellaneous
56
57 fromRat, -- :: (RealFloat a) => Rational -> a
58
59 ) where
60
61 #ifdef __GLASGOW_HASKELL__
62 import GHC.Base
63 import GHC.Read
64 import GHC.Real
65 import GHC.Float
66 import GHC.Num
67 import GHC.Show
68 import Data.Maybe
69 import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
70 import qualified Text.Read.Lex as L
71 #else
72 import Data.Char
73 #endif
74
75 #ifdef __HUGS__
76 import Hugs.Prelude
77 import Hugs.Numeric
78 #endif
79
80 #ifdef __GLASGOW_HASKELL__
81 -- -----------------------------------------------------------------------------
82 -- Reading
83
84 -- | Reads an /unsigned/ 'Integral' value in an arbitrary base.
85 readInt :: Num a
86 => a -- ^ the base
87 -> (Char -> Bool) -- ^ a predicate distinguishing valid digits in this base
88 -> (Char -> Int) -- ^ a function converting a valid digit character to an 'Int'
89 -> ReadS a
90 readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
91
92 -- | Read an unsigned number in octal notation.
93 readOct :: (Eq a, Num a) => ReadS a
94 readOct = readP_to_S L.readOctP
95
96 -- | Read an unsigned number in decimal notation.
97 readDec :: (Eq a, Num a) => ReadS a
98 readDec = readP_to_S L.readDecP
99
100 -- | Read an unsigned number in hexadecimal notation.
101 -- Both upper or lower case letters are allowed.
102 readHex :: (Eq a, Num a) => ReadS a
103 readHex = readP_to_S L.readHexP
104
105 -- | Reads an /unsigned/ 'RealFrac' value,
106 -- expressed in decimal scientific notation.
107 readFloat :: RealFrac a => ReadS a
108 readFloat = readP_to_S readFloatP
109
110 readFloatP :: RealFrac a => ReadP a
111 readFloatP =
112 do tok <- L.lex
113 case tok of
114 L.Number n -> return $ fromRational $ L.numberToRational n
115 _ -> pfail
116
117 -- It's turgid to have readSigned work using list comprehensions,
118 -- but it's specified as a ReadS to ReadS transformer
119 -- With a bit of luck no one will use it.
120
121 -- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
122 readSigned :: (Real a) => ReadS a -> ReadS a
123 readSigned readPos = readParen False read'
124 where read' r = read'' r ++
125 (do
126 ("-",s) <- lex r
127 (x,t) <- read'' s
128 return (-x,t))
129 read'' r = do
130 (str,s) <- lex r
131 (n,"") <- readPos str
132 return (n,s)
133
134 -- -----------------------------------------------------------------------------
135 -- Showing
136
137 -- | Show /non-negative/ 'Integral' numbers in base 10.
138 showInt :: Integral a => a -> ShowS
139 showInt n0 cs0
140 | n0 < 0 = error "Numeric.showInt: can't show negative numbers"
141 | otherwise = go n0 cs0
142 where
143 go n cs
144 | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
145 c@(C# _) -> c:cs
146 | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
147 c@(C# _) -> go q (c:cs)
148 where
149 (q,r) = n `quotRem` 10
150
151 -- Controlling the format and precision of floats. The code that
152 -- implements the formatting itself is in @PrelNum@ to avoid
153 -- mutual module deps.
154
155 {-# SPECIALIZE showEFloat ::
156 Maybe Int -> Float -> ShowS,
157 Maybe Int -> Double -> ShowS #-}
158 {-# SPECIALIZE showFFloat ::
159 Maybe Int -> Float -> ShowS,
160 Maybe Int -> Double -> ShowS #-}
161 {-# SPECIALIZE showGFloat ::
162 Maybe Int -> Float -> ShowS,
163 Maybe Int -> Double -> ShowS #-}
164
165 -- | Show a signed 'RealFloat' value
166 -- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
167 --
168 -- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
169 -- the value is shown to full precision; if @digs@ is @'Just' d@,
170 -- then at most @d@ digits after the decimal point are shown.
171 showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
172
173 -- | Show a signed 'RealFloat' value
174 -- using standard decimal notation (e.g. @245000@, @0.0015@).
175 --
176 -- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
177 -- the value is shown to full precision; if @digs@ is @'Just' d@,
178 -- then at most @d@ digits after the decimal point are shown.
179 showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
180
181 -- | Show a signed 'RealFloat' value
182 -- using standard decimal notation for arguments whose absolute value lies
183 -- between @0.1@ and @9,999,999@, and scientific notation otherwise.
184 --
185 -- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
186 -- the value is shown to full precision; if @digs@ is @'Just' d@,
187 -- then at most @d@ digits after the decimal point are shown.
188 showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
189
190 showEFloat d x = showString (formatRealFloat FFExponent d x)
191 showFFloat d x = showString (formatRealFloat FFFixed d x)
192 showGFloat d x = showString (formatRealFloat FFGeneric d x)
193 #endif /* __GLASGOW_HASKELL__ */
194
195 -- ---------------------------------------------------------------------------
196 -- Integer printing functions
197
198 -- | Shows a /non-negative/ 'Integral' number using the base specified by the
199 -- first argument, and the character representation specified by the second.
200 showIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
201 showIntAtBase base toChr n0 r0
202 | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
203 | n0 < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n0)
204 | otherwise = showIt (quotRem n0 base) r0
205 where
206 showIt (n,d) r = seq c $ -- stricter than necessary
207 case n of
208 0 -> r'
209 _ -> showIt (quotRem n base) r'
210 where
211 c = toChr (fromIntegral d)
212 r' = c : r
213
214 -- | Show /non-negative/ 'Integral' numbers in base 16.
215 showHex :: (Integral a,Show a) => a -> ShowS
216 showHex = showIntAtBase 16 intToDigit
217
218 -- | Show /non-negative/ 'Integral' numbers in base 8.
219 showOct :: (Integral a, Show a) => a -> ShowS
220 showOct = showIntAtBase 8 intToDigit