glafp-utils/nofib-analyse/Printf.lhs

   1 -----------------------------------------------------------------------------
   2 -- $Id: Printf.lhs,v 1.2 2001/02/21 16:24:34 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 > import PrelPack (unpackCString)
  16
  17 > showFloat
  18 >       :: Bool                         -- Always print decimal point
  19 >       -> Bool                         -- Left adjustment
  20 >       -> Bool                         -- Always print sign
  21 >       -> Bool                         -- Leave blank before positive number
  22 >       -> Bool                         -- Use zero padding
  23 >       -> Maybe Int                    -- Field Width
  24 >       -> Maybe Int                    -- Precision
  25 >       -> Float
  26 >       -> String
  27
  28 > bUFSIZE = 512 :: Int
  29
  30 > showFloat alt left sign blank zero width prec num =
  31 >       unsafePerformIO ( do
  32 >               buf <- malloc bUFSIZE
  33 >               snprintf buf (fromIntegral bUFSIZE) (packString format) num
  34 >               let s = unpackCString buf
  35 >               length s `seq` -- urk! need to force the string before we
  36 >                              -- free the buffer.  A better solution would
  37 >                              -- be to use foreign objects and finalisers,
  38 >                              -- but that's just too heavyweight.
  39 >                  free buf
  40 >               return s
  41 >       )
  42 >
  43 >  where
  44 >       format = '%' :
  45 >               if_bool alt   "#" ++
  46 >               if_bool left  "-" ++
  47 >               if_bool sign  "+" ++
  48 >               if_bool blank " " ++
  49 >               if_bool zero  "0" ++
  50 >               if_maybe width show ++
  51 >               if_maybe prec  (\s -> "." ++ show s) ++
  52 >               "f"
  53
  54 > showFloat' :: Maybe Int -> Maybe Int -> Float -> String
  55 > showFloat' = showFloat False False False False False
  56
  57 > if_bool False s = []
  58 > if_bool True  s = s
  59
  60 > if_maybe Nothing  f = []
  61 > if_maybe (Just s) f = f s
  62
  63 > type PackedString = ByteArray Int
  64 > foreign import unsafe snprintf :: Addr -> CSize -> PackedString -> Float -> IO ()