{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.Internal.Foreign.Marshal.Utils
-- Copyright   :  (c) The FFI task force 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  ffi@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- Utilities for primitive marshaling
--
-----------------------------------------------------------------------------

module GHC.Internal.Foreign.Marshal.Utils (
  -- * General marshalling utilities

  -- ** Combined allocation and marshalling
  --
  with,
  new,

  -- ** Marshalling of Boolean values (non-zero corresponds to 'True')
  --
  fromBool,
  toBool,

  -- ** Marshalling of Maybe values
  --
  maybeNew,
  maybeWith,
  maybePeek,

  -- ** Marshalling lists of storable objects
  --
  withMany,

  -- ** Haskellish interface to memcpy and memmove
  -- | (argument order: destination, source)
  --
  copyBytes,
  moveBytes,

  -- ** Filling up memory area with required values
  --
  fillBytes,
) where

import GHC.Internal.Data.Maybe
import GHC.Internal.Ptr                  ( Ptr(..), nullPtr )
import GHC.Internal.Foreign.Storable         ( Storable(poke) )
import GHC.Internal.Foreign.Marshal.Alloc    ( malloc, alloca )
import GHC.Internal.Word                 ( Word8(..) )

import GHC.Internal.Num
import GHC.Internal.Base

-- combined allocation and marshalling
-- -----------------------------------

-- |Allocate a block of memory and marshal a value into it
-- (the combination of 'malloc' and 'poke').
-- The size of the area allocated is determined by the 'GHC.Internal.Foreign.Storable.sizeOf'
-- method from the instance of 'Storable' for the appropriate type.
--
-- The memory may be deallocated using 'GHC.Internal.Foreign.Marshal.Alloc.free' or
-- 'GHC.Internal.Foreign.Marshal.Alloc.finalizerFree' when no longer required.
--
new     :: Storable a => a -> IO (Ptr a)
new :: forall a. Storable a => a -> IO (Ptr a)
new a
val  =
  do
    ptr <- IO (Ptr a)
forall a. Storable a => IO (Ptr a)
malloc
    poke ptr val
    return ptr

-- |@'with' val f@ executes the computation @f@, passing as argument
-- a pointer to a temporarily allocated block of memory into which
-- @val@ has been marshalled (the combination of 'alloca' and 'poke').
--
-- 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.
--
with       :: Storable a => a -> (Ptr a -> IO b) -> IO b
with :: forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with a
val Ptr a -> IO b
f  =
  (Ptr a -> IO b) -> IO b
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
    Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
ptr a
val
    Ptr a -> IO b
f Ptr a
ptr

-- marshalling of Boolean values (non-zero corresponds to 'True')
-- -----------------------------

-- |Convert a Haskell 'Bool' to its numeric representation
--
fromBool       :: Num a => Bool -> a
fromBool :: forall a. Num a => Bool -> a
fromBool Bool
False  = a
0
fromBool Bool
True   = a
1

-- |Convert a Boolean in numeric representation to a Haskell value
--
toBool :: (Eq a, Num a) => a -> Bool
toBool :: forall a. (Eq a, Num a) => a -> Bool
toBool  = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0)


-- marshalling of Maybe values
-- ---------------------------

-- |Allocate storage and marshal a storable value wrapped into a 'Maybe'
--
-- * the 'nullPtr' is used to represent 'Nothing'
--
maybeNew :: (      a -> IO (Ptr b))
         -> (Maybe a -> IO (Ptr b))
maybeNew :: forall a b. (a -> IO (Ptr b)) -> Maybe a -> IO (Ptr b)
maybeNew  = IO (Ptr b) -> (a -> IO (Ptr b)) -> Maybe a -> IO (Ptr b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Ptr b -> IO (Ptr b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr b
forall a. Ptr a
nullPtr)

-- |Converts a @withXXX@ combinator into one marshalling a value wrapped
-- into a 'Maybe', using 'nullPtr' to represent 'Nothing'.
--
maybeWith :: (      a -> (Ptr b -> IO c) -> IO c)
          -> (Maybe a -> (Ptr b -> IO c) -> IO c)
maybeWith :: forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith  = ((Ptr b -> IO c) -> IO c)
-> (a -> (Ptr b -> IO c) -> IO c)
-> Maybe a
-> (Ptr b -> IO c)
-> IO c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Ptr b -> IO c) -> Ptr b -> IO c
forall a b. (a -> b) -> a -> b
$ Ptr b
forall a. Ptr a
nullPtr)

-- |Convert a peek combinator into a one returning 'Nothing' if applied to a
-- 'nullPtr'
--
maybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek :: forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr a -> IO b
peek Ptr a
ptr | Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr  = Maybe b -> IO (Maybe b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
                   | Bool
otherwise       = do a <- Ptr a -> IO b
peek Ptr a
ptr; return (Just a)


-- marshalling lists of storable objects
-- -------------------------------------

-- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of
-- marshalled objects
--
withMany :: (a -> (b -> res) -> res)  -- withXXX combinator for one object
         -> [a]                       -- storable objects
         -> ([b] -> res)              -- action on list of marshalled obj.s
         -> res
withMany :: forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany a -> (b -> res) -> res
_       []     [b] -> res
f = [b] -> res
f []
withMany a -> (b -> res) -> res
withFoo (a
x:[a]
xs) [b] -> res
f = a -> (b -> res) -> res
withFoo a
x ((b -> res) -> res) -> (b -> res) -> res
forall a b. (a -> b) -> a -> b
$ \b
x' ->
                              (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany a -> (b -> res) -> res
withFoo [a]
xs (\[b]
xs' -> [b] -> res
f (b
x'b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
xs'))


-- Haskellish interface to memcpy and memmove
-- ------------------------------------------

-- |Copies the given number of bytes from the second area (source) into the
-- first (destination); the copied areas may /not/ overlap
--
copyBytes
  :: Ptr a -- ^ Destination
  -> Ptr a -- ^ Source
  -> Int -- ^ Size in bytes
  -> IO ()
copyBytes :: forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes = (Ptr Any
 -> Ptr Any
 -> Int
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Ptr a -> Ptr a -> Int -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Ptr Any
  -> Ptr Any
  -> Int
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Ptr a -> Ptr a -> Int -> IO ())
-> (Ptr Any
    -> Ptr Any
    -> Int
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Ptr a
-> Ptr a
-> Int
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
dest#) (Ptr Addr#
src#) (I# Int#
size#) State# RealWorld
s
  -> (# Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
copyAddrToAddrNonOverlapping# Addr#
src# Addr#
dest# Int#
size# State# RealWorld
s, () #)

-- |Copies the given number of bytes from the second area (source) into the
-- first (destination); the copied areas /may/ overlap
--
moveBytes
  :: Ptr a -- ^ Destination
  -> Ptr a -- ^ Source
  -> Int -- ^ Size in bytes
  -> IO ()
moveBytes :: forall a. Ptr a -> Ptr a -> Int -> IO ()
moveBytes = (Ptr Any
 -> Ptr Any
 -> Int
 -> State# RealWorld
 -> (# State# RealWorld, () #))
-> Ptr a -> Ptr a -> Int -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Ptr Any
  -> Ptr Any
  -> Int
  -> State# RealWorld
  -> (# State# RealWorld, () #))
 -> Ptr a -> Ptr a -> Int -> IO ())
-> (Ptr Any
    -> Ptr Any
    -> Int
    -> State# RealWorld
    -> (# State# RealWorld, () #))
-> Ptr a
-> Ptr a
-> Int
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
dest#) (Ptr Addr#
src#) (I# Int#
size#) State# RealWorld
s
  -> (# Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld
copyAddrToAddr# Addr#
src# Addr#
dest# Int#
size# State# RealWorld
s, () #)

-- Filling up memory area with required values
-- -------------------------------------------

-- |Fill a given number of bytes in memory area with a byte value.
--
-- @since base-4.8.0.0
fillBytes :: Ptr a -> Word8 -> Int -> IO ()
fillBytes :: forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes = (Ptr Any
 -> Word8 -> Int -> State# RealWorld -> (# State# RealWorld, () #))
-> Ptr a -> Word8 -> Int -> IO ()
forall a b. Coercible a b => a -> b
coerce ((Ptr Any
  -> Word8 -> Int -> State# RealWorld -> (# State# RealWorld, () #))
 -> Ptr a -> Word8 -> Int -> IO ())
-> (Ptr Any
    -> Word8 -> Int -> State# RealWorld -> (# State# RealWorld, () #))
-> Ptr a
-> Word8
-> Int
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr Addr#
dest#) (W8# Word8#
byte#) (I# Int#
size#) State# RealWorld
s
  -> (# Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
setAddrRange# Addr#
dest# Int#
size# (Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
byte#)) State# RealWorld
s, () #)