{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Unison.Runtime.Foreign.Function
( ForeignFunc (..),
ForeignConvention (..),
mkForeign,
)
where
import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar (MVar)
import Control.Concurrent.STM (TVar)
import Control.Exception (evaluate)
import Data.Atomics (Ticket)
import Data.Char qualified as Char
import Data.Foldable (toList)
import Data.IORef (IORef)
import Data.Primitive.Array as PA
import Data.Primitive.ByteArray as PA
import Data.Sequence qualified as Sq
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.IO.Exception (IOErrorType (..), IOException (..))
import Network.Socket (Socket)
import Network.UDP (UDPSocket)
import System.IO (BufferMode (..), Handle, IOMode, SeekMode)
import Unison.Builtin.Decls qualified as Ty
import Unison.Reference (Reference)
import Unison.Runtime.ANF (Mem (..), SuperGroup, Value, internalBug)
import Unison.Runtime.Exception
import Unison.Runtime.Foreign
import Unison.Runtime.MCode
import Unison.Runtime.Stack
import Unison.Symbol (Symbol)
import Unison.Type
( iarrayRef,
ibytearrayRef,
marrayRef,
mbytearrayRef,
mvarRef,
promiseRef,
refRef,
ticketRef,
tvarRef,
typeLinkRef,
)
import Unison.Util.Bytes (Bytes)
import Unison.Util.RefPromise (Promise)
import Unison.Util.Text (Text, pack, unpack)
data ForeignFunc where
FF ::
(Stack 'UN -> Stack 'BX -> Args -> IO a) ->
(Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX)) ->
(a -> IO r) ->
ForeignFunc
instance Show ForeignFunc where
show :: ForeignFunc -> String
show ForeignFunc
_ = String
"ForeignFunc"
instance Eq ForeignFunc where
ForeignFunc
_ == :: ForeignFunc -> ForeignFunc -> Bool
== ForeignFunc
_ = String -> Bool
forall a. HasCallStack => String -> a
internalBug String
"Eq ForeignFunc"
instance Ord ForeignFunc where
compare :: ForeignFunc -> ForeignFunc -> Ordering
compare ForeignFunc
_ ForeignFunc
_ = String -> Ordering
forall a. HasCallStack => String -> a
internalBug String
"Ord ForeignFunc"
class ForeignConvention a where
readForeign ::
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
writeForeign ::
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
mkForeign ::
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) ->
ForeignFunc
mkForeign :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign a -> IO r
ev = (Stack 'UN -> Stack 'BX -> Args -> IO a)
-> (Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX))
-> (a -> IO r)
-> ForeignFunc
forall a r.
(Stack 'UN -> Stack 'BX -> Args -> IO a)
-> (Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX))
-> (a -> IO r)
-> ForeignFunc
FF Stack 'UN -> Stack 'BX -> Args -> IO a
forall {b}.
ForeignConvention b =>
Stack 'UN -> Stack 'BX -> Args -> IO b
readArgs Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign a -> IO r
ev
where
readArgs :: Stack 'UN -> Stack 'BX -> Args -> IO b
readArgs Stack 'UN
ustk Stack 'BX
bstk (Args -> ([Int], [Int])
argsToLists -> ([Int]
us, [Int]
bs)) =
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk IO ([Int], [Int], b) -> (([Int], [Int], b) -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
([], [], b
a) -> b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a
([Int], [Int], b)
_ ->
String -> IO b
forall a. HasCallStack => String -> a
internalBug
String
"mkForeign: too many arguments for foreign function"
instance ForeignConvention Int where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Int)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
_ = ([Int]
us,[Int]
bs,) (Int -> ([Int], [Int], Int)) -> IO Int -> IO ([Int], [Int], Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'UN -> Int -> IO (Elem 'UN)
forall (b :: Mem). MEM b => Stack b -> Int -> IO (Elem b)
peekOff Stack 'UN
ustk Int
i
readForeign [] [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], Int)
forall a. String -> IO a
foreignCCError String
"Int"
writeForeign :: Stack 'UN -> Stack 'BX -> Int -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk Int
i = do
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
i
instance ForeignConvention Word64 where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], ConstructorId)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
_ = ([Int]
us,[Int]
bs,) (ConstructorId -> ([Int], [Int], ConstructorId))
-> IO ConstructorId -> IO ([Int], [Int], ConstructorId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'UN -> Int -> IO ConstructorId
peekOffN Stack 'UN
ustk Int
i
readForeign [] [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], ConstructorId)
forall a. String -> IO a
foreignCCError String
"Word64"
writeForeign :: Stack 'UN
-> Stack 'BX -> ConstructorId -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk ConstructorId
n = do
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> ConstructorId -> IO ()
pokeN Stack 'UN
ustk ConstructorId
n
instance ForeignConvention Word8 where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Word8)
readForeign = (ConstructorId -> Word8)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Word8)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (ConstructorId -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word8)
writeForeign :: Stack 'UN -> Stack 'BX -> Word8 -> IO (Stack 'UN, Stack 'BX)
writeForeign = (Word8 -> ConstructorId)
-> Stack 'UN -> Stack 'BX -> Word8 -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Word8 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Word64)
instance ForeignConvention Word16 where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Word16)
readForeign = (ConstructorId -> Word16)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Word16)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (ConstructorId -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word16)
writeForeign :: Stack 'UN -> Stack 'BX -> Word16 -> IO (Stack 'UN, Stack 'BX)
writeForeign = (Word16 -> ConstructorId)
-> Stack 'UN -> Stack 'BX -> Word16 -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Word16 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Word64)
instance ForeignConvention Word32 where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Word32)
readForeign = (ConstructorId -> Word32)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Word32)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (ConstructorId -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Word32)
writeForeign :: Stack 'UN -> Stack 'BX -> Word32 -> IO (Stack 'UN, Stack 'BX)
writeForeign = (Word32 -> ConstructorId)
-> Stack 'UN -> Stack 'BX -> Word32 -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Word32 -> ConstructorId
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Word64)
instance ForeignConvention Char where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Char)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
_ = ([Int]
us,[Int]
bs,) (Char -> ([Int], [Int], Char))
-> (Int -> Char) -> Int -> ([Int], [Int], Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char
Char.chr (Int -> ([Int], [Int], Char)) -> IO Int -> IO ([Int], [Int], Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'UN -> Int -> IO (Elem 'UN)
forall (b :: Mem). MEM b => Stack b -> Int -> IO (Elem b)
peekOff Stack 'UN
ustk Int
i
readForeign [] [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], Char)
forall a. String -> IO a
foreignCCError String
"Char"
writeForeign :: Stack 'UN -> Stack 'BX -> Char -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk Char
ch = do
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk (Char -> Int
Char.ord Char
ch)
instance (GClosure comb ~ Elem 'BX) => ForeignConvention (GClosure comb) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], GClosure comb)
readForeign [Int]
us (Int
i : [Int]
bs) Stack 'UN
_ Stack 'BX
bstk = ([Int]
us,[Int]
bs,) (GClosure comb -> ([Int], [Int], GClosure comb))
-> IO (GClosure comb) -> IO ([Int], [Int], GClosure comb)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'BX -> Int -> IO (Elem 'BX)
forall (b :: Mem). MEM b => Stack b -> Int -> IO (Elem b)
peekOff Stack 'BX
bstk Int
i
readForeign [Int]
_ [] Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], GClosure comb)
forall a. String -> IO a
foreignCCError String
"Closure"
writeForeign :: Stack 'UN
-> Stack 'BX -> GClosure comb -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk GClosure comb
c = do
Stack 'BX
bstk <- Stack 'BX -> IO (Stack 'BX)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'BX
bstk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Stack 'BX -> Elem 'BX -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'BX
bstk (GClosure comb -> IO ()) -> IO (GClosure comb) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GClosure comb -> IO (GClosure comb)
forall a. a -> IO a
evaluate GClosure comb
c)
instance ForeignConvention Text where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Text)
readForeign = [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Text)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> Text -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> Text -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention Bytes where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Bytes)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Bytes)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> Bytes -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> Bytes -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention Socket where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Socket)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Socket)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> Socket -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> Socket -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention UDPSocket where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], UDPSocket)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], UDPSocket)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> UDPSocket -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> UDPSocket -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention ThreadId where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], ThreadId)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], ThreadId)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> ThreadId -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> ThreadId -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention Handle where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Handle)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Handle)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> Handle -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> Handle -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention POSIXTime where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], POSIXTime)
readForeign = (Int -> POSIXTime)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], POSIXTime)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> POSIXTime)
writeForeign :: Stack 'UN -> Stack 'BX -> POSIXTime -> IO (Stack 'UN, Stack 'BX)
writeForeign = (POSIXTime -> Int)
-> Stack 'UN -> Stack 'BX -> POSIXTime -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (POSIXTime -> Int
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round :: POSIXTime -> Int)
instance (ForeignConvention a) => ForeignConvention (Maybe a) where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Maybe a)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
bstk =
Stack 'UN -> Int -> IO (Elem 'UN)
forall (b :: Mem). MEM b => Stack b -> Int -> IO (Elem b)
peekOff Stack 'UN
ustk Int
i IO Int
-> (Int -> IO ([Int], [Int], Maybe a))
-> IO ([Int], [Int], Maybe a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Int
0 -> ([Int], [Int], Maybe a) -> IO ([Int], [Int], Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, Maybe a
forall a. Maybe a
Nothing)
Int
1 -> (a -> Maybe a) -> ([Int], [Int], a) -> ([Int], [Int], Maybe a)
forall a b. (a -> b) -> ([Int], [Int], a) -> ([Int], [Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (([Int], [Int], a) -> ([Int], [Int], Maybe a))
-> IO ([Int], [Int], a) -> IO ([Int], [Int], Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
Int
_ -> String -> IO ([Int], [Int], Maybe a)
forall a. String -> IO a
foreignCCError String
"Maybe"
readForeign [] [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], Maybe a)
forall a. String -> IO a
foreignCCError String
"Maybe"
writeForeign :: Stack 'UN -> Stack 'BX -> Maybe a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk Maybe a
Nothing = do
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
0
writeForeign Stack 'UN
ustk Stack 'BX
bstk (Just a
x) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
x
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
1
instance
(ForeignConvention a, ForeignConvention b) =>
ForeignConvention (Either a b)
where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Either a b)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
bstk =
Stack 'UN -> Int -> IO (Elem 'UN)
forall (b :: Mem). MEM b => Stack b -> Int -> IO (Elem b)
peekOff Stack 'UN
ustk Int
i IO Int
-> (Int -> IO ([Int], [Int], Either a b))
-> IO ([Int], [Int], Either a b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Int
0 -> (a -> Either a b)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Either a b)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs a -> Either a b
forall a b. a -> Either a b
Left [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
Int
1 -> (b -> Either a b)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Either a b)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs b -> Either a b
forall a b. b -> Either a b
Right [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
Int
_ -> String -> IO ([Int], [Int], Either a b)
forall a. String -> IO a
foreignCCError String
"Either"
readForeign [Int]
_ [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], Either a b)
forall a. String -> IO a
foreignCCError String
"Either"
writeForeign :: Stack 'UN -> Stack 'BX -> Either a b -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (Left a
a) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
a
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
0
writeForeign Stack 'UN
ustk Stack 'BX
bstk (Right b
b) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk b
b
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
1
ioeDecode :: Int -> IOErrorType
ioeDecode :: Int -> IOErrorType
ioeDecode Int
0 = IOErrorType
AlreadyExists
ioeDecode Int
1 = IOErrorType
NoSuchThing
ioeDecode Int
2 = IOErrorType
ResourceBusy
ioeDecode Int
3 = IOErrorType
ResourceExhausted
ioeDecode Int
4 = IOErrorType
EOF
ioeDecode Int
5 = IOErrorType
IllegalOperation
ioeDecode Int
6 = IOErrorType
PermissionDenied
ioeDecode Int
7 = IOErrorType
UserError
ioeDecode Int
_ = String -> IOErrorType
forall a. HasCallStack => String -> a
internalBug String
"ioeDecode"
ioeEncode :: IOErrorType -> Int
ioeEncode :: IOErrorType -> Int
ioeEncode IOErrorType
AlreadyExists = Int
0
ioeEncode IOErrorType
NoSuchThing = Int
1
ioeEncode IOErrorType
ResourceBusy = Int
2
ioeEncode IOErrorType
ResourceExhausted = Int
3
ioeEncode IOErrorType
EOF = Int
4
ioeEncode IOErrorType
IllegalOperation = Int
5
ioeEncode IOErrorType
PermissionDenied = Int
6
ioeEncode IOErrorType
UserError = Int
7
ioeEncode IOErrorType
_ = String -> Int
forall a. HasCallStack => String -> a
internalBug String
"ioeDecode"
instance ForeignConvention IOException where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], IOException)
readForeign = (Int -> IOException)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], IOException)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (IOErrorType -> IOException
bld (IOErrorType -> IOException)
-> (Int -> IOErrorType) -> Int -> IOException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IOErrorType
ioeDecode)
where
bld :: IOErrorType -> IOException
bld IOErrorType
t = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
t String
"" String
"" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
writeForeign :: Stack 'UN -> Stack 'BX -> IOException -> IO (Stack 'UN, Stack 'BX)
writeForeign = (IOException -> Int)
-> Stack 'UN
-> Stack 'BX
-> IOException
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (IOErrorType -> Int
ioeEncode (IOErrorType -> Int)
-> (IOException -> IOErrorType) -> IOException -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> IOErrorType
ioe_type)
readForeignAs ::
(ForeignConvention a) =>
(a -> b) ->
[Int] ->
[Int] ->
Stack 'UN ->
Stack 'BX ->
IO ([Int], [Int], b)
readForeignAs :: forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs a -> b
f [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk = (a -> b) -> ([Int], [Int], a) -> ([Int], [Int], b)
forall a b. (a -> b) -> ([Int], [Int], a) -> ([Int], [Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (([Int], [Int], a) -> ([Int], [Int], b))
-> IO ([Int], [Int], a) -> IO ([Int], [Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
writeForeignAs ::
(ForeignConvention b) =>
(a -> b) ->
Stack 'UN ->
Stack 'BX ->
a ->
IO (Stack 'UN, Stack 'BX)
writeForeignAs :: forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs a -> b
f Stack 'UN
ustk Stack 'BX
bstk a
x = Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (a -> b
f a
x)
readForeignEnum ::
(Enum a) =>
[Int] ->
[Int] ->
Stack 'UN ->
Stack 'BX ->
IO ([Int], [Int], a)
readForeignEnum :: forall a.
Enum a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeignEnum = (Int -> a)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs Int -> a
forall a. Enum a => Int -> a
toEnum
writeForeignEnum ::
(Enum a) =>
Stack 'UN ->
Stack 'BX ->
a ->
IO (Stack 'UN, Stack 'BX)
writeForeignEnum :: forall a.
Enum a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignEnum = (a -> Int)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs a -> Int
forall a. Enum a => a -> Int
fromEnum
readForeignBuiltin ::
(BuiltinForeign b) =>
[Int] ->
[Int] ->
Stack 'UN ->
Stack 'BX ->
IO ([Int], [Int], b)
readForeignBuiltin :: forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin = (GClosure RComb -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> b
forall f. BuiltinForeign f => Foreign -> f
unwrapBuiltin (Foreign -> b)
-> (GClosure RComb -> Foreign) -> GClosure RComb -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeignBuiltin ::
(BuiltinForeign b) =>
Stack 'UN ->
Stack 'BX ->
b ->
IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin :: forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin = (b -> GClosure RComb)
-> Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (b -> Foreign) -> b -> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Foreign
forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin)
writeTypeLink ::
Stack 'UN ->
Stack 'BX ->
Reference ->
IO (Stack 'UN, Stack 'BX)
writeTypeLink :: Stack 'UN -> Stack 'BX -> Reference -> IO (Stack 'UN, Stack 'BX)
writeTypeLink = (Reference -> GClosure RComb)
-> Stack 'UN -> Stack 'BX -> Reference -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (Reference -> Foreign) -> Reference -> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Reference -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
typeLinkRef)
readTypelink ::
[Int] ->
[Int] ->
Stack 'UN ->
Stack 'BX ->
IO ([Int], [Int], Reference)
readTypelink :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Reference)
readTypelink = (GClosure RComb -> Reference)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Reference)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> Reference
forall a. Foreign -> a
unwrapForeign (Foreign -> Reference)
-> (GClosure RComb -> Foreign) -> GClosure RComb -> Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
instance ForeignConvention Double where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Double)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
_ = ([Int]
us,[Int]
bs,) (Double -> ([Int], [Int], Double))
-> IO Double -> IO ([Int], [Int], Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'UN -> Int -> IO Double
peekOffD Stack 'UN
ustk Int
i
readForeign [Int]
_ [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], Double)
forall a. String -> IO a
foreignCCError String
"Double"
writeForeign :: Stack 'UN -> Stack 'BX -> Double -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk Double
d =
Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk IO (Stack 'UN)
-> (Stack 'UN -> IO (Stack 'UN, Stack 'BX))
-> IO (Stack 'UN, Stack 'BX)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Stack 'UN
ustk ->
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Double -> IO ()
pokeD Stack 'UN
ustk Double
d
instance ForeignConvention Bool where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Bool)
readForeign = [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Bool)
forall a.
Enum a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeignEnum
writeForeign :: Stack 'UN -> Stack 'BX -> Bool -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> Bool -> IO (Stack 'UN, Stack 'BX)
forall a.
Enum a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignEnum
instance ForeignConvention String where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], String)
readForeign = (Text -> String)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], String)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs Text -> String
unpack
writeForeign :: Stack 'UN -> Stack 'BX -> String -> IO (Stack 'UN, Stack 'BX)
writeForeign = (String -> Text)
-> Stack 'UN -> Stack 'BX -> String -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs String -> Text
pack
instance ForeignConvention SeekMode where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], SeekMode)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], SeekMode)
forall a.
Enum a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeignEnum
writeForeign :: Stack 'UN -> Stack 'BX -> SeekMode -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> SeekMode -> IO (Stack 'UN, Stack 'BX)
forall a.
Enum a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignEnum
instance ForeignConvention IOMode where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], IOMode)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], IOMode)
forall a.
Enum a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeignEnum
writeForeign :: Stack 'UN -> Stack 'BX -> IOMode -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> IOMode -> IO (Stack 'UN, Stack 'BX)
forall a.
Enum a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignEnum
instance ForeignConvention () where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], ())
readForeign [Int]
us [Int]
bs Stack 'UN
_ Stack 'BX
_ = ([Int], [Int], ()) -> IO ([Int], [Int], ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, ())
writeForeign :: Stack 'UN -> Stack 'BX -> () -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk ()
_ = (Stack 'UN, Stack 'BX) -> IO (Stack 'UN, Stack 'BX)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stack 'UN
ustk, Stack 'BX
bstk)
instance
(ForeignConvention a, ForeignConvention b) =>
ForeignConvention (a, b)
where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], (a, b))
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk = do
([Int]
us, [Int]
bs, a
a) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, b
b) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int], [Int], (a, b)) -> IO ([Int], [Int], (a, b))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, (a
a, b
b))
writeForeign :: Stack 'UN -> Stack 'BX -> (a, b) -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (a
x, b
y) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk b
y
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
x
instance (ForeignConvention a) => ForeignConvention (Failure a) where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Failure a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk = do
([Int]
us, [Int]
bs, Reference
typeref) <- [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Reference)
readTypelink [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, Text
message) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Text)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, a
any) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int], [Int], Failure a) -> IO ([Int], [Int], Failure a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, Reference -> Text -> a -> Failure a
forall a. Reference -> Text -> a -> Failure a
Failure Reference
typeref Text
message a
any)
writeForeign :: Stack 'UN -> Stack 'BX -> Failure a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (Failure Reference
typeref Text
message a
any) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
any
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> Text -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk Text
message
Stack 'UN -> Stack 'BX -> Reference -> IO (Stack 'UN, Stack 'BX)
writeTypeLink Stack 'UN
ustk Stack 'BX
bstk Reference
typeref
instance
( ForeignConvention a,
ForeignConvention b,
ForeignConvention c
) =>
ForeignConvention (a, b, c)
where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], (a, b, c))
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk = do
([Int]
us, [Int]
bs, a
a) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, b
b) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, c
c) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], c)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int], [Int], (a, b, c)) -> IO ([Int], [Int], (a, b, c))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, (a
a, b
b, c
c))
writeForeign :: Stack 'UN -> Stack 'BX -> (a, b, c) -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (a
a, b
b, c
c) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> c -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk c
c
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk b
b
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
a
instance
( ForeignConvention a,
ForeignConvention b,
ForeignConvention c,
ForeignConvention d
) =>
ForeignConvention (a, b, c, d)
where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], (a, b, c, d))
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk = do
([Int]
us, [Int]
bs, a
a) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, b
b) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, c
c) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], c)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, d
d) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], d)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int], [Int], (a, b, c, d)) -> IO ([Int], [Int], (a, b, c, d))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, (a
a, b
b, c
c, d
d))
writeForeign :: Stack 'UN -> Stack 'BX -> (a, b, c, d) -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (a
a, b
b, c
c, d
d) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> d -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk d
d
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> c -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk c
c
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk b
b
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
a
instance
( ForeignConvention a,
ForeignConvention b,
ForeignConvention c,
ForeignConvention d,
ForeignConvention e
) =>
ForeignConvention (a, b, c, d, e)
where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], (a, b, c, d, e))
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk = do
([Int]
us, [Int]
bs, a
a) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, b
b) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, c
c) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], c)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, d
d) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], d)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int]
us, [Int]
bs, e
e) <- [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], e)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
([Int], [Int], (a, b, c, d, e))
-> IO ([Int], [Int], (a, b, c, d, e))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, (a
a, b
b, c
c, d
d, e
e))
writeForeign :: Stack 'UN
-> Stack 'BX -> (a, b, c, d, e) -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk (a
a, b
b, c
c, d
d, e
e) = do
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> e -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk e
e
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> d -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk d
d
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> c -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk c
c
(Stack 'UN
ustk, Stack 'BX
bstk) <- Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk b
b
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
forall a.
ForeignConvention a =>
Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk a
a
no'buf, line'buf, block'buf, sblock'buf :: Int
no'buf :: Int
no'buf = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeNoBufferingId
line'buf :: Int
line'buf = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeLineBufferingId
block'buf :: Int
block'buf = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeBlockBufferingId
sblock'buf :: Int
sblock'buf = ConstructorId -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ConstructorId
Ty.bufferModeSizedBlockBufferingId
instance ForeignConvention BufferMode where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], BufferMode)
readForeign (Int
i : [Int]
us) [Int]
bs Stack 'UN
ustk Stack 'BX
bstk =
Stack 'UN -> Int -> IO (Elem 'UN)
forall (b :: Mem). MEM b => Stack b -> Int -> IO (Elem b)
peekOff Stack 'UN
ustk Int
i IO Int
-> (Int -> IO ([Int], [Int], BufferMode))
-> IO ([Int], [Int], BufferMode)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Int
t
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
no'buf -> ([Int], [Int], BufferMode) -> IO ([Int], [Int], BufferMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, BufferMode
NoBuffering)
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line'buf -> ([Int], [Int], BufferMode) -> IO ([Int], [Int], BufferMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, BufferMode
LineBuffering)
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
block'buf -> ([Int], [Int], BufferMode) -> IO ([Int], [Int], BufferMode)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
us, [Int]
bs, Maybe Int -> BufferMode
BlockBuffering Maybe Int
forall a. Maybe a
Nothing)
| Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sblock'buf ->
(Int -> BufferMode)
-> ([Int], [Int], Int) -> ([Int], [Int], BufferMode)
forall a b. (a -> b) -> ([Int], [Int], a) -> ([Int], [Int], b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Int -> BufferMode
BlockBuffering (Maybe Int -> BufferMode)
-> (Int -> Maybe Int) -> Int -> BufferMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just)
(([Int], [Int], Int) -> ([Int], [Int], BufferMode))
-> IO ([Int], [Int], Int) -> IO ([Int], [Int], BufferMode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Int)
forall a.
ForeignConvention a =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], a)
readForeign [Int]
us [Int]
bs Stack 'UN
ustk Stack 'BX
bstk
| Bool
otherwise ->
String -> IO ([Int], [Int], BufferMode)
forall a. String -> IO a
foreignCCError (String -> IO ([Int], [Int], BufferMode))
-> String -> IO ([Int], [Int], BufferMode)
forall a b. (a -> b) -> a -> b
$
String
"BufferMode (unknown tag: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
readForeign [Int]
_ [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], BufferMode)
forall a. String -> IO a
foreignCCError (String -> IO ([Int], [Int], BufferMode))
-> String -> IO ([Int], [Int], BufferMode)
forall a b. (a -> b) -> a -> b
$ String
"BufferMode (empty stack)"
writeForeign :: Stack 'UN -> Stack 'BX -> BufferMode -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk BufferMode
bm =
Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk IO (Stack 'UN)
-> (Stack 'UN -> IO (Stack 'UN, Stack 'BX))
-> IO (Stack 'UN, Stack 'BX)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Stack 'UN
ustk ->
case BufferMode
bm of
BufferMode
NoBuffering -> (Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
no'buf
BufferMode
LineBuffering -> (Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
line'buf
BlockBuffering Maybe Int
Nothing -> (Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
block'buf
BlockBuffering (Just Int
n) -> do
Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
n
Stack 'UN
ustk <- Stack 'UN -> IO (Stack 'UN)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'UN
ustk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'UN -> Elem 'UN -> IO ()
forall (b :: Mem). MEM b => Stack b -> Elem b -> IO ()
poke Stack 'UN
ustk Int
Elem 'UN
sblock'buf
instance (GClosure comb ~ Elem 'BX) => ForeignConvention [GClosure comb] where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], [GClosure comb])
readForeign [Int]
us (Int
i : [Int]
bs) Stack 'UN
_ Stack 'BX
bstk =
([Int]
us,[Int]
bs,) ([GClosure comb] -> ([Int], [Int], [GClosure comb]))
-> (Seq (GClosure comb) -> [GClosure comb])
-> Seq (GClosure comb)
-> ([Int], [Int], [GClosure comb])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (GClosure comb) -> [GClosure comb]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (GClosure comb) -> ([Int], [Int], [GClosure comb]))
-> IO (Seq (GClosure comb)) -> IO ([Int], [Int], [GClosure comb])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'BX -> Int -> IO (Seq (GClosure RComb))
peekOffS Stack 'BX
bstk Int
i
readForeign [Int]
_ [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], [GClosure comb])
forall a. String -> IO a
foreignCCError String
"[Closure]"
writeForeign :: Stack 'UN
-> Stack 'BX -> [GClosure comb] -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk [GClosure comb]
l = do
Stack 'BX
bstk <- Stack 'BX -> IO (Stack 'BX)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'BX
bstk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'BX -> Seq (GClosure RComb) -> IO ()
pokeS Stack 'BX
bstk ([GClosure RComb] -> Seq (GClosure RComb)
forall a. [a] -> Seq a
Sq.fromList [GClosure comb]
[GClosure RComb]
l)
instance ForeignConvention [Foreign] where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], [Foreign])
readForeign = ([GClosure RComb] -> [Foreign])
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], [Foreign])
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs ((GClosure RComb -> Foreign) -> [GClosure RComb] -> [Foreign]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN -> Stack 'BX -> [Foreign] -> IO (Stack 'UN, Stack 'BX)
writeForeign = ([Foreign] -> [GClosure RComb])
-> Stack 'UN -> Stack 'BX -> [Foreign] -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs ((Foreign -> GClosure RComb) -> [Foreign] -> [GClosure RComb]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign)
instance ForeignConvention (MVar RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], MVar (GClosure RComb))
readForeign = (GClosure RComb -> MVar (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], MVar (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> MVar (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> MVar (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> MVar (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX -> MVar (GClosure RComb) -> IO (Stack 'UN, Stack 'BX)
writeForeign = (MVar (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> MVar (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (MVar (GClosure RComb) -> Foreign)
-> MVar (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> MVar (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
mvarRef)
instance ForeignConvention (TVar RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], TVar (GClosure RComb))
readForeign = (GClosure RComb -> TVar (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], TVar (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> TVar (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> TVar (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> TVar (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX -> TVar (GClosure RComb) -> IO (Stack 'UN, Stack 'BX)
writeForeign = (TVar (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> TVar (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (TVar (GClosure RComb) -> Foreign)
-> TVar (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> TVar (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
tvarRef)
instance ForeignConvention (IORef RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], IORef (GClosure RComb))
readForeign = (GClosure RComb -> IORef (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], IORef (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> IORef (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> IORef (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> IORef (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX -> IORef (GClosure RComb) -> IO (Stack 'UN, Stack 'BX)
writeForeign = (IORef (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> IORef (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (IORef (GClosure RComb) -> Foreign)
-> IORef (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> IORef (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
refRef)
instance ForeignConvention (Ticket RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Ticket (GClosure RComb))
readForeign = (GClosure RComb -> Ticket (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Ticket (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> Ticket (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> Ticket (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> Ticket (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX
-> Ticket (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
writeForeign = (Ticket (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> Ticket (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (Ticket (GClosure RComb) -> Foreign)
-> Ticket (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Ticket (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
ticketRef)
instance ForeignConvention (Promise RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Promise (GClosure RComb))
readForeign = (GClosure RComb -> Promise (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Promise (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> Promise (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> Promise (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> Promise (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX
-> Promise (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
writeForeign = (Promise (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> Promise (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (Promise (GClosure RComb) -> Foreign)
-> Promise (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Promise (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
promiseRef)
instance ForeignConvention (SuperGroup Symbol) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], SuperGroup Symbol)
readForeign = [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], SuperGroup Symbol)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN
-> Stack 'BX -> SuperGroup Symbol -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN
-> Stack 'BX -> SuperGroup Symbol -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention Value where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Value)
readForeign = [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Value)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> Value -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> Value -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
instance ForeignConvention Foreign where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], Foreign)
readForeign = (GClosure RComb -> Foreign)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Foreign)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign
writeForeign :: Stack 'UN -> Stack 'BX -> Foreign -> IO (Stack 'UN, Stack 'BX)
writeForeign = (Foreign -> GClosure RComb)
-> Stack 'UN -> Stack 'BX -> Foreign -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign
instance ForeignConvention (PA.MutableArray s RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], MutableArray s (GClosure RComb))
readForeign = (GClosure RComb -> MutableArray s (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], MutableArray s (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> MutableArray s (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> MutableArray s (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> MutableArray s (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX
-> MutableArray s (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
writeForeign = (MutableArray s (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> MutableArray s (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (MutableArray s (GClosure RComb) -> Foreign)
-> MutableArray s (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> MutableArray s (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
marrayRef)
instance ForeignConvention (PA.MutableByteArray s) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], MutableByteArray s)
readForeign = (GClosure RComb -> MutableByteArray s)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], MutableByteArray s)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> MutableByteArray s
forall a. Foreign -> a
unwrapForeign (Foreign -> MutableByteArray s)
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> MutableByteArray s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX -> MutableByteArray s -> IO (Stack 'UN, Stack 'BX)
writeForeign = (MutableByteArray s -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> MutableByteArray s
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (MutableByteArray s -> Foreign)
-> MutableByteArray s
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> MutableByteArray s -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
mbytearrayRef)
instance ForeignConvention (PA.Array RClosure) where
readForeign :: [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Array (GClosure RComb))
readForeign = (GClosure RComb -> Array (GClosure RComb))
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], Array (GClosure RComb))
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> Array (GClosure RComb)
forall a. Foreign -> a
unwrapForeign (Foreign -> Array (GClosure RComb))
-> (GClosure RComb -> Foreign)
-> GClosure RComb
-> Array (GClosure RComb)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN
-> Stack 'BX -> Array (GClosure RComb) -> IO (Stack 'UN, Stack 'BX)
writeForeign = (Array (GClosure RComb) -> GClosure RComb)
-> Stack 'UN
-> Stack 'BX
-> Array (GClosure RComb)
-> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (Array (GClosure RComb) -> Foreign)
-> Array (GClosure RComb)
-> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Array (GClosure RComb) -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
iarrayRef)
instance ForeignConvention PA.ByteArray where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], ByteArray)
readForeign = (GClosure RComb -> ByteArray)
-> [Int]
-> [Int]
-> Stack 'UN
-> Stack 'BX
-> IO ([Int], [Int], ByteArray)
forall a b.
ForeignConvention a =>
(a -> b)
-> [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignAs (Foreign -> ByteArray
forall a. Foreign -> a
unwrapForeign (Foreign -> ByteArray)
-> (GClosure RComb -> Foreign) -> GClosure RComb -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign)
writeForeign :: Stack 'UN -> Stack 'BX -> ByteArray -> IO (Stack 'UN, Stack 'BX)
writeForeign = (ByteArray -> GClosure RComb)
-> Stack 'UN -> Stack 'BX -> ByteArray -> IO (Stack 'UN, Stack 'BX)
forall b a.
ForeignConvention b =>
(a -> b)
-> Stack 'UN -> Stack 'BX -> a -> IO (Stack 'UN, Stack 'BX)
writeForeignAs (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (ByteArray -> Foreign) -> ByteArray -> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> ByteArray -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
ibytearrayRef)
instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention b where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeign = [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
forall b.
BuiltinForeign b =>
[Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], b)
readForeignBuiltin
writeForeign :: Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeign = Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
forall b.
BuiltinForeign b =>
Stack 'UN -> Stack 'BX -> b -> IO (Stack 'UN, Stack 'BX)
writeForeignBuiltin
fromUnisonPair :: RClosure -> (a, b)
fromUnisonPair :: forall a b. GClosure RComb -> (a, b)
fromUnisonPair (DataC Reference
_ ConstructorId
_ [] [GClosure RComb
x, DataC Reference
_ ConstructorId
_ [] [GClosure RComb
y, GClosure RComb
_]]) =
(GClosure RComb -> a
forall a. GClosure RComb -> a
unwrapForeignClosure GClosure RComb
x, GClosure RComb -> b
forall a. GClosure RComb -> a
unwrapForeignClosure GClosure RComb
y)
fromUnisonPair GClosure RComb
_ = String -> (a, b)
forall a. HasCallStack => String -> a
error String
"fromUnisonPair: invalid closure"
toUnisonPair ::
(BuiltinForeign a, BuiltinForeign b) => (a, b) -> RClosure
toUnisonPair :: forall a b.
(BuiltinForeign a, BuiltinForeign b) =>
(a, b) -> GClosure RComb
toUnisonPair (a
x, b
y) =
Reference
-> ConstructorId -> [Int] -> [GClosure RComb] -> GClosure RComb
DataC
Reference
Ty.pairRef
ConstructorId
0
[]
[a -> GClosure RComb
forall {f} {comb}. BuiltinForeign f => f -> GClosure comb
wr a
x, Reference
-> ConstructorId -> [Int] -> [GClosure RComb] -> GClosure RComb
DataC Reference
Ty.pairRef ConstructorId
0 [] [b -> GClosure RComb
forall {f} {comb}. BuiltinForeign f => f -> GClosure comb
wr b
y, GClosure RComb
un]]
where
un :: GClosure RComb
un = Reference
-> ConstructorId -> [Int] -> [GClosure RComb] -> GClosure RComb
DataC Reference
Ty.unitRef ConstructorId
0 [] []
wr :: f -> GClosure comb
wr f
z = Foreign -> GClosure comb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure comb) -> Foreign -> GClosure comb
forall a b. (a -> b) -> a -> b
$ f -> Foreign
forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin f
z
unwrapForeignClosure :: RClosure -> a
unwrapForeignClosure :: forall a. GClosure RComb -> a
unwrapForeignClosure = Foreign -> a
forall a. Foreign -> a
unwrapForeign (Foreign -> a)
-> (GClosure RComb -> Foreign) -> GClosure RComb -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => GClosure RComb -> Foreign
GClosure RComb -> Foreign
marshalToForeign
instance {-# OVERLAPPABLE #-} (BuiltinForeign a, BuiltinForeign b) => ForeignConvention [(a, b)] where
readForeign :: [Int]
-> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], [(a, b)])
readForeign [Int]
us (Int
i : [Int]
bs) Stack 'UN
_ Stack 'BX
bstk =
([Int]
us,[Int]
bs,)
([(a, b)] -> ([Int], [Int], [(a, b)]))
-> (Seq (GClosure RComb) -> [(a, b)])
-> Seq (GClosure RComb)
-> ([Int], [Int], [(a, b)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GClosure RComb -> (a, b)) -> [GClosure RComb] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GClosure RComb -> (a, b)
forall a b. GClosure RComb -> (a, b)
fromUnisonPair
([GClosure RComb] -> [(a, b)])
-> (Seq (GClosure RComb) -> [GClosure RComb])
-> Seq (GClosure RComb)
-> [(a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (GClosure RComb) -> [GClosure RComb]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
(Seq (GClosure RComb) -> ([Int], [Int], [(a, b)]))
-> IO (Seq (GClosure RComb)) -> IO ([Int], [Int], [(a, b)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'BX -> Int -> IO (Seq (GClosure RComb))
peekOffS Stack 'BX
bstk Int
i
readForeign [Int]
_ [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], [(a, b)])
forall a. String -> IO a
foreignCCError String
"[(a,b)]"
writeForeign :: Stack 'UN -> Stack 'BX -> [(a, b)] -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk [(a, b)]
l = do
Stack 'BX
bstk <- Stack 'BX -> IO (Stack 'BX)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'BX
bstk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'BX -> Seq (GClosure RComb) -> IO ()
pokeS Stack 'BX
bstk ((a, b) -> GClosure RComb
forall a b.
(BuiltinForeign a, BuiltinForeign b) =>
(a, b) -> GClosure RComb
toUnisonPair ((a, b) -> GClosure RComb) -> Seq (a, b) -> Seq (GClosure RComb)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, b)] -> Seq (a, b)
forall a. [a] -> Seq a
Sq.fromList [(a, b)]
l)
instance {-# OVERLAPPABLE #-} (BuiltinForeign b) => ForeignConvention [b] where
readForeign :: [Int] -> [Int] -> Stack 'UN -> Stack 'BX -> IO ([Int], [Int], [b])
readForeign [Int]
us (Int
i : [Int]
bs) Stack 'UN
_ Stack 'BX
bstk =
([Int]
us,[Int]
bs,)
([b] -> ([Int], [Int], [b]))
-> (Seq (GClosure RComb) -> [b])
-> Seq (GClosure RComb)
-> ([Int], [Int], [b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GClosure RComb -> b) -> [GClosure RComb] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GClosure RComb -> b
forall a. GClosure RComb -> a
unwrapForeignClosure
([GClosure RComb] -> [b])
-> (Seq (GClosure RComb) -> [GClosure RComb])
-> Seq (GClosure RComb)
-> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (GClosure RComb) -> [GClosure RComb]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
(Seq (GClosure RComb) -> ([Int], [Int], [b]))
-> IO (Seq (GClosure RComb)) -> IO ([Int], [Int], [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack 'BX -> Int -> IO (Seq (GClosure RComb))
peekOffS Stack 'BX
bstk Int
i
readForeign [Int]
_ [Int]
_ Stack 'UN
_ Stack 'BX
_ = String -> IO ([Int], [Int], [b])
forall a. String -> IO a
foreignCCError String
"[b]"
writeForeign :: Stack 'UN -> Stack 'BX -> [b] -> IO (Stack 'UN, Stack 'BX)
writeForeign Stack 'UN
ustk Stack 'BX
bstk [b]
l = do
Stack 'BX
bstk <- Stack 'BX -> IO (Stack 'BX)
forall (b :: Mem). MEM b => Stack b -> IO (Stack b)
bump Stack 'BX
bstk
(Stack 'UN
ustk, Stack 'BX
bstk) (Stack 'UN, Stack 'BX) -> IO () -> IO (Stack 'UN, Stack 'BX)
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack 'BX -> Seq (GClosure RComb) -> IO ()
pokeS Stack 'BX
bstk (Foreign -> GClosure RComb
forall comb. Foreign -> GClosure comb
Foreign (Foreign -> GClosure RComb)
-> (b -> Foreign) -> b -> GClosure RComb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Foreign
forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin (b -> GClosure RComb) -> Seq b -> Seq (GClosure RComb)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b] -> Seq b
forall a. [a] -> Seq a
Sq.fromList [b]
l)
foreignCCError :: String -> IO a
foreignCCError :: forall a. String -> IO a
foreignCCError String
nm =
String -> IO a
forall a. HasCallStack => String -> IO a
die (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"mismatched foreign calling convention for `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"`"