primitive-foreign (empty) → 0.1
raw patch · 6 files changed
+450/−0 lines, 6 filesdep +QuickCheckdep +basedep +primitive
Dependencies added: QuickCheck, base, primitive, primitive-foreign
Files
- CHANGELOG.md +12/−0
- LICENSE +29/−0
- README.md +7/−0
- primitive-foreign.cabal +67/−0
- src/Data/Primitive/Foreign.hs +309/−0
- test/Spec.hs +26/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++`primitive-ffi` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.0.0+=====++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/haskell-primitive/primitive-ffi/releases
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2019, chessai+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its+ 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 HOLDER 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.md view
@@ -0,0 +1,7 @@+# primitive-foreign++[](https://hackage.haskell.org/package/primitive-foreign)+[](LICENSE)+[](https://travis-ci.com/haskell-primitive/primitive-foreign)+ +The goal of this library is to make it possible to avoid the duplicated code between `Storable` and `Prim` APIs when one is working mostly with the `primitive` or `contiguous` APIs, by using the `Prim` interface to facilitate marshalling of values in memory.
+ primitive-foreign.cabal view
@@ -0,0 +1,67 @@+cabal-version: 2.2+name:+ primitive-foreign+version:+ 0.1+synopsis:+ using the `Prim` interface for the FFI+description:+ This library provides an alternative to the `Storable` interface,+ using the `Prim` typeclass. The goal is to make it possible to avoid+ the duplicated code between `Storable` and `Prim` APIs when one is+ working mostly with the `primitive` or `contiguous` APIs.+homepage:+ https://github.com/haskell-primitive/primitive-ffi+bug-reports:+ https://github.com/haskell-primitive/primitive-ffi/issues+license:+ BSD-3-Clause+license-file:+ LICENSE+author:+ chessai+maintainer:+ chessai <chessai1996@gmail.com>+copyright:+ © 2019 chessai+category:+ Data+build-type:+ Simple+extra-doc-files:+ README.md+ , CHANGELOG.md+tested-with:+ GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5++library+ hs-source-dirs:+ src+ exposed-modules:+ Data.Primitive.Foreign+ build-depends:+ , base >= 4.10.1 && < 4.13+ , primitive >= 0.6.4 && < 0.8+ ghc-options:+ -Wall+ -O2+ default-language:+ Haskell2010++test-suite props+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: test+ build-depends:+ , base+ , QuickCheck+ , primitive+ , primitive-foreign+ default-language: Haskell2010+ ghc-options: -O2 -Wall++source-repository head+ type:+ git+ location:+ https://github.com/haskell-primitive/primitive-foreign.git
+ src/Data/Primitive/Foreign.hs view
@@ -0,0 +1,309 @@+--------------------------------------------------------------------------------++{-# language BangPatterns #-}+{-# language ForeignFunctionInterface #-}+{-# language MagicHash #-}+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}+{-# language UnboxedTuples #-}++--------------------------------------------------------------------------------++module Data.Primitive.Foreign+ (+ -- * Prim-Storable methods+ sizeOf, alignment+ , peek, peekElemOff, peekByteOff+ , poke, pokeElemOff, pokeByteOff++ -- * Memory allocation+ -- ** Local allocation+ , alloca, F.allocaBytes, F.allocaBytesAligned+ -- ** Dynamic allocation+ , malloc, F.mallocBytes+ , calloc, F.callocBytes+ , realloc, F.reallocBytes+ , F.free, F.finalizerFree++ -- * Marshalling arrays+ -- ** Allocation+ , mallocArray, mallocArray0+ , allocaArray, allocaArray0+ , reallocArray, reallocArray0+ , callocArray, callocArray0+ -- ** Marshalling+ , peekArray, peekArray0+ , pokeArray, pokeArray0+ -- ** Combined allocation and marshalling+ , newArray, newArray0+ , withArray, withArray0+ , withArrayLen, withArrayLen0+ -- ** Copying+ , copyArray+ , moveArray+ -- ** Finding the length+ , lengthArray0+ -- ** Indexing+ , advancePtr++ -- * General marshalling utilities+ -- ** Combined allocation and marshalling+ , with+ , new+ -- ** Marshalling of Maybe values+ , F.maybeNew+ , F.maybeWith+ , F.maybePeek+ -- ** Haskellish interface to memcpy and memmove+ , F.copyBytes+ , F.moveBytes+ -- ** Filling up memory areas with required values+ , F.fillBytes+ ) where++--------------------------------------------------------------------------------++import Control.Monad.Primitive (primitive)+import Data.Coerce (coerce)+import Data.Primitive.PrimArray+import Data.Primitive.Types+import Data.Void (Void)+import GHC.Exts+import GHC.Ptr++import qualified Foreign as F++--------------------------------------------------------------------------------++-- [Section: Foreign.Storable]++-- | Read a value from a memory area regarded as an array of values+-- of the same kind. The first argument specifies the start address+-- of the array and the second the index into the array (the first+-- element of the array has index @0@). The following equality holds,+--+-- > peekElemOff addr idx = fixIO $ \result ->+-- > peek (addr `plusPtr` (idx * sizeOf result))+--+-- Note that this is only a specification, not+-- necessarily the concrete implementation of the+-- function.+peekElemOff :: forall a. Prim a => Ptr a -> Int -> IO a+peekElemOff !ptr = coerce (F.peekElemOff @(PrimStorable a) (coerce ptr))++-- | Write a value to a memory area regarded as an array of+-- values of the same kind. The following equality holds:+--+-- > pokeElemOff addr idx x =+-- > poke (addr `plusPtr` (idx * sizeOf x)) x+pokeElemOff :: forall a. Prim a => Ptr a -> Int -> a -> IO ()+pokeElemOff !ptr !idx a = F.pokeElemOff (coerce ptr) idx (PrimStorable a)++-- | Read a value from a memory location given by a base+-- address and offset. The following equality holds:+--+-- > peekByteOff addr off = peek (addr `plusPtr` off)+peekByteOff :: forall a. Prim a => Ptr Void -> Int -> IO a+peekByteOff !ptr = coerce (F.peekByteOff @(PrimStorable a) ptr)++-- | Write a value to a memory location given by a base+-- address and offset. The following equality holds:+--+-- > pokeByteOff addr off x = poke (addr `plusPtr` off) x+pokeByteOff :: forall a. Prim a => Ptr Void -> Int -> a -> IO ()+pokeByteOff !ptr !idx a = F.pokeByteOff ptr idx (PrimStorable a)++-- | Read a value from the given memory location.+--+-- Note that the peek and poke functions might require properly+-- aligned addresses to function correctly. This is architecture+-- dependent; thus, portable code should ensure that when peeking+-- or poking values of some type @a@, the alignment constraint for+-- @a@, as given by the function 'alignment' is fulfilled.+peek :: forall a. Prim a => Ptr a -> IO a+peek = coerce (F.peek . coerce @(Ptr a) @(Ptr (PrimStorable a)))++-- | Write the given value to the given memory location. Alignment+-- restrictions might apply; see 'peek'.+poke :: forall a. Prim a => Ptr a -> a -> IO ()+poke !ptr a = F.poke (coerce ptr) (PrimStorable a)++--------------------------------------------------------------------------------++-- [Section: Foreign.Marshal.Alloc]++-- |@'alloca' f@ executes the computation @f@, passing as argument+-- a pointer to a temporarily allocated block of memory sufficient to+-- hold values of type @a@.+--+-- 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.+alloca :: forall a b. Prim a => (Ptr a -> IO b) -> IO b+alloca f = F.alloca (coerce f :: Ptr (PrimStorable a) -> IO b)++malloc :: forall a. Prim a => IO (Ptr a)+malloc = F.mallocBytes (sizeOf @a undefined)++calloc :: forall a. Prim a => IO (Ptr a)+calloc = F.callocBytes (sizeOf @a undefined)++realloc :: forall a b. Prim b => Ptr a -> IO (Ptr b)+realloc ptr = coerce (F.realloc ptr :: IO (Ptr (PrimStorable b)))++--------------------------------------------------------------------------------++-- [Section: Foreign.Marshal.Array]++-- | Allocate storage for the given number of elements of a storable type+-- (like 'malloc', but for multiple elements).+mallocArray :: forall a. Prim a => Int -> IO (Ptr a)+mallocArray !idx = coerce (F.mallocArray @(PrimStorable a) idx)++-- | Like 'mallocArray', but add an extra position to hold a special+-- termination element.+mallocArray0 :: forall a. Prim a => Int -> IO (Ptr a)+mallocArray0 !idx = coerce (F.mallocArray0 @(PrimStorable a) idx)++-- | Temporarily allocate space for the given number of elements+-- (like 'alloca', but for multiple elements).+allocaArray :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b+allocaArray !idx f = F.allocaArray idx (coerce f :: Ptr (PrimStorable a) -> IO b)++-- | Like 'allocaArray', but add an extra position to hold a special+-- termination element.+allocaArray0 :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b+allocaArray0 !idx f = F.allocaArray0 idx (coerce f :: Ptr (PrimStorable a) -> IO b)++-- | Adjust the size of an array.+reallocArray :: forall a. Prim a => Ptr a -> Int -> IO (Ptr a)+reallocArray !ptr !idx = coerce (F.reallocArray @(PrimStorable a) (coerce ptr) idx)++-- | Adjust the size of an array, including an extra position for the+-- terminating element.+reallocArray0 :: forall a. Prim a => Ptr a -> Int -> IO (Ptr a)+reallocArray0 !ptr !idx = coerce (F.reallocArray0 @(PrimStorable a) (coerce ptr) idx)++-- | Like 'mallocArray', but allocated memory is filled with bytes of value zero.+callocArray :: forall a. Prim a => Int -> IO (Ptr a)+callocArray !idx = coerce (F.callocArray @(PrimStorable a) idx)++-- | Like 'mallocArray0', but allocated memory is filled with bytes of value zero.+callocArray0 :: forall a. Prim a => Int -> IO (Ptr a)+callocArray0 !idx = coerce (F.callocArray0 @(PrimStorable a) idx)++-- | Convert an array of given length into a Haskell 'PrimArray'.+peekArray :: forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)+peekArray !sz@(I# n#) !(Ptr addr#) = do+ marr@(MutablePrimArray ba#) <- newPrimArray sz+ primitive $ \s0# ->+ case (copyAddrToByteArray# addr# ba# 0# (n# *# (sizeOf# @a undefined)) s0#) of+ s1# -> (# s1#, () #)+ unsafeFreezePrimArray marr++-- | Convert an array terminated by the given terminator into a Haskell+-- 'PrimArray'.+peekArray0 :: forall a. (Prim a, Eq a) => a -> Ptr a -> IO (PrimArray a)+peekArray0 term !ptr = lengthArray0 term ptr >>= \size ->+ peekArray size ptr++-- | Write the 'PrimArray' into memory at the given location.+pokeArray :: forall a. Prim a => Ptr a -> PrimArray a -> IO ()+pokeArray !ptr !arr = flip itraversePrimArray_ arr $ \ix atIx ->+ pokeElemOff ptr ix atIx++-- | Write the 'PrimArray' into memory and terminate the elements+-- with a given terminating element.+pokeArray0 :: forall a. Prim a => a -> Ptr a -> PrimArray a -> IO ()+pokeArray0 term !ptr !arr =+ let !sz = sizeofPrimArray arr+ in flip itraversePrimArray_ arr $ \ix atIx ->+ if ix == sz+ then pokeElemOff ptr ix term+ else pokeElemOff ptr ix atIx++-- | Write a 'PrimArray' into a newly allocated, consecutive+-- sequence of primitive values.+newArray :: forall a. Prim a => PrimArray a -> IO (Ptr a)+newArray !arr = do+ ptr <- mallocArray (sizeofPrimArray arr)+ pokeArray ptr arr+ pure ptr++-- | Write a 'PrimArray' into a newly allocated, consecutive+-- sequence of primitive values, where the end is fixed by+-- the given terminating element.+newArray0 :: forall a. Prim a => a -> PrimArray a -> IO (Ptr a)+newArray0 term !arr = do+ ptr <- mallocArray0 (sizeofPrimArray arr)+ pokeArray0 term ptr arr+ pure ptr++-- | Temporarily store a 'PrimArray' in memory.+withArray :: forall a b. Prim a => PrimArray a -> (Ptr a -> IO b) -> IO b+withArray !arr = withArrayLen arr . const++-- | Like 'withArray', but the action is also passed the size+-- of the 'PrimArray'.+withArrayLen :: forall a b. Prim a => PrimArray a -> (Int -> Ptr a -> IO b) -> IO b+withArrayLen !arr f = allocaArray len $ \ptr -> do+ pokeArray ptr arr+ f len ptr+ where+ !len = sizeofPrimArray arr++-- | Like 'withArray', but a terminator indicates where the array ends.+withArray0 :: forall a b. Prim a => a -> PrimArray a -> (Ptr a -> IO b) -> IO b+withArray0 term !arr = withArrayLen0 term arr . const++-- | Like 'withArrayLen', but a terminator indicates where the array ends.+withArrayLen0 :: forall a b. Prim a => a -> PrimArray a -> (Int -> Ptr a -> IO b) -> IO b+withArrayLen0 term !arr f = allocaArray0 len $ \ptr -> do+ pokeArray0 term ptr arr+ f len ptr+ where+ !len = sizeofPrimArray arr++-- | Return the number of elements in an array, excluding+-- the terminator+lengthArray0 :: forall a. (Prim a, Eq a)+ => a -- ^ terminating element+ -> Ptr a+ -> IO Int+lengthArray0 term !ptr = go 0+ where+ go !ix = peekElemOff ptr ix >>= \val ->+ if val == term then pure ix else go (ix + 1)++-- | Advance a pointer into an array by the given number of elements.+advancePtr :: forall a. Prim a => Ptr a -> Int -> Ptr a+advancePtr !ptr !ix = ptr `plusPtr` (ix * sizeOf @a undefined)++-- | Copy the given number of elements from the source array+-- into the destination array; the memory regions /may not/ overlap.+copyArray :: forall a. Prim a+ => Ptr a -- ^ destination array+ -> Ptr a -- ^ source array+ -> Int -- ^ number of elements to copy+ -> IO ()+copyArray !dest !src !size = F.copyBytes dest src (size * sizeOf @a undefined)++-- | Copy the given number of elements from the source array+-- into the destination array; the memory regions /may/ overlap.+moveArray :: forall a. Prim a+ => Ptr a -- ^ destination array+ -> Ptr a -- ^ source array+ -> Int -- ^ number of elements to copy+ -> IO ()+moveArray !dest !src !size = F.moveBytes dest src (size * sizeOf @a undefined)++--------------------------------------------------------------------------------++-- [Section: Foreign.Marshal.Utils]++with :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO b+with val f = F.with (PrimStorable val) (coerce f :: Ptr (PrimStorable a) -> IO b)++new :: forall a. Prim a => a -> IO (Ptr a)+new val = coerce (F.new (PrimStorable val))++--------------------------------------------------------------------------------
+ test/Spec.hs view
@@ -0,0 +1,26 @@+{-# language TypeApplications #-}++{-# options_ghc -fno-warn-orphans #-}++module Main (main) where++import Data.Primitive.Foreign+import Data.Primitive.PrimArray+import Data.Primitive.Types (Prim)+import Test.QuickCheck+import System.IO.Unsafe (unsafePerformIO)++main :: IO ()+main = do+ quickCheck putInGetOut++putInGetOut :: PrimArray Int -> Bool+putInGetOut arr = unsafePerformIO $ do+ ptr <- newArray arr+ arr' <- peekArray (sizeofPrimArray arr) ptr+ pure (arr == arr')++instance (Arbitrary a, Prim a) => Arbitrary (PrimArray a) where+ arbitrary = do+ l <- choose (5, 25)+ fmap primArrayFromList (vectorOf l arbitrary)