1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE 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
19module Numeric (
20
21        -- * Showing
22
23        showSigned,
24
25        showIntAtBase,
26        showInt,
27        showHex,
28        showOct,
29
30        showEFloat,
31        showFFloat,
32        showGFloat,
33        showFFloatAlt,
34        showGFloatAlt,
35        showFloat,
36        showHFloat,
37
38        floatToDigits,
39
40        -- * Reading
41
42        -- | /NB:/ 'readInt' is the \'dual\' of 'showIntAtBase',
43        -- and 'readDec' is the \`dual\' of 'showInt'.
44        -- The inconsistent naming is a historical accident.
45
46        readSigned,
47
48        readInt,
49        readDec,
50        readOct,
51        readHex,
52
53        readFloat,
54
55        lexDigits,
56
57        -- * Miscellaneous
58
59        fromRat,
60        Floating(..)
61
62        ) where
63
64import GHC.Base
65import GHC.Read
66import GHC.Real
67import GHC.Float
68import GHC.Num
69import GHC.Show
70import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
71import qualified Text.Read.Lex as L
72
73
74-- -----------------------------------------------------------------------------
75-- Reading
76
77-- | Reads an /unsigned/ 'Integral' value in an arbitrary base.
78readInt :: Num a
79  => a                  -- ^ the base
80  -> (Char -> Bool)     -- ^ a predicate distinguishing valid digits in this base
81  -> (Char -> Int)      -- ^ a function converting a valid digit character to an 'Int'
82  -> ReadS a
83readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
84
85-- | Read an unsigned number in octal notation.
86--
87-- >>> readOct "0644"
88-- [(420,"")]
89readOct :: (Eq a, Num a) => ReadS a
90readOct = readP_to_S L.readOctP
91
92-- | Read an unsigned number in decimal notation.
93--
94-- >>> readDec "0644"
95-- [(644,"")]
96readDec :: (Eq a, Num a) => ReadS a
97readDec = readP_to_S L.readDecP
98
99-- | Read an unsigned number in hexadecimal notation.
100-- Both upper or lower case letters are allowed.
101--
102-- >>> readHex "deadbeef"
103-- [(3735928559,"")]
104readHex :: (Eq a, Num a) => ReadS a
105readHex = readP_to_S L.readHexP
106
107-- | Reads an /unsigned/ 'RealFrac' value,
108-- expressed in decimal scientific notation.
109readFloat :: RealFrac a => ReadS a
110readFloat = readP_to_S readFloatP
111
112readFloatP :: RealFrac a => ReadP a
113readFloatP =
114  do tok <- L.lex
115     case tok of
116       L.Number n -> return $ fromRational $ L.numberToRational n
117       _          -> pfail
118
119-- It's turgid to have readSigned work using list comprehensions,
120-- but it's specified as a ReadS to ReadS transformer
121-- With a bit of luck no one will use it.
122
123-- | Reads a /signed/ 'Real' value, given a reader for an unsigned value.
124readSigned :: (Real a) => ReadS a -> ReadS a
125readSigned readPos = readParen False read'
126                     where read' r  = read'' r ++
127                                      (do
128                                        ("-",s) <- lex r
129                                        (x,t)   <- read'' s
130                                        return (-x,t))
131                           read'' r = do
132                               (str,s) <- lex r
133                               (n,"")  <- readPos str
134                               return (n,s)
135
136-- -----------------------------------------------------------------------------
137-- Showing
138
139-- | Show /non-negative/ 'Integral' numbers in base 10.
140showInt :: Integral a => a -> ShowS
141showInt n0 cs0
142    | n0 < 0    = errorWithoutStackTrace "Numeric.showInt: can't show negative numbers"
143    | otherwise = go n0 cs0
144    where
145    go n cs
146        | n < 10    = case unsafeChr (ord '0' + fromIntegral n) of
147            c@(C# _) -> c:cs
148        | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
149            c@(C# _) -> go q (c:cs)
150        where
151        (q,r) = n `quotRem` 10
152
153-- Controlling the format and precision of floats. The code that
154-- implements the formatting itself is in @PrelNum@ to avoid
155-- mutual module deps.
156
157{-# SPECIALIZE showEFloat ::
158        Maybe Int -> Float  -> ShowS,
159        Maybe Int -> Double -> ShowS #-}
160{-# SPECIALIZE showFFloat ::
161        Maybe Int -> Float  -> ShowS,
162        Maybe Int -> Double -> ShowS #-}
163{-# SPECIALIZE showGFloat ::
164        Maybe Int -> Float  -> ShowS,
165        Maybe Int -> Double -> ShowS #-}
166
167-- | Show a signed 'RealFloat' value
168-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).
169--
170-- In the call @'showEFloat' digs val@, if @digs@ is 'Nothing',
171-- the value is shown to full precision; if @digs@ is @'Just' d@,
172-- then at most @d@ digits after the decimal point are shown.
173showEFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS
174
175-- | Show a signed 'RealFloat' value
176-- using standard decimal notation (e.g. @245000@, @0.0015@).
177--
178-- In the call @'showFFloat' digs val@, if @digs@ is 'Nothing',
179-- the value is shown to full precision; if @digs@ is @'Just' d@,
180-- then at most @d@ digits after the decimal point are shown.
181showFFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS
182
183-- | Show a signed 'RealFloat' value
184-- using standard decimal notation for arguments whose absolute value lies
185-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
186--
187-- In the call @'showGFloat' digs val@, if @digs@ is 'Nothing',
188-- the value is shown to full precision; if @digs@ is @'Just' d@,
189-- then at most @d@ digits after the decimal point are shown.
190showGFloat    :: (RealFloat a) => Maybe Int -> a -> ShowS
191
192showEFloat d x =  showString (formatRealFloat FFExponent d x)
193showFFloat d x =  showString (formatRealFloat FFFixed d x)
194showGFloat d x =  showString (formatRealFloat FFGeneric d x)
195
196-- | Show a signed 'RealFloat' value
197-- using standard decimal notation (e.g. @245000@, @0.0015@).
198--
199-- This behaves as 'showFFloat', except that a decimal point
200-- is always guaranteed, even if not needed.
201--
202-- @since 4.7.0.0
203showFFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS
204
205-- | Show a signed 'RealFloat' value
206-- using standard decimal notation for arguments whose absolute value lies
207-- between @0.1@ and @9,999,999@, and scientific notation otherwise.
208--
209-- This behaves as 'showFFloat', except that a decimal point
210-- is always guaranteed, even if not needed.
211--
212-- @since 4.7.0.0
213showGFloatAlt    :: (RealFloat a) => Maybe Int -> a -> ShowS
214
215showFFloatAlt d x =  showString (formatRealFloatAlt FFFixed d True x)
216showGFloatAlt d x =  showString (formatRealFloatAlt FFGeneric d True x)
217
218{- | Show a floating-point value in the hexadecimal format,
219similar to the @%a@ specifier in C's printf.
220
221  >>> showHFloat (212.21 :: Double) ""
222  "0x1.a86b851eb851fp7"
223  >>> showHFloat (-12.76 :: Float) ""
224  "-0x1.9851ecp3"
225  >>> showHFloat (-0 :: Double) ""
226  "-0x0p+0"
227-}
228showHFloat :: RealFloat a => a -> ShowS
229showHFloat = showString . fmt
230  where
231  fmt x
232    | isNaN x                   = "NaN"
233    | isInfinite x              = (if x < 0 then "-" else "") ++ "Infinity"
234    | x < 0 || isNegativeZero x = '-' : cvt (-x)
235    | otherwise                 = cvt x
236
237  cvt x
238    | x == 0 = "0x0p+0"
239    | otherwise =
240      case floatToDigits 2 x of
241        r@([], _) -> error $ "Impossible happened: showHFloat: " ++ show r
242        (d:ds, e) -> "0x" ++ show d ++ frac ds ++ "p" ++ show (e-1)
243
244  -- Given binary digits, convert them to hex in blocks of 4
245  -- Special case: If all 0's, just drop it.
246  frac digits
247    | allZ digits = ""
248    | otherwise   = "." ++ hex digits
249    where
250    hex ds =
251      case ds of
252        []                -> ""
253        [a]               -> hexDigit a 0 0 0 ""
254        [a,b]             -> hexDigit a b 0 0 ""
255        [a,b,c]           -> hexDigit a b c 0 ""
256        a : b : c : d : r -> hexDigit a b c d (hex r)
257
258  hexDigit a b c d = showHex (8*a + 4*b + 2*c + d)
259
260  allZ xs = case xs of
261              x : more -> x == 0 && allZ more
262              []       -> True
263
264-- ---------------------------------------------------------------------------
265-- Integer printing functions
266
267-- | Shows a /non-negative/ 'Integral' number using the base specified by the
268-- first argument, and the character representation specified by the second.
269showIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
270showIntAtBase base toChr n0 r0
271  | base <= 1 = errorWithoutStackTrace ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
272  | n0 <  0   = errorWithoutStackTrace ("Numeric.showIntAtBase: applied to negative number " ++ show n0)
273  | otherwise = showIt (quotRem n0 base) r0
274   where
275    showIt (n,d) r = seq c $ -- stricter than necessary
276      case n of
277        0 -> r'
278        _ -> showIt (quotRem n base) r'
279     where
280      c  = toChr (fromIntegral d)
281      r' = c : r
282
283-- | Show /non-negative/ 'Integral' numbers in base 16.
284showHex :: (Integral a,Show a) => a -> ShowS
285showHex = showIntAtBase 16 intToDigit
286
287-- | Show /non-negative/ 'Integral' numbers in base 8.
288showOct :: (Integral a, Show a) => a -> ShowS
289showOct = showIntAtBase 8  intToDigit
290