glafp-utils/nofib-analyse/Printf.lhs

   1 -----------------------------------------------------------------------------
   2 -- $Id: Printf.lhs,v 1.1 1999/11/12 11:54:17 simonmar Exp $
   3
   4 -- (c) Simon Marlow 1997-1999
   5 -----------------------------------------------------------------------------
   6
   7 > module Printf (showFloat, showFloat') where
   8
   9 > import GlaExts
  10 > import PrelPack (unpackCString)
  11
  12 > showFloat
  13 >       :: Bool                         -- Always print decimal point
  14 >       -> Bool                         -- Left adjustment
  15 >       -> Bool                         -- Always print sign
  16 >       -> Bool                         -- Leave blank before positive number
  17 >       -> Bool                         -- Use zero padding
  18 >       -> Maybe Int                    -- Field Width
  19 >       -> Maybe Int                    -- Precision
  20 >       -> Float
  21 >       -> String
  22
  23 > bUFSIZE = 512 :: Int
  24
  25 > showFloat alt left sign blank zero width prec num =
  26 >       unsafePerformPrimIO ( do
  27 >               buf <- _ccall_ malloc bUFSIZE :: IO Addr
  28 >               _ccall_ snprintf buf bUFSIZE format num
  29 >               let s = unpackCString buf
  30 >               length s `seq` -- urk! need to force the string before we
  31 >                              -- free the buffer.  A better solution would
  32 >                              -- be to use foreign objects and finalisers,
  33 >                              -- but that's just too heavyweight.
  34 >                 _ccall_ free buf
  35 >               return s
  36 >       )
  37 >
  38 >  where
  39 >       format = '%' :
  40 >               if_bool alt   "#" ++
  41 >               if_bool left  "-" ++
  42 >               if_bool sign  "+" ++
  43 >               if_bool blank " " ++
  44 >               if_bool zero  "0" ++
  45 >               if_maybe width show ++
  46 >               if_maybe prec  (\s -> "." ++ show s) ++
  47 >               "f"
  48
  49 > showFloat' :: Maybe Int -> Maybe Int -> Float -> String
  50 > showFloat' = showFloat False False False False False
  51
  52 > if_bool False s = []
  53 > if_bool True  s = s
  54
  55 > if_maybe Nothing  f = []
  56 > if_maybe (Just s) f = f s