{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Unison.Runtime.Builtin
  ( builtinLookup,
    builtinTermNumbering,
    builtinTypeNumbering,
    builtinTermBackref,
    builtinTypeBackref,
    builtinForeigns,
    sandboxedForeigns,
    numberedTermLookup,
    Sandbox (..),
    baseSandboxInfo,
  )
where

import Control.Concurrent (ThreadId)
import Control.Concurrent as SYS
  ( killThread,
    threadDelay,
  )
import Control.Concurrent.MVar as SYS
import Control.Concurrent.STM qualified as STM
import Control.DeepSeq (NFData)
import Control.Exception (evaluate)
import Control.Exception.Safe qualified as Exception
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Primitive qualified as PA
import Control.Monad.Reader (ReaderT (..), ask, runReaderT)
import Control.Monad.State.Strict (State, execState, modify)
import Crypto.Error (CryptoError (..), CryptoFailable (..))
import Crypto.Hash qualified as Hash
import Crypto.MAC.HMAC qualified as HMAC
import Crypto.PubKey.Ed25519 qualified as Ed25519
import Crypto.PubKey.RSA.PKCS15 qualified as RSA
import Crypto.Random (getRandomBytes)
import Data.Bits (shiftL, shiftR, (.|.))
import Unison.Runtime.Builtin.Types
import Data.ByteArray qualified as BA
import Data.ByteString (hGet, hGetSome, hPut)
import Data.ByteString.Lazy qualified as L
import Data.Default (def)
import Data.Digest.Murmur64 (asWord64, hash64)
import Data.IORef as SYS
  ( IORef,
    newIORef,
    readIORef,
    writeIORef,
  )
import Data.IP (IP)
import Data.Map qualified as Map
import Data.PEM (PEM, pemContent, pemParseLBS)
import Data.Set (insert)
import Data.Set qualified as Set
import Data.Text qualified
import Data.Text.IO qualified as Text.IO
import Data.Time.Clock.POSIX as SYS
  ( getPOSIXTime,
    posixSecondsToUTCTime,
    utcTimeToPOSIXSeconds,
  )
import Data.Time.LocalTime (TimeZone (..), getTimeZone)
import Data.X509 qualified as X
import Data.X509.CertificateStore qualified as X
import Data.X509.Memory qualified as X
import GHC.Conc qualified as STM
import GHC.IO (IO (IO))
import Network.Simple.TCP as SYS
  ( HostPreference (..),
    bindSock,
    closeSock,
    connectSock,
    listenSock,
    recv,
    send,
  )
import Network.Socket as SYS
  ( PortNumber,
    Socket,
    accept,
    socketPort,
  )
import Network.TLS as TLS
import Network.TLS.Extra.Cipher as Cipher
import Network.UDP as UDP
  ( ClientSockAddr,
    ListenSocket,
    UDPSocket (..),
    clientSocket,
    close,
    recv,
    recvFrom,
    send,
    sendTo,
    serverSocket,
    stop,
  )
import System.Clock (Clock (..), getTime, nsec, sec)
import System.Directory as SYS
  ( createDirectoryIfMissing,
    doesDirectoryExist,
    doesPathExist,
    getCurrentDirectory,
    getDirectoryContents,
    getFileSize,
    getModificationTime,
    getTemporaryDirectory,
    removeDirectoryRecursive,
    removeFile,
    renameDirectory,
    renameFile,
    setCurrentDirectory,
  )
import System.Environment as SYS
  ( getArgs,
    getEnv,
  )
import System.Exit as SYS (ExitCode (..))
import System.FilePath (isPathSeparator)
import System.IO (Handle)
import System.IO as SYS
  ( IOMode (..),
    hClose,
    hGetBuffering,
    hGetChar,
    hGetEcho,
    hIsEOF,
    hIsOpen,
    hIsSeekable,
    hReady,
    hSeek,
    hSetBuffering,
    hSetEcho,
    hTell,
    openFile,
    stderr,
    stdin,
    stdout,
  )
import System.IO.Temp (createTempDirectory)
import System.Process as SYS
  ( getProcessExitCode,
    proc,
    runInteractiveProcess,
    terminateProcess,
    waitForProcess,
    withCreateProcess,
  )
import System.X509 qualified as X
import Unison.ABT.Normalized hiding (TTm)
import Unison.Builtin.Decls qualified as Ty
import Unison.Prelude hiding (Text, some)
import Unison.Reference
import Unison.Referent (Referent, pattern Ref)
import Unison.Runtime.ANF as ANF
import Unison.Runtime.ANF.Rehash (checkGroupHashes)
import Unison.Runtime.ANF.Serialize as ANF
import Unison.Runtime.Array qualified as PA
import Unison.Runtime.Crypto.Rsa as Rsa
import Unison.Runtime.Exception (die)
import Unison.Runtime.Foreign
  ( Foreign (Wrap),
    HashAlgorithm (..),
    pattern Failure,
  )
import Unison.Runtime.Foreign qualified as F
import Unison.Runtime.Foreign.Function
import Unison.Runtime.Stack (Closure)
import Unison.Runtime.Stack qualified as Closure
import Unison.Symbol
import Unison.Type (charRef)
import Unison.Type qualified as Ty
import Unison.Util.Bytes qualified as Bytes
import Unison.Util.EnumContainers as EC
import Unison.Util.RefPromise
  ( Promise,
    Ticket,
    casIORef,
    newPromise,
    peekTicket,
    readForCAS,
    readPromise,
    tryReadPromise,
    writePromise,
  )
import Unison.Util.Text (Text)
import Unison.Util.Text qualified as Util.Text
import Unison.Util.Text.Pattern qualified as TPat
import Unison.Var

type Failure = F.Failure Closure

freshes :: (Var v) => Int -> [v]
freshes :: forall v. Var v => Int -> [v]
freshes = Set v -> Int -> [v]
forall v. Var v => Set v -> Int -> [v]
freshes' Set v
forall a. Monoid a => a
mempty

freshes' :: (Var v) => Set v -> Int -> [v]
freshes' :: forall v. Var v => Set v -> Int -> [v]
freshes' Set v
avoid0 = Set v -> [v] -> Int -> [v]
forall {t} {a}. (Num t, Var a, Eq t) => Set a -> [a] -> t -> [a]
go Set v
avoid0 []
  where
    go :: Set a -> [a] -> t -> [a]
go Set a
_ [a]
vs t
0 = [a]
vs
    go Set a
avoid [a]
vs t
n =
      let v :: a
v = Set a -> a -> a
forall v. Var v => Set v -> v -> v
freshIn Set a
avoid (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Type -> a
forall v. Var v => Type -> v
typed Type
ANFBlank
       in Set a -> [a] -> t -> [a]
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
insert a
v Set a
avoid) (a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
vs) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)

class Fresh t where fresh :: t

fresh1 :: (Var v) => v
fresh1 :: forall v. Var v => v
fresh1 = [v] -> v
forall a. HasCallStack => [a] -> a
head ([v] -> v) -> [v] -> v
forall a b. (a -> b) -> a -> b
$ Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
1

instance (Var v) => Fresh (v, v) where
  fresh :: (v, v)
fresh = (v
v1, v
v2)
    where
      [v
v1, v
v2] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
2

instance (Var v) => Fresh (v, v, v) where
  fresh :: (v, v, v)
fresh = (v
v1, v
v2, v
v3)
    where
      [v
v1, v
v2, v
v3] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
3

instance (Var v) => Fresh (v, v, v, v) where
  fresh :: (v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4)
    where
      [v
v1, v
v2, v
v3, v
v4] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
4

instance (Var v) => Fresh (v, v, v, v, v) where
  fresh :: (v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
5

instance (Var v) => Fresh (v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
6

instance (Var v) => Fresh (v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
7

instance (Var v) => Fresh (v, v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
8

instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
9

instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
10

instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10, v
v11)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10, v
v11] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
11

instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10, v
v11, v
v12, v
v13)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10, v
v11, v
v12, v
v13] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
13

instance (Var v) => Fresh (v, v, v, v, v, v, v, v, v, v, v, v, v, v) where
  fresh :: (v, v, v, v, v, v, v, v, v, v, v, v, v, v)
fresh = (v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10, v
v11, v
v12, v
v13, v
v14)
    where
      [v
v1, v
v2, v
v3, v
v4, v
v5, v
v6, v
v7, v
v8, v
v9, v
v10, v
v11, v
v12, v
v13, v
v14] = Int -> [v]
forall v. Var v => Int -> [v]
freshes Int
14

fls, tru :: (Var v) => ANormal v
fls :: forall v. Var v => ANormal v
fls = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
0 []
tru :: forall v. Var v => ANormal v
tru = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
1 []

none :: (Var v) => ANormal v
none :: forall v. Var v => ANormal v
none = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.optionalRef (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.noneId) []

some, left, right :: (Var v) => v -> ANormal v
some :: forall v. Var v => v -> ANormal v
some v
a = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.optionalRef (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.someId) [v
a]
left :: forall v. Var v => v -> ANormal v
left v
x = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.eitherRef (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.eitherLeftId) [v
x]
right :: forall v. Var v => v -> ANormal v
right v
x = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.eitherRef (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.eitherRightId) [v
x]

seqViewEmpty :: (Var v) => ANormal v
seqViewEmpty :: forall v. Var v => ANormal v
seqViewEmpty = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.seqViewRef (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.seqViewEmpty) []

seqViewElem :: (Var v) => v -> v -> ANormal v
seqViewElem :: forall v. Var v => v -> v -> ANormal v
seqViewElem v
l v
r = Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.seqViewRef (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.seqViewElem) [v
l, v
r]

boolift :: (Var v) => v -> ANormal v
boolift :: forall v. Var v => v -> ANormal v
boolift v
v =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (Term ANormalF v)
-> Maybe (Term ANormalF v) -> Branched (Term ANormalF v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral ([(Word64, Term ANormalF v)] -> EnumMap Word64 (Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(Word64
0, Term ANormalF v
forall v. Var v => ANormal v
fls), (Word64
1, Term ANormalF v
forall v. Var v => ANormal v
tru)]) Maybe (Term ANormalF v)
forall a. Maybe a
Nothing

notlift :: (Var v) => v -> ANormal v
notlift :: forall v. Var v => v -> ANormal v
notlift v
v =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v (Branched (Term ANormalF v) -> Term ANormalF v)
-> Branched (Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (Term ANormalF v)
-> Maybe (Term ANormalF v) -> Branched (Term ANormalF v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral ([(Word64, Term ANormalF v)] -> EnumMap Word64 (Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(Word64
1, Term ANormalF v
forall v. Var v => ANormal v
fls), (Word64
0, Term ANormalF v
forall v. Var v => ANormal v
tru)]) Maybe (Term ANormalF v)
forall a. Maybe a
Nothing

unbox :: (Var v) => v -> Reference -> v -> ANormal v -> ANormal v
unbox :: forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
v0 Reference
r v
v ANormal v
b =
  v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v0 (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$
    Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
r (CTag -> ([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
mapSingleton CTag
0 (([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v))
-> ([Mem], ANormal v) -> EnumMap CTag ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ ([Mem
UN], v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
v ANormal v
b)) Maybe (ANormal v)
forall a. Maybe a
Nothing

unenum :: (Var v) => Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum :: forall v.
Var v =>
Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum Int
n v
v0 Reference
r v
v ANormal v
nx =
  v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
v0 (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
r EnumMap CTag ([Mem], ANormal v)
cases Maybe (ANormal v)
forall a. Maybe a
Nothing
  where
    mkCase :: Int -> (CTag, ([Mem], ANormal v))
mkCase Int
i = (Int -> CTag
forall a. Enum a => Int -> a
toEnum Int
i, ([], v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
v Mem
UN (Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> (Int64 -> Lit) -> Int64 -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Lit
I (Int64 -> ANormal v) -> Int64 -> ANormal v
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) ANormal v
nx))
    cases :: EnumMap CTag ([Mem], ANormal v)
cases = [(CTag, ([Mem], ANormal v))] -> EnumMap CTag ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList ([(CTag, ([Mem], ANormal v))] -> EnumMap CTag ([Mem], ANormal v))
-> ([Int] -> [(CTag, ([Mem], ANormal v))])
-> [Int]
-> EnumMap CTag ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> (CTag, ([Mem], ANormal v)))
-> [Int] -> [(CTag, ([Mem], ANormal v))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> (CTag, ([Mem], ANormal v))
mkCase ([Int] -> EnumMap CTag ([Mem], ANormal v))
-> [Int] -> EnumMap CTag ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

unop0 :: (Var v) => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 :: forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
n [v] -> ANormal v
f =
  [Mem] -> ANormal v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX]
    (ANormal v -> SuperNormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> SuperNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
x0]
    (ANormal v -> SuperNormal v) -> ANormal v -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal v
f [v]
xs
  where
    xs :: [v]
xs@(v
x0 : [v]
_) = Int -> [v]
forall v. Var v => Int -> [v]
freshes (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

binop0 :: (Var v) => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 :: forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
n [v] -> ANormal v
f =
  [Mem] -> ANormal v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX, Mem
BX]
    (ANormal v -> SuperNormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> SuperNormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
x0, v
y0]
    (ANormal v -> SuperNormal v) -> ANormal v -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ [v] -> ANormal v
f [v]
xs
  where
    xs :: [v]
xs@(v
x0 : v
y0 : [v]
_) = Int -> [v]
forall v. Var v => Int -> [v]
freshes (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

unop :: (Var v) => POp -> Reference -> SuperNormal v
unop :: forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
pop Reference
rf = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
pop Reference
rf Reference
rf

unop' :: (Var v) => POp -> Reference -> Reference -> SuperNormal v
unop' :: forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
pop Reference
rfi Reference
rfo =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
2 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
x, v
r] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
rfi v
x
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
r Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
x])
      (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
rfo CTag
0 [v
r]

binop :: (Var v) => POp -> Reference -> SuperNormal v
binop :: forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
pop Reference
rf = POp -> Reference -> Reference -> Reference -> SuperNormal v
forall v.
Var v =>
POp -> Reference -> Reference -> Reference -> SuperNormal v
binop' POp
pop Reference
rf Reference
rf Reference
rf

binop' ::
  (Var v) =>
  POp ->
  Reference ->
  Reference ->
  Reference ->
  SuperNormal v
binop' :: forall v.
Var v =>
POp -> Reference -> Reference -> Reference -> SuperNormal v
binop' POp
pop Reference
rfx Reference
rfy Reference
rfr =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y0, v
x, v
y, v
r] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
rfx v
x
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
y0 Reference
rfy v
y
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
r Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
x, v
y])
      (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
rfr CTag
0 [v
r]

cmpop :: (Var v) => POp -> Reference -> SuperNormal v
cmpop :: forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
pop Reference
rf =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y0, v
x, v
y, v
b] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
rf v
x
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
y0 Reference
rf v
y
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
x, v
y])
      (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
boolift v
b

cmpopb :: (Var v) => POp -> Reference -> SuperNormal v
cmpopb :: forall v. Var v => POp -> Reference -> SuperNormal v
cmpopb POp
pop Reference
rf =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y0, v
x, v
y, v
b] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
rf v
x
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
y0 Reference
rf v
y
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
y, v
x])
      (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
boolift v
b

cmpopn :: (Var v) => POp -> Reference -> SuperNormal v
cmpopn :: forall v. Var v => POp -> Reference -> SuperNormal v
cmpopn POp
pop Reference
rf =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y0, v
x, v
y, v
b] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
rf v
x
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
y0 Reference
rf v
y
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
x, v
y])
      (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
notlift v
b

cmpopbn :: (Var v) => POp -> Reference -> SuperNormal v
cmpopbn :: forall v. Var v => POp -> Reference -> SuperNormal v
cmpopbn POp
pop Reference
rf =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y0, v
x, v
y, v
b] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
rf v
x
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
y0 Reference
rf v
y
      (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
y, v
x])
      (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
notlift v
b

addi, subi, muli, divi, modi, shli, shri, powi :: (Var v) => SuperNormal v
addi :: forall v. Var v => SuperNormal v
addi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
ADDI Reference
Ty.intRef
subi :: forall v. Var v => SuperNormal v
subi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
SUBI Reference
Ty.intRef
muli :: forall v. Var v => SuperNormal v
muli = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MULI Reference
Ty.intRef
divi :: forall v. Var v => SuperNormal v
divi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
DIVI Reference
Ty.intRef
modi :: forall v. Var v => SuperNormal v
modi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MODI Reference
Ty.intRef
shli :: forall v. Var v => SuperNormal v
shli = POp -> Reference -> Reference -> Reference -> SuperNormal v
forall v.
Var v =>
POp -> Reference -> Reference -> Reference -> SuperNormal v
binop' POp
SHLI Reference
Ty.intRef Reference
Ty.natRef Reference
Ty.intRef
shri :: forall v. Var v => SuperNormal v
shri = POp -> Reference -> Reference -> Reference -> SuperNormal v
forall v.
Var v =>
POp -> Reference -> Reference -> Reference -> SuperNormal v
binop' POp
SHRI Reference
Ty.intRef Reference
Ty.natRef Reference
Ty.intRef
powi :: forall v. Var v => SuperNormal v
powi = POp -> Reference -> Reference -> Reference -> SuperNormal v
forall v.
Var v =>
POp -> Reference -> Reference -> Reference -> SuperNormal v
binop' POp
POWI Reference
Ty.intRef Reference
Ty.natRef Reference
Ty.intRef

addn, subn, muln, divn, modn, shln, shrn, pown :: (Var v) => SuperNormal v
addn :: forall v. Var v => SuperNormal v
addn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
ADDN Reference
Ty.natRef
subn :: forall v. Var v => SuperNormal v
subn = POp -> Reference -> Reference -> Reference -> SuperNormal v
forall v.
Var v =>
POp -> Reference -> Reference -> Reference -> SuperNormal v
binop' POp
SUBN Reference
Ty.natRef Reference
Ty.natRef Reference
Ty.intRef
muln :: forall v. Var v => SuperNormal v
muln = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MULN Reference
Ty.natRef
divn :: forall v. Var v => SuperNormal v
divn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
DIVN Reference
Ty.natRef
modn :: forall v. Var v => SuperNormal v
modn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MODN Reference
Ty.natRef
shln :: forall v. Var v => SuperNormal v
shln = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
SHLN Reference
Ty.natRef
shrn :: forall v. Var v => SuperNormal v
shrn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
SHRN Reference
Ty.natRef
pown :: forall v. Var v => SuperNormal v
pown = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
POWN Reference
Ty.natRef

eqi, eqn, lti, ltn, lei, len :: (Var v) => SuperNormal v
eqi :: forall v. Var v => SuperNormal v
eqi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
EQLI Reference
Ty.intRef
lti :: forall v. Var v => SuperNormal v
lti = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopbn POp
LEQI Reference
Ty.intRef
lei :: forall v. Var v => SuperNormal v
lei = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
LEQI Reference
Ty.intRef
eqn :: forall v. Var v => SuperNormal v
eqn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
EQLN Reference
Ty.natRef
ltn :: forall v. Var v => SuperNormal v
ltn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopbn POp
LEQN Reference
Ty.natRef
len :: forall v. Var v => SuperNormal v
len = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
LEQN Reference
Ty.natRef

gti, gtn, gei, gen :: (Var v) => SuperNormal v
gti :: forall v. Var v => SuperNormal v
gti = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopn POp
LEQI Reference
Ty.intRef
gei :: forall v. Var v => SuperNormal v
gei = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopb POp
LEQI Reference
Ty.intRef
gtn :: forall v. Var v => SuperNormal v
gtn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopn POp
LEQN Reference
Ty.intRef
gen :: forall v. Var v => SuperNormal v
gen = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopb POp
LEQN Reference
Ty.intRef

inci, incn :: (Var v) => SuperNormal v
inci :: forall v. Var v => SuperNormal v
inci = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
INCI Reference
Ty.intRef
incn :: forall v. Var v => SuperNormal v
incn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
INCN Reference
Ty.natRef

sgni, negi :: (Var v) => SuperNormal v
sgni :: forall v. Var v => SuperNormal v
sgni = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
SGNI Reference
Ty.intRef
negi :: forall v. Var v => SuperNormal v
negi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
NEGI Reference
Ty.intRef

lzeron, tzeron, lzeroi, tzeroi, popn, popi :: (Var v) => SuperNormal v
lzeron :: forall v. Var v => SuperNormal v
lzeron = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
LZRO Reference
Ty.natRef
tzeron :: forall v. Var v => SuperNormal v
tzeron = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
TZRO Reference
Ty.natRef
popn :: forall v. Var v => SuperNormal v
popn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
POPC Reference
Ty.natRef
popi :: forall v. Var v => SuperNormal v
popi = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
POPC Reference
Ty.intRef Reference
Ty.natRef
lzeroi :: forall v. Var v => SuperNormal v
lzeroi = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
LZRO Reference
Ty.intRef Reference
Ty.natRef
tzeroi :: forall v. Var v => SuperNormal v
tzeroi = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
TZRO Reference
Ty.intRef Reference
Ty.natRef

andn, orn, xorn, compln, andi, ori, xori, compli :: (Var v) => SuperNormal v
andn :: forall v. Var v => SuperNormal v
andn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
ANDN Reference
Ty.natRef
orn :: forall v. Var v => SuperNormal v
orn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
IORN Reference
Ty.natRef
xorn :: forall v. Var v => SuperNormal v
xorn = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
XORN Reference
Ty.natRef
compln :: forall v. Var v => SuperNormal v
compln = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
COMN Reference
Ty.natRef
andi :: forall v. Var v => SuperNormal v
andi = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
ANDN Reference
Ty.intRef
ori :: forall v. Var v => SuperNormal v
ori = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
IORN Reference
Ty.intRef
xori :: forall v. Var v => SuperNormal v
xori = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
XORN Reference
Ty.intRef
compli :: forall v. Var v => SuperNormal v
compli = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
COMN Reference
Ty.intRef

addf,
  subf,
  mulf,
  divf,
  powf,
  sqrtf,
  logf,
  logbf ::
    (Var v) => SuperNormal v
addf :: forall v. Var v => SuperNormal v
addf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
ADDF Reference
Ty.floatRef
subf :: forall v. Var v => SuperNormal v
subf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
SUBF Reference
Ty.floatRef
mulf :: forall v. Var v => SuperNormal v
mulf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MULF Reference
Ty.floatRef
divf :: forall v. Var v => SuperNormal v
divf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
DIVF Reference
Ty.floatRef
powf :: forall v. Var v => SuperNormal v
powf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
POWF Reference
Ty.floatRef
sqrtf :: forall v. Var v => SuperNormal v
sqrtf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
SQRT Reference
Ty.floatRef
logf :: forall v. Var v => SuperNormal v
logf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
LOGF Reference
Ty.floatRef
logbf :: forall v. Var v => SuperNormal v
logbf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
LOGB Reference
Ty.floatRef

expf, absf :: (Var v) => SuperNormal v
expf :: forall v. Var v => SuperNormal v
expf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
EXPF Reference
Ty.floatRef
absf :: forall v. Var v => SuperNormal v
absf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ABSF Reference
Ty.floatRef

cosf, sinf, tanf, acosf, asinf, atanf :: (Var v) => SuperNormal v
cosf :: forall v. Var v => SuperNormal v
cosf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
COSF Reference
Ty.floatRef
sinf :: forall v. Var v => SuperNormal v
sinf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
SINF Reference
Ty.floatRef
tanf :: forall v. Var v => SuperNormal v
tanf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
TANF Reference
Ty.floatRef
acosf :: forall v. Var v => SuperNormal v
acosf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ACOS Reference
Ty.floatRef
asinf :: forall v. Var v => SuperNormal v
asinf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ASIN Reference
Ty.floatRef
atanf :: forall v. Var v => SuperNormal v
atanf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ATAN Reference
Ty.floatRef

coshf,
  sinhf,
  tanhf,
  acoshf,
  asinhf,
  atanhf,
  atan2f ::
    (Var v) => SuperNormal v
coshf :: forall v. Var v => SuperNormal v
coshf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
COSH Reference
Ty.floatRef
sinhf :: forall v. Var v => SuperNormal v
sinhf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
SINH Reference
Ty.floatRef
tanhf :: forall v. Var v => SuperNormal v
tanhf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
TANH Reference
Ty.floatRef
acoshf :: forall v. Var v => SuperNormal v
acoshf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ACSH Reference
Ty.floatRef
asinhf :: forall v. Var v => SuperNormal v
asinhf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ASNH Reference
Ty.floatRef
atanhf :: forall v. Var v => SuperNormal v
atanhf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
unop POp
ATNH Reference
Ty.floatRef
atan2f :: forall v. Var v => SuperNormal v
atan2f = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
ATN2 Reference
Ty.floatRef

ltf, gtf, lef, gef, eqf, neqf :: (Var v) => SuperNormal v
ltf :: forall v. Var v => SuperNormal v
ltf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopbn POp
LEQF Reference
Ty.floatRef
gtf :: forall v. Var v => SuperNormal v
gtf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopn POp
LEQF Reference
Ty.floatRef
lef :: forall v. Var v => SuperNormal v
lef = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
LEQF Reference
Ty.floatRef
gef :: forall v. Var v => SuperNormal v
gef = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopb POp
LEQF Reference
Ty.floatRef
eqf :: forall v. Var v => SuperNormal v
eqf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpop POp
EQLF Reference
Ty.floatRef
neqf :: forall v. Var v => SuperNormal v
neqf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
cmpopn POp
EQLF Reference
Ty.floatRef

minf, maxf :: (Var v) => SuperNormal v
minf :: forall v. Var v => SuperNormal v
minf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MINF Reference
Ty.floatRef
maxf :: forall v. Var v => SuperNormal v
maxf = POp -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> SuperNormal v
binop POp
MAXF Reference
Ty.floatRef

ceilf, floorf, truncf, roundf, i2f, n2f :: (Var v) => SuperNormal v
ceilf :: forall v. Var v => SuperNormal v
ceilf = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
CEIL Reference
Ty.floatRef Reference
Ty.intRef
floorf :: forall v. Var v => SuperNormal v
floorf = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
FLOR Reference
Ty.floatRef Reference
Ty.intRef
truncf :: forall v. Var v => SuperNormal v
truncf = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
TRNF Reference
Ty.floatRef Reference
Ty.intRef
roundf :: forall v. Var v => SuperNormal v
roundf = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
RNDF Reference
Ty.floatRef Reference
Ty.intRef
i2f :: forall v. Var v => SuperNormal v
i2f = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
ITOF Reference
Ty.intRef Reference
Ty.floatRef
n2f :: forall v. Var v => SuperNormal v
n2f = POp -> Reference -> Reference -> SuperNormal v
forall v. Var v => POp -> Reference -> Reference -> SuperNormal v
unop' POp
NTOF Reference
Ty.natRef Reference
Ty.floatRef

trni :: (Var v) => SuperNormal v
trni :: forall v. Var v => SuperNormal v
trni = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
x, v
z, v
b] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.intRef v
x
    (ANormal v -> ANormal v)
-> (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
z Mem
UN (Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> Lit -> ANormal v
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit
I Int64
0)
    (ANormal v -> ANormal v)
-> (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LEQI [v
x, v
z])
    (ANormal v -> ANormal v)
-> (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
b
    (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
      (Word64 -> ANormal v -> EnumMap Word64 (ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
mapSingleton Word64
1 (ANormal v -> EnumMap Word64 (ANormal v))
-> ANormal v -> EnumMap Word64 (ANormal v)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
z])
      (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just (ANormal v -> Maybe (ANormal v)) -> ANormal v -> Maybe (ANormal v)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
x])

modular :: (Var v) => POp -> (Bool -> ANormal v) -> SuperNormal v
modular :: forall v. Var v => POp -> (Bool -> ANormal v) -> SuperNormal v
modular POp
pop Bool -> ANormal v
ret =
  Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
x, v
m, v
t] ->
    v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.intRef v
x
      (ANormal v -> ANormal v)
-> (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> Lit -> ANormal v
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit
I Int64
2)
      (ANormal v -> ANormal v)
-> (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
m Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
pop [v
x, v
t])
      (ANormal v -> ANormal v)
-> (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
m
      (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
        (Word64 -> ANormal v -> EnumMap Word64 (ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
mapSingleton Word64
1 (ANormal v -> EnumMap Word64 (ANormal v))
-> ANormal v -> EnumMap Word64 (ANormal v)
forall a b. (a -> b) -> a -> b
$ Bool -> ANormal v
ret Bool
True)
        (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just (ANormal v -> Maybe (ANormal v)) -> ANormal v -> Maybe (ANormal v)
forall a b. (a -> b) -> a -> b
$ Bool -> ANormal v
ret Bool
False)

evni, evnn, oddi, oddn :: (Var v) => SuperNormal v
evni :: forall v. Var v => SuperNormal v
evni = POp -> (Bool -> ANormal v) -> SuperNormal v
forall v. Var v => POp -> (Bool -> ANormal v) -> SuperNormal v
modular POp
MODI (\Bool
b -> if Bool
b then ANormal v
forall v. Var v => ANormal v
fls else ANormal v
forall v. Var v => ANormal v
tru)
oddi :: forall v. Var v => SuperNormal v
oddi = POp -> (Bool -> ANormal v) -> SuperNormal v
forall v. Var v => POp -> (Bool -> ANormal v) -> SuperNormal v
modular POp
MODI (\Bool
b -> if Bool
b then ANormal v
forall v. Var v => ANormal v
tru else ANormal v
forall v. Var v => ANormal v
fls)
evnn :: forall v. Var v => SuperNormal v
evnn = POp -> (Bool -> ANormal v) -> SuperNormal v
forall v. Var v => POp -> (Bool -> ANormal v) -> SuperNormal v
modular POp
MODN (\Bool
b -> if Bool
b then ANormal v
forall v. Var v => ANormal v
fls else ANormal v
forall v. Var v => ANormal v
tru)
oddn :: forall v. Var v => SuperNormal v
oddn = POp -> (Bool -> ANormal v) -> SuperNormal v
forall v. Var v => POp -> (Bool -> ANormal v) -> SuperNormal v
modular POp
MODN (\Bool
b -> if Bool
b then ANormal v
forall v. Var v => ANormal v
tru else ANormal v
forall v. Var v => ANormal v
fls)

dropn :: (Var v) => SuperNormal v
dropn :: forall v. Var v => SuperNormal v
dropn = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
4 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y0, v
x, v
y, v
b, v
r] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.natRef v
x
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
y0 Reference
Ty.natRef v
y
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LEQN [v
x, v
y])
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction Word16 -> v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
Direction Word16
-> v
-> Mem
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLet
      (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
1)
      v
r
      Mem
UN
      ( v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
b (Branched (ANormal v) -> ANormal v)
-> Branched (ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$
          EnumMap Word64 (ANormal v)
-> Maybe (ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
            (Word64 -> ANormal v -> EnumMap Word64 (ANormal v)
forall k a. EnumKey k => k -> a -> EnumMap k a
mapSingleton Word64
1 (ANormal v -> EnumMap Word64 (ANormal v))
-> ANormal v -> EnumMap Word64 (ANormal v)
forall a b. (a -> b) -> a -> b
$ Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> Lit -> ANormal v
forall a b. (a -> b) -> a -> b
$ Word64 -> Lit
N Word64
0)
            (ANormal v -> Maybe (ANormal v)
forall a. a -> Maybe a
Just (ANormal v -> Maybe (ANormal v)) -> ANormal v -> Maybe (ANormal v)
forall a b. (a -> b) -> a -> b
$ POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SUBN [v
x, v
y])
      )
    (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
r]

appendt, taket, dropt, indext, indexb, sizet, unconst, unsnoct :: (Var v) => SuperNormal v
appendt :: forall v. Var v => SuperNormal v
appendt = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
y] -> POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CATT [v
x, v
y]
taket :: forall v. Var v => SuperNormal v
taket = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y, v
x] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.natRef v
x (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TAKT [v
x, v
y]
dropt :: forall v. Var v => SuperNormal v
dropt = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y, v
x] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.natRef v
x (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
DRPT [v
x, v
y]

atb :: SuperNormal Symbol
atb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
4 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
n0, Symbol
b, Symbol
n, Symbol
t, Symbol
r0, Symbol
r] ->
  Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
n0 Reference
Ty.natRef Symbol
n
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
IDXB [Symbol
n, Symbol
b])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal Symbol
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
r0
              (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
r Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [Symbol
r0])
              (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
r
          )
        )
      ]

indext :: forall v. Var v => SuperNormal v
indext = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
y, v
t, v
r0, v
r] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
IXOT [v
x, v
y])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
r0
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
r Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
r0])
              (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
some v
r
          )
        )
      ]

indexb :: forall v. Var v => SuperNormal v
indexb = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
y, v
t, v
i, v
r] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
IXOB [v
x, v
y])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
i
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
r Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
i])
              (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
some v
r
          )
        )
      ]

sizet :: forall v. Var v => SuperNormal v
sizet = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
r] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
r Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SIZT [v
x]) (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
r]

unconst :: forall v. Var v => SuperNormal v
unconst = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
7 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
t, v
c0, v
c, v
y, v
p, v
u, v
yp] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
UCNS [v
x])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN, Mem
BX],
            [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
c0, v
y]
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
u Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
yp Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
y, v
u])
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
c Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.charRef CTag
0 [v
c0])
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
p Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
c, v
yp])
              (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
some v
p
          )
        )
      ]

unsnoct :: forall v. Var v => SuperNormal v
unsnoct = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
7 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
t, v
c0, v
c, v
y, v
p, v
u, v
cp] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
USNC [v
x])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
BX, Mem
UN],
            [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
y, v
c0]
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
u Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
c Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.charRef CTag
0 [v
c0])
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
cp Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
c, v
u])
              (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
p Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
y, v
cp])
              (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
some v
p
          )
        )
      ]

appends, conss, snocs :: (Var v) => SuperNormal v
appends :: forall v. Var v => SuperNormal v
appends = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
y] -> POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CATS [v
x, v
y]
conss :: forall v. Var v => SuperNormal v
conss = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
y] -> POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CONS [v
x, v
y]
snocs :: forall v. Var v => SuperNormal v
snocs = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
y] -> POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SNOC [v
x, v
y]

coerceType :: (Var v) => Reference -> Reference -> SuperNormal v
coerceType :: forall v. Var v => Reference -> Reference -> SuperNormal v
coerceType Reference
fromType Reference
toType = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
r] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x Reference
fromType v
r (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
toType CTag
0 [v
r]

takes, drops, sizes, ats, emptys :: (Var v) => SuperNormal v
takes :: forall v. Var v => SuperNormal v
takes = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y, v
x] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.natRef v
x (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TAKS [v
x, v
y]
drops :: forall v. Var v => SuperNormal v
drops = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y, v
x] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.natRef v
x (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
DRPS [v
x, v
y]
sizes :: forall v. Var v => SuperNormal v
sizes = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x, v
r] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
r Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SIZS [v
x]) (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
    Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
r]
ats :: forall v. Var v => SuperNormal v
ats = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
x0, v
y, v
x, v
t, v
r] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
x0 Reference
Ty.natRef v
x
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
IDXS [v
x, v
y])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
none)),
        (Word64
1, ([Mem
BX], v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
r (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
some v
r))
      ]
emptys :: forall v. Var v => SuperNormal v
emptys = [Mem] -> ANormal v -> SuperNormal v
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [] (ANormal v -> SuperNormal v) -> ANormal v -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
BLDS []

viewls, viewrs :: (Var v) => SuperNormal v
viewls :: forall v. Var v => SuperNormal v
viewls = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
s, v
u, v
h, v
t] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
u Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
VWLS [v
s])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
u
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
seqViewEmpty)),
        (Word64
1, ([Mem
BX, Mem
BX], [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
h, v
t] (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> v -> ANormal v
forall v. Var v => v -> v -> ANormal v
seqViewElem v
h v
t))
      ]
viewrs :: forall v. Var v => SuperNormal v
viewrs = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
s, v
u, v
i, v
l] ->
  v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
u Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
VWRS [v
s])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
u
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
seqViewEmpty)),
        (Word64
1, ([Mem
BX, Mem
BX], [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
i, v
l] (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> v -> ANormal v
forall v. Var v => v -> v -> ANormal v
seqViewElem v
i v
l))
      ]

splitls, splitrs :: (Var v) => SuperNormal v
splitls :: forall v. Var v => SuperNormal v
splitls = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
4 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
n0, v
s, v
n, v
t, v
l, v
r] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
n0 Reference
Ty.natRef v
n
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SPLL [v
n, v
s])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
seqViewEmpty)),
        (Word64
1, ([Mem
BX, Mem
BX], [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
l, v
r] (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> v -> ANormal v
forall v. Var v => v -> v -> ANormal v
seqViewElem v
l v
r))
      ]
splitrs :: forall v. Var v => SuperNormal v
splitrs = Int -> ([v] -> ANormal v) -> SuperNormal v
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
4 (([v] -> ANormal v) -> SuperNormal v)
-> ([v] -> ANormal v) -> SuperNormal v
forall a b. (a -> b) -> a -> b
$ \[v
n0, v
s, v
n, v
t, v
l, v
r] ->
  v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
n0 Reference
Ty.natRef v
n
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
t Mem
UN (POp -> [v] -> ANormal v
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SPLR [v
n, v
s])
    (ANormal v -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal v
forall v. Var v => ANormal v
seqViewEmpty)),
        (Word64
1, ([Mem
BX, Mem
BX], [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
l, v
r] (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> v -> ANormal v
forall v. Var v => v -> v -> ANormal v
seqViewElem v
l v
r))
      ]

eqt, neqt, leqt, geqt, lesst, great :: SuperNormal Symbol
eqt :: SuperNormal Symbol
eqt = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EQLT [Symbol
x, Symbol
y]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
b
neqt :: SuperNormal Symbol
neqt = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EQLT [Symbol
x, Symbol
y]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
notlift Symbol
b
leqt :: SuperNormal Symbol
leqt = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LEQT [Symbol
x, Symbol
y]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
b
geqt :: SuperNormal Symbol
geqt = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LEQT [Symbol
y, Symbol
x]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
b
lesst :: SuperNormal Symbol
lesst = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LEQT [Symbol
y, Symbol
x]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
notlift Symbol
b
great :: SuperNormal Symbol
great = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LEQT [Symbol
x, Symbol
y]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
notlift Symbol
b

packt, unpackt :: SuperNormal Symbol
packt :: SuperNormal Symbol
packt = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
s] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
PAKT [Symbol
s]
unpackt :: SuperNormal Symbol
unpackt = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
t] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
UPKT [Symbol
t]

packb, unpackb, emptyb, appendb :: SuperNormal Symbol
packb :: SuperNormal Symbol
packb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
s] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
PAKB [Symbol
s]
unpackb :: SuperNormal Symbol
unpackb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
b] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
UPKB [Symbol
b]
emptyb :: SuperNormal Symbol
emptyb =
  [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda []
    (ANormal Symbol -> SuperNormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
es Mem
BX (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
BLDS [])
    (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
PAKB [Symbol
es]
  where
    es :: Symbol
es = Symbol
forall v. Var v => v
fresh1
appendb :: SuperNormal Symbol
appendb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CATB [Symbol
x, Symbol
y]

takeb, dropb, atb, sizeb, flattenb :: SuperNormal Symbol
takeb :: SuperNormal Symbol
takeb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
n0, Symbol
b, Symbol
n] ->
  Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
n0 Reference
Ty.natRef Symbol
n (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TAKB [Symbol
n, Symbol
b]
dropb :: SuperNormal Symbol
dropb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
n0, Symbol
b, Symbol
n] ->
  Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
n0 Reference
Ty.natRef Symbol
n (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
DRPB [Symbol
n, Symbol
b]
sizeb :: SuperNormal Symbol
sizeb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
b, Symbol
n] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
n Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SIZB [Symbol
b]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [Symbol
n]
flattenb :: SuperNormal Symbol
flattenb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
b] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
FLTB [Symbol
b]

i2t, n2t, f2t :: SuperNormal Symbol
i2t :: SuperNormal Symbol
i2t = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
n0, Symbol
n] ->
  Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
n0 Reference
Ty.intRef Symbol
n (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
ITOT [Symbol
n]
n2t :: SuperNormal Symbol
n2t = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
n0, Symbol
n] ->
  Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
n0 Reference
Ty.natRef Symbol
n (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
NTOT [Symbol
n]
f2t :: SuperNormal Symbol
f2t = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
f0, Symbol
f] ->
  Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
f0 Reference
Ty.floatRef Symbol
f (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
FTOT [Symbol
f]

t2i, t2n, t2f :: SuperNormal Symbol
t2i :: SuperNormal Symbol
t2i = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
t, Symbol
n0, Symbol
n] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TTOI [Symbol
x])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal Symbol
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
n0
              (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
n Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.intRef CTag
0 [Symbol
n0])
              (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
n
          )
        )
      ]
t2n :: SuperNormal Symbol
t2n = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
t, Symbol
n0, Symbol
n] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TTON [Symbol
x])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal Symbol
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
n0
              (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
n Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [Symbol
n0])
              (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
n
          )
        )
      ]
t2f :: SuperNormal Symbol
t2f = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
t, Symbol
f0, Symbol
f] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TTOF [Symbol
x])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], ANormal Symbol
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
f0
              (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
f Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.floatRef CTag
0 [Symbol
f0])
              (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
f
          )
        )
      ]

equ :: SuperNormal Symbol
equ :: SuperNormal Symbol
equ = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
b] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EQLU [Symbol
x, Symbol
y]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
b

cmpu :: SuperNormal Symbol
cmpu :: SuperNormal Symbol
cmpu = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
2 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
c, Symbol
i] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
c Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CMPU [Symbol
x, Symbol
y])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
i Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
DECI [Symbol
c])
    (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.intRef CTag
0 [Symbol
i]

ltu :: SuperNormal Symbol
ltu :: SuperNormal Symbol
ltu = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
c] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
c Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CMPU [Symbol
x, Symbol
y])
    (ANormal Symbol -> ANormal Symbol)
-> (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
c
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal Symbol)
-> Maybe (ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
      ([(Word64, ANormal Symbol)] -> EnumMap Word64 (ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(Word64
0, Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
1 [])])
      (ANormal Symbol -> Maybe (ANormal Symbol)
forall a. a -> Maybe a
Just (ANormal Symbol -> Maybe (ANormal Symbol))
-> ANormal Symbol -> Maybe (ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
0 [])

gtu :: SuperNormal Symbol
gtu :: SuperNormal Symbol
gtu = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
c] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
c Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CMPU [Symbol
x, Symbol
y])
    (ANormal Symbol -> ANormal Symbol)
-> (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
c
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal Symbol)
-> Maybe (ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
      ([(Word64, ANormal Symbol)] -> EnumMap Word64 (ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(Word64
2, Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
1 [])])
      (ANormal Symbol -> Maybe (ANormal Symbol)
forall a. a -> Maybe a
Just (ANormal Symbol -> Maybe (ANormal Symbol))
-> ANormal Symbol -> Maybe (ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
0 [])

geu :: SuperNormal Symbol
geu :: SuperNormal Symbol
geu = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
c] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
c Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CMPU [Symbol
x, Symbol
y])
    (ANormal Symbol -> ANormal Symbol)
-> (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
c
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal Symbol)
-> Maybe (ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
      ([(Word64, ANormal Symbol)] -> EnumMap Word64 (ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(Word64
0, Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
0 [])])
      (ANormal Symbol -> Maybe (ANormal Symbol)
forall a. a -> Maybe a
Just (ANormal Symbol -> Maybe (ANormal Symbol))
-> ANormal Symbol -> Maybe (ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
1 [])

leu :: SuperNormal Symbol
leu :: SuperNormal Symbol
leu = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
y, Symbol
c] ->
  Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
c Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CMPU [Symbol
x, Symbol
y])
    (ANormal Symbol -> ANormal Symbol)
-> (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
c
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 (ANormal Symbol)
-> Maybe (ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 e -> Maybe e -> Branched e
MatchIntegral
      ([(Word64, ANormal Symbol)] -> EnumMap Word64 (ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(Word64
2, Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
0 [])])
      (ANormal Symbol -> Maybe (ANormal Symbol)
forall a. a -> Maybe a
Just (ANormal Symbol -> Maybe (ANormal Symbol))
-> ANormal Symbol -> Maybe (ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.booleanRef CTag
1 [])

notb :: SuperNormal Symbol
notb :: SuperNormal Symbol
notb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
b] ->
  Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
b (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap CTag ([Mem], ANormal Symbol)
 -> Maybe (ANormal Symbol) -> Branched (ANormal Symbol))
-> Maybe (ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Branched (ANormal Symbol)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Maybe (ANormal Symbol)
-> Branched (ANormal Symbol)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
Ty.booleanRef) Maybe (ANormal Symbol)
forall a. Maybe a
Nothing (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    [(CTag, ([Mem], ANormal Symbol))]
-> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(CTag
0, ([], ANormal Symbol
forall v. Var v => ANormal v
tru)), (CTag
1, ([], ANormal Symbol
forall v. Var v => ANormal v
fls))]

orb :: SuperNormal Symbol
orb :: SuperNormal Symbol
orb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
p, Symbol
q] ->
  Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
p (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap CTag ([Mem], ANormal Symbol)
 -> Maybe (ANormal Symbol) -> Branched (ANormal Symbol))
-> Maybe (ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Branched (ANormal Symbol)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Maybe (ANormal Symbol)
-> Branched (ANormal Symbol)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
Ty.booleanRef) Maybe (ANormal Symbol)
forall a. Maybe a
Nothing (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    [(CTag, ([Mem], ANormal Symbol))]
-> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(CTag
1, ([], ANormal Symbol
forall v. Var v => ANormal v
tru)), (CTag
0, ([], Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
q))]

andb :: SuperNormal Symbol
andb :: SuperNormal Symbol
andb = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
p, Symbol
q] ->
  Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
p (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap CTag ([Mem], ANormal Symbol)
 -> Maybe (ANormal Symbol) -> Branched (ANormal Symbol))
-> Maybe (ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Branched (ANormal Symbol)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Maybe (ANormal Symbol)
-> Branched (ANormal Symbol)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
Ty.booleanRef) Maybe (ANormal Symbol)
forall a. Maybe a
Nothing (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
    [(CTag, ([Mem], ANormal Symbol))]
-> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList [(CTag
0, ([], ANormal Symbol
forall v. Var v => ANormal v
fls)), (CTag
1, ([], Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
q))]

-- unsafeCoerce, used for numeric types where conversion is a
-- no-op on the representation. Ideally this will be inlined and
-- eliminated so that no instruction is necessary.
cast :: Reference -> Reference -> SuperNormal Symbol
cast :: Reference -> Reference -> SuperNormal Symbol
cast Reference
ri Reference
ro =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x0, Symbol
x] ->
    Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
x0 Reference
ri Symbol
x (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
      Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
ro CTag
0 [Symbol
x]

-- This version of unsafeCoerce is the identity function. It works
-- only if the two types being coerced between are actually the same,
-- because it keeps the same representation. It is not capable of
-- e.g. correctly translating between two types with compatible bit
-- representations, because tagging information will be retained.
poly'coerce :: SuperNormal Symbol
poly'coerce :: SuperNormal Symbol
poly'coerce = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x] -> Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
x

jumpk :: SuperNormal Symbol
jumpk :: SuperNormal Symbol
jumpk = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
k, Symbol
a] -> Symbol -> [Symbol] -> ANormal Symbol
forall v. Var v => v -> [v] -> Term ANormalF v
TKon Symbol
k [Symbol
a]

scope'run :: SuperNormal Symbol
scope'run :: SuperNormal Symbol
scope'run =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
e, Symbol
un] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
un Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 []) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
      Func Symbol -> [Symbol] -> ANormal Symbol
forall v. Var v => Func v -> [v] -> Term ANormalF v
TApp (Symbol -> Func Symbol
forall v. v -> Func v
FVar Symbol
e) [Symbol
un]

fork'comp :: SuperNormal Symbol
fork'comp :: SuperNormal Symbol
fork'comp =
  [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX]
    (ANormal Symbol -> SuperNormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
act
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
unit Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol
-> Either Reference Symbol
-> [Symbol]
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName Symbol
lz (Symbol -> Either Reference Symbol
forall a b. b -> Either a b
Right Symbol
act) [Symbol
unit]
    (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
FORK [Symbol
lz]
  where
    (Symbol
act, Symbol
unit, Symbol
lz) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

try'eval :: SuperNormal Symbol
try'eval :: SuperNormal Symbol
try'eval =
  [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX]
    (ANormal Symbol -> SuperNormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
act
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
unit Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol
-> Either Reference Symbol
-> [Symbol]
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName Symbol
lz (Symbol -> Either Reference Symbol
forall a b. b -> Either a b
Right Symbol
act) [Symbol
unit]
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
ta Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TFRC [Symbol
lz])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
ta
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> SuperNormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> (Word64, ([Mem], ANormal Symbol))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase Symbol
lnk Symbol
msg Symbol
xtra Symbol
any Symbol
fail,
        (Word64
1, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
r (Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
r)))
      ]
  where
    (Symbol
act, Symbol
unit, Symbol
lz, Symbol
ta, Symbol
lnk, Symbol
msg, Symbol
xtra, Symbol
any, Symbol
fail, Symbol
r) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol)
forall t. Fresh t => t
fresh

bug :: Util.Text.Text -> SuperNormal Symbol
bug :: Text -> SuperNormal Symbol
bug Text
name =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x, Symbol
n] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
n Mem
BX (Lit -> ANormal Symbol
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal Symbol) -> Lit -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Text -> Lit
T Text
name) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
      POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EROR [Symbol
n, Symbol
x]

watch :: SuperNormal Symbol
watch :: SuperNormal Symbol
watch =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
t, Symbol
v] ->
    Direction Word16
-> [Symbol]
-> [Mem]
-> ANormal Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [] [] (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
PRNT [Symbol
t]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
      Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
v

raise :: SuperNormal Symbol
raise :: SuperNormal Symbol
raise =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
r, Symbol
f, Symbol
n, Symbol
k] ->
    Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
r
      (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Reference (EnumMap CTag ([Mem], ANormal Symbol))
 -> ANormal Symbol -> Branched (ANormal Symbol))
-> ANormal Symbol
-> Map Reference (EnumMap CTag ([Mem], ANormal Symbol))
-> Branched (ANormal Symbol)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Map Reference (EnumMap CTag ([Mem], ANormal Symbol))
-> ANormal Symbol -> Branched (ANormal Symbol)
forall e.
Map Reference (EnumMap CTag ([Mem], e)) -> e -> Branched e
MatchRequest (Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
f (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
f)
      (Map Reference (EnumMap CTag ([Mem], ANormal Symbol))
 -> Branched (ANormal Symbol))
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Map Reference (EnumMap CTag ([Mem], ANormal Symbol)))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Branched (ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Map Reference (EnumMap CTag ([Mem], ANormal Symbol))
forall k a. k -> a -> Map k a
Map.singleton Reference
Ty.exceptionRef
      (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ CTag
-> ([Mem], ANormal Symbol) -> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => k -> a -> EnumMap k a
mapSingleton
        CTag
0
        ( [Mem
BX],
          Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
f
            (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
Reference -> v -> Term ANormalF v -> Term ANormalF v
TShift Reference
Ty.exceptionRef Symbol
k
            (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
n Mem
BX (Lit -> ANormal Symbol
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal Symbol) -> Lit -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Text -> Lit
T Text
"builtin.raise")
            (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
EROR [Symbol
n, Symbol
f]
        )

gen'trace :: SuperNormal Symbol
gen'trace :: SuperNormal Symbol
gen'trace =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
binop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
t, Symbol
v] ->
    Direction Word16
-> [Symbol]
-> [Mem]
-> ANormal Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [] [] (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TRCE [Symbol
t, Symbol
v]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
      Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 []

debug'text :: SuperNormal Symbol
debug'text :: SuperNormal Symbol
debug'text =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
3 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
c, Symbol
r, Symbol
t, Symbol
e] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
r Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
DBTX [Symbol
c])
      (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
r
      (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
      (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
        [ (Word64
0, ([], ANormal Symbol
forall v. Var v => ANormal v
none)),
          (Word64
1, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
t (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
e Mem
BX (Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
left Symbol
t) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
e)),
          (Word64
2, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
t (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
e Mem
BX (Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
right Symbol
t) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
e))
        ]

code'missing :: SuperNormal Symbol
code'missing :: SuperNormal Symbol
code'missing =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
link, Symbol
b] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
MISS [Symbol
link]) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
      Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
b

code'cache :: SuperNormal Symbol
code'cache :: SuperNormal Symbol
code'cache = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
new] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CACH [Symbol
new]

code'lookup :: SuperNormal Symbol
code'lookup :: SuperNormal Symbol
code'lookup =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
2 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
link, Symbol
t, Symbol
r] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LKUP [Symbol
link])
      (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
      (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
      (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
        [ (Word64
0, ([], ANormal Symbol
forall v. Var v => ANormal v
none)),
          (Word64
1, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
r (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
r))
        ]

code'validate :: SuperNormal Symbol
code'validate :: SuperNormal Symbol
code'validate =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
6 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
item, Symbol
t, Symbol
ref, Symbol
msg, Symbol
extra, Symbol
any, Symbol
fail] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
CVLD [Symbol
item])
      (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
      (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
      (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
        [ ( Word64
1,
            ([Mem
BX, Mem
BX, Mem
BX],)
              (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
ref, Symbol
msg, Symbol
extra]
              (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
any Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.anyRef CTag
0 [Symbol
extra])
              (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
fail Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.failureRef CTag
0 [Symbol
ref, Symbol
msg, Symbol
any])
              (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
fail
          ),
          ( Word64
0,
            ([],) (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$
              ANormal Symbol
forall v. Var v => ANormal v
none
          )
        ]

term'link'to'text :: SuperNormal Symbol
term'link'to'text :: SuperNormal Symbol
term'link'to'text =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
link] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
TLTT [Symbol
link]

value'load :: SuperNormal Symbol
value'load :: SuperNormal Symbol
value'load =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
2 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
vlu, Symbol
t, Symbol
r] ->
    Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
LOAD [Symbol
vlu])
      (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
t
      (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
      (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
        [ (Word64
0, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
r (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
left Symbol
r)),
          (Word64
1, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
r (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
right Symbol
r))
        ]

value'create :: SuperNormal Symbol
value'create :: SuperNormal Symbol
value'create = Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
x] -> POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
VALU [Symbol
x]

check'sandbox :: SuperNormal Symbol
check'sandbox :: SuperNormal Symbol
check'sandbox =
  [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX, Mem
BX]
    (ANormal Symbol -> SuperNormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
refs, Symbol
val]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
b Mem
UN (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SDBX [Symbol
refs, Symbol
val])
    (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
b
  where
    (Symbol
refs, Symbol
val, Symbol
b) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

sandbox'links :: SuperNormal Symbol
sandbox'links :: SuperNormal Symbol
sandbox'links = [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX] (ANormal Symbol -> SuperNormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
ln (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SDBL [Symbol
ln]
  where
    ln :: Symbol
ln = Symbol
forall v. Var v => v
fresh1

value'sandbox :: SuperNormal Symbol
value'sandbox :: SuperNormal Symbol
value'sandbox =
  [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX, Mem
BX]
    (ANormal Symbol -> SuperNormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
refs, Symbol
val]
    (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
SDBV [Symbol
refs, Symbol
val]
  where
    (Symbol
refs, Symbol
val) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

stm'atomic :: SuperNormal Symbol
stm'atomic :: SuperNormal Symbol
stm'atomic =
  [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [Mem
BX]
    (ANormal Symbol -> SuperNormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> SuperNormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
act
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
unit Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol
-> Either Reference Symbol
-> [Symbol]
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
v
-> Either Reference v -> [v] -> Term ANormalF v -> Term ANormalF v
TName Symbol
lz (Symbol -> Either Reference Symbol
forall a b. b -> Either a b
Right Symbol
act) [Symbol
unit]
    (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
ATOM [Symbol
lz]
  where
    (Symbol
act, Symbol
unit, Symbol
lz) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

type ForeignOp = FOp -> ([Mem], ANormal Symbol)

standard'handle :: ForeignOp
standard'handle :: ForeignOp
standard'handle Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
h0]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Symbol
-> Reference
-> Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum Int
3 Symbol
h0 Reference
Ty.stdHandleRef Symbol
h
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
h]
  where
    (Symbol
h0, Symbol
h) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

any'construct :: SuperNormal Symbol
any'construct :: SuperNormal Symbol
any'construct =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
0 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ \[Symbol
v] ->
    Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.anyRef CTag
0 [Symbol
v]

any'extract :: SuperNormal Symbol
any'extract :: SuperNormal Symbol
any'extract =
  Int -> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall v. Var v => Int -> ([v] -> ANormal v) -> SuperNormal v
unop0 Int
1 (([Symbol] -> ANormal Symbol) -> SuperNormal Symbol)
-> ([Symbol] -> ANormal Symbol) -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$
    \[Symbol
v, Symbol
v1] ->
      Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
v (Branched (ANormal Symbol) -> ANormal Symbol)
-> Branched (ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
        Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Maybe (ANormal Symbol)
-> Branched (ANormal Symbol)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
Ty.anyRef (CTag
-> ([Mem], ANormal Symbol) -> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => k -> a -> EnumMap k a
mapSingleton CTag
0 (([Mem], ANormal Symbol) -> EnumMap CTag ([Mem], ANormal Symbol))
-> ([Mem], ANormal Symbol) -> EnumMap CTag ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
v1 (Symbol -> ANormal Symbol
forall v. Var v => v -> Term ANormalF v
TVar Symbol
v1))) Maybe (ANormal Symbol)
forall a. Maybe a
Nothing

seek'handle :: ForeignOp
seek'handle :: ForeignOp
seek'handle Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
arg1, Symbol
arg2, Symbol
arg3]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Symbol
-> Reference
-> Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum Int
3 Symbol
arg2 Reference
Ty.seekModeRef Symbol
seek
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
arg3 Reference
Ty.intRef Symbol
nat
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
result Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
arg1, Symbol
seek, Symbol
nat])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
unit Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
seek, Symbol
nat, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
unit, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

no'buf, line'buf, block'buf, sblock'buf :: (Enum e) => e
no'buf :: forall e. Enum e => e
no'buf = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> Int -> e
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.bufferModeNoBufferingId
line'buf :: forall e. Enum e => e
line'buf = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> Int -> e
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.bufferModeLineBufferingId
block'buf :: forall e. Enum e => e
block'buf = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> Int -> e
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.bufferModeBlockBufferingId
sblock'buf :: forall e. Enum e => e
sblock'buf = Int -> e
forall a. Enum a => Int -> a
toEnum (Int -> e) -> Int -> e
forall a b. (a -> b) -> a -> b
$ Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.bufferModeSizedBlockBufferingId

infixr 0 -->

(-->) :: a -> b -> (a, b)
a
x --> :: forall a b. a -> b -> (a, b)
--> b
y = (a
x, b
y)

-- Box an unboxed value
-- Takes the boxed variable, the unboxed variable, and the type of the value
box :: (Var v) => v -> v -> Reference -> Term ANormalF v -> Term ANormalF v
box :: forall v.
Var v =>
v -> v -> Reference -> Term ANormalF v -> Term ANormalF v
box v
b v
u Reference
ty = v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
b Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
ty CTag
0 [v
u])

time'zone :: ForeignOp
time'zone :: ForeignOp
time'zone Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
bsecs]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
bsecs Reference
Ty.intRef Symbol
secs
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction Word16
-> [Symbol]
-> [Mem]
-> ANormal Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [Symbol
offset, Symbol
summer, Symbol
name] [Mem
UN, Mem
UN, Mem
BX] (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
secs])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Symbol -> Reference -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> v -> Reference -> Term ANormalF v -> Term ANormalF v
box Symbol
bsummer Symbol
summer Reference
Ty.natRef
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Symbol -> Reference -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> v -> Reference -> Term ANormalF v -> Term ANormalF v
box Symbol
boffset Symbol
offset Reference
Ty.intRef
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
un Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
p2 Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
name, Symbol
un])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
p1 Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
bsummer, Symbol
p2])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
boffset, Symbol
p1]
  where
    (Symbol
secs, Symbol
bsecs, Symbol
offset, Symbol
boffset, Symbol
summer, Symbol
bsummer, Symbol
name, Symbol
un, Symbol
p2, Symbol
p1) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol)
forall t. Fresh t => t
fresh

start'process :: ForeignOp
start'process :: ForeignOp
start'process Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
exe, Symbol
args]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction Word16
-> [Symbol]
-> [Mem]
-> ANormal Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [Symbol
hin, Symbol
hout, Symbol
herr, Symbol
hproc] [Mem
BX, Mem
BX, Mem
BX, Mem
BX] (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
exe, Symbol
args])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
un Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
p3 Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
hproc, Symbol
un])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
p2 Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
herr, Symbol
p3])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
p1 Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
hout, Symbol
p2])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [Symbol
hin, Symbol
p1]
  where
    (Symbol
exe, Symbol
args, Symbol
hin, Symbol
hout, Symbol
herr, Symbol
hproc, Symbol
un, Symbol
p3, Symbol
p2, Symbol
p1) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol)
forall t. Fresh t => t
fresh

set'buffering :: ForeignOp
set'buffering :: ForeignOp
set'buffering Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
handle, Symbol
bmode]
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
bmode
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Branched (ANormal Symbol)
forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover Reference
Ty.bufferModeRef
    (EnumMap CTag ([Mem], ANormal Symbol) -> ([Mem], ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol) -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ [(CTag, ([Mem], ANormal Symbol))]
-> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ CTag
forall e. Enum e => e
no'buf CTag -> ([Mem], ANormal Symbol) -> (CTag, ([Mem], ANormal Symbol))
forall a b. a -> b -> (a, b)
--> [] [Mem] -> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. a -> b -> (a, b)
--> Word64 -> ANormal Symbol
k1 Word64
forall e. Enum e => e
no'buf,
        CTag
forall e. Enum e => e
line'buf CTag -> ([Mem], ANormal Symbol) -> (CTag, ([Mem], ANormal Symbol))
forall a b. a -> b -> (a, b)
--> [] [Mem] -> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. a -> b -> (a, b)
--> Word64 -> ANormal Symbol
k1 Word64
forall e. Enum e => e
line'buf,
        CTag
forall e. Enum e => e
block'buf CTag -> ([Mem], ANormal Symbol) -> (CTag, ([Mem], ANormal Symbol))
forall a b. a -> b -> (a, b)
--> [] [Mem] -> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. a -> b -> (a, b)
--> Word64 -> ANormal Symbol
k1 Word64
forall e. Enum e => e
block'buf,
        CTag
forall e. Enum e => e
sblock'buf
          CTag -> ([Mem], ANormal Symbol) -> (CTag, ([Mem], ANormal Symbol))
forall a b. a -> b -> (a, b)
--> [Mem
BX]
          [Mem] -> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. a -> b -> (a, b)
--> Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
n
          (ANormal Symbol -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
n
          (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap CTag ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap CTag ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference
-> EnumMap CTag ([Mem], ANormal Symbol)
-> Branched (ANormal Symbol)
forall e. Reference -> EnumMap CTag ([Mem], e) -> Branched e
MatchDataCover Reference
Ty.bufferModeRef
          (EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap CTag ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [(CTag, ([Mem], ANormal Symbol))]
-> EnumMap CTag ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
            [ CTag
0
                CTag -> ([Mem], ANormal Symbol) -> (CTag, ([Mem], ANormal Symbol))
forall a b. a -> b -> (a, b)
--> [Mem
UN]
                [Mem] -> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. a -> b -> (a, b)
--> Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
w
                (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
tag Mem
UN (Lit -> ANormal Symbol
forall v. Var v => Lit -> Term ANormalF v
TLit (Word64 -> Lit
N Word64
forall e. Enum e => e
sblock'buf))
                (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ [Symbol] -> ANormal Symbol
k2 [Symbol
tag, Symbol
w]
            ]
      ]
  where
    k1 :: Word64 -> ANormal Symbol
k1 Word64
num =
      Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
tag Mem
UN (Lit -> ANormal Symbol
forall v. Var v => Lit -> Term ANormalF v
TLit (Word64 -> Lit
N Word64
num)) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
        [Symbol] -> ANormal Symbol
k2 [Symbol
tag]
    k2 :: [Symbol] -> ANormal Symbol
k2 [Symbol]
args =
      Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
r Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr (Symbol
handle Symbol -> [Symbol] -> [Symbol]
forall a. a -> [a] -> [a]
: [Symbol]
args)) (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
        Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit Symbol
s1 Symbol
s2 Symbol
s3 Symbol
u Symbol
f Symbol
r
    (Symbol
handle, Symbol
bmode, Symbol
tag, Symbol
n, Symbol
w, Symbol
s1, Symbol
s2, Symbol
s3, Symbol
u, Symbol
f, Symbol
r) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

get'buffering'output :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
get'buffering'output :: forall v.
Var v =>
v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
get'buffering'output v
eitherResult v
stack1 v
stack2 v
stack3 v
resultTag v
anyVar v
failVar v
successVar =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
eitherResult (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
anyVar v
failVar,
        ( Word64
1,
          ([Mem
UN],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
resultTag
            (Term ANormalF v -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
resultTag
            (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
            (EnumMap Word64 ([Mem], Term ANormalF v)
 -> ([Mem], Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
              [ Word64
forall e. Enum e => e
no'buf
                  Word64
-> ([Mem], Term ANormalF v) -> (Word64, ([Mem], Term ANormalF v))
forall a b. a -> b -> (a, b)
--> []
                  [Mem] -> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. a -> b -> (a, b)
--> v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
successVar Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.bufferModeRef CTag
forall e. Enum e => e
no'buf [])
                  (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
successVar,
                Word64
forall e. Enum e => e
line'buf
                  Word64
-> ([Mem], Term ANormalF v) -> (Word64, ([Mem], Term ANormalF v))
forall a b. a -> b -> (a, b)
--> []
                  [Mem] -> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. a -> b -> (a, b)
--> v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
successVar Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.bufferModeRef CTag
forall e. Enum e => e
line'buf [])
                  (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
successVar,
                Word64
forall e. Enum e => e
block'buf
                  Word64
-> ([Mem], Term ANormalF v) -> (Word64, ([Mem], Term ANormalF v))
forall a b. a -> b -> (a, b)
--> []
                  [Mem] -> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. a -> b -> (a, b)
--> v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
successVar Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.bufferModeRef CTag
forall e. Enum e => e
block'buf [])
                  (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
successVar,
                Word64
forall e. Enum e => e
sblock'buf
                  Word64
-> ([Mem], Term ANormalF v) -> (Word64, ([Mem], Term ANormalF v))
forall a b. a -> b -> (a, b)
--> [Mem
UN]
                  [Mem] -> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. a -> b -> (a, b)
--> v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack1
                  (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
stack2 Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
stack1])
                  (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
successVar Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.bufferModeRef CTag
forall e. Enum e => e
sblock'buf [v
stack2])
                  (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
successVar
              ]
        )
      ]

get'buffering :: ForeignOp
get'buffering :: ForeignOp
get'buffering =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg1 Symbol
eitherResult (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
forall v.
Var v =>
v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
get'buffering'output Symbol
eitherResult Symbol
n Symbol
n2 Symbol
n3 Symbol
resultTag Symbol
anyVar Symbol
failVar Symbol
successVar
  where
    (Symbol
arg1, Symbol
eitherResult, Symbol
n, Symbol
n2, Symbol
n3, Symbol
resultTag, Symbol
anyVar, Symbol
failVar, Symbol
successVar) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

crypto'hash :: ForeignOp
crypto'hash :: ForeignOp
crypto'hash Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
alg, Symbol
x]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
vl Mem
BX (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
VALU [Symbol
x])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
alg, Symbol
vl]
  where
    (Symbol
alg, Symbol
x, Symbol
vl) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

murmur'hash :: ForeignOp
murmur'hash :: ForeignOp
murmur'hash Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
x]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
vl Mem
BX (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
VALU [Symbol
x])
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
result Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
vl])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [Symbol
result]
  where
    (Symbol
x, Symbol
vl, Symbol
result) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

crypto'hmac :: ForeignOp
crypto'hmac :: ForeignOp
crypto'hmac Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
alg, Symbol
by, Symbol
x]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
vl Mem
BX (POp -> [Symbol] -> ANormal Symbol
forall v. Var v => POp -> [v] -> Term ANormalF v
TPrm POp
VALU [Symbol
x])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
alg, Symbol
by, Symbol
vl]
  where
    (Symbol
alg, Symbol
by, Symbol
x, Symbol
vl) = (Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- Input Shape -- these will represent different argument lists a
-- foreign might expect
--
-- They will be named according to their shape:
--   inBx     : one boxed input arg
--   inNat     : one Nat input arg
--   inBxBx   : two boxed input args
--
-- All of these functions will have take (at least) the same three arguments
--
--   instr : the foreign instruction to call
--   result : a variable containing the result of the foreign call
--   cont : a term which will be evaluated when a result from the foreign call is on the stack
--

-- () -> ...
inUnit :: forall v. (Var v) => v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inUnit :: forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inUnit v
unit v
result ANormal v
cont Word64
instr =
  ([Mem
BX], v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
unit (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr []) ANormal v
cont)

-- a -> ...
inBx :: forall v. (Var v) => v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBx :: forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx v
arg v
result ANormal v
cont Word64
instr =
  ([Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
arg
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg]) ANormal v
cont

-- Nat -> ...
inNat :: forall v. (Var v) => v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inNat :: forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inNat v
arg v
nat v
result ANormal v
cont Word64
instr =
  ([Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
arg
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
arg Reference
Ty.natRef v
nat
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
nat]) ANormal v
cont

-- Maybe a -> b -> ...
inMaybeBx :: forall v. (Var v) => v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inMaybeBx :: forall v.
Var v =>
v -> v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inMaybeBx v
arg1 v
arg2 v
arg3 v
mb v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (EnumMap CTag ([Mem], ANormal v) -> ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2]
    (ANormal v -> ANormal v)
-> (EnumMap CTag ([Mem], ANormal v) -> ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
arg1
    (Branched (ANormal v) -> ANormal v)
-> (EnumMap CTag ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap CTag ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap CTag ([Mem], ANormal v)
 -> Maybe (ANormal v) -> Branched (ANormal v))
-> Maybe (ANormal v)
-> EnumMap CTag ([Mem], ANormal v)
-> Branched (ANormal v)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Reference
-> EnumMap CTag ([Mem], ANormal v)
-> Maybe (ANormal v)
-> Branched (ANormal v)
forall e.
Reference -> EnumMap CTag ([Mem], e) -> Maybe e -> Branched e
MatchData Reference
Ty.optionalRef) Maybe (ANormal v)
forall a. Maybe a
Nothing
    (EnumMap CTag ([Mem], ANormal v) -> ([Mem], ANormal v))
-> EnumMap CTag ([Mem], ANormal v) -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ [(CTag, ([Mem], ANormal v))] -> EnumMap CTag ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ ( Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.noneId,
          ( [],
            v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
mb Mem
UN (Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> Lit -> ANormal v
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit
I Int64
0) (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
              v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
mb, v
arg2]) ANormal v
cont
          )
        ),
        (Word64 -> CTag
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
Ty.someId, ([Mem
BX], v -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
arg3 (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
mb Mem
UN (Lit -> ANormal v
forall v. Var v => Lit -> Term ANormalF v
TLit (Lit -> ANormal v) -> Lit -> ANormal v
forall a b. (a -> b) -> a -> b
$ Int64 -> Lit
I Int64
1) (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
mb, v
arg3, v
arg2]) ANormal v
cont))
      ]

-- a -> b -> ...
inBxBx :: forall v. (Var v) => v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxBx :: forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBx v
arg1 v
arg2 v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2]
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg1, v
arg2]) ANormal v
cont

-- a -> b -> c -> ...
inBxBxBx :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxBxBx :: forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBxBx v
arg1 v
arg2 v
arg3 v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2, v
arg3]
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg1, v
arg2, v
arg3]) ANormal v
cont

set'echo :: ForeignOp
set'echo :: ForeignOp
set'echo Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
arg1, Symbol
arg2]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Symbol
-> Reference
-> Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum Int
2 Symbol
arg2 Reference
Ty.booleanRef Symbol
bol
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
result Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
arg1, Symbol
bol])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
unit Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
bol, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
unit, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> ...
inBxNat :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxNat :: forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxNat v
arg1 v
arg2 v
nat v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2]
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
arg2 Reference
Ty.natRef v
nat
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg1, v
nat]) ANormal v
cont

inBxNatNat ::
  (Var v) => v -> v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxNatNat :: forall v.
Var v =>
v
-> v
-> v
-> v
-> v
-> v
-> ANormal v
-> Word64
-> ([Mem], ANormal v)
inBxNatNat v
arg1 v
arg2 v
arg3 v
nat1 v
nat2 v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2, v
arg3]
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
arg2 Reference
Ty.natRef v
nat1
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
arg3 Reference
Ty.natRef v
nat2
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg1, v
nat1, v
nat2]) ANormal v
cont

inBxNatBx :: (Var v) => v -> v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxNatBx :: forall v.
Var v =>
v -> v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxNatBx v
arg1 v
arg2 v
arg3 v
nat v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2, v
arg3]
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Reference -> v -> ANormal v -> ANormal v
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox v
arg2 Reference
Ty.natRef v
nat
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg1, v
nat, v
arg3]) ANormal v
cont

-- a -> IOMode -> ...
inBxIomr :: forall v. (Var v) => v -> v -> v -> v -> ANormal v -> FOp -> ([Mem], ANormal v)
inBxIomr :: forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxIomr v
arg1 v
arg2 v
fm v
result ANormal v
cont Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
arg1, v
arg2]
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> v -> Reference -> v -> ANormal v -> ANormal v
forall v.
Var v =>
Int -> v -> Reference -> v -> ANormal v -> ANormal v
unenum Int
4 v
arg2 Reference
Ty.fileModeRef v
fm
    (ANormal v -> ([Mem], ANormal v))
-> ANormal v -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
result Mem
UN (Word64 -> [v] -> ANormal v
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [v
arg1, v
fm]) ANormal v
cont

-- Output Shape -- these will represent different ways of translating
-- the result of a foreign call to a Unison Term
--
-- They will be named according to the output type
--   outInt    : a foreign function returning an Int
--   outBool   : a foreign function returning a boolean
--   outIOFail : a function returning (Either Failure a)
--
-- All of these functions will take a Var named result containing the
-- result of the foreign call
--

outMaybe :: forall v. (Var v) => v -> v -> ANormal v
outMaybe :: forall v. Var v => v -> v -> ANormal v
outMaybe v
maybe v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], Term ANormalF v
forall v. Var v => ANormal v
none)),
        (Word64
1, ([Mem
BX], v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
maybe (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
some v
maybe))
      ]

outMaybeNat :: (Var v) => v -> v -> v -> ANormal v
outMaybeNat :: forall v. Var v => v -> v -> v -> ANormal v
outMaybeNat v
tag v
result v
n =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
tag (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], Term ANormalF v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN],
            v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
result
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
n Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
n])
              (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
some v
n
          )
        )
      ]

outMaybeNTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> ANormal v
outMaybeNTup :: forall v. Var v => v -> v -> v -> v -> v -> v -> v -> ANormal v
outMaybeNTup v
a v
b v
n v
u v
bp v
p v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], Term ANormalF v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
UN, Mem
BX],
            [v] -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
a, v
b]
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
u Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
bp Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
b, v
u])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
n Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
a])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
p Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
n, v
bp])
              (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
some v
p
          )
        )
      ]

outMaybeTup :: (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outMaybeTup :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outMaybeTup v
a v
b v
u v
bp v
ap v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([], Term ANormalF v
forall v. Var v => ANormal v
none)),
        ( Word64
1,
          ( [Mem
BX, Mem
BX],
            [v] -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
a, v
b]
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
u Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
bp Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
b, v
u])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
ap Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
a, v
bp])
              (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
some v
ap
          )
        )
      ]

-- Note: the Io part doesn't really do anything. There's no actual
-- representation of `IO`.
outIoFail :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoFail :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFail v
stack1 v
stack2 v
stack3 v
any v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
any v
fail,
        (Word64
1, ([Mem
BX], v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack1 (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
stack1))
      ]

outIoFailNat :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailNat :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailNat v
stack1 v
stack2 v
stack3 v
fail v
extra v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
extra v
fail,
        ( Word64
1,
          ([Mem
UN],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack3
            (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
extra Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
stack3])
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
extra
        )
      ]

outIoFailChar :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailChar :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailChar v
stack1 v
stack2 v
stack3 v
fail v
extra v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
extra v
fail,
        ( Word64
1,
          ([Mem
UN],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack3
            (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
extra Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.charRef CTag
0 [v
stack3])
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
extra
        )
      ]

failureCase ::
  (Var v) => v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase :: forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
any v
fail =
  (Word64
0,)
    (([Mem], ANormal v) -> (Word64, ([Mem], ANormal v)))
-> (ANormal v -> ([Mem], ANormal v))
-> ANormal v
-> (Word64, ([Mem], ANormal v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
stack1, v
stack2, v
stack3]
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
any Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.anyRef CTag
0 [v
stack3])
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
fail Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.failureRef CTag
0 [v
stack1, v
stack2, v
any])
    (ANormal v -> (Word64, ([Mem], ANormal v)))
-> ANormal v -> (Word64, ([Mem], ANormal v))
forall a b. (a -> b) -> a -> b
$ v -> ANormal v
forall v. Var v => v -> ANormal v
left v
fail

exnCase ::
  (Var v) => v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase :: forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase v
stack1 v
stack2 v
stack3 v
any v
fail =
  (Word64
0,)
    (([Mem], ANormal v) -> (Word64, ([Mem], ANormal v)))
-> (ANormal v -> ([Mem], ANormal v))
-> ANormal v
-> (Word64, ([Mem], ANormal v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal v -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ANormal v -> ([Mem], ANormal v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [v] -> ANormal v -> ANormal v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
stack1, v
stack2, v
stack3]
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
any Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.anyRef CTag
0 [v
stack3])
    (ANormal v -> ANormal v)
-> (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
fail Mem
BX (Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.failureRef CTag
0 [v
stack1, v
stack2, v
any])
    (ANormal v -> (Word64, ([Mem], ANormal v)))
-> ANormal v -> (Word64, ([Mem], ANormal v))
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> ANormal v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TReq Reference
Ty.exceptionRef CTag
0 [v
fail]

outIoExnNat ::
  forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnNat :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnNat v
stack1 v
stack2 v
stack3 v
any v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase v
stack1 v
stack2 v
stack3 v
any v
fail,
        ( Word64
1,
          ([Mem
UN],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack1
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [v
stack1]
        )
      ]

outIoExnUnit ::
  forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnUnit :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnUnit v
stack1 v
stack2 v
stack3 v
any v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase v
stack1 v
stack2 v
stack3 v
any v
fail,
        (Word64
1, ([], Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 []))
      ]

outIoExnBox ::
  (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnBox :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnBox v
stack1 v
stack2 v
stack3 v
any v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase v
stack1 v
stack2 v
stack3 v
any v
fail,
        (Word64
1, ([Mem
BX], v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack1 (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> Term ANormalF v
TVar v
stack1))
      ]

outIoExnEBoxBox ::
  (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
outIoExnEBoxBox :: forall v.
Var v =>
v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
outIoExnEBoxBox v
stack1 v
stack2 v
stack3 v
any v
fail v
t0 v
t1 v
res =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t0 (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
exnCase v
stack1 v
stack2 v
stack3 v
any v
fail,
        ( Word64
1,
          ([Mem
UN],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
t1
            (Term ANormalF v -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
t1
            (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
            (EnumMap Word64 ([Mem], Term ANormalF v)
 -> ([Mem], Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
              [ (Word64
0, ([Mem
BX], v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
res (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
left v
res)),
                (Word64
1, ([Mem
BX], v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
res (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
res))
              ]
        )
      ]

outIoFailBox :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBox :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBox v
stack1 v
stack2 v
stack3 v
any v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
any v
fail,
        ( Word64
1,
          ([Mem
BX],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack1
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
stack1
        )
      ]

outIoFailUnit :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit v
stack1 v
stack2 v
stack3 v
extra v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
extra v
fail,
        ( Word64
1,
          ([],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
extra Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
extra
        )
      ]

outIoFailBool :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBool :: forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBool v
stack1 v
stack2 v
stack3 v
extra v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
extra v
fail,
        ( Word64
1,
          ([Mem
UN],)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> ([Mem], Term ANormalF v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs v
stack3
            (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction Word16
-> v
-> Mem
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
forall v.
Var v =>
Direction Word16
-> v
-> Mem
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLet (Word16 -> Direction Word16
forall a. a -> Direction a
Indirect Word16
1) v
extra Mem
BX (v -> Term ANormalF v
forall v. Var v => v -> ANormal v
boolift v
stack3)
            (Term ANormalF v -> ([Mem], Term ANormalF v))
-> Term ANormalF v -> ([Mem], Term ANormalF v)
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
extra
        )
      ]

outIoFailTup :: forall v. (Var v) => v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
outIoFailTup :: forall v.
Var v =>
v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
outIoFailTup v
stack1 v
stack2 v
stack3 v
stack4 v
stack5 v
extra v
fail v
result =
  v -> Branched (Term ANormalF v) -> Term ANormalF v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (Term ANormalF v) -> Term ANormalF v)
-> (EnumMap Word64 ([Mem], Term ANormalF v)
    -> Branched (Term ANormalF v))
-> EnumMap Word64 ([Mem], Term ANormalF v)
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], Term ANormalF v)
-> Branched (Term ANormalF v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v)
-> EnumMap Word64 ([Mem], Term ANormalF v) -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], Term ANormalF v))]
-> EnumMap Word64 ([Mem], Term ANormalF v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], Term ANormalF v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
extra v
fail,
        ( Word64
1,
          ( [Mem
BX, Mem
BX],
            [v] -> Term ANormalF v -> Term ANormalF v
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [v
stack1, v
stack2]
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
stack3 Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
stack4 Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
stack2, v
stack3])
              (Term ANormalF v -> Term ANormalF v)
-> (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v
-> Term ANormalF v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
stack5 Mem
BX (Reference -> CTag -> [v] -> Term ANormalF v
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.pairRef CTag
0 [v
stack1, v
stack4])
              (Term ANormalF v -> Term ANormalF v)
-> Term ANormalF v -> Term ANormalF v
forall a b. (a -> b) -> a -> b
$ v -> Term ANormalF v
forall v. Var v => v -> ANormal v
right v
stack5
          )
        )
      ]

outIoFailG ::
  (Var v) =>
  v ->
  v ->
  v ->
  v ->
  v ->
  v ->
  ((ANormal v -> ANormal v) -> ([Mem], ANormal v)) ->
  ANormal v
outIoFailG :: forall v.
Var v =>
v
-> v
-> v
-> v
-> v
-> v
-> ((ANormal v -> ANormal v) -> ([Mem], ANormal v))
-> ANormal v
outIoFailG v
stack1 v
stack2 v
stack3 v
fail v
result v
output (ANormal v -> ANormal v) -> ([Mem], ANormal v)
k =
  v -> Branched (ANormal v) -> ANormal v
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch v
result (Branched (ANormal v) -> ANormal v)
-> (EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v))
-> EnumMap Word64 ([Mem], ANormal v)
-> ANormal v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal v) -> Branched (ANormal v)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], ANormal v) -> ANormal v)
-> EnumMap Word64 ([Mem], ANormal v) -> ANormal v
forall a b. (a -> b) -> a -> b
$
    [(Word64, ([Mem], ANormal v))] -> EnumMap Word64 ([Mem], ANormal v)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase v
stack1 v
stack2 v
stack3 v
output v
fail,
        ( Word64
1,
          (ANormal v -> ANormal v) -> ([Mem], ANormal v)
k ((ANormal v -> ANormal v) -> ([Mem], ANormal v))
-> (ANormal v -> ANormal v) -> ([Mem], ANormal v)
forall a b. (a -> b) -> a -> b
$ \ANormal v
t ->
            v -> Mem -> ANormal v -> ANormal v -> ANormal v
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD v
output Mem
BX ANormal v
t (ANormal v -> ANormal v) -> ANormal v -> ANormal v
forall a b. (a -> b) -> a -> b
$
              v -> ANormal v
forall v. Var v => v -> ANormal v
right v
output
        )
      ]

-- Input / Output glue
--
-- These are pairings of input and output functions to handle a
-- foreign call.  The input function represents the numbers and types
-- of the inputs to a forein call.  The output function takes the
-- result of the foreign call and turns it into a Unison type.
--

-- a
direct :: ForeignOp
direct :: ForeignOp
direct Word64
instr = ([], Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [])

--  () -> a
unitDirect :: ForeignOp
unitDirect :: ForeignOp
unitDirect Word64
instr = ([Mem
BX],) (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
arg (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [] where arg :: Symbol
arg = Symbol
forall v. Var v => v
fresh1

-- a -> b
boxDirect :: ForeignOp
boxDirect :: ForeignOp
boxDirect Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
arg
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
arg]
  where
    arg :: Symbol
arg = Symbol
forall v. Var v => v
fresh1

-- () -> Either Failure Nat
unitToEFNat :: ForeignOp
unitToEFNat :: ForeignOp
unitToEFNat =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inUnit Symbol
unit Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailNat Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
fail Symbol
nat Symbol
result
  where
    (Symbol
unit, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
fail, Symbol
nat, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- () -> Int
unitToInt :: ForeignOp
unitToInt :: ForeignOp
unitToInt =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inUnit Symbol
unit Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.intRef CTag
0 [Symbol
result]
  where
    (Symbol
unit, Symbol
result) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- () -> Either Failure a
unitToEFBox :: ForeignOp
unitToEFBox :: ForeignOp
unitToEFBox =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inUnit Symbol
unit Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBox Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
unit, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
fail, Symbol
any, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Int
boxToInt :: ForeignOp
boxToInt :: ForeignOp
boxToInt = Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.intRef CTag
0 [Symbol
result])
  where
    (Symbol
arg, Symbol
result) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat
boxToNat :: ForeignOp
boxToNat :: ForeignOp
boxToNat = Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [Symbol
result])
  where
    (Symbol
arg, Symbol
result) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

boxIomrToEFBox :: ForeignOp
boxIomrToEFBox :: ForeignOp
boxIomrToEFBox =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxIomr Symbol
arg1 Symbol
arg2 Symbol
enum Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBox Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
enum, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> ()
boxTo0 :: ForeignOp
boxTo0 :: ForeignOp
boxTo0 = Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
  where
    (Symbol
arg, Symbol
result) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b ->{E} ()
boxBoxTo0 :: ForeignOp
boxBoxTo0 :: ForeignOp
boxBoxTo0 Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
arg1, Symbol
arg2]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction Word16
-> [Symbol]
-> [Mem]
-> ANormal Symbol
-> ANormal Symbol
-> ANormal Symbol
forall v.
Var v =>
Direction Word16
-> [v]
-> [Mem]
-> Term ANormalF v
-> Term ANormalF v
-> Term ANormalF v
TLets Direction Word16
forall a. Direction a
Direct [] [] (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
arg1, Symbol
arg2])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 []
  where
    (Symbol
arg1, Symbol
arg2) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b ->{E} Nat
boxBoxToNat :: ForeignOp
boxBoxToNat :: ForeignOp
boxBoxToNat Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
arg1, Symbol
arg2]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
result Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
arg1, Symbol
arg2])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.natRef CTag
0 [Symbol
result]
  where
    (Symbol
arg1, Symbol
arg2, Symbol
result) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> Option c

-- a -> Bool
boxToBool :: ForeignOp
boxToBool :: ForeignOp
boxToBool =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
result
  where
    (Symbol
arg, Symbol
result) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> Bool
boxBoxToBool :: ForeignOp
boxBoxToBool :: ForeignOp
boxBoxToBool =
  Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBx Symbol
arg1 Symbol
arg2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
result) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> c -> Bool
boxBoxBoxToBool :: ForeignOp
boxBoxBoxToBool :: ForeignOp
boxBoxBoxToBool =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBxBx Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
result) = (Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- Nat -> c
-- Works for an type that's packed into a word, just
-- pass `wordDirect Ty.natRef`, `wordDirect Ty.floatRef`
-- etc
wordDirect :: Reference -> ForeignOp
wordDirect :: Reference -> ForeignOp
wordDirect Reference
wordType Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
b1 Reference
wordType Symbol
ub1
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
ub1]
  where
    (Symbol
b1, Symbol
ub1) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- Nat -> Bool
boxWordToBool :: Reference -> ForeignOp
boxWordToBool :: Reference -> ForeignOp
boxWordToBool Reference
wordType Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1, Symbol
w1]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
w1 Reference
wordType Symbol
uw1
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
result Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
b1, Symbol
uw1]) (Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
boolift Symbol
result)
  where
    (Symbol
b1, Symbol
w1, Symbol
uw1, Symbol
result) = (Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- Nat -> Nat -> c
wordWordDirect :: Reference -> Reference -> ForeignOp
wordWordDirect :: Reference -> Reference -> ForeignOp
wordWordDirect Reference
word1 Reference
word2 Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1, Symbol
b2]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
b1 Reference
word1 Symbol
ub1
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
b2 Reference
word2 Symbol
ub2
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
ub1, Symbol
ub2]
  where
    (Symbol
b1, Symbol
b2, Symbol
ub1, Symbol
ub2) = (Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- Nat -> a -> c
-- Works for an type that's packed into a word, just
-- pass `wordBoxDirect Ty.natRef`, `wordBoxDirect Ty.floatRef`
-- etc
wordBoxDirect :: Reference -> ForeignOp
wordBoxDirect :: Reference -> ForeignOp
wordBoxDirect Reference
wordType Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1, Symbol
b2]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
b1 Reference
wordType Symbol
ub1
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
ub1, Symbol
b2]
  where
    (Symbol
b1, Symbol
b2, Symbol
ub1) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> c
-- works for any second argument type that is packed into a word
boxWordDirect :: Reference -> ForeignOp
boxWordDirect :: Reference -> ForeignOp
boxWordDirect Reference
wordType Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1, Symbol
b2]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
b2 Reference
wordType Symbol
ub2
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
b1, Symbol
ub2]
  where
    (Symbol
b1, Symbol
b2, Symbol
ub2) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> c
boxBoxDirect :: ForeignOp
boxBoxDirect :: ForeignOp
boxBoxDirect Word64
instr =
  ([Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1, Symbol
b2]
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
b1, Symbol
b2]
  where
    (Symbol
b1, Symbol
b2) = (Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> c -> d
boxBoxBoxDirect :: ForeignOp
boxBoxBoxDirect :: ForeignOp
boxBoxBoxDirect Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b1, Symbol
b2, Symbol
b3]
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
b1, Symbol
b2, Symbol
b3]
  where
    (Symbol
b1, Symbol
b2, Symbol
b3) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure b
boxToEFBox :: ForeignOp
boxToEFBox :: ForeignOp
boxToEFBox =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBox Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure (b, c)
boxToEFTup :: ForeignOp
boxToEFTup :: ForeignOp
boxToEFTup =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
forall v.
Var v =>
v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
outIoFailTup Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
stack4 Symbol
stack5 Symbol
extra Symbol
fail Symbol
result
  where
    (Symbol
arg, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
stack4, Symbol
stack5, Symbol
extra, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure (Maybe b)
boxToEFMBox :: ForeignOp
boxToEFMBox :: ForeignOp
boxToEFMBox =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result
    (ANormal Symbol -> ForeignOp)
-> (((ANormal Symbol -> ANormal Symbol) -> ([Mem], ANormal Symbol))
    -> ANormal Symbol)
-> ((ANormal Symbol -> ANormal Symbol) -> ([Mem], ANormal Symbol))
-> ForeignOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ((ANormal Symbol -> ANormal Symbol) -> ([Mem], ANormal Symbol))
-> ANormal Symbol
forall v.
Var v =>
v
-> v
-> v
-> v
-> v
-> v
-> ((ANormal v -> ANormal v) -> ([Mem], ANormal v))
-> ANormal v
outIoFailG Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
fail Symbol
result Symbol
output
    (((ANormal Symbol -> ANormal Symbol) -> ([Mem], ANormal Symbol))
 -> ForeignOp)
-> ((ANormal Symbol -> ANormal Symbol) -> ([Mem], ANormal Symbol))
-> ForeignOp
forall a b. (a -> b) -> a -> b
$ \ANormal Symbol -> ANormal Symbol
k ->
      ( [Mem
UN],
        Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
stack3 (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
stack3 (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$
          [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
            [ (Word64
0, ([], ANormal Symbol -> ANormal Symbol
k (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ ANormal Symbol
forall v. Var v => ANormal v
none)),
              (Word64
1, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
stack4 (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ANormal Symbol -> ANormal Symbol
k (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
some Symbol
stack4))
            ]
      )
  where
    (Symbol
arg, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
stack4, Symbol
fail, Symbol
output) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Maybe b
boxToMaybeBox :: ForeignOp
boxToMaybeBox :: ForeignOp
boxToMaybeBox =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> ANormal v
outMaybe Symbol
maybe Symbol
result
  where
    (Symbol
arg, Symbol
maybe, Symbol
result) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Maybe Nat
boxToMaybeNat :: ForeignOp
boxToMaybeNat :: ForeignOp
boxToMaybeNat = Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
tag (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$ Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> ANormal v
outMaybeNat Symbol
tag Symbol
result Symbol
n
  where
    (Symbol
arg, Symbol
tag, Symbol
result, Symbol
n) = (Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Maybe (Nat, b)
boxToMaybeNTup :: ForeignOp
boxToMaybeNTup :: ForeignOp
boxToMaybeNTup =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$ Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> v -> ANormal v
outMaybeNTup Symbol
a Symbol
b Symbol
c Symbol
u Symbol
bp Symbol
p Symbol
result
  where
    (Symbol
arg, Symbol
a, Symbol
b, Symbol
c, Symbol
u, Symbol
bp, Symbol
p, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> Maybe (c, d)
boxBoxToMaybeTup :: ForeignOp
boxBoxToMaybeTup :: ForeignOp
boxBoxToMaybeTup =
  Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBx Symbol
arg1 Symbol
arg2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$ Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outMaybeTup Symbol
a Symbol
b Symbol
u Symbol
bp Symbol
ap Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
a, Symbol
b, Symbol
u, Symbol
bp, Symbol
ap, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure Bool
boxToEFBool :: ForeignOp
boxToEFBool :: ForeignOp
boxToEFBool =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBool Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
bool Symbol
fail Symbol
result
  where
    (Symbol
arg, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
bool, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure Char
boxToEFChar :: ForeignOp
boxToEFChar :: ForeignOp
boxToEFChar =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailChar Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
bool Symbol
fail Symbol
result
  where
    (Symbol
arg, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
bool, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> Either Failure Bool
boxBoxToEFBool :: ForeignOp
boxBoxToEFBool :: ForeignOp
boxBoxToEFBool =
  Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBx Symbol
arg1 Symbol
arg2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBool Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
bool Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
bool, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> c -> Either Failure Bool
boxBoxBoxToEFBool :: ForeignOp
boxBoxBoxToEFBool :: ForeignOp
boxBoxBoxToEFBool =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBxBx Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailBool Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
bool Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
bool, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure ()
boxToEF0 :: ForeignOp
boxToEF0 :: ForeignOp
boxToEF0 =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
unit Symbol
fail Symbol
result
  where
    (Symbol
arg, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
unit, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> Either Failure ()
boxBoxToEF0 :: ForeignOp
boxBoxToEF0 :: ForeignOp
boxBoxToEF0 =
  Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBx Symbol
arg1 Symbol
arg2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
fail Symbol
unit Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
fail, Symbol
unit) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> c -> Either Failure ()
boxBoxBoxToEF0 :: ForeignOp
boxBoxBoxToEF0 :: ForeignOp
boxBoxBoxToEF0 =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBxBx Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
fail Symbol
unit Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
fail, Symbol
unit) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Either Failure Nat
boxToEFNat :: ForeignOp
boxToEFNat :: ForeignOp
boxToEFNat =
  Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBx Symbol
arg Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFailNat Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
nat Symbol
fail Symbol
result
  where
    (Symbol
arg, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
nat, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- Maybe a -> b -> Either Failure c
maybeBoxToEFBox :: ForeignOp
maybeBoxToEFBox :: ForeignOp
maybeBoxToEFBox =
  Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
-> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inMaybeBx Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
mb Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFail Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
mb, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> Either Failure c
boxBoxToEFBox :: ForeignOp
boxBoxToEFBox :: ForeignOp
boxBoxToEFBox =
  Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBx Symbol
arg1 Symbol
arg2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFail Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> b -> c -> Either Failure d
boxBoxBoxToEFBox :: ForeignOp
boxBoxBoxToEFBox :: ForeignOp
boxBoxBoxToEFBox =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxBxBx Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFail Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- Nat -> a
-- Nat only
natToBox :: ForeignOp
natToBox :: ForeignOp
natToBox = Reference -> ForeignOp
wordDirect Reference
Ty.natRef

-- Nat -> Nat -> a
-- Nat only
natNatToBox :: ForeignOp
natNatToBox :: ForeignOp
natNatToBox = Reference -> Reference -> ForeignOp
wordWordDirect Reference
Ty.natRef Reference
Ty.natRef

-- Nat -> Nat -> a -> b
natNatBoxToBox :: ForeignOp
natNatBoxToBox :: ForeignOp
natNatBoxToBox Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
a1, Symbol
a2, Symbol
a3]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
a1 Reference
Ty.natRef Symbol
ua1
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
a2 Reference
Ty.natRef Symbol
ua2
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
ua1, Symbol
ua2, Symbol
a3]
  where
    (Symbol
a1, Symbol
a2, Symbol
a3, Symbol
ua1, Symbol
ua2) = (Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> c
-- Nat only
boxNatToBox :: ForeignOp
boxNatToBox :: ForeignOp
boxNatToBox = Reference -> ForeignOp
boxWordDirect Reference
Ty.natRef

-- a -> Nat -> Either Failure b
boxNatToEFBox :: ForeignOp
boxNatToEFBox :: ForeignOp
boxNatToEFBox =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxNat Symbol
arg1 Symbol
arg2 Symbol
nat Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoFail Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
nat, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat ->{Exception} b
boxNatToExnBox :: ForeignOp
boxNatToExnBox :: ForeignOp
boxNatToExnBox =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxNat Symbol
arg1 Symbol
arg2 Symbol
nat Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnBox Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
fail Symbol
any Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
nat, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> b ->{Exception} ()
boxNatBoxToExnUnit :: ForeignOp
boxNatBoxToExnUnit :: ForeignOp
boxNatBoxToExnUnit =
  Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
-> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxNatBx Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
nat Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
nat, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat ->{Exception} Nat
boxNatToExnNat :: ForeignOp
boxNatToExnNat :: ForeignOp
boxNatToExnNat =
  Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inBxNat Symbol
arg1 Symbol
arg2 Symbol
nat Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnNat Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
nat, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> Nat ->{Exception} ()
boxNatNatToExnUnit :: ForeignOp
boxNatNatToExnUnit :: ForeignOp
boxNatNatToExnUnit =
  Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
-> ForeignOp
forall v.
Var v =>
v
-> v
-> v
-> v
-> v
-> v
-> ANormal v
-> Word64
-> ([Mem], ANormal v)
inBxNatNat Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
nat1 Symbol
nat2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
nat1, Symbol
nat2, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> Nat ->{Exception} b
boxNatNatToExnBox :: ForeignOp
boxNatNatToExnBox :: ForeignOp
boxNatNatToExnBox =
  Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
-> ForeignOp
forall v.
Var v =>
v
-> v
-> v
-> v
-> v
-> v
-> ANormal v
-> Word64
-> ([Mem], ANormal v)
inBxNatNat Symbol
arg1 Symbol
arg2 Symbol
arg3 Symbol
nat1 Symbol
nat2 Symbol
result (ANormal Symbol -> ForeignOp) -> ANormal Symbol -> ForeignOp
forall a b. (a -> b) -> a -> b
$
    Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnBox Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
arg1, Symbol
arg2, Symbol
arg3, Symbol
nat1, Symbol
nat2, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Nat -> b -> Nat -> Nat ->{Exception} ()
boxNatBoxNatNatToExnUnit :: ForeignOp
boxNatBoxNatNatToExnUnit :: ForeignOp
boxNatBoxNatNatToExnUnit Word64
instr =
  ([Mem
BX, Mem
BX, Mem
BX, Mem
BX, Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
a0, Symbol
a1, Symbol
a2, Symbol
a3, Symbol
a4]
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
a1 Reference
Ty.natRef Symbol
ua1
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
a3 Reference
Ty.natRef Symbol
ua3
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Reference -> Symbol -> ANormal Symbol -> ANormal Symbol
forall v. Var v => v -> Reference -> v -> ANormal v -> ANormal v
unbox Symbol
a4 Reference
Ty.natRef Symbol
ua4
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
result Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
a0, Symbol
ua1, Symbol
a2, Symbol
ua3, Symbol
ua4])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol
-> Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> ANormal Symbol
forall v. Var v => v -> v -> v -> v -> v -> v -> ANormal v
outIoExnUnit Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
result
  where
    (Symbol
a0, Symbol
a1, Symbol
a2, Symbol
a3, Symbol
a4, Symbol
ua1, Symbol
ua3, Symbol
ua4, Symbol
result, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a ->{Exception} Either b c
boxToExnEBoxBox :: ForeignOp
boxToExnEBoxBox :: ForeignOp
boxToExnEBoxBox Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
a
    (ANormal Symbol -> ANormal Symbol)
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
t0 Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
a])
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> ANormal Symbol
forall v.
Var v =>
v -> v -> v -> v -> v -> v -> v -> v -> ANormal v
outIoExnEBoxBox Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
any Symbol
fail Symbol
t0 Symbol
t1 Symbol
result
  where
    (Symbol
a, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
any, Symbol
fail, Symbol
t0, Symbol
t1, Symbol
result) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol,
 Symbol)
forall t. Fresh t => t
fresh

-- Nat -> Either Failure b
-- natToEFBox :: ForeignOp
-- natToEFBox = inNat arg nat result $ outIoFail stack1 stack2 fail result
--   where
--     (arg, nat, stack1, stack2, fail, result) = fresh

-- Nat -> Either Failure ()
natToEFUnit :: ForeignOp
natToEFUnit :: ForeignOp
natToEFUnit =
  Symbol -> Symbol -> Symbol -> ANormal Symbol -> ForeignOp
forall v.
Var v =>
v -> v -> v -> ANormal v -> Word64 -> ([Mem], ANormal v)
inNat Symbol
arg Symbol
nat Symbol
result
    (ANormal Symbol -> ForeignOp)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ForeignOp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
result
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> ForeignOp)
-> EnumMap Word64 ([Mem], ANormal Symbol) -> ForeignOp
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ Symbol
-> Symbol
-> Symbol
-> Symbol
-> Symbol
-> (Word64, ([Mem], ANormal Symbol))
forall v.
Var v =>
v -> v -> v -> v -> v -> (Word64, ([Mem], ANormal v))
failureCase Symbol
stack1 Symbol
stack2 Symbol
stack3 Symbol
unit Symbol
fail,
        ( Word64
1,
          ([],)
            (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
unit Mem
BX (Reference -> CTag -> [Symbol] -> ANormal Symbol
forall v. Var v => Reference -> CTag -> [v] -> Term ANormalF v
TCon Reference
Ty.unitRef CTag
0 [])
            (ANormal Symbol -> ([Mem], ANormal Symbol))
-> ANormal Symbol -> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
right Symbol
unit
        )
      ]
  where
    (Symbol
arg, Symbol
nat, Symbol
result, Symbol
fail, Symbol
stack1, Symbol
stack2, Symbol
stack3, Symbol
unit) = (Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

-- a -> Either b c
boxToEBoxBox :: ForeignOp
boxToEBoxBox :: ForeignOp
boxToEBoxBox Word64
instr =
  ([Mem
BX],)
    (ANormal Symbol -> ([Mem], ANormal Symbol))
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ([Mem], ANormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Symbol] -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => [v] -> Term f v -> Term f v
TAbss [Symbol
b]
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Mem -> ANormal Symbol -> ANormal Symbol -> ANormal Symbol
forall v.
Var v =>
v -> Mem -> Term ANormalF v -> Term ANormalF v -> Term ANormalF v
TLetD Symbol
e Mem
UN (Word64 -> [Symbol] -> ANormal Symbol
forall v. Var v => Word64 -> [v] -> Term ANormalF v
TFOp Word64
instr [Symbol
b])
    (ANormal Symbol -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol) -> ANormal Symbol)
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Branched (ANormal Symbol) -> ANormal Symbol
forall v.
Var v =>
v -> Branched (Term ANormalF v) -> Term ANormalF v
TMatch Symbol
e
    (Branched (ANormal Symbol) -> ANormal Symbol)
-> (EnumMap Word64 ([Mem], ANormal Symbol)
    -> Branched (ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ANormal Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap Word64 ([Mem], ANormal Symbol) -> Branched (ANormal Symbol)
forall e. EnumMap Word64 ([Mem], e) -> Branched e
MatchSum
    (EnumMap Word64 ([Mem], ANormal Symbol) -> ([Mem], ANormal Symbol))
-> EnumMap Word64 ([Mem], ANormal Symbol)
-> ([Mem], ANormal Symbol)
forall a b. (a -> b) -> a -> b
$ [(Word64, ([Mem], ANormal Symbol))]
-> EnumMap Word64 ([Mem], ANormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList
      [ (Word64
0, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
ev (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
left Symbol
ev)),
        (Word64
1, ([Mem
BX], Symbol -> ANormal Symbol -> ANormal Symbol
forall v (f :: * -> * -> *). Var v => v -> Term f v -> Term f v
TAbs Symbol
ev (ANormal Symbol -> ANormal Symbol)
-> ANormal Symbol -> ANormal Symbol
forall a b. (a -> b) -> a -> b
$ Symbol -> ANormal Symbol
forall v. Var v => v -> ANormal v
right Symbol
ev))
      ]
  where
    (Symbol
e, Symbol
b, Symbol
ev) = (Symbol, Symbol, Symbol)
forall t. Fresh t => t
fresh

builtinLookup :: Map.Map Reference (Sandbox, SuperNormal Symbol)
builtinLookup :: Map Reference (Sandbox, SuperNormal Symbol)
builtinLookup =
  [(Reference, (Sandbox, SuperNormal Symbol))]
-> Map Reference (Sandbox, SuperNormal Symbol)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(Reference, (Sandbox, SuperNormal Symbol))]
 -> Map Reference (Sandbox, SuperNormal Symbol))
-> ([(Text, (Sandbox, SuperNormal Symbol))]
    -> [(Reference, (Sandbox, SuperNormal Symbol))])
-> [(Text, (Sandbox, SuperNormal Symbol))]
-> Map Reference (Sandbox, SuperNormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, (Sandbox, SuperNormal Symbol))
 -> (Reference, (Sandbox, SuperNormal Symbol)))
-> [(Text, (Sandbox, SuperNormal Symbol))]
-> [(Reference, (Sandbox, SuperNormal Symbol))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
t, (Sandbox, SuperNormal Symbol)
f) -> (Text -> Reference
forall t h. t -> Reference' t h
Builtin Text
t, (Sandbox, SuperNormal Symbol)
f))
    ([(Text, (Sandbox, SuperNormal Symbol))]
 -> Map Reference (Sandbox, SuperNormal Symbol))
-> [(Text, (Sandbox, SuperNormal Symbol))]
-> Map Reference (Sandbox, SuperNormal Symbol)
forall a b. (a -> b) -> a -> b
$ [ (Text
"Int.+", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
addi)),
        (Text
"Int.-", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
subi)),
        (Text
"Int.*", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
muli)),
        (Text
"Int./", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
divi)),
        (Text
"Int.mod", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
modi)),
        (Text
"Int.==", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
eqi)),
        (Text
"Int.<", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
lti)),
        (Text
"Int.<=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
lei)),
        (Text
"Int.>", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
gti)),
        (Text
"Int.>=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
gei)),
        (Text
"Int.fromRepresentation", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
forall v. Var v => Reference -> Reference -> SuperNormal v
coerceType Reference
Ty.natRef Reference
Ty.intRef)),
        (Text
"Int.toRepresentation", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
forall v. Var v => Reference -> Reference -> SuperNormal v
coerceType Reference
Ty.intRef Reference
Ty.natRef)),
        (Text
"Int.increment", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
inci)),
        (Text
"Int.signum", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
sgni)),
        (Text
"Int.negate", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
negi)),
        (Text
"Int.truncate0", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
trni)),
        (Text
"Int.isEven", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
evni)),
        (Text
"Int.isOdd", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
oddi)),
        (Text
"Int.shiftLeft", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
shli)),
        (Text
"Int.shiftRight", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
shri)),
        (Text
"Int.trailingZeros", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
tzeroi)),
        (Text
"Int.leadingZeros", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
lzeroi)),
        (Text
"Int.and", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
andi)),
        (Text
"Int.or", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
ori)),
        (Text
"Int.xor", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
xori)),
        (Text
"Int.complement", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
compli)),
        (Text
"Int.pow", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
powi)),
        (Text
"Int.toText", (Sandbox
Untracked, SuperNormal Symbol
i2t)),
        (Text
"Int.fromText", (Sandbox
Untracked, SuperNormal Symbol
t2i)),
        (Text
"Int.toFloat", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
i2f)),
        (Text
"Int.popCount", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
popi)),
        (Text
"Nat.+", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
addn)),
        (Text
"Nat.-", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
subn)),
        (Text
"Nat.sub", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
subn)),
        (Text
"Nat.*", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
muln)),
        (Text
"Nat./", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
divn)),
        (Text
"Nat.mod", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
modn)),
        (Text
"Nat.==", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
eqn)),
        (Text
"Nat.<", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
ltn)),
        (Text
"Nat.<=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
len)),
        (Text
"Nat.>", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
gtn)),
        (Text
"Nat.>=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
gen)),
        (Text
"Nat.increment", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
incn)),
        (Text
"Nat.isEven", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
evnn)),
        (Text
"Nat.isOdd", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
oddn)),
        (Text
"Nat.shiftLeft", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
shln)),
        (Text
"Nat.shiftRight", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
shrn)),
        (Text
"Nat.trailingZeros", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
tzeron)),
        (Text
"Nat.leadingZeros", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
lzeron)),
        (Text
"Nat.and", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
andn)),
        (Text
"Nat.or", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
orn)),
        (Text
"Nat.xor", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
xorn)),
        (Text
"Nat.complement", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
compln)),
        (Text
"Nat.pow", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
pown)),
        (Text
"Nat.drop", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
dropn)),
        (Text
"Nat.toInt", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
cast Reference
Ty.natRef Reference
Ty.intRef)),
        (Text
"Nat.toFloat", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
n2f)),
        (Text
"Nat.toText", (Sandbox
Untracked, SuperNormal Symbol
n2t)),
        (Text
"Nat.fromText", (Sandbox
Untracked, SuperNormal Symbol
t2n)),
        (Text
"Nat.popCount", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
popn)),
        (Text
"Float.+", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
addf)),
        (Text
"Float.-", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
subf)),
        (Text
"Float.*", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
mulf)),
        (Text
"Float./", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
divf)),
        (Text
"Float.pow", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
powf)),
        (Text
"Float.log", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
logf)),
        (Text
"Float.logBase", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
logbf)),
        (Text
"Float.sqrt", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
sqrtf)),
        (Text
"Float.fromRepresentation", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
forall v. Var v => Reference -> Reference -> SuperNormal v
coerceType Reference
Ty.natRef Reference
Ty.floatRef)),
        (Text
"Float.toRepresentation", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
forall v. Var v => Reference -> Reference -> SuperNormal v
coerceType Reference
Ty.floatRef Reference
Ty.natRef)),
        (Text
"Float.min", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
minf)),
        (Text
"Float.max", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
maxf)),
        (Text
"Float.<", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
ltf)),
        (Text
"Float.>", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
gtf)),
        (Text
"Float.<=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
lef)),
        (Text
"Float.>=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
gef)),
        (Text
"Float.==", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
eqf)),
        (Text
"Float.!=", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
neqf)),
        (Text
"Float.acos", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
acosf)),
        (Text
"Float.asin", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
asinf)),
        (Text
"Float.atan", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
atanf)),
        (Text
"Float.cos", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
cosf)),
        (Text
"Float.sin", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
sinf)),
        (Text
"Float.tan", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
tanf)),
        (Text
"Float.acosh", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
acoshf)),
        (Text
"Float.asinh", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
asinhf)),
        (Text
"Float.atanh", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
atanhf)),
        (Text
"Float.cosh", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
coshf)),
        (Text
"Float.sinh", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
sinhf)),
        (Text
"Float.tanh", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
tanhf)),
        (Text
"Float.exp", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
expf)),
        (Text
"Float.abs", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
absf)),
        (Text
"Float.ceiling", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
ceilf)),
        (Text
"Float.floor", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
floorf)),
        (Text
"Float.round", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
roundf)),
        (Text
"Float.truncate", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
truncf)),
        (Text
"Float.atan2", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
atan2f)),
        (Text
"Float.toText", (Sandbox
Untracked, SuperNormal Symbol
f2t)),
        (Text
"Float.fromText", (Sandbox
Untracked, SuperNormal Symbol
t2f)),
        -- text
        (Text
"Text.empty", (Sandbox
Untracked, [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda [] (ANormal Symbol -> SuperNormal Symbol)
-> ANormal Symbol -> SuperNormal Symbol
forall a b. (a -> b) -> a -> b
$ Lit -> ANormal Symbol
forall v. Var v => Lit -> Term ANormalF v
TLit (Text -> Lit
T Text
""))),
        (Text
"Text.++", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
appendt)),
        (Text
"Text.take", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
taket)),
        (Text
"Text.drop", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
dropt)),
        (Text
"Text.indexOf", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
indext)),
        (Text
"Text.size", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
sizet)),
        (Text
"Text.==", (Sandbox
Untracked, SuperNormal Symbol
eqt)),
        (Text
"Text.!=", (Sandbox
Untracked, SuperNormal Symbol
neqt)),
        (Text
"Text.<=", (Sandbox
Untracked, SuperNormal Symbol
leqt)),
        (Text
"Text.>=", (Sandbox
Untracked, SuperNormal Symbol
geqt)),
        (Text
"Text.<", (Sandbox
Untracked, SuperNormal Symbol
lesst)),
        (Text
"Text.>", (Sandbox
Untracked, SuperNormal Symbol
great)),
        (Text
"Text.uncons", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
unconst)),
        (Text
"Text.unsnoc", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
unsnoct)),
        (Text
"Text.toCharList", (Sandbox
Untracked, SuperNormal Symbol
unpackt)),
        (Text
"Text.fromCharList", (Sandbox
Untracked, SuperNormal Symbol
packt)),
        (Text
"Boolean.not", (Sandbox
Untracked, SuperNormal Symbol
notb)),
        (Text
"Boolean.or", (Sandbox
Untracked, SuperNormal Symbol
orb)),
        (Text
"Boolean.and", (Sandbox
Untracked, SuperNormal Symbol
andb)),
        (Text
"bug", (Sandbox
Untracked, Text -> SuperNormal Symbol
bug Text
"builtin.bug")),
        (Text
"todo", (Sandbox
Untracked, Text -> SuperNormal Symbol
bug Text
"builtin.todo")),
        (Text
"Debug.watch", (Sandbox
Tracked, SuperNormal Symbol
watch)),
        (Text
"Debug.trace", (Sandbox
Tracked, SuperNormal Symbol
gen'trace)),
        (Text
"Debug.toText", (Sandbox
Tracked, SuperNormal Symbol
debug'text)),
        (Text
"unsafe.coerceAbilities", (Sandbox
Untracked, SuperNormal Symbol
poly'coerce)),
        (Text
"Char.toNat", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
cast Reference
Ty.charRef Reference
Ty.natRef)),
        (Text
"Char.fromNat", (Sandbox
Untracked, Reference -> Reference -> SuperNormal Symbol
cast Reference
Ty.natRef Reference
Ty.charRef)),
        (Text
"Bytes.empty", (Sandbox
Untracked, SuperNormal Symbol
emptyb)),
        (Text
"Bytes.fromList", (Sandbox
Untracked, SuperNormal Symbol
packb)),
        (Text
"Bytes.toList", (Sandbox
Untracked, SuperNormal Symbol
unpackb)),
        (Text
"Bytes.++", (Sandbox
Untracked, SuperNormal Symbol
appendb)),
        (Text
"Bytes.take", (Sandbox
Untracked, SuperNormal Symbol
takeb)),
        (Text
"Bytes.drop", (Sandbox
Untracked, SuperNormal Symbol
dropb)),
        (Text
"Bytes.at", (Sandbox
Untracked, SuperNormal Symbol
atb)),
        (Text
"Bytes.indexOf", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
indexb)),
        (Text
"Bytes.size", (Sandbox
Untracked, SuperNormal Symbol
sizeb)),
        (Text
"Bytes.flatten", (Sandbox
Untracked, SuperNormal Symbol
flattenb)),
        (Text
"List.take", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
takes)),
        (Text
"List.drop", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
drops)),
        (Text
"List.size", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
sizes)),
        (Text
"List.++", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
appends)),
        (Text
"List.at", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
ats)),
        (Text
"List.cons", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
conss)),
        (Text
"List.snoc", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
snocs)),
        (Text
"List.empty", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
emptys)),
        (Text
"List.viewl", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
viewls)),
        (Text
"List.viewr", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
viewrs)),
        (Text
"List.splitLeft", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
splitls)),
        (Text
"List.splitRight", (Sandbox
Untracked, SuperNormal Symbol
forall v. Var v => SuperNormal v
splitrs)),
        --
        --   , B "Debug.watch" $ forall1 "a" (\a -> text --> a --> a)
        (Text
"Universal.==", (Sandbox
Untracked, SuperNormal Symbol
equ)),
        (Text
"Universal.compare", (Sandbox
Untracked, SuperNormal Symbol
cmpu)),
        (Text
"Universal.>", (Sandbox
Untracked, SuperNormal Symbol
gtu)),
        (Text
"Universal.<", (Sandbox
Untracked, SuperNormal Symbol
ltu)),
        (Text
"Universal.>=", (Sandbox
Untracked, SuperNormal Symbol
geu)),
        (Text
"Universal.<=", (Sandbox
Untracked, SuperNormal Symbol
leu)),
        -- internal stuff
        (Text
"jumpCont", (Sandbox
Untracked, SuperNormal Symbol
jumpk)),
        (Text
"raise", (Sandbox
Untracked, SuperNormal Symbol
raise)),
        (Text
"IO.forkComp.v2", (Sandbox
Tracked, SuperNormal Symbol
fork'comp)),
        (Text
"Scope.run", (Sandbox
Untracked, SuperNormal Symbol
scope'run)),
        (Text
"Code.isMissing", (Sandbox
Tracked, SuperNormal Symbol
code'missing)),
        (Text
"Code.cache_", (Sandbox
Tracked, SuperNormal Symbol
code'cache)),
        (Text
"Code.lookup", (Sandbox
Tracked, SuperNormal Symbol
code'lookup)),
        (Text
"Code.validate", (Sandbox
Tracked, SuperNormal Symbol
code'validate)),
        (Text
"Value.load", (Sandbox
Tracked, SuperNormal Symbol
value'load)),
        (Text
"Value.value", (Sandbox
Tracked, SuperNormal Symbol
value'create)),
        (Text
"Any.Any", (Sandbox
Untracked, SuperNormal Symbol
any'construct)),
        (Text
"Any.unsafeExtract", (Sandbox
Untracked, SuperNormal Symbol
any'extract)),
        (Text
"Link.Term.toText", (Sandbox
Untracked, SuperNormal Symbol
term'link'to'text)),
        (Text
"STM.atomically", (Sandbox
Tracked, SuperNormal Symbol
stm'atomic)),
        (Text
"validateSandboxed", (Sandbox
Untracked, SuperNormal Symbol
check'sandbox)),
        (Text
"Value.validateSandboxed", (Sandbox
Tracked, SuperNormal Symbol
value'sandbox)),
        (Text
"sandboxLinks", (Sandbox
Tracked, SuperNormal Symbol
sandbox'links)),
        (Text
"IO.tryEval", (Sandbox
Tracked, SuperNormal Symbol
try'eval))
      ]
      [(Text, (Sandbox, SuperNormal Symbol))]
-> [(Text, (Sandbox, SuperNormal Symbol))]
-> [(Text, (Sandbox, SuperNormal Symbol))]
forall a. [a] -> [a] -> [a]
++ [(Text, (Sandbox, SuperNormal Symbol))]
foreignWrappers

type FDecl v =
  ReaderT Bool (State (Word64, [(Data.Text.Text, (Sandbox, SuperNormal v))], EnumMap Word64 (Data.Text.Text, ForeignFunc)))

-- Data type to determine whether a builtin should be tracked for
-- sandboxing. Untracked means that it can be freely used, and Tracked
-- means that the sandboxing check will by default consider them
-- disallowed.
data Sandbox = Tracked | Untracked
  deriving (Sandbox -> Sandbox -> Bool
(Sandbox -> Sandbox -> Bool)
-> (Sandbox -> Sandbox -> Bool) -> Eq Sandbox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sandbox -> Sandbox -> Bool
== :: Sandbox -> Sandbox -> Bool
$c/= :: Sandbox -> Sandbox -> Bool
/= :: Sandbox -> Sandbox -> Bool
Eq, Eq Sandbox
Eq Sandbox =>
(Sandbox -> Sandbox -> Ordering)
-> (Sandbox -> Sandbox -> Bool)
-> (Sandbox -> Sandbox -> Bool)
-> (Sandbox -> Sandbox -> Bool)
-> (Sandbox -> Sandbox -> Bool)
-> (Sandbox -> Sandbox -> Sandbox)
-> (Sandbox -> Sandbox -> Sandbox)
-> Ord Sandbox
Sandbox -> Sandbox -> Bool
Sandbox -> Sandbox -> Ordering
Sandbox -> Sandbox -> Sandbox
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sandbox -> Sandbox -> Ordering
compare :: Sandbox -> Sandbox -> Ordering
$c< :: Sandbox -> Sandbox -> Bool
< :: Sandbox -> Sandbox -> Bool
$c<= :: Sandbox -> Sandbox -> Bool
<= :: Sandbox -> Sandbox -> Bool
$c> :: Sandbox -> Sandbox -> Bool
> :: Sandbox -> Sandbox -> Bool
$c>= :: Sandbox -> Sandbox -> Bool
>= :: Sandbox -> Sandbox -> Bool
$cmax :: Sandbox -> Sandbox -> Sandbox
max :: Sandbox -> Sandbox -> Sandbox
$cmin :: Sandbox -> Sandbox -> Sandbox
min :: Sandbox -> Sandbox -> Sandbox
Ord, Int -> Sandbox -> ShowS
[Sandbox] -> ShowS
Sandbox -> String
(Int -> Sandbox -> ShowS)
-> (Sandbox -> String) -> ([Sandbox] -> ShowS) -> Show Sandbox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sandbox -> ShowS
showsPrec :: Int -> Sandbox -> ShowS
$cshow :: Sandbox -> String
show :: Sandbox -> String
$cshowList :: [Sandbox] -> ShowS
showList :: [Sandbox] -> ShowS
Show, ReadPrec [Sandbox]
ReadPrec Sandbox
Int -> ReadS Sandbox
ReadS [Sandbox]
(Int -> ReadS Sandbox)
-> ReadS [Sandbox]
-> ReadPrec Sandbox
-> ReadPrec [Sandbox]
-> Read Sandbox
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Sandbox
readsPrec :: Int -> ReadS Sandbox
$creadList :: ReadS [Sandbox]
readList :: ReadS [Sandbox]
$creadPrec :: ReadPrec Sandbox
readPrec :: ReadPrec Sandbox
$creadListPrec :: ReadPrec [Sandbox]
readListPrec :: ReadPrec [Sandbox]
Read, Int -> Sandbox
Sandbox -> Int
Sandbox -> [Sandbox]
Sandbox -> Sandbox
Sandbox -> Sandbox -> [Sandbox]
Sandbox -> Sandbox -> Sandbox -> [Sandbox]
(Sandbox -> Sandbox)
-> (Sandbox -> Sandbox)
-> (Int -> Sandbox)
-> (Sandbox -> Int)
-> (Sandbox -> [Sandbox])
-> (Sandbox -> Sandbox -> [Sandbox])
-> (Sandbox -> Sandbox -> [Sandbox])
-> (Sandbox -> Sandbox -> Sandbox -> [Sandbox])
-> Enum Sandbox
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Sandbox -> Sandbox
succ :: Sandbox -> Sandbox
$cpred :: Sandbox -> Sandbox
pred :: Sandbox -> Sandbox
$ctoEnum :: Int -> Sandbox
toEnum :: Int -> Sandbox
$cfromEnum :: Sandbox -> Int
fromEnum :: Sandbox -> Int
$cenumFrom :: Sandbox -> [Sandbox]
enumFrom :: Sandbox -> [Sandbox]
$cenumFromThen :: Sandbox -> Sandbox -> [Sandbox]
enumFromThen :: Sandbox -> Sandbox -> [Sandbox]
$cenumFromTo :: Sandbox -> Sandbox -> [Sandbox]
enumFromTo :: Sandbox -> Sandbox -> [Sandbox]
$cenumFromThenTo :: Sandbox -> Sandbox -> Sandbox -> [Sandbox]
enumFromThenTo :: Sandbox -> Sandbox -> Sandbox -> [Sandbox]
Enum, Sandbox
Sandbox -> Sandbox -> Bounded Sandbox
forall a. a -> a -> Bounded a
$cminBound :: Sandbox
minBound :: Sandbox
$cmaxBound :: Sandbox
maxBound :: Sandbox
Bounded)

bomb :: Data.Text.Text -> a -> IO r
bomb :: forall a r. Text -> a -> IO r
bomb Text
name a
_ = String -> IO r
forall a. HasCallStack => String -> IO a
die (String -> IO r) -> String -> IO r
forall a b. (a -> b) -> a -> b
$ String
"attempted to use sandboxed operation: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Data.Text.unpack Text
name

declareForeign ::
  Sandbox ->
  Data.Text.Text ->
  ForeignOp ->
  ForeignFunc ->
  FDecl Symbol ()
declareForeign :: Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
sand Text
name ForeignOp
op ForeignFunc
func0 = do
  Bool
sanitize <- ReaderT
  Bool
  (State
     (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
      EnumMap Word64 (Text, ForeignFunc)))
  Bool
forall r (m :: * -> *). MonadReader r m => m r
ask
  ((Word64, [(Text, (Sandbox, SuperNormal Symbol))],
  EnumMap Word64 (Text, ForeignFunc))
 -> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
     EnumMap Word64 (Text, ForeignFunc)))
-> FDecl Symbol ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Word64, [(Text, (Sandbox, SuperNormal Symbol))],
   EnumMap Word64 (Text, ForeignFunc))
  -> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
      EnumMap Word64 (Text, ForeignFunc)))
 -> FDecl Symbol ())
-> ((Word64, [(Text, (Sandbox, SuperNormal Symbol))],
     EnumMap Word64 (Text, ForeignFunc))
    -> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
        EnumMap Word64 (Text, ForeignFunc)))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Word64
w, [(Text, (Sandbox, SuperNormal Symbol))]
codes, EnumMap Word64 (Text, ForeignFunc)
funcs) ->
    let func :: ForeignFunc
func
          | Bool
sanitize,
            Sandbox
Tracked <- Sandbox
sand,
            FF Stack 'UN -> Stack 'BX -> Args -> IO a
r Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX)
w a -> IO r
_ <- ForeignFunc
func0 =
              (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
r Stack 'UN -> Stack 'BX -> r -> IO (Stack 'UN, Stack 'BX)
w (Text -> a -> IO r
forall a r. Text -> a -> IO r
bomb Text
name)
          | Bool
otherwise = ForeignFunc
func0
        code :: (Text, (Sandbox, SuperNormal Symbol))
code = (Text
name, (Sandbox
sand, ([Mem] -> ANormal Symbol -> SuperNormal Symbol)
-> ([Mem], ANormal Symbol) -> SuperNormal Symbol
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Mem] -> ANormal Symbol -> SuperNormal Symbol
forall v. [Mem] -> ANormal v -> SuperNormal v
Lambda (ForeignOp
op Word64
w)))
     in (Word64
w Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, (Text, (Sandbox, SuperNormal Symbol))
code (Text, (Sandbox, SuperNormal Symbol))
-> [(Text, (Sandbox, SuperNormal Symbol))]
-> [(Text, (Sandbox, SuperNormal Symbol))]
forall a. a -> [a] -> [a]
: [(Text, (Sandbox, SuperNormal Symbol))]
codes, Word64
-> (Text, ForeignFunc)
-> EnumMap Word64 (Text, ForeignFunc)
-> EnumMap Word64 (Text, ForeignFunc)
forall k a. EnumKey k => k -> a -> EnumMap k a -> EnumMap k a
mapInsert Word64
w (Text
name, ForeignFunc
func) EnumMap Word64 (Text, ForeignFunc)
funcs)

mkForeignIOF ::
  (ForeignConvention a, ForeignConvention r) =>
  (a -> IO r) ->
  ForeignFunc
mkForeignIOF :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF a -> IO r
f = (a -> IO (Either (Failure Closure) r)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((a -> IO (Either (Failure Closure) r)) -> ForeignFunc)
-> (a -> IO (Either (Failure Closure) r)) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$ \a
a -> IO r -> IO (Either (Failure Closure) r)
forall a. IO a -> IO (Either (Failure Closure) a)
tryIOE (a -> IO r
f a
a)
  where
    tryIOE :: IO a -> IO (Either Failure a)
    tryIOE :: forall a. IO a -> IO (Either (Failure Closure) a)
tryIOE = (Either IOException a -> Either (Failure Closure) a)
-> IO (Either IOException a) -> IO (Either (Failure Closure) a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IOException a -> Either (Failure Closure) a
forall a. Either IOException a -> Either (Failure Closure) a
handleIOE (IO (Either IOException a) -> IO (Either (Failure Closure) a))
-> (IO a -> IO (Either IOException a))
-> IO a
-> IO (Either (Failure Closure) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either IOException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
    handleIOE :: Either IOException a -> Either Failure a
    handleIOE :: forall a. Either IOException a -> Either (Failure Closure) a
handleIOE (Left IOException
e) = Failure Closure -> Either (Failure Closure) a
forall a b. a -> Either a b
Left (Failure Closure -> Either (Failure Closure) a)
-> Failure Closure -> Either (Failure Closure) a
forall a b. (a -> b) -> a -> b
$ Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack (IOException -> String
forall a. Show a => a -> String
show IOException
e)) Closure
unitValue
    handleIOE (Right a
a) = a -> Either (Failure Closure) a
forall a b. b -> Either a b
Right a
a

unitValue :: Closure
unitValue :: Closure
unitValue = Reference -> Word64 -> Closure
forall comb. Reference -> Word64 -> GClosure comb
Closure.Enum Reference
Ty.unitRef Word64
0

natValue :: Word64 -> Closure
natValue :: Word64 -> Closure
natValue Word64
w = Reference -> Word64 -> Int -> Closure
forall comb. Reference -> Word64 -> Int -> GClosure comb
Closure.DataU1 Reference
Ty.natRef Word64
0 (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w)

mkForeignTls ::
  forall a r.
  (ForeignConvention a, ForeignConvention r) =>
  (a -> IO r) ->
  ForeignFunc
mkForeignTls :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls a -> IO r
f = (a -> IO (Either (Failure Closure) r)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((a -> IO (Either (Failure Closure) r)) -> ForeignFunc)
-> (a -> IO (Either (Failure Closure) r)) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$ \a
a -> (Either IOException (Either TLSException r)
 -> Either (Failure Closure) r)
-> IO (Either IOException (Either TLSException r))
-> IO (Either (Failure Closure) r)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either IOException (Either TLSException r)
-> Either (Failure Closure) r
flatten (IO (Either TLSException r)
-> IO (Either IOException (Either TLSException r))
tryIO2 (IO r -> IO (Either TLSException r)
tryIO1 (a -> IO r
f a
a)))
  where
    tryIO1 :: IO r -> IO (Either TLS.TLSException r)
    tryIO1 :: IO r -> IO (Either TLSException r)
tryIO1 = IO r -> IO (Either TLSException r)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
    tryIO2 :: IO (Either TLS.TLSException r) -> IO (Either IOException (Either TLS.TLSException r))
    tryIO2 :: IO (Either TLSException r)
-> IO (Either IOException (Either TLSException r))
tryIO2 = IO (Either TLSException r)
-> IO (Either IOException (Either TLSException r))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
    flatten :: Either IOException (Either TLS.TLSException r) -> Either (Failure) r
    flatten :: Either IOException (Either TLSException r)
-> Either (Failure Closure) r
flatten (Left IOException
e) = Failure Closure -> Either (Failure Closure) r
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack (IOException -> String
forall a. Show a => a -> String
show IOException
e)) Closure
unitValue)
    flatten (Right (Left TLSException
e)) = Failure Closure -> Either (Failure Closure) r
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.tlsFailureRef (String -> Text
Util.Text.pack (TLSException -> String
forall a. Show a => a -> String
show TLSException
e)) Closure
unitValue)
    flatten (Right (Right r
a)) = r -> Either (Failure Closure) r
forall a b. b -> Either a b
Right r
a

mkForeignTlsE ::
  forall a r.
  (ForeignConvention a, ForeignConvention r) =>
  (a -> IO (Either Failure r)) ->
  ForeignFunc
mkForeignTlsE :: forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO (Either (Failure Closure) r)) -> ForeignFunc
mkForeignTlsE a -> IO (Either (Failure Closure) r)
f = (a -> IO (Either (Failure Closure) r)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((a -> IO (Either (Failure Closure) r)) -> ForeignFunc)
-> (a -> IO (Either (Failure Closure) r)) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$ \a
a -> (Either
   IOException (Either TLSException (Either (Failure Closure) r))
 -> Either (Failure Closure) r)
-> IO
     (Either
        IOException (Either TLSException (Either (Failure Closure) r)))
-> IO (Either (Failure Closure) r)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either
  IOException (Either TLSException (Either (Failure Closure) r))
-> Either (Failure Closure) r
flatten (IO (Either TLSException (Either (Failure Closure) r))
-> IO
     (Either
        IOException (Either TLSException (Either (Failure Closure) r)))
tryIO2 (IO (Either (Failure Closure) r)
-> IO (Either TLSException (Either (Failure Closure) r))
tryIO1 (a -> IO (Either (Failure Closure) r)
f a
a)))
  where
    tryIO1 :: IO (Either Failure r) -> IO (Either TLS.TLSException (Either Failure r))
    tryIO1 :: IO (Either (Failure Closure) r)
-> IO (Either TLSException (Either (Failure Closure) r))
tryIO1 = IO (Either (Failure Closure) r)
-> IO (Either TLSException (Either (Failure Closure) r))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
    tryIO2 :: IO (Either TLS.TLSException (Either Failure r)) -> IO (Either IOException (Either TLS.TLSException (Either Failure r)))
    tryIO2 :: IO (Either TLSException (Either (Failure Closure) r))
-> IO
     (Either
        IOException (Either TLSException (Either (Failure Closure) r)))
tryIO2 = IO (Either TLSException (Either (Failure Closure) r))
-> IO
     (Either
        IOException (Either TLSException (Either (Failure Closure) r)))
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try
    flatten :: Either IOException (Either TLS.TLSException (Either Failure r)) -> Either Failure r
    flatten :: Either
  IOException (Either TLSException (Either (Failure Closure) r))
-> Either (Failure Closure) r
flatten (Left IOException
e) = Failure Closure -> Either (Failure Closure) r
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack (IOException -> String
forall a. Show a => a -> String
show IOException
e)) Closure
unitValue)
    flatten (Right (Left TLSException
e)) = Failure Closure -> Either (Failure Closure) r
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.tlsFailureRef (String -> Text
Util.Text.pack (TLSException -> String
forall a. Show a => a -> String
show TLSException
e)) Closure
unitValue)
    flatten (Right (Right (Left Failure Closure
e))) = Failure Closure -> Either (Failure Closure) r
forall a b. a -> Either a b
Left Failure Closure
e
    flatten (Right (Right (Right r
a))) = r -> Either (Failure Closure) r
forall a b. b -> Either a b
Right r
a

declareUdpForeigns :: FDecl Symbol ()
declareUdpForeigns :: FDecl Symbol ()
declareUdpForeigns = do
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.clientSocket.impl.v1" ForeignOp
boxBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Text, Text) -> IO UDPSocket) -> ForeignFunc)
-> ((Text, Text) -> IO UDPSocket)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> IO UDPSocket) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Text, Text) -> IO UDPSocket) -> FDecl Symbol ())
-> ((Text, Text) -> IO UDPSocket) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Text
host :: Util.Text.Text, Text
port :: Util.Text.Text) ->
      let hostStr :: String
hostStr = Text -> String
Util.Text.toString Text
host
          portStr :: String
portStr = Text -> String
Util.Text.toString Text
port
       in String -> String -> Bool -> IO UDPSocket
UDP.clientSocket String
hostStr String
portStr Bool
True

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.UDPSocket.recv.impl.v1" ForeignOp
boxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> ((UDPSocket -> IO Bytes) -> ForeignFunc)
-> (UDPSocket -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UDPSocket -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((UDPSocket -> IO Bytes) -> FDecl Symbol ())
-> (UDPSocket -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(UDPSocket
sock :: UDPSocket) -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDPSocket -> IO ByteString
UDP.recv UDPSocket
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.UDPSocket.send.impl.v1" ForeignOp
boxBoxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> (((UDPSocket, Bytes) -> IO ()) -> ForeignFunc)
-> ((UDPSocket, Bytes) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UDPSocket, Bytes) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((UDPSocket, Bytes) -> IO ()) -> FDecl Symbol ())
-> ((UDPSocket, Bytes) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(UDPSocket
sock :: UDPSocket, Bytes
bytes :: Bytes.Bytes) ->
      UDPSocket -> ByteString -> IO ()
UDP.send UDPSocket
sock (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bytes)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.UDPSocket.close.impl.v1" ForeignOp
boxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> ((UDPSocket -> IO ()) -> ForeignFunc)
-> (UDPSocket -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UDPSocket -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((UDPSocket -> IO ()) -> FDecl Symbol ())
-> (UDPSocket -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(UDPSocket
sock :: UDPSocket) -> UDPSocket -> IO ()
UDP.close UDPSocket
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.ListenSocket.close.impl.v1" ForeignOp
boxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> ((ListenSocket -> IO ()) -> ForeignFunc)
-> (ListenSocket -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListenSocket -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((ListenSocket -> IO ()) -> FDecl Symbol ())
-> (ListenSocket -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(ListenSocket
sock :: ListenSocket) -> ListenSocket -> IO ()
UDP.stop ListenSocket
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.UDPSocket.toText.impl.v1" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((UDPSocket -> IO String) -> ForeignFunc)
-> (UDPSocket -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UDPSocket -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((UDPSocket -> IO String) -> FDecl Symbol ())
-> (UDPSocket -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(UDPSocket
sock :: UDPSocket) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ UDPSocket -> String
forall a. Show a => a -> String
show UDPSocket
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.serverSocket.impl.v1" ForeignOp
boxBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Text, Text) -> IO ListenSocket) -> ForeignFunc)
-> ((Text, Text) -> IO ListenSocket)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> IO ListenSocket) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Text, Text) -> IO ListenSocket) -> FDecl Symbol ())
-> ((Text, Text) -> IO ListenSocket) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Text
ip :: Util.Text.Text, Text
port :: Util.Text.Text) ->
      let maybeIp :: Maybe IP
maybeIp = String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IP) -> String -> Maybe IP
forall a b. (a -> b) -> a -> b
$ Text -> String
Util.Text.toString Text
ip :: Maybe IP
          maybePort :: Maybe PortNumber
maybePort = String -> Maybe PortNumber
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe PortNumber) -> String -> Maybe PortNumber
forall a b. (a -> b) -> a -> b
$ Text -> String
Util.Text.toString Text
port :: Maybe PortNumber
       in case (Maybe IP
maybeIp, Maybe PortNumber
maybePort) of
            (Maybe IP
Nothing, Maybe PortNumber
_) -> String -> IO ListenSocket
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid IP Address"
            (Maybe IP
_, Maybe PortNumber
Nothing) -> String -> IO ListenSocket
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Port Number"
            (Just IP
ip, Just PortNumber
pt) -> (IP, PortNumber) -> IO ListenSocket
UDP.serverSocket (IP
ip, PortNumber
pt)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.ListenSocket.toText.impl.v1" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((ListenSocket -> IO String) -> ForeignFunc)
-> (ListenSocket -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListenSocket -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((ListenSocket -> IO String) -> FDecl Symbol ())
-> (ListenSocket -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(ListenSocket
sock :: ListenSocket) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ListenSocket -> String
forall a. Show a => a -> String
show ListenSocket
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.ListenSocket.recvFrom.impl.v1" ForeignOp
boxToEFTup
    (ForeignFunc -> FDecl Symbol ())
-> ((ListenSocket -> IO (Bytes, ClientSockAddr)) -> ForeignFunc)
-> (ListenSocket -> IO (Bytes, ClientSockAddr))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListenSocket -> IO (Bytes, ClientSockAddr)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((ListenSocket -> IO (Bytes, ClientSockAddr)) -> FDecl Symbol ())
-> (ListenSocket -> IO (Bytes, ClientSockAddr)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ ((ByteString, ClientSockAddr) -> (Bytes, ClientSockAddr))
-> IO (ByteString, ClientSockAddr) -> IO (Bytes, ClientSockAddr)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Bytes)
-> (ByteString, ClientSockAddr) -> (Bytes, ClientSockAddr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray) (IO (ByteString, ClientSockAddr) -> IO (Bytes, ClientSockAddr))
-> (ListenSocket -> IO (ByteString, ClientSockAddr))
-> ListenSocket
-> IO (Bytes, ClientSockAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListenSocket -> IO (ByteString, ClientSockAddr)
UDP.recvFrom

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.ClientSockAddr.toText.v1" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((ClientSockAddr -> IO String) -> ForeignFunc)
-> (ClientSockAddr -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientSockAddr -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((ClientSockAddr -> IO String) -> FDecl Symbol ())
-> (ClientSockAddr -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(ClientSockAddr
sock :: ClientSockAddr) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ClientSockAddr -> String
forall a. Show a => a -> String
show ClientSockAddr
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.UDP.ListenSocket.sendTo.impl.v1" ForeignOp
boxBoxBoxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> (((ListenSocket, Bytes, ClientSockAddr) -> IO ())
    -> ForeignFunc)
-> ((ListenSocket, Bytes, ClientSockAddr) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ListenSocket, Bytes, ClientSockAddr) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((ListenSocket, Bytes, ClientSockAddr) -> IO ())
 -> FDecl Symbol ())
-> ((ListenSocket, Bytes, ClientSockAddr) -> IO ())
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(ListenSocket
socket :: ListenSocket, Bytes
bytes :: Bytes.Bytes, ClientSockAddr
addr :: ClientSockAddr) ->
      ListenSocket -> ByteString -> ClientSockAddr -> IO ()
UDP.sendTo ListenSocket
socket (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bytes) ClientSockAddr
addr

declareForeigns :: FDecl Symbol ()
declareForeigns :: FDecl Symbol ()
declareForeigns = do
  FDecl Symbol ()
declareUdpForeigns
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.openFile.impl.v3" ForeignOp
boxIomrToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    ((Text, Int) -> IO Handle) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((Text, Int) -> IO Handle) -> ForeignFunc)
-> ((Text, Int) -> IO Handle) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$ \(Text
fnameText :: Util.Text.Text, Int
n :: Int) ->
      let fname :: String
fname = Text -> String
Util.Text.toString Text
fnameText
          mode :: IOMode
mode = case Int
n of
            Int
0 -> IOMode
ReadMode
            Int
1 -> IOMode
WriteMode
            Int
2 -> IOMode
AppendMode
            Int
_ -> IOMode
ReadWriteMode
       in String -> IOMode -> IO Handle
openFile String
fname IOMode
mode

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.closeFile.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO ()
hClose
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.isFileEOF.impl.v3" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO Bool
hIsEOF
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.isFileOpen.impl.v3" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO Bool
hIsOpen
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getEcho.impl.v1" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO Bool
hGetEcho
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.ready.impl.v1" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO Bool
hReady
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getChar.impl.v1" ForeignOp
boxToEFChar (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Char) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO Char
hGetChar
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.isSeekable.impl.v3" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO Bool
hIsSeekable

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.seekHandle.impl.v3" ForeignOp
seek'handle
    (ForeignFunc -> FDecl Symbol ())
-> (((Handle, SeekMode, Int) -> IO ()) -> ForeignFunc)
-> ((Handle, SeekMode, Int) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Handle, SeekMode, Int) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Handle, SeekMode, Int) -> IO ()) -> FDecl Symbol ())
-> ((Handle, SeekMode, Int) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Handle
h, SeekMode
sm, Int
n) -> Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
h SeekMode
sm (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n :: Int))

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.handlePosition.impl.v3" ForeignOp
boxToEFNat
    -- TODO: truncating integer
    (ForeignFunc -> FDecl Symbol ())
-> ((Handle -> IO Word64) -> ForeignFunc)
-> (Handle -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((Handle -> IO Word64) -> FDecl Symbol ())
-> (Handle -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> forall a. Num a => Integer -> a
fromInteger @Word64 (Integer -> Word64) -> IO Integer -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Integer
hTell Handle
h

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getBuffering.impl.v3" ForeignOp
get'buffering (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (Handle -> IO BufferMode) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Handle -> IO BufferMode
hGetBuffering

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.setBuffering.impl.v3" ForeignOp
set'buffering
    (ForeignFunc -> FDecl Symbol ())
-> (((Handle, BufferMode) -> IO ()) -> ForeignFunc)
-> ((Handle, BufferMode) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Handle, BufferMode) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Handle, BufferMode) -> IO ()) -> FDecl Symbol ())
-> ((Handle, BufferMode) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> BufferMode -> IO ()) -> (Handle, BufferMode) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Handle -> BufferMode -> IO ()
hSetBuffering

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.setEcho.impl.v1" ForeignOp
set'echo (ForeignFunc -> FDecl Symbol ())
-> (((Handle, Bool) -> IO ()) -> ForeignFunc)
-> ((Handle, Bool) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Handle, Bool) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((Handle, Bool) -> IO ()) -> FDecl Symbol ())
-> ((Handle, Bool) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (Handle -> Bool -> IO ()) -> (Handle, Bool) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Handle -> Bool -> IO ()
hSetEcho

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getLine.impl.v1" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (Handle -> IO Text) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((Handle -> IO Text) -> ForeignFunc)
-> (Handle -> IO Text) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      (Text -> Text) -> IO Text -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Util.Text.fromText (IO Text -> IO Text) -> (Handle -> IO Text) -> Handle -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO Text
Text.IO.hGetLine

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getBytes.impl.v3" ForeignOp
boxNatToEFBox (ForeignFunc -> FDecl Symbol ())
-> (((Handle, Int) -> IO Bytes) -> ForeignFunc)
-> ((Handle, Int) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Handle, Int) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((Handle, Int) -> IO Bytes) -> FDecl Symbol ())
-> ((Handle, Int) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Handle
h, Int
n) -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
hGet Handle
h Int
n

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getSomeBytes.impl.v1" ForeignOp
boxNatToEFBox (ForeignFunc -> FDecl Symbol ())
-> (((Handle, Int) -> IO Bytes) -> ForeignFunc)
-> ((Handle, Int) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Handle, Int) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((Handle, Int) -> IO Bytes) -> FDecl Symbol ())
-> ((Handle, Int) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Handle
h, Int
n) -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Int -> IO ByteString
hGetSome Handle
h Int
n

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.putBytes.impl.v3" ForeignOp
boxBoxToEF0 (ForeignFunc -> FDecl Symbol ())
-> (((Handle, Bytes) -> IO ()) -> ForeignFunc)
-> ((Handle, Bytes) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Handle, Bytes) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((Handle, Bytes) -> IO ()) -> FDecl Symbol ())
-> ((Handle, Bytes) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Handle
h, Bytes
bs) -> Handle -> ByteString -> IO ()
hPut Handle
h (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bs)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.systemTime.impl.v3" ForeignOp
unitToEFNat (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO POSIXTime) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO POSIXTime) -> ForeignFunc)
-> (() -> IO POSIXTime) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> IO POSIXTime
getPOSIXTime

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.systemTimeMicroseconds.v1" ForeignOp
unitToInt (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO POSIXTime) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO POSIXTime) -> ForeignFunc)
-> (() -> IO POSIXTime) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> (POSIXTime -> POSIXTime) -> IO POSIXTime -> IO POSIXTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime
1e6 POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
*) IO POSIXTime
getPOSIXTime

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.monotonic.v1" ForeignOp
unitToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO TimeSpec) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO TimeSpec) -> ForeignFunc)
-> (() -> IO TimeSpec) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> Clock -> IO TimeSpec
getTime Clock
Monotonic

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.realtime.v1" ForeignOp
unitToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO TimeSpec) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO TimeSpec) -> ForeignFunc)
-> (() -> IO TimeSpec) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> Clock -> IO TimeSpec
getTime Clock
Realtime

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.processCPUTime.v1" ForeignOp
unitToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO TimeSpec) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO TimeSpec) -> ForeignFunc)
-> (() -> IO TimeSpec) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> Clock -> IO TimeSpec
getTime Clock
ProcessCPUTime

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.threadCPUTime.v1" ForeignOp
unitToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO TimeSpec) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO TimeSpec) -> ForeignFunc)
-> (() -> IO TimeSpec) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> Clock -> IO TimeSpec
getTime Clock
ThreadCPUTime

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.sec.v1" ForeignOp
boxToInt (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (TimeSpec -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (\TimeSpec
n -> Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
sec TimeSpec
n :: Word64))

  -- A TimeSpec that comes from getTime never has negative nanos,
  -- so we can safely cast to Nat
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.nsec.v1" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (TimeSpec -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (\TimeSpec
n -> Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ TimeSpec -> Int64
nsec TimeSpec
n :: Word64))

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Clock.internals.systemTimeZone.v1" ForeignOp
time'zone (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (Int -> IO (Int, Bool, String)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
      ( \Int
secs -> do
          TimeZone Int
offset Bool
summer String
name <- UTCTime -> IO TimeZone
getTimeZone (POSIXTime -> UTCTime
posixSecondsToUTCTime (Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
secs :: Int)))
          (Int, Bool, String) -> IO (Int, Bool, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
offset :: Int, Bool
summer, String
name)
      )

  let chop :: ShowS
chop = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getTempDirectory.impl.v3" ForeignOp
unitToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO String) -> ForeignFunc)
-> (() -> IO String) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> ShowS
chop ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getTemporaryDirectory

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.createTempDirectory.impl.v3" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((String -> IO String) -> ForeignFunc)
-> (String -> IO String) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$ \String
prefix -> do
      String
temp <- IO String
getTemporaryDirectory
      ShowS
chop ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO String
createTempDirectory String
temp String
prefix

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getCurrentDirectory.impl.v3" ForeignOp
unitToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO String) -> ForeignFunc)
-> (() -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((() -> IO String) -> FDecl Symbol ())
-> (() -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> IO String
getCurrentDirectory

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.setCurrentDirectory.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF String -> IO ()
setCurrentDirectory

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.fileExists.impl.v3" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF String -> IO Bool
doesPathExist

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getEnv.impl.v1" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF String -> IO String
getEnv

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getArgs.impl.v1" ForeignOp
unitToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (() -> IO [Text]) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((() -> IO [Text]) -> ForeignFunc)
-> (() -> IO [Text]) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \() -> (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Util.Text.pack ([String] -> [Text]) -> IO [String] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
SYS.getArgs

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.isDirectory.impl.v3" ForeignOp
boxToEFBool (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF String -> IO Bool
doesDirectoryExist

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.createDirectory.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((String -> IO ()) -> ForeignFunc)
-> (String -> IO ()) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      Bool -> String -> IO ()
createDirectoryIfMissing Bool
True

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.removeDirectory.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF String -> IO ()
removeDirectoryRecursive

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.renameDirectory.impl.v3" ForeignOp
boxBoxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    ((String, String) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((String, String) -> IO ()) -> ForeignFunc)
-> ((String, String) -> IO ()) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      (String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
renameDirectory

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.directoryContents.impl.v3" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO [Text]) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ((String -> IO [Text]) -> ForeignFunc)
-> (String -> IO [Text]) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Util.Text.pack ([String] -> [Text]) -> IO [String] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO [String] -> IO [Text])
-> (String -> IO [String]) -> String -> IO [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO [String]
getDirectoryContents

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.removeFile.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (String -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF String -> IO ()
removeFile

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.renameFile.impl.v3" ForeignOp
boxBoxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    ((String, String) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF (((String, String) -> IO ()) -> ForeignFunc)
-> ((String, String) -> IO ()) -> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      (String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
renameFile

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getFileTimestamp.impl.v3" ForeignOp
boxToEFNat
    (ForeignFunc -> FDecl Symbol ())
-> ((String -> IO POSIXTime) -> ForeignFunc)
-> (String -> IO POSIXTime)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO POSIXTime) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((String -> IO POSIXTime) -> FDecl Symbol ())
-> (String -> IO POSIXTime) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (UTCTime -> POSIXTime) -> IO UTCTime -> IO POSIXTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (IO UTCTime -> IO POSIXTime)
-> (String -> IO UTCTime) -> String -> IO POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO UTCTime
getModificationTime

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.getFileSize.impl.v3" ForeignOp
boxToEFNat
    -- TODO: truncating integer
    (ForeignFunc -> FDecl Symbol ())
-> ((String -> IO Word64) -> ForeignFunc)
-> (String -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((String -> IO Word64) -> FDecl Symbol ())
-> (String -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \String
fp -> forall a. Num a => Integer -> a
fromInteger @Word64 (Integer -> Word64) -> IO Integer -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Integer
getFileSize String
fp

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.serverSocket.impl.v3" ForeignOp
maybeBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Maybe Text, String) -> IO Socket) -> ForeignFunc)
-> ((Maybe Text, String) -> IO Socket)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text, String) -> IO Socket) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Maybe Text, String) -> IO Socket) -> FDecl Symbol ())
-> ((Maybe Text, String) -> IO Socket) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \( Maybe Text
mhst :: Maybe Util.Text.Text,
         String
port
         ) ->
        (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst ((Socket, SockAddr) -> Socket)
-> IO (Socket, SockAddr) -> IO Socket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HostPreference -> String -> IO (Socket, SockAddr)
forall (m :: * -> *).
MonadIO m =>
HostPreference -> String -> m (Socket, SockAddr)
SYS.bindSock (Maybe Text -> HostPreference
hostPreference Maybe Text
mhst) String
port

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Socket.toText" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Socket -> IO String) -> ForeignFunc)
-> (Socket -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Socket -> IO String) -> FDecl Symbol ())
-> (Socket -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Socket
sock :: Socket) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Socket -> String
forall a. Show a => a -> String
show Socket
sock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Handle.toText" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Handle -> IO String) -> ForeignFunc)
-> (Handle -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Handle -> IO String) -> FDecl Symbol ())
-> (Handle -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Handle
hand :: Handle) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Handle -> String
forall a. Show a => a -> String
show Handle
hand

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"ThreadId.toText" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((ThreadId -> IO String) -> ForeignFunc)
-> (ThreadId -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ThreadId -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((ThreadId -> IO String) -> FDecl Symbol ())
-> (ThreadId -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(ThreadId
threadId :: ThreadId) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ThreadId -> String
forall a. Show a => a -> String
show ThreadId
threadId

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.socketPort.impl.v3" ForeignOp
boxToEFNat
    (ForeignFunc -> FDecl Symbol ())
-> ((Socket -> IO Word64) -> ForeignFunc)
-> (Socket -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((Socket -> IO Word64) -> FDecl Symbol ())
-> (Socket -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Socket
handle :: Socket) -> do
      PortNumber
n <- Socket -> IO PortNumber
SYS.socketPort Socket
handle
      return (PortNumber -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
n :: Word64)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.listen.impl.v3" ForeignOp
boxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> ((Socket -> IO ()) -> ForeignFunc)
-> (Socket -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((Socket -> IO ()) -> FDecl Symbol ())
-> (Socket -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \Socket
sk -> Socket -> Int -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> Int -> m ()
SYS.listenSock Socket
sk Int
2048

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.clientSocket.impl.v3" ForeignOp
boxBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((String, String) -> IO Socket) -> ForeignFunc)
-> ((String, String) -> IO Socket)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> IO Socket) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((String, String) -> IO Socket) -> FDecl Symbol ())
-> ((String, String) -> IO Socket) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ ((Socket, SockAddr) -> Socket)
-> IO (Socket, SockAddr) -> IO Socket
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst (IO (Socket, SockAddr) -> IO Socket)
-> ((String, String) -> IO (Socket, SockAddr))
-> (String, String)
-> IO Socket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> IO (Socket, SockAddr))
-> (String, String) -> IO (Socket, SockAddr)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO (Socket, SockAddr)
forall (m :: * -> *).
MonadIO m =>
String -> String -> m (Socket, SockAddr)
SYS.connectSock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.closeSocket.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (Socket -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Socket -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> m ()
SYS.closeSock

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.socketAccept.impl.v3" ForeignOp
boxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> ((Socket -> IO Socket) -> ForeignFunc)
-> (Socket -> IO Socket)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO Socket) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((Socket -> IO Socket) -> FDecl Symbol ())
-> (Socket -> IO Socket) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ ((Socket, SockAddr) -> Socket)
-> IO (Socket, SockAddr) -> IO Socket
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket, SockAddr) -> Socket
forall a b. (a, b) -> a
fst (IO (Socket, SockAddr) -> IO Socket)
-> (Socket -> IO (Socket, SockAddr)) -> Socket -> IO Socket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO (Socket, SockAddr)
SYS.accept

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.socketSend.impl.v3" ForeignOp
boxBoxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> (((Socket, Bytes) -> IO ()) -> ForeignFunc)
-> ((Socket, Bytes) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Socket, Bytes) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Socket, Bytes) -> IO ()) -> FDecl Symbol ())
-> ((Socket, Bytes) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Socket
sk, Bytes
bs) -> Socket -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Socket -> ByteString -> m ()
SYS.send Socket
sk (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
bs)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.socketReceive.impl.v3" ForeignOp
boxNatToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Socket, Int) -> IO Bytes) -> ForeignFunc)
-> ((Socket, Int) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Socket, Int) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((Socket, Int) -> IO Bytes) -> FDecl Symbol ())
-> ((Socket, Int) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Socket
hs, Int
n) ->
      Bytes -> (ByteString -> Bytes) -> Maybe ByteString -> Bytes
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bytes
forall a. Monoid a => a
mempty ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Maybe ByteString -> Bytes) -> IO (Maybe ByteString) -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> Int -> IO (Maybe ByteString)
forall (m :: * -> *).
MonadIO m =>
Socket -> Int -> m (Maybe ByteString)
SYS.recv Socket
hs Int
n

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.kill.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ (ThreadId -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF ThreadId -> IO ()
killThread

  let mx :: Word64
      mx :: Word64
mx = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)

      customDelay :: Word64 -> IO ()
      customDelay :: Word64 -> IO ()
customDelay Word64
n
        | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
mx = Int -> IO ()
threadDelay (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
        | Bool
otherwise = Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> IO ()
customDelay (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
mx)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.delay.impl.v3" ForeignOp
natToEFUnit (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (Word64 -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF Word64 -> IO ()
customDelay

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.stdHandle" ForeignOp
standard'handle
    (ForeignFunc -> FDecl Symbol ())
-> ((Int -> IO Handle) -> ForeignFunc)
-> (Int -> IO Handle)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Handle) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Int -> IO Handle) -> FDecl Symbol ())
-> (Int -> IO Handle) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Int
n :: Int) -> case Int
n of
      Int
0 -> Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
SYS.stdin
      Int
1 -> Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
SYS.stdout
      Int
2 -> Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
SYS.stderr
      Int
_ -> String -> IO Handle
forall a. HasCallStack => String -> IO a
die String
"IO.stdHandle: invalid input."

  let exitDecode :: ExitCode -> Int
exitDecode ExitCode
ExitSuccess = Int
0
      exitDecode (ExitFailure Int
n) = Int
n

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.process.call" ForeignOp
boxBoxToNat (ForeignFunc -> FDecl Symbol ())
-> (((String, [Text]) -> IO Int) -> ForeignFunc)
-> ((String, [Text]) -> IO Int)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Text]) -> IO Int) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((String, [Text]) -> IO Int) -> FDecl Symbol ())
-> ((String, [Text]) -> IO Int) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(String
exe, (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Util.Text.unpack -> [String]
args) ->
      CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Int)
-> IO Int
forall a.
CreateProcess
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-> IO a
withCreateProcess (String -> [String] -> CreateProcess
proc String
exe [String]
args) ((Maybe Handle
  -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Int)
 -> IO Int)
-> (Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO Int)
-> IO Int
forall a b. (a -> b) -> a -> b
$ \Maybe Handle
_ Maybe Handle
_ Maybe Handle
_ ProcessHandle
p ->
        ExitCode -> Int
exitDecode (ExitCode -> Int) -> IO ExitCode -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
p

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.process.start" ForeignOp
start'process (ForeignFunc -> FDecl Symbol ())
-> (((String, [Text])
     -> IO (Handle, Handle, Handle, ProcessHandle))
    -> ForeignFunc)
-> ((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
 -> FDecl Symbol ())
-> ((String, [Text]) -> IO (Handle, Handle, Handle, ProcessHandle))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(String
exe, (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
Util.Text.unpack -> [String]
args) ->
      String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveProcess String
exe [String]
args Maybe String
forall a. Maybe a
Nothing Maybe [(String, String)]
forall a. Maybe a
Nothing

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.process.kill" ForeignOp
boxTo0 (ForeignFunc -> FDecl Symbol ())
-> ((ProcessHandle -> IO ()) -> ForeignFunc)
-> (ProcessHandle -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessHandle -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((ProcessHandle -> IO ()) -> FDecl Symbol ())
-> (ProcessHandle -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    ProcessHandle -> IO ()
terminateProcess

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.process.wait" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((ProcessHandle -> IO Int) -> ForeignFunc)
-> (ProcessHandle -> IO Int)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessHandle -> IO Int) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((ProcessHandle -> IO Int) -> FDecl Symbol ())
-> (ProcessHandle -> IO Int) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \ProcessHandle
ph -> ExitCode -> Int
exitDecode (ExitCode -> Int) -> IO ExitCode -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.process.exitCode" ForeignOp
boxToMaybeNat (ForeignFunc -> FDecl Symbol ())
-> ((ProcessHandle -> IO (Maybe Int)) -> ForeignFunc)
-> (ProcessHandle -> IO (Maybe Int))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessHandle -> IO (Maybe Int)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((ProcessHandle -> IO (Maybe Int)) -> FDecl Symbol ())
-> (ProcessHandle -> IO (Maybe Int)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (Maybe ExitCode -> Maybe Int)
-> IO (Maybe ExitCode) -> IO (Maybe Int)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ExitCode -> Int) -> Maybe ExitCode -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ExitCode -> Int
exitDecode) (IO (Maybe ExitCode) -> IO (Maybe Int))
-> (ProcessHandle -> IO (Maybe ExitCode))
-> ProcessHandle
-> IO (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.new" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Closure -> IO (MVar Closure)) -> ForeignFunc)
-> (Closure -> IO (MVar Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Closure -> IO (MVar Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Closure -> IO (MVar Closure)) -> FDecl Symbol ())
-> (Closure -> IO (MVar Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Closure
c :: Closure) -> Closure -> IO (MVar Closure)
forall a. a -> IO (MVar a)
newMVar Closure
c

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.newEmpty.v2" ForeignOp
unitDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO (MVar Closure)) -> ForeignFunc)
-> (() -> IO (MVar Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO (MVar Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((() -> IO (MVar Closure)) -> FDecl Symbol ())
-> (() -> IO (MVar Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> forall a. IO (MVar a)
newEmptyMVar @Closure

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.take.impl.v3" ForeignOp
boxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> ((MVar Closure -> IO Closure) -> ForeignFunc)
-> (MVar Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((MVar Closure -> IO Closure) -> FDecl Symbol ())
-> (MVar Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure) -> MVar Closure -> IO Closure
forall a. MVar a -> IO a
takeMVar MVar Closure
mv

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.tryTake" ForeignOp
boxToMaybeBox
    (ForeignFunc -> FDecl Symbol ())
-> ((MVar Closure -> IO (Maybe Closure)) -> ForeignFunc)
-> (MVar Closure -> IO (Maybe Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar Closure -> IO (Maybe Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((MVar Closure -> IO (Maybe Closure)) -> FDecl Symbol ())
-> (MVar Closure -> IO (Maybe Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure) -> MVar Closure -> IO (Maybe Closure)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar Closure
mv

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.put.impl.v3" ForeignOp
boxBoxToEF0
    (ForeignFunc -> FDecl Symbol ())
-> (((MVar Closure, Closure) -> IO ()) -> ForeignFunc)
-> ((MVar Closure, Closure) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MVar Closure, Closure) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((MVar Closure, Closure) -> IO ()) -> FDecl Symbol ())
-> ((MVar Closure, Closure) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure, Closure
x) -> MVar Closure -> Closure -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Closure
mv Closure
x

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.tryPut.impl.v3" ForeignOp
boxBoxToEFBool
    (ForeignFunc -> FDecl Symbol ())
-> (((MVar Closure, Closure) -> IO Bool) -> ForeignFunc)
-> ((MVar Closure, Closure) -> IO Bool)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MVar Closure, Closure) -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((MVar Closure, Closure) -> IO Bool) -> FDecl Symbol ())
-> ((MVar Closure, Closure) -> IO Bool) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure, Closure
x) -> MVar Closure -> Closure -> IO Bool
forall a. MVar a -> a -> IO Bool
tryPutMVar MVar Closure
mv Closure
x

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.swap.impl.v3" ForeignOp
boxBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((MVar Closure, Closure) -> IO Closure) -> ForeignFunc)
-> ((MVar Closure, Closure) -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MVar Closure, Closure) -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    (((MVar Closure, Closure) -> IO Closure) -> FDecl Symbol ())
-> ((MVar Closure, Closure) -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure, Closure
x) -> MVar Closure -> Closure -> IO Closure
forall a. MVar a -> a -> IO a
swapMVar MVar Closure
mv Closure
x

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.isEmpty" ForeignOp
boxToBool
    (ForeignFunc -> FDecl Symbol ())
-> ((MVar Closure -> IO Bool) -> ForeignFunc)
-> (MVar Closure -> IO Bool)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar Closure -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((MVar Closure -> IO Bool) -> FDecl Symbol ())
-> (MVar Closure -> IO Bool) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure) -> MVar Closure -> IO Bool
forall a. MVar a -> IO Bool
isEmptyMVar MVar Closure
mv

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.read.impl.v3" ForeignOp
boxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> ((MVar Closure -> IO Closure) -> ForeignFunc)
-> (MVar Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((MVar Closure -> IO Closure) -> FDecl Symbol ())
-> (MVar Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure) -> MVar Closure -> IO Closure
forall a. MVar a -> IO a
readMVar MVar Closure
mv

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"MVar.tryRead.impl.v3" ForeignOp
boxToEFMBox
    (ForeignFunc -> FDecl Symbol ())
-> ((MVar Closure -> IO (Maybe Closure)) -> ForeignFunc)
-> (MVar Closure -> IO (Maybe Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MVar Closure -> IO (Maybe Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignIOF
    ((MVar Closure -> IO (Maybe Closure)) -> FDecl Symbol ())
-> (MVar Closure -> IO (Maybe Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MVar Closure
mv :: MVar Closure) -> MVar Closure -> IO (Maybe Closure)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar Closure
mv

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.toText" (Reference -> ForeignOp
wordDirect Reference
Ty.charRef) (ForeignFunc -> FDecl Symbol ())
-> ((Char -> IO Text) -> ForeignFunc)
-> (Char -> IO Text)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> IO Text) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Char -> IO Text) -> FDecl Symbol ())
-> (Char -> IO Text) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Char
ch :: Char) -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Text
Util.Text.singleton Char
ch)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.repeat" (Reference -> ForeignOp
wordBoxDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> (((Word64, Text) -> IO Text) -> ForeignFunc)
-> ((Word64, Text) -> IO Text)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Text) -> IO Text) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Word64, Text) -> IO Text) -> FDecl Symbol ())
-> ((Word64, Text) -> IO Text) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Word64
n :: Word64, Text
txt :: Util.Text.Text) -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> Text
Util.Text.replicate (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) Text
txt)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.reverse" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Text -> IO Text) -> ForeignFunc)
-> (Text -> IO Text)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO Text) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Text -> IO Text) -> FDecl Symbol ())
-> (Text -> IO Text) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.reverse

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.toUppercase" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Text -> IO Text) -> ForeignFunc)
-> (Text -> IO Text)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO Text) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Text -> IO Text) -> FDecl Symbol ())
-> (Text -> IO Text) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toUppercase

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.toLowercase" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Text -> IO Text) -> ForeignFunc)
-> (Text -> IO Text)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO Text) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Text -> IO Text) -> FDecl Symbol ())
-> (Text -> IO Text) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> (Text -> Text) -> Text -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Util.Text.toLowercase

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.toUtf8" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Text -> IO Bytes) -> ForeignFunc)
-> (Text -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Text -> IO Bytes) -> FDecl Symbol ())
-> (Text -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Text -> Bytes) -> Text -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bytes
Util.Text.toUtf8

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.fromUtf8.impl.v3" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either (Failure Closure) Text)) -> ForeignFunc)
-> (Bytes -> IO (Either (Failure Closure) Text))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either (Failure Closure) Text)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either (Failure Closure) Text)) -> FDecl Symbol ())
-> (Bytes -> IO (Either (Failure Closure) Text)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Either (Failure Closure) Text -> IO (Either (Failure Closure) Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Text
 -> IO (Either (Failure Closure) Text))
-> (Bytes -> Either (Failure Closure) Text)
-> Bytes
-> IO (Either (Failure Closure) Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Failure Closure)
-> Either String Text -> Either (Failure Closure) Text
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (\String
t -> Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.ioFailureRef (String -> Text
Util.Text.pack String
t) Closure
unitValue) (Either String Text -> Either (Failure Closure) Text)
-> (Bytes -> Either String Text)
-> Bytes
-> Either (Failure Closure) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either String Text
Util.Text.fromUtf8

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.ClientConfig.default" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((Text, Bytes) -> IO ClientParams) -> ForeignFunc)
-> ((Text, Bytes) -> IO ClientParams)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Bytes) -> IO ClientParams) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Text, Bytes) -> IO ClientParams) -> FDecl Symbol ())
-> ((Text, Bytes) -> IO ClientParams) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Text
hostName :: Util.Text.Text, Bytes
serverId :: Bytes.Bytes) ->
      (CertificateStore -> ClientParams)
-> IO CertificateStore -> IO ClientParams
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( \CertificateStore
store ->
            (String -> ByteString -> ClientParams
defaultParamsClient (Text -> String
Util.Text.unpack Text
hostName) (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
serverId))
              { TLS.clientSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong},
                TLS.clientShared = def {TLS.sharedCAStore = store}
              }
        )
        IO CertificateStore
X.getSystemCertificateStore

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.ServerConfig.default" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ()) -> ForeignFunc -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    (([SignedCertificate], PrivKey) -> IO ServerParams) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((([SignedCertificate], PrivKey) -> IO ServerParams)
 -> ForeignFunc)
-> (([SignedCertificate], PrivKey) -> IO ServerParams)
-> ForeignFunc
forall a b. (a -> b) -> a -> b
$
      \([SignedCertificate]
certs :: [X.SignedCertificate], PrivKey
key :: X.PrivKey) ->
        ServerParams -> IO ServerParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerParams -> IO ServerParams)
-> ServerParams -> IO ServerParams
forall a b. (a -> b) -> a -> b
$
          (ServerParams
forall a. Default a => a
def :: TLS.ServerParams)
            { TLS.serverSupported = def {TLS.supportedCiphers = Cipher.ciphersuite_strong},
              TLS.serverShared = def {TLS.sharedCredentials = Credentials [(X.CertificateChain certs, key)]}
            }

  let updateClient :: X.CertificateStore -> TLS.ClientParams -> TLS.ClientParams
      updateClient :: CertificateStore -> ClientParams -> ClientParams
updateClient CertificateStore
certs ClientParams
client = ClientParams
client {TLS.clientShared = ((clientShared client) {TLS.sharedCAStore = certs})}
   in Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.ClientConfig.certificates.set" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> ((([SignedCertificate], ClientParams) -> IO ClientParams)
    -> ForeignFunc)
-> (([SignedCertificate], ClientParams) -> IO ClientParams)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([SignedCertificate], ClientParams) -> IO ClientParams)
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((([SignedCertificate], ClientParams) -> IO ClientParams)
 -> FDecl Symbol ())
-> (([SignedCertificate], ClientParams) -> IO ClientParams)
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
        \([SignedCertificate]
certs :: [X.SignedCertificate], ClientParams
params :: ClientParams) -> ClientParams -> IO ClientParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientParams -> IO ClientParams)
-> ClientParams -> IO ClientParams
forall a b. (a -> b) -> a -> b
$ CertificateStore -> ClientParams -> ClientParams
updateClient ([SignedCertificate] -> CertificateStore
X.makeCertificateStore [SignedCertificate]
certs) ClientParams
params

  let updateServer :: X.CertificateStore -> TLS.ServerParams -> TLS.ServerParams
      updateServer :: CertificateStore -> ServerParams -> ServerParams
updateServer CertificateStore
certs ServerParams
client = ServerParams
client {TLS.serverShared = ((serverShared client) {TLS.sharedCAStore = certs})}
   in Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.ServerConfig.certificates.set" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> ((([SignedCertificate], ServerParams) -> IO ServerParams)
    -> ForeignFunc)
-> (([SignedCertificate], ServerParams) -> IO ServerParams)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([SignedCertificate], ServerParams) -> IO ServerParams)
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((([SignedCertificate], ServerParams) -> IO ServerParams)
 -> FDecl Symbol ())
-> (([SignedCertificate], ServerParams) -> IO ServerParams)
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
        \([SignedCertificate]
certs :: [X.SignedCertificate], ServerParams
params :: ServerParams) -> ServerParams -> IO ServerParams
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerParams -> IO ServerParams)
-> ServerParams -> IO ServerParams
forall a b. (a -> b) -> a -> b
$ CertificateStore -> ServerParams -> ServerParams
updateServer ([SignedCertificate] -> CertificateStore
X.makeCertificateStore [SignedCertificate]
certs) ServerParams
params

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"TVar.new" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Closure -> IO (TVar Closure)) -> ForeignFunc)
-> (Closure -> IO (TVar Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Closure -> IO (TVar Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Closure -> IO (TVar Closure)) -> FDecl Symbol ())
-> (Closure -> IO (TVar Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Closure
c :: Closure) -> STM (TVar Closure) -> IO (TVar Closure)
forall a. STM a -> IO a
unsafeSTMToIO (STM (TVar Closure) -> IO (TVar Closure))
-> STM (TVar Closure) -> IO (TVar Closure)
forall a b. (a -> b) -> a -> b
$ Closure -> STM (TVar Closure)
forall a. a -> STM (TVar a)
STM.newTVar Closure
c

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"TVar.read" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((TVar Closure -> IO Closure) -> ForeignFunc)
-> (TVar Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((TVar Closure -> IO Closure) -> FDecl Symbol ())
-> (TVar Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TVar Closure
v :: STM.TVar Closure) -> STM Closure -> IO Closure
forall a. STM a -> IO a
unsafeSTMToIO (STM Closure -> IO Closure) -> STM Closure -> IO Closure
forall a b. (a -> b) -> a -> b
$ TVar Closure -> STM Closure
forall a. TVar a -> STM a
STM.readTVar TVar Closure
v

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"TVar.write" ForeignOp
boxBoxTo0 (ForeignFunc -> FDecl Symbol ())
-> (((TVar Closure, Closure) -> IO ()) -> ForeignFunc)
-> ((TVar Closure, Closure) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TVar Closure, Closure) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((TVar Closure, Closure) -> IO ()) -> FDecl Symbol ())
-> ((TVar Closure, Closure) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TVar Closure
v :: STM.TVar Closure, Closure
c :: Closure) ->
      STM () -> IO ()
forall a. STM a -> IO a
unsafeSTMToIO (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Closure -> Closure -> STM ()
forall a. TVar a -> a -> STM ()
STM.writeTVar TVar Closure
v Closure
c

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"TVar.newIO" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Closure -> IO (TVar Closure)) -> ForeignFunc)
-> (Closure -> IO (TVar Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Closure -> IO (TVar Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Closure -> IO (TVar Closure)) -> FDecl Symbol ())
-> (Closure -> IO (TVar Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Closure
c :: Closure) -> Closure -> IO (TVar Closure)
forall a. a -> IO (TVar a)
STM.newTVarIO Closure
c

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"TVar.readIO" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((TVar Closure -> IO Closure) -> ForeignFunc)
-> (TVar Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((TVar Closure -> IO Closure) -> FDecl Symbol ())
-> (TVar Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TVar Closure
v :: STM.TVar Closure) -> TVar Closure -> IO Closure
forall a. TVar a -> IO a
STM.readTVarIO TVar Closure
v

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"TVar.swap" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((TVar Closure, Closure) -> IO Closure) -> ForeignFunc)
-> ((TVar Closure, Closure) -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TVar Closure, Closure) -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((TVar Closure, Closure) -> IO Closure) -> FDecl Symbol ())
-> ((TVar Closure, Closure) -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TVar Closure
v, Closure
c :: Closure) -> STM Closure -> IO Closure
forall a. STM a -> IO a
unsafeSTMToIO (STM Closure -> IO Closure) -> STM Closure -> IO Closure
forall a b. (a -> b) -> a -> b
$ TVar Closure -> Closure -> STM Closure
forall a. TVar a -> a -> STM a
STM.swapTVar TVar Closure
v Closure
c

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"STM.retry" ForeignOp
unitDirect (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO Closure) -> ForeignFunc)
-> (() -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO Closure) -> FDecl Symbol ())
-> (() -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \() -> STM Closure -> IO Closure
forall a. STM a -> IO a
unsafeSTMToIO STM Closure
forall a. STM a
STM.retry :: IO Closure

  -- Scope and Ref stuff
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Scope.ref" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Closure -> IO (IORef Closure)) -> ForeignFunc)
-> (Closure -> IO (IORef Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Closure -> IO (IORef Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Closure -> IO (IORef Closure)) -> FDecl Symbol ())
-> (Closure -> IO (IORef Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Closure
c :: Closure) -> Closure -> IO (IORef Closure)
forall a. a -> IO (IORef a)
newIORef Closure
c

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.ref" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Closure -> IO (IORef Closure)) -> ForeignFunc)
-> (Closure -> IO (IORef Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Closure -> IO (IORef Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Closure -> IO (IORef Closure)) -> FDecl Symbol ())
-> (Closure -> IO (IORef Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Closure
c :: Closure) -> Closure -> IO Closure
forall a. a -> IO a
evaluate Closure
c IO Closure -> (Closure -> IO (IORef Closure)) -> IO (IORef Closure)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Closure -> IO (IORef Closure)
forall a. a -> IO (IORef a)
newIORef

  -- The docs for IORef state that IORef operations can be observed
  -- out of order ([1]) but actually GHC does emit the appropriate
  -- load and store barriers nowadays ([2], [3]).
  --
  -- [1] https://hackage.haskell.org/package/base-4.17.0.0/docs/Data-IORef.html#g:2
  -- [2] https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L286
  -- [3] https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L298
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Ref.read" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((IORef Closure -> IO Closure) -> ForeignFunc)
-> (IORef Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((IORef Closure -> IO Closure) -> FDecl Symbol ())
-> (IORef Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(IORef Closure
r :: IORef Closure) -> IORef Closure -> IO Closure
forall a. IORef a -> IO a
readIORef IORef Closure
r

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Ref.write" ForeignOp
boxBoxTo0 (ForeignFunc -> FDecl Symbol ())
-> (((IORef Closure, Closure) -> IO ()) -> ForeignFunc)
-> ((IORef Closure, Closure) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IORef Closure, Closure) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((IORef Closure, Closure) -> IO ()) -> FDecl Symbol ())
-> ((IORef Closure, Closure) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(IORef Closure
r :: IORef Closure, Closure
c :: Closure) -> Closure -> IO Closure
forall a. a -> IO a
evaluate Closure
c IO Closure -> (Closure -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef Closure -> Closure -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Closure
r

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Ref.readForCas" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((IORef Closure -> IO (Ticket Closure)) -> ForeignFunc)
-> (IORef Closure -> IO (Ticket Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IORef Closure -> IO (Ticket Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((IORef Closure -> IO (Ticket Closure)) -> FDecl Symbol ())
-> (IORef Closure -> IO (Ticket Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(IORef Closure
r :: IORef Closure) -> IORef Closure -> IO (Ticket Closure)
forall a. IORef a -> IO (Ticket a)
readForCAS IORef Closure
r

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Ref.Ticket.read" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Ticket Closure -> IO Closure) -> ForeignFunc)
-> (Ticket Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ticket Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Ticket Closure -> IO Closure) -> FDecl Symbol ())
-> (Ticket Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Ticket Closure
t :: Ticket Closure) -> Closure -> IO Closure
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Closure -> IO Closure) -> Closure -> IO Closure
forall a b. (a -> b) -> a -> b
$ Ticket Closure -> Closure
forall a. Ticket a -> a
peekTicket Ticket Closure
t

  -- In GHC, CAS returns both a Boolean and the current value of the
  -- IORef, which can be used to retry a failed CAS.
  -- This strategy is more efficient than returning a Boolean only
  -- because it uses a single call to cmpxchg in assembly (see [1]) to
  -- avoid an extra read per CAS iteration, however it's not supported
  -- in Scheme.
  -- Therefore, we adopt the more common signature that only returns a
  -- Boolean, which doesn't even suffer from spurious failures because
  -- GHC issues loads of mutable variables with memory_order_acquire
  -- (see [2])
  --
  -- [1]: https://github.com/ghc/ghc/blob/master/rts/PrimOps.cmm#L697
  -- [2]: https://github.com/ghc/ghc/blob/master/compiler/GHC/StgToCmm/Prim.hs#L285
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Ref.cas" ForeignOp
boxBoxBoxToBool (ForeignFunc -> FDecl Symbol ())
-> (((IORef Closure, Ticket Closure, Closure) -> IO Bool)
    -> ForeignFunc)
-> ((IORef Closure, Ticket Closure, Closure) -> IO Bool)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((IORef Closure, Ticket Closure, Closure) -> IO Bool)
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((IORef Closure, Ticket Closure, Closure) -> IO Bool)
 -> FDecl Symbol ())
-> ((IORef Closure, Ticket Closure, Closure) -> IO Bool)
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(IORef Closure
r :: IORef Closure, Ticket Closure
t :: Ticket Closure, Closure
v :: Closure) -> ((Bool, Ticket Closure) -> Bool)
-> IO (Bool, Ticket Closure) -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool, Ticket Closure) -> Bool
forall a b. (a, b) -> a
fst (IO (Bool, Ticket Closure) -> IO Bool)
-> IO (Bool, Ticket Closure) -> IO Bool
forall a b. (a -> b) -> a -> b
$
      do
        Ticket Closure
t <- Ticket Closure -> IO (Ticket Closure)
forall a. a -> IO a
evaluate Ticket Closure
t
        IORef Closure
-> Ticket Closure -> Closure -> IO (Bool, Ticket Closure)
forall a. IORef a -> Ticket a -> a -> IO (Bool, Ticket a)
casIORef IORef Closure
r Ticket Closure
t Closure
v

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Promise.new" ForeignOp
unitDirect (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO (Promise Closure)) -> ForeignFunc)
-> (() -> IO (Promise Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO (Promise Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO (Promise Closure)) -> FDecl Symbol ())
-> (() -> IO (Promise Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \() -> forall a. IO (Promise a)
newPromise @Closure

  -- the only exceptions from Promise.read are async and shouldn't be caught
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Promise.read" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Promise Closure -> IO Closure) -> ForeignFunc)
-> (Promise Closure -> IO Closure)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Promise Closure -> IO Closure) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Promise Closure -> IO Closure) -> FDecl Symbol ())
-> (Promise Closure -> IO Closure) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Promise Closure
p :: Promise Closure) -> Promise Closure -> IO Closure
forall a. Promise a -> IO a
readPromise Promise Closure
p

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Promise.tryRead" ForeignOp
boxToMaybeBox (ForeignFunc -> FDecl Symbol ())
-> ((Promise Closure -> IO (Maybe Closure)) -> ForeignFunc)
-> (Promise Closure -> IO (Maybe Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Promise Closure -> IO (Maybe Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Promise Closure -> IO (Maybe Closure)) -> FDecl Symbol ())
-> (Promise Closure -> IO (Maybe Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Promise Closure
p :: Promise Closure) -> Promise Closure -> IO (Maybe Closure)
forall a. Promise a -> IO (Maybe a)
tryReadPromise Promise Closure
p

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Promise.write" ForeignOp
boxBoxToBool (ForeignFunc -> FDecl Symbol ())
-> (((Promise Closure, Closure) -> IO Bool) -> ForeignFunc)
-> ((Promise Closure, Closure) -> IO Bool)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Promise Closure, Closure) -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Promise Closure, Closure) -> IO Bool) -> FDecl Symbol ())
-> ((Promise Closure, Closure) -> IO Bool) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Promise Closure
p :: Promise Closure, Closure
a :: Closure) -> Promise Closure -> Closure -> IO Bool
forall a. Promise a -> a -> IO Bool
writePromise Promise Closure
p Closure
a

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.newClient.impl.v3" ForeignOp
boxBoxToEFBox (ForeignFunc -> FDecl Symbol ())
-> (((ClientParams, Socket) -> IO Context) -> ForeignFunc)
-> ((ClientParams, Socket) -> IO Context)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ClientParams, Socket) -> IO Context) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls (((ClientParams, Socket) -> IO Context) -> FDecl Symbol ())
-> ((ClientParams, Socket) -> IO Context) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \( ClientParams
config :: TLS.ClientParams,
       Socket
socket :: SYS.Socket
       ) -> Socket -> ClientParams -> IO Context
forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew Socket
socket ClientParams
config

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.newServer.impl.v3" ForeignOp
boxBoxToEFBox (ForeignFunc -> FDecl Symbol ())
-> (((ServerParams, Socket) -> IO Context) -> ForeignFunc)
-> ((ServerParams, Socket) -> IO Context)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ServerParams, Socket) -> IO Context) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls (((ServerParams, Socket) -> IO Context) -> FDecl Symbol ())
-> ((ServerParams, Socket) -> IO Context) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \( ServerParams
config :: TLS.ServerParams,
       Socket
socket :: SYS.Socket
       ) -> Socket -> ServerParams -> IO Context
forall (m :: * -> *) backend params.
(MonadIO m, HasBackend backend, TLSParams params) =>
backend -> params -> m Context
TLS.contextNew Socket
socket ServerParams
config

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.handshake.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ())
-> ((Context -> IO ()) -> ForeignFunc)
-> (Context -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls ((Context -> IO ()) -> FDecl Symbol ())
-> (Context -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Context
tls :: TLS.Context) -> Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.handshake Context
tls

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.send.impl.v3" ForeignOp
boxBoxToEF0 (ForeignFunc -> FDecl Symbol ())
-> (((Context, Bytes) -> IO ()) -> ForeignFunc)
-> ((Context, Bytes) -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Context, Bytes) -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls (((Context, Bytes) -> IO ()) -> FDecl Symbol ())
-> ((Context, Bytes) -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \( Context
tls :: TLS.Context,
       Bytes
bytes :: Bytes.Bytes
       ) -> Context -> ByteString -> IO ()
forall (m :: * -> *). MonadIO m => Context -> ByteString -> m ()
TLS.sendData Context
tls (Bytes -> ByteString
Bytes.toLazyByteString Bytes
bytes)

  let wrapFailure :: String -> Failure Closure
wrapFailure String
t = Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.tlsFailureRef (String -> Text
Util.Text.pack String
t) Closure
unitValue
      decoded :: Bytes.Bytes -> Either String PEM
      decoded :: Bytes -> Either String PEM
decoded Bytes
bytes = case ByteString -> Either String [PEM]
pemParseLBS (ByteString -> Either String [PEM])
-> ByteString -> Either String [PEM]
forall a b. (a -> b) -> a -> b
$ Bytes -> ByteString
Bytes.toLazyByteString Bytes
bytes of
        Right (PEM
pem : [PEM]
_) -> PEM -> Either String PEM
forall a b. b -> Either a b
Right PEM
pem
        Right [] -> String -> Either String PEM
forall a b. a -> Either a b
Left String
"no PEM found"
        Left String
l -> String -> Either String PEM
forall a b. a -> Either a b
Left String
l
      asCert :: PEM -> Either String X.SignedCertificate
      asCert :: PEM -> Either String SignedCertificate
asCert PEM
pem = ByteString -> Either String SignedCertificate
X.decodeSignedCertificate (ByteString -> Either String SignedCertificate)
-> ByteString -> Either String SignedCertificate
forall a b. (a -> b) -> a -> b
$ PEM -> ByteString
pemContent PEM
pem
   in Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.decodeCert.impl.v3" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either (Failure Closure) SignedCertificate))
    -> ForeignFunc)
-> (Bytes -> IO (Either (Failure Closure) SignedCertificate))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either (Failure Closure) SignedCertificate))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO (Either (Failure Closure) r)) -> ForeignFunc
mkForeignTlsE ((Bytes -> IO (Either (Failure Closure) SignedCertificate))
 -> FDecl Symbol ())
-> (Bytes -> IO (Either (Failure Closure) SignedCertificate))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
        \(Bytes
bytes :: Bytes.Bytes) -> Either (Failure Closure) SignedCertificate
-> IO (Either (Failure Closure) SignedCertificate)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) SignedCertificate
 -> IO (Either (Failure Closure) SignedCertificate))
-> Either (Failure Closure) SignedCertificate
-> IO (Either (Failure Closure) SignedCertificate)
forall a b. (a -> b) -> a -> b
$ (String -> Failure Closure)
-> Either String SignedCertificate
-> Either (Failure Closure) SignedCertificate
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft String -> Failure Closure
wrapFailure (Either String SignedCertificate
 -> Either (Failure Closure) SignedCertificate)
-> Either String SignedCertificate
-> Either (Failure Closure) SignedCertificate
forall a b. (a -> b) -> a -> b
$ (Bytes -> Either String PEM
decoded (Bytes -> Either String PEM)
-> (PEM -> Either String SignedCertificate)
-> Bytes
-> Either String SignedCertificate
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PEM -> Either String SignedCertificate
asCert) Bytes
bytes

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.encodeCert" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((SignedCertificate -> IO Bytes) -> ForeignFunc)
-> (SignedCertificate -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignedCertificate -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((SignedCertificate -> IO Bytes) -> FDecl Symbol ())
-> (SignedCertificate -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(SignedCertificate
cert :: X.SignedCertificate) -> Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> ByteString -> Bytes
forall a b. (a -> b) -> a -> b
$ SignedCertificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
X.encodeSignedObject SignedCertificate
cert

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.decodePrivateKey" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO [PrivKey]) -> ForeignFunc)
-> (Bytes -> IO [PrivKey])
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO [PrivKey]) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO [PrivKey]) -> FDecl Symbol ())
-> (Bytes -> IO [PrivKey]) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Bytes
bytes :: Bytes.Bytes) -> [PrivKey] -> IO [PrivKey]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PrivKey] -> IO [PrivKey]) -> [PrivKey] -> IO [PrivKey]
forall a b. (a -> b) -> a -> b
$ ByteString -> [PrivKey]
X.readKeyFileFromMemory (ByteString -> [PrivKey]) -> ByteString -> [PrivKey]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Bytes -> ByteString
Bytes.toLazyByteString Bytes
bytes

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.encodePrivateKey" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((PrivKey -> IO Bytes) -> ForeignFunc)
-> (PrivKey -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivKey -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((PrivKey -> IO Bytes) -> FDecl Symbol ())
-> (PrivKey -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(PrivKey
privateKey :: X.PrivKey) -> Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Text -> Bytes
Util.Text.toUtf8 (Text -> Bytes) -> Text -> Bytes
forall a b. (a -> b) -> a -> b
$ String -> Text
Util.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ PrivKey -> String
forall a. Show a => a -> String
show PrivKey
privateKey

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.receive.impl.v3" ForeignOp
boxToEFBox (ForeignFunc -> FDecl Symbol ())
-> ((Context -> IO Bytes) -> ForeignFunc)
-> (Context -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls ((Context -> IO Bytes) -> FDecl Symbol ())
-> (Context -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Context
tls :: TLS.Context) -> do
      ByteString
bs <- Context -> IO ByteString
forall (m :: * -> *). MonadIO m => Context -> m ByteString
TLS.recvData Context
tls
      pure $ ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray ByteString
bs

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"Tls.terminate.impl.v3" ForeignOp
boxToEF0 (ForeignFunc -> FDecl Symbol ())
-> ((Context -> IO ()) -> ForeignFunc)
-> (Context -> IO ())
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context -> IO ()) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeignTls ((Context -> IO ()) -> FDecl Symbol ())
-> (Context -> IO ()) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Context
tls :: TLS.Context) -> Context -> IO ()
forall (m :: * -> *). MonadIO m => Context -> m ()
TLS.bye Context
tls

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Code.validateLinks" ForeignOp
boxToExnEBoxBox
    (ForeignFunc -> FDecl Symbol ())
-> (([(Referent, SuperGroup Symbol)]
     -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
    -> ForeignFunc)
-> ([(Referent, SuperGroup Symbol)]
    -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Referent, SuperGroup Symbol)]
 -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (([(Referent, SuperGroup Symbol)]
  -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
 -> FDecl Symbol ())
-> ([(Referent, SuperGroup Symbol)]
    -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \([(Referent, SuperGroup Symbol)]
lsgs0 :: [(Referent, SuperGroup Symbol)]) -> do
      let f :: (Text, a) -> Failure a
f (Text
msg, a
rs) =
            Reference -> Text -> a -> Failure a
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.miscFailureRef (Text -> Text
Util.Text.fromText Text
msg) a
rs
      Either (Failure [Referent]) (Either [Referent] [Referent])
-> IO (Either (Failure [Referent]) (Either [Referent] [Referent]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure [Referent]) (Either [Referent] [Referent])
 -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> (Either (Text, [Referent]) (Either [Referent] [Referent])
    -> Either (Failure [Referent]) (Either [Referent] [Referent]))
-> Either (Text, [Referent]) (Either [Referent] [Referent])
-> IO (Either (Failure [Referent]) (Either [Referent] [Referent]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, [Referent]) -> Failure [Referent])
-> Either (Text, [Referent]) (Either [Referent] [Referent])
-> Either (Failure [Referent]) (Either [Referent] [Referent])
forall a c b. (a -> c) -> Either a b -> Either c b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text, [Referent]) -> Failure [Referent]
forall {a}. (Text, a) -> Failure a
f (Either (Text, [Referent]) (Either [Referent] [Referent])
 -> IO (Either (Failure [Referent]) (Either [Referent] [Referent])))
-> Either (Text, [Referent]) (Either [Referent] [Referent])
-> IO (Either (Failure [Referent]) (Either [Referent] [Referent]))
forall a b. (a -> b) -> a -> b
$ [(Referent, SuperGroup Symbol)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
forall v.
Var v =>
[(Referent, SuperGroup v)]
-> Either (Text, [Referent]) (Either [Referent] [Referent])
checkGroupHashes [(Referent, SuperGroup Symbol)]
lsgs0
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Code.dependencies" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((SuperGroup Symbol -> IO [Foreign]) -> ForeignFunc)
-> (SuperGroup Symbol -> IO [Foreign])
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup Symbol -> IO [Foreign]) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((SuperGroup Symbol -> IO [Foreign]) -> FDecl Symbol ())
-> (SuperGroup Symbol -> IO [Foreign]) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(SuperGroup Symbol
sg :: SuperGroup Symbol) ->
      [Foreign] -> IO [Foreign]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Foreign] -> IO [Foreign]) -> [Foreign] -> IO [Foreign]
forall a b. (a -> b) -> a -> b
$ Reference -> Referent -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
Ty.termLinkRef (Referent -> Foreign)
-> (Reference -> Referent) -> Reference -> Foreign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Referent
Ref (Reference -> Foreign) -> [Reference] -> [Foreign]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SuperGroup Symbol -> [Reference]
forall v. Var v => SuperGroup v -> [Reference]
groupTermLinks SuperGroup Symbol
sg
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Code.serialize" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((SuperGroup Symbol -> IO Bytes) -> ForeignFunc)
-> (SuperGroup Symbol -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SuperGroup Symbol -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((SuperGroup Symbol -> IO Bytes) -> FDecl Symbol ())
-> (SuperGroup Symbol -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(SuperGroup Symbol
sg :: SuperGroup Symbol) ->
      Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ByteString -> Bytes) -> ByteString -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> IO Bytes) -> ByteString -> IO Bytes
forall a b. (a -> b) -> a -> b
$ EnumMap Word64 Text -> SuperGroup Symbol -> ByteString
forall v.
Var v =>
EnumMap Word64 Text -> SuperGroup v -> ByteString
serializeGroup EnumMap Word64 Text
builtinForeignNames SuperGroup Symbol
sg
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Code.deserialize" ForeignOp
boxToEBoxBox
    (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either String (SuperGroup Symbol)))
    -> ForeignFunc)
-> (Bytes -> IO (Either String (SuperGroup Symbol)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either String (SuperGroup Symbol))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Bytes -> IO (Either String (SuperGroup Symbol)))
 -> FDecl Symbol ())
-> (Bytes -> IO (Either String (SuperGroup Symbol)))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Either String (SuperGroup Symbol)
-> IO (Either String (SuperGroup Symbol))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (SuperGroup Symbol)
 -> IO (Either String (SuperGroup Symbol)))
-> (Bytes -> Either String (SuperGroup Symbol))
-> Bytes
-> IO (Either String (SuperGroup Symbol))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. Var v => ByteString -> Either String (SuperGroup v)
deserializeGroup @Symbol (ByteString -> Either String (SuperGroup Symbol))
-> (Bytes -> ByteString)
-> Bytes
-> Either String (SuperGroup Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Code.display" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((Text, SuperGroup Symbol) -> IO String) -> ForeignFunc)
-> ((Text, SuperGroup Symbol) -> IO String)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, SuperGroup Symbol) -> IO String) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Text, SuperGroup Symbol) -> IO String) -> FDecl Symbol ())
-> ((Text, SuperGroup Symbol) -> IO String) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Text
nm, SuperGroup Symbol
sg) -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ forall v. Var v => String -> SuperGroup v -> ShowS
prettyGroup @Symbol (Text -> String
Util.Text.unpack Text
nm) SuperGroup Symbol
sg String
""
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Value.dependencies" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Value -> IO [Foreign]) -> ForeignFunc)
-> (Value -> IO [Foreign])
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> IO [Foreign]) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Value -> IO [Foreign]) -> FDecl Symbol ())
-> (Value -> IO [Foreign]) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ [Foreign] -> IO [Foreign]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Foreign] -> IO [Foreign])
-> (Value -> [Foreign]) -> Value -> IO [Foreign]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reference -> Foreign) -> [Reference] -> [Foreign]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Reference -> Referent -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
Ty.termLinkRef (Referent -> Foreign)
-> (Reference -> Referent) -> Reference -> Foreign
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reference -> Referent
Ref) ([Reference] -> [Foreign])
-> (Value -> [Reference]) -> Value -> [Foreign]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Reference]
valueTermLinks
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Value.serialize" ForeignOp
boxDirect
    (ForeignFunc -> FDecl Symbol ())
-> ((Value -> IO Bytes) -> ForeignFunc)
-> (Value -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Value -> IO Bytes) -> FDecl Symbol ())
-> (Value -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Value -> Bytes) -> Value -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> (Value -> ByteString) -> Value -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
serializeValue
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Value.deserialize" ForeignOp
boxToEBoxBox
    (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either String Value)) -> ForeignFunc)
-> (Bytes -> IO (Either String Value))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either String Value)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    ((Bytes -> IO (Either String Value)) -> FDecl Symbol ())
-> (Bytes -> IO (Either String Value)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> (Bytes -> Either String Value)
-> Bytes
-> IO (Either String Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Value
deserializeValue (ByteString -> Either String Value)
-> (Bytes -> ByteString) -> Bytes -> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray
  -- Hashing functions
  let declareHashAlgorithm :: forall alg. (Hash.HashAlgorithm alg) => Data.Text.Text -> alg -> FDecl Symbol ()
      declareHashAlgorithm :: forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
txt alg
alg = do
        let algoRef :: Reference
algoRef = Text -> Reference
forall t h. t -> Reference' t h
Builtin (Text
"crypto.HashAlgorithm." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt)
        Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked (Text
"crypto.HashAlgorithm." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt) ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO HashAlgorithm) -> ForeignFunc)
-> (() -> IO HashAlgorithm)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO HashAlgorithm) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO HashAlgorithm) -> FDecl Symbol ())
-> (() -> IO HashAlgorithm) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() ->
          HashAlgorithm -> IO HashAlgorithm
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Reference -> alg -> HashAlgorithm
forall a. HashAlgorithm a => Reference -> a -> HashAlgorithm
HashAlgorithm Reference
algoRef alg
alg)

  Text -> SHA3_512 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Sha3_512" SHA3_512
Hash.SHA3_512
  Text -> SHA3_256 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Sha3_256" SHA3_256
Hash.SHA3_256
  Text -> SHA512 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Sha2_512" SHA512
Hash.SHA512
  Text -> SHA256 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Sha2_256" SHA256
Hash.SHA256
  Text -> SHA1 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Sha1" SHA1
Hash.SHA1
  Text -> Blake2b_512 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Blake2b_512" Blake2b_512
Hash.Blake2b_512
  Text -> Blake2b_256 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Blake2b_256" Blake2b_256
Hash.Blake2b_256
  Text -> Blake2s_256 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Blake2s_256" Blake2s_256
Hash.Blake2s_256
  Text -> MD5 -> FDecl Symbol ()
forall alg. HashAlgorithm alg => Text -> alg -> FDecl Symbol ()
declareHashAlgorithm Text
"Md5" MD5
Hash.MD5

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.hashBytes" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((HashAlgorithm, Bytes) -> IO Bytes) -> ForeignFunc)
-> ((HashAlgorithm, Bytes) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashAlgorithm, Bytes) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((HashAlgorithm, Bytes) -> IO Bytes) -> FDecl Symbol ())
-> ((HashAlgorithm, Bytes) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Bytes
b :: Bytes.Bytes) ->
      let ctx :: Context a
ctx = a -> Context a
forall alg. HashAlgorithm alg => alg -> Context alg
Hash.hashInitWith a
alg
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (Context a -> Bytes) -> Context a -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Digest a -> Bytes)
-> (Context a -> Digest a) -> Context a -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Digest a
forall a. HashAlgorithm a => Context a -> Digest a
Hash.hashFinalize (Context a -> IO Bytes) -> Context a -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Context a -> [ByteString] -> Context a
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
Hash.hashUpdates Context a
ctx (Bytes -> [ByteString]
Bytes.byteStringChunks Bytes
b)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.hmacBytes" ForeignOp
boxBoxBoxDirect
    (ForeignFunc -> FDecl Symbol ())
-> (((HashAlgorithm, Bytes, Bytes) -> IO Bytes) -> ForeignFunc)
-> ((HashAlgorithm, Bytes, Bytes) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashAlgorithm, Bytes, Bytes) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((HashAlgorithm, Bytes, Bytes) -> IO Bytes) -> FDecl Symbol ())
-> ((HashAlgorithm, Bytes, Bytes) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(HashAlgorithm Reference
_ a
alg, Bytes
key :: Bytes.Bytes, Bytes
msg :: Bytes.Bytes) ->
      let out :: HMAC a
out = a -> HMAC a -> HMAC a
forall a. a -> HMAC a -> HMAC a
u a
alg (HMAC a -> HMAC a) -> HMAC a -> HMAC a
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes -> HMAC a
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
HMAC.hmac (forall b. ByteArray b => Bytes -> b
Bytes.toArray @BA.Bytes Bytes
key) (forall b. ByteArray b => Bytes -> b
Bytes.toArray @BA.Bytes Bytes
msg)
          u :: a -> HMAC.HMAC a -> HMAC.HMAC a
          u :: forall a. a -> HMAC a -> HMAC a
u a
_ HMAC a
h = HMAC a
h -- to help typechecker along
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> Bytes -> IO Bytes
forall a b. (a -> b) -> a -> b
$ HMAC a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray HMAC a
out

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.hash" ForeignOp
crypto'hash (ForeignFunc -> FDecl Symbol ())
-> (((HashAlgorithm, Value) -> IO Bytes) -> ForeignFunc)
-> ((HashAlgorithm, Value) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashAlgorithm, Value) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((HashAlgorithm, Value) -> IO Bytes) -> FDecl Symbol ())
-> ((HashAlgorithm, Value) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Value
x) ->
      let hashlazy ::
            (Hash.HashAlgorithm a) =>
            a ->
            L.ByteString ->
            Hash.Digest a
          hashlazy :: forall a. HashAlgorithm a => a -> ByteString -> Digest a
hashlazy a
_ ByteString
l = ByteString -> Digest a
forall a. HashAlgorithm a => ByteString -> Digest a
Hash.hashlazy ByteString
l
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ByteString -> Bytes) -> ByteString -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Digest a -> Bytes)
-> (ByteString -> Digest a) -> ByteString -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString -> Digest a
forall a. HashAlgorithm a => a -> ByteString -> Digest a
hashlazy a
alg (ByteString -> IO Bytes) -> ByteString -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
serializeValueLazy Value
x

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.hmac" ForeignOp
crypto'hmac (ForeignFunc -> FDecl Symbol ())
-> (((HashAlgorithm, Bytes, Value) -> IO Bytes) -> ForeignFunc)
-> ((HashAlgorithm, Bytes, Value) -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HashAlgorithm, Bytes, Value) -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((HashAlgorithm, Bytes, Value) -> IO Bytes) -> FDecl Symbol ())
-> ((HashAlgorithm, Bytes, Value) -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(HashAlgorithm Reference
_ a
alg, Bytes
key, Value
x) ->
      let hmac ::
            (Hash.HashAlgorithm a) => a -> L.ByteString -> HMAC.HMAC a
          hmac :: forall a. HashAlgorithm a => a -> ByteString -> HMAC a
hmac a
_ ByteString
s =
            Context a -> HMAC a
forall a. HashAlgorithm a => Context a -> HMAC a
HMAC.finalize
              (Context a -> HMAC a)
-> ([ByteString] -> Context a) -> [ByteString] -> HMAC a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> [ByteString] -> Context a
forall message a.
(ByteArrayAccess message, HashAlgorithm a) =>
Context a -> [message] -> Context a
HMAC.updates
                (Bytes -> Context a
forall key a.
(ByteArrayAccess key, HashAlgorithm a) =>
key -> Context a
HMAC.initialize (Bytes -> Context a) -> Bytes -> Context a
forall a b. (a -> b) -> a -> b
$ forall b. ByteArray b => Bytes -> b
Bytes.toArray @BA.Bytes Bytes
key)
              ([ByteString] -> HMAC a) -> [ByteString] -> HMAC a
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
s
       in Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes)
-> (ByteString -> Bytes) -> ByteString -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HMAC a -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (HMAC a -> Bytes) -> (ByteString -> HMAC a) -> ByteString -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString -> HMAC a
forall a. HashAlgorithm a => a -> ByteString -> HMAC a
hmac a
alg (ByteString -> IO Bytes) -> ByteString -> IO Bytes
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
serializeValueLazy Value
x

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.Ed25519.sign.impl" ForeignOp
boxBoxBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
    -> ForeignFunc)
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
 -> FDecl Symbol ())
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Either (Failure Closure) Bytes
-> IO (Either (Failure Closure) Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Bytes
 -> IO (Either (Failure Closure) Bytes))
-> ((Bytes, Bytes, Bytes) -> Either (Failure Closure) Bytes)
-> (Bytes, Bytes, Bytes)
-> IO (Either (Failure Closure) Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes, Bytes) -> Either (Failure Closure) Bytes
signEd25519Wrapper

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.Ed25519.verify.impl" ForeignOp
boxBoxBoxToEFBool
    (ForeignFunc -> FDecl Symbol ())
-> (((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
    -> ForeignFunc)
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
 -> FDecl Symbol ())
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Either (Failure Closure) Bool -> IO (Either (Failure Closure) Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Bool
 -> IO (Either (Failure Closure) Bool))
-> ((Bytes, Bytes, Bytes) -> Either (Failure Closure) Bool)
-> (Bytes, Bytes, Bytes)
-> IO (Either (Failure Closure) Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes, Bytes) -> Either (Failure Closure) Bool
verifyEd25519Wrapper

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.Rsa.sign.impl" ForeignOp
boxBoxToEFBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
    -> ForeignFunc)
-> ((Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
 -> FDecl Symbol ())
-> ((Bytes, Bytes) -> IO (Either (Failure Closure) Bytes))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Either (Failure Closure) Bytes
-> IO (Either (Failure Closure) Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Bytes
 -> IO (Either (Failure Closure) Bytes))
-> ((Bytes, Bytes) -> Either (Failure Closure) Bytes)
-> (Bytes, Bytes)
-> IO (Either (Failure Closure) Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes) -> Either (Failure Closure) Bytes
signRsaWrapper

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"crypto.Rsa.verify.impl" ForeignOp
boxBoxBoxToEFBool
    (ForeignFunc -> FDecl Symbol ())
-> (((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
    -> ForeignFunc)
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
 -> FDecl Symbol ())
-> ((Bytes, Bytes, Bytes) -> IO (Either (Failure Closure) Bool))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Either (Failure Closure) Bool -> IO (Either (Failure Closure) Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Bool
 -> IO (Either (Failure Closure) Bool))
-> ((Bytes, Bytes, Bytes) -> Either (Failure Closure) Bool)
-> (Bytes, Bytes, Bytes)
-> IO (Either (Failure Closure) Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes, Bytes, Bytes) -> Either (Failure Closure) Bool
verifyRsaWrapper

  let catchAll :: (MonadCatch m, MonadIO m, NFData a) => m a -> m (Either Util.Text.Text a)
      catchAll :: forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either Text a)
catchAll m a
e = do
        Either SomeException a
e <- m a -> m (Either SomeException a)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either SomeException a)
Exception.tryAnyDeep m a
e
        pure $ case Either SomeException a
e of
          Left SomeException
se -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
Util.Text.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
se))
          Right a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Universal.murmurHash" ForeignOp
murmur'hash (ForeignFunc -> FDecl Symbol ())
-> ((Value -> IO Word64) -> ForeignFunc)
-> (Value -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Value -> IO Word64) -> FDecl Symbol ())
-> (Value -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64) -> (Value -> Word64) -> Value -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash64 -> Word64
asWord64 (Hash64 -> Word64) -> (Value -> Hash64) -> Value -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash64
forall a. Hashable64 a => a -> Hash64
hash64 (ByteString -> Hash64) -> (Value -> ByteString) -> Value -> Hash64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
serializeValueLazy

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.randomBytes" ForeignOp
natToBox (ForeignFunc -> FDecl Symbol ())
-> ((Int -> IO Bytes) -> ForeignFunc)
-> (Int -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Int -> IO Bytes) -> FDecl Symbol ())
-> (Int -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \Int
n -> ByteString -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (ByteString -> Bytes) -> IO ByteString -> IO Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes @IO @ByteString Int
n

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.zlib.compress" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO Bytes) -> ForeignFunc)
-> (Bytes -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO Bytes) -> FDecl Symbol ())
-> (Bytes -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.zlibCompress
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.gzip.compress" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO Bytes) -> ForeignFunc)
-> (Bytes -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO Bytes) -> FDecl Symbol ())
-> (Bytes -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.gzipCompress
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.zlib.decompress" ForeignOp
boxToEBoxBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either Text Bytes)) -> ForeignFunc)
-> (Bytes -> IO (Either Text Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either Text Bytes)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ())
-> (Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \Bytes
bs ->
    IO Bytes -> IO (Either Text Bytes)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either Text a)
catchAll (Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> Bytes
Bytes.zlibDecompress Bytes
bs))
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.gzip.decompress" ForeignOp
boxToEBoxBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either Text Bytes)) -> ForeignFunc)
-> (Bytes -> IO (Either Text Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either Text Bytes)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ())
-> (Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \Bytes
bs ->
    IO Bytes -> IO (Either Text Bytes)
forall (m :: * -> *) a.
(MonadCatch m, MonadIO m, NFData a) =>
m a -> m (Either Text a)
catchAll (Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> Bytes
Bytes.gzipDecompress Bytes
bs))

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.toBase16" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO Bytes) -> ForeignFunc)
-> (Bytes -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO Bytes) -> FDecl Symbol ())
-> (Bytes -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase16
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.toBase32" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO Bytes) -> ForeignFunc)
-> (Bytes -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO Bytes) -> FDecl Symbol ())
-> (Bytes -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase32
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.toBase64" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO Bytes) -> ForeignFunc)
-> (Bytes -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO Bytes) -> FDecl Symbol ())
-> (Bytes -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase64
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.toBase64UrlUnpadded" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO Bytes) -> ForeignFunc)
-> (Bytes -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO Bytes) -> FDecl Symbol ())
-> (Bytes -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Bytes -> Bytes) -> Bytes -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
Bytes.toBase64UrlUnpadded

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.fromBase16" ForeignOp
boxToEBoxBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either Text Bytes)) -> ForeignFunc)
-> (Bytes -> IO (Either Text Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either Text Bytes)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ())
-> (Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase16
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.fromBase32" ForeignOp
boxToEBoxBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either Text Bytes)) -> ForeignFunc)
-> (Bytes -> IO (Either Text Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either Text Bytes)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ())
-> (Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase32
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.fromBase64" ForeignOp
boxToEBoxBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either Text Bytes)) -> ForeignFunc)
-> (Bytes -> IO (Either Text Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either Text Bytes)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ())
-> (Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase64
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.fromBase64UrlUnpadded" ForeignOp
boxToEBoxBox (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Either Text Bytes)) -> ForeignFunc)
-> (Bytes -> IO (Either Text Bytes))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Either Text Bytes)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ())
-> (Bytes -> IO (Either Text Bytes)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Either Text Bytes -> IO (Either Text Bytes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Bytes -> IO (Either Text Bytes))
-> (Bytes -> Either Text Bytes) -> Bytes -> IO (Either Text Bytes)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> Either Text Bytes -> Either Text Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Text -> Text
Util.Text.fromText (Either Text Bytes -> Either Text Bytes)
-> (Bytes -> Either Text Bytes) -> Bytes -> Either Text Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Either Text Bytes
Bytes.fromBase64UrlUnpadded

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.decodeNat64be" ForeignOp
boxToMaybeNTup (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc)
-> (Bytes -> IO (Maybe (Word64, Bytes)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ())
-> (Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes)))
-> (Bytes -> Maybe (Word64, Bytes))
-> Bytes
-> IO (Maybe (Word64, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (Word64, Bytes)
Bytes.decodeNat64be
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.decodeNat64le" ForeignOp
boxToMaybeNTup (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc)
-> (Bytes -> IO (Maybe (Word64, Bytes)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ())
-> (Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes)))
-> (Bytes -> Maybe (Word64, Bytes))
-> Bytes
-> IO (Maybe (Word64, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (Word64, Bytes)
Bytes.decodeNat64le
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.decodeNat32be" ForeignOp
boxToMaybeNTup (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc)
-> (Bytes -> IO (Maybe (Word64, Bytes)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ())
-> (Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes)))
-> (Bytes -> Maybe (Word64, Bytes))
-> Bytes
-> IO (Maybe (Word64, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (Word64, Bytes)
Bytes.decodeNat32be
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.decodeNat32le" ForeignOp
boxToMaybeNTup (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc)
-> (Bytes -> IO (Maybe (Word64, Bytes)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ())
-> (Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes)))
-> (Bytes -> Maybe (Word64, Bytes))
-> Bytes
-> IO (Maybe (Word64, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (Word64, Bytes)
Bytes.decodeNat32le
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.decodeNat16be" ForeignOp
boxToMaybeNTup (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc)
-> (Bytes -> IO (Maybe (Word64, Bytes)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ())
-> (Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes)))
-> (Bytes -> Maybe (Word64, Bytes))
-> Bytes
-> IO (Maybe (Word64, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (Word64, Bytes)
Bytes.decodeNat16be
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.decodeNat16le" ForeignOp
boxToMaybeNTup (ForeignFunc -> FDecl Symbol ())
-> ((Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc)
-> (Bytes -> IO (Maybe (Word64, Bytes)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> IO (Maybe (Word64, Bytes))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ())
-> (Bytes -> IO (Maybe (Word64, Bytes))) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Word64, Bytes) -> IO (Maybe (Word64, Bytes)))
-> (Bytes -> Maybe (Word64, Bytes))
-> Bytes
-> IO (Maybe (Word64, Bytes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Maybe (Word64, Bytes)
Bytes.decodeNat16le

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.encodeNat64be" (Reference -> ForeignOp
wordDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> ((Word64 -> IO Bytes) -> ForeignFunc)
-> (Word64 -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Word64 -> IO Bytes) -> FDecl Symbol ())
-> (Word64 -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Word64 -> Bytes) -> Word64 -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bytes
Bytes.encodeNat64be
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.encodeNat64le" (Reference -> ForeignOp
wordDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> ((Word64 -> IO Bytes) -> ForeignFunc)
-> (Word64 -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Word64 -> IO Bytes) -> FDecl Symbol ())
-> (Word64 -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Word64 -> Bytes) -> Word64 -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bytes
Bytes.encodeNat64le
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.encodeNat32be" (Reference -> ForeignOp
wordDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> ((Word64 -> IO Bytes) -> ForeignFunc)
-> (Word64 -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Word64 -> IO Bytes) -> FDecl Symbol ())
-> (Word64 -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Word64 -> Bytes) -> Word64 -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bytes
Bytes.encodeNat32be
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.encodeNat32le" (Reference -> ForeignOp
wordDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> ((Word64 -> IO Bytes) -> ForeignFunc)
-> (Word64 -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Word64 -> IO Bytes) -> FDecl Symbol ())
-> (Word64 -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Word64 -> Bytes) -> Word64 -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bytes
Bytes.encodeNat32le
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.encodeNat16be" (Reference -> ForeignOp
wordDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> ((Word64 -> IO Bytes) -> ForeignFunc)
-> (Word64 -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Word64 -> IO Bytes) -> FDecl Symbol ())
-> (Word64 -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Word64 -> Bytes) -> Word64 -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bytes
Bytes.encodeNat16be
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Bytes.encodeNat16le" (Reference -> ForeignOp
wordDirect Reference
Ty.natRef) (ForeignFunc -> FDecl Symbol ())
-> ((Word64 -> IO Bytes) -> ForeignFunc)
-> (Word64 -> IO Bytes)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> IO Bytes) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Word64 -> IO Bytes) -> FDecl Symbol ())
-> (Word64 -> IO Bytes) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Bytes -> IO Bytes
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bytes -> IO Bytes) -> (Word64 -> Bytes) -> Word64 -> IO Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Bytes
Bytes.encodeNat16le

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableArray.copyTo!" ForeignOp
boxNatBoxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableArray RealWorld Closure, Word64,
      MutableArray RealWorld Closure, Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableArray RealWorld Closure, Word64,
     MutableArray RealWorld Closure, Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableArray RealWorld Closure, Word64,
  MutableArray RealWorld Closure, Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableArray RealWorld Closure, Word64,
   MutableArray RealWorld Closure, Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableArray RealWorld Closure, Word64,
     MutableArray RealWorld Closure, Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MutableArray RealWorld Closure
dst, Word64
doff, MutableArray RealWorld Closure
src, Word64
soff, Word64
l) ->
      let name :: Text
name = Text
"MutableArray.copyTo!"
       in if Word64
l Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then Either (Failure Closure) () -> IO (Either (Failure Closure) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds Text
name (MutableArray RealWorld Closure -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Closure
dst) (Word64
doff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds Text
name (MutableArray RealWorld Closure -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Closure
src) (Word64
soff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Closure) ())
-> IO () -> IO (Either (Failure Closure) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
PA.copyMutableArray @IO @Closure
                      MutableArray RealWorld Closure
MutableArray (PrimState IO) Closure
dst
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
doff)
                      MutableArray RealWorld Closure
MutableArray (PrimState IO) Closure
src
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
soff)
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
l)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.copyTo!" ForeignOp
boxNatBoxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray RealWorld, Word64,
      MutableByteArray RealWorld, Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableByteArray RealWorld, Word64,
     MutableByteArray RealWorld, Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, MutableByteArray RealWorld,
  Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray RealWorld, Word64, MutableByteArray RealWorld,
   Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableByteArray RealWorld, Word64,
     MutableByteArray RealWorld, Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MutableByteArray RealWorld
dst, Word64
doff, MutableByteArray RealWorld
src, Word64
soff, Word64
l) ->
      let name :: Text
name = Text
"MutableByteArray.copyTo!"
       in if Word64
l Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then Either (Failure Closure) () -> IO (Either (Failure Closure) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
dst) (Word64
doff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l) Word64
0 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
src) (Word64
soff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l) Word64
0 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Closure) ())
-> IO () -> IO (Either (Failure Closure) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(() :: Constraint, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PA.copyMutableByteArray @IO
                      MutableByteArray RealWorld
MutableByteArray (PrimState IO)
dst
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
doff)
                      MutableByteArray RealWorld
MutableByteArray (PrimState IO)
src
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
soff)
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
l)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableArray.copyTo!" ForeignOp
boxNatBoxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableArray RealWorld Closure, Word64, Array Closure,
      Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableArray RealWorld Closure, Word64, Array Closure, Word64,
     Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableArray RealWorld Closure, Word64, Array Closure, Word64,
  Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableArray RealWorld Closure, Word64, Array Closure, Word64,
   Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableArray RealWorld Closure, Word64, Array Closure, Word64,
     Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MutableArray RealWorld Closure
dst, Word64
doff, Array Closure
src, Word64
soff, Word64
l) ->
      let name :: Text
name = Text
"ImmutableArray.copyTo!"
       in if Word64
l Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then Either (Failure Closure) () -> IO (Either (Failure Closure) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds Text
name (MutableArray RealWorld Closure -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Closure
dst) (Word64
doff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds Text
name (Array Closure -> Int
forall a. Array a -> Int
PA.sizeofArray Array Closure
src) (Word64
soff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Closure) ())
-> IO () -> IO (Either (Failure Closure) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
PA.copyArray @IO @Closure
                      MutableArray RealWorld Closure
MutableArray (PrimState IO) Closure
dst
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
doff)
                      Array Closure
src
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
soff)
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
l)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableArray.size" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((Array Closure -> IO Word64) -> ForeignFunc)
-> (Array Closure -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Array Closure -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Array Closure -> IO Word64) -> FDecl Symbol ())
-> (Array Closure -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64)
-> (Array Closure -> Word64) -> Array Closure -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> Word64)
-> (Array Closure -> Int) -> Array Closure -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Array a -> Int
PA.sizeofArray @Closure
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableArray.size" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((MutableArray RealWorld Closure -> IO Word64) -> ForeignFunc)
-> (MutableArray RealWorld Closure -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MutableArray RealWorld Closure -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((MutableArray RealWorld Closure -> IO Word64) -> FDecl Symbol ())
-> (MutableArray RealWorld Closure -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64)
-> (MutableArray RealWorld Closure -> Word64)
-> MutableArray RealWorld Closure
-> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> Word64)
-> (MutableArray RealWorld Closure -> Int)
-> MutableArray RealWorld Closure
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. MutableArray s a -> Int
PA.sizeofMutableArray @PA.RealWorld @Closure
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.size" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((ByteArray -> IO Word64) -> ForeignFunc)
-> (ByteArray -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArray -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((ByteArray -> IO Word64) -> FDecl Symbol ())
-> (ByteArray -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64)
-> (ByteArray -> Word64) -> ByteArray -> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> Word64) -> (ByteArray -> Int) -> ByteArray -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> Int
PA.sizeofByteArray
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.size" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((MutableByteArray RealWorld -> IO Word64) -> ForeignFunc)
-> (MutableByteArray RealWorld -> IO Word64)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MutableByteArray RealWorld -> IO Word64) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((MutableByteArray RealWorld -> IO Word64) -> FDecl Symbol ())
-> (MutableByteArray RealWorld -> IO Word64) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Word64 -> IO Word64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> IO Word64)
-> (MutableByteArray RealWorld -> Word64)
-> MutableByteArray RealWorld
-> IO Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word64 (Int -> Word64)
-> (MutableByteArray RealWorld -> Int)
-> MutableByteArray RealWorld
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray @PA.RealWorld

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.copyTo!" ForeignOp
boxNatBoxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray RealWorld, Word64, ByteArray, Word64,
      Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableByteArray RealWorld, Word64, ByteArray, Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, ByteArray, Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray RealWorld, Word64, ByteArray, Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableByteArray RealWorld, Word64, ByteArray, Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(MutableByteArray RealWorld
dst, Word64
doff, ByteArray
src, Word64
soff, Word64
l) ->
      let name :: Text
name = Text
"ImmutableByteArray.copyTo!"
       in if Word64
l Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
            then Either (Failure Closure) () -> IO (Either (Failure Closure) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
            else
              Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
dst) (Word64
doff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l) Word64
0 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
src) (Word64
soff Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l) Word64
0 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$
                  () -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right
                    (() -> Either (Failure Closure) ())
-> IO () -> IO (Either (Failure Closure) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(() :: Constraint, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PA.copyByteArray @IO
                      MutableByteArray RealWorld
MutableByteArray (PrimState IO)
dst
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
doff)
                      ByteArray
src
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
soff)
                      (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
l)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableArray.read" ForeignOp
boxNatToExnBox
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableArray (PrimState IO) Closure, Word64)
     -> IO (Either (Failure Closure) Closure))
    -> ForeignFunc)
-> ((MutableArray (PrimState IO) Closure, Word64)
    -> IO (Either (Failure Closure) Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableArray RealWorld Closure, Word64)
 -> IO (Either (Failure Closure) Closure))
-> ForeignFunc
((MutableArray (PrimState IO) Closure, Word64)
 -> IO (Either (Failure Closure) Closure))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableArray (PrimState IO) Closure, Word64)
  -> IO (Either (Failure Closure) Closure))
 -> FDecl Symbol ())
-> ((MutableArray (PrimState IO) Closure, Word64)
    -> IO (Either (Failure Closure) Closure))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableArray (PrimState IO) Closure, Word64)
-> IO (Either (Failure Closure) Closure)
checkedRead Text
"MutableArray.read"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.read8" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64)
     -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64)
  -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead8 Text
"MutableByteArray.read8"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.read16be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64)
     -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64)
  -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead16 Text
"MutableByteArray.read16be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.read24be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64)
     -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64)
  -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead24 Text
"MutableByteArray.read24be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.read32be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64)
     -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64)
  -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead32 Text
"MutableByteArray.read32be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.read40be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64)
     -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64)
  -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead40 Text
"MutableByteArray.read40be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.read64be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64)
     -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64)
 -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64)
  -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64)
    -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead64 Text
"MutableByteArray.read64be"

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableArray.write" ForeignOp
boxNatBoxToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableArray (PrimState IO) Closure, Word64, Closure)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableArray (PrimState IO) Closure, Word64, Closure)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableArray RealWorld Closure, Word64, Closure)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
((MutableArray (PrimState IO) Closure, Word64, Closure)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableArray (PrimState IO) Closure, Word64, Closure)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableArray (PrimState IO) Closure, Word64, Closure)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableArray (PrimState IO) Closure, Word64, Closure)
-> IO (Either (Failure Closure) ())
checkedWrite Text
"MutableArray.write"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.write8" ForeignOp
boxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite8 Text
"MutableByteArray.write8"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.write16be" ForeignOp
boxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite16 Text
"MutableByteArray.write16be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.write32be" ForeignOp
boxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite32 Text
"MutableByteArray.write32be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.write64be" ForeignOp
boxNatNatToExnUnit
    (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray (PrimState IO), Word64, Word64)
     -> IO (Either (Failure Closure) ()))
    -> ForeignFunc)
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
((MutableByteArray (PrimState IO), Word64, Word64)
 -> IO (Either (Failure Closure) ()))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((MutableByteArray (PrimState IO), Word64, Word64)
  -> IO (Either (Failure Closure) ()))
 -> FDecl Symbol ())
-> ((MutableByteArray (PrimState IO), Word64, Word64)
    -> IO (Either (Failure Closure) ()))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite64 Text
"MutableByteArray.write64be"

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableArray.read" ForeignOp
boxNatToExnBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Array Closure, Word64)
     -> IO (Either (Failure Closure) Closure))
    -> ForeignFunc)
-> ((Array Closure, Word64)
    -> IO (Either (Failure Closure) Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Array Closure, Word64) -> IO (Either (Failure Closure) Closure))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Array Closure, Word64) -> IO (Either (Failure Closure) Closure))
 -> FDecl Symbol ())
-> ((Array Closure, Word64)
    -> IO (Either (Failure Closure) Closure))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text
-> (Array Closure, Word64) -> IO (Either (Failure Closure) Closure)
checkedIndex Text
"ImmutableArray.read"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.read8" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex8 Text
"ImmutableByteArray.read8"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.read16be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex16 Text
"ImmutableByteArray.read16be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.read24be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex24 Text
"ImmutableByteArray.read24be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.read32be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex32 Text
"ImmutableByteArray.read32be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.read40be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex40 Text
"ImmutableByteArray.read40be"
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.read64be" ForeignOp
boxNatToExnNat
    (ForeignFunc -> FDecl Symbol ())
-> (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
    -> ForeignFunc)
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
 -> FDecl Symbol ())
-> ((ByteArray, Word64) -> IO (Either (Failure Closure) Word64))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex64 Text
"ImmutableByteArray.read64be"

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.freeze!" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((MutableByteArray RealWorld -> IO ByteArray) -> ForeignFunc)
-> (MutableByteArray RealWorld -> IO ByteArray)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MutableByteArray RealWorld -> IO ByteArray) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((MutableByteArray RealWorld -> IO ByteArray) -> FDecl Symbol ())
-> (MutableByteArray RealWorld -> IO ByteArray) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    MutableByteArray RealWorld -> IO ByteArray
MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PA.unsafeFreezeByteArray
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableArray.freeze!" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((MutableArray (PrimState IO) Closure -> IO (Array Closure))
    -> ForeignFunc)
-> (MutableArray (PrimState IO) Closure -> IO (Array Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MutableArray RealWorld Closure -> IO (Array Closure))
-> ForeignFunc
(MutableArray (PrimState IO) Closure -> IO (Array Closure))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((MutableArray (PrimState IO) Closure -> IO (Array Closure))
 -> FDecl Symbol ())
-> (MutableArray (PrimState IO) Closure -> IO (Array Closure))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
PA.unsafeFreezeArray @IO @Closure

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.freeze" ForeignOp
boxNatNatToExnBox (ForeignFunc -> FDecl Symbol ())
-> (((MutableByteArray RealWorld, Word64, Word64)
     -> IO (Either (Failure Closure) ByteArray))
    -> ForeignFunc)
-> ((MutableByteArray RealWorld, Word64, Word64)
    -> IO (Either (Failure Closure) ByteArray))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableByteArray RealWorld, Word64, Word64)
 -> IO (Either (Failure Closure) ByteArray))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((MutableByteArray RealWorld, Word64, Word64)
  -> IO (Either (Failure Closure) ByteArray))
 -> FDecl Symbol ())
-> ((MutableByteArray RealWorld, Word64, Word64)
    -> IO (Either (Failure Closure) ByteArray))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(MutableByteArray RealWorld
src, Word64
off, Word64
len) ->
      if Word64
len Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
        then (ByteArray -> Either (Failure Closure) ByteArray)
-> IO ByteArray -> IO (Either (Failure Closure) ByteArray)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteArray -> Either (Failure Closure) ByteArray
forall a b. b -> Either a b
Right (IO ByteArray -> IO (Either (Failure Closure) ByteArray))
-> (MutableByteArray RealWorld -> IO ByteArray)
-> MutableByteArray RealWorld
-> IO (Either (Failure Closure) ByteArray)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableByteArray RealWorld -> IO ByteArray
MutableByteArray (PrimState IO) -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
PA.unsafeFreezeByteArray (MutableByteArray RealWorld
 -> IO (Either (Failure Closure) ByteArray))
-> IO (MutableByteArray RealWorld)
-> IO (Either (Failure Closure) ByteArray)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray Int
0
        else
          Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ByteArray)
-> IO (Either (Failure Closure) ByteArray)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim
            Text
"MutableByteArray.freeze"
            (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
src)
            (Word64
off Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
len)
            Word64
0
            (IO (Either (Failure Closure) ByteArray)
 -> IO (Either (Failure Closure) ByteArray))
-> IO (Either (Failure Closure) ByteArray)
-> IO (Either (Failure Closure) ByteArray)
forall a b. (a -> b) -> a -> b
$ ByteArray -> Either (Failure Closure) ByteArray
forall a b. b -> Either a b
Right (ByteArray -> Either (Failure Closure) ByteArray)
-> IO ByteArray -> IO (Either (Failure Closure) ByteArray)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableByteArray (PrimState IO) -> Int -> Int -> IO ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> m ByteArray
PA.freezeByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
src (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
off) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableArray.freeze" ForeignOp
boxNatNatToExnBox (ForeignFunc -> FDecl Symbol ())
-> (((MutableArray RealWorld Closure, Word64, Word64)
     -> IO (Either (Failure Closure) (Array Closure)))
    -> ForeignFunc)
-> ((MutableArray RealWorld Closure, Word64, Word64)
    -> IO (Either (Failure Closure) (Array Closure)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MutableArray RealWorld Closure, Word64, Word64)
 -> IO (Either (Failure Closure) (Array Closure)))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((MutableArray RealWorld Closure, Word64, Word64)
  -> IO (Either (Failure Closure) (Array Closure)))
 -> FDecl Symbol ())
-> ((MutableArray RealWorld Closure, Word64, Word64)
    -> IO (Either (Failure Closure) (Array Closure)))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(MutableArray RealWorld Closure
src :: PA.MutableArray PA.RealWorld Closure.RClosure, Word64
off, Word64
len) ->
      if Word64
len Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
        then (Array Closure -> Either (Failure Closure) (Array Closure))
-> IO (Array Closure)
-> IO (Either (Failure Closure) (Array Closure))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array Closure -> Either (Failure Closure) (Array Closure)
forall a b. b -> Either a b
Right (IO (Array Closure)
 -> IO (Either (Failure Closure) (Array Closure)))
-> (MutableArray RealWorld Closure -> IO (Array Closure))
-> MutableArray RealWorld Closure
-> IO (Either (Failure Closure) (Array Closure))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableArray RealWorld Closure -> IO (Array Closure)
MutableArray (PrimState IO) Closure -> IO (Array Closure)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
PA.unsafeFreezeArray (MutableArray RealWorld Closure
 -> IO (Either (Failure Closure) (Array Closure)))
-> IO (MutableArray RealWorld Closure)
-> IO (Either (Failure Closure) (Array Closure))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Closure -> IO (MutableArray (PrimState IO) Closure)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
0 Closure
forall comb. GClosure comb
Closure.BlackHole
        else
          Text
-> Int
-> Word64
-> IO (Either (Failure Closure) (Array Closure))
-> IO (Either (Failure Closure) (Array Closure))
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds
            Text
"MutableArray.freeze"
            (MutableArray RealWorld Closure -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Closure
src)
            (Word64
off Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
len Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
            (IO (Either (Failure Closure) (Array Closure))
 -> IO (Either (Failure Closure) (Array Closure)))
-> IO (Either (Failure Closure) (Array Closure))
-> IO (Either (Failure Closure) (Array Closure))
forall a b. (a -> b) -> a -> b
$ Array Closure -> Either (Failure Closure) (Array Closure)
forall a b. b -> Either a b
Right (Array Closure -> Either (Failure Closure) (Array Closure))
-> IO (Array Closure)
-> IO (Either (Failure Closure) (Array Closure))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray (PrimState IO) Closure
-> Int -> Int -> IO (Array Closure)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> Int -> m (Array a)
PA.freezeArray MutableArray RealWorld Closure
MutableArray (PrimState IO) Closure
src (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
off) (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len)

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"MutableByteArray.length" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((MutableByteArray RealWorld -> IO Int) -> ForeignFunc)
-> (MutableByteArray RealWorld -> IO Int)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MutableByteArray RealWorld -> IO Int) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((MutableByteArray RealWorld -> IO Int) -> FDecl Symbol ())
-> (MutableByteArray RealWorld -> IO Int) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int)
-> (MutableByteArray RealWorld -> Int)
-> MutableByteArray RealWorld
-> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray @PA.RealWorld

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"ImmutableByteArray.length" ForeignOp
boxToNat (ForeignFunc -> FDecl Symbol ())
-> ((ByteArray -> IO Int) -> ForeignFunc)
-> (ByteArray -> IO Int)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArray -> IO Int) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((ByteArray -> IO Int) -> FDecl Symbol ())
-> (ByteArray -> IO Int) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> (ByteArray -> Int) -> ByteArray -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteArray -> Int
PA.sizeofByteArray

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.array" ForeignOp
natToBox (ForeignFunc -> FDecl Symbol ())
-> ((Int -> IO (MutableArray RealWorld Closure)) -> ForeignFunc)
-> (Int -> IO (MutableArray RealWorld Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO (MutableArray RealWorld Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Int -> IO (MutableArray RealWorld Closure)) -> FDecl Symbol ())
-> (Int -> IO (MutableArray RealWorld Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \Int
n -> Int -> Closure -> IO (MutableArray (PrimState IO) Closure)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n (Closure
forall comb. GClosure comb
Closure.BlackHole :: Closure.RClosure)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.arrayOf" ForeignOp
boxNatToBox (ForeignFunc -> FDecl Symbol ())
-> (((Closure, Int) -> IO (MutableArray RealWorld Closure))
    -> ForeignFunc)
-> ((Closure, Int) -> IO (MutableArray RealWorld Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Closure, Int) -> IO (MutableArray RealWorld Closure))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Closure, Int) -> IO (MutableArray RealWorld Closure))
 -> FDecl Symbol ())
-> ((Closure, Int) -> IO (MutableArray RealWorld Closure))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Closure
v :: Closure, Int
n) -> Int -> Closure -> IO (MutableArray (PrimState IO) Closure)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n Closure
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.bytearray" ForeignOp
natToBox (ForeignFunc -> FDecl Symbol ())
-> ((Int -> IO (MutableByteArray RealWorld)) -> ForeignFunc)
-> (Int -> IO (MutableByteArray RealWorld))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO (MutableByteArray RealWorld)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Int -> IO (MutableByteArray RealWorld)) -> FDecl Symbol ())
-> (Int -> IO (MutableByteArray RealWorld)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutableByteArray RealWorld)
Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Tracked Text
"IO.bytearrayOf" ForeignOp
natNatToBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Word8, Int) -> IO (MutableByteArray RealWorld))
    -> ForeignFunc)
-> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8, Int) -> IO (MutableByteArray RealWorld)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Word8, Int) -> IO (MutableByteArray RealWorld))
 -> FDecl Symbol ())
-> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Word8
init, Int
sz) -> do
      MutableByteArray RealWorld
arr <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray Int
sz
      MutableByteArray (PrimState IO) -> Int -> Int -> Word8 -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
PA.fillByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr Int
0 Int
sz Word8
init
      pure MutableByteArray RealWorld
arr

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Scope.array" ForeignOp
natToBox (ForeignFunc -> FDecl Symbol ())
-> ((Int -> IO (MutableArray RealWorld Closure)) -> ForeignFunc)
-> (Int -> IO (MutableArray RealWorld Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO (MutableArray RealWorld Closure)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Int -> IO (MutableArray RealWorld Closure)) -> FDecl Symbol ())
-> (Int -> IO (MutableArray RealWorld Closure)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \Int
n -> Int -> Closure -> IO (MutableArray (PrimState IO) Closure)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n (Closure
forall comb. GClosure comb
Closure.BlackHole :: Closure.RClosure)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Scope.arrayOf" ForeignOp
boxNatToBox (ForeignFunc -> FDecl Symbol ())
-> (((Closure, Int) -> IO (MutableArray RealWorld Closure))
    -> ForeignFunc)
-> ((Closure, Int) -> IO (MutableArray RealWorld Closure))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Closure, Int) -> IO (MutableArray RealWorld Closure))
-> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Closure, Int) -> IO (MutableArray RealWorld Closure))
 -> FDecl Symbol ())
-> ((Closure, Int) -> IO (MutableArray RealWorld Closure))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Closure
v :: Closure, Int
n) -> Int -> Closure -> IO (MutableArray (PrimState IO) Closure)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
PA.newArray Int
n Closure
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Scope.bytearray" ForeignOp
natToBox (ForeignFunc -> FDecl Symbol ())
-> ((Int -> IO (MutableByteArray RealWorld)) -> ForeignFunc)
-> (Int -> IO (MutableByteArray RealWorld))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO (MutableByteArray RealWorld)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Int -> IO (MutableByteArray RealWorld)) -> FDecl Symbol ())
-> (Int -> IO (MutableByteArray RealWorld)) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutableByteArray RealWorld)
Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Scope.bytearrayOf" ForeignOp
natNatToBox
    (ForeignFunc -> FDecl Symbol ())
-> (((Word8, Int) -> IO (MutableByteArray RealWorld))
    -> ForeignFunc)
-> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8, Int) -> IO (MutableByteArray RealWorld)) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign
    (((Word8, Int) -> IO (MutableByteArray RealWorld))
 -> FDecl Symbol ())
-> ((Word8, Int) -> IO (MutableByteArray RealWorld))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Word8
init, Int
sz) -> do
      MutableByteArray RealWorld
arr <- Int -> IO (MutableByteArray (PrimState IO))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
PA.newByteArray Int
sz
      MutableByteArray (PrimState IO) -> Int -> Int -> Word8 -> IO ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
PA.fillByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr Int
0 Int
sz Word8
init
      pure MutableByteArray RealWorld
arr

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.literal" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((Text -> IO CPattern) -> ForeignFunc)
-> (Text -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((Text -> IO CPattern) -> FDecl Symbol ())
-> (Text -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \Text
txt -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern
TPat.Literal Text
txt
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.digit" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CPattern) -> ForeignFunc)
-> (() -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CPattern) -> FDecl Symbol ())
-> (() -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (Char -> Char -> CharPattern
TPat.CharRange Char
'0' Char
'9')) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.letter" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CPattern) -> ForeignFunc)
-> (() -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CPattern) -> FDecl Symbol ())
-> (() -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Letter)) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.space" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CPattern) -> ForeignFunc)
-> (() -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CPattern) -> FDecl Symbol ())
-> (() -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Whitespace)) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.punctuation" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CPattern) -> ForeignFunc)
-> (() -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CPattern) -> FDecl Symbol ())
-> (() -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Punctuation)) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.anyChar" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CPattern) -> ForeignFunc)
-> (() -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CPattern) -> FDecl Symbol ())
-> (() -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char CharPattern
TPat.Any) in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.eof" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CPattern) -> ForeignFunc)
-> (() -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CPattern) -> FDecl Symbol ())
-> (() -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern Pattern
TPat.Eof in \() -> CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v
  let ccd :: ForeignOp
ccd = Reference -> Reference -> ForeignOp
wordWordDirect Reference
Ty.charRef Reference
Ty.charRef
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.charRange" ForeignOp
ccd (ForeignFunc -> FDecl Symbol ())
-> (((Char, Char) -> IO CPattern) -> ForeignFunc)
-> ((Char, Char) -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Char) -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Char, Char) -> IO CPattern) -> FDecl Symbol ())
-> ((Char, Char) -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Char
beg, Char
end) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharPattern
TPat.CharRange Char
beg Char
end
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.notCharRange" ForeignOp
ccd (ForeignFunc -> FDecl Symbol ())
-> (((Char, Char) -> IO CPattern) -> ForeignFunc)
-> ((Char, Char) -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Char) -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Char, Char) -> IO CPattern) -> FDecl Symbol ())
-> ((Char, Char) -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Char
beg, Char
end) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> Pattern)
-> (CharPattern -> CharPattern) -> CharPattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> CharPattern
TPat.Not (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharPattern
TPat.CharRange Char
beg Char
end
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.charIn" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> (([Closure] -> IO CPattern) -> ForeignFunc)
-> ([Closure] -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Closure] -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (([Closure] -> IO CPattern) -> FDecl Symbol ())
-> ([Closure] -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \[Closure]
ccs -> do
    String
cs <- [Closure] -> (Closure -> IO Char) -> IO String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Closure]
ccs ((Closure -> IO Char) -> IO String)
-> (Closure -> IO Char) -> IO String
forall a b. (a -> b) -> a -> b
$ \case
      Closure.DataU1 Reference
_ Word64
_ Int
i -> Char -> IO Char
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i)
      Closure
_ -> String -> IO Char
forall a. HasCallStack => String -> IO a
die String
"Text.patterns.charIn: non-character closure"
    CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ String -> CharPattern
TPat.CharSet String
cs
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.notCharIn" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> (([Closure] -> IO CPattern) -> ForeignFunc)
-> ([Closure] -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Closure] -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (([Closure] -> IO CPattern) -> FDecl Symbol ())
-> ([Closure] -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \[Closure]
ccs -> do
    String
cs <- [Closure] -> (Closure -> IO Char) -> IO String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Closure]
ccs ((Closure -> IO Char) -> IO String)
-> (Closure -> IO Char) -> IO String
forall a b. (a -> b) -> a -> b
$ \case
      Closure.DataU1 Reference
_ Word64
_ Int
i -> Char -> IO Char
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i)
      Closure
_ -> String -> IO Char
forall a. HasCallStack => String -> IO a
die String
"Text.patterns.notCharIn: non-character closure"
    CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (CharPattern -> CPattern) -> CharPattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> (CharPattern -> Pattern) -> CharPattern -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> Pattern
TPat.Char (CharPattern -> Pattern)
-> (CharPattern -> CharPattern) -> CharPattern -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> CharPattern
TPat.Not (CharPattern -> IO CPattern) -> CharPattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ String -> CharPattern
TPat.CharSet String
cs
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.many" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((CPattern -> IO CPattern) -> ForeignFunc)
-> (CPattern -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPattern -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((CPattern -> IO CPattern) -> FDecl Symbol ())
-> (CPattern -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Bool -> Pattern -> Pattern
TPat.Many Bool
False Pattern
p
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.many.corrected" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((CPattern -> IO CPattern) -> ForeignFunc)
-> (CPattern -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPattern -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((CPattern -> IO CPattern) -> FDecl Symbol ())
-> (CPattern -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Bool -> Pattern -> Pattern
TPat.Many Bool
True Pattern
p
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.capture" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((CPattern -> IO CPattern) -> ForeignFunc)
-> (CPattern -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CPattern -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((CPattern -> IO CPattern) -> FDecl Symbol ())
-> (CPattern -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern
TPat.Capture Pattern
p
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.captureAs" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((Text, CPattern) -> IO CPattern) -> ForeignFunc)
-> ((Text, CPattern) -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, CPattern) -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Text, CPattern) -> IO CPattern) -> FDecl Symbol ())
-> ((Text, CPattern) -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Text
t, (TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_)) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Text -> Pattern -> Pattern
TPat.CaptureAs Text
t Pattern
p
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.join" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> (([CPattern] -> IO CPattern) -> ForeignFunc)
-> ([CPattern] -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CPattern] -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (([CPattern] -> IO CPattern) -> FDecl Symbol ())
-> ([CPattern] -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \[CPattern]
ps ->
    CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> ([Pattern] -> CPattern) -> [Pattern] -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> CPattern)
-> ([Pattern] -> Pattern) -> [Pattern] -> CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pattern] -> Pattern
TPat.Join ([Pattern] -> IO CPattern) -> [Pattern] -> IO CPattern
forall a b. (a -> b) -> a -> b
$ (CPattern -> Pattern) -> [CPattern] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map (\(TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) -> Pattern
p) [CPattern]
ps
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.or" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((CPattern, CPattern) -> IO CPattern) -> ForeignFunc)
-> ((CPattern, CPattern) -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CPattern, CPattern) -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((CPattern, CPattern) -> IO CPattern) -> FDecl Symbol ())
-> ((CPattern, CPattern) -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
l Text -> Maybe ([Text], Text)
_, TPat.CP Pattern
r Text -> Maybe ([Text], Text)
_) -> CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Pattern -> Pattern -> Pattern
TPat.Or Pattern
l Pattern
r
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.replicate" ForeignOp
natNatBoxToBox (ForeignFunc -> FDecl Symbol ())
-> (((Word64, Word64, CPattern) -> IO CPattern) -> ForeignFunc)
-> ((Word64, Word64, CPattern) -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word64, Word64, CPattern) -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Word64, Word64, CPattern) -> IO CPattern) -> FDecl Symbol ())
-> ((Word64, Word64, CPattern) -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(Word64
m0 :: Word64, Word64
n0 :: Word64, TPat.CP Pattern
p Text -> Maybe ([Text], Text)
_) ->
      let m :: Int
m = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
m0; n :: Int
n = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n0
       in CPattern -> IO CPattern
forall a. a -> IO a
evaluate (CPattern -> IO CPattern)
-> (Pattern -> CPattern) -> Pattern -> IO CPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> CPattern
TPat.cpattern (Pattern -> IO CPattern) -> Pattern -> IO CPattern
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pattern -> Pattern
TPat.Replicate Int
m Int
n Pattern
p

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.run" ForeignOp
boxBoxToMaybeTup (ForeignFunc -> FDecl Symbol ())
-> (((CPattern, Text) -> IO (Maybe ([Text], Text))) -> ForeignFunc)
-> ((CPattern, Text) -> IO (Maybe ([Text], Text)))
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CPattern, Text) -> IO (Maybe ([Text], Text))) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((CPattern, Text) -> IO (Maybe ([Text], Text)))
 -> FDecl Symbol ())
-> ((CPattern, Text) -> IO (Maybe ([Text], Text)))
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
_ Text -> Maybe ([Text], Text)
matcher, Text
input :: Text) -> Maybe ([Text], Text) -> IO (Maybe ([Text], Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ([Text], Text) -> IO (Maybe ([Text], Text)))
-> Maybe ([Text], Text) -> IO (Maybe ([Text], Text))
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ([Text], Text)
matcher Text
input

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Pattern.isMatch" ForeignOp
boxBoxToBool (ForeignFunc -> FDecl Symbol ())
-> (((CPattern, Text) -> IO Bool) -> ForeignFunc)
-> ((CPattern, Text) -> IO Bool)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CPattern, Text) -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((CPattern, Text) -> IO Bool) -> FDecl Symbol ())
-> ((CPattern, Text) -> IO Bool) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$
    \(TPat.CP Pattern
_ Text -> Maybe ([Text], Text)
matcher, Text
input :: Text) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool)
-> (Maybe ([Text], Text) -> Bool)
-> Maybe ([Text], Text)
-> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ([Text], Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Text], Text) -> IO Bool)
-> Maybe ([Text], Text) -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ([Text], Text)
matcher Text
input

  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.any" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CharPattern
TPat.Any
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.not" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((CharPattern -> IO CharPattern) -> ForeignFunc)
-> (CharPattern -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharPattern -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((CharPattern -> IO CharPattern) -> FDecl Symbol ())
-> (CharPattern -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern)
-> (CharPattern -> CharPattern) -> CharPattern -> IO CharPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPattern -> CharPattern
TPat.Not
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.and" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((CharPattern, CharPattern) -> IO CharPattern) -> ForeignFunc)
-> ((CharPattern, CharPattern) -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CharPattern, CharPattern) -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((CharPattern, CharPattern) -> IO CharPattern) -> FDecl Symbol ())
-> ((CharPattern, CharPattern) -> IO CharPattern)
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(CharPattern
a, CharPattern
b) -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ CharPattern -> CharPattern -> CharPattern
TPat.Intersect CharPattern
a CharPattern
b
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.or" ForeignOp
boxBoxDirect (ForeignFunc -> FDecl Symbol ())
-> (((CharPattern, CharPattern) -> IO CharPattern) -> ForeignFunc)
-> ((CharPattern, CharPattern) -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CharPattern, CharPattern) -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((CharPattern, CharPattern) -> IO CharPattern) -> FDecl Symbol ())
-> ((CharPattern, CharPattern) -> IO CharPattern)
-> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(CharPattern
a, CharPattern
b) -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ CharPattern -> CharPattern -> CharPattern
TPat.Union CharPattern
a CharPattern
b
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.range" (Reference -> Reference -> ForeignOp
wordWordDirect Reference
charRef Reference
charRef) (ForeignFunc -> FDecl Symbol ())
-> (((Char, Char) -> IO CharPattern) -> ForeignFunc)
-> ((Char, Char) -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Char) -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((Char, Char) -> IO CharPattern) -> FDecl Symbol ())
-> ((Char, Char) -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(Char
a, Char
b) -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ Char -> Char -> CharPattern
TPat.CharRange Char
a Char
b
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.anyOf" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> (([Closure] -> IO CharPattern) -> ForeignFunc)
-> ([Closure] -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Closure] -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (([Closure] -> IO CharPattern) -> FDecl Symbol ())
-> ([Closure] -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \[Closure]
ccs -> do
    String
cs <- [Closure] -> (Closure -> IO Char) -> IO String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Closure]
ccs ((Closure -> IO Char) -> IO String)
-> (Closure -> IO Char) -> IO String
forall a b. (a -> b) -> a -> b
$ \case
      Closure.DataU1 Reference
_ Word64
_ Int
i -> Char -> IO Char
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Char
forall a. Enum a => Int -> a
toEnum Int
i)
      Closure
_ -> String -> IO Char
forall a. HasCallStack => String -> IO a
die String
"Text.patterns.charIn: non-character closure"
    CharPattern -> IO CharPattern
forall a. a -> IO a
evaluate (CharPattern -> IO CharPattern) -> CharPattern -> IO CharPattern
forall a b. (a -> b) -> a -> b
$ String -> CharPattern
TPat.CharSet String
cs
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.alphanumeric" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.AlphaNum)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.upper" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Upper)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.lower" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Lower)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.whitespace" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Whitespace)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.control" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Control)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.printable" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Printable)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.mark" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.MarkChar)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.number" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Number)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.punctuation" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Punctuation)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.symbol" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Symbol)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.separator" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Separator)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.letter" ForeignOp
direct (ForeignFunc -> FDecl Symbol ())
-> ((() -> IO CharPattern) -> ForeignFunc)
-> (() -> IO CharPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO CharPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((() -> IO CharPattern) -> FDecl Symbol ())
-> (() -> IO CharPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \() -> CharPattern -> IO CharPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CharClass -> CharPattern
TPat.CharClass CharClass
TPat.Letter)
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Char.Class.is" (Reference -> ForeignOp
boxWordToBool Reference
charRef) (ForeignFunc -> FDecl Symbol ())
-> (((CharPattern, Char) -> IO Bool) -> ForeignFunc)
-> ((CharPattern, Char) -> IO Bool)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CharPattern, Char) -> IO Bool) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign (((CharPattern, Char) -> IO Bool) -> FDecl Symbol ())
-> ((CharPattern, Char) -> IO Bool) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \(CharPattern
cl, Char
c) -> Bool -> IO Bool
forall a. a -> IO a
evaluate (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CharPattern -> Char -> Bool
TPat.charPatternPred CharPattern
cl Char
c
  Sandbox -> Text -> ForeignOp -> ForeignFunc -> FDecl Symbol ()
declareForeign Sandbox
Untracked Text
"Text.patterns.char" ForeignOp
boxDirect (ForeignFunc -> FDecl Symbol ())
-> ((CharPattern -> IO CPattern) -> ForeignFunc)
-> (CharPattern -> IO CPattern)
-> FDecl Symbol ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharPattern -> IO CPattern) -> ForeignFunc
forall a r.
(ForeignConvention a, ForeignConvention r) =>
(a -> IO r) -> ForeignFunc
mkForeign ((CharPattern -> IO CPattern) -> FDecl Symbol ())
-> (CharPattern -> IO CPattern) -> FDecl Symbol ()
forall a b. (a -> b) -> a -> b
$ \CharPattern
c ->
    let v :: CPattern
v = Pattern -> CPattern
TPat.cpattern (CharPattern -> Pattern
TPat.Char CharPattern
c) in CPattern -> IO CPattern
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CPattern
v

type RW = PA.PrimState IO

checkedRead ::
  Text -> (PA.MutableArray RW Closure, Word64) -> IO (Either Failure Closure)
checkedRead :: Text
-> (MutableArray (PrimState IO) Closure, Word64)
-> IO (Either (Failure Closure) Closure)
checkedRead Text
name (MutableArray (PrimState IO) Closure
arr, Word64
w) =
  Text
-> Int
-> Word64
-> IO (Either (Failure Closure) Closure)
-> IO (Either (Failure Closure) Closure)
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds
    Text
name
    (MutableArray RealWorld Closure -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Closure
MutableArray (PrimState IO) Closure
arr)
    Word64
w
    (Closure -> Either (Failure Closure) Closure
forall a b. b -> Either a b
Right (Closure -> Either (Failure Closure) Closure)
-> IO Closure -> IO (Either (Failure Closure) Closure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray (PrimState IO) Closure -> Int -> IO Closure
forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a -> Int -> m a
PA.readArray MutableArray (PrimState IO) Closure
arr (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w))

checkedWrite ::
  Text -> (PA.MutableArray RW Closure, Word64, Closure) -> IO (Either Failure ())
checkedWrite :: Text
-> (MutableArray (PrimState IO) Closure, Word64, Closure)
-> IO (Either (Failure Closure) ())
checkedWrite Text
name (MutableArray (PrimState IO) Closure
arr, Word64
w, Closure
v) =
  Text
-> Int
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds
    Text
name
    (MutableArray RealWorld Closure -> Int
forall s a. MutableArray s a -> Int
PA.sizeofMutableArray MutableArray RealWorld Closure
MutableArray (PrimState IO) Closure
arr)
    Word64
w
    (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right (() -> Either (Failure Closure) ())
-> IO () -> IO (Either (Failure Closure) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray (PrimState IO) Closure -> Int -> Closure -> IO ()
forall (m :: * -> *) a.
(() :: Constraint, PrimMonad m) =>
MutableArray (PrimState m) a -> Int -> a -> m ()
PA.writeArray MutableArray (PrimState IO) Closure
arr (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w) Closure
v)

checkedIndex ::
  Text -> (PA.Array Closure, Word64) -> IO (Either Failure Closure)
checkedIndex :: Text
-> (Array Closure, Word64) -> IO (Either (Failure Closure) Closure)
checkedIndex Text
name (Array Closure
arr, Word64
w) =
  Text
-> Int
-> Word64
-> IO (Either (Failure Closure) Closure)
-> IO (Either (Failure Closure) Closure)
forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds
    Text
name
    (Array Closure -> Int
forall a. Array a -> Int
PA.sizeofArray Array Closure
arr)
    Word64
w
    (Closure -> Either (Failure Closure) Closure
forall a b. b -> Either a b
Right (Closure -> Either (Failure Closure) Closure)
-> IO Closure -> IO (Either (Failure Closure) Closure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array Closure -> Int -> IO Closure
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
PA.indexArrayM Array Closure
arr (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w))

checkedRead8 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead8 :: Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead8 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
1 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> (Word8 -> Word64) -> Word8 -> Either (Failure Closure) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Either (Failure Closure) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr Int
j
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedRead16 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead16 :: Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead16 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
2 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    Word8 -> Word8 -> Either (Failure Closure) Word64
mk16
      (Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Word8 -> Either (Failure Closure) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr Int
j
      IO (Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedRead24 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead24 :: Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead24 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
3 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64
mk24
      (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr Int
j
      IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO (Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedRead32 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead32 :: Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead32 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
4 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    Word8 -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64
mk32
      (Word8
 -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr Int
j
      IO (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      IO (Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedRead40 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead40 :: Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead40 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
6 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Closure) Word64
mk40
      (Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO
     (Word8
      -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr Int
j
      IO
  (Word8
   -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
      IO (Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedRead64 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead64 :: Text
-> (MutableByteArray (PrimState IO), Word64)
-> IO (Either (Failure Closure) Word64)
checkedRead64 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
8 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Closure) Word64
mk64
      (Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Word8
 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Either (Failure Closure) Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr Int
j
      IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Either (Failure Closure) Word64)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Either (Failure Closure) Word64)
-> IO Word8
-> IO
     (Word8
      -> Word8
      -> Word8
      -> Word8
      -> Word8
      -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
      IO
  (Word8
   -> Word8
   -> Word8
   -> Word8
   -> Word8
   -> Either (Failure Closure) Word64)
-> IO Word8
-> IO
     (Word8
      -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
      IO
  (Word8
   -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
      IO (Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8
-> IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5)
      IO (Word8 -> Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Word8 -> Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6)
      IO (Word8 -> Either (Failure Closure) Word64)
-> IO Word8 -> IO (Either (Failure Closure) Word64)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray @Word8 MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

mk16 :: Word8 -> Word8 -> Either Failure Word64
mk16 :: Word8 -> Word8 -> Either (Failure Closure) Word64
mk16 Word8
b0 Word8
b1 = Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> Word64 -> Either (Failure Closure) Word64
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1)

mk24 :: Word8 -> Word8 -> Word8 -> Either Failure Word64
mk24 :: Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64
mk24 Word8
b0 Word8
b1 Word8
b2 =
  Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> Word64 -> Either (Failure Closure) Word64
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2)

mk32 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk32 :: Word8 -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64
mk32 Word8
b0 Word8
b1 Word8
b2 Word8
b3 =
  Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> Word64 -> Either (Failure Closure) Word64
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3)

mk40 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk40 :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Closure) Word64
mk40 Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 =
  Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> Word64 -> Either (Failure Closure) Word64
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4)

mk64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk64 :: Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Closure) Word64
mk64 Word8
b0 Word8
b1 Word8
b2 Word8
b3 Word8
b4 Word8
b5 Word8
b6 Word8
b7 =
  Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> Word64 -> Either (Failure Closure) Word64
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b7)

checkedWrite8 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite8 :: Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite8 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i, Word64
v) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
1 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr Int
j (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word8)
    pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedWrite16 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite16 :: Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite16 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i, Word64
v) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
2 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr Int
j (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word8)
    pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedWrite32 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite32 :: Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite32 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i, Word64
v) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
4 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr Int
j (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word8)
    pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

checkedWrite64 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
checkedWrite64 :: Text
-> (MutableByteArray (PrimState IO), Word64, Word64)
-> IO (Either (Failure Closure) ())
checkedWrite64 Text
name (MutableByteArray (PrimState IO)
arr, Word64
i, Word64
v) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (MutableByteArray RealWorld -> Int
forall s. MutableByteArray s -> Int
PA.sizeofMutableByteArray MutableByteArray RealWorld
MutableByteArray (PrimState IO)
arr) Word64
i Word64
8 (IO (Either (Failure Closure) ())
 -> IO (Either (Failure Closure) ()))
-> IO (Either (Failure Closure) ())
-> IO (Either (Failure Closure) ())
forall a b. (a -> b) -> a -> b
$ do
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr Int
j (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
56 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
v Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8 :: Word8)
    MutableByteArray (PrimState IO) -> Int -> Word8 -> IO ()
forall a (m :: * -> *).
(() :: Constraint, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray MutableByteArray (PrimState IO)
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word8)
    pure (() -> Either (Failure Closure) ()
forall a b. b -> Either a b
Right ())
  where
    j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

-- index single byte
checkedIndex8 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex8 :: Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex8 Text
name (ByteArray
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) Word64
i Word64
1 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> (Either (Failure Closure) Word64
    -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Word64
 -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
     in Word64 -> Either (Failure Closure) Word64
forall a b. b -> Either a b
Right (Word64 -> Either (Failure Closure) Word64)
-> (Word8 -> Word64) -> Word8 -> Either (Failure Closure) Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Either (Failure Closure) Word64)
-> Word8 -> Either (Failure Closure) Word64
forall a b. (a -> b) -> a -> b
$ forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray @Word8 ByteArray
arr Int
j

-- index 16 big-endian
checkedIndex16 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex16 :: Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex16 Text
name (ByteArray
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) Word64
i Word64
2 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> (Either (Failure Closure) Word64
    -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Word64
 -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
     in Word8 -> Word8 -> Either (Failure Closure) Word64
mk16 (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j) (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

-- index 32 big-endian
checkedIndex24 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex24 :: Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex24 Text
name (ByteArray
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) Word64
i Word64
3 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> (Either (Failure Closure) Word64
    -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Word64
 -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
     in Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64
mk24
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))

-- index 32 big-endian
checkedIndex32 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex32 :: Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex32 Text
name (ByteArray
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) Word64
i Word64
4 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> (Either (Failure Closure) Word64
    -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Word64
 -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
     in Word8 -> Word8 -> Word8 -> Word8 -> Either (Failure Closure) Word64
mk32
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))

-- index 40 big-endian
checkedIndex40 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex40 :: Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex40 Text
name (ByteArray
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) Word64
i Word64
5 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> (Either (Failure Closure) Word64
    -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Word64
 -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
     in Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Closure) Word64
mk40
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4))

-- index 64 big-endian
checkedIndex64 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex64 :: Text -> (ByteArray, Word64) -> IO (Either (Failure Closure) Word64)
checkedIndex64 Text
name (ByteArray
arr, Word64
i) =
  Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) Word64)
-> IO (Either (Failure Closure) Word64)
forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name (ByteArray -> Int
PA.sizeofByteArray ByteArray
arr) Word64
i Word64
8 (IO (Either (Failure Closure) Word64)
 -> IO (Either (Failure Closure) Word64))
-> (Either (Failure Closure) Word64
    -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) Word64
 -> IO (Either (Failure Closure) Word64))
-> Either (Failure Closure) Word64
-> IO (Either (Failure Closure) Word64)
forall a b. (a -> b) -> a -> b
$
    let j :: Int
j = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
     in Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Either (Failure Closure) Word64
mk64
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr Int
j)
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6))
          (ByteArray -> Int -> Word8
forall a. (() :: Constraint, Prim a) => ByteArray -> Int -> a
PA.indexByteArray ByteArray
arr (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7))

checkBounds :: Text -> Int -> Word64 -> IO (Either Failure b) -> IO (Either Failure b)
checkBounds :: forall b.
Text
-> Int
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBounds Text
name Int
l Word64
w IO (Either (Failure Closure) b)
act
  | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l = IO (Either (Failure Closure) b)
act
  | Bool
otherwise = Either (Failure Closure) b -> IO (Either (Failure Closure) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) b -> IO (Either (Failure Closure) b))
-> Either (Failure Closure) b -> IO (Either (Failure Closure) b)
forall a b. (a -> b) -> a -> b
$ Failure Closure -> Either (Failure Closure) b
forall a b. a -> Either a b
Left Failure Closure
err
  where
    msg :: Text
msg = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": array index out of bounds"
    err :: Failure Closure
err = Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.arrayFailureRef Text
msg (Word64 -> Closure
natValue Word64
w)

-- Performs a bounds check on a byte array. Strategy is as follows:
--
--   isz = signed array size-in-bytes
--   off = unsigned byte offset into the array
--   esz = unsigned number of bytes to be read
--
--   1. Turn the signed size-in-bytes of the array unsigned
--   2. Add the offset to the to-be-read number to get the maximum size needed
--   3. Check that the actual array size is at least as big as the needed size
--   4. Check that the offset is less than the size
--
-- Step 4 ensures that step 3 has not overflowed. Since an actual array size can
-- only be 63 bits (since it is signed), the only way for 3 to overflow is if
-- the offset is larger than a possible array size, since it would need to be
-- 2^64-k, where k is the small (<=8) number of bytes to be read.
checkBoundsPrim ::
  Text -> Int -> Word64 -> Word64 -> IO (Either Failure b) -> IO (Either Failure b)
checkBoundsPrim :: forall b.
Text
-> Int
-> Word64
-> Word64
-> IO (Either (Failure Closure) b)
-> IO (Either (Failure Closure) b)
checkBoundsPrim Text
name Int
isz Word64
off Word64
esz IO (Either (Failure Closure) b)
act
  | Word64
w Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
bsz Bool -> Bool -> Bool
|| Word64
off Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
bsz = Either (Failure Closure) b -> IO (Either (Failure Closure) b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Failure Closure) b -> IO (Either (Failure Closure) b))
-> Either (Failure Closure) b -> IO (Either (Failure Closure) b)
forall a b. (a -> b) -> a -> b
$ Failure Closure -> Either (Failure Closure) b
forall a b. a -> Either a b
Left Failure Closure
err
  | Bool
otherwise = IO (Either (Failure Closure) b)
act
  where
    msg :: Text
msg = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": array index out of bounds"
    err :: Failure Closure
err = Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.arrayFailureRef Text
msg (Word64 -> Closure
natValue Word64
off)

    bsz :: Word64
bsz = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
isz
    w :: Word64
w = Word64
off Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
esz

hostPreference :: Maybe Util.Text.Text -> SYS.HostPreference
hostPreference :: Maybe Text -> HostPreference
hostPreference Maybe Text
Nothing = HostPreference
SYS.HostAny
hostPreference (Just Text
host) = String -> HostPreference
SYS.Host (String -> HostPreference) -> String -> HostPreference
forall a b. (a -> b) -> a -> b
$ Text -> String
Util.Text.unpack Text
host

signEd25519Wrapper ::
  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes
signEd25519Wrapper :: (Bytes, Bytes, Bytes) -> Either (Failure Closure) Bytes
signEd25519Wrapper (Bytes
secret0, Bytes
public0, Bytes
msg0) = case CryptoFailable (SecretKey, PublicKey)
validated of
  CryptoFailed CryptoError
err ->
    Failure Closure -> Either (Failure Closure) Bytes
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.cryptoFailureRef (CryptoError -> Text
forall {a}. IsString a => CryptoError -> a
errMsg CryptoError
err) Closure
unitValue)
  CryptoPassed (SecretKey
secret, PublicKey
public) ->
    Bytes -> Either (Failure Closure) Bytes
forall a b. b -> Either a b
Right (Bytes -> Either (Failure Closure) Bytes)
-> (Signature -> Bytes)
-> Signature
-> Either (Failure Closure) Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Bytes
forall b. ByteArrayAccess b => b -> Bytes
Bytes.fromArray (Signature -> Either (Failure Closure) Bytes)
-> Signature -> Either (Failure Closure) Bytes
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
secret PublicKey
public ByteString
msg
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    validated :: CryptoFailable (SecretKey, PublicKey)
validated =
      (,)
        (SecretKey -> PublicKey -> (SecretKey, PublicKey))
-> CryptoFailable SecretKey
-> CryptoFailable (PublicKey -> (SecretKey, PublicKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
secret0 :: ByteString)
        CryptoFailable (PublicKey -> (SecretKey, PublicKey))
-> CryptoFailable PublicKey
-> CryptoFailable (SecretKey, PublicKey)
forall a b.
CryptoFailable (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
public0 :: ByteString)

    errMsg :: CryptoError -> a
errMsg CryptoError
CryptoError_PublicKeySizeInvalid =
      a
"ed25519: Public key size invalid"
    errMsg CryptoError
CryptoError_SecretKeySizeInvalid =
      a
"ed25519: Secret key size invalid"
    errMsg CryptoError
CryptoError_SecretKeyStructureInvalid =
      a
"ed25519: Secret key structure invalid"
    errMsg CryptoError
_ = a
"ed25519: unexpected error"

verifyEd25519Wrapper ::
  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool
verifyEd25519Wrapper :: (Bytes, Bytes, Bytes) -> Either (Failure Closure) Bool
verifyEd25519Wrapper (Bytes
public0, Bytes
msg0, Bytes
sig0) = case CryptoFailable (PublicKey, Signature)
validated of
  CryptoFailed CryptoError
err ->
    Failure Closure -> Either (Failure Closure) Bool
forall a b. a -> Either a b
Left (Failure Closure -> Either (Failure Closure) Bool)
-> Failure Closure -> Either (Failure Closure) Bool
forall a b. (a -> b) -> a -> b
$ Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.cryptoFailureRef (CryptoError -> Text
forall {a}. IsString a => CryptoError -> a
errMsg CryptoError
err) Closure
unitValue
  CryptoPassed (PublicKey
public, Signature
sig) ->
    Bool -> Either (Failure Closure) Bool
forall a b. b -> Either a b
Right (Bool -> Either (Failure Closure) Bool)
-> Bool -> Either (Failure Closure) Bool
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
public ByteString
msg Signature
sig
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    validated :: CryptoFailable (PublicKey, Signature)
validated =
      (,)
        (PublicKey -> Signature -> (PublicKey, Signature))
-> CryptoFailable PublicKey
-> CryptoFailable (Signature -> (PublicKey, Signature))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
public0 :: ByteString)
        CryptoFailable (Signature -> (PublicKey, Signature))
-> CryptoFailable Signature
-> CryptoFailable (PublicKey, Signature)
forall a b.
CryptoFailable (a -> b) -> CryptoFailable a -> CryptoFailable b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
sig0 :: ByteString)

    errMsg :: CryptoError -> a
errMsg CryptoError
CryptoError_PublicKeySizeInvalid =
      a
"ed25519: Public key size invalid"
    errMsg CryptoError
CryptoError_SecretKeySizeInvalid =
      a
"ed25519: Secret key size invalid"
    errMsg CryptoError
CryptoError_SecretKeyStructureInvalid =
      a
"ed25519: Secret key structure invalid"
    errMsg CryptoError
_ = a
"ed25519: unexpected error"

signRsaWrapper ::
  (Bytes.Bytes, Bytes.Bytes) -> Either Failure Bytes.Bytes
signRsaWrapper :: (Bytes, Bytes) -> Either (Failure Closure) Bytes
signRsaWrapper (Bytes
secret0, Bytes
msg0) = case Either Text PrivateKey
validated of
  Left Text
err ->
    Failure Closure -> Either (Failure Closure) Bytes
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.cryptoFailureRef Text
err Closure
unitValue)
  Right PrivateKey
secret ->
    case Maybe Blinder
-> Maybe SHA256
-> PrivateKey
-> ByteString
-> Either Error ByteString
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe Blinder
-> Maybe hashAlg
-> PrivateKey
-> ByteString
-> Either Error ByteString
RSA.sign Maybe Blinder
forall a. Maybe a
Nothing (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
Hash.SHA256) PrivateKey
secret ByteString
msg of
      Left Error
err -> Failure Closure -> Either (Failure Closure) Bytes
forall a b. a -> Either a b
Left (Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.cryptoFailureRef (Error -> Text
Rsa.rsaErrorToText Error
err) Closure
unitValue)
      Right ByteString
signature -> Bytes -> Either (Failure Closure) Bytes
forall a b. b -> Either a b
Right (Bytes -> Either (Failure Closure) Bytes)
-> Bytes -> Either (Failure Closure) Bytes
forall a b. (a -> b) -> a -> b
$ ByteString -> Bytes
Bytes.fromByteString ByteString
signature
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    validated :: Either Text PrivateKey
validated = ByteString -> Either Text PrivateKey
Rsa.parseRsaPrivateKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
secret0 :: ByteString)

verifyRsaWrapper ::
  (Bytes.Bytes, Bytes.Bytes, Bytes.Bytes) -> Either Failure Bool
verifyRsaWrapper :: (Bytes, Bytes, Bytes) -> Either (Failure Closure) Bool
verifyRsaWrapper (Bytes
public0, Bytes
msg0, Bytes
sig0) = case Either Text PublicKey
validated of
  Left Text
err ->
    Failure Closure -> Either (Failure Closure) Bool
forall a b. a -> Either a b
Left (Failure Closure -> Either (Failure Closure) Bool)
-> Failure Closure -> Either (Failure Closure) Bool
forall a b. (a -> b) -> a -> b
$ Reference -> Text -> Closure -> Failure Closure
forall a. Reference -> Text -> a -> Failure a
Failure Reference
Ty.cryptoFailureRef Text
err Closure
unitValue
  Right PublicKey
public ->
    Bool -> Either (Failure Closure) Bool
forall a b. b -> Either a b
Right (Bool -> Either (Failure Closure) Bool)
-> Bool -> Either (Failure Closure) Bool
forall a b. (a -> b) -> a -> b
$ Maybe SHA256 -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
RSA.verify (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
Hash.SHA256) PublicKey
public ByteString
msg ByteString
sig
  where
    msg :: ByteString
msg = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
msg0 :: ByteString
    sig :: ByteString
sig = Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
sig0 :: ByteString
    validated :: Either Text PublicKey
validated = ByteString -> Either Text PublicKey
Rsa.parseRsaPublicKey (Bytes -> ByteString
forall b. ByteArray b => Bytes -> b
Bytes.toArray Bytes
public0 :: ByteString)

foreignDeclResults ::
  Bool -> (Word64, [(Data.Text.Text, (Sandbox, SuperNormal Symbol))], EnumMap Word64 (Data.Text.Text, ForeignFunc))
foreignDeclResults :: Bool
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
foreignDeclResults Bool
sanitize =
  State
  (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
   EnumMap Word64 (Text, ForeignFunc))
  ()
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
forall s a. State s a -> s -> s
execState (FDecl Symbol ()
-> Bool
-> State
     (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
      EnumMap Word64 (Text, ForeignFunc))
     ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT FDecl Symbol ()
declareForeigns Bool
sanitize) (Word64
0, [], EnumMap Word64 (Text, ForeignFunc)
forall a. Monoid a => a
mempty)

foreignWrappers :: [(Data.Text.Text, (Sandbox, SuperNormal Symbol))]
foreignWrappers :: [(Text, (Sandbox, SuperNormal Symbol))]
foreignWrappers | (Word64
_, [(Text, (Sandbox, SuperNormal Symbol))]
l, EnumMap Word64 (Text, ForeignFunc)
_) <- Bool
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
foreignDeclResults Bool
False = [(Text, (Sandbox, SuperNormal Symbol))]
-> [(Text, (Sandbox, SuperNormal Symbol))]
forall a. [a] -> [a]
reverse [(Text, (Sandbox, SuperNormal Symbol))]
l

numberedTermLookup :: EnumMap Word64 (SuperNormal Symbol)
numberedTermLookup :: EnumMap Word64 (SuperNormal Symbol)
numberedTermLookup =
  [(Word64, SuperNormal Symbol)]
-> EnumMap Word64 (SuperNormal Symbol)
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList ([(Word64, SuperNormal Symbol)]
 -> EnumMap Word64 (SuperNormal Symbol))
-> (Map Reference (Sandbox, SuperNormal Symbol)
    -> [(Word64, SuperNormal Symbol)])
-> Map Reference (Sandbox, SuperNormal Symbol)
-> EnumMap Word64 (SuperNormal Symbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> [SuperNormal Symbol] -> [(Word64, SuperNormal Symbol)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
1 ..] ([SuperNormal Symbol] -> [(Word64, SuperNormal Symbol)])
-> (Map Reference (Sandbox, SuperNormal Symbol)
    -> [SuperNormal Symbol])
-> Map Reference (Sandbox, SuperNormal Symbol)
-> [(Word64, SuperNormal Symbol)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Reference (SuperNormal Symbol) -> [SuperNormal Symbol]
forall k a. Map k a -> [a]
Map.elems (Map Reference (SuperNormal Symbol) -> [SuperNormal Symbol])
-> (Map Reference (Sandbox, SuperNormal Symbol)
    -> Map Reference (SuperNormal Symbol))
-> Map Reference (Sandbox, SuperNormal Symbol)
-> [SuperNormal Symbol]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Sandbox, SuperNormal Symbol) -> SuperNormal Symbol)
-> Map Reference (Sandbox, SuperNormal Symbol)
-> Map Reference (SuperNormal Symbol)
forall a b. (a -> b) -> Map Reference a -> Map Reference b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Sandbox, SuperNormal Symbol) -> SuperNormal Symbol
forall a b. (a, b) -> b
snd (Map Reference (Sandbox, SuperNormal Symbol)
 -> EnumMap Word64 (SuperNormal Symbol))
-> Map Reference (Sandbox, SuperNormal Symbol)
-> EnumMap Word64 (SuperNormal Symbol)
forall a b. (a -> b) -> a -> b
$ Map Reference (Sandbox, SuperNormal Symbol)
builtinLookup

builtinTermNumbering :: Map Reference Word64
builtinTermNumbering :: Map Reference Word64
builtinTermNumbering =
  [(Reference, Word64)] -> Map Reference Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Reference] -> [Word64] -> [(Reference, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map Reference (Sandbox, SuperNormal Symbol) -> [Reference]
forall k a. Map k a -> [k]
Map.keys (Map Reference (Sandbox, SuperNormal Symbol) -> [Reference])
-> Map Reference (Sandbox, SuperNormal Symbol) -> [Reference]
forall a b. (a -> b) -> a -> b
$ Map Reference (Sandbox, SuperNormal Symbol)
builtinLookup) [Word64
1 ..])

builtinTermBackref :: EnumMap Word64 Reference
builtinTermBackref :: EnumMap Word64 Reference
builtinTermBackref =
  [(Word64, Reference)] -> EnumMap Word64 Reference
forall k a. EnumKey k => [(k, a)] -> EnumMap k a
mapFromList ([(Word64, Reference)] -> EnumMap Word64 Reference)
-> (Map Reference (Sandbox, SuperNormal Symbol)
    -> [(Word64, Reference)])
-> Map Reference (Sandbox, SuperNormal Symbol)
-> EnumMap Word64 Reference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> [Reference] -> [(Word64, Reference)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
1 ..] ([Reference] -> [(Word64, Reference)])
-> (Map Reference (Sandbox, SuperNormal Symbol) -> [Reference])
-> Map Reference (Sandbox, SuperNormal Symbol)
-> [(Word64, Reference)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Reference (Sandbox, SuperNormal Symbol) -> [Reference]
forall k a. Map k a -> [k]
Map.keys (Map Reference (Sandbox, SuperNormal Symbol)
 -> EnumMap Word64 Reference)
-> Map Reference (Sandbox, SuperNormal Symbol)
-> EnumMap Word64 Reference
forall a b. (a -> b) -> a -> b
$ Map Reference (Sandbox, SuperNormal Symbol)
builtinLookup

builtinForeigns :: EnumMap Word64 ForeignFunc
builtinForeigns :: EnumMap Word64 ForeignFunc
builtinForeigns | (Word64
_, [(Text, (Sandbox, SuperNormal Symbol))]
_, EnumMap Word64 (Text, ForeignFunc)
m) <- Bool
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
foreignDeclResults Bool
False = (Text, ForeignFunc) -> ForeignFunc
forall a b. (a, b) -> b
snd ((Text, ForeignFunc) -> ForeignFunc)
-> EnumMap Word64 (Text, ForeignFunc) -> EnumMap Word64 ForeignFunc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap Word64 (Text, ForeignFunc)
m

sandboxedForeigns :: EnumMap Word64 ForeignFunc
sandboxedForeigns :: EnumMap Word64 ForeignFunc
sandboxedForeigns | (Word64
_, [(Text, (Sandbox, SuperNormal Symbol))]
_, EnumMap Word64 (Text, ForeignFunc)
m) <- Bool
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
foreignDeclResults Bool
True = (Text, ForeignFunc) -> ForeignFunc
forall a b. (a, b) -> b
snd ((Text, ForeignFunc) -> ForeignFunc)
-> EnumMap Word64 (Text, ForeignFunc) -> EnumMap Word64 ForeignFunc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap Word64 (Text, ForeignFunc)
m

builtinForeignNames :: EnumMap Word64 Data.Text.Text
builtinForeignNames :: EnumMap Word64 Text
builtinForeignNames | (Word64
_, [(Text, (Sandbox, SuperNormal Symbol))]
_, EnumMap Word64 (Text, ForeignFunc)
m) <- Bool
-> (Word64, [(Text, (Sandbox, SuperNormal Symbol))],
    EnumMap Word64 (Text, ForeignFunc))
foreignDeclResults Bool
False = (Text, ForeignFunc) -> Text
forall a b. (a, b) -> a
fst ((Text, ForeignFunc) -> Text)
-> EnumMap Word64 (Text, ForeignFunc) -> EnumMap Word64 Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnumMap Word64 (Text, ForeignFunc)
m

-- Bootstrapping for sandbox check. The eventual map will be one with
-- associations `r -> s` where `s` is all the 'sensitive' base
-- functions that `r` calls.
baseSandboxInfo :: Map Reference (Set Reference)
baseSandboxInfo :: Map Reference (Set Reference)
baseSandboxInfo =
  [(Reference, Set Reference)] -> Map Reference (Set Reference)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Reference, Set Reference)] -> Map Reference (Set Reference))
-> [(Reference, Set Reference)] -> Map Reference (Set Reference)
forall a b. (a -> b) -> a -> b
$
    [ (Reference
r, Reference -> Set Reference
forall a. a -> Set a
Set.singleton Reference
r)
      | (Reference
r, (Sandbox
sb, SuperNormal Symbol
_)) <- Map Reference (Sandbox, SuperNormal Symbol)
-> [(Reference, (Sandbox, SuperNormal Symbol))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Reference (Sandbox, SuperNormal Symbol)
builtinLookup,
        Sandbox
sb Sandbox -> Sandbox -> Bool
forall a. Eq a => a -> a -> Bool
== Sandbox
Tracked
    ]

unsafeSTMToIO :: STM.STM a -> IO a
unsafeSTMToIO :: forall a. STM a -> IO a
unsafeSTMToIO (STM.STM State# RealWorld -> (# State# RealWorld, a #)
m) = (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO State# RealWorld -> (# State# RealWorld, a #)
m