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 import Data.Char
  46
  47 #ifdef __GLASGOW_HASKELL__
  48 import GHC.Base
  49 import GHC.Read
  50 import GHC.Real
  51 import GHC.Float
  52 import GHC.Num
  53 import GHC.Show
  54 import Data.Maybe
  55 import Text.ParserCombinators.ReadP( ReadP, readP_to_S, pfail )
  56 import qualified Text.Read.Lex as L
  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   | 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 (fromIntegral 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, showOct :: Integral a => a -> ShowS
 158 showHex = showIntAtBase 16 intToDigit
 159 showOct = showIntAtBase 8  intToDigit