{-# LANGUAGE
  TemplateHaskell,
  MultiParamTypeClasses,
  FunctionalDependencies,
  UndecidableInstances
  #-}
module LLVM.Internal.Coding where

import LLVM.Prelude

import Language.Haskell.TH
import Language.Haskell.TH.Quote

import Control.Monad.AnyCont
import Control.Monad.IO.Class

import Foreign.C
import Foreign.Ptr
import Foreign.Storable (Storable)
import qualified Foreign.Storable
import qualified Foreign.Marshal.Alloc
import qualified Foreign.Marshal.Array
import GHC.Stack

import qualified LLVM.Internal.FFI.LLVMCTypes as FFI

class EncodeM e h c where
  encodeM :: HasCallStack => h -> e c

class DecodeM d h c where
  decodeM :: HasCallStack => c -> d h

genCodingInstance :: (Data c, Data h) => TypeQ -> Name -> [(c, h)] -> Q [Dec]
genCodingInstance :: forall c h.
(Data c, Data h) =>
TypeQ -> Name -> [(c, h)] -> Q [Dec]
genCodingInstance TypeQ
ht Name
ctn [(c, h)]
chs = do
  let n :: b -> Maybe a
n = Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing
  [d| 
    instance Monad m => EncodeM m $(TypeQ
ht) $(Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
ctn) where
      encodeM h = return $(
        Q Exp -> [Q Match] -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
caseE [| h |] [ Q Pat -> Q Body -> [Q Dec] -> Q Match
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match ((forall b. Data b => b -> Maybe (Q Pat)) -> h -> Q Pat
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ b -> Maybe (Q Pat)
forall b. Data b => b -> Maybe (Q Pat)
forall {b} {a}. b -> Maybe a
n h
h) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB ((forall b. Data b => b -> Maybe (Q Exp)) -> c -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ b -> Maybe (Q Exp)
forall b. Data b => b -> Maybe (Q Exp)
forall {b} {a}. b -> Maybe a
n c
c)) [] | (c
c,h
h) <- [(c, h)]
chs ] 
       )

    instance Monad m => DecodeM m $(TypeQ
ht) $(Name -> TypeQ
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
ctn) where
      decodeM c = return $(
        Q Exp -> [Q Match] -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> [m Match] -> m Exp
caseE [| c |] ([ Q Pat -> Q Body -> [Q Dec] -> Q Match
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match ((forall b. Data b => b -> Maybe (Q Pat)) -> c -> Q Pat
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ b -> Maybe (Q Pat)
forall b. Data b => b -> Maybe (Q Pat)
forall {b} {a}. b -> Maybe a
n c
c) (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB ((forall b. Data b => b -> Maybe (Q Exp)) -> h -> Q Exp
forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ b -> Maybe (Q Exp)
forall b. Data b => b -> Maybe (Q Exp)
forall {b} {a}. b -> Maybe a
n h
h)) [] | (c
c,h
h) <- [(c, h)]
chs] [Q Match] -> [Q Match] -> [Q Match]
forall a. [a] -> [a] -> [a]
++
                       [ Q Pat -> Q Body -> [Q Dec] -> Q Match
forall (m :: * -> *).
Quote m =>
m Pat -> m Body -> [m Dec] -> m Match
match Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [e| error ("Decoding failed: Unknown " <> show c) |]) []]))
   |]

allocaArray :: (Integral i, Storable a, MonadAnyCont IO m) => i -> m (Ptr a)
allocaArray :: forall i a (m :: * -> *).
(Integral i, Storable a, MonadAnyCont IO m) =>
i -> m (Ptr a)
allocaArray i
p = (forall r. (Ptr a -> IO r) -> IO r) -> m (Ptr a)
forall a. (forall r. (a -> IO r) -> IO r) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. (Ptr a -> IO r) -> IO r) -> m (Ptr a))
-> (forall r. (Ptr a -> IO r) -> IO r) -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr a -> IO r) -> IO r
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
Foreign.Marshal.Array.allocaArray (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
p)

alloca :: (Storable a, MonadAnyCont IO m) => m (Ptr a)
alloca :: forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca = (forall r. (Ptr a -> IO r) -> IO r) -> m (Ptr a)
forall a. (forall r. (a -> IO r) -> IO r) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (Ptr a -> IO r) -> IO r
forall r. (Ptr a -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Foreign.Marshal.Alloc.alloca

peek :: (Storable a, MonadIO m) => Ptr a -> m a
peek :: forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek Ptr a
p = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
Foreign.Storable.peek Ptr a
p

peekByteOff :: (Storable a, MonadIO m) => Ptr a -> Int -> m a
peekByteOff :: forall a (m :: * -> *).
(Storable a, MonadIO m) =>
Ptr a -> Int -> m a
peekByteOff Ptr a
p Int
i = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Ptr a -> Int -> IO a
forall b. Ptr b -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
Foreign.Storable.peekByteOff Ptr a
p Int
i

poke :: (Storable a, MonadIO m) => Ptr a -> a -> m ()
poke :: forall a (m :: * -> *).
(Storable a, MonadIO m) =>
Ptr a -> a -> m ()
poke Ptr a
p a
a = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
Foreign.Storable.poke Ptr a
p a
a

pokeByteOff :: (Storable a, MonadIO m) => Ptr a -> Int -> a -> m ()
pokeByteOff :: forall a (m :: * -> *).
(Storable a, MonadIO m) =>
Ptr a -> Int -> a -> m ()
pokeByteOff Ptr a
p Int
i a
a = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr a -> Int -> a -> IO ()
forall b. Ptr b -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
Foreign.Storable.pokeByteOff Ptr a
p Int
i a
a

peekArray :: (Integral i, Storable a, MonadIO m) => i -> Ptr a -> m [a]
peekArray :: forall i a (m :: * -> *).
(Integral i, Storable a, MonadIO m) =>
i -> Ptr a -> m [a]
peekArray i
n Ptr a
p = IO [a] -> m [a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> m [a]) -> IO [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
Foreign.Marshal.Array.peekArray (i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n) Ptr a
p

instance (Monad m, EncodeM m h c, Storable c, MonadAnyCont IO m) => EncodeM m [h] (CUInt, Ptr c) where
  encodeM :: HasCallStack => [h] -> m (CUInt, Ptr c)
encodeM [h]
hs = do
    [c]
hs <- (h -> m c) -> [h] -> m [c]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM h -> m c
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM [h]
hs
    ((forall r. ((CUInt, Ptr c) -> IO r) -> IO r) -> m (CUInt, Ptr c)
forall a. (forall r. (a -> IO r) -> IO r) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM ((forall r. ((CUInt, Ptr c) -> IO r) -> IO r) -> m (CUInt, Ptr c))
-> (forall r. ((CUInt, Ptr c) -> IO r) -> IO r) -> m (CUInt, Ptr c)
forall a b. (a -> b) -> a -> b
$ \(CUInt, Ptr c) -> IO r
x -> [c] -> (Int -> Ptr c -> IO r) -> IO r
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
Foreign.Marshal.Array.withArrayLen [c]
hs ((Int -> Ptr c -> IO r) -> IO r) -> (Int -> Ptr c -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Int
n Ptr c
hs -> (CUInt, Ptr c) -> IO r
x (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n, Ptr c
hs))

instance (Monad m, DecodeM m h c, Storable c, MonadIO m) => DecodeM m [h] (CUInt, Ptr c) where
  decodeM :: HasCallStack => (CUInt, Ptr c) -> m [h]
decodeM (CUInt
n, Ptr c
ca) = do
    [c]
cs <- IO [c] -> m [c]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [c] -> m [c]) -> IO [c] -> m [c]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr c -> IO [c]
forall a. Storable a => Int -> Ptr a -> IO [a]
Foreign.Marshal.Array.peekArray (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
n) Ptr c
ca
    (c -> m h) -> [c] -> m [h]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM c -> m h
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM [c]
cs

instance Monad m => EncodeM m Bool FFI.LLVMBool where
  encodeM :: HasCallStack => Bool -> m LLVMBool
encodeM Bool
False = LLVMBool -> m LLVMBool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LLVMBool -> m LLVMBool) -> LLVMBool -> m LLVMBool
forall a b. (a -> b) -> a -> b
$ CUInt -> LLVMBool
FFI.LLVMBool CUInt
0
  encodeM Bool
True = LLVMBool -> m LLVMBool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LLVMBool -> m LLVMBool) -> LLVMBool -> m LLVMBool
forall a b. (a -> b) -> a -> b
$ CUInt -> LLVMBool
FFI.LLVMBool CUInt
1

instance Monad m => DecodeM m Bool FFI.LLVMBool where
  decodeM :: HasCallStack => LLVMBool -> m Bool
decodeM (FFI.LLVMBool CUInt
0) = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
False
  decodeM (FFI.LLVMBool CUInt
_) = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True

instance (Monad m, EncodeM m h (Ptr c)) => EncodeM m (Maybe h) (Ptr c) where
  encodeM :: HasCallStack => Maybe h -> m (Ptr c)
encodeM = m (Ptr c) -> (h -> m (Ptr c)) -> Maybe h -> m (Ptr c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Ptr c -> m (Ptr c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr c
forall a. Ptr a
nullPtr) h -> m (Ptr c)
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM

instance (Monad m, DecodeM m h (Ptr c)) => DecodeM m (Maybe h) (Ptr c) where
  decodeM :: HasCallStack => Ptr c -> m (Maybe h)
decodeM Ptr c
p | Ptr c
p Ptr c -> Ptr c -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr c
forall a. Ptr a
nullPtr = Maybe h -> m (Maybe h)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe h
forall a. Maybe a
Nothing
            | Bool
otherwise = (h -> Maybe h) -> m h -> m (Maybe h)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM h -> Maybe h
forall a. a -> Maybe a
Just (m h -> m (Maybe h)) -> m h -> m (Maybe h)
forall a b. (a -> b) -> a -> b
$ Ptr c -> m h
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM Ptr c
p

instance Monad m => EncodeM m (Maybe Bool) (FFI.NothingAsMinusOne Bool) where
  encodeM :: HasCallStack => Maybe Bool -> m (NothingAsMinusOne Bool)
encodeM = NothingAsMinusOne Bool -> m (NothingAsMinusOne Bool)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NothingAsMinusOne Bool -> m (NothingAsMinusOne Bool))
-> (Maybe Bool -> NothingAsMinusOne Bool)
-> Maybe Bool
-> m (NothingAsMinusOne Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> NothingAsMinusOne Bool
forall h. CInt -> NothingAsMinusOne h
FFI.NothingAsMinusOne (CInt -> NothingAsMinusOne Bool)
-> (Maybe Bool -> CInt) -> Maybe Bool -> NothingAsMinusOne Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> (Bool -> CInt) -> Maybe Bool -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
1) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum)

instance Monad m => EncodeM m (Maybe Word) (FFI.NothingAsMinusOne Word) where
  encodeM :: HasCallStack => Maybe Word -> m (NothingAsMinusOne Word)
encodeM = NothingAsMinusOne Word -> m (NothingAsMinusOne Word)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NothingAsMinusOne Word -> m (NothingAsMinusOne Word))
-> (Maybe Word -> NothingAsMinusOne Word)
-> Maybe Word
-> m (NothingAsMinusOne Word)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> NothingAsMinusOne Word
forall h. CInt -> NothingAsMinusOne h
FFI.NothingAsMinusOne (CInt -> NothingAsMinusOne Word)
-> (Maybe Word -> CInt) -> Maybe Word -> NothingAsMinusOne Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> (Word -> CInt) -> Maybe Word -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
1) Word -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => EncodeM m (Maybe Word32) (CUInt, FFI.LLVMBool) where
  encodeM :: HasCallStack => Maybe Word32 -> m (CUInt, LLVMBool)
encodeM (Just Word32
a) = (CUInt -> LLVMBool -> (CUInt, LLVMBool))
-> m CUInt -> m LLVMBool -> m (CUInt, LLVMBool)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Word32 -> m CUInt
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Word32
a) (Bool -> m LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Bool
True)
  encodeM Maybe Word32
Nothing = (CUInt
0,) (LLVMBool -> (CUInt, LLVMBool))
-> m LLVMBool -> m (CUInt, LLVMBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> m LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Bool
False

instance Monad m => EncodeM m (Maybe Word32) (Word32, FFI.LLVMBool) where
  encodeM :: HasCallStack => Maybe Word32 -> m (Word32, LLVMBool)
encodeM (Just Word32
a) = (Word32
a,) (LLVMBool -> (Word32, LLVMBool))
-> m LLVMBool -> m (Word32, LLVMBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> m LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Bool
True
  encodeM Maybe Word32
Nothing = (Word32
0,) (LLVMBool -> (Word32, LLVMBool))
-> m LLVMBool -> m (Word32, LLVMBool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> m LLVMBool
forall (e :: * -> *) h c. (EncodeM e h c, HasCallStack) => h -> e c
encodeM Bool
False

instance Monad m => EncodeM m Word CUInt where
  encodeM :: HasCallStack => Word -> m CUInt
encodeM = CUInt -> m CUInt
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> m CUInt) -> (Word -> CUInt) -> Word -> m CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => EncodeM m Word32 CUInt where
  encodeM :: HasCallStack => Word32 -> m CUInt
encodeM = CUInt -> m CUInt
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> m CUInt) -> (Word32 -> CUInt) -> Word32 -> m CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => EncodeM m Word64 CULong where
  encodeM :: HasCallStack => Word64 -> m CULong
encodeM = CULong -> m CULong
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CULong -> m CULong) -> (Word64 -> CULong) -> Word64 -> m CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => DecodeM m Word CUInt where
  decodeM :: HasCallStack => CUInt -> m Word
decodeM = Word -> m Word
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> m Word) -> (CUInt -> Word) -> CUInt -> m Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => DecodeM m Word32 CUInt where
  decodeM :: HasCallStack => CUInt -> m Word32
decodeM = Word32 -> m Word32
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> m Word32) -> (CUInt -> Word32) -> CUInt -> m Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => DecodeM m Word64 CULong where
  decodeM :: HasCallStack => CULong -> m Word64
decodeM = Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> m Word64) -> (CULong -> Word64) -> CULong -> m Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CULong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => EncodeM m Int32 CInt where
  encodeM :: HasCallStack => Int32 -> m CInt
encodeM = CInt -> m CInt
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> m CInt) -> (Int32 -> CInt) -> Int32 -> m CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => DecodeM m Int32 CInt where
  decodeM :: HasCallStack => CInt -> m Int32
decodeM = Int32 -> m Int32
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> m Int32) -> (CInt -> Int32) -> CInt -> m Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => DecodeM m Int CInt where
  decodeM :: HasCallStack => CInt -> m Int
decodeM = Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> (CInt -> Int) -> CInt -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Monad m => EncodeM m Word64 Word64 where
  encodeM :: HasCallStack => Word64 -> m Word64
encodeM = Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance Monad m => DecodeM m Word64 Word64 where
  decodeM :: HasCallStack => Word64 -> m Word64
decodeM = Word64 -> m Word64
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

decodeOptional :: (DecodeM m b a, Storable a, MonadAnyCont IO m, MonadIO m) => (Ptr a -> IO FFI.LLVMBool) -> m (Maybe b)
decodeOptional :: forall (m :: * -> *) b a.
(DecodeM m b a, Storable a, MonadAnyCont IO m, MonadIO m) =>
(Ptr a -> IO LLVMBool) -> m (Maybe b)
decodeOptional Ptr a -> IO LLVMBool
f = do
  Ptr a
ptr <- m (Ptr a)
forall a (m :: * -> *).
(Storable a, MonadAnyCont IO m) =>
m (Ptr a)
alloca
  Bool
isJust <- LLVMBool -> m Bool
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (LLVMBool -> m Bool) -> m LLVMBool -> m Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO LLVMBool -> m LLVMBool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ptr a -> IO LLVMBool
f Ptr a
ptr)
  if Bool
isJust
    then b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m b
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (a -> m b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr a -> m a
forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek Ptr a
ptr)
    else Maybe b -> m (Maybe b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing

decodeArray :: (DecodeM m b' b, MonadIO m) => (a -> IO CUInt) -> (a -> CUInt -> IO b) -> a -> m [b']
decodeArray :: forall (m :: * -> *) b' b a.
(DecodeM m b' b, MonadIO m) =>
(a -> IO CUInt) -> (a -> CUInt -> IO b) -> a -> m [b']
decodeArray a -> IO CUInt
numElems a -> CUInt -> IO b
getElem a
a = do
  CUInt
n <- IO CUInt -> m CUInt
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO CUInt
numElems a
a)
  if CUInt
n CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0
    then [b'] -> m [b']
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    else (CUInt -> m b') -> [CUInt] -> m [b']
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (b -> m b'
forall (d :: * -> *) h c. (DecodeM d h c, HasCallStack) => c -> d h
decodeM (b -> m b') -> (CUInt -> m b) -> CUInt -> m b'
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO b -> m b
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> (CUInt -> IO b) -> CUInt -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CUInt -> IO b
getElem a
a) [CUInt
0 .. CUInt
n CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
- CUInt
1]