    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables, BangPatterns #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Foreign.Storable
    -- Copyright   :  (c) The FFI task force 2001
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  ffi@haskell.org
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- The module "Foreign.Storable" provides most elementary support for
    -- marshalling and is part of the language-independent portion of the
    -- Foreign Function Interface (FFI), and will normally be imported via
    -- the "Foreign" module.
    --
    -----------------------------------------------------------------------------

    module Foreign.Storable
            ( Storable(
                 sizeOf,
                 alignment,
                 peekElemOff,
                 pokeElemOff,
                 peekByteOff,
                 pokeByteOff,
                 peek,
                 poke)
            ) where

    #include "MachDeps.h"
    #include "HsBaseConfig.h"

    import GHC.Storable
    import GHC.Stable       ( StablePtr )
    import GHC.Num
    import GHC.Int
    import GHC.Word
    import GHC.Ptr
    import GHC.Base
    import GHC.Fingerprint.Type
    import Data.Bits
    import GHC.Real

    {- |
    The member functions of this class facilitate writing values of
    primitive types to raw memory (which may have been allocated with the
    above mentioned routines) and reading values from blocks of raw
    memory.  The class, furthermore, includes support for computing the
    storage requirements and alignment restrictions of storable types.

    Memory addresses are represented as values of type @'Ptr' a@, for some
    @a@ which is an instance of class 'Storable'.  The type argument to
    'Ptr' helps provide some valuable type safety in FFI code (you can\'t
    mix pointers of different types without an explicit cast), while
    helping the Haskell type system figure out which marshalling method is
    needed for a given pointer.

    All marshalling between Haskell and a foreign language ultimately
    boils down to translating Haskell data structures into the binary
    representation of a corresponding data structure of the foreign
    language and vice versa.  To code this marshalling in Haskell, it is
    necessary to manipulate primitive data types stored in unstructured
    memory blocks.  The class 'Storable' facilitates this manipulation on
    all types for which it is instantiated, which are the standard basic
    types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
    'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
    'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
    as well as 'Ptr'.
    -}

    class Storable a where
       {-# MINIMAL sizeOf, alignment,
                   (peek | peekElemOff | peekByteOff),
                   (poke | pokeElemOff | pokeByteOff) #-}

       sizeOf      :: a -> Int
       -- ^ Computes the storage requirements (in bytes) of the argument.
       -- The value of the argument is not used.

       alignment   :: a -> Int
       -- ^ Computes the alignment constraint of the argument.  An
       -- alignment constraint @x@ is fulfilled by any address divisible
       -- by @x@. The alignment must be a power of two if this instance
       -- is to be used with 'alloca' or 'allocaArray'.  The value of
       -- the argument is not used.

       peekElemOff :: Ptr a -> Int      -> IO a
       -- ^       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 = IOExts.fixIO $ \result ->
       -- >   peek (addr `plusPtr` (idx * sizeOf result))
       --
       --         Note that this is only a specification, not
       --         necessarily the concrete implementation of the
       --         function.

       pokeElemOff :: Ptr a -> Int -> a -> IO ()
       -- ^       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

       peekByteOff :: Ptr b -> Int      -> IO 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)

       pokeByteOff :: Ptr b -> Int -> a -> IO ()
       -- ^       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

       peek        :: Ptr a      -> IO 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.

       poke        :: Ptr a -> a -> IO ()
       -- ^ Write the given value to the given memory location.  Alignment
       -- restrictions might apply; see 'peek'.

       -- circular default instances
       peekElemOff = a -> Ptr a -> Int -> IO a
    peekElemOff_ a
    forall a. HasCallStack => a
    undefined
          where peekElemOff_ :: a -> Ptr a -> Int -> IO a
                peekElemOff_ :: a -> Ptr a -> Int -> IO a
    peekElemOff_ a
    undef Ptr a
    ptr Int
    off = Ptr a -> Int -> IO a
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr a
    ptr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * a -> Int
    forall a. Storable a => a -> Int
    sizeOf a
    undef)
       pokeElemOff Ptr a
    ptr Int
    off a
    val = Ptr a -> Int -> a -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    ptr (Int
    off Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * a -> Int
    forall a. Storable a => a -> Int
    sizeOf a
    val) a
    val

       peekByteOff Ptr b
    ptr Int
    off = Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    peek (Ptr b
    ptr Ptr b -> Int -> Ptr a
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off)
       pokeByteOff Ptr b
    ptr Int
    off = Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke (Ptr b
    ptr Ptr b -> Int -> Ptr a
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off)

       peek Ptr a
    ptr = Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    ptr Int
    0
       poke Ptr a
    ptr = Ptr a -> Int -> a -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr a
    ptr Int
    0

    -- | @since 4.9.0.0
    instance Storable () where
      sizeOf :: () -> Int
    sizeOf ()
    _ = Int
    0
      alignment :: () -> Int
    alignment ()
    _ = Int
    1
      peek :: Ptr () -> IO ()
    peek Ptr ()
    _ = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      poke :: Ptr () -> () -> IO ()
    poke Ptr ()
    _ ()
    _ = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- System-dependent, but rather obvious instances

    -- | @since 2.01
    instance Storable Bool where
       sizeOf :: Bool -> Int
    sizeOf Bool
    _          = Int32 -> Int
    forall a. Storable a => a -> Int
    sizeOf (Int32
    forall a. HasCallStack => a
    undefined::HTYPE_INT)
       alignment :: Bool -> Int
    alignment Bool
    _       = Int32 -> Int
    forall a. Storable a => a -> Int
    alignment (Int32
    forall a. HasCallStack => a
    undefined::HTYPE_INT)
       peekElemOff :: Ptr Bool -> Int -> IO Bool
    peekElemOff Ptr Bool
    p Int
    i   = (Int32 -> Bool) -> IO Int32 -> IO Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (Int32 -> Int32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (Int32
    0::HTYPE_INT)) $ peekElemOff (castPtr p) i
       pokeElemOff :: Ptr Bool -> Int -> Bool -> IO ()
    pokeElemOff Ptr Bool
    p Int
    i Bool
    x = Ptr Int32 -> Int -> Int32 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff (Ptr Bool -> Ptr Int32
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Bool
    p) Int
    i (if Bool
    x then Int32
    1 else Int32
    0::HTYPE_INT)

    #define STORABLE(T,size,align,read,write)       \
    instance Storable (T) where {                   \
        sizeOf    _ = size;                         \
        alignment _ = align;                        \
        peekElemOff = read;                         \
        pokeElemOff = write }

    -- | @since 2.01
    STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
             readWideCharOffPtr,writeWideCharOffPtr)

    -- | @since 2.01
    STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
             readIntOffPtr,writeIntOffPtr)

    -- | @since 2.01
    STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
             readWordOffPtr,writeWordOffPtr)

    -- | @since 2.01
    STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
             readPtrOffPtr,writePtrOffPtr)

    -- | @since 2.01
    STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
             readFunPtrOffPtr,writeFunPtrOffPtr)

    -- | @since 2.01
    STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
             readStablePtrOffPtr,writeStablePtrOffPtr)

    -- | @since 2.01
    STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
             readFloatOffPtr,writeFloatOffPtr)

    -- | @since 2.01
    STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
             readDoubleOffPtr,writeDoubleOffPtr)

    -- | @since 2.01
    STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
             readWord8OffPtr,writeWord8OffPtr)

    -- | @since 2.01
    STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
             readWord16OffPtr,writeWord16OffPtr)

    -- | @since 2.01
    STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
             readWord32OffPtr,writeWord32OffPtr)

    -- | @since 2.01
    STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
             readWord64OffPtr,writeWord64OffPtr)

    -- | @since 2.01
    STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
             readInt8OffPtr,writeInt8OffPtr)

    -- | @since 2.01
    STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
             readInt16OffPtr,writeInt16OffPtr)

    -- | @since 2.01
    STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
             readInt32OffPtr,writeInt32OffPtr)

    -- | @since 2.01
    STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
             readInt64OffPtr,writeInt64OffPtr)

    -- | @since 4.8.0.0
    instance (Storable a, Integral a) => Storable (Ratio a) where
        sizeOf :: Ratio a -> Int
    sizeOf Ratio a
    _    = Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)
        alignment :: Ratio a -> Int
    alignment Ratio a
    _ = a -> Int
    forall a. Storable a => a -> Int
    alignment (a
    forall a. HasCallStack => a
    undefined :: a )
        peek :: Ptr (Ratio a) -> IO (Ratio a)
    peek Ptr (Ratio a)
    p           = do
                            Ptr a
    q <- Ptr a -> IO (Ptr a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr a -> IO (Ptr a)) -> Ptr a -> IO (Ptr a)
    forall a b. (a -> b) -> a -> b
    $ Ptr (Ratio a) -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr Ptr (Ratio a)
    p
                            a
    r <- Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    peek Ptr a
    q
                            a
    i <- Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff Ptr a
    q Int
    1
                            Ratio a -> IO (Ratio a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    r a -> a -> Ratio a
    forall a. Integral a => a -> a -> Ratio a
    % a
    i)
        poke :: Ptr (Ratio a) -> Ratio a -> IO ()
    poke Ptr (Ratio a)
    p (a
    r :% a
    i)  = do
                            Ptr a
    q <-Ptr a -> IO (Ptr a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr a -> IO (Ptr a)) -> Ptr a -> IO (Ptr a)
    forall a b. (a -> b) -> a -> b
    $  (Ptr (Ratio a) -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr Ptr (Ratio a)
    p)
                            Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr a
    q a
    r
                            Ptr a -> Int -> a -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr a
    q Int
    1 a
    i

    -- XXX: here to avoid orphan instance in GHC.Fingerprint
    -- | @since 4.4.0.0
    instance Storable Fingerprint where
      sizeOf :: Fingerprint -> Int
    sizeOf Fingerprint
    _ = Int
    16
      alignment :: Fingerprint -> Int
    alignment Fingerprint
    _ = Int
    8
      peek :: Ptr Fingerprint -> IO Fingerprint
    peek = Ptr Fingerprint -> IO Fingerprint
    peekFingerprint
      poke :: Ptr Fingerprint -> Fingerprint -> IO ()
    poke = Ptr Fingerprint -> Fingerprint -> IO ()
    pokeFingerprint

    -- peek/poke in fixed BIG-endian 128-bit format
    peekFingerprint :: Ptr Fingerprint -> IO Fingerprint
    peekFingerprint :: Ptr Fingerprint -> IO Fingerprint
    peekFingerprint Ptr Fingerprint
    p0 = do
          let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
              peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
    peekW64 Ptr Word8
    _  Int
    0  !Word64
    i = Word64 -> IO Word64
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word64
    i
              peekW64 !Ptr Word8
    p !Int
    n !Word64
    i = do
                    Word8
    w8 <- Ptr Word8 -> IO Word8
    forall a. Storable a => Ptr a -> IO a
    peek Ptr Word8
    p
                    Ptr Word8 -> Int -> Word64 -> IO Word64
    peekW64 (Ptr Word8
    p Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    1) (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                        ((Word64
    i Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    w8)

          Word64
    high <- Ptr Word8 -> Int -> Word64 -> IO Word64
    peekW64 (Ptr Fingerprint -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Fingerprint
    p0) Int
    8 Word64
    0
          Word64
    low  <- Ptr Word8 -> Int -> Word64 -> IO Word64
    peekW64 (Ptr Fingerprint -> Ptr Any
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Fingerprint
    p0 Ptr Any -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    8) Int
    8 Word64
    0
          Fingerprint -> IO Fingerprint
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word64 -> Word64 -> Fingerprint
    Fingerprint Word64
    high Word64
    low)

    pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()
    pokeFingerprint :: Ptr Fingerprint -> Fingerprint -> IO ()
    pokeFingerprint Ptr Fingerprint
    p0 (Fingerprint Word64
    high Word64
    low) = do
          let pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()
              pokeW64 :: Ptr Word8 -> Int -> Word64 -> IO ()
    pokeW64 Ptr Word8
    _ Int
    0  Word64
    _  = () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              pokeW64 Ptr Word8
    p !Int
    n !Word64
    i = do
                    Ptr Word8 -> Int -> Word8 -> IO ()
    forall a. Storable a => Ptr a -> Int -> a -> IO ()
    pokeElemOff Ptr Word8
    p (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Word64 -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word64
    i)
                    Ptr Word8 -> Int -> Word64 -> IO ()
    pokeW64 Ptr Word8
    p (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) (Word64
    i Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8)

          Ptr Word8 -> Int -> Word64 -> IO ()
    pokeW64 (Ptr Fingerprint -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Fingerprint
    p0) Int
    8 Word64
    high
          Ptr Word8 -> Int -> Word64 -> IO ()
    pokeW64 (Ptr Fingerprint -> Ptr Any
    forall a b. Ptr a -> Ptr b
    castPtr Ptr Fingerprint
    p0 Ptr Any -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    8) Int
    8 Word64
    low