summaryrefslogtreecommitdiff
path: root/libraries/base/Foreign
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/base/Foreign')
-rw-r--r--libraries/base/Foreign/C/Types.hs17
-rw-r--r--libraries/base/Foreign/Concurrent.hs23
-rw-r--r--libraries/base/Foreign/ForeignPtr.hs3
-rw-r--r--libraries/base/Foreign/Marshal/Alloc.hs52
-rw-r--r--libraries/base/Foreign/Marshal/Array.hs58
-rw-r--r--libraries/base/Foreign/Marshal/Pool.hs33
6 files changed, 84 insertions, 102 deletions
diff --git a/libraries/base/Foreign/C/Types.hs b/libraries/base/Foreign/C/Types.hs
index b2e723f724..1b18935b9e 100644
--- a/libraries/base/Foreign/C/Types.hs
+++ b/libraries/base/Foreign/C/Types.hs
@@ -37,9 +37,9 @@ module Foreign.C.Types
-- | These types are represented as @newtype@s of
-- types in "Data.Int" and "Data.Word", and are instances of
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
- -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',
- -- 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral' and
- -- 'Bits'.
+ -- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable',
+ -- 'Storable', 'Prelude.Bounded', 'Prelude.Real', 'Prelude.Integral'
+ -- and 'Bits'.
CChar(..), CSChar(..), CUChar(..)
, CShort(..), CUShort(..), CInt(..), CUInt(..)
, CLong(..), CULong(..)
@@ -51,7 +51,8 @@ module Foreign.C.Types
-- | These types are represented as @newtype@s of basic
-- foreign types, and are instances of
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
- -- 'Prelude.Show', 'Prelude.Enum', 'Typeable' and 'Storable'.
+ -- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable' and
+ -- 'Storable'.
, CClock(..), CTime(..), CUSeconds(..), CSUSeconds(..)
-- extracted from CTime, because we don't want this comment in
@@ -66,9 +67,13 @@ module Foreign.C.Types
-- | These types are represented as @newtype@s of
-- 'Prelude.Float' and 'Prelude.Double', and are instances of
-- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num', 'Prelude.Read',
- -- 'Prelude.Show', 'Prelude.Enum', 'Typeable', 'Storable',
+ -- 'Prelude.Show', 'Prelude.Enum', 'Data.Typeable.Typeable', 'Storable',
-- 'Prelude.Real', 'Prelude.Fractional', 'Prelude.Floating',
- -- 'Prelude.RealFrac' and 'Prelude.RealFloat'.
+ -- 'Prelude.RealFrac' and 'Prelude.RealFloat'. That does mean
+ -- that `CFloat`'s (respectively `CDouble`'s) instances of
+ -- 'Prelude.Eq', 'Prelude.Ord', 'Prelude.Num' and
+ -- 'Prelude.Fractional' are as badly behaved as `Prelude.Float`'s
+ -- (respectively `Prelude.Double`'s).
, CFloat(..), CDouble(..)
-- XXX GHC doesn't support CLDouble yet
-- , CLDouble(..)
diff --git a/libraries/base/Foreign/Concurrent.hs b/libraries/base/Foreign/Concurrent.hs
index a19b20b664..e197f798c3 100644
--- a/libraries/base/Foreign/Concurrent.hs
+++ b/libraries/base/Foreign/Concurrent.hs
@@ -40,33 +40,34 @@ newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
-- associating a finalizer - given by the monadic operation - with the
-- reference. The storage manager will start the finalizer, in a
-- separate thread, some time after the last reference to the
--- @ForeignPtr@ is dropped. There is no guarantee of promptness, and
+-- 'ForeignPtr' is dropped. There is no guarantee of promptness, and
-- in fact there is no guarantee that the finalizer will eventually
-- run at all.
--
-- Note that references from a finalizer do not necessarily prevent
-- another object from being finalized. If A's finalizer refers to B
--- (perhaps using 'touchForeignPtr', then the only guarantee is that
--- B's finalizer will never be started before A's. If both A and B
--- are unreachable, then both finalizers will start together. See
--- 'touchForeignPtr' for more on finalizer ordering.
+-- (perhaps using 'Foreign.ForeignPtr.touchForeignPtr', then the only
+-- guarantee is that B's finalizer will never be started before A's. If both
+-- A and B are unreachable, then both finalizers will start together. See
+-- 'Foreign.ForeignPtr.touchForeignPtr' for more on finalizer ordering.
--
newForeignPtr = GHC.ForeignPtr.newConcForeignPtr
addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
--- ^This function adds a finalizer to the given @ForeignPtr@. The
+-- ^This function adds a finalizer to the given 'ForeignPtr'. The
-- finalizer will run /before/ all other finalizers for the same
-- object which have already been registered.
--
--- This is a variant of @Foreign.ForeignPtr.addForeignPtrFinalizer@,
--- where the finalizer is an arbitrary @IO@ action. When it is
+-- This is a variant of 'Foreign.ForeignPtr.addForeignPtrFinalizer',
+-- where the finalizer is an arbitrary 'IO' action. When it is
-- invoked, the finalizer will run in a new thread.
--
-- NB. Be very careful with these finalizers. One common trap is that
-- if a finalizer references another finalized value, it does not
--- prevent that value from being finalized. In particular, 'Handle's
--- are finalized objects, so a finalizer should not refer to a 'Handle'
--- (including @stdout@, @stdin@ or @stderr@).
+-- prevent that value from being finalized. In particular, 'System.IO.Handle's
+-- are finalized objects, so a finalizer should not refer to a
+-- 'System.IO.Handle' (including 'System.IO.stdout', 'System.IO.stdin', or
+-- 'System.IO.stderr').
--
addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer
diff --git a/libraries/base/Foreign/ForeignPtr.hs b/libraries/base/Foreign/ForeignPtr.hs
index a684a8d25b..12bd4bfdc8 100644
--- a/libraries/base/Foreign/ForeignPtr.hs
+++ b/libraries/base/Foreign/ForeignPtr.hs
@@ -15,6 +15,9 @@
-- Foreign Function Interface (FFI) and will usually be imported via
-- the "Foreign" module.
--
+-- For non-portable support of Haskell finalizers, see the
+-- "Foreign.Concurrent" module.
+--
-----------------------------------------------------------------------------
module Foreign.ForeignPtr (
diff --git a/libraries/base/Foreign/Marshal/Alloc.hs b/libraries/base/Foreign/Marshal/Alloc.hs
index 2a3c756035..c32f0b62d7 100644
--- a/libraries/base/Foreign/Marshal/Alloc.hs
+++ b/libraries/base/Foreign/Marshal/Alloc.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples,
+ ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
@@ -79,20 +80,14 @@ import GHC.Base
-- no longer required.
--
{-# INLINE malloc #-}
-malloc :: Storable a => IO (Ptr a)
-malloc = doMalloc undefined
- where
- doMalloc :: Storable b => b -> IO (Ptr b)
- doMalloc dummy = mallocBytes (sizeOf dummy)
+malloc :: forall a . Storable a => IO (Ptr a)
+malloc = mallocBytes (sizeOf (undefined :: a))
-- |Like 'malloc' but memory is filled with bytes of value zero.
--
{-# INLINE calloc #-}
-calloc :: Storable a => IO (Ptr a)
-calloc = doCalloc undefined
- where
- doCalloc :: Storable b => b -> IO (Ptr b)
- doCalloc dummy = callocBytes (sizeOf dummy)
+calloc :: forall a . Storable a => IO (Ptr a)
+calloc = callocBytes (sizeOf (undefined :: a))
-- |Allocate a block of memory of the given number of bytes.
-- The block of memory is sufficiently aligned for any of the basic
@@ -117,11 +112,22 @@ callocBytes size = failWhenNULL "calloc" $ _calloc 1 (fromIntegral size)
-- exception), so the pointer passed to @f@ must /not/ be used after this.
--
{-# INLINE alloca #-}
-alloca :: Storable a => (Ptr a -> IO b) -> IO b
-alloca = doAlloca undefined
- where
- doAlloca :: Storable a' => a' -> (Ptr a' -> IO b') -> IO b'
- doAlloca dummy = allocaBytesAligned (sizeOf dummy) (alignment dummy)
+alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b
+alloca =
+ allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a))
+
+-- Note [NOINLINE for touch#]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously
+-- fragile in the presence of simplification (see #14346). In particular, the
+-- simplifier may drop the continuation containing the touch# if it can prove
+-- that the action passed to allocaBytes will not return. The hack introduced to
+-- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the
+-- simplifier can't see the divergence.
+--
+-- These can be removed once #14375 is fixed, which suggests that we instead do
+-- away with touch# in favor of a primitive that will capture the scoping left
+-- implicit in the case of touch#.
-- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
-- a pointer to a temporarily allocated block of memory of @n@ bytes.
@@ -141,6 +147,8 @@ allocaBytes (I# size) action = IO $ \ s0 ->
case touch# barr# s3 of { s4 ->
(# s4, r #)
}}}}}
+-- See Note [NOINLINE for touch#]
+{-# NOINLINE allocaBytes #-}
allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
@@ -152,6 +160,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
case touch# barr# s3 of { s4 ->
(# s4, r #)
}}}}}
+-- See Note [NOINLINE for touch#]
+{-# NOINLINE allocaBytesAligned #-}
-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
-- to the size needed to store values of type @b@. The returned pointer
@@ -163,14 +173,10 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 ->
-- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
-- 'malloc'.
--
-realloc :: Storable b => Ptr a -> IO (Ptr b)
-realloc = doRealloc undefined
+realloc :: forall a b . Storable b => Ptr a -> IO (Ptr b)
+realloc ptr = failWhenNULL "realloc" (_realloc ptr size)
where
- doRealloc :: Storable b' => b' -> Ptr a' -> IO (Ptr b')
- doRealloc dummy ptr = let
- size = fromIntegral (sizeOf dummy)
- in
- failWhenNULL "realloc" (_realloc ptr size)
+ size = fromIntegral (sizeOf (undefined :: b))
-- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
-- to the given size. The returned pointer may refer to an entirely
diff --git a/libraries/base/Foreign/Marshal/Array.hs b/libraries/base/Foreign/Marshal/Array.hs
index 5e103419b6..c0a9164b51 100644
--- a/libraries/base/Foreign/Marshal/Array.hs
+++ b/libraries/base/Foreign/Marshal/Array.hs
@@ -1,12 +1,12 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.Marshal.Array
-- Copyright : (c) The FFI task force 2001
-- License : BSD-style (see the file libraries/base/LICENSE)
---
+--
-- Maintainer : ffi@haskell.org
-- Stability : provisional
-- Portability : portable
@@ -82,11 +82,8 @@ import GHC.Base
-- |Allocate storage for the given number of elements of a storable type
-- (like 'Foreign.Marshal.Alloc.malloc', but for multiple elements).
--
-mallocArray :: Storable a => Int -> IO (Ptr a)
-mallocArray = doMalloc undefined
- where
- doMalloc :: Storable a' => a' -> Int -> IO (Ptr a')
- doMalloc dummy size = mallocBytes (size * sizeOf dummy)
+mallocArray :: forall a . Storable a => Int -> IO (Ptr a)
+mallocArray size = mallocBytes (size * sizeOf (undefined :: a))
-- |Like 'mallocArray', but add an extra position to hold a special
-- termination element.
@@ -96,11 +93,8 @@ mallocArray0 size = mallocArray (size + 1)
-- |Like 'mallocArray', but allocated memory is filled with bytes of value zero.
--
-callocArray :: Storable a => Int -> IO (Ptr a)
-callocArray = doCalloc undefined
- where
- doCalloc :: Storable a' => a' -> Int -> IO (Ptr a')
- doCalloc dummy size = callocBytes (size * sizeOf dummy)
+callocArray :: forall a . Storable a => Int -> IO (Ptr a)
+callocArray size = callocBytes (size * sizeOf (undefined :: a))
-- |Like 'callocArray0', but allocated memory is filled with bytes of value
-- zero.
@@ -111,12 +105,9 @@ callocArray0 size = callocArray (size + 1)
-- |Temporarily allocate space for the given number of elements
-- (like 'Foreign.Marshal.Alloc.alloca', but for multiple elements).
--
-allocaArray :: Storable a => Int -> (Ptr a -> IO b) -> IO b
-allocaArray = doAlloca undefined
- where
- doAlloca :: Storable a' => a' -> Int -> (Ptr a' -> IO b') -> IO b'
- doAlloca dummy size = allocaBytesAligned (size * sizeOf dummy)
- (alignment dummy)
+allocaArray :: forall a b . Storable a => Int -> (Ptr a -> IO b) -> IO b
+allocaArray size = allocaBytesAligned (size * sizeOf (undefined :: a))
+ (alignment (undefined :: a))
-- |Like 'allocaArray', but add an extra position to hold a special
-- termination element.
@@ -129,11 +120,8 @@ allocaArray0 size = allocaArray (size + 1)
-- |Adjust the size of an array
--
-reallocArray :: Storable a => Ptr a -> Int -> IO (Ptr a)
-reallocArray = doRealloc undefined
- where
- doRealloc :: Storable a' => a' -> Ptr a' -> Int -> IO (Ptr a')
- doRealloc dummy ptr size = reallocBytes ptr (size * sizeOf dummy)
+reallocArray :: forall a . Storable a => Ptr a -> Int -> IO (Ptr a)
+reallocArray ptr size = reallocBytes ptr (size * sizeOf (undefined :: a))
-- |Adjust the size of an array including an extra position for the end marker.
--
@@ -153,7 +141,7 @@ peekArray size ptr | size <= 0 = return []
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)
-
+
-- |Convert an array terminated by the given end marker into a Haskell list
--
peekArray0 :: (Storable a, Eq a) => a -> Ptr a -> IO [a]
@@ -238,20 +226,14 @@ withArrayLen0 marker vals f =
-- |Copy the given number of elements from the second array (source) into the
-- first array (destination); the copied areas may /not/ overlap
--
-copyArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
-copyArray = doCopy undefined
- where
- doCopy :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
- doCopy dummy dest src size = copyBytes dest src (size * sizeOf dummy)
+copyArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
+copyArray dest src size = copyBytes dest src (size * sizeOf (undefined :: a))
-- |Copy the given number of elements from the second array (source) into the
-- first array (destination); the copied areas /may/ overlap
--
-moveArray :: Storable a => Ptr a -> Ptr a -> Int -> IO ()
-moveArray = doMove undefined
- where
- doMove :: Storable a' => a' -> Ptr a' -> Ptr a' -> Int -> IO ()
- doMove dummy dest src size = moveBytes dest src (size * sizeOf dummy)
+moveArray :: forall a . Storable a => Ptr a -> Ptr a -> Int -> IO ()
+moveArray dest src size = moveBytes dest src (size * sizeOf (undefined :: a))
-- finding the length
@@ -272,9 +254,5 @@ lengthArray0 marker ptr = loop 0
-- |Advance a pointer into an array by the given number of elements
--
-advancePtr :: Storable a => Ptr a -> Int -> Ptr a
-advancePtr = doAdvance undefined
- where
- doAdvance :: Storable a' => a' -> Ptr a' -> Int -> Ptr a'
- doAdvance dummy ptr i = ptr `plusPtr` (i * sizeOf dummy)
-
+advancePtr :: forall a . Storable a => Ptr a -> Int -> Ptr a
+advancePtr ptr i = ptr `plusPtr` (i * sizeOf (undefined :: a))
diff --git a/libraries/base/Foreign/Marshal/Pool.hs b/libraries/base/Foreign/Marshal/Pool.hs
index 5d92f6fdd9..8d704c1a2d 100644
--- a/libraries/base/Foreign/Marshal/Pool.hs
+++ b/libraries/base/Foreign/Marshal/Pool.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoImplicitPrelude, ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- |
@@ -102,11 +102,8 @@ withPool act = -- ATTENTION: cut-n-paste from Control.Exception below!
-- allocated is determined by the 'sizeOf' method from the instance of
-- 'Storable' for the appropriate type.
-pooledMalloc :: Storable a => Pool -> IO (Ptr a)
-pooledMalloc = pm undefined
- where
- pm :: Storable a' => a' -> Pool -> IO (Ptr a')
- pm dummy pool = pooledMallocBytes pool (sizeOf dummy)
+pooledMalloc :: forall a . Storable a => Pool -> IO (Ptr a)
+pooledMalloc pool = pooledMallocBytes pool (sizeOf (undefined :: a))
-- | Allocate the given number of bytes of storage in the pool.
@@ -120,11 +117,8 @@ pooledMallocBytes (Pool pool) size = do
-- | Adjust the storage area for an element in the pool to the given size of
-- the required type.
-pooledRealloc :: Storable a => Pool -> Ptr a -> IO (Ptr a)
-pooledRealloc = pr undefined
- where
- pr :: Storable a' => a' -> Pool -> Ptr a' -> IO (Ptr a')
- pr dummy pool ptr = pooledReallocBytes pool ptr (sizeOf dummy)
+pooledRealloc :: forall a . Storable a => Pool -> Ptr a -> IO (Ptr a)
+pooledRealloc pool ptr = pooledReallocBytes pool ptr (sizeOf (undefined :: a))
-- | Adjust the storage area for an element in the pool to the given size.
@@ -140,11 +134,9 @@ pooledReallocBytes (Pool pool) ptr size = do
-- | Allocate storage for the given number of elements of a storable type in the
-- pool.
-pooledMallocArray :: Storable a => Pool -> Int -> IO (Ptr a)
-pooledMallocArray = pma undefined
- where
- pma :: Storable a' => a' -> Pool -> Int -> IO (Ptr a')
- pma dummy pool size = pooledMallocBytes pool (size * sizeOf dummy)
+pooledMallocArray :: forall a . Storable a => Pool -> Int -> IO (Ptr a)
+pooledMallocArray pool size =
+ pooledMallocBytes pool (size * sizeOf (undefined :: a))
-- | Allocate storage for the given number of elements of a storable type in the
-- pool, but leave room for an extra element to signal the end of the array.
@@ -155,11 +147,9 @@ pooledMallocArray0 pool size =
-- | Adjust the size of an array in the given pool.
-pooledReallocArray :: Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
-pooledReallocArray = pra undefined
- where
- pra :: Storable a' => a' -> Pool -> Ptr a' -> Int -> IO (Ptr a')
- pra dummy pool ptr size = pooledReallocBytes pool ptr (size * sizeOf dummy)
+pooledReallocArray :: forall a . Storable a => Pool -> Ptr a -> Int -> IO (Ptr a)
+pooledReallocArray pool ptr size =
+ pooledReallocBytes pool ptr (size * sizeOf (undefined :: a))
-- | Adjust the size of an array with an end marker in the given pool.
@@ -195,4 +185,3 @@ pooledNewArray0 pool marker vals = do
ptr <- pooledMallocArray0 pool (length vals)
pokeArray0 marker ptr vals
return ptr
-
View Lorry Controller Status