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.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 -> (a -> Char) -> a -> ShowS
 145 showIntAtBase base toChr n r
 146   | n < 0  = error ("Numeric.showIntAtBase: applied to negative number " ++ show n)
 147   | otherwise =
 148     case quotRem n base of { (n', d) ->
 149     let c = toChr d in
 150     seq c $ -- stricter than necessary
 151     let
 152         r' = c : r
 153     in
 154     if n' == 0 then r' else showIntAtBase base toChr n' r'
 155     }
 156
 157 showHex :: Integral a => a -> ShowS
 158 showHex n r =
 159  showString "0x" $
 160  showIntAtBase 16 (toChrHex) n r
 161  where
 162   toChrHex d
 163     | d < 10    = chr (ord '0' + fromIntegral d)
 164     | otherwise = chr (ord 'a' + fromIntegral (d - 10))
 165
 166 showOct :: Integral a => a -> ShowS
 167 showOct n r =
 168  showString "0o" $
 169  showIntAtBase 8 (toChrOct) n r
 170  where toChrOct d = chr (ord '0' + fromIntegral d)
 171
 172 showBin :: Integral a => a -> ShowS
 173 showBin n r =
 174  showString "0b" $
 175  showIntAtBase 2 (toChrOct) n r
 176  where toChrOct d = chr (ord '0' + fromIntegral d)