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)