NumExts.lhs 2.9 KB
Newer Older
sof's avatar
sof committed
1 2 3 4 5 6 7 8
%
% (c) The AQUA Project, Glasgow University, 1998
%

\section[NumExts]{Misc numeric bits}

\begin{code}
module NumExts
9

sof's avatar
sof committed
10 11 12
       (
         doubleToFloat   -- :: Double -> Float
       , floatToDouble   -- :: Double -> Float
sof's avatar
sof committed
13

sof's avatar
sof committed
14 15
       , showHex         -- :: Integral a => a -> ShowS
       , showOct         -- :: Integral a => a -> ShowS
sof's avatar
sof committed
16 17 18 19 20 21 22 23
       , showBin         -- :: Integral a => a -> ShowS

	 -- general purpose number->string converter.
       , showIntAtBase   -- :: Integral a 
			 -- => a		-- base
			 -- -> (a -> Char)      -- digit to char
			 -- -> a                -- number to show.
			 -- -> ShowS
sof's avatar
sof committed
24 25 26
       , showListWith    -- :: (a -> ShowS)
			 -- -> [a]
			 -- -> ShowS
sof's avatar
sof committed
27 28 29
       ) where

import Char (ord, chr)
30 31 32
#ifdef __HUGS__
ord_0 = ord '0'
#else
33 34
import PrelNum ( ord_0 )
import PrelShow( showList__ )
sof's avatar
sof committed
35
import GlaExts
36
#endif
sof's avatar
sof committed
37 38 39 40 41
\end{code}

\begin{code}
doubleToFloat :: Double -> Float
floatToDouble :: Float -> Double
42 43 44 45 46 47

#ifdef __HUGS__
doubleToFloat = primDoubleToFloat
floatToDouble = primFloatToDouble
#else
doubleToFloat (D# d#) = F# (double2Float# d#)
sof's avatar
sof committed
48
floatToDouble (F# f#) = D# (float2Double# f#)
49
#endif
sof's avatar
sof committed
50

51 52 53 54 55 56 57 58 59 60 61 62 63 64
#ifdef __HUGS__
showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
showIntAtBase base toChr n r
  | n < 0  = error ("NumExts.showIntAtBase: applied to negative number " ++ show n)
  | otherwise = 
    case quotRem n base of { (n', d) ->
    let c = toChr d in
    seq c $ -- stricter than necessary
    let
	r' = c : r
    in
    if n' == 0 then r' else showIntAtBase base toChr n' r'
    }
#else
sof's avatar
sof committed
65 66 67 68 69 70 71 72 73 74 75
showIntAtBase :: Integral a => a -> (a -> Char) -> a -> ShowS
showIntAtBase base toChr n r
  | n < 0  = error ("NumExts.showIntAtBase: applied to negative number " ++ show n)
  | otherwise = 
    case quotRem n base of { (n', d) ->
    case toChr d        of { C# c# -> -- stricter than necessary
    let
	r' = C# c# : r
    in
    if n' == 0 then r' else showIntAtBase base toChr n' r'
    }}
76
#endif
sof's avatar
sof committed
77 78 79 80 81 82 83 84 85 86 87 88 89 90 91

showHex :: Integral a => a -> ShowS
showHex n r = 
 showString "0x" $
 showIntAtBase 16 (toChrHex) n r
 where  
  toChrHex d
    | d < 10    = chr (ord_0   + fromIntegral d)
    | otherwise = chr (ord 'a' + fromIntegral (d - 10))

showOct :: Integral a => a -> ShowS
showOct n r = 
 showString "0o" $
 showIntAtBase 8 (toChrOct) n r
 where toChrOct d = chr (ord_0   + fromIntegral d)
sof's avatar
sof committed
92 93 94 95 96 97

showBin :: Integral a => a -> ShowS
showBin n r = 
 showString "0b" $
 showIntAtBase 2 (toChrOct) n r
 where toChrOct d = chr (ord_0 + fromIntegral d)
sof's avatar
sof committed
98
\end{code}
sof's avatar
sof committed
99 100 101 102 103 104 105 106 107

Easy enough to define by the user, but since it's
occasionally useful (when, say, printing out a 
list of hex values), we define and export it
from @NumExts@.

\begin{code}
showListWith :: (a -> ShowS) -> [a] -> ShowS 
showListWith = showList__
andy's avatar
andy committed
108 109 110 111 112 113 114 115
#ifdef __HUGS__
showList__ :: (a -> ShowS) ->  [a] -> ShowS
showList__ _     []     s = "[]" ++ s
showList__ showx (x:xs) s = '[' : showx x (showl xs)
  where
    showl []     = ']' : s
    showl (y:ys) = ',' : showx y (showl ys)
#endif
sof's avatar
sof committed
116
\end{code}
andy's avatar
andy committed
117