X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FMarshal%2FUtils.hs;h=5ae677a19d05e37e568c3a938159cc5c2a59540e;hb=41e8fba828acbae1751628af50849f5352b27873;hp=5b21ca04e1696349a94ab7045e88f0fc541b8c70;hpb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;p=ghc-base.git diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs index 5b21ca0..5ae677a 100644 --- a/Foreign/Marshal/Utils.hs +++ b/Foreign/Marshal/Utils.hs @@ -1,70 +1,78 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.Marshal.Utils -- Copyright : (c) The FFI task force 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- --- $Id: Utils.hs,v 1.4 2002/04/24 16:31:44 simonmar Exp $ --- -- Utilities for primitive marshaling -- ----------------------------------------------------------------------------- module Foreign.Marshal.Utils ( + -- * General marshalling utilities - -- combined allocation and marshalling + -- ** Combined allocation and marshalling -- - withObject, -- :: Storable a => a -> (Ptr a -> IO b) -> IO b - {- FIXME: should be `with' -} + with, -- :: Storable a => a -> (Ptr a -> IO b) -> IO b new, -- :: Storable a => a -> IO (Ptr a) - -- marshalling of Boolean values (non-zero corresponds to `True') + -- ** Marshalling of Boolean values (non-zero corresponds to 'True') -- fromBool, -- :: Num a => Bool -> a - toBool, -- :: Num a => a -> Bool + toBool, -- :: Num a => a -> Bool - -- marshalling of Maybe values + -- ** Marshalling of Maybe values -- maybeNew, -- :: ( a -> IO (Ptr a)) - -- -> (Maybe a -> IO (Ptr a)) + -- -> (Maybe a -> IO (Ptr a)) maybeWith, -- :: ( a -> (Ptr b -> IO c) -> IO c) - -- -> (Maybe a -> (Ptr b -> IO c) -> IO c) + -- -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybePeek, -- :: (Ptr a -> IO b ) - -- -> (Ptr a -> IO (Maybe b)) + -- -> (Ptr a -> IO (Maybe b)) - -- marshalling lists of storable objects + -- ** Marshalling lists of storable objects -- withMany, -- :: (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res - -- Haskellish interface to memcpy and memmove - -- (argument order: destination, source) + -- ** Haskellish interface to memcpy and memmove + -- | (argument order: destination, source) -- copyBytes, -- :: Ptr a -> Ptr a -> Int -> IO () - moveBytes -- :: Ptr a -> Ptr a -> Int -> IO () + moveBytes, -- :: Ptr a -> Ptr a -> Int -> IO () ) where import Data.Maybe +import Foreign.Ptr ( Ptr, nullPtr ) +import Foreign.Storable ( Storable(poke) ) +import Foreign.C.Types ( CSize ) +import Foreign.Marshal.Alloc ( malloc, alloca ) #ifdef __GLASGOW_HASKELL__ -import Foreign.Ptr ( Ptr, nullPtr ) -import GHC.Storable ( Storable(poke) ) -import Foreign.C.TypesISO ( CSize ) -import Foreign.Marshal.Alloc ( malloc, alloca ) -import GHC.IOBase -import GHC.Real ( fromIntegral ) +import GHC.Real ( fromIntegral ) import GHC.Num import GHC.Base #endif +#ifdef __NHC__ +import Foreign.C.Types ( CInt(..) ) +#endif + -- combined allocation and marshalling -- ----------------------------------- --- allocate storage for a value and marshal it into this storage +-- |Allocate a block of memory and marshal a value into it +-- (the combination of 'malloc' and 'poke'). +-- The size of the area allocated is determined by the 'Foreign.Storable.sizeOf' +-- method from the instance of 'Storable' for the appropriate type. +-- +-- The memory may be deallocated using 'Foreign.Marshal.Alloc.free' or +-- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required. -- new :: Storable a => a -> IO (Ptr a) new val = @@ -73,29 +81,31 @@ new val = poke ptr val return ptr --- allocate temporary storage for a value and marshal it into this storage +-- |@'with' val f@ executes the computation @f@, passing as argument +-- a pointer to a temporarily allocated block of memory into which +-- @val@ has been marshalled (the combination of 'alloca' and 'poke'). -- --- * see the life time constraints imposed by `alloca' +-- The memory is freed when @f@ terminates (either normally or via an +-- exception), so the pointer passed to @f@ must /not/ be used after this. -- -{- FIXME: should be called `with' -} -withObject :: Storable a => a -> (Ptr a -> IO b) -> IO b -withObject val f = +with :: Storable a => a -> (Ptr a -> IO b) -> IO b +with val f = alloca $ \ptr -> do poke ptr val res <- f ptr return res --- marshalling of Boolean values (non-zero corresponds to `True') +-- marshalling of Boolean values (non-zero corresponds to 'True') -- ----------------------------- --- convert a Haskell Boolean to its numeric representation +-- |Convert a Haskell 'Bool' to its numeric representation -- fromBool :: Num a => Bool -> a fromBool False = 0 fromBool True = 1 --- convert a Boolean in numeric representation to a Haskell value +-- |Convert a Boolean in numeric representation to a Haskell value -- toBool :: Num a => a -> Bool toBool = (/= 0) @@ -104,64 +114,66 @@ toBool = (/= 0) -- marshalling of Maybe values -- --------------------------- --- allocate storage and marshall a storable value wrapped into a `Maybe' +-- |Allocate storage and marshal a storable value wrapped into a 'Maybe' -- --- * the `nullPtr' is used to represent `Nothing' +-- * the 'nullPtr' is used to represent 'Nothing' -- maybeNew :: ( a -> IO (Ptr a)) - -> (Maybe a -> IO (Ptr a)) + -> (Maybe a -> IO (Ptr a)) maybeNew = maybe (return nullPtr) --- converts a withXXX combinator into one marshalling a value wrapped into a --- `Maybe' +-- |Converts a @withXXX@ combinator into one marshalling a value wrapped +-- into a 'Maybe', using 'nullPtr' to represent 'Nothing'. -- maybeWith :: ( a -> (Ptr b -> IO c) -> IO c) - -> (Maybe a -> (Ptr b -> IO c) -> IO c) + -> (Maybe a -> (Ptr b -> IO c) -> IO c) maybeWith = maybe ($ nullPtr) --- convert a peek combinator into a one returning `Nothing' if applied to a --- `nullPtr' +-- |Convert a peek combinator into a one returning 'Nothing' if applied to a +-- 'nullPtr' -- maybePeek :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b) maybePeek peek ptr | ptr == nullPtr = return Nothing - | otherwise = do a <- peek ptr; return (Just a) + | otherwise = do a <- peek ptr; return (Just a) -- marshalling lists of storable objects -- ------------------------------------- --- replicates a withXXX combinator over a list of objects, yielding a list of +-- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of -- marshalled objects -- withMany :: (a -> (b -> res) -> res) -- withXXX combinator for one object - -> [a] -- storable objects - -> ([b] -> res) -- action on list of marshalled obj.s - -> res + -> [a] -- storable objects + -> ([b] -> res) -- action on list of marshalled obj.s + -> res withMany _ [] f = f [] withMany withFoo (x:xs) f = withFoo x $ \x' -> - withMany withFoo xs (\xs' -> f (x':xs')) + withMany withFoo xs (\xs' -> f (x':xs')) -- Haskellish interface to memcpy and memmove -- ------------------------------------------ --- copies the given number of bytes from the second area (source) into the --- first (destination); the copied areas may *not* overlap +-- |Copies the given number of bytes from the second area (source) into the +-- first (destination); the copied areas may /not/ overlap -- copyBytes :: Ptr a -> Ptr a -> Int -> IO () -copyBytes dest src size = memcpy dest src (fromIntegral size) +copyBytes dest src size = do _ <- memcpy dest src (fromIntegral size) + return () --- copies the given number of elements from the second area (source) into the --- first (destination); the copied areas *may* overlap +-- |Copies the given number of bytes from the second area (source) into the +-- first (destination); the copied areas /may/ overlap -- moveBytes :: Ptr a -> Ptr a -> Int -> IO () -moveBytes dest src size = memmove dest src (fromIntegral size) +moveBytes dest src size = do _ <- memmove dest src (fromIntegral size) + return () -- auxilliary routines -- ------------------- --- basic C routines needed for memory copying +-- |Basic C routines needed for memory copying -- -foreign import ccall unsafe memcpy :: Ptr a -> Ptr a -> CSize -> IO () -foreign import ccall unsafe memmove :: Ptr a -> Ptr a -> CSize -> IO () +foreign import ccall unsafe "string.h" memcpy :: Ptr a -> Ptr a -> CSize -> IO (Ptr a) +foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)