[PATCH 2/2] Add copy and move based on Storable to Foreign.Marshal.Utils

Jason Dagit dagitj at gmail.com
Sun Apr 3 22:28:14 CEST 2011


---
 Foreign/Marshal/Utils.hs |   26 ++++++++++++++++++++++++--
 1 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/Foreign/Marshal/Utils.hs b/Foreign/Marshal/Utils.hs
index bf9bdb3..2413e73 100644
--- a/Foreign/Marshal/Utils.hs
+++ b/Foreign/Marshal/Utils.hs
@@ -43,8 +43,11 @@ module Foreign.Marshal.Utils (
   -- ** Haskellish interface to memcpy and memmove
   -- | (argument order: destination, source)
   --
-  copyBytes,     -- :: Ptr a -> Ptr a -> Int -> IO ()
-  moveBytes,     -- :: Ptr a -> Ptr a -> Int -> IO ()
+  copy,          -- :: Storable a => Ptr a -> Ptr a -> IO ()
+  copyBytes,     -- ::               Ptr a -> Ptr a -> Int -> IO ()
+
+  move,          -- :: Storable a => Ptr a -> Ptr a -> IO ()
+  moveBytes,     -- ::               Ptr a -> Ptr a -> Int -> IO ()
 ) where
 
 import Data.Maybe
@@ -169,6 +172,25 @@ moveBytes               :: Ptr a -> Ptr a -> Int -> IO ()
 moveBytes dest src size  = do _ <- memmove dest src (fromIntegral size)
                               return ()
 
+-- |Uses 'sizeOf' to copy bytes from the second area (source) into the
+-- first (destination); the copied areas may /not/ overlap
+--
+{-# INLINE copy #-}
+copy :: Storable a => Ptr a -> Ptr a -> IO ()
+copy dest src = copyBytes dest src (sizeOf (type_ src))
+  where
+  type_ :: Ptr a -> a
+  type_ = undefined
+
+-- |Uses 'sizeOf' to copy bytes from the second area (source) into the
+-- first (destination); the copied areas /may/ overlap
+--
+{-# INLINE move #-}
+move :: Storable a => Ptr a -> Ptr a -> IO ()
+move dest src = moveBytes dest src (sizeOf (type_ src))
+  where
+  type_ :: Ptr a -> a
+  type_ = undefined
 
 -- auxilliary routines
 -- -------------------
-- 
1.7.4.1




More information about the Libraries mailing list