{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}

-- | The startup checks' way into the C helpers (cbits/jit_rt.c). At
-- startup "Unison.Runtime.JIT.Layout" runs every helper family (lists,
-- texts, bytes, arrays and refs, the hash, the comparison, the handler
-- environment, records, partial applications) against the interpreter
-- before the JIT is allowed on, and these are the calls it makes.
--
-- The protocol is the same for each family. Haskell builds sample values
-- and puts them in a boxed array ('MutableArray' of 'Any', so the C side
-- gets real heap pointers), then:
--
-- * an @init@ call teaches the family its layouts from the samples (info
--   pointers and tags, passed as a list of ints alongside the array) and
--   returns 1 or the number of the check that failed;
-- * a @check@ call asks whether a sample has the structure the helpers
--   assume;
-- * a @test@ call runs one helper on the samples (the operation and its
--   arguments as ints) and leaves the result in the array, where Haskell
--   compares it with what the interpreter computes.
--
-- 'probeClosure' is the first of all: it reads a closure's raw layout, from
-- which 'Layout.probeLayouts' learns where each constructor keeps its fields.
module Unison.Runtime.JIT.Native.Probes
  ( probeClosure,
    closureInit,
    nameTest,
    listInit,
    listCheck,
    listTest,
    textInit,
    textCheck,
    textTest,
    bytesInit,
    bytesCheck,
    bytesTest,
    arrayInit,
    murmurInit,
    murmurTest,
    cmpInit,
    cmpTest,
    envInit,
    recordInit,
  )
where

import Control.Monad (when)
import Control.Monad.Primitive (PrimState)
import Data.Int (Int64)
import Data.Primitive.Array (MutableArray (..), sizeofMutableArray)
import Data.Word (Word64)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek, peekElemOff, pokeElemOff)
import GHC.Exts (Any, MutableArray#)

-- | Passes a list of ints to C as an array.
withInts :: [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts :: forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
xs Ptr Int64 -> IO a
k = Int -> (Ptr Int64 -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)) ((Ptr Int64 -> IO a) -> IO a) -> (Ptr Int64 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p -> do
  ((Int, Int) -> IO ()) -> [(Int, Int)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
i, Int
v) -> Ptr Int64 -> Int -> Int64 -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr Int64
p Int
i (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)) ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Int]
xs)
  Ptr Int64 -> IO a
k Ptr Int64
p

foreign import ccall unsafe "unison_jit_probe" c_probe :: MutableArray# (PrimState IO) Any -> Int64 -> Ptr Int64 -> Int64 -> IO Int64

-- | Inspects a closure. Element 0 of the array is the sample, the rest are
-- the objects in its pointer fields. Returns the raw probe output: info
-- pointer, pointer tag, closure type, pointer count, non-pointer count,
-- constructor tag, the payload words, then a match index per pointer field.
probeClosure :: MutableArray (PrimState IO) Any -> IO [Int]
probeClosure :: MutableArray (PrimState IO) Any -> IO [Int]
probeClosure arr :: MutableArray (PrimState IO) Any
arr@(MutableArray MutableArray# (PrimState IO) Any
arr#) = Int -> (Ptr Int64 -> IO [Int]) -> IO [Int]
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
probeWords) ((Ptr Int64 -> IO [Int]) -> IO [Int])
-> (Ptr Int64 -> IO [Int]) -> IO [Int]
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
out -> do
  Int64
total <- MutableArray# (PrimState IO) Any
-> Int64 -> Ptr Int64 -> Int64 -> IO Int64
c_probe MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MutableArray RealWorld Any -> Int
forall s a. MutableArray s a -> Int
sizeofMutableArray MutableArray RealWorld Any
MutableArray (PrimState IO) Any
arr)) Ptr Int64
out (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
probeWords)
  -- C writes nothing past the capacity it was given, and nothing at all
  -- when the answer would not fit; the samples are the runtime's own
  -- closures, none anywhere near this size
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
probeWords) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char]
"probeClosure: a sample closure with " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
total [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" payload words does not fit the probe buffer")
  [Int64]
vals <- (Int -> IO Int64) -> [Int] -> IO [Int64]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Ptr Int64 -> Int -> IO Int64
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr Int64
out) [Int
0 .. Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
total]
  pure ((Int64 -> Int) -> [Int64] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Int64]
vals)
  where
    probeWords :: Int
probeWords = Int
64 :: Int

foreign import ccall unsafe "unison_jit_list_init" c_listInit :: MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64

foreign import ccall unsafe "unison_jit_list_check" c_listCheck :: MutableArray# (PrimState IO) Any -> IO Int64

foreign import ccall unsafe "unison_jit_list_test" c_listTest :: MutableArray# (PrimState IO) Any -> Int64 -> Int64 -> Int64 -> IO Int64

-- | Teaches the C list helpers the constructors of a list from samples
-- (see unison_jit_list_init), given the info pointers of Foreign, Val,
-- Data1 and Data2. 1 if all is well, else the number of the check that failed.
listInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
listInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
listInit (MutableArray MutableArray# (PrimState IO) Any
arr#) [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64
c_listInit MutableArray# (PrimState IO) Any
arr# Ptr Int64
p

-- | Checks the structure of the list in slot 0: -1 if it isn't what the C
-- helpers assume, else the set of constructors met.
listCheck :: MutableArray (PrimState IO) Any -> IO Int
listCheck :: MutableArray (PrimState IO) Any -> IO Int
listCheck (MutableArray MutableArray# (PrimState IO) Any
arr#) = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> IO Int64
c_listCheck MutableArray# (PrimState IO) Any
arr#

-- | Runs a C list helper on slot 0 (see unison_jit_list_test); the result
-- lands in slot 3. False if the helper left the case to the interpreter.
listTest :: MutableArray (PrimState IO) Any -> Int -> Int -> Int -> IO Bool
listTest :: MutableArray (PrimState IO) Any -> Int -> Int -> Int -> IO Bool
listTest (MutableArray MutableArray# (PrimState IO) Any
arr#) Int
op Int
a Int
b = (Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1) (Int64 -> Bool) -> IO Int64 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any
-> Int64 -> Int64 -> Int64 -> IO Int64
c_listTest MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
op) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)

foreign import ccall unsafe "unison_jit_text_init" c_textInit :: MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64

foreign import ccall unsafe "unison_jit_text_check" c_textCheck :: MutableArray# (PrimState IO) Any -> IO Int64

foreign import ccall unsafe "unison_jit_text_test" c_textTest :: MutableArray# (PrimState IO) Any -> Int64 -> Int64 -> Int64 -> Int64 -> IO Int64

-- | The same three for the text helpers (see unison_jit_text_init and
-- unison_jit_text_test). 'textTest' returns what the C function does.
textInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
textInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
textInit (MutableArray MutableArray# (PrimState IO) Any
arr#) [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64
c_textInit MutableArray# (PrimState IO) Any
arr# Ptr Int64
p

textCheck :: MutableArray (PrimState IO) Any -> IO Bool
textCheck :: MutableArray (PrimState IO) Any -> IO Bool
textCheck (MutableArray MutableArray# (PrimState IO) Any
arr#) = (Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1) (Int64 -> Bool) -> IO Int64 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> IO Int64
c_textCheck MutableArray# (PrimState IO) Any
arr#

textTest :: MutableArray (PrimState IO) Any -> Int -> Int -> Int -> Int -> IO Int
textTest :: MutableArray (PrimState IO) Any
-> Int -> Int -> Int -> Int -> IO Int
textTest (MutableArray MutableArray# (PrimState IO) Any
arr#) Int
op Int
a Int
b Int
c = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any
-> Int64 -> Int64 -> Int64 -> Int64 -> IO Int64
c_textTest MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
op) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)

foreign import ccall unsafe "unison_jit_bytes_init" c_bytesInit :: MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64

foreign import ccall unsafe "unison_jit_array_init" c_arrayInit :: MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64

foreign import ccall unsafe "unison_jit_murmur_init" c_murmurInit :: MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64

-- the C side returns a pair (ok, hash) by value; the FFI can't, so this
-- wrapper writes it through a pointer
foreign import ccall unsafe "unison_jit_murmur_test_ffi" c_murmurTest :: MutableArray# (PrimState IO) Any -> Int64 -> Int64 -> Ptr Int64 -> IO Int64

foreign import ccall unsafe "unison_jit_env_init" c_envInit :: MutableArray# (PrimState IO) Any -> IO Int64

-- | Teaches the request helpers the handler environment's layout from
-- samples and checks the lookup on them (see unison_jit_env_init). 1 if
-- all is well, else the number of the check that failed.
envInit :: MutableArray (PrimState IO) Any -> IO Int
envInit :: MutableArray (PrimState IO) Any -> IO Int
envInit (MutableArray MutableArray# (PrimState IO) Any
arr#) = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> IO Int64
c_envInit MutableArray# (PrimState IO) Any
arr#

foreign import ccall unsafe "unison_jit_record_init" c_recordInit :: MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64

-- | Teaches the record helpers the record layout from samples and checks
-- the field lookup on them (see unison_jit_record_init). 1 if everything
-- is as expected, else the number of the check that failed.
recordInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
recordInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
recordInit (MutableArray MutableArray# (PrimState IO) Any
arr#) [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64
c_recordInit MutableArray# (PrimState IO) Any
arr# Ptr Int64
p

foreign import ccall unsafe "unison_jit_cmp_init" c_cmpInit :: Ptr Int64 -> IO Int64

foreign import ccall unsafe "unison_jit_cmp_test_ffi" c_cmpTest :: MutableArray# (PrimState IO) Any -> Int64 -> Int64 -> Int64 -> Ptr Int64 -> IO Int64

-- | Hands the comparison helpers the PAp info pointer, the packed tags of
-- boxed Int and Nat, and the type part of Any's packed tag.
cmpInit :: [Int] -> IO Int
cmpInit :: [Int] -> IO Int
cmpInit [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int64 -> IO Int64
c_cmpInit Ptr Int64
p

-- | The native comparison (or equality, with the flag) of the values in
-- elements 0 and 1, whose unboxed halves are the two ints and whose boxed
-- halves are the elements; Nothing when the helper leaves the pair to the
-- interpreter.
cmpTest :: MutableArray (PrimState IO) Any -> Int -> Int -> Bool -> IO (Maybe Int)
cmpTest :: MutableArray (PrimState IO) Any
-> Int -> Int -> Bool -> IO (Maybe Int)
cmpTest (MutableArray MutableArray# (PrimState IO) Any
arr#) Int
u1 Int
u2 Bool
eq = Int -> (Ptr Int64 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 ((Ptr Int64 -> IO (Maybe Int)) -> IO (Maybe Int))
-> (Ptr Int64 -> IO (Maybe Int)) -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p -> do
  Int64
ok <- MutableArray# (PrimState IO) Any
-> Int64 -> Int64 -> Int64 -> Ptr Int64 -> IO Int64
c_cmpTest MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u1) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u2) (if Bool
eq then Int64
4 else Int64
0) Ptr Int64
p
  if Int64
ok Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1 then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Int64 -> Int) -> Int64 -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Int) -> IO Int64 -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
p else Maybe Int -> IO (Maybe Int)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing

-- | Hands the hash helper the type-tag closure in element 0 and the Enum
-- and DataG info pointers.
murmurInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
murmurInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
murmurInit (MutableArray MutableArray# (PrimState IO) Any
arr#) [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64
c_murmurInit MutableArray# (PrimState IO) Any
arr# Ptr Int64
p

-- | The native hash of element 0 (boxed), or of the unboxed value with the
-- type tag in element 0; Nothing when the helper leaves it to the interpreter.
murmurTest :: MutableArray (PrimState IO) Any -> Int -> Bool -> IO (Maybe Word64)
murmurTest :: MutableArray (PrimState IO) Any -> Int -> Bool -> IO (Maybe Word64)
murmurTest (MutableArray MutableArray# (PrimState IO) Any
arr#) Int
u Bool
unboxed = Int -> (Ptr Int64 -> IO (Maybe Word64)) -> IO (Maybe Word64)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
8 ((Ptr Int64 -> IO (Maybe Word64)) -> IO (Maybe Word64))
-> (Ptr Int64 -> IO (Maybe Word64)) -> IO (Maybe Word64)
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p -> do
  Int64
ok <- MutableArray# (PrimState IO) Any
-> Int64 -> Int64 -> Ptr Int64 -> IO Int64
c_murmurTest MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) (if Bool
unboxed then Int64
1 else Int64
0) Ptr Int64
p
  if Int64
ok Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1 then Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64)
-> (Int64 -> Word64) -> Int64 -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Maybe Word64) -> IO Int64 -> IO (Maybe Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek Ptr Int64
p else Maybe Word64 -> IO (Maybe Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word64
forall a. Maybe a
Nothing

-- | Hands the array and ref helpers the wrappers' info pointers and tags
-- (pairs, flattened) and the empty value in element 0.
arrayInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
arrayInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
arrayInit (MutableArray MutableArray# (PrimState IO) Any
arr#) [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64
c_arrayInit MutableArray# (PrimState IO) Any
arr# Ptr Int64
p

foreign import ccall unsafe "unison_jit_bytes_check" c_bytesCheck :: MutableArray# (PrimState IO) Any -> IO Int64

foreign import ccall unsafe "unison_jit_bytes_test" c_bytesTest :: MutableArray# (PrimState IO) Any -> Int64 -> Int64 -> Int64 -> Int64 -> IO Int64

-- | And for the bytes helpers (see unison_jit_bytes_init and
-- unison_jit_bytes_test).
bytesInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
bytesInit :: MutableArray (PrimState IO) Any -> [Int] -> IO Int
bytesInit (MutableArray MutableArray# (PrimState IO) Any
arr#) [Int]
infos = [Int] -> (Ptr Int64 -> IO Int) -> IO Int
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO Int) -> IO Int)
-> (Ptr Int64 -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Ptr Int64 -> IO Int64
c_bytesInit MutableArray# (PrimState IO) Any
arr# Ptr Int64
p

bytesCheck :: MutableArray (PrimState IO) Any -> IO Bool
bytesCheck :: MutableArray (PrimState IO) Any -> IO Bool
bytesCheck (MutableArray MutableArray# (PrimState IO) Any
arr#) = (Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1) (Int64 -> Bool) -> IO Int64 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> IO Int64
c_bytesCheck MutableArray# (PrimState IO) Any
arr#

bytesTest :: MutableArray (PrimState IO) Any -> Int -> Int -> Int -> Int -> IO Int
bytesTest :: MutableArray (PrimState IO) Any
-> Int -> Int -> Int -> Int -> IO Int
bytesTest (MutableArray MutableArray# (PrimState IO) Any
arr#) Int
op Int
a Int
b Int
c = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any
-> Int64 -> Int64 -> Int64 -> Int64 -> IO Int64
c_bytesTest MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
op) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b) (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c)

foreign import ccall unsafe "unison_jit_closure_init" c_closureInit :: Ptr Int64 -> IO ()

foreign import ccall unsafe "unison_jit_name_test" c_nameTest :: MutableArray# (PrimState IO) Any -> Int64 -> IO Int64

-- | Gives the partial-application helper the info pointers of PAp and of
-- the boxes around a segment's two arrays.
closureInit :: [Int] -> IO ()
closureInit :: [Int] -> IO ()
closureInit [Int]
infos = [Int] -> (Ptr Int64 -> IO ()) -> IO ()
forall a. [Int] -> (Ptr Int64 -> IO a) -> IO a
withInts [Int]
infos ((Ptr Int64 -> IO ()) -> IO ()) -> (Ptr Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Int64
p ->
  Ptr Int64 -> IO ()
c_closureInit Ptr Int64
p

-- | Runs the helper on slot 0 with n arguments (see unison_jit_name_test).
nameTest :: MutableArray (PrimState IO) Any -> Int -> IO Bool
nameTest :: MutableArray (PrimState IO) Any -> Int -> IO Bool
nameTest (MutableArray MutableArray# (PrimState IO) Any
arr#) Int
n = (Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1) (Int64 -> Bool) -> IO Int64 -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutableArray# (PrimState IO) Any -> Int64 -> IO Int64
c_nameTest MutableArray# (PrimState IO) Any
arr# (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)