[project @ 2002-09-09 03:50:38 by sof]
[packages/base.git] / Numeric.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Numeric
5 -- Copyright : (c) The University of Glasgow 2002
6 -- License : BSD-style (see the file libraries/base/LICENSE)
7 --
8 -- Maintainer : libraries@haskell.org
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 -----------------------------------------------------------------------------
16
17 module Numeric (
18
19 fromRat, -- :: (RealFloat a) => Rational -> a
20 showSigned, -- :: (Real a) => (a -> ShowS) -> Int -> a -> ShowS
21 readSigned, -- :: (Real a) => ReadS a -> ReadS a
22
23 readInt, -- :: (Integral a) => a -> (Char -> Bool)
24 -- -> (Char -> Int) -> ReadS a
25 readDec, -- :: (Integral a) => ReadS a
26 readOct, -- :: (Integral a) => ReadS a
27 readHex, -- :: (Integral a) => ReadS a
28
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
34
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
39 readFloat, -- :: (RealFloat a) => ReadS a
40
41 floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int)
42 lexDigits, -- :: ReadS String
43
44 ) where
45
46 import Data.Char
47
48 #ifdef __GLASGOW_HASKELL__
49 import GHC.Base
50 import GHC.Read
51 import GHC.Real
52 import GHC.Float
53 import GHC.Num
54 import GHC.Show
55 import Data.Maybe
56 import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
57 import qualified Text.Read.Lex as L
58 #endif
59
60 #ifdef __HUGS__
61 import Hugs.Prelude
62 import Hugs.Numeric
63 #endif
64
65 #ifdef __GLASGOW_HASKELL__
66 -- -----------------------------------------------------------------------------
67 -- Reading
68
69 readInt :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
70 readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
71
72 readOct, readDec, readHex :: Num a => ReadS a
73 readOct = readP_to_S L.readOctP
74 readDec = readP_to_S L.readDecP
75 readHex = readP_to_S L.readHexP
76
77 readFloat :: RealFrac a => ReadS a
78 readFloat = readP_to_S readFloatP
79
80 readFloatP :: RealFrac a => ReadP a
81 readFloatP =
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
87
88 -- It's turgid to have readSigned work using list comprehensions,
89 -- but it's specified as a ReadS to ReadS transformer
90 -- With a bit of luck no one will use it.
91 readSigned :: (Real a) => ReadS a -> ReadS a
92 readSigned readPos = readParen False read'
93 where read' r = read'' r ++
94 (do
95 ("-",s) <- lex r
96 (x,t) <- read'' s
97 return (-x,t))
98 read'' r = do
99 (str,s) <- lex r
100 (n,"") <- readPos str
101 return (n,s)
102
103 -- -----------------------------------------------------------------------------
104 -- Showing
105
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
118
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.
122
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 #-}
132
133 showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
134 showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
135 showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
136
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)
140 #endif /* __GLASGOW_HASKELL__ */
141
142 -- ---------------------------------------------------------------------------
143 -- Integer printing functions
144
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 }
157
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))
166
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)
172
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)