module Unison.Runtime.Machine.Primops where

import Control.Concurrent.STM as STM
import Control.Exception
import Data.Atomics qualified as Atomic
import Data.Bits
import Data.IORef (IORef)
import Data.IORef qualified as IORef
import Data.Map.Strict qualified as M
import Data.Sequence qualified as Sq
import Data.Set qualified as S
import Data.Word
import Unison.Builtin.Decls qualified as Ty
import Unison.Prelude hiding (Text)
import Unison.Reference (Reference)
import Unison.Referent (Referent, toShortHash, pattern Ref)
import Unison.Runtime.ANF (Code, Value, codeGroup)
import Unison.Runtime.Foreign
import Unison.Runtime.Foreign.Function
import Unison.Runtime.MCode
import Unison.Runtime.Machine.Types
import Unison.Runtime.Stack
import Unison.Runtime.TypeTags qualified as Ty
import Unison.ShortHash qualified as SH
import Unison.Type qualified as Rf
import Unison.Util.Bytes (Bytes)
import Unison.Util.Bytes qualified as By
import Unison.Util.Text as UText

prim1wrap ::
  (ForeignConvention x) =>
  (Stack -> x -> IO ()) ->
  Stack ->
  Int ->
  IO Stack
prim1wrap :: forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> x -> IO ()
f Stack
stk Int
i = do
  x
x <- Stack -> Int -> IO x
forall a. ForeignConvention a => Stack -> Int -> IO a
readAtIndex Stack
stk Int
i
  Stack
stk <- Stack -> IO Stack
bump Stack
stk
  Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> x -> IO ()
f Stack
stk x
x
{-# INLINE prim1wrap #-}

prim1 :: CCache -> Stack -> Prim1 -> Int -> IO Stack
prim1 :: CCache -> Stack -> Prim1 -> Int -> IO Stack
prim1 !CCache
_env !Stack
stk Prim1
DECI !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
deci Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
DECN !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
decn Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
INCI !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
inci Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
INCN !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
incn Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TRNC !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
trnc Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
NEGI !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
negi Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SGNI !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
sgni Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ABSF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
absf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
CEIL !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
ceil Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
FLOR !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
flor Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TRNF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
trnf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
RNDF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
rndf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
EXPF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
expf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
LOGF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
logf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SQRT !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
sqtf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
COSF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
cosf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SINF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
sinf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TANF !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
tanf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
COSH !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
cshf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SINH !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
snhf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TANH !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
tnhf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ACOS !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
acsf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ASIN !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
asnf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ATAN !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
atnf Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ASNH !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
asnh Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ACSH !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
acsh Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ATNH !Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
atnh Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ITOF !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
itof Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
NTOF !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
ntof Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
LZRO !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
lzro Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TZRO !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
tzro Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
POPC !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
popc Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
COMN !Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
comn Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
COMI !Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
comi Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
NOTB !Int
i = (Stack -> Bool -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Bool -> IO ()
notb Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SIZT Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
sizt Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SIZS Int
i = (Stack -> Seq Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Seq Val -> IO ()
sizs Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
ITOT Int
i = (Stack -> Int -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Int -> IO ()
itot Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
NTOT Int
i = (Stack -> Word64 -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Word64 -> IO ()
ntot Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
FTOT Int
i = (Stack -> Double -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Double -> IO ()
ftot Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
USNC Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
usnc Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
UCNS Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
ucns Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TTOI Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
ttoi Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TTON Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
tton Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TTOF Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
ttof Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
VWLS Int
i = (Stack -> Seq Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Seq Val -> IO ()
vwls Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
VWRS Int
i = (Stack -> Seq Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Seq Val -> IO ()
vwrs Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
PAKT Int
i = (Stack -> Seq Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Seq Val -> IO ()
pakt Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
UPKT Int
i = (Stack -> Text -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Text -> IO ()
upkt Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
PAKB Int
i = (Stack -> Seq Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Seq Val -> IO ()
pakb Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
UPKB Int
i = (Stack -> Bytes -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Bytes -> IO ()
upkb Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
SIZB Int
i = (Stack -> Bytes -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Bytes -> IO ()
sizb Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
FLTB Int
i = (Stack -> Bytes -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Bytes -> IO ()
fltb Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
REFR Int
i = (Stack -> IORef Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> IORef Val -> IO ()
refr Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
REFN Int
i = (Stack -> Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Val -> IO ()
refn Stack
stk Int
i
prim1 !CCache
env !Stack
stk Prim1
RRFC Int
i = (Stack -> IORef Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap (CCache -> Stack -> IORef Val -> IO ()
rrfc CCache
env) Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TIKR Int
i = (Stack -> Ticket Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Ticket Val -> IO ()
tikr Stack
stk Int
i
prim1 !CCache
env !Stack
stk Prim1
MISS Int
i = (Stack -> Referent -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap (CCache -> Stack -> Referent -> IO ()
miss CCache
env) Stack
stk Int
i
prim1 !CCache
env !Stack
stk Prim1
SDBL Int
i = (Stack -> Referent -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap (CCache -> Stack -> Referent -> IO ()
sdbl CCache
env) Stack
stk Int
i
prim1 !CCache
env !Stack
stk Prim1
LKUP Int
i = (Stack -> Referent -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap (CCache -> Stack -> Referent -> IO ()
lkup CCache
env) Stack
stk Int
i
prim1 !CCache
env !Stack
stk Prim1
CVLD Int
i = (Stack -> [(Referent, Code)] -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap (CCache -> Stack -> [(Referent, Code)] -> IO ()
cvld CCache
env) Stack
stk Int
i
prim1 !CCache
_env !Stack
stk Prim1
TLTT Int
i = (Stack -> Referent -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap Stack -> Referent -> IO ()
tltt Stack
stk Int
i
prim1 !CCache
env !Stack
stk Prim1
DBTX Int
i = (Stack -> Val -> IO ()) -> Stack -> Int -> IO Stack
forall x.
ForeignConvention x =>
(Stack -> x -> IO ()) -> Stack -> Int -> IO Stack
prim1wrap (CCache -> Stack -> Val -> IO ()
dbtx CCache
env) Stack
stk Int
i
-- handled elsewhere
prim1 !CCache
_env !Stack
stk Prim1
CACH Int
_ = Stack -> IO Stack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack
stk
prim1 !CCache
_env !Stack
stk Prim1
LOAD Int
_ = Stack -> IO Stack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack
stk
prim1 !CCache
_env !Stack
stk Prim1
VALU Int
_ = Stack -> IO Stack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack
stk
{-# INLINE prim1 #-}

-- Wrap an implementation to act on an index on two indices
prim2wrap2 ::
  (ForeignConvention x) =>
  (ForeignConvention y) =>
  (Stack -> x -> y -> IO ()) ->
  Stack ->
  Int ->
  Int ->
  IO Stack
prim2wrap2 :: forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> x -> y -> IO ()
f Stack
stk Int
i Int
j = do
  x
x <- Stack -> Int -> IO x
forall a. ForeignConvention a => Stack -> Int -> IO a
readAtIndex Stack
stk Int
i
  y
y <- Stack -> Int -> IO y
forall a. ForeignConvention a => Stack -> Int -> IO a
readAtIndex Stack
stk Int
j
  Stack
stk <- Stack -> IO Stack
bump Stack
stk
  Stack
stk Stack -> IO () -> IO Stack
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Stack -> x -> y -> IO ()
f Stack
stk x
x y
y
{-# INLINE prim2wrap2 #-}

-- Primops applied to two stack indices
primxx :: CCache -> Stack -> Prim2 -> Int -> Int -> IO Stack
primxx :: CCache -> Stack -> Prim2 -> Int -> Int -> IO Stack
primxx CCache
_env Stack
stk Prim2
ADDI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
addi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SUBI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
subi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MULI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
muli Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DIVI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
divi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MODI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
modi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
EQLI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
eqli Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
NEQI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
neqi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LEQI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
leqi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LESI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
lesi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
ANDI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
andi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IORI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
iori Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
XORI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
xori Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SHLI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
shli Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SHRI Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
shri Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
POWI Int
i Int
j = (Stack -> Int -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Word64 -> IO ()
powi Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
ADDN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
addn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SUBN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
subn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MULN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
muln Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DIVN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
divn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MODN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
modn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SHLN Int
i Int
j = (Stack -> Word64 -> Int -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Int -> IO ()
shln Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SHRN Int
i Int
j = (Stack -> Word64 -> Int -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Int -> IO ()
shrn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
POWN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
pown Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
EQLN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
eqln Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
NEQN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
neqn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LEQN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
leqn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LESN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
lesn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
ANDN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
andn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IORN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
iorn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
XORN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
xorn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DRPN Int
i Int
j = (Stack -> Word64 -> Word64 -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Word64 -> Word64 -> IO ()
drpn Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
EQLF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
eqlf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
NEQF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
neqf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LEQF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
leqf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LESF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
lesf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
ADDF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
addf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SUBF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
subf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MULF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
mulf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DIVF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
divf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
ATN2 Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
atn2 Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
POWF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
powf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LOGB Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
logb Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MAXF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
maxf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
MINF Int
i Int
j = (Stack -> Double -> Double -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Double -> Double -> IO ()
minf Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DRPT Int
i Int
j = (Stack -> Int -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Text -> IO ()
drpt Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
TAKT Int
i Int
j = (Stack -> Int -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Text -> IO ()
takt Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
CATT Int
i Int
j = (Stack -> Text -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Text -> Text -> IO ()
catt Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IXOT Int
i Int
j = (Stack -> Text -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Text -> Text -> IO ()
ixot Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
EQLT Int
i Int
j = (Stack -> Text -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Text -> Text -> IO ()
eqlt Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LEQT Int
i Int
j = (Stack -> Text -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Text -> Text -> IO ()
leqt Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LEST Int
i Int
j = (Stack -> Text -> Text -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Text -> Text -> IO ()
lest Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
EQLU Int
i Int
j = (Stack -> Val -> Val -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Val -> Val -> IO ()
eqlu Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
CMPU Int
i Int
j = (Stack -> Val -> Val -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Val -> Val -> IO ()
cmpu Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LEQU Int
i Int
j = (Stack -> Val -> Val -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Val -> Val -> IO ()
lequ Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
LESU Int
i Int
j = (Stack -> Val -> Val -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Val -> Val -> IO ()
lesu Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DRPS Int
i Int
j = (Stack -> Int -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Seq Val -> IO ()
drps Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
TAKS Int
i Int
j = (Stack -> Int -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Seq Val -> IO ()
taks Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
CONS Int
i Int
j = (Stack -> Val -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Val -> Seq Val -> IO ()
cons Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SNOC Int
i Int
j = (Stack -> Seq Val -> Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Seq Val -> Val -> IO ()
snoc Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IDXS Int
i Int
j = (Stack -> Int -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Seq Val -> IO ()
idxs Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SPLL Int
i Int
j = (Stack -> Int -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Seq Val -> IO ()
spll Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
SPLR Int
i Int
j = (Stack -> Int -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Seq Val -> IO ()
splr Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
CATS Int
i Int
j = (Stack -> Seq Val -> Seq Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Seq Val -> Seq Val -> IO ()
cats Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
TAKB Int
i Int
j = (Stack -> Int -> Bytes -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Bytes -> IO ()
takb Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
DRPB Int
i Int
j = (Stack -> Int -> Bytes -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Bytes -> IO ()
drpb Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IDXB Int
i Int
j = (Stack -> Int -> Bytes -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Bytes -> IO ()
idxb Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
CATB Int
i Int
j = (Stack -> Bytes -> Bytes -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Bytes -> Bytes -> IO ()
catb Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IXOB Int
i Int
j = (Stack -> Bytes -> Bytes -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Bytes -> Bytes -> IO ()
ixob Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
REFW Int
i Int
j = (Stack -> IORef Val -> Val -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> IORef Val -> Val -> IO ()
refw Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
CAST Int
i Int
j = (Stack -> Int -> Int -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Int -> Int -> IO ()
cast Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
ANDB Int
i Int
j = (Stack -> Bool -> Bool -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Bool -> Bool -> IO ()
andb Stack
stk Int
i Int
j
primxx CCache
_env Stack
stk Prim2
IORB Int
i Int
j = (Stack -> Bool -> Bool -> IO ()) -> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 Stack -> Bool -> Bool -> IO ()
iorb Stack
stk Int
i Int
j
primxx CCache
env Stack
stk Prim2
SDBV Int
i Int
j = (Stack -> [Referent] -> Value -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 (CCache -> Stack -> [Referent] -> Value -> IO ()
sdbv CCache
env) Stack
stk Int
i Int
j
primxx CCache
env Stack
stk Prim2
SDBX Int
i Int
j = (Stack -> [Referent] -> Closure -> IO ())
-> Stack -> Int -> Int -> IO Stack
forall x y.
(ForeignConvention x, ForeignConvention y) =>
(Stack -> x -> y -> IO ()) -> Stack -> Int -> Int -> IO Stack
prim2wrap2 (CCache -> Stack -> [Referent] -> Closure -> IO ()
sdbx CCache
env) Stack
stk Int
i Int
j
-- handled elsewhere
primxx CCache
_env Stack
stk Prim2
THRO Int
_ Int
_ = Stack -> IO Stack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack
stk
primxx CCache
_env Stack
stk Prim2
TRCE Int
_ Int
_ = Stack -> IO Stack
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Stack
stk
{-# INLINE primxx #-}

termLinkVal :: Referent -> Val
termLinkVal :: Referent -> Val
termLinkVal = Closure -> Val
BoxedVal (Closure -> Val) -> (Referent -> Closure) -> Referent -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Foreign -> Closure
Foreign (Foreign -> Closure)
-> (Referent -> Foreign) -> Referent -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermReference -> Referent -> Foreign
forall e. TermReference -> e -> Foreign
Wrap TermReference
Rf.termLinkRef

typeLinkVal :: Reference -> Val
typeLinkVal :: TermReference -> Val
typeLinkVal = Closure -> Val
BoxedVal (Closure -> Val)
-> (TermReference -> Closure) -> TermReference -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Foreign -> Closure
Foreign (Foreign -> Closure)
-> (TermReference -> Foreign) -> TermReference -> Closure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermReference -> TermReference -> Foreign
forall e. TermReference -> e -> Foreign
Wrap TermReference
Rf.typeLinkRef

-- Evaluation and writeback portion of primops.
--
-- These are defined so that they can be common, and just referenced
-- in the various permutations of their application to literals or
-- variables.
--
-- The bodies always accept a stack that has already been bumped to
-- the appropriate location for their return result.
deci :: Stack -> Int -> IO ()
deci :: Stack -> Int -> IO ()
deci Stack
stk Int
m = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

decn :: Stack -> Word64 -> IO ()
decn :: Stack -> Word64 -> IO ()
decn Stack
stk Word64
m = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)

inci :: Stack -> Int -> IO ()
inci :: Stack -> Int -> IO ()
inci Stack
stk Int
m = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

incn :: Stack -> Word64 -> IO ()
incn :: Stack -> Word64 -> IO ()
incn Stack
stk Word64
m = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)

trnc :: Stack -> Int -> IO ()
trnc :: Stack -> Int -> IO ()
trnc Stack
stk Int
v = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
v)

negi :: Stack -> Int -> IO ()
negi :: Stack -> Int -> IO ()
negi Stack
stk Int
m = Stack -> Int -> IO ()
pokeI Stack
stk (-Int
m)

sgni :: Stack -> Int -> IO ()
sgni :: Stack -> Int -> IO ()
sgni Stack
stk Int
m = Stack -> Int -> IO ()
pokeI Stack
stk (Int -> Int
forall a. Num a => a -> a
signum Int
m)

absf :: Stack -> Double -> IO ()
absf :: Stack -> Double -> IO ()
absf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Num a => a -> a
abs Double
d)

ceil :: Stack -> Double -> IO ()
ceil :: Stack -> Double -> IO ()
ceil Stack
stk Double
d = Stack -> Int -> IO ()
pokeI Stack
stk (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
d)

flor :: Stack -> Double -> IO ()
flor :: Stack -> Double -> IO ()
flor Stack
stk Double
d = Stack -> Int -> IO ()
pokeI Stack
stk (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
d)

trnf :: Stack -> Double -> IO ()
trnf :: Stack -> Double -> IO ()
trnf Stack
stk Double
d = Stack -> Int -> IO ()
pokeI Stack
stk (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
d)

rndf :: Stack -> Double -> IO ()
rndf :: Stack -> Double -> IO ()
rndf Stack
stk Double
d = Stack -> Int -> IO ()
pokeI Stack
stk (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d)

expf :: Stack -> Double -> IO ()
expf :: Stack -> Double -> IO ()
expf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
exp Double
d)

logf :: Stack -> Double -> IO ()
logf :: Stack -> Double -> IO ()
logf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
log Double
d)

sqtf :: Stack -> Double -> IO ()
sqtf :: Stack -> Double -> IO ()
sqtf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
sqrt Double
d)

cosf :: Stack -> Double -> IO ()
cosf :: Stack -> Double -> IO ()
cosf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
cos Double
d)

sinf :: Stack -> Double -> IO ()
sinf :: Stack -> Double -> IO ()
sinf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
sin Double
d)

tanf :: Stack -> Double -> IO ()
tanf :: Stack -> Double -> IO ()
tanf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
tan Double
d)

cshf :: Stack -> Double -> IO ()
cshf :: Stack -> Double -> IO ()
cshf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
cosh Double
d)

snhf :: Stack -> Double -> IO ()
snhf :: Stack -> Double -> IO ()
snhf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
sinh Double
d)

tnhf :: Stack -> Double -> IO ()
tnhf :: Stack -> Double -> IO ()
tnhf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
tanh Double
d)

acsf :: Stack -> Double -> IO ()
acsf :: Stack -> Double -> IO ()
acsf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
acos Double
d)

asnf :: Stack -> Double -> IO ()
asnf :: Stack -> Double -> IO ()
asnf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
asin Double
d)

atnf :: Stack -> Double -> IO ()
atnf :: Stack -> Double -> IO ()
atnf Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
atan Double
d)

asnh :: Stack -> Double -> IO ()
asnh :: Stack -> Double -> IO ()
asnh Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
asinh Double
d)

acsh :: Stack -> Double -> IO ()
acsh :: Stack -> Double -> IO ()
acsh Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
acosh Double
d)

atnh :: Stack -> Double -> IO ()
atnh :: Stack -> Double -> IO ()
atnh Stack
stk Double
d = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double
forall a. Floating a => a -> a
atanh Double
d)

itof :: Stack -> Int -> IO ()
itof :: Stack -> Int -> IO ()
itof Stack
stk Int
n = Stack -> Double -> IO ()
pokeD Stack
stk (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)

ntof :: Stack -> Word64 -> IO ()
ntof :: Stack -> Word64 -> IO ()
ntof Stack
stk Word64
n = Stack -> Double -> IO ()
pokeD Stack
stk (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)

lzro :: Stack -> Word64 -> IO ()
lzro :: Stack -> Word64 -> IO ()
lzro Stack
stk Word64
n = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Word64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros Word64
n)

tzro :: Stack -> Word64 -> IO ()
tzro :: Stack -> Word64 -> IO ()
tzro Stack
stk Word64
n = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Word64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word64
n)

popc :: Stack -> Word64 -> IO ()
popc :: Stack -> Word64 -> IO ()
popc Stack
stk Word64
n = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Word64 -> Int
forall a. Bits a => a -> Int
popCount Word64
n)

comn :: Stack -> Word64 -> IO ()
comn :: Stack -> Word64 -> IO ()
comn Stack
stk Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
n)

comi :: Stack -> Int -> IO ()
comi :: Stack -> Int -> IO ()
comi Stack
stk Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int -> Int
forall a. Bits a => a -> a
complement Int
n)

notb :: Stack -> Bool -> IO ()
notb :: Stack -> Bool -> IO ()
notb Stack
stk Bool
b = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> Bool
not Bool
b)

sizt :: Stack -> Text -> IO ()
sizt :: Stack -> Text -> IO ()
sizt Stack
stk Text
t = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
UText.size Text
t

sizs :: Stack -> USeq -> IO ()
sizs :: Stack -> Seq Val -> IO ()
sizs Stack
stk Seq Val
s = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Seq Val -> Int
forall a. Seq a -> Int
Sq.length Seq Val
s

itot :: Stack -> Int -> IO ()
itot :: Stack -> Int -> IO ()
itot Stack
stk Int
n = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Text -> IO ()) -> ([Char] -> Text) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
UText.pack ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n

ntot :: Stack -> Word64 -> IO ()
ntot :: Stack -> Word64 -> IO ()
ntot Stack
stk Word64
n = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Text -> IO ()) -> ([Char] -> Text) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
UText.pack ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> [Char]
forall a. Show a => a -> [Char]
show Word64
n

ftot :: Stack -> Double -> IO ()
ftot :: Stack -> Double -> IO ()
ftot Stack
stk Double
f = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Text -> IO ()) -> ([Char] -> Text) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
UText.pack ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
f

usnc :: Stack -> Text -> IO ()
usnc :: Stack -> Text -> IO ()
usnc Stack
stk Text
t = Stack -> Maybe (Text, Char) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Text -> Maybe (Text, Char)
UText.unsnoc Text
t)
{-# INLINE usnc #-}

ucns :: Stack -> Text -> IO ()
ucns :: Stack -> Text -> IO ()
ucns Stack
stk Text
t = Stack -> Maybe (Char, Text) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Text -> Maybe (Char, Text)
UText.uncons Text
t)
{-# INLINE ucns #-}

readIntegral :: (Bounded n, Integral n) => String -> Maybe n
readIntegral :: forall n. (Bounded n, Integral n) => [Char] -> Maybe n
readIntegral [Char]
s = Integer -> Maybe n
forall n. (Bounded n, Integral n) => Integer -> Maybe n
clamp (Integer -> Maybe n) -> Maybe Integer -> Maybe n
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
s
{-# INLINE readIntegral #-}

clamp :: forall n. (Bounded n, Integral n) => Integer -> Maybe n
clamp :: forall n. (Bounded n, Integral n) => Integer -> Maybe n
clamp Integer
i
  | Integer
minb Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxb = n -> Maybe n
forall a. a -> Maybe a
Just (n -> Maybe n) -> n -> Maybe n
forall a b. (a -> b) -> a -> b
$ Integer -> n
forall a. Num a => Integer -> a
fromInteger Integer
i
  | Bool
otherwise = Maybe n
forall a. Maybe a
Nothing
  where
    minb :: Integer
minb = n -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (n
forall a. Bounded a => a
minBound :: n)
    maxb :: Integer
maxb = n -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (n
forall a. Bounded a => a
maxBound :: n)
{-# INLINE clamp #-}

ttoi :: Stack -> Text -> IO ()
ttoi :: Stack -> Text -> IO ()
ttoi Stack
stk Text
t = Stack -> Maybe Int -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk ([Char] -> Maybe Int
readi ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
UText.unpack Text
t)
  where
    readi :: String -> Maybe Int
    readi :: [Char] -> Maybe Int
readi (Char
'+' : [Char]
s) = [Char] -> Maybe Int
forall n. (Bounded n, Integral n) => [Char] -> Maybe n
readIntegral [Char]
s
    readi [Char]
s = [Char] -> Maybe Int
forall n. (Bounded n, Integral n) => [Char] -> Maybe n
readIntegral [Char]
s
{-# INLINE ttoi #-}

tton :: Stack -> Text -> IO ()
tton :: Stack -> Text -> IO ()
tton Stack
stk Text
t = Stack -> Maybe Word64 -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (forall n. (Bounded n, Integral n) => [Char] -> Maybe n
readIntegral @Word64 ([Char] -> Maybe Word64) -> [Char] -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
UText.unpack Text
t)
{-# INLINE tton #-}

ttof :: Stack -> Text -> IO ()
ttof :: Stack -> Text -> IO ()
ttof Stack
stk Text
t = Stack -> Maybe Double -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk ([Char] -> Maybe Double
readd ([Char] -> Maybe Double) -> [Char] -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
UText.unpack Text
t)
  where
    readd :: String -> Maybe Double
    readd :: [Char] -> Maybe Double
readd = [Char] -> Maybe Double
forall a. Read a => [Char] -> Maybe a
readMaybe

vwls :: Stack -> USeq -> IO ()
vwls :: Stack -> Seq Val -> IO ()
vwls Stack
stk Seq Val
s = Stack -> SeqView Val (Seq Val) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk SeqView Val (Seq Val)
result
  where
    result :: SeqView Val (Seq Val)
result = case Seq Val
s of
      Seq Val
Sq.Empty -> SeqView Val (Seq Val)
forall a b. SeqView a b
SeqViewEmpty
      Val
x Sq.:<| Seq Val
xs -> Val -> Seq Val -> SeqView Val (Seq Val)
forall a b. a -> b -> SeqView a b
SeqViewElem Val
x Seq Val
xs
{-# INLINE vwls #-}

vwrs :: Stack -> USeq -> IO ()
vwrs :: Stack -> Seq Val -> IO ()
vwrs Stack
stk Seq Val
s = Stack -> SeqView (Seq Val) Val -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk SeqView (Seq Val) Val
result
  where
    result :: SeqView (Seq Val) Val
result = case Seq Val
s of
      Seq Val
Sq.Empty -> SeqView (Seq Val) Val
forall a b. SeqView a b
SeqViewEmpty
      Seq Val
xs Sq.:|> Val
x -> Seq Val -> Val -> SeqView (Seq Val) Val
forall a b. a -> b -> SeqView a b
SeqViewElem Seq Val
xs Val
x
{-# INLINE vwrs #-}

pakt :: Stack -> USeq -> IO ()
pakt :: Stack -> Seq Val -> IO ()
pakt Stack
stk Seq Val
s = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Text -> IO ()) -> (Seq Char -> Text) -> Seq Char -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
UText.pack ([Char] -> Text) -> (Seq Char -> [Char]) -> Seq Char -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Char -> [Char]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Char -> IO ()) -> Seq Char -> IO ()
forall a b. (a -> b) -> a -> b
$ Val -> Char
val2char (Val -> Char) -> Seq Val -> Seq Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Val
s
  where
    val2char :: Val -> Char
    val2char :: Val -> Char
val2char (CharVal Char
c) = Char
c
    val2char Val
c = [Char] -> Char
forall a. HasCallStack => [Char] -> a
error ([Char] -> Char) -> [Char] -> Char
forall a b. (a -> b) -> a -> b
$ [Char]
"pack text: non-character closure: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Val -> [Char]
forall a. Show a => a -> [Char]
show Val
c

upkt :: Stack -> Text -> IO ()
upkt :: Stack -> Text -> IO ()
upkt Stack
stk Text
t =
  Stack -> Seq Val -> IO ()
pokeS Stack
stk
    (Seq Val -> IO ()) -> (Text -> Seq Val) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Seq Val
forall a. [a] -> Seq a
Sq.fromList
    ([Val] -> Seq Val) -> (Text -> [Val]) -> Text -> Seq Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Val) -> [Char] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Val
CharVal
    ([Char] -> [Val]) -> (Text -> [Char]) -> Text -> [Val]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
UText.unpack
    (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
t

pakb :: Stack -> USeq -> IO ()
pakb :: Stack -> Seq Val -> IO ()
pakb Stack
stk Seq Val
s = Stack -> Bytes -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Bytes -> IO ()) -> ([Val] -> Bytes) -> [Val] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Bytes
By.fromWord8s ([Word8] -> Bytes) -> ([Val] -> [Word8]) -> [Val] -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Val -> Word8) -> [Val] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Val -> Word8
val2w8 ([Val] -> IO ()) -> [Val] -> IO ()
forall a b. (a -> b) -> a -> b
$ Seq Val -> [Val]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Val
s
  where
    -- TODO: Should we have a tag for bytes specifically?
    val2w8 :: Val -> Word8
    val2w8 :: Val -> Word8
val2w8 (NatVal Word64
n) = Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Word64 -> Int) -> Word64 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a. Enum a => a -> Int
fromEnum (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64
n
    val2w8 Val
c = [Char] -> Word8
forall a. HasCallStack => [Char] -> a
error ([Char] -> Word8) -> [Char] -> Word8
forall a b. (a -> b) -> a -> b
$ [Char]
"pack bytes: non-natural closure: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Val -> [Char]
forall a. Show a => a -> [Char]
show Val
c

upkb :: Stack -> Bytes -> IO ()
upkb :: Stack -> Bytes -> IO ()
upkb Stack
stk Bytes
b =
  Stack -> Seq Val -> IO ()
pokeS Stack
stk (Seq Val -> IO ()) -> ([Word8] -> Seq Val) -> [Word8] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Val] -> Seq Val
forall a. [a] -> Seq a
Sq.fromList ([Val] -> Seq Val) -> ([Word8] -> [Val]) -> [Word8] -> Seq Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Val) -> [Word8] -> [Val]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Val
NatVal (Word64 -> Val) -> (Word8 -> Word64) -> Word8 -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @Word64 (Int -> Word64) -> (Word8 -> Int) -> Word8 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum @Word8) ([Word8] -> IO ()) -> [Word8] -> IO ()
forall a b. (a -> b) -> a -> b
$
    Bytes -> [Word8]
By.toWord8s Bytes
b

sizb :: Stack -> Bytes -> IO ()
sizb :: Stack -> Bytes -> IO ()
sizb Stack
stk Bytes
b = (() :: Constraint) => Stack -> Int -> IO ()
Stack -> Int -> IO ()
unsafePokeIasN Stack
stk (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Bytes -> Int
By.size Bytes
b

fltb :: Stack -> Bytes -> IO ()
fltb :: Stack -> Bytes -> IO ()
fltb Stack
stk Bytes
b = Stack -> Bytes -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Bytes -> IO ()) -> Bytes -> IO ()
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes
By.flatten Bytes
b

-- 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
refr :: Stack -> IORef Val -> IO ()
refr :: Stack -> IORef Val -> IO ()
refr Stack
stk IORef Val
ref = IORef Val -> IO Val
forall a. IORef a -> IO a
IORef.readIORef IORef Val
ref IO Val -> (Val -> 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
>>= (() :: Constraint) => Stack -> Val -> IO ()
Stack -> Val -> IO ()
poke Stack
stk

refn :: Stack -> Val -> IO ()
refn :: Stack -> Val -> IO ()
refn Stack
stk Val
v = do
  -- Note that the CAS machinery is extremely fussy w/r to whether things are forced because it
  -- uses unsafe pointer equality. The only way we've gotten it to work as expected is with liberal
  -- forcing of the values and tickets.
  !Val
v <- Val -> IO Val
forall a. a -> IO a
evaluate Val
v
  IORef Val
ref <- Val -> IO (IORef Val)
forall a. a -> IO (IORef a)
IORef.newIORef Val
v
  Stack -> IORef Val -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk IORef Val
ref

rrfc :: CCache -> Stack -> IORef Val -> IO ()
rrfc :: CCache -> Stack -> IORef Val -> IO ()
rrfc CCache
env Stack
stk IORef Val
ref
  | CCache -> Bool
sandboxed CCache
env = [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"attempted to use sandboxed operation: Ref.readForCAS"
  | Bool
otherwise = do
      Ticket Val
ticket <- IORef Val -> IO (Ticket Val)
forall a. IORef a -> IO (Ticket a)
Atomic.readForCAS IORef Val
ref
      Stack -> Ticket Val -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk Ticket Val
ticket

tikr :: Stack -> Atomic.Ticket Val -> IO ()
tikr :: Stack -> Ticket Val -> IO ()
tikr Stack
stk Ticket Val
t = (() :: Constraint) => Stack -> Val -> IO ()
Stack -> Val -> IO ()
poke Stack
stk (Ticket Val -> Val
forall a. Ticket a -> a
Atomic.peekTicket Ticket Val
t)

miss :: CCache -> Stack -> Referent -> IO ()
miss :: CCache -> Stack -> Referent -> IO ()
miss CCache
env Stack
stk Referent
tl
  | CCache -> Bool
sandboxed CCache
env = [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"attempted to use sandboxed operation: isMissing"
  | Bool
otherwise = case Referent
tl of
      Ref TermReference
link -> do
        Map TermReference (SuperGroup Symbol)
m <- TVar (Map TermReference (SuperGroup Symbol))
-> IO (Map TermReference (SuperGroup Symbol))
forall a. TVar a -> IO a
readTVarIO (CCache -> TVar (Map TermReference (SuperGroup Symbol))
intermed CCache
env)
        (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (TermReference
link TermReference -> Map TermReference (SuperGroup Symbol) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map TermReference (SuperGroup Symbol)
m)
      Referent
_ -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"exec:prim1:MISS: expected Ref"
{-# INLINE miss #-}

sdbl :: CCache -> Stack -> Referent -> IO ()
sdbl :: CCache -> Stack -> Referent -> IO ()
sdbl CCache
env Stack
stk Referent
tl = Stack -> [TermReference] -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk ([TermReference] -> IO ()) -> IO [TermReference] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CCache -> Referent -> IO [TermReference]
sandboxList CCache
env Referent
tl
{-# INLINE sdbl #-}

sandboxList :: CCache -> Referent -> IO [Reference]
sandboxList :: CCache -> Referent -> IO [TermReference]
sandboxList CCache
cc (Ref TermReference
r) = do
  Map TermReference (Set TermReference)
sands <- TVar (Map TermReference (Set TermReference))
-> IO (Map TermReference (Set TermReference))
forall a. TVar a -> IO a
readTVarIO (TVar (Map TermReference (Set TermReference))
 -> IO (Map TermReference (Set TermReference)))
-> TVar (Map TermReference (Set TermReference))
-> IO (Map TermReference (Set TermReference))
forall a b. (a -> b) -> a -> b
$ CCache -> TVar (Map TermReference (Set TermReference))
sandbox CCache
cc
  [TermReference] -> IO [TermReference]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TermReference] -> IO [TermReference])
-> (Maybe (Set TermReference) -> [TermReference])
-> Maybe (Set TermReference)
-> IO [TermReference]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TermReference]
-> (Set TermReference -> [TermReference])
-> Maybe (Set TermReference)
-> [TermReference]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set TermReference -> [TermReference]
forall a. Set a -> [a]
S.toList (Maybe (Set TermReference) -> IO [TermReference])
-> Maybe (Set TermReference) -> IO [TermReference]
forall a b. (a -> b) -> a -> b
$ TermReference
-> Map TermReference (Set TermReference)
-> Maybe (Set TermReference)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TermReference
r Map TermReference (Set TermReference)
sands
sandboxList CCache
_ Referent
_ = [TermReference] -> IO [TermReference]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

lkup :: CCache -> Stack -> Referent -> IO ()
lkup :: CCache -> Stack -> Referent -> IO ()
lkup CCache
env Stack
stk Referent
tl
  | CCache -> Bool
sandboxed CCache
env = [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"attempted to use sandboxed operation: lookup"
  | Bool
otherwise = Stack -> Maybe Code -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Maybe Code -> IO ()) -> IO (Maybe Code) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CCache -> Referent -> IO (Maybe Code)
lookupCode CCache
env Referent
tl
{-# INLINE lkup #-}

cvld :: CCache -> Stack -> [(Referent, Code)] -> IO ()
cvld :: CCache -> Stack -> [(Referent, Code)] -> IO ()
cvld CCache
env Stack
stk [(Referent, Code)]
news
  | CCache -> Bool
sandboxed CCache
env = [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"attempted to use sandboxed operation: validate"
  | Bool
otherwise =
      ((Referent, Code) -> IO (TermReference, SuperGroup Symbol))
-> [(Referent, Code)] -> IO [(TermReference, SuperGroup Symbol)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Referent, Code) -> IO (TermReference, SuperGroup Symbol)
extract [(Referent, Code)]
news IO [(TermReference, SuperGroup Symbol)]
-> ([(TermReference, SuperGroup Symbol)]
    -> IO (Maybe (Failure Text)))
-> IO (Maybe (Failure Text))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CCache
-> [(TermReference, SuperGroup Symbol)]
-> IO (Maybe (Failure Text))
codeValidate CCache
env IO (Maybe (Failure Text))
-> (Maybe (Failure Text) -> 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
>>= Stack -> Maybe (Failure Text) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk
  where
    extract :: (Referent, Code) -> IO (TermReference, SuperGroup Symbol)
extract (Ref TermReference
r, Code
code) = (TermReference, SuperGroup Symbol)
-> IO (TermReference, SuperGroup Symbol)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TermReference
r, Code -> SuperGroup Symbol
codeGroup Code
code)
    extract (Referent, Code)
_ = [Char] -> IO (TermReference, SuperGroup Symbol)
forall a. HasCallStack => [Char] -> IO a
die [Char]
"Prim1:CVLD: Con reference"
{-# INLINE cvld #-}

tltt :: Stack -> Referent -> IO ()
tltt :: Stack -> Referent -> IO ()
tltt Stack
stk Referent
r =
  Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Text -> IO ()) -> (ShortHash -> Text) -> ShortHash -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
UText.fromText (Text -> Text) -> (ShortHash -> Text) -> ShortHash -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortHash -> Text
SH.toText (ShortHash -> IO ()) -> ShortHash -> IO ()
forall a b. (a -> b) -> a -> b
$ Referent -> ShortHash
toShortHash Referent
r
{-# INLINE tltt #-}

dbtx :: CCache -> Stack -> Val -> IO ()
dbtx :: CCache -> Stack -> Val -> IO ()
dbtx CCache
env Stack
stk Val
val
  | CCache -> Bool
sandboxed CCache
env =
      [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"attempted to use sandboxed operation: Debug.toText"
  | Bool
otherwise = Stack -> Maybe (Either Text Text) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk Maybe (Either Text Text)
traced
  where
    traced :: Maybe (Either Text Text)
traced = case CCache -> Bool -> Val -> Tracer
tracer CCache
env Bool
False Val
val of
      Tracer
NoTrace -> Maybe (Either Text Text)
forall a. Maybe a
Nothing
      MsgTrace [Char]
_ [Char]
_ [Char]
tx -> Either Text Text -> Maybe (Either Text Text)
forall a. a -> Maybe a
Just (Either Text Text -> Maybe (Either Text Text))
-> (Text -> Either Text Text) -> Text -> Maybe (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Maybe (Either Text Text))
-> Text -> Maybe (Either Text Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
UText.pack [Char]
tx
      SimpleTrace [Char]
tx -> Either Text Text -> Maybe (Either Text Text)
forall a. a -> Maybe a
Just (Either Text Text -> Maybe (Either Text Text))
-> (Text -> Either Text Text) -> Text -> Maybe (Either Text Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Maybe (Either Text Text))
-> Text -> Maybe (Either Text Text)
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
UText.pack [Char]
tx
{-# INLINE dbtx #-}

addi :: Stack -> Int -> Int -> IO ()
addi :: Stack -> Int -> Int -> IO ()
addi Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
{-# INLINE addi #-}

subi :: Stack -> Int -> Int -> IO ()
subi :: Stack -> Int -> Int -> IO ()
subi Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
{-# INLINE subi #-}

muli :: Stack -> Int -> Int -> IO ()
muli :: Stack -> Int -> Int -> IO ()
muli Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n)
{-# INLINE muli #-}

divi :: Stack -> Int -> Int -> IO ()
divi :: Stack -> Int -> Int -> IO ()
divi Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n)
{-# INLINE divi #-}

modi :: Stack -> Int -> Int -> IO ()
modi :: Stack -> Int -> Int -> IO ()
modi Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n)
{-# INLINE modi #-}

eqli :: Stack -> Int -> Int -> IO ()
eqli :: Stack -> Int -> Int -> IO ()
eqli Stack
stk Int
m Int
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n)
{-# INLINE eqli #-}

neqi :: Stack -> Int -> Int -> IO ()
neqi :: Stack -> Int -> Int -> IO ()
neqi Stack
stk Int
m Int
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n)
{-# INLINE neqi #-}

leqi :: Stack -> Int -> Int -> IO ()
leqi :: Stack -> Int -> Int -> IO ()
leqi Stack
stk Int
m Int
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n)
{-# INLINE leqi #-}

lesi :: Stack -> Int -> Int -> IO ()
lesi :: Stack -> Int -> Int -> IO ()
lesi Stack
stk Int
m Int
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n)
{-# INLINE lesi #-}

andi :: Stack -> Int -> Int -> IO ()
andi :: Stack -> Int -> Int -> IO ()
andi Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
n)
{-# INLINE andi #-}

iori :: Stack -> Int -> Int -> IO ()
iori :: Stack -> Int -> Int -> IO ()
iori Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
n)
{-# INLINE iori #-}

xori :: Stack -> Int -> Int -> IO ()
xori :: Stack -> Int -> Int -> IO ()
xori Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
n)
{-# INLINE xori #-}

shli :: Stack -> Int -> Int -> IO ()
shli :: Stack -> Int -> Int -> IO ()
shli Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
n)
{-# INLINE shli #-}

shri :: Stack -> Int -> Int -> IO ()
shri :: Stack -> Int -> Int -> IO ()
shri Stack
stk Int
m Int
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
n)
{-# INLINE shri #-}

powi :: Stack -> Int -> Word64 -> IO ()
powi :: Stack -> Int -> Word64 -> IO ()
powi Stack
stk Int
m Word64
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int
m Int -> Word64 -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Word64
n)
{-# INLINE powi #-}

addn :: Stack -> Word64 -> Word64 -> IO ()
addn :: Stack -> Word64 -> Word64 -> IO ()
addn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
n)
{-# INLINE addn #-}

subn :: Stack -> Word64 -> Word64 -> IO ()
subn :: Stack -> Word64 -> Word64 -> IO ()
subn Stack
stk Word64
m Word64
n = Stack -> Int -> IO ()
pokeI Stack
stk (Int -> IO ()) -> (Word64 -> Int) -> Word64 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n
{-# INLINE subn #-}

muln :: Stack -> Word64 -> Word64 -> IO ()
muln :: Stack -> Word64 -> Word64 -> IO ()
muln Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n)
{-# INLINE muln #-}

divn :: Stack -> Word64 -> Word64 -> IO ()
divn :: Stack -> Word64 -> Word64 -> IO ()
divn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
n)
{-# INLINE divn #-}

modn :: Stack -> Word64 -> Word64 -> IO ()
modn :: Stack -> Word64 -> Word64 -> IO ()
modn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` Word64
n)
{-# INLINE modn #-}

shln :: Stack -> Word64 -> Int -> IO ()
shln :: Stack -> Word64 -> Int -> IO ()
shln Stack
stk Word64
m Int
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
n)
{-# INLINE shln #-}

shrn :: Stack -> Word64 -> Int -> IO ()
shrn :: Stack -> Word64 -> Int -> IO ()
shrn Stack
stk Word64
m Int
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
n)
{-# INLINE shrn #-}

pown :: Stack -> Word64 -> Word64 -> IO ()
pown :: Stack -> Word64 -> Word64 -> IO ()
pown Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Word64
n)
{-# INLINE pown #-}

eqln :: Stack -> Word64 -> Word64 -> IO ()
eqln :: Stack -> Word64 -> Word64 -> IO ()
eqln Stack
stk Word64
m Word64
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n)
{-# INLINE eqln #-}

neqn :: Stack -> Word64 -> Word64 -> IO ()
neqn :: Stack -> Word64 -> Word64 -> IO ()
neqn Stack
stk Word64
m Word64
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
n)
{-# INLINE neqn #-}

leqn :: Stack -> Word64 -> Word64 -> IO ()
leqn :: Stack -> Word64 -> Word64 -> IO ()
leqn Stack
stk Word64
m Word64
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Word64
m Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
n)
{-# INLINE leqn #-}

lesn :: Stack -> Word64 -> Word64 -> IO ()
lesn :: Stack -> Word64 -> Word64 -> IO ()
lesn Stack
stk Word64
m Word64
n = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Word64
m Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
n)
{-# INLINE lesn #-}

andn :: Stack -> Word64 -> Word64 -> IO ()
andn :: Stack -> Word64 -> Word64 -> IO ()
andn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
n)
{-# INLINE andn #-}

iorn :: Stack -> Word64 -> Word64 -> IO ()
iorn :: Stack -> Word64 -> Word64 -> IO ()
iorn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
n)
{-# INLINE iorn #-}

xorn :: Stack -> Word64 -> Word64 -> IO ()
xorn :: Stack -> Word64 -> Word64 -> IO ()
xorn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64
m Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
n)
{-# INLINE xorn #-}

drpn :: Stack -> Word64 -> Word64 -> IO ()
drpn :: Stack -> Word64 -> Word64 -> IO ()
drpn Stack
stk Word64
m Word64
n = Stack -> Word64 -> IO ()
pokeN Stack
stk (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ if Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
m then Word64
0 else Word64
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
n
{-# INLINE drpn #-}

eqlf :: Stack -> Double -> Double -> IO ()
eqlf :: Stack -> Double -> Double -> IO ()
eqlf Stack
stk Double
x Double
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y)
{-# INLINE eqlf #-}

neqf :: Stack -> Double -> Double -> IO ()
neqf :: Stack -> Double -> Double -> IO ()
neqf Stack
stk Double
x Double
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
y)
{-# INLINE neqf #-}

leqf :: Stack -> Double -> Double -> IO ()
leqf :: Stack -> Double -> Double -> IO ()
leqf Stack
stk Double
x Double
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
y)
{-# INLINE leqf #-}

lesf :: Stack -> Double -> Double -> IO ()
lesf :: Stack -> Double -> Double -> IO ()
lesf Stack
stk Double
x Double
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y)
{-# INLINE lesf #-}

addf :: Stack -> Double -> Double -> IO ()
addf :: Stack -> Double -> Double -> IO ()
addf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y)
{-# INLINE addf #-}

subf :: Stack -> Double -> Double -> IO ()
subf :: Stack -> Double -> Double -> IO ()
subf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y)
{-# INLINE subf #-}

mulf :: Stack -> Double -> Double -> IO ()
mulf :: Stack -> Double -> Double -> IO ()
mulf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
y)
{-# INLINE mulf #-}

divf :: Stack -> Double -> Double -> IO ()
divf :: Stack -> Double -> Double -> IO ()
divf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
y)
{-# INLINE divf #-}

atn2 :: Stack -> Double -> Double -> IO ()
atn2 :: Stack -> Double -> Double -> IO ()
atn2 Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
x Double
y)
{-# INLINE atn2 #-}

powf :: Stack -> Double -> Double -> IO ()
powf :: Stack -> Double -> Double -> IO ()
powf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double
x Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
y)
{-# INLINE powf #-}

logb :: Stack -> Double -> Double -> IO ()
logb :: Stack -> Double -> Double -> IO ()
logb Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
x Double
y)
{-# INLINE logb #-}

maxf :: Stack -> Double -> Double -> IO ()
maxf :: Stack -> Double -> Double -> IO ()
maxf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x Double
y)
{-# INLINE maxf #-}

minf :: Stack -> Double -> Double -> IO ()
minf :: Stack -> Double -> Double -> IO ()
minf Stack
stk Double
x Double
y = Stack -> Double -> IO ()
pokeD Stack
stk (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
x Double
y)
{-# INLINE minf #-}

drpt :: Stack -> Int -> Text -> IO ()
drpt :: Stack -> Int -> Text -> IO ()
drpt Stack
stk Int
n Text
t0 = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk Text
t
  where
    -- Note; if n < 0, the Nat argument was greater than the maximum
    -- signed integer. As an approximation, just return the empty
    -- string, as a string larger than this would require an absurd
    -- amount of memory.
    t :: Text
t
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
UText.empty
      | Bool
otherwise = Int -> Text -> Text
UText.drop Int
n Text
t0

takt :: Stack -> Int -> Text -> IO ()
takt :: Stack -> Int -> Text -> IO ()
takt Stack
stk Int
n Text
t0 = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk Text
t
  where
    -- Note: if n < 0, the Nat argument was greater than the maximum
    -- signed integer. As an approximation, we just return the
    -- original string, because it's unlikely such a large string
    -- exists.
    t :: Text
t
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Text
t0
      | Bool
otherwise = Int -> Text -> Text
UText.take Int
n Text
t0

catt :: Stack -> Text -> Text -> IO ()
catt :: Stack -> Text -> Text -> IO ()
catt Stack
stk Text
x Text
y = Stack -> Text -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y :: UText.Text)
{-# INLINE catt #-}

ixot :: Stack -> Text -> Text -> IO ()
ixot :: Stack -> Text -> Text -> IO ()
ixot Stack
stk Text
x Text
y = Stack -> Maybe Word64 -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Maybe Word64 -> IO ()) -> Maybe Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Word64
UText.indexOf Text
x Text
y
{-# INLINE ixot #-}

eqlt :: Stack -> Text -> Text -> IO ()
eqlt :: Stack -> Text -> Text -> IO ()
eqlt Stack
stk Text
x Text
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y
{-# INLINE eqlt #-}

leqt :: Stack -> Text -> Text -> IO ()
leqt :: Stack -> Text -> Text -> IO ()
leqt Stack
stk Text
x Text
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
<= Text
y
{-# INLINE leqt #-}

lest :: Stack -> Text -> Text -> IO ()
lest :: Stack -> Text -> Text -> IO ()
lest Stack
stk Text
x Text
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
x Text -> Text -> Bool
forall a. Ord a => a -> a -> Bool
< Text
y
{-# INLINE lest #-}

eqlu :: Stack -> Val -> Val -> IO ()
eqlu :: Stack -> Val -> Val -> IO ()
eqlu Stack
stk Val
x Val
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ (Foreign -> Foreign -> Bool) -> Val -> Val -> Bool
universalEq Foreign -> Foreign -> Bool
forall a. Eq a => a -> a -> Bool
(==) Val
x Val
y
{-# INLINE eqlu #-}

cmpu :: Stack -> Val -> Val -> IO ()
cmpu :: Stack -> Val -> Val -> IO ()
cmpu Stack
stk Val
x Val
y = Stack -> Int -> IO ()
pokeI Stack
stk (Int -> IO ()) -> (Ordering -> Int) -> Ordering -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (Ordering -> Int) -> Ordering -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> Int
forall a. Enum a => a -> Int
fromEnum (Ordering -> IO ()) -> Ordering -> IO ()
forall a b. (a -> b) -> a -> b
$ (Foreign -> Foreign -> Ordering) -> Val -> Val -> Ordering
universalCompare Foreign -> Foreign -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Val
x Val
y
{-# INLINE cmpu #-}

lequ :: Stack -> Val -> Val -> IO ()
lequ :: Stack -> Val -> Val -> IO ()
lequ Stack
stk Val
x Val
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ (Foreign -> Foreign -> Ordering) -> Val -> Val -> Ordering
universalCompare Foreign -> Foreign -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Val
x Val
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
{-# INLINE lequ #-}

lesu :: Stack -> Val -> Val -> IO ()
lesu :: Stack -> Val -> Val -> IO ()
lesu Stack
stk Val
x Val
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ (Foreign -> Foreign -> Ordering) -> Val -> Val -> Ordering
universalCompare Foreign -> Foreign -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Val
x Val
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
{-# INLINE lesu #-}

-- Note: if n < 0, then the Nat argument was larger than the largest
-- signed integer. Seq actually doesn't handle this well, despite it
-- being possible to build (lazy) sequences this large. So,
-- approximate by yielding the empty sequence.
drps :: Stack -> Int -> USeq -> IO ()
drps :: Stack -> Int -> Seq Val -> IO ()
drps Stack
stk Int
n Seq Val
s = Stack -> Seq Val -> IO ()
pokeS Stack
stk (Seq Val -> IO ()) -> Seq Val -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Seq Val
forall a. Seq a
Sq.empty else Int -> Seq Val -> Seq Val
forall a. Int -> Seq a -> Seq a
Sq.drop Int
n Seq Val
s
{-# INLINE drps #-}

taks :: Stack -> Int -> USeq -> IO ()
taks :: Stack -> Int -> Seq Val -> IO ()
taks Stack
stk Int
n Seq Val
s = Stack -> Seq Val -> IO ()
pokeS Stack
stk (Seq Val -> IO ()) -> Seq Val -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Seq Val
s else Int -> Seq Val -> Seq Val
forall a. Int -> Seq a -> Seq a
Sq.take Int
n Seq Val
s
{-# INLINE taks #-}

cons :: Stack -> Val -> USeq -> IO ()
cons :: Stack -> Val -> Seq Val -> IO ()
cons Stack
stk Val
x Seq Val
s = Stack -> Seq Val -> IO ()
pokeS Stack
stk (Seq Val -> IO ()) -> Seq Val -> IO ()
forall a b. (a -> b) -> a -> b
$ Val
x Val -> Seq Val -> Seq Val
forall a. a -> Seq a -> Seq a
Sq.<| Seq Val
s
{-# INLINE cons #-}

snoc :: Stack -> USeq -> Val -> IO ()
snoc :: Stack -> Seq Val -> Val -> IO ()
snoc Stack
stk Seq Val
s Val
x = Stack -> Seq Val -> IO ()
pokeS Stack
stk (Seq Val -> IO ()) -> Seq Val -> IO ()
forall a b. (a -> b) -> a -> b
$ Seq Val
s Seq Val -> Val -> Seq Val
forall a. Seq a -> a -> Seq a
Sq.|> Val
x
{-# INLINE snoc #-}

idxs :: Stack -> Int -> USeq -> IO ()
idxs :: Stack -> Int -> Seq Val -> IO ()
idxs Stack
stk Int
n Seq Val
s = Stack -> Maybe Val -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Maybe Val -> IO ()) -> Maybe Val -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Seq Val -> Maybe Val
forall a. Int -> Seq a -> Maybe a
Sq.lookup Int
n Seq Val
s
{-# INLINE idxs #-}

data SeqView a b = SeqViewEmpty | SeqViewElem a b

decodeSeqView ::
  (ForeignConvention a) =>
  (ForeignConvention b) =>
  Closure ->
  IO (SeqView a b)
decodeSeqView :: forall a b.
(ForeignConvention a, ForeignConvention b) =>
Closure -> IO (SeqView a b)
decodeSeqView (Enum TermReference
_ PackedTag
t)
  | PackedTag
t PackedTag -> PackedTag -> Bool
forall a. Eq a => a -> a -> Bool
== PackedTag
Ty.seqViewEmptyTag = SeqView a b -> IO (SeqView a b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SeqView a b
forall a b. SeqView a b
SeqViewEmpty
decodeSeqView (Data2 TermReference
_ PackedTag
t Val
x Val
y)
  | PackedTag
t PackedTag -> PackedTag -> Bool
forall a. Eq a => a -> a -> Bool
== PackedTag
Ty.seqViewElemTag = a -> b -> SeqView a b
forall a b. a -> b -> SeqView a b
SeqViewElem (a -> b -> SeqView a b) -> IO a -> IO (b -> SeqView a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Val -> IO a
forall a. ForeignConvention a => Val -> IO a
decodeVal Val
x IO (b -> SeqView a b) -> IO b -> IO (SeqView a b)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Val -> IO b
forall a. ForeignConvention a => Val -> IO a
decodeVal Val
y
decodeSeqView Closure
v = [Char] -> Val -> IO (SeqView a b)
forall a. [Char] -> Val -> IO a
foreignConventionError [Char]
"Either" (Closure -> Val
BoxedVal Closure
v)

seqViewE :: Closure
seqViewE :: Closure
seqViewE = TermReference -> PackedTag -> Closure
Enum TermReference
Ty.seqViewRef PackedTag
Ty.seqViewEmptyTag

encodeSeqView ::
  (ForeignConvention a) =>
  (ForeignConvention b) =>
  SeqView a b ->
  Closure
encodeSeqView :: forall a b.
(ForeignConvention a, ForeignConvention b) =>
SeqView a b -> Closure
encodeSeqView SeqView a b
SeqViewEmpty = Closure
seqViewE
encodeSeqView (SeqViewElem a
x b
y) =
  TermReference -> PackedTag -> Val -> Val -> Closure
Data2 TermReference
Ty.seqViewRef PackedTag
Ty.seqViewElemTag (a -> Val
forall a. ForeignConvention a => a -> Val
encodeVal a
x) (b -> Val
forall a. ForeignConvention a => a -> Val
encodeVal b
y)
{-# INLINE encodeSeqView #-}

instance
  ( ForeignConvention a,
    ForeignConvention b
  ) =>
  ForeignConvention (SeqView a b)
  where
  readAtIndex :: Stack -> Int -> IO (SeqView a b)
readAtIndex Stack
stk Int
i = Closure -> IO (SeqView a b)
forall a b.
(ForeignConvention a, ForeignConvention b) =>
Closure -> IO (SeqView a b)
decodeSeqView (Closure -> IO (SeqView a b)) -> IO Closure -> IO (SeqView a b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (() :: Constraint) => Stack -> Int -> IO Closure
Stack -> Int -> IO Closure
bpeekOff Stack
stk Int
i

  decodeVal :: Val -> IO (SeqView a b)
decodeVal (BoxedVal Closure
c) = Closure -> IO (SeqView a b)
forall a b.
(ForeignConvention a, ForeignConvention b) =>
Closure -> IO (SeqView a b)
decodeSeqView Closure
c
  decodeVal Val
v = [Char] -> Val -> IO (SeqView a b)
forall a. [Char] -> Val -> IO a
foreignConventionError [Char]
"SeqView" Val
v

  readsAt :: Stack -> Args -> IO (SeqView a b)
readsAt Stack
stk (VArg1 Int
i) = Stack -> Int -> IO (SeqView a b)
forall a. ForeignConvention a => Stack -> Int -> IO a
readAtIndex Stack
stk Int
i
  readsAt Stack
_ Args
args = [Char] -> Args -> IO (SeqView a b)
forall a. [Char] -> Args -> IO a
readsAtError [Char]
"one argument" Args
args

  encodeVal :: SeqView a b -> Val
encodeVal = Closure -> Val
BoxedVal (Closure -> Val) -> (SeqView a b -> Closure) -> SeqView a b -> Val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeqView a b -> Closure
forall a b.
(ForeignConvention a, ForeignConvention b) =>
SeqView a b -> Closure
encodeSeqView

  writeBack :: Stack -> SeqView a b -> IO ()
writeBack Stack
stk SeqView a b
v = (() :: Constraint) => Stack -> Closure -> IO ()
Stack -> Closure -> IO ()
bpoke Stack
stk (Closure -> IO ()) -> Closure -> IO ()
forall a b. (a -> b) -> a -> b
$ SeqView a b -> Closure
forall a b.
(ForeignConvention a, ForeignConvention b) =>
SeqView a b -> Closure
encodeSeqView SeqView a b
v
  {-# INLINE writeBack #-}

spll :: Stack -> Int -> USeq -> IO ()
spll :: Stack -> Int -> Seq Val -> IO ()
spll Stack
stk Int
n Seq Val
s = Stack -> SeqView (Seq Val) (Seq Val) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk SeqView (Seq Val) (Seq Val)
result
  where
    result :: SeqView (Seq Val) (Seq Val)
result
      | Seq Val -> Int
forall a. Seq a -> Int
Sq.length Seq Val
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = SeqView (Seq Val) (Seq Val)
forall a b. SeqView a b
SeqViewEmpty
      | (Seq Val
l, Seq Val
r) <- Int -> Seq Val -> (Seq Val, Seq Val)
forall a. Int -> Seq a -> (Seq a, Seq a)
Sq.splitAt Int
n Seq Val
s = Seq Val -> Seq Val -> SeqView (Seq Val) (Seq Val)
forall a b. a -> b -> SeqView a b
SeqViewElem Seq Val
l Seq Val
r
{-# INLINE spll #-}

splr :: Stack -> Int -> USeq -> IO ()
splr :: Stack -> Int -> Seq Val -> IO ()
splr Stack
stk Int
n Seq Val
s = Stack -> SeqView (Seq Val) (Seq Val) -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk SeqView (Seq Val) (Seq Val)
result
  where
    result :: SeqView (Seq Val) (Seq Val)
result
      | Seq Val -> Int
forall a. Seq a -> Int
Sq.length Seq Val
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = SeqView (Seq Val) (Seq Val)
forall a b. SeqView a b
SeqViewEmpty
      | (Seq Val
l, Seq Val
r) <- Int -> Seq Val -> (Seq Val, Seq Val)
forall a. Int -> Seq a -> (Seq a, Seq a)
Sq.splitAt (Seq Val -> Int
forall a. Seq a -> Int
Sq.length Seq Val
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Seq Val
s = Seq Val -> Seq Val -> SeqView (Seq Val) (Seq Val)
forall a b. a -> b -> SeqView a b
SeqViewElem Seq Val
l Seq Val
r
{-# INLINE splr #-}

cats :: Stack -> USeq -> USeq -> IO ()
cats :: Stack -> Seq Val -> Seq Val -> IO ()
cats Stack
stk Seq Val
x Seq Val
y = Stack -> Seq Val -> IO ()
pokeS Stack
stk (Seq Val -> IO ()) -> Seq Val -> IO ()
forall a b. (a -> b) -> a -> b
$ Seq Val
x Seq Val -> Seq Val -> Seq Val
forall a. Seq a -> Seq a -> Seq a
Sq.>< Seq Val
y
{-# INLINE cats #-}

-- If n < 0, the Nat argument was larger than the maximum signed
-- integer. Building a value this large would reuire an absurd
-- amount of memory, so just assume n is larger.
takb :: Stack -> Int -> Bytes -> IO ()
takb :: Stack -> Int -> Bytes -> IO ()
takb Stack
stk Int
n Bytes
b = Stack -> Bytes -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Bytes -> IO ()) -> Bytes -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Bytes
b else Int -> Bytes -> Bytes
By.take Int
n Bytes
b
{-# INLINE takb #-}

-- See above for n < 0
drpb :: Stack -> Int -> Bytes -> IO ()
drpb :: Stack -> Int -> Bytes -> IO ()
drpb Stack
stk Int
n Bytes
b = Stack -> Bytes -> IO ()
forall b. BuiltinForeign b => Stack -> b -> IO ()
pokeBi Stack
stk (Bytes -> IO ()) -> Bytes -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Bytes
By.empty else Int -> Bytes -> Bytes
By.drop Int
n Bytes
b
{-# INLINE drpb #-}

idxb :: Stack -> Int -> Bytes -> IO ()
idxb :: Stack -> Int -> Bytes -> IO ()
idxb Stack
stk Int
n Bytes
b = Stack -> Maybe Word8 -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Maybe Word8 -> IO ()) -> Maybe Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Bytes -> Maybe Word8
By.at Int
n Bytes
b
{-# INLINE idxb #-}

catb :: Stack -> Bytes -> Bytes -> IO ()
catb :: Stack -> Bytes -> Bytes -> IO ()
catb Stack
stk Bytes
l Bytes
r = Stack -> Bytes -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Bytes -> IO ()) -> Bytes -> IO ()
forall a b. (a -> b) -> a -> b
$ Bytes
l Bytes -> Bytes -> Bytes
forall a. Semigroup a => a -> a -> a
<> Bytes
r
{-# INLINE catb #-}

ixob :: Stack -> Bytes -> Bytes -> IO ()
ixob :: Stack -> Bytes -> Bytes -> IO ()
ixob Stack
stk Bytes
l Bytes
r = Stack -> Maybe Word64 -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk (Maybe Word64 -> IO ()) -> Maybe Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes -> Maybe Word64
By.indexOf Bytes
l Bytes
r
{-# INLINE ixob #-}

refw :: Stack -> IORef Val -> Val -> IO ()
refw :: Stack -> IORef Val -> Val -> IO ()
refw Stack
stk IORef Val
ref Val
v = IORef Val -> Val -> IO ()
forall a. IORef a -> a -> IO ()
IORef.writeIORef IORef Val
ref Val
v IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (() :: Constraint) => Stack -> Closure -> IO ()
Stack -> Closure -> IO ()
bpoke Stack
stk Closure
unitClosure
{-# INLINE refw #-}

cast :: Stack -> Int -> Int -> IO ()
cast :: Stack -> Int -> Int -> IO ()
cast Stack
stk Int
n Int
tag = (() :: Constraint) => Stack -> Val -> IO ()
Stack -> Val -> IO ()
poke Stack
stk (Val -> IO ()) -> Val -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> UnboxedTypeTag -> Val
UnboxedVal Int
n (HasCallStack => Int -> UnboxedTypeTag
Int -> UnboxedTypeTag
unboxedTypeTagFromInt Int
tag)
{-# INLINE cast #-}

andb :: Stack -> Bool -> Bool -> IO ()
andb :: Stack -> Bool -> Bool -> IO ()
andb Stack
stk Bool
x Bool
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
&& Bool
y
{-# INLINE andb #-}

iorb :: Stack -> Bool -> Bool -> IO ()
iorb :: Stack -> Bool -> Bool -> IO ()
iorb Stack
stk Bool
x Bool
y = (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
|| Bool
y
{-# INLINE iorb #-}

sdbv :: CCache -> Stack -> [Referent] -> Value -> IO ()
sdbv :: CCache -> Stack -> [Referent] -> Value -> IO ()
sdbv CCache
env Stack
stk [Referent]
allowed0 Value
v
  | CCache -> Bool
sandboxed CCache
env =
      [Char] -> IO ()
forall a. HasCallStack => [Char] -> IO a
die [Char]
"attempted to use sandboxed operation: Value.validateSandboxed"
  | Bool
otherwise = CCache
-> [TermReference] -> Value -> IO (Either [Referent] [Referent])
checkValueSandboxing CCache
env [TermReference]
allowed Value
v IO (Either [Referent] [Referent])
-> (Either [Referent] [Referent] -> 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
>>= Stack -> Either [Referent] [Referent] -> IO ()
forall a. ForeignConvention a => Stack -> a -> IO ()
writeBack Stack
stk
  where
    allowed :: [TermReference]
allowed = [Referent]
allowed0 [Referent] -> (Referent -> [TermReference]) -> [TermReference]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case (Ref TermReference
r) -> [TermReference
r]; Referent
_ -> []
{-# INLINE sdbv #-}

sdbx :: CCache -> Stack -> [Referent] -> Closure -> IO ()
sdbx :: CCache -> Stack -> [Referent] -> Closure -> IO ()
sdbx CCache
env Stack
stk [Referent]
allowed0 Closure
c = CCache -> [TermReference] -> Closure -> IO Bool
checkSandboxing CCache
env [TermReference]
allowed Closure
c IO Bool -> (Bool -> 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
>>= (() :: Constraint) => Stack -> Bool -> IO ()
Stack -> Bool -> IO ()
pokeBool Stack
stk
  where
    allowed :: [TermReference]
allowed = [Referent]
allowed0 [Referent] -> (Referent -> [TermReference]) -> [TermReference]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case (Ref TermReference
r) -> [TermReference
r]; Referent
_ -> []
{-# INLINE sdbx #-}