X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=glafp-utils%2Fnofib-analyse%2FPrintf.lhs;h=33b5290e074ca16abd6a547f536424832dfe82a2;hb=943c67d68bd033d2a8d62c85ce69f8b6a0b11e3b;hp=8d65c0c978659973c2674e28f6db158f370e6ac9;hpb=aadb2bf04603e88c0e458e71e26a69776ec823d0;p=ghc-hetmet.git diff --git a/glafp-utils/nofib-analyse/Printf.lhs b/glafp-utils/nofib-analyse/Printf.lhs index 8d65c0c..33b5290 100644 --- a/glafp-utils/nofib-analyse/Printf.lhs +++ b/glafp-utils/nofib-analyse/Printf.lhs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: Printf.lhs,v 1.2 2001/02/21 16:24:34 simonmar Exp $ +-- $Id: Printf.lhs,v 1.5 2002/03/14 17:09:46 simonmar Exp $ -- (c) Simon Marlow 1997-2001 ----------------------------------------------------------------------------- @@ -12,7 +12,6 @@ > import CString > import IOExts > import ByteArray -> import PrelPack (unpackCString) > showFloat > :: Bool -- Always print decimal point @@ -28,9 +27,13 @@ > bUFSIZE = 512 :: Int > showFloat alt left sign blank zero width prec num = -> unsafePerformIO ( do +> unsafePerformIO $ do + +#if __GLASGOW_HASKELL__ < 500 + > buf <- malloc bUFSIZE -> snprintf buf (fromIntegral bUFSIZE) (packString format) num +> 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 @@ -38,8 +41,17 @@ > -- 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 "#" ++ @@ -60,5 +72,13 @@ > 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 -> Float -> IO () +> foreign import unsafe snprintf :: Addr -> CSize -> PackedString -> Double -> IO () + +#else + +> foreign import unsafe snprintf :: CString -> CSize -> CString -> Double -> IO () + +#endif