ghc/lib/exts/NumExts.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1998
   3 %
   4
   5 \section[NumExts]{Misc numeric bits}
   6
   7 \begin{code}
   8 module NumExts
   9
  10        (
  11          doubleToFloat   -- :: Double -> Float
  12        , floatToDouble   -- :: Double -> Float
  13        , showHex         -- :: Integral a => a -> ShowS
  14        , showOct         -- :: Integral a => a -> ShowS
  15        ) where
  16
  17 import Char (ord, chr)
  18 #ifdef __HUGS__
  19 import PreludeBuiltin
  20 ord_0 = ord '0'
  21 #else
  22 import PrelBase (ord_0)
  23 import GlaExts
  24 #endif
  25 \end{code}
  26
  27 \begin{code}
  28 doubleToFloat :: Double -> Float
  29 floatToDouble :: Float -> Double
  30
  31 #ifdef __HUGS__
  32 doubleToFloat = primDoubleToFloat
  33 floatToDouble = primFloatToDouble
  34 #else
  35 doubleToFloat (D# d#) = F# (double2Float# d#)
  36 floatToDouble (F# f#) = D# (float2Double# f#)
  37 #endif
  38
  39 #ifdef __HUGS__
  40 showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
  41 showIntAtBase base toChr n r
  42   | n < 0  = error ("NumExts.showIntAtBase: applied to negative number " ++ show n)
  43   | otherwise =
  44     case quotRem n base of { (n', d) ->
  45     let c = toChr d in
  46     seq c $ -- stricter than necessary
  47     let
  48         r' = c : r
  49     in
  50     if n' == 0 then r' else showIntAtBase base toChr n' r'
  51     }
  52 #else
  53 showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
  54 showIntAtBase base toChr n r
  55   | n < 0  = error ("NumExts.showIntAtBase: applied to negative number " ++ show n)
  56   | otherwise =
  57     case quotRem n base of { (n', d) ->
  58     case toChr d        of { C# c# -> -- stricter than necessary
  59     let
  60         r' = C# c# : r
  61     in
  62     if n' == 0 then r' else showIntAtBase base toChr n' r'
  63     }}
  64 #endif
  65
  66 showHex :: Integral a => a -> ShowS
  67 showHex n r =
  68  showString "0x" $
  69  showIntAtBase 16 (toChrHex) n r
  70  where
  71   toChrHex d
  72     | d < 10    = chr (ord_0   + fromIntegral d)
  73     | otherwise = chr (ord 'a' + fromIntegral (d - 10))
  74
  75 showOct :: Integral a => a -> ShowS
  76 showOct n r =
  77  showString "0o" $
  78  showIntAtBase 8 (toChrOct) n r
  79  where toChrOct d = chr (ord_0   + fromIntegral d)
  80 \end{code}