libffi 0.1 → 0.2
raw patch · 11 files changed
+197/−440 lines, 11 filesdep ~basenew-uploader
Dependency ranges changed: base
Files
- CHANGELOG.md +24/−0
- Foreign/LibFFI/Base.hs +34/−35
- Foreign/LibFFI/Types.hs +3/−15
- README.md +85/−0
- TODO +0/−17
- examples/CCall.hs +0/−176
- examples/CTime.hsc +0/−75
- examples/Makefile +0/−22
- examples/MemSpeed.hs +0/−75
- examples/mytime.c +0/−14
- libffi.cabal +51/−11
+ CHANGELOG.md view
@@ -0,0 +1,24 @@+## 0.2 [2022.08.11]+* The `libffi` library now uses `bracket` internally and should now be+ exception-safe.+* There is a now a `ghc-bundled-libffi` `cabal` flag that makes this library+ statically link against GHC's bundled copy of `libffi` rather than attempt to+ link against the system `libffi`. On the vast majority of GHCs, this is the+ most reasonable option, as linking against the system `libffi` is inherently+ fragile. As a result, `+ghc-bundled-libffi` is now the defalut setting. See+ the [`README`](https://github.com/remiturk/libffi/blob/master/README.md#notes-on-ghcs-bundling-of-libffi)+ for more discussion on this point.+* The definition of `Arg` has changed:++ ```diff+ -newtype Arg = Arg { unArg :: IO (Ptr CType, Ptr CValue, IO ()) }+ +newtype Arg = Arg { unArg :: forall a. (Ptr CType -> Ptr CValue -> IO a) -> IO a }+ ```+* The definition of `RetType` has changed:+ ```diff+ -data RetType a = RetType (Ptr CType) ((Ptr CValue -> IO ()) -> IO a)+ +newtype RetType a = RetType { unRetType :: (Ptr CType -> Ptr CValue -> IO ()) -> IO a }+ ```++## 0.1 [2009.03.17]+* Initial release.
Foreign/LibFFI/Base.hs view
@@ -1,50 +1,41 @@-{- | This module defines the basic libffi machinery. You will need this to create support for new ffi types. -}+{-# LANGUAGE Rank2Types #-}+{- | This module defines the basic libffi machinery.+ You will need this to create support for new ffi types. -} module Foreign.LibFFI.Base where import Control.Monad-import Data.List-import Data.Char-import Data.Int-import Data.Word--import Foreign.C.Types+import Control.Exception import Foreign.Ptr import Foreign.Storable-import Foreign.C.String import Foreign.Marshal-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BSU import Foreign.LibFFI.Internal import Foreign.LibFFI.FFITypes -newtype Arg = Arg { unArg :: IO (Ptr CType, Ptr CValue, IO ()) }+newtype Arg = Arg { unArg :: forall a. (Ptr CType -> Ptr CValue -> IO a) -> IO a } customPointerArg :: (a -> IO (Ptr b)) -> (Ptr b -> IO ()) -> a -> Arg-customPointerArg newA freeA a = Arg $ do- p <- newA a- pp <- new p- return (ffi_type_pointer, castPtr pp, free pp >> freeA p)+customPointerArg newA freeA a = Arg $ \withArg ->+ bracket (newA a) freeA $ \p ->+ with p $ \pp ->+ withArg ffi_type_pointer (castPtr pp) mkStorableArg :: Storable a => Ptr CType -> a -> Arg-mkStorableArg cType a = Arg $ do- p <- malloc- poke p a- return (cType, castPtr p, free p)+mkStorableArg cType a = Arg $ \withArg ->+ with a $ \p ->+ withArg cType (castPtr p) -data RetType a = RetType (Ptr CType) ((Ptr CValue -> IO ()) -> IO a)+newtype RetType a = RetType { unRetType :: (Ptr CType -> Ptr CValue -> IO ()) -> IO a } instance Functor RetType where fmap f = withRetType (return . f) withRetType :: (a -> IO b) -> RetType a -> RetType b-withRetType f (RetType cType withPoke)- = RetType cType (withPoke >=> f)+withRetType f (RetType withPoke) = RetType $ withPoke >=> f mkStorableRetType :: Storable a => Ptr CType -> RetType a mkStorableRetType cType- = RetType cType- (\write -> alloca $ \ptr -> write (castPtr ptr) >> peek ptr)+ = RetType $ \write -> alloca $ \cValue -> write cType (castPtr cValue) >> peek cValue newStorableStructArgRet :: Storable a => [Ptr CType] -> IO (a -> Arg, RetType a, IO ()) newStorableStructArgRet cTypes = do@@ -59,14 +50,22 @@ return (ffi_type, free ffi_type >> free elements) callFFI :: FunPtr a -> RetType b -> [Arg] -> IO b-callFFI funPtr (RetType cRetType withRet) args- = allocaBytes sizeOf_cif $ \cif -> do- (cTypes, cValues, frees) <- unzip3 `liftM` mapM unArg args- withArray cTypes $ \cTypesPtr -> do- status <- ffi_prep_cif cif ffi_default_abi (genericLength args) cRetType cTypesPtr- unless (status == ffi_ok) $- error "callFFI: ffi_prep_cif failed"- withArray cValues $ \cValuesPtr -> do- ret <- withRet (\cRet -> ffi_call cif funPtr cRet cValuesPtr)- sequence_ frees- return ret+callFFI funPtr (RetType actRet) args+ = allocaBytes sizeOf_cif $ \cif ->+ allocaArray n $ \cTypesPtr ->+ allocaArray n $ \cValuesPtr ->+ let+ doCall = actRet $ \cRetType cRetValue -> do+ status <- ffi_prep_cif cif ffi_default_abi (fromIntegral n) cRetType cTypesPtr+ unless (status == ffi_ok) $+ error "callFFI: ffi_prep_cif failed"+ ffi_call cif funPtr cRetValue cValuesPtr+ addArg (i, Arg actArg) goArgs+ = actArg $ \cType cValue -> do+ pokeElemOff cTypesPtr i cType+ pokeElemOff cValuesPtr i cValue+ goArgs+ in+ foldr addArg doCall $ zip [0..] args+ where+ n = length args
Foreign/LibFFI/Types.hs view
@@ -6,12 +6,10 @@ argCUInt, argCLong, argCULong,- argInt, argInt8, argInt16, argInt32, argInt64,- argWord, argWord8, argWord16, argWord32,@@ -38,12 +36,10 @@ retCUInt, retCLong, retCULong,- retInt, retInt8, retInt16, retInt32, retInt64,- retWord, retWord8, retWord16, retWord32,@@ -93,8 +89,6 @@ argCULong = mkStorableArg ffi_type_ulong -- | Note that on e.g. x86_64, Int \/= CInt-argInt :: Int -> Arg-argInt = mkStorableArg ffi_type_hs_int argInt8 :: Int8 -> Arg argInt8 = mkStorableArg ffi_type_sint8 argInt16 :: Int16 -> Arg@@ -104,8 +98,6 @@ argInt64 :: Int64 -> Arg argInt64 = mkStorableArg ffi_type_sint64 -argWord :: Word -> Arg-argWord = mkStorableArg ffi_type_hs_word argWord8 :: Word8 -> Arg argWord8 = mkStorableArg ffi_type_uint8 argWord16 :: Word16 -> Arg@@ -131,7 +123,7 @@ argCUChar = mkStorableArg ffi_type_uchar argCWchar :: CWchar -> Arg-argCWchar = mkStorableArg ffi_type_schar+argCWchar = mkStorableArg ffi_type_wchar argPtr :: Ptr a -> Arg argPtr = mkStorableArg ffi_type_pointer@@ -153,7 +145,7 @@ argConstByteString = customPointerArg (flip BSU.unsafeUseAsCString return) (const $ return ()) retVoid :: RetType ()-retVoid = RetType ffi_type_void (\write -> write nullPtr >> return ())+retVoid = RetType (\write -> write ffi_type_void nullPtr >> return ()) retCInt :: RetType CInt retCInt = mkStorableRetType ffi_type_sint@@ -164,8 +156,6 @@ retCULong :: RetType CULong retCULong = mkStorableRetType ffi_type_ulong -retInt :: RetType Int-retInt = mkStorableRetType ffi_type_hs_int retInt8 :: RetType Int8 retInt8 = mkStorableRetType ffi_type_sint8 retInt16 :: RetType Int16@@ -175,8 +165,6 @@ retInt64 :: RetType Int64 retInt64 = mkStorableRetType ffi_type_sint64 -retWord :: RetType Word-retWord = mkStorableRetType ffi_type_hs_word retWord8 :: RetType Word8 retWord8 = mkStorableRetType ffi_type_uint8 retWord16 :: RetType Word16@@ -202,7 +190,7 @@ retCUChar = mkStorableRetType ffi_type_uchar retCWchar :: RetType CWchar-retCWchar = mkStorableRetType ffi_type_schar+retCWchar = mkStorableRetType ffi_type_wchar retFunPtr :: RetType a -> RetType (FunPtr a) retFunPtr _ = mkStorableRetType ffi_type_pointer
+ README.md view
@@ -0,0 +1,85 @@+# `libffi`+[][Hackage: libffi]+[](http://packdeps.haskellers.com/reverse/libffi)+[][Haskell.org]+[][tl;dr Legal: BSD3]+[](https://github.com/remiturk/libffi/actions?query=workflow%3AHaskell-CI)++[Hackage: libffi]:+ http://hackage.haskell.org/package/libffi+ "libffi package on Hackage"+[Haskell.org]:+ http://www.haskell.org+ "The Haskell Programming Language"+[tl;dr Legal: BSD3]:+ https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29+ "BSD 3-Clause License (Revised)"++A binding to `libffi`, allowing C functions of types only known at runtime to be called from Haskell.++# Notes on GHC's bundling of `libffi`++This library makes a somewhat unusual choice: by default, it does not+explicitly declare a dependency against the `libffi` C library. This is because+most binary distributions of GHC—that is, GHCs configured without the+`--with-system-libffi` option—bundle their own copies of `libffi`. One of these+copies is statically linked, and another of these copies is dynamically linked.+Moreover, whenever GHC compiles an executable, it will always pass the+necessary flags to link against its static copy of `libffi`, as the GHC runtime+system depends on it.++When GHC bundles its own copies of `libffi`, if you were to declare, say, an+`extra-libraries: ffi` dependency, then it would not behave in the way that you+would expect. This is because:++1. The linker flags to link against GHC's static copy of `libffi` always come+ first in the final linking step when compiling an executable. As a result,+ declaring an `extra-libraries: ffi` dependency won't make much of a+ difference, since GHC will always statically link against its own copy of+ `libffi` anyway due to the order of linker flags.++2. Moreover, declaring an `extra-libraries: ffi` dependency can have the+ unfortunate side effect of declaring an _unused_ dynamic dependency against+ `libffi`. Even worse is the fact that the version of dynamically linked+ `libffi` that comes with your operating system may differ from the version+ of dynamiclly linked `libffi` that GHC bundles. When the version numbers+ differ, this can lead to the compiled executable failing at runtime with+ mysterious errors such as:++ ```+ error while loading shared libraries: libffi.so.7: cannot open shared object file: No such file or directory+ ```++ For more information on this point, see+ [GHC#15397](https://gitlab.haskell.org/ghc/ghc/-/issues/15397).++Observation (2) means that when GHC is configured with `--with-system-libffi`,+it is inherently fragile to use `extra-libraries: ffi`. This is an unfortunate+situation, but there is not much that one can do about this short of fixing+GHC#15397 upstream. A workaround would be to configure GHC with+`--with-system-libffi`, but practically speaking, the vast majority of GHC+binary distributions do not configure this way. This includes all versions of+GHC that `ghcup` distributes, so unless we want to exclude most GHC users, we+need some kind of workaround for this issue.++Our workaround is to rely on observation (1). That is, because GHC always+passes flags to the linker to link against its own static copy of `libffi`, we+can always assume that GHC will handle the `libffi` dependency for us. As a+result, the default behavior for this library is to enable the+`+ghc-bundled-libffi` flag, which means that the library will not declare an+external dependency on `libffi` at all. This is rather unusual, but then again,+GHC bundling its own copies of `libffi` is also unusual. (To our knowledge,+this is the _only_ C library that GHC bundles in this fashion.)++We have tested out `+ghc-bundled-libffi` on Windows, macOS, and Linux, and it+works as expected. If you encounter any linking oddities with+`+ghc-bundled-libffi`, please file an issue.++It is worth re-emphasizing that `+ghc-bundled-libffi` will only work if you are+using a binary distribution of GHC that was not configured with the+`--with-system-libffi` option. If you _are_ using such a GHC, then you will+need to use `-ghc-bundle-libffi` (note the minus sign) to disable the flag and+link against your operating system's copy of `libffi`. Unfortunately, `cabal`+does not provide a way to detect whether GHC was configured with+`--with-system-libffi` or not, so the burden is on users to enable or disable+`ghc-bundle-libffi` as appropriate.
− TODO
@@ -1,17 +0,0 @@-- things are not exception-safe right now-- new api based on something like:-- mkFun :: Fun a -> IO a-- argBool :: Fun a -> Fun (Bool -> a)- argInt :: Fun a -> Fun (Int -> a)-- retBool :: Fun (IO Bool)- retInt :: Fun (IO Int)-- mkFun (argInt . argInt $ retBool) :: IO (Int -> Int -> IO Bool)-- Then, mkFun would call ffi_prep_cif, and the function it returns would call ffi_call,- which could be much more efficient.- However, I don't currently see how to implement mkFun without the function it returns- having to traverse the Fun GADT on each call.
− examples/CCall.hs
@@ -1,176 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-module Main where--import Control.Applicative hiding (Alternative(..), many)-import Control.Monad.State.Strict-import Control.Exception hiding (try)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Maybe-import Data.List-import Data.Int-import Data.Word-import Data.Char-import Text.ParserCombinators.Parsec-import System.IO-import System.Posix.DynamicLinker-import Foreign.C.Types-import Foreign.Ptr-import Foreign.LibFFI-import Prelude hiding (catch)--instance Applicative (GenParser tok st) where- pure = return- (<*>) = ap--pRead :: Read a => CharParser st a-pRead = do- s <- getInput- case reads s of- [] -> fail "no reads result"- [(a, s')] -> setInput s' >> return a- _ -> fail "ambiguous reads result"--data Val = I CInt- | IL CLong- | I8 Int8- | I16 Int16- | I32 Int32- | I64 Int64-- | U CUInt- | UL CULong- | U8 Word8- | U16 Word16- | U32 Word32- | U64 Word64-- | Z CSize-- | F CFloat- | D CDouble-- | P (Ptr ())- | S String- deriving (Eq, Show)--valToArg val = case val of- I x -> argCInt x- IL x -> argCLong x- I8 x -> argInt8 x- I16 x -> argInt16 x- I32 x -> argInt32 x- I64 x -> argInt64 x- U x -> argCUInt x- UL x -> argCULong x- U8 x -> argWord8 x- U16 x -> argWord16 x- U32 x -> argWord32 x- U64 x -> argWord64 x- Z x -> argCSize x- F x -> argCFloat x- D x -> argCDouble x- P x -> argPtr x- S x -> argString x--pIdent :: CharParser st String-pIdent = liftM2 (:) (char '_' <|> letter) (many $ char '_' <|> alphaNum) <?> "identifier"--pArg :: CharParser (Map String Val) Val-pArg = liftM S pRead- <|> do- i <- pRead :: CharParser st Integer- t <- many alphaNum- case t of- "" -> return $ I $ fromIntegral i- "i" -> return $ I $ fromIntegral i- "l" -> return $ IL $ fromIntegral i- "i8" -> return $ I8 $ fromIntegral i- "i16" -> return $ I16 $ fromIntegral i- "i32" -> return $ I32 $ fromIntegral i- "i64" -> return $ I64 $ fromIntegral i- "u" -> return $ U $ fromIntegral i- "ul" -> return $ UL $ fromIntegral i- "u8" -> return $ U8 $ fromIntegral i- "u16" -> return $ U16 $ fromIntegral i- "u32" -> return $ U32 $ fromIntegral i- "u64" -> return $ U64 $ fromIntegral i- "p" -> return $ P $ plusPtr nullPtr $ fromIntegral i- "z" -> return $ Z $ fromIntegral i- _ -> fail "invalid type"- <|> do- x <- pRead :: CharParser st Double- t <- many alphaNum- case t of- "" -> return $ D $ realToFrac x- "s" -> return $ F $ realToFrac x- _ -> fail "invalid type"- <|> do- ident <- pIdent- env <- getState- case Map.lookup ident env of- Nothing -> fail "no such identifier"- Just v -> return v--pRet :: CharParser st (Maybe (RetType Val))-pRet = do- t <- many1 alphaNum- case t of- "v" -> return Nothing- "i" -> return $ Just $ fmap I retCInt- "l" -> return $ Just $ fmap IL retCLong- "i8" -> return $ Just $ fmap I8 retInt8- "i16" -> return $ Just $ fmap I16 retInt16- "i32" -> return $ Just $ fmap I32 retInt32- "i64" -> return $ Just $ fmap I64 retInt64- "u" -> return $ Just $ fmap U retCUInt- "ul" -> return $ Just $ fmap UL retCULong- "u8" -> return $ Just $ fmap U8 retWord8- "u16" -> return $ Just $ fmap U16 retWord16- "u32" -> return $ Just $ fmap U32 retWord32- "u64" -> return $ Just $ fmap U64 retWord64- "p" -> return $ Just $ fmap P (retPtr retVoid)- "z" -> return $ Just $ fmap Z retCSize- "f" -> return $ Just $ fmap F retCFloat- "d" -> return $ Just $ fmap D retCDouble- "s" -> return $ Just $ fmap S retString- _ -> fail "invalid type"--pCall :: CharParser (Map String Val) ((String -> IO (FunPtr a)) -> IO (Maybe (String, Val)))-pCall = do- mbAssign <- optionMaybe $ try $ pIdent <* (spaces >> char '=' >> spaces)- mbRet <- pRet- space- sym <- pIdent- vals <- many (space >> pArg)- let call f retType = return $ \load -> load sym >>= \fp -> f <$> callFFI fp retType (map valToArg vals)- case (mbAssign, mbRet) of- (Just ident, Just retType) -> call (Just . (,) ident) retType- (Nothing , Just retType) -> call (Just . (,) "it" ) retType- (Nothing , Nothing ) -> call id (const Nothing <$> retVoid)- (Just ident, Nothing) -> fail "cannot assign void"--repl env = do- putStr "> "- hFlush stdout- s <- getLine `catch` (\(e :: IOException) -> return ":q")- case s of- ":q" -> return ()- ":l" -> do- forM_ (Map.toList env) $ \(ident, val) -> putStrLn $ ident ++ " = " ++ show val- repl env- _ -> do- case words s of- [ident] -> do- case Map.lookup ident env of- Nothing -> putStrLn ("No such identifier: " ++ show ident)- Just val -> print val- repl env- _ -> case runParser pCall env "repl" s of- Left err -> print err >> repl env- Right call -> do- mbAssign <- call (dlsym Default)- `catch` (\(e :: IOException) -> print e >> return Nothing)- repl $ maybe id (uncurry Map.insert) mbAssign env--main = repl Map.empty
− examples/CTime.hsc
@@ -1,75 +0,0 @@-{-# LANGUAGE RankNTypes #-}-module Main where--#include <time.h>--import Foreign.C.Types-import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal-import Foreign.LibFFI-import Foreign.LibFFI.Base-import Foreign.LibFFI.FFITypes-import System.Posix.DynamicLinker--withDLCall :: String -> ((forall a. String -> RetType a -> [Arg] -> IO a) -> IO b) -> IO b-withDLCall lib f = do- withDL lib [RTLD_NOW] $ \dl ->- f $ \sym ret args -> do- p <- dlsym dl sym- callFFI p ret args--main = do- withDLCall "" $ \call -> do- t <- call "time" retCTime [argPtr nullPtr]-- with t $ \t_p -> do- tm_p <- call "localtime" (retPtr retVoid) [argPtr t_p]- tm <- peek (castPtr tm_p :: Ptr TM)- t' <- call "mktime" retCTime [argPtr tm_p]- print t- print tm- print t'-- withDLCall "./mytime.so" $ \call -> do- t <- call "time" retCTime [argPtr nullPtr]-- -- struct tm actually has a few architecture dependent "hidden" fields...- (argTM, retTM, freeTMType)- <- newStorableStructArgRet $ replicate 9 ffi_type_sint ++ [ffi_type_slong, ffi_type_pointer]- :: IO (TM -> Arg, RetType TM, IO ())-- tm <- call "mylocaltime" retTM [argCTime t]- t' <- call "mymktime" retCTime [argTM tm]- freeTMType- print t- print tm- print t'--data TM = TM {sec, min, hour, mday, mon, year, wday, yday, isdst :: CInt}- deriving (Eq, Show)--instance Storable TM where- alignment _ = #{size int}- sizeOf _ = #{size struct tm}- peek p = do- sec <- #{peek struct tm, tm_sec} p- min <- #{peek struct tm, tm_min} p- hour <- #{peek struct tm, tm_hour} p- mday <- #{peek struct tm, tm_mday} p- mon <- #{peek struct tm, tm_mon} p- year <- #{peek struct tm, tm_year} p- wday <- #{peek struct tm, tm_wday} p- yday <- #{peek struct tm, tm_yday} p- isdst <- #{peek struct tm, tm_isdst} p- return $ TM sec min hour mday mon year wday yday isdst- poke p (TM sec min hour mday mon year wday yday isdst) = do- #{poke struct tm, tm_sec} p sec- #{poke struct tm, tm_min} p min- #{poke struct tm, tm_hour} p hour- #{poke struct tm, tm_mday} p mday- #{poke struct tm, tm_mon} p mon- #{poke struct tm, tm_year} p year- #{poke struct tm, tm_wday} p wday- #{poke struct tm, tm_yday} p yday- #{poke struct tm, tm_isdst} p isdst
− examples/Makefile
@@ -1,22 +0,0 @@-.PHONY: all clean--all: MemSpeed CCall CTime mytime.so--%.o: %.c- gcc $(CFLAGS) -fPIC -c $<--%.so: %.o- gcc $(LDFLAGS) -nostartfiles -shared -Wl,-soname,$@ $< -o $@--mytime.so: mytime.o--%.hs: %.hsc- hsc2hs -I/usr/lib/ghc-6.10.1/include $<--%: %.hs- ghc --make $<--CTime: CTime.hs--clean:- rm -f MemSpeed CCall CTime CTime.hs *.o *.hi *.so core core.*
− examples/MemSpeed.hs
@@ -1,75 +0,0 @@-module Main where--import Control.Monad-import Foreign.C.Types-import Foreign.LibFFI-import System.Posix.DynamicLinker-import Numeric-import CPUTime-import Time-import Ratio-import System.Environment-import System.Exit--main = withDL "" [RTLD_NOW] $ \dl -> do- args <- getArgs- sz <- case args of- [n] -> return $ (read n * 2^20) `quot` 2- [] -> putStrLn "usage: MemSpeed megabytes-to-use" >> exitWith (ExitFailure 1)-- memset <- dlsym dl "memset"- memcpy <- dlsym dl "memcpy"- malloc <- dlsym dl "malloc"- free <- dlsym dl "free"-- s <- callFFI malloc (retPtr retVoid) [argCSize sz]- d <- callFFI malloc (retPtr retVoid) [argCSize sz]- check sz "memcpy 1" $ callFFI memcpy retVoid [argPtr d, argPtr s, argCSize sz]- check (10*sz) "memcpy 10" $ replicateM_ 10 $ callFFI memcpy retVoid [argPtr d, argPtr s, argCSize sz]- callFFI free retVoid [argPtr s]- callFFI free retVoid [argPtr d]-- p <- callFFI malloc (retPtr retVoid) [argCSize (2 * sz)]- check (2*sz) "memset 1" $ callFFI memset retVoid [argPtr p, argCInt 97, argCSize (2 * sz)]- check (20*sz) "memset 10" $ replicateM_ 10 $ callFFI memset retVoid [argPtr p, argCInt 97, argCSize (2 * sz)]- callFFI free retVoid [argPtr p]--check sz s a = do- (r, cpu, clock) <- timeIt a- putStrLn $ s ++ ": "- ++ showf 2 ((fromIntegral sz / cpu) / (2 ^ 20)) ++ " mb/cpu sec "- ++ showf 2 ((fromIntegral sz / clock) / (2 ^ 20)) ++ " mb/clock sec "- return r--type TimeIt = (Integer, ClockTime)--timeItStart :: IO TimeIt-timeItStart = liftM2 (,) getCPUTime getClockTime--timeItEnd :: TimeIt -> IO (Double, Double)-timeItEnd (startCPU, startClock) = do- stopCPU <- getCPUTime- stopClock <- getClockTime- let- cpuTime = (fromIntegral (stopCPU - startCPU) / 10^12)- clockTime = (timeDiffToSec $ diffClockTimes stopClock startClock)- return (cpuTime, clockTime)- where- timeDiffToSec td- = fromIntegral (tdSec td) + fromIntegral (tdPicosec td) / 10^12--{- | @timeIt action@ executes @action@, then returns- a tuple of its result, CPU- and wallclock-time elapsed. -}-timeIt :: IO a -> IO (a, Double, Double)-timeIt a = do- t <- timeItStart- r <- a- (cpuTime, clockTime) <- timeItEnd t- return (r, cpuTime, clockTime)--showf :: RealFloat a => Int -> a -> String-showf n x- | x >= 0 = ' ':s- | otherwise = s- where- s = showFFloat (Just n) x ""
− examples/mytime.c
@@ -1,14 +0,0 @@-#include <time.h>--struct tm mylocaltime(const time_t);-time_t mymktime(struct tm);--struct tm mylocaltime(const time_t t)-{- return *localtime(&t);-}--time_t mymktime(struct tm t)-{- return mktime(&t);-}
libffi.cabal view
@@ -1,23 +1,63 @@ Name: libffi-Version: 0.1+cabal-version: >= 1.10+Version: 0.2 Description: A binding to libffi, allowing C functions of types only known at runtime to be called from Haskell. License: BSD3 License-file: LICENSE Copyright: Remi Turk 2008-2009 Author: Remi Turk Maintainer: remi.turk@gmail.com+Homepage: http://haskell.org/haskellwiki/Library/libffi Stability: alpha Synopsis: A binding to libffi-Tested-With: GHC == 6.10.1-Build-Depends: base, bytestring+Tested-With: GHC == 7.0.4+ , GHC == 7.2.2+ , GHC == 7.4.2+ , GHC == 7.6.3+ , GHC == 7.8.4+ , GHC == 7.10.3+ , GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.2+extra-source-files: CHANGELOG.md, README.md Build-Type: Simple Category: Foreign -exposed-modules: Foreign.LibFFI,- Foreign.LibFFI.Base,- Foreign.LibFFI.Types,- Foreign.LibFFI.FFITypes,- Foreign.LibFFI.Internal-pkgconfig-depends: libffi-extra-libraries: ffi-includes: ffi.h ffitarget.h+flag ghc-bundled-libffi+ description: When GHC is configured without @--with-system-libffi@, it+ will bundle its own copies of @libffi@, one of them+ statically linked and the other dynamically linked. This+ flag will force linking against the static copy of @libffi@+ that GHC bundles. This avoids a GHC bug+ (https://gitlab.haskell.org/ghc/ghc/-/issues/15397) that+ can arise when the linker confuses the system's dynamic+ @libffi@ with GHC's own dynamic @libffi@.++ Note that this flag only works when GHC is configured+ without the @--with-system-libffi@ option. This is the case+ for most GHC binary distributions, such as those provided+ by @ghcup@. If you are using a GHC that was configured with+ @--with-system-libffi@, however, you will need to disable+ this option and link against the system's version of+ @libffi@ instead.+ default: True++source-repository head+ type: git+ location: https://github.com/remiturk/libffi++library+ build-depends: base >= 3 && < 5, bytestring+ exposed-modules: Foreign.LibFFI,+ Foreign.LibFFI.Base,+ Foreign.LibFFI.Types,+ Foreign.LibFFI.FFITypes,+ Foreign.LibFFI.Internal+ if !flag(ghc-bundled-libffi)+ pkgconfig-depends: libffi+ default-language: Haskell2010