    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples,
                 ScopedTypeVariables, BangPatterns #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Foreign.Marshal.Alloc
    -- Copyright   :  (c) The FFI task force 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  ffi@haskell.org
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- The module "Foreign.Marshal.Alloc" provides operations to allocate and
    -- deallocate blocks of raw memory (i.e., unstructured chunks of memory
    -- outside of the area maintained by the Haskell storage manager).  These
    -- memory blocks are commonly used to pass compound data structures to
    -- foreign functions or to provide space in which compound result values
    -- are obtained from foreign functions.
    --
    -- If any of the allocation functions fails, an exception is thrown.
    -- In some cases, memory exhaustion may mean the process is terminated.
    -- If 'free' or 'reallocBytes' is applied to a memory area
    -- that has been allocated with 'alloca' or 'allocaBytes', the
    -- behaviour is undefined.  Any further access to memory areas allocated with
    -- 'alloca' or 'allocaBytes', after the computation that was passed to
    -- the allocation function has terminated, leads to undefined behaviour.  Any
    -- further access to the memory area referenced by a pointer passed to
    -- 'realloc', 'reallocBytes', or 'free' entails undefined
    -- behaviour.
    --
    -- All storage allocated by functions that allocate based on a /size in bytes/
    -- must be sufficiently aligned for any of the basic foreign types
    -- that fits into the newly allocated storage. All storage allocated by
    -- functions that allocate based on a specific type must be sufficiently
    -- aligned for that type. Array allocation routines need to obey the same
    -- alignment constraints for each array element.
    --
    -- The underlying implementation is wrapping the @<stdlib.h>@
    -- @malloc@, @realloc@, and @free@.
    -- In other words it should be safe to allocate using C-@malloc@,
    -- and free memory with 'free' from this module.
    --
    -----------------------------------------------------------------------------

    module Foreign.Marshal.Alloc (
      -- * Memory allocation
      -- ** Local allocation
      alloca,
      allocaBytes,
      allocaBytesAligned,

      -- ** Dynamic allocation
      malloc,
      mallocBytes,

      calloc,
      callocBytes,

      realloc,
      reallocBytes,

      free,
      finalizerFree
    ) where

    import Data.Bits                ( Bits, (.&.) )
    import Data.Maybe
    import Foreign.C.Types          ( CSize(..) )
    import Foreign.Storable         ( Storable(sizeOf,alignment) )
    import Foreign.ForeignPtr       ( FinalizerPtr )
    import GHC.IO.Exception
    import GHC.Num
    import GHC.Real
    import GHC.Show
    import GHC.Ptr
    import GHC.Base

    -- exported functions
    -- ------------------

    -- |Allocate a block of memory that is sufficient to hold values of type
    -- @a@.  The size of the area allocated is determined by the 'sizeOf'
    -- method from the instance of 'Storable' for the appropriate type.
    --
    -- The memory may be deallocated using 'free' or 'finalizerFree' when
    -- no longer required.
    --
    {-# INLINE malloc #-}
    malloc :: forall a . Storable a => IO (Ptr a)
    malloc :: forall a. Storable a => IO (Ptr a)
    malloc  = Int -> IO (Ptr a)
    forall a. Int -> IO (Ptr a)
    mallocBytes (a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a))

    -- |Like 'malloc' but memory is filled with bytes of value zero.
    --
    {-# INLINE calloc #-}
    calloc :: forall a . Storable a => IO (Ptr a)
    calloc :: forall a. Storable a => IO (Ptr a)
    calloc = Int -> IO (Ptr a)
    forall a. Int -> IO (Ptr a)
    callocBytes (a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    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
    -- foreign types that fits into a memory block of the allocated size.
    --
    -- The memory may be deallocated using 'free' or 'finalizerFree' when
    -- no longer required.
    --
    mallocBytes      :: Int -> IO (Ptr a)
    mallocBytes :: forall a. Int -> IO (Ptr a)
    mallocBytes Int
    size  = String -> IO (Ptr a) -> IO (Ptr a)
    forall a. String -> IO (Ptr a) -> IO (Ptr a)
    failWhenNULL String
    "malloc" (CSize -> IO (Ptr a)
    forall a. CSize -> IO (Ptr a)
    _malloc (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size))

    -- |Like 'mallocBytes', but memory is filled with bytes of value zero.
    --
    callocBytes :: Int -> IO (Ptr a)
    callocBytes :: forall a. Int -> IO (Ptr a)
    callocBytes Int
    size = String -> IO (Ptr a) -> IO (Ptr a)
    forall a. String -> IO (Ptr a) -> IO (Ptr a)
    failWhenNULL String
    "calloc" (IO (Ptr a) -> IO (Ptr a)) -> IO (Ptr a) -> IO (Ptr a)
    forall a b. (a -> b) -> a -> b
    $ CSize -> CSize -> IO (Ptr a)
    forall a. CSize -> CSize -> IO (Ptr a)
    _calloc CSize
    1 (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size)

    -- |@'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.
    --
    {-# INLINE alloca #-}
    alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b
    alloca :: forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca  =
      Int -> Int -> (Ptr a -> IO b) -> IO b
    forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAligned (a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)) (a -> Int
    forall a. Storable a => a -> Int
    alignment (a
    forall a. HasCallStack => a
    undefined :: a))

    -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument
    -- a pointer to a temporarily allocated block of memory of @n@ bytes.
    -- The block of memory is sufficiently aligned for any of the basic
    -- foreign types that fits into a memory block of the allocated size.
    --
    -- 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.
    --
    allocaBytes :: Int -> (Ptr a -> IO b) -> IO b
    allocaBytes :: forall a b. Int -> (Ptr a -> IO b) -> IO b
    allocaBytes (I# Int#
    size) Ptr a -> IO b
    action = (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
    -> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \ State# RealWorld
    s0 ->
         case Int#
    -> State# RealWorld
    -> (# State# RealWorld, MutableByteArray# RealWorld #)
    forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
    newPinnedByteArray# Int#
    size State# RealWorld
    s0      of { (# State# RealWorld
    s1, MutableByteArray# RealWorld
    mbarr# #) ->
         case MutableByteArray# RealWorld
    -> State# RealWorld -> (# State# RealWorld, ByteArray# #)
    forall d.
    MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
    unsafeFreezeByteArray# MutableByteArray# RealWorld
    mbarr# State# RealWorld
    s1 of { (# State# RealWorld
    s2, ByteArray#
    barr#  #) ->
         let addr :: Ptr a
    addr = Addr# -> Ptr a
    forall a. Addr# -> Ptr a
    Ptr (ByteArray# -> Addr#
    byteArrayContents# ByteArray#
    barr#) in
         case Ptr a -> IO b
    action Ptr a
    forall {a}. Ptr a
    addr     of { IO State# RealWorld -> (# State# RealWorld, b #)
    action' ->
         ByteArray#
    -> State# RealWorld
    -> (State# RealWorld -> (# State# RealWorld, b #))
    -> (# State# RealWorld, b #)
    forall a b. a -> State# RealWorld -> (State# RealWorld -> b) -> b
    keepAlive# ByteArray#
    barr# State# RealWorld
    s2 State# RealWorld -> (# State# RealWorld, b #)
    action'
      }}}

    -- |@'allocaBytesAligned' size align f@ executes the computation @f@,
    -- passing as argument a pointer to a temporarily allocated block of memory
    -- of @size@ bytes and aligned to @align@ bytes. The value of @align@ must
    -- be a power of two.
    --
    -- 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.
    --
    allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAligned :: forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAligned !Int
    _size !Int
    align !Ptr a -> IO b
    _action
        | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Bool
    forall i. (Bits i, Integral i) => i -> Bool
    isPowerOfTwo Int
    align =
          IOError -> IO b
    forall a. IOError -> IO a
    ioError (IOError -> IO b) -> IOError -> IO b
    forall a b. (a -> b) -> a -> b
    $
            Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOError
    IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    InvalidArgument
              String
    "allocaBytesAligned"
              (String
    "alignment (="String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Int -> String
    forall a. Show a => a -> String
    show Int
    alignString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    ") must be a power of two!")
              Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing
      where
        isPowerOfTwo :: (Bits i, Integral i) => i -> Bool
        isPowerOfTwo :: forall i. (Bits i, Integral i) => i -> Bool
    isPowerOfTwo i
    x = i
    x i -> i -> i
    forall a. Bits a => a -> a -> a
    .&. (i
    xi -> i -> i
    forall a. Num a => a -> a -> a
    -i
    1) i -> i -> Bool
    forall a. Eq a => a -> a -> Bool
    == i
    0
    allocaBytesAligned !Int
    size !Int
    align !Ptr a -> IO b
    action =
        Int -> Int -> (Ptr a -> IO b) -> IO b
    forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAlignedAndUnchecked Int
    size Int
    align Ptr a -> IO b
    action
    {-# INLINABLE allocaBytesAligned #-}

    allocaBytesAlignedAndUnchecked :: Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAlignedAndUnchecked :: forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
    allocaBytesAlignedAndUnchecked (I# Int#
    size) (I# Int#
    align) Ptr a -> IO b
    action = (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b)
    -> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \ State# RealWorld
    s0 ->
         case Int#
    -> Int#
    -> State# RealWorld
    -> (# State# RealWorld, MutableByteArray# RealWorld #)
    forall d.
    Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
    newAlignedPinnedByteArray# Int#
    size Int#
    align State# RealWorld
    s0 of { (# State# RealWorld
    s1, MutableByteArray# RealWorld
    mbarr# #) ->
         case MutableByteArray# RealWorld
    -> State# RealWorld -> (# State# RealWorld, ByteArray# #)
    forall d.
    MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
    unsafeFreezeByteArray# MutableByteArray# RealWorld
    mbarr# State# RealWorld
    s1 of { (# State# RealWorld
    s2, ByteArray#
    barr#  #) ->
         let addr :: Ptr a
    addr = Addr# -> Ptr a
    forall a. Addr# -> Ptr a
    Ptr (ByteArray# -> Addr#
    byteArrayContents# ByteArray#
    barr#) in
         case Ptr a -> IO b
    action Ptr a
    forall {a}. Ptr a
    addr     of { IO State# RealWorld -> (# State# RealWorld, b #)
    action' ->
         ByteArray#
    -> State# RealWorld
    -> (State# RealWorld -> (# State# RealWorld, b #))
    -> (# State# RealWorld, b #)
    forall a b. a -> State# RealWorld -> (State# RealWorld -> b) -> b
    keepAlive# ByteArray#
    barr# State# RealWorld
    s2 State# RealWorld -> (# State# RealWorld, b #)
    action'
      }}}

    -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes'
    -- to the size needed to store values of type @b@.  The returned pointer
    -- may refer to an entirely different memory area, but will be suitably
    -- aligned to hold values of type @b@.  The contents of the referenced
    -- memory area will be the same as of the original pointer up to the
    -- minimum of the original size and the size of values of type @b@.
    --
    -- If the argument to 'realloc' is 'nullPtr', 'realloc' behaves like
    -- 'malloc'.
    --
    realloc :: forall a b . Storable b => Ptr a -> IO (Ptr b)
    realloc :: forall a b. Storable b => Ptr a -> IO (Ptr b)
    realloc Ptr a
    ptr = String -> IO (Ptr b) -> IO (Ptr b)
    forall a. String -> IO (Ptr a) -> IO (Ptr a)
    failWhenNULL String
    "realloc" (Ptr a -> CSize -> IO (Ptr b)
    forall a b. Ptr a -> CSize -> IO (Ptr b)
    _realloc Ptr a
    ptr CSize
    size)
      where
        size :: CSize
    size = Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (b -> Int
    forall a. Storable a => a -> Int
    sizeOf (b
    forall a. HasCallStack => a
    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
    -- different memory area, but will be sufficiently aligned for any of the
    -- basic foreign types that fits into a memory block of the given size.
    -- The contents of the referenced memory area will be the same as of
    -- the original pointer up to the minimum of the original size and the
    -- given size.
    --
    -- If the pointer argument to 'reallocBytes' is 'nullPtr', 'reallocBytes'
    -- behaves like 'malloc'.  If the requested size is 0, 'reallocBytes'
    -- behaves like 'free'.
    --
    reallocBytes          :: Ptr a -> Int -> IO (Ptr a)
    reallocBytes :: forall a. Ptr a -> Int -> IO (Ptr a)
    reallocBytes Ptr a
    ptr Int
    0     = do Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    free Ptr a
    ptr; Ptr a -> IO (Ptr a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr a
    forall {a}. Ptr a
    nullPtr
    reallocBytes Ptr a
    ptr Int
    size  =
      String -> IO (Ptr a) -> IO (Ptr a)
    forall a. String -> IO (Ptr a) -> IO (Ptr a)
    failWhenNULL String
    "realloc" (Ptr a -> CSize -> IO (Ptr a)
    forall a b. Ptr a -> CSize -> IO (Ptr b)
    _realloc Ptr a
    ptr (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size))

    -- |Free a block of memory that was allocated with 'malloc',
    -- 'mallocBytes', 'realloc', 'reallocBytes', 'Foreign.Marshal.Utils.new'
    -- or any of the @new@/X/ functions in "Foreign.Marshal.Array" or
    -- "Foreign.C.String".
    --
    free :: Ptr a -> IO ()
    free :: forall a. Ptr a -> IO ()
    free  = Ptr a -> IO ()
    forall a. Ptr a -> IO ()
    _free

    -- auxiliary routines
    -- -------------------

    -- asserts that the pointer returned from the action in the second argument is
    -- non-null
    --
    failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
    failWhenNULL :: forall a. String -> IO (Ptr a) -> IO (Ptr a)
    failWhenNULL String
    name IO (Ptr a)
    f = do
       Ptr a
    addr <- IO (Ptr a)
    f
       if Ptr a
    addr Ptr a -> Ptr a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr a
    forall {a}. Ptr a
    nullPtr
          then IOError -> IO (Ptr a)
    forall a. IOError -> IO a
    ioError (Maybe Handle
    -> IOErrorType
    -> String
    -> String
    -> Maybe CInt
    -> Maybe String
    -> IOError
    IOError Maybe Handle
    forall a. Maybe a
    Nothing IOErrorType
    ResourceExhausted String
    name
                                            String
    "out of memory" Maybe CInt
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing)
          else Ptr a -> IO (Ptr a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr a
    addr

    -- basic C routines needed for memory allocation
    --
    foreign import ccall unsafe "stdlib.h malloc"  _malloc  ::          CSize -> IO (Ptr a)
    foreign import ccall unsafe "stdlib.h calloc"  _calloc  :: CSize -> CSize -> IO (Ptr a)
    foreign import ccall unsafe "stdlib.h realloc" _realloc :: Ptr a -> CSize -> IO (Ptr b)
    foreign import ccall unsafe "stdlib.h free"    _free    :: Ptr a -> IO ()

    -- | A pointer to a foreign function equivalent to 'free', which may be
    -- used as a finalizer (cf 'Foreign.ForeignPtr.ForeignPtr') for storage
    -- allocated with 'malloc', 'mallocBytes', 'realloc' or 'reallocBytes'.
    foreign import ccall unsafe "stdlib.h &free" finalizerFree :: FinalizerPtr a