{-# 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]