utils/nofib-analyse/Printf.lhs

   1 -----------------------------------------------------------------------------
   2 -- $Id: Printf.lhs,v 1.5 2002/03/14 17:09:46 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)
  36 >                       (realToFrac num)
  37 >               let s = unpackCString buf
  38 >               length s `seq` -- urk! need to force the string before we
  39 >                              -- free the buffer.  A better solution would
  40 >                              -- be to use foreign objects and finalisers,
  41 >                              -- but that's just too heavyweight.
  42 >                  free buf
  43 >               return s
  44
  45 #else
  46
  47 >               allocaBytes bUFSIZE $ \buf ->
  48 >                 withCString format $ \cformat -> do
  49 >                   snprintf buf (fromIntegral bUFSIZE) cformat
  50 >                       (realToFrac num)
  51 >                   peekCString buf
  52
  53 #endif
  54
  55 >  where
  56 >       format = '%' :
  57 >               if_bool alt   "#" ++
  58 >               if_bool left  "-" ++
  59 >               if_bool sign  "+" ++
  60 >               if_bool blank " " ++
  61 >               if_bool zero  "0" ++
  62 >               if_maybe width show ++
  63 >               if_maybe prec  (\s -> "." ++ show s) ++
  64 >               "f"
  65
  66 > showFloat' :: Maybe Int -> Maybe Int -> Float -> String
  67 > showFloat' = showFloat False False False False False
  68
  69 > if_bool False s = []
  70 > if_bool True  s = s
  71
  72 > if_maybe Nothing  f = []
  73 > if_maybe (Just s) f = f s
  74
  75 #if __GLASGOW_HASKELL__ < 500
  76
  77 > type PackedString = ByteArray Int
  78 > foreign import unsafe snprintf :: Addr -> CSize -> PackedString -> Double -> IO ()
  79
  80 #else
  81
  82 > foreign import unsafe snprintf :: CString -> CSize -> CString -> Double -> IO ()
  83
  84 #endif