glafp-utils/nofib-analyse/Printf.lhs

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