[project @ 2004-03-30 17:54:28 by ross]
[packages/pretty.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
34 showEFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
35 showFFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
36 showGFloat, -- :: (RealFloat a) => Maybe Int -> a -> ShowS
37 showFloat, -- :: (RealFloat a) => a -> ShowS
38 readFloat, -- :: (RealFloat a) => ReadS a
39
40 floatToDigits, -- :: (RealFloat a) => Integer -> a -> ([Int], Int)
41 lexDigits, -- :: ReadS String
42
43 ) where
44
45 #ifdef __GLASGOW_HASKELL__
46 import GHC.Base
47 import GHC.Read
48 import GHC.Real
49 import GHC.Float
50 import GHC.Num
51 import GHC.Show
52 import Data.Maybe
53 import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
54 import qualified Text.Read.Lex as L
55 #else
56 import Data.Char
57 #endif
58
59 #ifdef __HUGS__
60 import Hugs.Prelude
61 import Hugs.Numeric
62 #endif
63
64 #ifdef __GLASGOW_HASKELL__
65 -- -----------------------------------------------------------------------------
66 -- Reading
67
68 readInt :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
69 readInt base isDigit valDigit = readP_to_S (L.readIntP base isDigit valDigit)
70
71 readOct, readDec, readHex :: Num a => ReadS a
72 readOct = readP_to_S L.readOctP
73 readDec = readP_to_S L.readDecP
74 readHex = readP_to_S L.readHexP
75
76 readFloat :: RealFrac a => ReadS a
77 readFloat = readP_to_S readFloatP
78
79 readFloatP :: RealFrac a => ReadP a
80 readFloatP =
81 do tok <- L.lex
82 case tok of
83 L.Rat y -> return (fromRational y)
84 L.Int i -> return (fromInteger i)
85 other -> pfail
86
87 -- It's turgid to have readSigned work using list comprehensions,
88 -- but it's specified as a ReadS to ReadS transformer
89 -- With a bit of luck no one will use it.
90 readSigned :: (Real a) => ReadS a -> ReadS a
91 readSigned readPos = readParen False read'
92 where read' r = read'' r ++
93 (do
94 ("-",s) <- lex r
95 (x,t) <- read'' s
96 return (-x,t))
97 read'' r = do
98 (str,s) <- lex r
99 (n,"") <- readPos str
100 return (n,s)
101
102 -- -----------------------------------------------------------------------------
103 -- Showing
104
105 showInt :: Integral a => a -> ShowS
106 showInt n cs
107 | n < 0 = error "Numeric.showInt: can't show negative numbers"
108 | otherwise = go n cs
109 where
110 go n cs
111 | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
112 c@(C# _) -> c:cs
113 | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
114 c@(C# _) -> go q (c:cs)
115 where
116 (q,r) = n `quotRem` 10
117
118 -- Controlling the format and precision of floats. The code that
119 -- implements the formatting itself is in @PrelNum@ to avoid
120 -- mutual module deps.
121
122 {-# SPECIALIZE showEFloat ::
123 Maybe Int -> Float -> ShowS,
124 Maybe Int -> Double -> ShowS #-}
125 {-# SPECIALIZE showFFloat ::
126 Maybe Int -> Float -> ShowS,
127 Maybe Int -> Double -> ShowS #-}
128 {-# SPECIALIZE showGFloat ::
129 Maybe Int -> Float -> ShowS,
130 Maybe Int -> Double -> ShowS #-}
131
132 showEFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
133 showFFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
134 showGFloat :: (RealFloat a) => Maybe Int -> a -> ShowS
135
136 showEFloat d x = showString (formatRealFloat FFExponent d x)
137 showFFloat d x = showString (formatRealFloat FFFixed d x)
138 showGFloat d x = showString (formatRealFloat FFGeneric d x)
139 #endif /* __GLASGOW_HASKELL__ */
140
141 -- ---------------------------------------------------------------------------
142 -- Integer printing functions
143
144 showIntAtBase :: Integral a => a -> (Int -> Char) -> a -> ShowS
145 showIntAtBase base toChr n r
146 | base <= 1 = error ("Numeric.showIntAtBase: applied to unsupported base " ++ show base)
147 | n < 0 = error ("Numeric.showIntAtBase: applied to negative number " ++ show n)
148 | otherwise = showIt (quotRem n base) r
149 where
150 showIt (n,d) r = seq c $ -- stricter than necessary
151 case n of
152 0 -> r'
153 _ -> showIt (quotRem n base) r'
154 where
155 c = toChr (fromIntegral d)
156 r' = c : r
157
158 showHex, showOct :: Integral a => a -> ShowS
159 showHex = showIntAtBase 16 intToDigit
160 showOct = showIntAtBase 8 intToDigit