packages feed

c-storable (empty) → 0.1

raw patch · 5 files changed

+307/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright Evan Laforge 2011++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Evan Laforge nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ README view
@@ -0,0 +1,14 @@+When binding to C via hsc2hs, you are expected to write your own Storable+instances, and manually poke struct fields with any Storable type.  Since all+manner of non-C types are in Storable, it's easy to accidentally poke a Char+instead of CChar, at which point you have memory corruption that may be very+difficult to track down.++One such bug was enough for me, so I created a parallel CStorable class that+prevents that kind of bug by only including C types.++If you are writing a new C binding, I recommend something higher-level than+hsc2hs, such as c2hs, which I think should sidestep the problem entirely by+verifying your types.  But if you are already using hsc2hs and for whatever+reason don't want subtle memory corruption bugs, you can import ForeignC+instead of Foreign and Foreign.C, and see if you have any.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ c-storable.cabal view
@@ -0,0 +1,27 @@+name: c-storable+version: 0.1+cabal-version: >= 1.8+build-type: Simple+synopsis: Replacement for Storable class that omits non-C types+description: See README.+category: Haskell, Development+license: BSD3+license-file: LICENSE+author: Evan Laforge+maintainer: Evan Laforge <qdunkan@gmail.com>+stability: stable+tested-with: GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.2+data-files: README++homepage: https://github.com/elaforge/c-storable+source-repository head+    type: git+    location: git://github.com/elaforge/c-storable.git++library+    build-depends:+        base <5+    exposed-modules:+        ForeignC+    hs-source-dirs: src+    ghc-options: -Wall -fno-warn-name-shadowing
+ src/ForeignC.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MagicHash #-}+{- | This is a drop-in replacement for "Foreign" and "Foreign.C".  The+    difference is that it uses a 'CStorable' class instead of+    'Foreign.Storable', and only C types are in CStorable.  Otherwise, it's+    easy to corrupt memory by accidentally marshalling a haskell type into a+    C struct.++    It tries to export all the same things that Foreign and Foreign.C do, but+    because I only copied the things I need, it's not complete.+-}+module ForeignC (+    module ForeignC+    , module Data.Int, module Data.Word+    , module Foreign.C+    , module Foreign.Ptr, module Foreign.StablePtr, module Foreign.ForeignPtr+    , module Foreign.Marshal.Alloc, module Foreign.Marshal.Utils+) where+import Data.Int+import Data.Word+import qualified Foreign+import Foreign.C+import Foreign.Ptr+import Foreign.StablePtr+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc+    ( allocaBytes, allocaBytesAligned, mallocBytes, reallocBytes, free+    , finalizerFree+    )+import Foreign.Marshal.Utils hiding (with, new)+import GHC.Base+++-- * CStorable++class CStorable a where+    sizeOf      :: a -> Int+    alignment   :: a -> Int+    peekElemOff :: Ptr a -> Int      -> IO a+    pokeElemOff :: Ptr a -> Int -> a -> IO ()+    peekByteOff :: Ptr b -> Int      -> IO a+    pokeByteOff :: Ptr b -> Int -> a -> IO ()+    peek        :: Ptr a      -> IO a+    poke        :: Ptr a -> a -> IO ()++    peekElemOff = peekElemOff_ undefined+        where+        peekElemOff_ :: a -> Ptr a -> Int -> IO a+        peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)+    pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val+    peekByteOff ptr off = peek (ptr `plusPtr` off)+    pokeByteOff ptr off = poke (ptr `plusPtr` off)+    peek ptr = peekElemOff ptr 0+    poke ptr = pokeElemOff ptr 0++-- ** basic types++instance CStorable CDouble where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable CFloat where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable CInt where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable CChar where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable CUChar where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke++-- ** words++instance CStorable Word8 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable Word16 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable Word32 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable Word64 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke++-- ** ints++instance CStorable Int8 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable Int16 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable Int32 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke+instance CStorable Int64 where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke++-- ** ptrs++instance CStorable (Ptr a) where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke++instance CStorable (FunPtr a) where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke++instance CStorable (StablePtr a) where+    sizeOf = Foreign.sizeOf+    alignment = Foreign.alignment+    peek = Foreign.peek+    poke = Foreign.poke++-- * Foreign.Marshal.Alloc++alloca :: forall a b. (CStorable a) => (Ptr a -> IO b) -> IO b+alloca = allocaBytesAligned (sizeOf dummy) (alignment dummy)+    where+    dummy :: a+    dummy = undefined++malloc :: (CStorable a) => IO (Ptr a)+malloc = doMalloc undefined+    where+    doMalloc :: (CStorable b) => b -> IO (Ptr b)+    doMalloc dummy = mallocBytes (sizeOf dummy)++-- * Foreign.Marshal.Array++mallocArray :: (CStorable a) => Int -> IO (Ptr a)+mallocArray = doMalloc undefined+    where+    doMalloc :: (CStorable a') => a' -> Int -> IO (Ptr a')+    doMalloc dummy size = mallocBytes (size * sizeOf dummy)++allocaArray :: (CStorable a) => Int -> (Ptr a -> IO b) -> IO b+allocaArray = doAlloca undefined+    where+    doAlloca :: (CStorable a') => a' -> Int -> (Ptr a' -> IO b') -> IO b'+    doAlloca dummy size =+        allocaBytesAligned (size * sizeOf dummy) (alignment dummy)++pokeArray :: (CStorable a) => Ptr a -> [a] -> IO ()+pokeArray ptr vals0 = go vals0 0#+    where+    go [] _ = return ()+    go (val:vals) n# = do+        pokeElemOff ptr (I# n#) val+        go vals (n# +# 1#)++peekArray :: (CStorable a) => Int -> Ptr a -> IO [a]+peekArray size ptr+    | size <= 0 = return []+    | otherwise = f (size-1) []+    where+    f 0 acc = do+        e <- peekElemOff ptr 0+        return (e:acc)+    f n acc = do+        e <- peekElemOff ptr n+        f (n-1) (e:acc)+++newArray :: (CStorable a) => [a] -> IO (Ptr a)+newArray vals = do+    ptr <- mallocArray (length vals)+    pokeArray ptr vals+    return ptr++withArray :: (CStorable a) => [a] -> (Ptr a -> IO b) -> IO b+withArray vals f = withArrayLen vals (const f)++withArrayLen :: (CStorable a) => [a] -> (Int -> Ptr a -> IO b) -> IO b+withArrayLen vals f = allocaArray len $ \ptr -> do+    pokeArray ptr vals+    f len ptr+    where len = length vals++-- | Like 'withArrayLen', except if the list is null, then pass (0, nullPtr).+withArrayLenNull :: CStorable a => [a] -> (Int -> Ptr a -> IO b) -> IO b+withArrayLenNull vals f+    | null vals = f 0 nullPtr+    | otherwise = withArrayLen vals f++copyArray :: (CStorable a) => Ptr a -> Ptr a -> Int -> IO ()+copyArray = doCopy undefined+    where+    doCopy :: (CStorable a') => a' -> Ptr a' -> Ptr a' -> Int -> IO ()+    doCopy dummy dest src size = copyBytes dest src (size * sizeOf dummy)+++-- ** Foreign.Marshal.Utils++with :: (CStorable a) => a -> (Ptr a -> IO b) -> IO b+with val f = alloca $ \ptr -> do+    poke ptr val+    f ptr