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
  14        , showHex         -- :: Integral a => a -> ShowS
  15        , showOct         -- :: Integral a => a -> ShowS
  16        , showBin         -- :: Integral a => a -> ShowS
  17
  18          -- general purpose number->string converter.
  19        , showIntAtBase   -- :: Integral a
  20                          -- => a                -- base
  21                          -- -> (a -> Char)      -- digit to char
  22                          -- -> a                -- number to show.
  23                          -- -> ShowS
  24        ) where
  25
  26 import Char (ord, chr)
  27 #ifdef __HUGS__
  28 import PreludeBuiltin
  29 ord_0 = ord '0'
  30 #else
  31 import PrelBase (ord_0)
  32 import GlaExts
  33 #endif
  34 \end{code}
  35
  36 \begin{code}
  37 doubleToFloat :: Double -> Float
  38 floatToDouble :: Float -> Double
  39
  40 #ifdef __HUGS__
  41 doubleToFloat = primDoubleToFloat
  42 floatToDouble = primFloatToDouble
  43 #else
  44 doubleToFloat (D# d#) = F# (double2Float# d#)
  45 floatToDouble (F# f#) = D# (float2Double# f#)
  46 #endif
  47
  48 #ifdef __HUGS__
  49 showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
  50 showIntAtBase base toChr n r
  51   | n < 0  = error ("NumExts.showIntAtBase: applied to negative number " ++ show n)
  52   | otherwise =
  53     case quotRem n base of { (n', d) ->
  54     let c = toChr d in
  55     seq c $ -- stricter than necessary
  56     let
  57         r' = c : r
  58     in
  59     if n' == 0 then r' else showIntAtBase base toChr n' r'
  60     }
  61 #else
  62 showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
  63 showIntAtBase base toChr n r
  64   | n < 0  = error ("NumExts.showIntAtBase: applied to negative number " ++ show n)
  65   | otherwise =
  66     case quotRem n base of { (n', d) ->
  67     case toChr d        of { C# c# -> -- stricter than necessary
  68     let
  69         r' = C# c# : r
  70     in
  71     if n' == 0 then r' else showIntAtBase base toChr n' r'
  72     }}
  73 #endif
  74
  75 showHex :: Integral a => a -> ShowS
  76 showHex n r =
  77  showString "0x" $
  78  showIntAtBase 16 (toChrHex) n r
  79  where
  80   toChrHex d
  81     | d < 10    = chr (ord_0   + fromIntegral d)
  82     | otherwise = chr (ord 'a' + fromIntegral (d - 10))
  83
  84 showOct :: Integral a => a -> ShowS
  85 showOct n r =
  86  showString "0o" $
  87  showIntAtBase 8 (toChrOct) n r
  88  where toChrOct d = chr (ord_0   + fromIntegral d)
  89
  90 showBin :: Integral a => a -> ShowS
  91 showBin n r =
  92  showString "0b" $
  93  showIntAtBase 2 (toChrOct) n r
  94  where toChrOct d = chr (ord_0 + fromIntegral d)
  95 \end{code}