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

-- Foreign functions operating on stacks
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)

-- In reality this fixes the type to be 'RClosure', but allows us to defer
-- the typechecker a bit and avoid a bunch of annoying type annotations.
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

-- In reality this fixes the type to be 'RClosure', but allows us to defer
-- the typechecker a bit and avoid a bunch of annoying type annotations.
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
"`"