{-# LANGUAGE GADTs #-}
module AsyncRattus.InternalPrimitives where
import Prelude hiding (Left, Right)
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
type InputChannelIdentifier = Int
type Clock = IntSet
singletonClock :: InputChannelIdentifier -> Clock
singletonClock :: InputChannelIdentifier -> Clock
singletonClock = InputChannelIdentifier -> Clock
IntSet.singleton
clockUnion :: Clock -> Clock -> Clock
clockUnion :: Clock -> Clock -> Clock
clockUnion = Clock -> Clock -> Clock
IntSet.union
channelMember :: InputChannelIdentifier -> Clock -> Bool
channelMember :: InputChannelIdentifier -> Clock -> Bool
channelMember = InputChannelIdentifier -> Clock -> Bool
IntSet.member
data InputValue where
InputValue :: !InputChannelIdentifier -> !a -> InputValue
data O a = Delay !Clock (InputValue -> a)
data Select a b = Fst !a !(O b) | Snd !(O a) !b | Both !a !b
asyncRattusError :: [Char] -> a
asyncRattusError [Char]
pr = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
pr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": Did you forget to mark this as Async Rattus code?")
{-# INLINE [1] delay #-}
delay :: a -> O a
delay :: forall a. a -> O a
delay a
_ = [Char] -> O a
forall {a}. [Char] -> a
asyncRattusError [Char]
"delay"
extractClock :: O a -> Clock
(Delay Clock
cl InputValue -> a
_) = Clock
cl
{-# INLINE [1] adv' #-}
adv' :: O a -> InputValue -> a
adv' :: forall a. O a -> InputValue -> a
adv' (Delay Clock
_ InputValue -> a
f) InputValue
inp = InputValue -> a
f InputValue
inp
{-# INLINE [1] adv #-}
adv :: O a -> a
adv :: forall a. O a -> a
adv O a
_ = [Char] -> a
forall {a}. [Char] -> a
asyncRattusError [Char]
"adv"
{-# INLINE [1] select #-}
select :: O a -> O b -> Select a b
select :: forall a b. O a -> O b -> Select a b
select O a
_ O b
_ = [Char] -> Select a b
forall {a}. [Char] -> a
asyncRattusError [Char]
"select"
select' :: O a -> O b -> InputValue -> Select a b
select' :: forall a b. O a -> O b -> InputValue -> Select a b
select' a :: O a
a@(Delay Clock
clA InputValue -> a
inpFA) b :: O b
b@(Delay Clock
clB InputValue -> b
inpFB) inputValue :: InputValue
inputValue@(InputValue InputChannelIdentifier
chId a
_)
= if InputChannelIdentifier
chId InputChannelIdentifier -> Clock -> Bool
`channelMember` Clock
clA then
if InputChannelIdentifier
chId InputChannelIdentifier -> Clock -> Bool
`channelMember` Clock
clB then a -> b -> Select a b
forall a b. a -> b -> Select a b
Both (InputValue -> a
inpFA InputValue
inputValue) (InputValue -> b
inpFB InputValue
inputValue)
else a -> O b -> Select a b
forall a b. a -> O b -> Select a b
Fst (InputValue -> a
inpFA InputValue
inputValue) O b
b
else O a -> b -> Select a b
forall a b. O a -> b -> Select a b
Snd O a
a (InputValue -> b
inpFB InputValue
inputValue)
never :: O a
never :: forall a. O a
never = Clock -> (InputValue -> a) -> O a
forall a. Clock -> (InputValue -> a) -> O a
Delay Clock
IntSet.empty ([Char] -> InputValue -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Trying to adv on the 'never' delayed computation")
class Stable a where
data Box a = Box a
{-# INLINE [1] box #-}
box :: a -> Box a
box :: forall a. a -> Box a
box a
x = a -> Box a
forall a. a -> Box a
Box a
x
{-# INLINE [1] unbox #-}
unbox :: Box a -> a
unbox :: forall a. Box a -> a
unbox (Box a
d) = a
d
{-# RULES
"unbox/box" forall x. unbox (box x) = x
#-}
{-# RULES
"box/unbox" forall x. box (unbox x) = x
#-}