blob: 33b5290e074ca16abd6a547f536424832dfe82a2 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
-----------------------------------------------------------------------------
-- $Id: Printf.lhs,v 1.5 2002/03/14 17:09:46 simonmar Exp $
-- (c) Simon Marlow 1997-2001
-----------------------------------------------------------------------------
> module Printf (showFloat, showFloat') where
> import Foreign
> import CTypes
> import CTypesISO
> import CString
> import IOExts
> import ByteArray
> showFloat
> :: Bool -- Always print decimal point
> -> Bool -- Left adjustment
> -> Bool -- Always print sign
> -> Bool -- Leave blank before positive number
> -> Bool -- Use zero padding
> -> Maybe Int -- Field Width
> -> Maybe Int -- Precision
> -> Float
> -> String
> bUFSIZE = 512 :: Int
> showFloat alt left sign blank zero width prec num =
> unsafePerformIO $ do
#if __GLASGOW_HASKELL__ < 500
> buf <- malloc bUFSIZE
> snprintf buf (fromIntegral bUFSIZE) (packString format)
> (realToFrac num)
> let s = unpackCString buf
> length s `seq` -- urk! need to force the string before we
> -- free the buffer. A better solution would
> -- be to use foreign objects and finalisers,
> -- but that's just too heavyweight.
> free buf
> return s
#else
> allocaBytes bUFSIZE $ \buf ->
> withCString format $ \cformat -> do
> snprintf buf (fromIntegral bUFSIZE) cformat
> (realToFrac num)
> peekCString buf
#endif
> where
> format = '%' :
> if_bool alt "#" ++
> if_bool left "-" ++
> if_bool sign "+" ++
> if_bool blank " " ++
> if_bool zero "0" ++
> if_maybe width show ++
> if_maybe prec (\s -> "." ++ show s) ++
> "f"
> showFloat' :: Maybe Int -> Maybe Int -> Float -> String
> showFloat' = showFloat False False False False False
> if_bool False s = []
> if_bool True s = s
> if_maybe Nothing f = []
> if_maybe (Just s) f = f s
#if __GLASGOW_HASKELL__ < 500
> type PackedString = ByteArray Int
> foreign import unsafe snprintf :: Addr -> CSize -> PackedString -> Double -> IO ()
#else
> foreign import unsafe snprintf :: CString -> CSize -> CString -> Double -> IO ()
#endif
|
