NumExts.lhs 2.9 KB
 sof committed Jan 30, 1998 1 2 3 4 5 6 7 8 % % (c) The AQUA Project, Glasgow University, 1998 % \section[NumExts]{Misc numeric bits} \begin{code} module NumExts  simonm committed Dec 02, 1998 9   sof committed Jan 30, 1998 10 11 12  ( doubleToFloat -- :: Double -> Float , floatToDouble -- :: Double -> Float  sof committed Jan 19, 1999 13   sof committed Jan 30, 1998 14 15  , showHex -- :: Integral a => a -> ShowS , showOct -- :: Integral a => a -> ShowS  sof committed Jan 19, 1999 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 committed Mar 01, 1999 24 25 26  , showListWith -- :: (a -> ShowS) -- -> [a] -- -> ShowS  sof committed Jan 30, 1998 27 28 29  ) where import Char (ord, chr)  simonm committed Dec 02, 1998 30 31 32 #ifdef __HUGS__ ord_0 = ord '0' #else  simonpj committed May 18, 1999 33 34 import PrelNum ( ord_0 ) import PrelShow( showList__ )  sof committed Jan 30, 1998 35 import GlaExts  simonm committed Dec 02, 1998 36 #endif  sof committed Jan 30, 1998 37 38 39 40 41 \end{code} \begin{code} doubleToFloat :: Double -> Float floatToDouble :: Float -> Double  simonm committed Dec 02, 1998 42 43 44 45 46 47  #ifdef __HUGS__ doubleToFloat = primDoubleToFloat floatToDouble = primFloatToDouble #else doubleToFloat (D# d#) = F# (double2Float# d#)  sof committed Jan 30, 1998 48 floatToDouble (F# f#) = D# (float2Double# f#)  simonm committed Dec 02, 1998 49 #endif  sof committed Jan 30, 1998 50   simonm committed Dec 02, 1998 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 committed Jan 30, 1998 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' }}  simonm committed Dec 02, 1998 76 #endif  sof committed Jan 30, 1998 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 committed Jan 19, 1999 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 committed Jan 30, 1998 98 \end{code}  sof committed Mar 01, 1999 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 committed Nov 04, 1999 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 committed Mar 01, 1999 116 \end{code}  andy committed Nov 04, 1999 117