{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Unison.Runtime.Foreign
  ( Foreign (..),
    HashAlgorithm (..),
    unwrapForeign,
    maybeUnwrapForeign,
    wrapBuiltin,
    maybeUnwrapBuiltin,
    unwrapBuiltin,
    BuiltinForeign (..),
    Tls (..),
    Failure (..),
  )
where

import Control.Concurrent (MVar, ThreadId)
import Control.Concurrent.STM (TVar)
import Crypto.Hash qualified as Hash
import Data.Atomics qualified as Atomic
import Data.IORef (IORef)
import Data.Tagged (Tagged (..))
import Data.X509 qualified as X509
import Network.Socket (Socket)
import Network.TLS qualified as TLS (ClientParams, Context, ServerParams)
import Network.UDP (ClientSockAddr, ListenSocket, UDPSocket)
import System.Clock (TimeSpec)
import System.IO (Handle)
import System.Process (ProcessHandle)
import Unison.Reference (Reference)
import Unison.Referent (Referent)
import Unison.Runtime.ANF (Code, Value)
import Unison.Runtime.Array
import Unison.Type qualified as Ty
import Unison.Util.Bytes (Bytes)
import Unison.Util.Text (Text)
import Unison.Util.Text.Pattern (CPattern, CharPattern)
import Unsafe.Coerce

data Foreign where
  Wrap :: Reference -> !e -> Foreign

promote :: (a -> a -> r) -> b -> c -> r
promote :: forall a r b c. (a -> a -> r) -> b -> c -> r
promote a -> a -> r
(~~) b
x c
y = b -> a
forall a b. a -> b
unsafeCoerce b
x a -> a -> r
~~ c -> a
forall a b. a -> b
unsafeCoerce c
y

-- These functions are explicit aliases of the overloaded function.
-- When the overloaded function is used in their place, it seems to
-- cause issues with regard to `promote` above. Somehow, the
-- unsafeCoerce can cause memory faults, even when the values are
-- being coerced to appropriate types. Having an explicit, noinline
-- alias seems to prevent the faults.
txtEq :: Text -> Text -> Bool
txtEq :: Text -> Text -> Bool
txtEq Text
l Text
r = Text
l Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
r
{-# NOINLINE txtEq #-}

txtCmp :: Text -> Text -> Ordering
txtCmp :: Text -> Text -> Ordering
txtCmp Text
l Text
r = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
l Text
r
{-# NOINLINE txtCmp #-}

bytesEq :: Bytes -> Bytes -> Bool
bytesEq :: Bytes -> Bytes -> Bool
bytesEq Bytes
l Bytes
r = Bytes
l Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes
r
{-# NOINLINE bytesEq #-}

bytesCmp :: Bytes -> Bytes -> Ordering
bytesCmp :: Bytes -> Bytes -> Ordering
bytesCmp Bytes
l Bytes
r = Bytes -> Bytes -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bytes
l Bytes
r
{-# NOINLINE bytesCmp #-}

mvarEq :: MVar () -> MVar () -> Bool
mvarEq :: MVar () -> MVar () -> Bool
mvarEq MVar ()
l MVar ()
r = MVar ()
l MVar () -> MVar () -> Bool
forall a. Eq a => a -> a -> Bool
== MVar ()
r
{-# NOINLINE mvarEq #-}

tvarEq :: TVar () -> TVar () -> Bool
tvarEq :: TVar () -> TVar () -> Bool
tvarEq TVar ()
l TVar ()
r = TVar ()
l TVar () -> TVar () -> Bool
forall a. Eq a => a -> a -> Bool
== TVar ()
r
{-# NOINLINE tvarEq #-}

socketEq :: Socket -> Socket -> Bool
socketEq :: Socket -> Socket -> Bool
socketEq Socket
l Socket
r = Socket
l Socket -> Socket -> Bool
forall a. Eq a => a -> a -> Bool
== Socket
r
{-# NOINLINE socketEq #-}

udpSocketEq :: UDPSocket -> UDPSocket -> Bool
udpSocketEq :: UDPSocket -> UDPSocket -> Bool
udpSocketEq UDPSocket
l UDPSocket
r = UDPSocket
l UDPSocket -> UDPSocket -> Bool
forall a. Eq a => a -> a -> Bool
== UDPSocket
r
{-# NOINLINE udpSocketEq #-}

refEq :: IORef () -> IORef () -> Bool
refEq :: IORef () -> IORef () -> Bool
refEq IORef ()
l IORef ()
r = IORef ()
l IORef () -> IORef () -> Bool
forall a. Eq a => a -> a -> Bool
== IORef ()
r
{-# NOINLINE refEq #-}

tidEq :: ThreadId -> ThreadId -> Bool
tidEq :: ThreadId -> ThreadId -> Bool
tidEq ThreadId
l ThreadId
r = ThreadId
l ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
== ThreadId
r
{-# NOINLINE tidEq #-}

tidCmp :: ThreadId -> ThreadId -> Ordering
tidCmp :: ThreadId -> ThreadId -> Ordering
tidCmp ThreadId
l ThreadId
r = ThreadId -> ThreadId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ThreadId
l ThreadId
r
{-# NOINLINE tidCmp #-}

marrEq :: MutableArray () () -> MutableArray () () -> Bool
marrEq :: MutableArray () () -> MutableArray () () -> Bool
marrEq MutableArray () ()
l MutableArray () ()
r = MutableArray () ()
l MutableArray () () -> MutableArray () () -> Bool
forall a. Eq a => a -> a -> Bool
== MutableArray () ()
r
{-# NOINLINE marrEq #-}

mbarrEq :: MutableByteArray () -> MutableByteArray () -> Bool
mbarrEq :: MutableByteArray () -> MutableByteArray () -> Bool
mbarrEq MutableByteArray ()
l MutableByteArray ()
r = MutableByteArray ()
l MutableByteArray () -> MutableByteArray () -> Bool
forall a. Eq a => a -> a -> Bool
== MutableByteArray ()
r
{-# NOINLINE mbarrEq #-}

barrEq :: ByteArray -> ByteArray -> Bool
barrEq :: ByteArray -> ByteArray -> Bool
barrEq ByteArray
l ByteArray
r = ByteArray
l ByteArray -> ByteArray -> Bool
forall a. Eq a => a -> a -> Bool
== ByteArray
r
{-# NOINLINE barrEq #-}

barrCmp :: ByteArray -> ByteArray -> Ordering
barrCmp :: ByteArray -> ByteArray -> Ordering
barrCmp ByteArray
l ByteArray
r = ByteArray -> ByteArray -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteArray
l ByteArray
r
{-# NOINLINE barrCmp #-}

cpatEq :: CPattern -> CPattern -> Bool
cpatEq :: CPattern -> CPattern -> Bool
cpatEq CPattern
l CPattern
r = CPattern
l CPattern -> CPattern -> Bool
forall a. Eq a => a -> a -> Bool
== CPattern
r
{-# NOINLINE cpatEq #-}

cpatCmp :: CPattern -> CPattern -> Ordering
cpatCmp :: CPattern -> CPattern -> Ordering
cpatCmp CPattern
l CPattern
r = CPattern -> CPattern -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CPattern
l CPattern
r
{-# NOINLINE cpatCmp #-}

charClassEq :: CharPattern -> CharPattern -> Bool
charClassEq :: CharPattern -> CharPattern -> Bool
charClassEq CharPattern
l CharPattern
r = CharPattern
l CharPattern -> CharPattern -> Bool
forall a. Eq a => a -> a -> Bool
== CharPattern
r
{-# NOINLINE charClassEq #-}

charClassCmp :: CharPattern -> CharPattern -> Ordering
charClassCmp :: CharPattern -> CharPattern -> Ordering
charClassCmp = CharPattern -> CharPattern -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
{-# NOINLINE charClassCmp #-}

codeEq :: Code -> Code -> Bool
codeEq :: Code -> Code -> Bool
codeEq Code
co1 Code
co2 = Code
co1 Code -> Code -> Bool
forall a. Eq a => a -> a -> Bool
== Code
co2
{-# NOINLINE codeEq #-}

tylEq :: Reference -> Reference -> Bool
tylEq :: Reference -> Reference -> Bool
tylEq Reference
r Reference
l = Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
l
{-# NOINLINE tylEq #-}

tmlEq :: Referent -> Referent -> Bool
tmlEq :: Referent -> Referent -> Bool
tmlEq Referent
r Referent
l = Referent
r Referent -> Referent -> Bool
forall a. Eq a => a -> a -> Bool
== Referent
l
{-# NOINLINE tmlEq #-}

tylCmp :: Reference -> Reference -> Ordering
tylCmp :: Reference -> Reference -> Ordering
tylCmp Reference
r Reference
l = Reference -> Reference -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Reference
r Reference
l
{-# NOINLINE tylCmp #-}

tmlCmp :: Referent -> Referent -> Ordering
tmlCmp :: Referent -> Referent -> Ordering
tmlCmp Referent
r Referent
l = Referent -> Referent -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Referent
r Referent
l
{-# NOINLINE tmlCmp #-}

ref2eq :: Reference -> Maybe (a -> b -> Bool)
ref2eq :: forall a b. Reference -> Maybe (a -> b -> Bool)
ref2eq Reference
r
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.textRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Text -> Text -> Bool
txtEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.termLinkRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (Referent -> Referent -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Referent -> Referent -> Bool
tmlEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.typeLinkRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (Reference -> Reference -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Reference -> Reference -> Bool
tylEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.bytesRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (Bytes -> Bytes -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Bytes -> Bytes -> Bool
bytesEq
  -- Note: MVar equality is just reference equality, so it shouldn't
  -- matter what type the MVar holds.
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.mvarRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (MVar () -> MVar () -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote MVar () -> MVar () -> Bool
mvarEq
  -- Ditto
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.tvarRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (TVar () -> TVar () -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote TVar () -> TVar () -> Bool
tvarEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.socketRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (Socket -> Socket -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Socket -> Socket -> Bool
socketEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.udpSocketRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (UDPSocket -> UDPSocket -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote UDPSocket -> UDPSocket -> Bool
udpSocketEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.refRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (IORef () -> IORef () -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote IORef () -> IORef () -> Bool
refEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.threadIdRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (ThreadId -> ThreadId -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote ThreadId -> ThreadId -> Bool
tidEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.marrayRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (MutableArray () () -> MutableArray () () -> Bool)
-> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote MutableArray () () -> MutableArray () () -> Bool
marrEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.mbytearrayRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (MutableByteArray () -> MutableByteArray () -> Bool)
-> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote MutableByteArray () -> MutableByteArray () -> Bool
mbarrEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.ibytearrayRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (ByteArray -> ByteArray -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote ByteArray -> ByteArray -> Bool
barrEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.patternRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (CPattern -> CPattern -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote CPattern -> CPattern -> Bool
cpatEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.charClassRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (CharPattern -> CharPattern -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote CharPattern -> CharPattern -> Bool
charClassEq
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.codeRef = (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a. a -> Maybe a
Just ((a -> b -> Bool) -> Maybe (a -> b -> Bool))
-> (a -> b -> Bool) -> Maybe (a -> b -> Bool)
forall a b. (a -> b) -> a -> b
$ (Code -> Code -> Bool) -> a -> b -> Bool
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Code -> Code -> Bool
codeEq
  | Bool
otherwise = Maybe (a -> b -> Bool)
forall a. Maybe a
Nothing

ref2cmp :: Reference -> Maybe (a -> b -> Ordering)
ref2cmp :: forall a b. Reference -> Maybe (a -> b -> Ordering)
ref2cmp Reference
r
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.textRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Text -> Text -> Ordering
txtCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.termLinkRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (Referent -> Referent -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Referent -> Referent -> Ordering
tmlCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.typeLinkRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (Reference -> Reference -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Reference -> Reference -> Ordering
tylCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.bytesRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (Bytes -> Bytes -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote Bytes -> Bytes -> Ordering
bytesCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.threadIdRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (ThreadId -> ThreadId -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote ThreadId -> ThreadId -> Ordering
tidCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.ibytearrayRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (ByteArray -> ByteArray -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote ByteArray -> ByteArray -> Ordering
barrCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.patternRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (CPattern -> CPattern -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote CPattern -> CPattern -> Ordering
cpatCmp
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.charClassRef = (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a. a -> Maybe a
Just ((a -> b -> Ordering) -> Maybe (a -> b -> Ordering))
-> (a -> b -> Ordering) -> Maybe (a -> b -> Ordering)
forall a b. (a -> b) -> a -> b
$ (CharPattern -> CharPattern -> Ordering) -> a -> b -> Ordering
forall a r b c. (a -> a -> r) -> b -> c -> r
promote CharPattern -> CharPattern -> Ordering
charClassCmp
  | Bool
otherwise = Maybe (a -> b -> Ordering)
forall a. Maybe a
Nothing

instance Eq Foreign where
  Wrap Reference
rl e
t == :: Foreign -> Foreign -> Bool
== Wrap Reference
rr e
u
    | Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr, Just e -> e -> Bool
(~~) <- Reference -> Maybe (e -> e -> Bool)
forall a b. Reference -> Maybe (a -> b -> Bool)
ref2eq Reference
rl = e
t e -> e -> Bool
~~ e
u
  Wrap Reference
rl1 e
_ == Wrap Reference
rl2 e
_ =
    [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$
      [Char]
"Attempting to check equality of two values of different types: "
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Reference, Reference) -> [Char]
forall a. Show a => a -> [Char]
show (Reference
rl1, Reference
rl2)

instance Ord Foreign where
  Wrap Reference
rl e
t compare :: Foreign -> Foreign -> Ordering
`compare` Wrap Reference
rr e
u
    | Reference
rl Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
rr, Just e -> e -> Ordering
cmp <- Reference -> Maybe (e -> e -> Ordering)
forall a b. Reference -> Maybe (a -> b -> Ordering)
ref2cmp Reference
rl = e -> e -> Ordering
cmp e
t e
u
  compare (Wrap Reference
rl1 e
_) (Wrap Reference
rl2 e
_) =
    [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error ([Char] -> Ordering) -> [Char] -> Ordering
forall a b. (a -> b) -> a -> b
$
      [Char]
"Attempting to compare two values of different types: "
        [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Reference, Reference) -> [Char]
forall a. Show a => a -> [Char]
show (Reference
rl1, Reference
rl2)

instance Show Foreign where
  showsPrec :: Int -> Foreign -> [Char] -> [Char]
showsPrec Int
p !(Wrap Reference
r e
v) =
    Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
      [Char] -> [Char] -> [Char]
showString [Char]
"Wrap " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reference -> [Char] -> [Char]
forall a. Show a => Int -> a -> [Char] -> [Char]
showsPrec Int
10 Reference
r ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
" " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
contents
    where
      contents :: [Char] -> [Char]
contents
        | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
Ty.textRef = forall a. Show a => a -> [Char] -> [Char]
shows @Text (e -> Text
forall a b. a -> b
unsafeCoerce e
v)
        | Bool
otherwise = [Char] -> [Char] -> [Char]
showString [Char]
"_"

unwrapForeign :: Foreign -> a
unwrapForeign :: forall a. Foreign -> a
unwrapForeign (Wrap Reference
_ e
e) = e -> a
forall a b. a -> b
unsafeCoerce e
e

maybeUnwrapForeign :: Reference -> Foreign -> Maybe a
maybeUnwrapForeign :: forall a. Reference -> Foreign -> Maybe a
maybeUnwrapForeign Reference
rt (Wrap Reference
r e
e)
  | Reference
rt Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
r = a -> Maybe a
forall a. a -> Maybe a
Just (e -> a
forall a b. a -> b
unsafeCoerce e
e)
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
{-# NOINLINE maybeUnwrapForeign #-}

class BuiltinForeign f where
  foreignRef :: Tagged f Reference

instance BuiltinForeign Text where
  foreignRef :: Tagged Text Reference
  foreignRef :: Tagged Text Reference
foreignRef = Reference -> Tagged Text Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.textRef

instance BuiltinForeign Bytes where foreignRef :: Tagged Bytes Reference
foreignRef = Reference -> Tagged Bytes Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.bytesRef

instance BuiltinForeign Handle where foreignRef :: Tagged Handle Reference
foreignRef = Reference -> Tagged Handle Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.fileHandleRef

instance BuiltinForeign ProcessHandle where foreignRef :: Tagged ProcessHandle Reference
foreignRef = Reference -> Tagged ProcessHandle Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.processHandleRef

instance BuiltinForeign Referent where foreignRef :: Tagged Referent Reference
foreignRef = Reference -> Tagged Referent Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.termLinkRef

instance BuiltinForeign Socket where foreignRef :: Tagged Socket Reference
foreignRef = Reference -> Tagged Socket Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.socketRef

instance BuiltinForeign ListenSocket where foreignRef :: Tagged ListenSocket Reference
foreignRef = Reference -> Tagged ListenSocket Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.udpListenSocketRef

instance BuiltinForeign ClientSockAddr where foreignRef :: Tagged ClientSockAddr Reference
foreignRef = Reference -> Tagged ClientSockAddr Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.udpClientSockAddrRef

instance BuiltinForeign UDPSocket where foreignRef :: Tagged UDPSocket Reference
foreignRef = Reference -> Tagged UDPSocket Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.udpSocketRef

instance BuiltinForeign ThreadId where foreignRef :: Tagged ThreadId Reference
foreignRef = Reference -> Tagged ThreadId Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.threadIdRef

instance BuiltinForeign TLS.ClientParams where foreignRef :: Tagged ClientParams Reference
foreignRef = Reference -> Tagged ClientParams Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.tlsClientConfigRef

instance BuiltinForeign TLS.ServerParams where foreignRef :: Tagged ServerParams Reference
foreignRef = Reference -> Tagged ServerParams Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.tlsServerConfigRef

instance BuiltinForeign X509.SignedCertificate where foreignRef :: Tagged SignedCertificate Reference
foreignRef = Reference -> Tagged SignedCertificate Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.tlsSignedCertRef

instance BuiltinForeign X509.PrivKey where foreignRef :: Tagged PrivKey Reference
foreignRef = Reference -> Tagged PrivKey Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.tlsPrivateKeyRef

instance BuiltinForeign FilePath where foreignRef :: Tagged [Char] Reference
foreignRef = Reference -> Tagged [Char] Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.filePathRef

instance BuiltinForeign TLS.Context where foreignRef :: Tagged Context Reference
foreignRef = Reference -> Tagged Context Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.tlsRef

instance BuiltinForeign Code where foreignRef :: Tagged Code Reference
foreignRef = Reference -> Tagged Code Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.codeRef

instance BuiltinForeign Value where foreignRef :: Tagged Value Reference
foreignRef = Reference -> Tagged Value Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.valueRef

instance BuiltinForeign TimeSpec where foreignRef :: Tagged TimeSpec Reference
foreignRef = Reference -> Tagged TimeSpec Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.timeSpecRef

instance BuiltinForeign (Atomic.Ticket a) where foreignRef :: Tagged (Ticket a) Reference
foreignRef = Reference -> Tagged (Ticket a) Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.ticketRef

data HashAlgorithm where
  -- Reference is a reference to the hash algorithm
  HashAlgorithm :: (Hash.HashAlgorithm a) => Reference -> a -> HashAlgorithm

newtype Tls = Tls TLS.Context

data Failure a = Failure Reference Text a

instance BuiltinForeign HashAlgorithm where foreignRef :: Tagged HashAlgorithm Reference
foreignRef = Reference -> Tagged HashAlgorithm Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.hashAlgorithmRef

instance BuiltinForeign CPattern where
  foreignRef :: Tagged CPattern Reference
foreignRef = Reference -> Tagged CPattern Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.patternRef

instance BuiltinForeign CharPattern where
  foreignRef :: Tagged CharPattern Reference
foreignRef = Reference -> Tagged CharPattern Reference
forall {k} (s :: k) b. b -> Tagged s b
Tagged Reference
Ty.charClassRef

wrapBuiltin :: forall f. (BuiltinForeign f) => f -> Foreign
wrapBuiltin :: forall f. BuiltinForeign f => f -> Foreign
wrapBuiltin f
x = Reference -> f -> Foreign
forall e. Reference -> e -> Foreign
Wrap Reference
r f
x
  where
    Tagged Reference
r = Tagged f Reference
forall f. BuiltinForeign f => Tagged f Reference
foreignRef :: Tagged f Reference

unwrapBuiltin :: (BuiltinForeign f) => Foreign -> f
unwrapBuiltin :: forall f. BuiltinForeign f => Foreign -> f
unwrapBuiltin (Wrap Reference
_ e
x) = e -> f
forall a b. a -> b
unsafeCoerce e
x

maybeUnwrapBuiltin :: forall f. (BuiltinForeign f) => Foreign -> Maybe f
maybeUnwrapBuiltin :: forall f. BuiltinForeign f => Foreign -> Maybe f
maybeUnwrapBuiltin (Wrap Reference
r e
x)
  | Reference
r Reference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
== Reference
r0 = f -> Maybe f
forall a. a -> Maybe a
Just (e -> f
forall a b. a -> b
unsafeCoerce e
x)
  | Bool
otherwise = Maybe f
forall a. Maybe a
Nothing
  where
    Tagged Reference
r0 = Tagged f Reference
forall f. BuiltinForeign f => Tagged f Reference
foreignRef :: Tagged f Reference