-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | Session Types for Haskell -- -- Session Types for Haskell. Allows the specification of communication -- protocols and then validation that an implementation does not violate -- said protocol. Ignore the build failure for hackage - it's just -- haddock being rubbish. @package sessions @version 2008.5.12 module Control.Concurrent.Session.Base.Bool type :$ a :: (* -> *) b = a b type :. a :: (* -> *) b :: (* -> *) c = a (b c) data True TT :: True data False FF :: False class And x y z | x y -> z tyAnd :: (And x y z) => x -> y -> z class Or x y z | x y -> z tyOr :: (Or x y z) => x -> y -> z class If c x y z | c x y -> z tyIf :: (If c x y z) => c -> x -> y -> z class Not x y | x -> y where { type family NotT x; } tyNot :: (Not x y) => x -> y instance Show False instance Show True instance Not False True instance Not True False instance If False x y y instance If True x y x instance Or False False False instance Or False True True instance Or True y True instance And False y False instance And True False False instance And True True True -- | Type level Integers. These are all base 10. module Control.Concurrent.Session.Base.Number data E E :: E data D0 n D0 :: n -> D0 n data D1 n D1 :: n -> D1 n data D2 n D2 :: n -> D2 n data D3 n D3 :: n -> D3 n data D4 n D4 :: n -> D4 n data D5 n D5 :: n -> D5 n data D6 n D6 :: n -> D6 n data D7 n D7 :: n -> D7 n data D8 n D8 :: n -> D8 n data D9 n D9 :: n -> D9 n class Succ x y | x -> y tySucc :: (Succ x y) => x -> y class Pred x y | x -> y tyPred :: (Pred x y) => x -> y class Add m n s | m n -> s tyAdd :: (Add m n s) => m -> n -> s class SmallerThan x y class SmallerThanBool x y res | x y -> res isSmallerThan :: (SmallerThanBool x y res) => x -> y -> res class TyNum n -- | Convert a type-level number to an Int. Of course, we can only go this -- way... class TypeNumberToInt ty tyNumToInt :: (TypeNumberToInt ty) => ty -> Int instance [overlap ok] (Show n) => Show (D9 n) instance [overlap ok] (Show n) => Show (D8 n) instance [overlap ok] (Show n) => Show (D7 n) instance [overlap ok] (Show n) => Show (D6 n) instance [overlap ok] (Show n) => Show (D5 n) instance [overlap ok] (Show n) => Show (D4 n) instance [overlap ok] (Show n) => Show (D3 n) instance [overlap ok] (Show n) => Show (D2 n) instance [overlap ok] (Show n) => Show (D1 n) instance [overlap ok] (Show n) => Show (D0 n) instance [overlap ok] Show E instance [overlap ok] (Pred a b, TypeNumberToInt b) => TypeNumberToInt a instance [overlap ok] TypeNumberToInt (D0 E) instance [overlap ok] (TyNum n) => TyNum (D9 n) instance [overlap ok] (TyNum n) => TyNum (D8 n) instance [overlap ok] (TyNum n) => TyNum (D7 n) instance [overlap ok] (TyNum n) => TyNum (D6 n) instance [overlap ok] (TyNum n) => TyNum (D5 n) instance [overlap ok] (TyNum n) => TyNum (D4 n) instance [overlap ok] (TyNum n) => TyNum (D3 n) instance [overlap ok] (TyNum n) => TyNum (D2 n) instance [overlap ok] (TyNum n) => TyNum (D1 n) instance [overlap ok] (TyNum n) => TyNum (D0 n) instance [overlap ok] TyNum (D9 E) instance [overlap ok] TyNum (D8 E) instance [overlap ok] TyNum (D7 E) instance [overlap ok] TyNum (D6 E) instance [overlap ok] TyNum (D5 E) instance [overlap ok] TyNum (D4 E) instance [overlap ok] TyNum (D3 E) instance [overlap ok] TyNum (D2 E) instance [overlap ok] TyNum (D1 E) instance [overlap ok] TyNum (D0 E) instance [overlap ok] (Pred (D9 a) x') => Pred' (D9 a) x' True instance [overlap ok] (Pred (D8 a) x') => Pred' (D8 a) x' True instance [overlap ok] (Pred (D7 a) x') => Pred' (D7 a) x' True instance [overlap ok] (Pred (D6 a) x') => Pred' (D6 a) x' True instance [overlap ok] (Pred (D5 a) x') => Pred' (D5 a) x' True instance [overlap ok] (Pred (D4 a) x') => Pred' (D4 a) x' True instance [overlap ok] (Pred (D3 a) x') => Pred' (D3 a) x' True instance [overlap ok] (Pred (D2 a) x') => Pred' (D2 a) x' True instance [overlap ok] (Pred (D1 a) x') => Pred' (D1 a) x' True instance [overlap ok] Pred' (D0 E) y False instance [overlap ok] SmallerThanBool' x y False False False instance [overlap ok] SmallerThanBool' x y True False False instance [overlap ok] SmallerThanBool' x y False True True instance [overlap ok] (SmallerThanBool x y res) => SmallerThanBool' x y True True res instance [overlap ok] (Pred' x x' resX, Pred' y y' resY, SmallerThanBool' x' y' resX resY res) => SmallerThanBool x y res instance [overlap ok] (Pred x x', Pred y y', SmallerThan x' y') => SmallerThan x y instance [overlap ok] (Pred y y') => SmallerThan (D0 E) y instance [overlap ok] (Add m' n' s, Pred m m', Pred n n', Succ s s', Succ s' s'') => Add m n s'' instance [overlap ok] (Pred n n') => Add (D0 E) n n instance [overlap ok] (Pred m m') => Add m (D0 E) m instance [overlap ok] Add (D0 E) (D0 E) (D0 E) instance [overlap ok] (Reverse a a', DecrementRightToLeft a' b', Reverse b' b'', StripLeadingZeros b'' b) => Pred a b instance [overlap ok] (StripLeadingZeros a b) => StripLeadingZeros (D0 a) b instance [overlap ok] StripLeadingZeros (D9 a) (D9 a) instance [overlap ok] StripLeadingZeros (D8 a) (D8 a) instance [overlap ok] StripLeadingZeros (D7 a) (D7 a) instance [overlap ok] StripLeadingZeros (D6 a) (D6 a) instance [overlap ok] StripLeadingZeros (D5 a) (D5 a) instance [overlap ok] StripLeadingZeros (D4 a) (D4 a) instance [overlap ok] StripLeadingZeros (D3 a) (D3 a) instance [overlap ok] StripLeadingZeros (D2 a) (D2 a) instance [overlap ok] StripLeadingZeros (D1 a) (D1 a) instance [overlap ok] StripLeadingZeros (D0 E) (D0 E) instance [overlap ok] (DecrementRightToLeft a b) => DecrementRightToLeft (D0 a) (D9 b) instance [overlap ok] DecrementRightToLeft (D1 a) (D0 a) instance [overlap ok] DecrementRightToLeft (D2 a) (D1 a) instance [overlap ok] DecrementRightToLeft (D3 a) (D2 a) instance [overlap ok] DecrementRightToLeft (D4 a) (D3 a) instance [overlap ok] DecrementRightToLeft (D5 a) (D4 a) instance [overlap ok] DecrementRightToLeft (D6 a) (D5 a) instance [overlap ok] DecrementRightToLeft (D7 a) (D6 a) instance [overlap ok] DecrementRightToLeft (D8 a) (D7 a) instance [overlap ok] DecrementRightToLeft (D9 a) (D8 a) instance [overlap ok] (Reverse a a', IncrementRightToLeft a' b', Reverse b' b) => Succ a b instance [overlap ok] (IncrementRightToLeft a b) => IncrementRightToLeft (D9 a) (D0 b) instance [overlap ok] IncrementRightToLeft (D8 a) (D9 a) instance [overlap ok] IncrementRightToLeft (D7 a) (D8 a) instance [overlap ok] IncrementRightToLeft (D6 a) (D7 a) instance [overlap ok] IncrementRightToLeft (D5 a) (D6 a) instance [overlap ok] IncrementRightToLeft (D4 a) (D5 a) instance [overlap ok] IncrementRightToLeft (D3 a) (D4 a) instance [overlap ok] IncrementRightToLeft (D2 a) (D3 a) instance [overlap ok] IncrementRightToLeft (D1 a) (D2 a) instance [overlap ok] IncrementRightToLeft (D0 a) (D1 a) instance [overlap ok] IncrementRightToLeft E (D1 E) instance [overlap ok] (Reverse' n (D9 a) r) => Reverse' (D9 n) a r instance [overlap ok] (Reverse' n (D8 a) r) => Reverse' (D8 n) a r instance [overlap ok] (Reverse' n (D7 a) r) => Reverse' (D7 n) a r instance [overlap ok] (Reverse' n (D6 a) r) => Reverse' (D6 n) a r instance [overlap ok] (Reverse' n (D5 a) r) => Reverse' (D5 n) a r instance [overlap ok] (Reverse' n (D4 a) r) => Reverse' (D4 n) a r instance [overlap ok] (Reverse' n (D3 a) r) => Reverse' (D3 n) a r instance [overlap ok] (Reverse' n (D2 a) r) => Reverse' (D2 n) a r instance [overlap ok] (Reverse' n (D1 a) r) => Reverse' (D1 n) a r instance [overlap ok] (Reverse' n (D0 a) r) => Reverse' (D0 n) a r instance [overlap ok] Reverse' E a a instance [overlap ok] (Reverse' x E y) => Reverse x y -- | Heterogeneous lists. This has been done many times, in many different -- ways. Explicit constructors are hidden deliberately. module Control.Concurrent.Session.Base.List data Nil :: * data Cons :: * -> * -> * -- | Find the length of a list. class TyListLength list length | list -> length tyListLength :: (TyListLength list length) => list -> length nil :: Nil cons :: (TyList n) => t -> n -> (Cons t n) modifyCons :: (TyList n1, TyList n2) => (t1 -> t2) -> (n1 -> n2) -> (Cons t1 n1) -> (Cons t2 n2) tyHead :: (Cons t n) -> t tyTail :: (Cons t n) -> n class TyList l -- | Index or update a list. When updating, the type of the new value must -- be the same as the type of the old value. class TyListIndex lst idx res | lst idx -> res tyListIndex :: (TyListIndex lst idx res) => lst -> idx -> res tyListUpdate :: (TyListIndex lst idx res) => lst -> idx -> res -> lst -- | Update a list but allow the type of the new value to be different from -- the type of the old value. class TyListUpdateVar lst1 idx val lst2 | lst1 idx val -> lst2 tyListUpdateVar :: (TyListUpdateVar lst1 idx val lst2) => lst1 -> idx -> val -> lst2 -- | Take from the head of a list. Mirrors the Prelude function -- take. class TyListTake cnt lst res | cnt lst -> res tyListTake :: (TyListTake cnt lst res) => cnt -> lst -> res -- | Drop from the head of a list. Mirrors the Prelude function -- drop. class TyListDrop cnt lst res | cnt lst -> res tyListDrop :: (TyListDrop cnt lst res) => cnt -> lst -> res -- | Append two lists together. Mirrors the Prelude function '(++)'. class TyListAppend a b c | a b -> c tyListAppend :: (TyListAppend a b c) => a -> b -> c -- | Reverse a list. class TyListReverse m n | m -> n, n -> m tyListReverse :: (TyListReverse m n) => m -> n class TyListElem lst val idx | lst val -> idx tyListElem :: (TyListElem lst val idx) => lst -> val -> idx class TyListMember lst val res | lst val -> res isTyListMember :: (TyListMember lst val res) => val -> lst -> res class TyListConsSet e set set' | e set -> set' tyListConsSet :: (TyListConsSet e set set') => e -> set -> set' class TyListToSet lst set | lst -> set tyListToSet :: (TyListToSet lst set) => lst -> set class TyListSortNums lstA lstB | lstA -> lstB tyListSortNums :: (TyListSortNums lstA lstB) => lstA -> lstB class TyListDelete lst idx lst' | lst idx -> lst' tyListDelete :: (TyListDelete lst idx lst') => idx -> lst -> lst' class TySubList smaller bigger result | smaller bigger -> result isTySubList :: (TySubList smaller bigger result) => smaller -> bigger -> result instance [overlap ok] (TyListMember b a resMember, TySubList as b resSubList, And resMember resSubList res) => TySubList (Cons a as) b res instance [overlap ok] TySubList Nil b True instance [overlap ok] (Insert num val nxt lstB, TyList lstB) => Insert' False num val (Cons (num', val') nxt) (Cons (num', val') lstB) instance [overlap ok] (TyList lstA) => Insert' True num val lstA (Cons (num, val) lstA) instance [overlap ok] (SmallerThanBool num num' isSmaller, Insert' isSmaller num val (Cons (num', val') nxt) lstB) => Insert num val (Cons (num', val') nxt) lstB instance [overlap ok] Insert num val Nil (Cons (num, val) Nil) instance [overlap ok] (TyNum num, TyListSortNums nxt lst', Insert num val lst' lst'') => TyListSortNums (Cons (num, val) nxt) lst'' instance [overlap ok] TyListSortNums Nil Nil instance [overlap ok] (TyListToSet nxt set, TyListConsSet v set set') => TyListToSet (Cons v nxt) set' instance [overlap ok] TyListToSet Nil Nil instance [overlap ok] TyListConsSet' True e set set instance [overlap ok] (TyList set) => TyListConsSet' False e set (Cons e set) instance [overlap ok] (TyListMember set e res, TyListConsSet' res e set set') => TyListConsSet e set set' instance [overlap ok] (TyListMember nxt val res) => TyListMember (Cons val' nxt) val res instance [overlap ok] TyListMember (Cons val nxt) val True instance [overlap ok] TyListMember Nil val False instance [overlap ok] (TyListTake idx lst prefix, Succ idx idxS, TyListDrop idxS lst suffix, TyListAppend prefix suffix lst') => TyListDelete lst idx lst' instance [overlap ok] (TyListReverse' nxt (Cons v acc) n, TyList acc) => TyListReverse' (Cons v nxt) acc n instance [overlap ok] TyListReverse' Nil acc acc instance [overlap ok] (TyListReverse' m Nil n) => TyListReverse m n instance [overlap ok] (Succ acc acc', TyListElem' nxt acc' val idx) => TyListElem' (Cons val' nxt) acc val idx instance [overlap ok] TyListElem' (Cons val nxt) idx val idx instance [overlap ok] (TyListElem' lst (D0 E) val idx) => TyListElem lst val idx instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D9 r) cnt') => TyListTake (D9 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D8 r) cnt') => TyListTake (D8 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D7 r) cnt') => TyListTake (D7 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D6 r) cnt') => TyListTake (D6 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D5 r) cnt') => TyListTake (D5 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D4 r) cnt') => TyListTake (D4 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D3 r) cnt') => TyListTake (D3 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D2 r) cnt') => TyListTake (D2 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] (TyListTake cnt' nxt nxt', Pred (D1 r) cnt') => TyListTake (D1 r) (Cons val nxt) (Cons val nxt') instance [overlap ok] TyListTake (D0 E) (Cons val nxt) Nil instance [overlap ok] TyListTake (D0 E) Nil Nil instance [overlap ok] (TyListDrop cnt' nxt lst, Pred cnt cnt') => TyListDrop cnt (Cons val nxt) lst instance [overlap ok] TyListDrop cnt Nil Nil instance [overlap ok] TyListDrop (D0 E) (Cons val nxt) (Cons val nxt) instance [overlap ok] (TyListAppend nxt b nxt') => TyListAppend (Cons val nxt) b (Cons val nxt') instance [overlap ok] TyListAppend Nil b b instance [overlap ok] (TyListTake idx lst1 prefix, TyListDrop idxP lst1 suffix, Succ idx idxP, TyListAppend prefix (Cons val suffix) lst2) => TyListUpdateVar lst1 idx val lst2 instance [overlap ok] (TyListIndex nxt idx' res, Pred idx idx', SmallerThanBool idx' len True, TyListLength nxt len) => TyListIndex (Cons val nxt) idx res instance [overlap ok] TyListIndex (Cons res nxt) (D0 E) res instance [overlap ok] (TyList nxt) => TyList (Cons val nxt) instance [overlap ok] TyList Nil instance [overlap ok] (TyListLength n l, Succ l l', Show n, Show t) => Show (Cons t n) instance [overlap ok] Show Nil instance [overlap ok] (TyListLength n len, Succ len len') => TyListLength (Cons t n) len' instance [overlap ok] TyListLength Nil (D0 E) -- | Heterogeneous maps at the type level. Obviously equality is done on -- types and not values. Duplicate keys are not permitted, as you'd -- expect. module Control.Concurrent.Session.Base.Map data TyMap keyToIdx idxToValue TM :: keyToIdx -> idxToValue -> TyMap keyToIdx idxToValue emptyMap :: TyMap Nil Nil -- | Insert into a map. Remember, the values are irrelevant, it's only the -- types that matter. Inserting a key that already exists is not -- permitted. class MapInsert m1 key val m2 | m1 key val -> m2 mapInsert :: (MapInsert m1 key val m2) => key -> val -> m1 -> m2 -- | lookup in a map. Will call fail in Monad if it's not there. class MapLookup mp key val | mp key -> val mapLookup :: (MapLookup mp key val) => mp -> key -> val -- | Update a map. The key must already be in the map. The value is the -- type of the value, if you see what I mean and so obviously, updating -- the map means changing the type of the value. class MapUpdate mp key val' mp' | mp key val' -> mp' mapUpdate :: (MapUpdate mp key val' mp') => mp -> key -> val' -> mp' -- | Find the size of a map. class MapSize mp size | mp -> size mapSize :: (MapSize mp size) => mp -> size tyMapKeys :: TyMap keyToIdx idxToValue -> keyToIdx class MapDelete mp key mp' | mp key -> mp' mapDelete :: (MapDelete mp key mp') => mp -> key -> mp' instance (Show keyToIdx, Show idxToValue) => Show (TyMap keyToIdx idxToValue) instance (TyListElem keyToIdx key idx, TyListTake idx keyToIdx keyToIdxPrefix, TyListTake idx idxToValue idxToValuePrefix, TyListDrop idxP keyToIdx keyToIdxSuffix, TyListDrop idxP idxToValue idxToValueSuffix, Succ idx idxP, Pred idxP idx, TyListAppend keyToIdxPrefix keyToIdxSuffix keyToIdx', TyListAppend idxToValuePrefix idxToValueSuffix idxToValue') => MapDelete (TyMap keyToIdx idxToValue) key (TyMap keyToIdx' idxToValue') instance (TyListLength keyToIdx len) => MapSize (TyMap keyToIdx idxToValue) len instance (TyListUpdateVar idxToValue idx val' idxToValue', TyListElem keyToIdx key idx, MapLookup (TyMap keyToIdx idxToValue') key val') => MapUpdate (TyMap keyToIdx idxToValue) key val' (TyMap keyToIdx idxToValue') instance (TyListElem keyToIdx key idx, TyListIndex idxToValue idx val) => MapLookup (TyMap keyToIdx idxToValue) key val instance (TyListLength keyToIdx newIdx, TyListReverse keyToIdx keyToIdxRev, TyListReverse (Cons key keyToIdxRev) keyToIdx', TyListUpdateVar idxToValue newIdx value idxToValue', TyList keyToIdxRev, MapDelete (TyMap keyToIdx' idxToValue') key (TyMap keyToIdx idxToValue)) => MapInsert' False (TyMap keyToIdx idxToValue) key value (TyMap keyToIdx' idxToValue') instance (TyListMember keyToIdx key res, MapInsert' res (TyMap keyToIdx idxToValue) key val (TyMap keyToIdx' idxToValue'), MapDelete (TyMap keyToIdx' idxToValue') key (TyMap keyToIdx idxToValue)) => MapInsert (TyMap keyToIdx idxToValue) key val (TyMap keyToIdx' idxToValue') -- | Super magic Monads. module Control.Concurrent.Session.Base.SMonad newtype SChain m x y a SChain :: (x -> m (a, y)) -> SChain m x y a runSChain :: SChain m x y a -> x -> m (a, y) -- | An extension of the typical Monad such that you track additional -- from and to parameters. Thus you can think of this -- like State where the type of the State varies. class SMonad m :: (* -> * -> * -> *) (~>>) :: (SMonad m) => m x y a -> m y z b -> m x z b (~>>=) :: (SMonad m) => m x y a -> (a -> m y z b) -> m x z b sreturn :: (SMonad m) => a -> m x x a newtype SStateT s m x y a SStateT :: (s -> m x y (a, s)) -> SStateT s m x y a runSStateT :: SStateT s m x y a -> s -> m x y (a, s) class SMonadTrans t slift :: (SMonadTrans t, SMonad m) => m x y a -> t m x y a class (SMonad m) => SMonadIO m sliftIO :: (SMonadIO m) => IO a -> m x x a class (SMonad m) => SMonadState s m | m -> s sget :: (SMonadState s m) => m x x s sput :: (SMonadState s m) => s -> m x x () ssequence_ :: (SMonad m) => [m x x a] -> m x x () ssequence :: (SMonad m) => [m x x a] -> m x x [a] sjoin :: (SMonad m) => m x y (m y z b) -> m x z b smapM :: (SMonad m) => (a -> m x x b) -> [a] -> m x x [b] smapM_ :: (SMonad m) => (a -> m x x b) -> [a] -> m x x () instance (SMonad m) => SMonadState s (SStateT s m) instance (MonadIO m) => SMonadIO (SChain m) instance SMonadTrans (SStateT s) instance (SMonad m) => SMonad (SStateT s m) instance (Monad m) => Monad (SChain m x x) instance (Monad m) => SMonad (SChain m) -- | This module is concerned with allowing you to describe a session type. -- A session type is treated as a table or 2D array, where each row -- represents a particular session type function which can refer, by -- index, to the other rows. -- -- Basically, what you have here is the ability to describe a program at -- the type level. -- -- Just look at Control.Concurrent.Session.Tests for examples module Control.Concurrent.Session.SessionType data End End :: End end :: Cons End Nil sendPid :: (TyListSortNums lst lst') => lst -> SendPid False lst' recvPid :: (TyListSortNums lst lst') => lst -> RecvPid False lst' data SendPid inverted lst SendPid :: inverted -> lst -> SendPid inverted lst data RecvPid inverted lst RecvPid :: inverted -> lst -> RecvPid inverted lst sendSession :: idx -> SendSession False idx recvSession :: idx -> RecvSession False idx data SendSession inverted idx SendSession :: inverted -> idx -> SendSession inverted idx data RecvSession inverted idx RecvSession :: inverted -> idx -> RecvSession inverted idx data Send t Send :: t -> Send t data Recv t Recv :: t -> Recv t data Jump l Jump :: l -> Jump l jump :: (TyNum n) => n -> Cons (Jump n) Nil data Select :: * -> * Select :: lstOfLabels -> Select lstOfLabels select :: (SListOfJumps (Cons val nxt)) => (Cons val nxt) -> Cons (Select (Cons val nxt)) Nil data Offer :: * -> * Offer :: lstOfLabels -> Offer lstOfLabels offer :: (SListOfJumps (Cons val nxt)) => (Cons val nxt) -> Cons (Offer (Cons val nxt)) Nil class Dual a b | a -> b, b -> a where { type family DualT a; } dual :: (Dual a b) => a -> b class SListOfJumps lst class SListOfSessionTypes lstOfLists class SNonTerminal a class STerminal a class SValidSessionType lst (~>) :: (TyList nxt, SNonTerminal a, SValidSessionType nxt) => a -> nxt -> (Cons a nxt) (~|~) :: (TyNum target, TyList nxt) => target -> nxt -> Cons (Cons (Jump target) Nil) nxt class SNoJumpsBeyond s idx class MakeListOfJumps x y | x -> y makeListOfJumps :: (MakeListOfJumps x y) => x -> y class SWellFormedConfig idxA idxB ss testWellformed :: (SWellFormedConfig idxA idxB ss) => ss -> idxA -> idxB -> Bool data Choice :: * -> * Choice :: lstOfLabels -> Choice lstOfLabels class Expand prog frag expanded | prog frag -> expanded where { type family ExpandT prog frag; } instance [overlap ok] (Show l) => Show (Jump l) instance [overlap ok] (Show inverted, Show idx) => Show (RecvSession inverted idx) instance [overlap ok] (Show inverted, Show idx) => Show (SendSession inverted idx) instance [overlap ok] (Show inverted, Show lst) => Show (RecvPid inverted lst) instance [overlap ok] (Show inverted, Show lst) => Show (SendPid inverted lst) instance [overlap ok] Show End instance [overlap ok] Expand prog (Cons End Nil) (Cons End Nil) instance [overlap ok] Expand prog (Cons (Jump l) Nil) (Cons (Jump l) Nil) instance [overlap ok] Expand prog (Cons (Offer loj) Nil) (Cons (Offer loj) Nil) instance [overlap ok] Expand prog (Cons (Select loj) Nil) (Cons (Select loj) Nil) instance [overlap ok] (Expand prog nxt nxt') => Expand prog (Cons (Recv t) nxt) (Cons (Recv t) nxt') instance [overlap ok] (Expand prog nxt nxt') => Expand prog (Cons (Send t) nxt) (Cons (Send t) nxt') instance [overlap ok] (SListOfSessionTypes ss, TyListLength ss len, SNoJumpsBeyond ss len, SmallerThanBool idxA len True, TyListIndex ss idxA st, TyListLength st len', SmallerThanBool idxB len' True) => SWellFormedConfig idxA idxB ss instance [overlap ok] (TyNum num, MakeListOfJumps nxt nxt', TyList nxt, TyList nxt') => MakeListOfJumps (Cons (num, invert) nxt) (Cons (Cons (Jump num) Nil) nxt') instance [overlap ok] MakeListOfJumps Nil Nil instance [overlap ok] (SNoJumpsBeyond val idx, SNoJumpsBeyond nxt idx) => SNoJumpsBeyond (Cons val nxt) idx instance [overlap ok] SNoJumpsBeyond Nil idx instance [overlap ok] (SNoJumpsBeyond l idx) => SNoJumpsBeyond (RecvSession inverted l) idx instance [overlap ok] (SNoJumpsBeyond l idx) => SNoJumpsBeyond (SendSession inverted l) idx instance [overlap ok] (MakeListOfJumps lol lol', SNoJumpsBeyond lol' idx) => SNoJumpsBeyond (RecvPid inverted lol) idx instance [overlap ok] (MakeListOfJumps lol lol', SNoJumpsBeyond lol' idx) => SNoJumpsBeyond (SendPid inverted lol) idx instance [overlap ok] (SNoJumpsBeyond lol idx) => SNoJumpsBeyond (Offer lol) idx instance [overlap ok] (SNoJumpsBeyond lol idx) => SNoJumpsBeyond (Select lol) idx instance [overlap ok] SNoJumpsBeyond (Recv t) idx instance [overlap ok] SNoJumpsBeyond (Send t) idx instance [overlap ok] (SmallerThanBool l idx True) => SNoJumpsBeyond (Jump l) idx instance [overlap ok] SNoJumpsBeyond End idx instance [overlap ok] (SValidSessionType nxt, SNonTerminal val) => SValidSessionType (Cons val nxt) instance [overlap ok] (STerminal a) => SValidSessionType (Cons a Nil) instance [overlap ok] (SListOfJumps (Cons val nxt)) => STerminal (Offer (Cons val nxt)) instance [overlap ok] (SListOfJumps (Cons val nxt)) => STerminal (Select (Cons val nxt)) instance [overlap ok] (TyNum l) => STerminal (Jump l) instance [overlap ok] STerminal End instance [overlap ok] (SValidSessionType idx) => SNonTerminal (RecvSession inverted idx) instance [overlap ok] (SValidSessionType idx) => SNonTerminal (SendSession inverted idx) instance [overlap ok] SNonTerminal (RecvPid inverted t) instance [overlap ok] SNonTerminal (SendPid inverted t) instance [overlap ok] SNonTerminal (Recv t) instance [overlap ok] SNonTerminal (Send t) instance [overlap ok] (SValidSessionType val, SListOfSessionTypes nxt) => SListOfSessionTypes (Cons val nxt) instance [overlap ok] SListOfSessionTypes Nil instance [overlap ok] (SListOfJumps nxt, TyNum val) => SListOfJumps (Cons (Cons (Jump val) Nil) nxt) instance [overlap ok] SListOfJumps Nil instance [overlap ok] (TyList nxt, TyList nxt', Dual val val', Dual nxt nxt') => Dual (Cons val nxt) (Cons val' nxt') instance [overlap ok] Dual Nil Nil instance [overlap ok] (Not inverted inverted') => Dual (RecvSession inverted idx) (SendSession inverted' idx) instance [overlap ok] (Not inverted inverted') => Dual (SendSession inverted idx) (RecvSession inverted' idx) instance [overlap ok] Dual (Offer lst) (Select lst) instance [overlap ok] Dual (Select lst) (Offer lst) instance [overlap ok] (Not inverted inverted') => Dual (RecvPid inverted lst) (SendPid inverted' lst) instance [overlap ok] (Not inverted inverted') => Dual (SendPid inverted lst) (RecvPid inverted' lst) instance [overlap ok] Dual (Recv t) (Send t) instance [overlap ok] Dual (Send t) (Recv t) instance [overlap ok] Dual (Jump l) (Jump l) instance [overlap ok] Dual End End module Control.Concurrent.Session.Types data Cell :: * -> * Cell :: val -> MVar (Cell nxt) -> Cell (Cons val nxt) SelectCell :: Int -> Cell (Cons (Choice jumps) Nil) data ProgramCell :: * -> * ProgramCell :: MVar a -> MVar (ProgramCell a) -> ProgramCell a class ProgramToMVarsOutgoing progRef prog mvars | progRef prog -> mvars where { type family ProgramToMVarsOutgoingT progRef prog; } programToMVarsOutgoing :: (ProgramToMVarsOutgoing progRef prog mvars) => progRef -> prog -> IO mvars data SessionState :: * -> * -> * -> * SessionState :: progOut -> progIn -> current -> MVar (Maybe (Chan ())) -> (MVar (Cell currentOutgoing)) -> MVar (Maybe (Chan ())) -> (MVar (Cell currentIncoming)) -> SessionState prog prog' (current, currentOutgoing, currentIncoming) -- | The representation of a computation that performs work using session -- types. Again, really quite similar to a more-parameterized State -- monad. newtype SessionChain prog prog' from to res SessionChain :: ((SessionState prog prog' from) -> IO (res, SessionState prog prog' to)) -> SessionChain prog prog' from to res runSessionChain :: SessionChain prog prog' from to res -> (SessionState prog prog' from) -> IO (res, SessionState prog prog' to) type RawPid = [Int] -- | A process ID. This is a tiny bit like ThreadId but rather heavily -- annotated. data Pid :: * -> * -> * -> * -> * -> * Pid :: RawPid -> TyMap sessionsToIdx idxsToPairStructs -> Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs data InternalPid :: * -> * -> * -> * -> * -> * IPid :: Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs -> [RawPid] -> InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs pidToRawPid :: Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs -> RawPid iPidToPid :: InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs -> Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs -- | Provides a way to compare two Pids. Of course, if the Pids have -- different type params, then they are definitely different, but it's -- still convenient to be able to do something like (==) on them. class PidEq a b (=~=) :: (PidEq a b) => a -> b -> Bool newtype InterleavedChain internalPid from to res InterleavedChain :: (internalPid -> from -> IO (res, to, internalPid)) -> InterleavedChain internalPid from to res runInterleavedChain :: InterleavedChain internalPid from to res -> internalPid -> from -> IO (res, to, internalPid) data SpecialSession data SpecialPid data SpecialNormal data PairStruct :: * -> * -> * -> * -> * PS :: RawPid -> (SessionState prog prog' (Cons (Jump init) Nil, Cons (Jump init) Nil, Cons (Jump init) Nil) -> IO ()) -> PairStruct init prog prog' (Cons (Jump init) Nil, Cons (Jump init) Nil, Cons (Jump init) Nil) instance Ord (PairStruct init prog prog' start) instance Eq (PairStruct init prog prog' start) instance SMonadIO (InterleavedChain internalPid) instance SMonad (InterleavedChain internalPid) instance PidEq (Pid progA progA' invertedSessionsA sessionsToIdxA idxsToPairStructsA) (Pid progB progB' invertedSessionsB sessionsToIdxB idxsToPairStructsB) instance Ord (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) instance Eq (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) instance Ord (Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) instance Eq (Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) instance Show (Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) instance SMonadIO (SessionChain prog prog') instance SMonad (SessionChain prog prog') instance (Outgoing val'' ~ val', ProgramToMVarsOutgoing ref nxt nxt', TyList nxt, TyList nxt', Expand ref val val'') => ProgramToMVarsOutgoing ref (Cons val nxt) (Cons (MVar (ProgramCell (Cell val'))) nxt') instance ProgramToMVarsOutgoing ref Nil Nil module Control.Concurrent.Session.SessionTypeMonad data TypeState :: * -> * -> * -> * -> * TypeState :: nxtLabel -> declareable -> useable -> st -> TypeState nxtLabel declareable useable st newtype SessionType f t r SessionType :: (f -> (r, t)) -> SessionType f t r buildSessionType :: SessionType f t r -> f -> (r, t) newLabel :: (Succ nxtLabel nxtLabel', TyListConsSet nxtLabel declareable declareable', TyListConsSet nxtLabel useable useable') => SessionType (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable' useable' st) nxtLabel declareLabel :: (TyListMember declareable label True, TyListElem declareable label idx, TyListDelete declareable idx declareable', TyList st) => label -> (SessionType (TypeState nxtLabel declareable' useable (Cons (label, Nil) st)) (TypeState nxtLabel' declareable'' useable' st') a) -> SessionType (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable'' useable' st') a (.=) :: (TyListMember declareable label True, TyListElem declareable label idx, TyListDelete declareable idx declareable', TyList st) => label -> (SessionType (TypeState nxtLabel declareable' useable (Cons (label, Nil) st)) (TypeState nxtLabel' declareable'' useable' st') a) -> SessionType (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable'' useable' st') a send :: (TyList f, TyList fs) => t -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (Send (SpecialNormal, t)) f) fs)) () recv :: (TyList f, TyList fs) => t -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (Recv (SpecialNormal, t)) f) fs)) () sendPid :: (TyList f, TyList fs, TyListSortNums lst lst') => lst -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (SendPid False lst') f) fs)) () recvPid :: (TyList f, TyList fs, TyListSortNums lst lst') => lst -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (RecvPid False lst') f) fs)) () sendSession :: (TyList f, TyList fs, TyList fs', TyListReverse frag fragRev, TyListTake (D1 E) fragRev (Cons (label, fragHead) Nil), TyListDrop (D1 E) fragRev fragTailRev, TyListReverse fragTailRev fragTail, TyListAppend fragTail fs fs') => SessionType (TypeState nxtLabel declareable useable (Cons (label, Nil) Nil)) (TypeState nxtLabel' declareable' useable' frag) res -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel' declareable' useable' (Cons (label, Cons (SendSession False fragHead) f) fs')) res recvSession :: (TyList f, TyList fs, TyList fs', TyListReverse frag fragRev, TyListTake (D1 E) fragRev (Cons (label, fragHead) Nil), TyListDrop (D1 E) fragRev fragTailRev, TyListReverse fragTailRev fragTail, TyListAppend fragTail fs fs') => SessionType (TypeState nxtLabel declareable useable (Cons (label, Nil) Nil)) (TypeState nxtLabel' declareable' useable' frag) res -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel' declareable' useable' (Cons (label, Cons (RecvSession False fragHead) f) fs')) res end :: (TyListReverse (Cons End f) f', TyList f, TyList fs) => SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, f') fs)) () jump :: (TyListReverse (Cons (Jump jt) f) f', TyList f, TyList fs, TyListMember useable jt True) => jt -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, f') fs)) () data BranchesList :: * -> * -> * -> * -> * -> * BLNil :: BranchesList Nil Nil z z z BLCons :: (SessionType (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable' useable' st') (resLst -> Cons res resLst, labs -> Cons (Cons (Jump nxtLabel) Nil) labs)) -> (BranchesList resLst labs (TypeState nxtLabel' declareable' useable' st') to finalTo) -> BranchesList (Cons res resLst) (Cons (Cons (Jump nxtLabel) Nil) labs) (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable' useable' st', to) finalTo (~|~) :: (Succ label nxtLabel, TyListConsSet label declareable declareable', TyListElem declareable' label idx, TyListDelete declareable' idx declareable'', TyListConsSet label useable useable', TyList st, TyListMember declareable' label True, TyList labs, TyList resLst) => (SessionType (TypeState nxtLabel declareable'' useable' (Cons (label, Nil) st)) (TypeState nxtLabel' declareable''' useable'' st') res) -> (BranchesList resLst labs (TypeState nxtLabel' declareable''' useable'' st') to finalTo) -> (BranchesList (Cons res resLst) (Cons (Cons (Jump label) Nil) labs) (TypeState label declareable useable st) (TypeState nxtLabel' declareable''' useable'' st', to) finalTo) class BuildBranches bl st buildBranches :: (BuildBranches bl st) => bl -> st select :: (TyListReverse (Cons (Select listOfJumps) f) f', TyList f, TyList fs, BuildBranches (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) (SessionType (TypeState nxtLabel declareable useable (Cons (label, f') fs)) finalTo (listOfRes, listOfJumps))) => (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) -> (SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) finalTo listOfRes) offer :: (TyListReverse (Cons (Offer listOfJumps) f) f', TyList f, TyList fs, BuildBranches (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) (SessionType (TypeState nxtLabel declareable useable (Cons (label, f') fs)) finalTo (listOfRes, listOfJumps))) => (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) -> (SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) finalTo listOfRes) currentLabel :: SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, f) fs)) label makeSessionType :: (TyListSortNums st st', TyListSnd st' st'') => SessionType (TypeState (D0 E) Nil Nil Nil) (TypeState nxtLabel Nil useable st) res -> (st'', res) class TyListSnd lstA lstB | lstA -> lstB tyListSnd :: (TyListSnd lstA lstB) => lstA -> lstB dual :: True notDual :: False instance (TyListSnd nxt nxt', TyList nxt, TyList nxt') => TyListSnd (Cons (a, b) nxt) (Cons b nxt') instance TyListSnd Nil Nil instance (BuildBranches (BranchesList resLst labs (TypeState nxtLabel' declareable' useable' st') to finalTo) (SessionType (TypeState nxtLabel' declareable' useable' st') finalTo (resLst, labs))) => BuildBranches (BranchesList (Cons res resLst) (Cons (Cons (Jump nxtLabel) Nil) labs) (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable' useable' st', to) finalTo) (SessionType (TypeState nxtLabel declareable useable st) finalTo (Cons res resLst, Cons (Cons (Jump nxtLabel) Nil) labs)) instance BuildBranches (BranchesList Nil Nil (TypeState nxtLabel declareLabel useable st) (TypeState nxtLabel declareLabel useable st) (TypeState nxtLabel declareLabel useable st)) (SessionType (TypeState nxtLabel declareLabel useable st) (TypeState nxtLabel declareLabel useable st) (Nil, Nil)) instance SMonad SessionType -- | Having actually described a session type, you'll now want to implement -- it! Use the methods of SMonad to chain functions together. module Control.Concurrent.Session.Runtime -- | Use OfferImpls to construct the implementations of the branches of an -- offer. Really, it's just a slightly fancy list. data OfferImpls :: * -> * -> * -> * -> * -> * OfferImplsNil :: OfferImpls Nil prog prog' finalState finalResult -- | Use to construct OfferImpls. This function automatically adds the -- necessary sjump to the start of each branch implementation. (~||~) :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig l (D0 E) prog, SWellFormedConfig l (D0 E) prog', TyListIndex progOut l (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn l (MVar (ProgramCell (Cell incoming))), TyListIndex prog l currentUX, Expand prog currentUX current) => (SessionChain prog prog' (current, outgoing, incoming) finalState finalResult) -> (OfferImpls jumps prog prog' finalState finalResult) -> (OfferImpls (Cons (Cons (Jump l) Nil) jumps) prog prog' finalState finalResult) -- | Perform a jump. Now you may think that you should indicate where you -- want to jump to. But of course, that's actually specified by the -- session type so you don't have to specify it at all in the -- implementation. sjump :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, SWellFormedConfig l (D0 E) prog, SWellFormedConfig l (D0 E) prog', TyListIndex progOut l (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn l (MVar (ProgramCell (Cell incoming))), TyListIndex prog l currentUX, Expand prog currentUX current) => (SessionChain prog prog') (Cons (Jump l) Nil, Cons (Jump l) Nil, Cons (Jump l) Nil) (current, outgoing, incoming) () -- | Send a value to the other party. Of course, the value must be of the -- correct type indicated in the session type. ssend :: (CompatibleTypes sp t' t) => t' -> SessionChain prog prog' (Cons (Send (sp, t)) nxtCur, Cons t nxtOut, incoming) (nxtCur, nxtOut, incoming) () class CompatibleTypes special a b | special a -> b, special b -> a convert :: (CompatibleTypes special a b) => special -> a -> b -- | Recieve a value from the other party. This will block as necessary. -- The type of the value received is specified by the session type. No -- magic coercion needed. srecv :: (SessionChain prog prog') (Cons (Recv (sp, t)) nxt, outgoing, Cons t nxt') (nxt, outgoing, nxt') t -- | Offer a number of branches. This is basically an external choice - the -- other party uses sselect to decide which branch to take. Use -- OfferImpls in order to construct the list of implementations of -- branches. Note that every implementation must result in the same final -- state and emit the same value. soffer :: OfferImpls jumps prog prog' (current, outgoing, incoming) finalResult -> (SessionChain prog prog') (Cons (Offer jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) (current, outgoing, incoming) finalResult -- | Select which branch we're taking at a branch point. Use a type number -- (Control.Concurrent.Session.Number) to indicate the branch to -- take. sselect :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, TyListLength jumps len, SmallerThanBool label len True, TypeNumberToInt label, TyListIndex jumps label (Cons (Jump jumpTarget) Nil), SWellFormedConfig jumpTarget (D0 E) prog, SWellFormedConfig jumpTarget (D0 E) prog', TyListIndex progOut jumpTarget (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn jumpTarget (MVar (ProgramCell (Cell incoming))), TyListIndex prog jumpTarget currentUX, Expand prog currentUX current) => label -> (SessionChain prog prog') (Cons (Select jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) (current, outgoing, incoming) () -- | Run! Provide a program and a start point within that program (which is -- automatically sjumped to), the two implementations which must -- be duals of each other, run them, have them communicate, wait until -- they both finish and die and then return the results from both of -- them. run :: (ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, (ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), (DualT prog) ~ prog', Dual prog prog', TyListIndex prog init currentUX, Expand prog currentUX current, TyListIndex prog' init currentUX', Expand prog' currentUX' current') => prog -> init -> SessionChain prog prog' (current, fromO, fromI) (toCur, toO, toI) res -> SessionChain prog' prog (current', fromI, fromO) (toCur', toI, toO) res' -> IO (res, res') carefullySwapToNextCell :: MVar (ProgramCell a) -> IO (ProgramCell a) instance CompatibleTypes SpecialSession t t instance CompatibleTypes SpecialNormal t t instance (ReducePairStructs (TyMap origKeys origVals) (TyMap keys vals') (TyMap accKeys' accVals') result, MapInsert (TyMap accKeys accVals) key val (TyMap accKeys' accVals'), MapLookup (TyMap origKeys origVals) key val, MapLookup (TyMap (Cons key keys) vals) key val, MapDelete (TyMap (Cons key keys) vals) key (TyMap keys vals'), TyListElem origKeys key idx, TyListIndex origKeys idx key) => ReducePairStructs (TyMap origKeys origVals) (TyMap (Cons key keys) vals) (TyMap accKeys accVals) result instance ReducePairStructs orig (TyMap Nil Nil) acc acc instance (TySubList invertedSessionsB invertedSessionsA True, TySubList sessionsToIdxB sessionsToIdxA True, ReducePairStructs (TyMap sessionsToIdxA idxsToPairStructsA) (TyMap sessionsToIdxB idxsToPairStructsB) (TyMap Nil Nil) (TyMap sessionsToIdxB idxsToPairStructsB)) => CompatibleTypes SpecialPid (Pid prog prog' invertedSessionsA sessionsToIdxA idxsToPairStructsA) (Pid prog prog' invertedSessionsB sessionsToIdxB idxsToPairStructsB) instance (Outgoing current ~ outgoing, Outgoing current' ~ incoming, Dual prog prog', Expand prog' frag current, Dual frag frag', Expand prog' frag' current') => ExpandSession prog (RecvSession True frag) (Recv (SpecialSession, SessionState prog' prog (current, outgoing, incoming))) instance (Outgoing current ~ outgoing, Outgoing current' ~ incoming, Dual prog prog', Expand prog frag current, Dual frag frag', Expand prog frag' current') => ExpandSession prog (RecvSession False frag) (Recv (SpecialSession, SessionState prog prog' (current, outgoing, incoming))) instance (Outgoing current ~ outgoing, Outgoing current' ~ incoming, Dual prog prog', Expand prog' frag current, Dual frag frag', Expand prog' frag' current') => ExpandSession prog (SendSession True frag) (Send (SpecialSession, SessionState prog' prog (current, outgoing, incoming))) instance (Outgoing current ~ outgoing, Outgoing current' ~ incoming, Dual prog prog', Expand prog frag current, Dual frag frag', Expand prog frag' current') => ExpandSession prog (SendSession False frag) (Send (SpecialSession, SessionState prog prog' (current, outgoing, incoming))) instance (Expand prog nxt nxt', ExpandSession prog (RecvSession invert frag) expandedRecvSession) => Expand prog (Cons (RecvSession invert frag) nxt) (Cons expandedRecvSession nxt') instance (Expand prog nxt nxt', ExpandSession prog (SendSession invert frag) expandedSendSession) => Expand prog (Cons (SendSession invert frag) nxt) (Cons expandedSendSession nxt') instance WalkOfferImpls prog prog' finalState finalResult -- | Defines what a Pid is and provides functionality to create new -- sessions channels to a given pid. Obviously this is safe/ in -- some way - in particular, a Pid carries about with it the set of -- Session Types it is willing to use. This means that you can't try to -- start any old Session Type with any given Pid. However, it doesn't -- mean that given an acceptable Session Type, the other thread will ever -- actually get around to agreeing to create the new session / channel -- with you. module Control.Concurrent.Session.Pid makePid :: InternalPid prog prog' invertedSessionsO sessionsToIdxO idxsToPairStructsO -> invertedSessionsN -> TyMap sessionsToIdxN idxsToPairStructsN -> (InternalPid prog prog' invertedSessionsO sessionsToIdxO idxsToPairStructsO, InternalPid prog prog' invertedSessionsN sessionsToIdxN idxsToPairStructsN) rootPid :: (Dual prog prog', (DualT prog) ~ prog') => TyMap sessionsToIdx idxsToPairStructs -> invertedSessions -> prog -> InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs iPidToPid :: InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs -> Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs myPid :: InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) from from (Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) class BuildPidTyMap prog stlst tymap | prog stlst -> tymap where { type family BuildPidTyMapT prog stlst; } buildPidTyMap :: (BuildPidTyMap prog stlst tymap) => prog -> stlst -> IO tymap class BuildInvertedSessionsSet stlist set | stlist -> set where { type family BuildInvertedSessionsSetT stlist; } buildInvertedSessionsSet :: (BuildInvertedSessionsSet stlist set) => stlist -> set -- | Provides the ability to make a new session / channel with the given -- Pid. Supply the index to the Session Type, whether or not you're -- locally inverting (dualing) the Session Type, and the Pid, and so long -- as the Pid supports the dual of your local Session Type, this will -- block until the Pid gets around to servicing you. Thus this is a -- synchronous operation and both Pids must know of each other to create -- a new session / channel between them. class CreateSession invert init prog prog' sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem createSession :: (CreateSession invert init prog prog' sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem) => init -> invert -> Pid prog prog' invertedSessionsThem sessionsToIdxThem idxsToPairStructsThem -> InterleavedChain (InternalPid prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe) (TyMap keyToIdxMe idxToValueMe) (TyMap keyToIdxMe' idxToValueMe') idxOfThem -- | Provides a way to compare two Pids. Of course, if the Pids have -- different type params, then they are definitely different, but it's -- still convenient to be able to do something like (==) on them. class PidEq a b (=~=) :: (PidEq a b) => a -> b -> Bool data MultiReceive :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * MultiReceiveNil :: MultiReceive Nil prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res (~|||~) :: (MapLookup (TyMap keyToIdx idxToValue) ch (SessionState progS progS' (Cons (Recv (sp, t)) nxt, fromO, Cons t nxt'))) => (ch, InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue') res) -> MultiReceive chs prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res -> MultiReceive (Cons ch chs) prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res multiReceive :: (TyListLength chs len, SmallerThanBool (D0 E) len True, SetIncomingNotify (TyMap keyToIdx idxToValue) chs, FindNonEmptyIncoming (TyMap keyToIdx idxToValue) chs, TypeNumberToInt len) => (MultiReceive chs prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res) -> InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue') res instance (FindNonEmptyIncoming (TyMap keyToIdx idxToValue) nxt, MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current, fromO, fromI)), TypeNumberToInt idx) => FindNonEmptyIncoming (TyMap keyToIdx idxToValue) (Cons idx nxt) instance FindNonEmptyIncoming mp Nil instance WalkMultiReceives chs prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res instance (MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current, fromO, fromI)), SetIncomingNotify (TyMap keyToIdx idxToValue) nxt, TypeNumberToInt idx) => SetIncomingNotify (TyMap keyToIdx idxToValue) (Cons idx nxt) instance SetIncomingNotify mp Nil instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), TyListIndex prog init currentUX, Expand prog currentUX current, TyListIndex prog' init currentUX', Expand prog' currentUX' current', MapLookup (TyMap sessionsToIdxThem idxsToPairStructsThem) init (MVar (Map (RawPid, RawPid) (MVar (PairStruct init prog prog' (Cons (Jump init) Nil, Cons (Jump init) Nil, Cons (Jump init) Nil))))), TyListMember invertedSessionsMe init True, MapSize (TyMap keyToIdxMe idxToValueMe) idxOfThem, MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfThem (SessionState prog' prog (current', fromI, fromO)) (TyMap keyToIdxMe' idxToValueMe')) => CreateSession True init prog prog' sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), TyListIndex prog init current', Expand prog current' current, MapLookup (TyMap sessionsToIdxMe idxsToPairStructsMe) init (MVar (Map (RawPid, RawPid) (MVar (PairStruct init prog prog' (Cons (Jump init) Nil, Cons (Jump init) Nil, Cons (Jump init) Nil))))), TyListMember invertedSessionsThem init True, MapSize (TyMap keyToIdxMe idxToValueMe) idxOfThem, MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfThem (SessionState prog prog' (current, fromO, fromI)) (TyMap keyToIdxMe' idxToValueMe')) => CreateSession False init prog prog' sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem instance (Dual prog prog', BuildInvertedSessionsSet idxs invertedSessions, BuildPidTyMap prog' idxs (TyMap sessionsToIdx idxsToPairStructs)) => ExpandPid prog (RecvPid True idxs) (Recv (SpecialPid, Pid prog' prog invertedSessions sessionsToIdx idxsToPairStructs)) instance (Dual prog prog', BuildInvertedSessionsSet idxs invertedSessions, BuildPidTyMap prog idxs (TyMap sessionsToIdx idxsToPairStructs)) => ExpandPid prog (RecvPid False idxs) (Recv (SpecialPid, Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs)) instance (Dual prog prog', BuildInvertedSessionsSet idxs invertedSessions, BuildPidTyMap prog' idxs (TyMap sessionsToIdx idxsToPairStructs)) => ExpandPid prog (SendPid True idxs) (Send (SpecialPid, Pid prog' prog invertedSessions sessionsToIdx idxsToPairStructs)) instance (Dual prog prog', BuildInvertedSessionsSet idxs invertedSessions, BuildPidTyMap prog idxs (TyMap sessionsToIdx idxsToPairStructs)) => ExpandPid prog (SendPid False idxs) (Send (SpecialPid, Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs)) instance (Expand prog nxt nxt', ExpandPid prog (RecvPid invert idxs) expandedRecvPid) => Expand prog (Cons (RecvPid invert idxs) nxt) (Cons expandedRecvPid nxt') instance (Expand prog nxt nxt', ExpandPid prog (SendPid invert idxs) expandedSendPid) => Expand prog (Cons (SendPid invert idxs) nxt) (Cons expandedSendPid nxt') instance (BuildInvertedSessionsSet nxt set, TyList set) => BuildInvertedSessionsSet (Cons (init, True) nxt) (Cons init set) instance (BuildInvertedSessionsSet nxt set) => BuildInvertedSessionsSet (Cons (init, False) nxt) set instance BuildInvertedSessionsSet Nil Nil instance (BuildPidTyMap' prog nxt (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue'), TyList nxt) => BuildPidTyMap' prog (Cons (init, True) nxt) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue') instance (BuildPidTyMap' prog nxt (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue'), MapInsert (TyMap keyToIdx' idxToValue') init (MVar (Map (RawPid, RawPid) (MVar (PairStruct init prog prog' (Cons (Jump init) Nil, Cons (Jump init) Nil, Cons (Jump init) Nil))))) (TyMap keyToIdx'' idxToValue''), TyList nxt) => BuildPidTyMap' prog (Cons (init, False) nxt) (TyMap keyToIdx idxToValue) (TyMap keyToIdx'' idxToValue'') instance BuildPidTyMap' prog Nil acc acc instance (BuildPidTyMap' prog stlst (TyMap Nil Nil) tymap) => BuildPidTyMap prog stlst tymap -- | A single thread should be able to have multiple concurrent -- conversations with other threads. So this module places -- InterleavedChain as an instance of SMonad, and equipts -- it with the capability to manage and modify a mapping of channels to -- other threads. Note there is some danger in here. Deadlocks can start -- to appear if you're silly or deliberately mean. However, this is -- starting to get towards the Actor / Erlang model of message passing. module Control.Concurrent.Session.Interleaving -- | Perform the given actions on the given channel. Note that the value -- emitted by the actions will be passed out. withChannel :: (MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current, fromO, fromI)), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current', toO, toI)) (TyMap keyToIdx idxToValue'), MapDelete (TyMap keyToIdx idxToValue) idx (TyMap keyToIdx'' idxToValue''), MapDelete (TyMap keyToIdx idxToValue') idx (TyMap keyToIdx'' idxToValue'')) => idx -> SessionChain prog prog' (current, fromO, fromI) (current', toO, toI) res -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx idxToValue') res -- | Think of this as spawn or fork - it creates a child -- thread which must be prepared to communicate with you. You get a -- channel set up to the child which is emitted by this function. The -- child is first told about the channel back to you and your Pid. The -- child can go off and do what ever it wants, including creating -- additional channels. The child starts off knowing with only one open -- channel which is to the parent. class Fork invert init sessionsList prog prog' sessionsToIdxThem idxsToPairStructsThem sessionsToIdxMe idxsToPairStructsMe fromO fromI progOut progIn keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' keyToIdxChild' idxToValueChild' keyToIdxChild'' idxToValueChild'' idxOfChild current current' currentUX currentUX' invertedSessionsMe invertedSessionsThem fork :: (Fork invert init sessionsList prog prog' sessionsToIdxThem idxsToPairStructsThem sessionsToIdxMe idxsToPairStructsMe fromO fromI progOut progIn keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' keyToIdxChild' idxToValueChild' keyToIdxChild'' idxToValueChild'' idxOfChild current current' currentUX currentUX' invertedSessionsMe invertedSessionsThem) => init -> invert -> sessionsList -> ((D0 E) -> Pid prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe -> InterleavedChain (InternalPid prog prog' invertedSessionsThem sessionsToIdxThem idxsToPairStructsThem) (TyMap keyToIdxChild' idxToValueChild') (TyMap keyToIdxChild'' idxToValueChild'') ()) -> InterleavedChain (InternalPid prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe) (TyMap keyToIdxMe idxToValueMe) (TyMap keyToIdxMe' idxToValueMe') (idxOfChild, Pid prog prog' invertedSessionsThem sessionsToIdxThem idxsToPairStructsThem) -- | Run the root. Use this to start up a family from a single root. runInterleaved :: (BuildPidTyMap prog sessionsListSorted (TyMap sessionsToIdx idxsToPairStructs), TyListSortNums sessionsList sessionsListSortedRev, TyListReverse sessionsListSortedRev sessionsListSorted, BuildInvertedSessionsSet sessionsListSorted invertedSessions, Dual prog prog', (DualT prog) ~ prog') => sessionsList -> prog -> InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap Nil Nil) (TyMap keyToIdx idxToValue) res -> IO res -- | Convenience combination of withChannel and sjump sjumpCh :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, SWellFormedConfig l (D0 E) prog, SWellFormedConfig l (D0 E) prog', TyListIndex progOut l (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn l (MVar (ProgramCell (Cell incoming))), TyListIndex prog l current', Expand prog current' current, MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (Cons (Jump l) Nil, Cons (Jump l) Nil, Cons (Jump l) Nil)), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current, outgoing, incoming)) (TyMap keyToIdx idxToValue'), MapDelete (TyMap keyToIdx idxToValue) idx (TyMap keyToIdx'' idxToValue''), MapDelete (TyMap keyToIdx idxToValue') idx (TyMap keyToIdx'' idxToValue'')) => idx -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx idxToValue') () -- | Convenience combination of withChannel and ssend ssendCh :: (MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (Cons (Send (sp, t)) nxt, Cons t nxt', incoming)), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (nxt, nxt', incoming)) (TyMap keyToIdx idxToValue'), MapDelete (TyMap keyToIdx idxToValue) idx (TyMap keyToIdx'' idxToValue''), MapDelete (TyMap keyToIdx idxToValue') idx (TyMap keyToIdx'' idxToValue''), CompatibleTypes sp t' t) => idx -> t' -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx idxToValue') () -- | Convenience combination of withChannel and srecv srecvCh :: (MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (Cons (Recv (sp, t)) nxt, outgoing, Cons t nxt')), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (nxt, outgoing, nxt')) (TyMap keyToIdx idxToValue'), MapDelete (TyMap keyToIdx idxToValue) idx (TyMap keyToIdx'' idxToValue''), MapDelete (TyMap keyToIdx idxToValue') idx (TyMap keyToIdx'' idxToValue'')) => idx -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx idxToValue') t -- | Convenience combination of withChannel and soffer sofferCh :: (MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (Cons (Offer jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil)), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current, outgoing, incoming)) (TyMap keyToIdx idxToValue'), MapDelete (TyMap keyToIdx idxToValue) idx (TyMap keyToIdx'' idxToValue''), MapDelete (TyMap keyToIdx idxToValue') idx (TyMap keyToIdx'' idxToValue'')) => idx -> OfferImpls jumps prog prog' (current, outgoing, incoming) finalResult -> InterleavedChain (InternalPid pidProg pidProg' sessionsToIdx invertedSessions idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx idxToValue') finalResult -- | Convenience combination of withChannel and sselectCh sselectCh :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (Cons (Select jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil)), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (current, outgoing, incoming)) (TyMap keyToIdx idxToValue'), TyListLength jumps len, SmallerThanBool label len True, TypeNumberToInt label, TyListIndex jumps label (Cons (Jump jumpTarget) Nil), SWellFormedConfig jumpTarget (D0 E) prog, SWellFormedConfig jumpTarget (D0 E) prog', TyListIndex progOut jumpTarget (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn jumpTarget (MVar (ProgramCell (Cell incoming))), TyListIndex prog jumpTarget currentUX, Expand prog currentUX current, MapDelete (TyMap keyToIdx idxToValue) idx (TyMap keyToIdx'' idxToValue''), MapDelete (TyMap keyToIdx idxToValue') idx (TyMap keyToIdx'' idxToValue'')) => idx -> label -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx idxToValue') () scloseCh :: (MapDelete (TyMap keyToIdx idxToValue) ch (TyMap keyToIdx' idxToValue'), MapLookup (TyMap keyToIdx idxToValue) ch (SessionState prog prog' (Cons End Nil, outgoing, incoming))) => ch -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue') () sendChannel :: (MapLookup (TyMap keyToIdx idxToValue) chToSend (SessionState prog prog' (current, outgoing, incoming)), MapLookup (TyMap keyToIdx idxToValue) chOnWhichToSend (SessionState prog'' prog''' (Cons (Send (SpecialSession, SessionState prog prog' (current, outgoing, incoming))) nxt, Cons (SessionState prog prog' (current, outgoing, incoming)) nxt', incoming')), MapUpdate (TyMap keyToIdx idxToValue) chOnWhichToSend (SessionState prog'' prog''' (nxt, nxt', incoming')) (TyMap keyToIdx idxToValue'), MapDelete (TyMap keyToIdx idxToValue') chToSend (TyMap keyToIdx' idxToValue'')) => chToSend -> chOnWhichToSend -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue'') () recvChannel :: (MapLookup (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (Cons (Recv (SpecialSession, SessionState prog'' prog''' (current', outgoing', incoming'))) nxt, outgoing, Cons (SessionState prog'' prog''' (current', outgoing', incoming')) nxt')), MapUpdate (TyMap keyToIdx idxToValue) idx (SessionState prog prog' (nxt, outgoing, nxt')) (TyMap keyToIdx idxToValue'), MapSize (TyMap keyToIdx idxToValue') idx', MapInsert (TyMap keyToIdx idxToValue') idx' (SessionState prog'' prog''' (current', outgoing', incoming')) (TyMap keyToIdx' idxToValue'')) => idx -> InterleavedChain (InternalPid pidProg pidProg' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue'') idx' instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), TyListIndex prog init currentUX, TyListIndex prog' init currentUX', Expand prog currentUX current, Expand prog' currentUX' current', BuildPidTyMap prog sessionsListSorted (TyMap sessionsToIdxThem idxsToPairStructsThem), BuildInvertedSessionsSet sessionsListSorted invertedSessionsThem, TyListSortNums sessionsList sessionsListSortedRev, TyListReverse sessionsListSortedRev sessionsListSorted, MapSize (TyMap keyToIdxMe idxToValueMe) idxOfChild, MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfChild (SessionState prog' prog (current', fromI, fromO)) (TyMap keyToIdxMe' idxToValueMe'), MapInsert (TyMap Nil Nil) (D0 E) (SessionState prog prog' (current, fromO, fromI)) (TyMap keyToIdxChild' idxToValueChild')) => Fork True init sessionsList prog prog' sessionsToIdxThem idxsToPairStructsThem sessionsToIdxMe idxsToPairStructsMe fromO fromI progOut progIn keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' keyToIdxChild' idxToValueChild' keyToIdxChild'' idxToValueChild'' idxOfChild current current' currentUX currentUX' invertedSessionsMe invertedSessionsThem instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), TyListIndex prog init currentUX, TyListIndex prog' init currentUX', Expand prog currentUX current, Expand prog' currentUX' current', BuildPidTyMap prog sessionsListSorted (TyMap sessionsToIdxThem idxsToPairStructsThem), BuildInvertedSessionsSet sessionsListSorted invertedSessionsThem, TyListSortNums sessionsList sessionsListSortedRev, TyListReverse sessionsListSortedRev sessionsListSorted, MapSize (TyMap keyToIdxMe idxToValueMe) idxOfChild, MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfChild (SessionState prog prog' (current, fromO, fromI)) (TyMap keyToIdxMe' idxToValueMe'), MapInsert (TyMap Nil Nil) (D0 E) (SessionState prog' prog (current', fromI, fromO)) (TyMap keyToIdxChild' idxToValueChild')) => Fork False init sessionsList prog prog' sessionsToIdxThem idxsToPairStructsThem sessionsToIdxMe idxsToPairStructsMe fromO fromI progOut progIn keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' keyToIdxChild' idxToValueChild' keyToIdxChild'' idxToValueChild'' idxOfChild current current' currentUX currentUX' invertedSessionsMe invertedSessionsThem module Control.Concurrent.Session.Network.Socket runOverNetwork :: (ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, (ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), (DualT prog) ~ prog', Dual prog prog', TyListIndex prog init currentUX, Expand prog currentUX current, TyListIndex prog' init currentUX', Expand prog' currentUX' current', BuildNetworkRunner prog' prog (toCur', toI, toO) () prog' (D0 E), NetworkRuntime prog' prog (current', fromI, fromO) (toCur', toI, toO) ()) => prog -> init -> SessionChain prog prog' (current, fromO, fromI) (toCur, toO, toI) res' -> Maybe HostName -> PortID -> IO res' class CreateSessionOverNetwork invert init prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem createSessionOverNetwork :: (CreateSessionOverNetwork invert init prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem) => init -> invert -> Handle -> InterleavedChain (InternalPid prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe) (TyMap keyToIdxMe idxToValueMe) (TyMap keyToIdxMe' idxToValueMe') idxOfThem instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, DualT prog ~ prog', ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), TyListIndex prog init currentUX, Expand prog currentUX current, Dual prog prog', TyListIndex prog' init currentUX', Expand prog' currentUX' current', MapSize (TyMap keyToIdxMe idxToValueMe) idxOfThem, MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfThem (SessionState prog' prog (current', fromI, fromO)) (TyMap keyToIdxMe' idxToValueMe'), BuildNetworkRunner prog prog' (toCur, toO, toI) () prog init, NetworkRuntime prog prog' (current, fromO, fromI) (toCur, toO, toI) (), TyListMember invertedSessionsMe init True) => CreateSessionOverNetwork True init prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, DualT prog ~ prog', ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), TyListIndex prog init currentUX, Expand prog currentUX current, Dual prog prog', TyListIndex prog' init currentUX', Expand prog' currentUX' current', MapSize (TyMap keyToIdxMe idxToValueMe) idxOfThem, MapInsert (TyMap keyToIdxMe idxToValueMe) idxOfThem (SessionState prog prog' (current, fromO, fromI)) (TyMap keyToIdxMe' idxToValueMe'), BuildNetworkRunner prog' prog (toCur, toI, toO) () prog' init, NetworkRuntime prog' prog (current', fromI, fromO) (toCur, toI, toO) (), MapLookup (TyMap sessionsToIdxMe idxsToPairStructsMe) init (MVar (Map (RawPid, RawPid) (MVar (PairStruct init prog prog' (Cons (Jump init) Nil, Cons (Jump init) Nil, Cons (Jump init) Nil)))))) => CreateSessionOverNetwork False init prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem instance (JumpsToList prog prog' to result jumps' [SessionChain prog prog' from to result], NetworkRuntime prog prog' (Cons (Jump t) Nil, Cons (Jump t) Nil, Cons (Jump t) Nil) to result, TypeNumberToInt t) => JumpsToList prog prog' to result (Cons (Cons (Jump t) Nil) jumps') [SessionChain prog prog' from to result] instance JumpsToList prog prog' to result Nil [a] instance (JumpsToList prog prog' to result jumps [SessionChain prog prog' (Cons (Select jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) to result]) => NetworkRuntime prog prog' (Cons (Select jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) to result instance (JumpsToList prog prog' to result jumps [SessionChain prog prog' (Cons (Offer jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) to result]) => NetworkRuntime prog prog' (Cons (Offer jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) to result instance (TypeNumberToInt l) => NetworkRuntime prog prog' (Cons (Jump l) Nil, Cons (Jump l) Nil, Cons (Jump l) Nil) to result instance NetworkRuntime prog prog' (Cons End Nil, Cons End Nil, Cons End Nil) (current, outgoing, incoming) () instance (NetworkRuntime prog prog' (nxtC, outgoing, nxtI) (nxtC', outgoing', nxtI') result, Binary t) => NetworkRuntime prog prog' (Cons (Recv (sp, t)) nxtC, outgoing, Cons t nxtI) (nxtC', outgoing', nxtI') result instance (NetworkRuntime prog prog' (nxtC, nxtO, incoming) (nxtC', nxtO', incoming') result, Binary t', CompatibleTypes sp t' t) => NetworkRuntime prog prog' (Cons (Send (sp, t)) nxtC, Cons t nxtO, incoming) (nxtC', nxtO', incoming') result instance (ProgramToMVarsOutgoingT prog prog ~ progOut, ProgramToMVarsOutgoingT prog' prog' ~ progIn, Succ idx idxSucc, BuildNetworkRunner prog prog' to result progList idxSucc, TyListIndex progOut idx (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn idx (MVar (ProgramCell (Cell incoming))), TyListIndex prog idx currentUX, Expand prog currentUX current, NetworkRuntime prog prog' (current, outgoing, incoming) to result) => BuildNetworkRunner prog prog' to result (Cons frag progList) idx instance BuildNetworkRunner prog prog' to result Nil idx -- | This is just a convenience module that reexports everything you're -- expected to need. module Control.Concurrent.Session data True TT :: True data False FF :: False -- | Use OfferImpls to construct the implementations of the branches of an -- offer. Really, it's just a slightly fancy list. data OfferImpls :: * -> * -> * -> * -> * -> * OfferImplsNil :: OfferImpls Nil prog prog' finalState finalResult -- | Use to construct OfferImpls. This function automatically adds the -- necessary sjump to the start of each branch implementation. (~||~) :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, SWellFormedConfig l (D0 E) prog, SWellFormedConfig l (D0 E) prog', TyListIndex progOut l (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn l (MVar (ProgramCell (Cell incoming))), TyListIndex prog l currentUX, Expand prog currentUX current) => (SessionChain prog prog' (current, outgoing, incoming) finalState finalResult) -> (OfferImpls jumps prog prog' finalState finalResult) -> (OfferImpls (Cons (Cons (Jump l) Nil) jumps) prog prog' finalState finalResult) -- | Perform a jump. Now you may think that you should indicate where you -- want to jump to. But of course, that's actually specified by the -- session type so you don't have to specify it at all in the -- implementation. sjump :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, SWellFormedConfig l (D0 E) prog, SWellFormedConfig l (D0 E) prog', TyListIndex progOut l (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn l (MVar (ProgramCell (Cell incoming))), TyListIndex prog l currentUX, Expand prog currentUX current) => (SessionChain prog prog') (Cons (Jump l) Nil, Cons (Jump l) Nil, Cons (Jump l) Nil) (current, outgoing, incoming) () -- | Offer a number of branches. This is basically an external choice - the -- other party uses sselect to decide which branch to take. Use -- OfferImpls in order to construct the list of implementations of -- branches. Note that every implementation must result in the same final -- state and emit the same value. soffer :: OfferImpls jumps prog prog' (current, outgoing, incoming) finalResult -> (SessionChain prog prog') (Cons (Offer jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) (current, outgoing, incoming) finalResult -- | Select which branch we're taking at a branch point. Use a type number -- (Control.Concurrent.Session.Number) to indicate the branch to -- take. sselect :: ((ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, TyListLength jumps len, SmallerThanBool label len True, TypeNumberToInt label, TyListIndex jumps label (Cons (Jump jumpTarget) Nil), SWellFormedConfig jumpTarget (D0 E) prog, SWellFormedConfig jumpTarget (D0 E) prog', TyListIndex progOut jumpTarget (MVar (ProgramCell (Cell outgoing))), TyListIndex progIn jumpTarget (MVar (ProgramCell (Cell incoming))), TyListIndex prog jumpTarget currentUX, Expand prog currentUX current) => label -> (SessionChain prog prog') (Cons (Select jumps) Nil, Cons (Choice jumps) Nil, Cons (Choice jumps) Nil) (current, outgoing, incoming) () -- | Send a value to the other party. Of course, the value must be of the -- correct type indicated in the session type. ssend :: (CompatibleTypes sp t' t) => t' -> SessionChain prog prog' (Cons (Send (sp, t)) nxtCur, Cons t nxtOut, incoming) (nxtCur, nxtOut, incoming) () -- | Recieve a value from the other party. This will block as necessary. -- The type of the value received is specified by the session type. No -- magic coercion needed. srecv :: (SessionChain prog prog') (Cons (Recv (sp, t)) nxt, outgoing, Cons t nxt') (nxt, outgoing, nxt') t -- | Run! Provide a program and a start point within that program (which is -- automatically sjumped to), the two implementations which must -- be duals of each other, run them, have them communicate, wait until -- they both finish and die and then return the results from both of -- them. run :: (ProgramToMVarsOutgoing prog prog progOut, ProgramToMVarsOutgoing prog' prog' progIn, (ProgramToMVarsOutgoingT prog prog) ~ progOut, (ProgramToMVarsOutgoingT prog' prog') ~ progIn, SWellFormedConfig init (D0 E) prog, SWellFormedConfig init (D0 E) prog', TyListIndex progOut init (MVar (ProgramCell (Cell fromO))), TyListIndex progIn init (MVar (ProgramCell (Cell fromI))), (DualT prog) ~ prog', Dual prog prog', TyListIndex prog init currentUX, Expand prog currentUX current, TyListIndex prog' init currentUX', Expand prog' currentUX' current') => prog -> init -> SessionChain prog prog' (current, fromO, fromI) (toCur, toO, toI) res -> SessionChain prog' prog (current', fromI, fromO) (toCur', toI, toO) res' -> IO (res, res') data End data Send t Send :: t -> Send t data Recv t Recv :: t -> Recv t sendPid :: (TyList f, TyList fs, TyListSortNums lst lst') => lst -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (SendPid False lst') f) fs)) () recvPid :: (TyList f, TyList fs, TyListSortNums lst lst') => lst -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (RecvPid False lst') f) fs)) () sendSession :: (TyList f, TyList fs, TyList fs', TyListReverse frag fragRev, TyListTake (D1 E) fragRev (Cons (label, fragHead) Nil), TyListDrop (D1 E) fragRev fragTailRev, TyListReverse fragTailRev fragTail, TyListAppend fragTail fs fs') => SessionType (TypeState nxtLabel declareable useable (Cons (label, Nil) Nil)) (TypeState nxtLabel' declareable' useable' frag) res -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel' declareable' useable' (Cons (label, Cons (SendSession False fragHead) f) fs')) res recvSession :: (TyList f, TyList fs, TyList fs', TyListReverse frag fragRev, TyListTake (D1 E) fragRev (Cons (label, fragHead) Nil), TyListDrop (D1 E) fragRev fragTailRev, TyListReverse fragTailRev fragTail, TyListAppend fragTail fs fs') => SessionType (TypeState nxtLabel declareable useable (Cons (label, Nil) Nil)) (TypeState nxtLabel' declareable' useable' frag) res -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel' declareable' useable' (Cons (label, Cons (RecvSession False fragHead) f) fs')) res data Jump l data Select :: * -> * data Offer :: * -> * jump :: (TyListReverse (Cons (Jump jt) f) f', TyList f, TyList fs, TyListMember useable jt True) => jt -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, f') fs)) () end :: (TyListReverse (Cons End f) f', TyList f, TyList fs) => SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, f') fs)) () select :: (TyListReverse (Cons (Select listOfJumps) f) f', TyList f, TyList fs, BuildBranches (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) (SessionType (TypeState nxtLabel declareable useable (Cons (label, f') fs)) finalTo (listOfRes, listOfJumps))) => (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) -> (SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) finalTo listOfRes) offer :: (TyListReverse (Cons (Offer listOfJumps) f) f', TyList f, TyList fs, BuildBranches (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) (SessionType (TypeState nxtLabel declareable useable (Cons (label, f') fs)) finalTo (listOfRes, listOfJumps))) => (BranchesList listOfRes listOfJumps (TypeState nxtLabel declareable useable (Cons (label, f') fs)) to finalTo) -> (SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) finalTo listOfRes) (~>) :: (TyList nxt, SNonTerminal a, SValidSessionType nxt) => a -> nxt -> (Cons a nxt) (~|~) :: (Succ label nxtLabel, TyListConsSet label declareable declareable', TyListElem declareable' label idx, TyListDelete declareable' idx declareable'', TyListConsSet label useable useable', TyList st, TyListMember declareable' label True, TyList labs, TyList resLst) => (SessionType (TypeState nxtLabel declareable'' useable' (Cons (label, Nil) st)) (TypeState nxtLabel' declareable''' useable'' st') res) -> (BranchesList resLst labs (TypeState nxtLabel' declareable''' useable'' st') to finalTo) -> (BranchesList (Cons res resLst) (Cons (Cons (Jump label) Nil) labs) (TypeState label declareable useable st) (TypeState nxtLabel' declareable''' useable'' st', to) finalTo) class SWellFormedConfig idxA idxB ss testWellformed :: (SWellFormedConfig idxA idxB ss) => ss -> idxA -> idxB -> Bool -- | The representation of a computation that performs work using session -- types. Again, really quite similar to a more-parameterized State -- monad. data SessionChain prog prog' from to res (.=) :: (TyListMember declareable label True, TyListElem declareable label idx, TyListDelete declareable idx declareable', TyList st) => label -> (SessionType (TypeState nxtLabel declareable' useable (Cons (label, Nil) st)) (TypeState nxtLabel' declareable'' useable' st') a) -> SessionType (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable'' useable' st') a dual :: True notDual :: False newLabel :: (Succ nxtLabel nxtLabel', TyListConsSet nxtLabel declareable declareable', TyListConsSet nxtLabel useable useable') => SessionType (TypeState nxtLabel declareable useable st) (TypeState nxtLabel' declareable' useable' st) nxtLabel send :: (TyList f, TyList fs) => t -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (Send (SpecialNormal, t)) f) fs)) () recv :: (TyList f, TyList fs) => t -> SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, Cons (Recv (SpecialNormal, t)) f) fs)) () makeSessionType :: (TyListSortNums st st', TyListSnd st' st'') => SessionType (TypeState (D0 E) Nil Nil Nil) (TypeState nxtLabel Nil useable st) res -> (st'', res) currentLabel :: SessionType (TypeState nxtLabel declareable useable (Cons (label, f) fs)) (TypeState nxtLabel declareable useable (Cons (label, f) fs)) label data BranchesList :: * -> * -> * -> * -> * -> * BLNil :: BranchesList Nil Nil z z z data Cons :: * -> * -> * cons :: (TyList n) => t -> n -> (Cons t n) data Nil :: * nil :: Nil data E E :: E data D0 n D0 :: n -> D0 n data D1 n D1 :: n -> D1 n data D2 n D2 :: n -> D2 n data D3 n D3 :: n -> D3 n data D4 n D4 :: n -> D4 n data D5 n D5 :: n -> D5 n data D6 n D6 :: n -> D6 n data D7 n D7 :: n -> D7 n data D8 n D8 :: n -> D8 n data D9 n D9 :: n -> D9 n emptyMap :: TyMap Nil Nil -- | A process ID. This is a tiny bit like ThreadId but rather heavily -- annotated. data Pid :: * -> * -> * -> * -> * -> * data InterleavedChain internalPid from to res -- | Provides the ability to make a new session / channel with the given -- Pid. Supply the index to the Session Type, whether or not you're -- locally inverting (dualing) the Session Type, and the Pid, and so long -- as the Pid supports the dual of your local Session Type, this will -- block until the Pid gets around to servicing you. Thus this is a -- synchronous operation and both Pids must know of each other to create -- a new session / channel between them. class CreateSession invert init prog prog' sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem createSession :: (CreateSession invert init prog prog' sessionsToIdxMe sessionsToIdxThem idxsToPairStructsMe idxsToPairStructsThem keyToIdxMe idxToValueMe keyToIdxMe' idxToValueMe' idxOfThem invertedSessionsMe invertedSessionsThem) => init -> invert -> Pid prog prog' invertedSessionsThem sessionsToIdxThem idxsToPairStructsThem -> InterleavedChain (InternalPid prog prog' invertedSessionsMe sessionsToIdxMe idxsToPairStructsMe) (TyMap keyToIdxMe idxToValueMe) (TyMap keyToIdxMe' idxToValueMe') idxOfThem myPid :: InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) from from (Pid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) -- | Provides a way to compare two Pids. Of course, if the Pids have -- different type params, then they are definitely different, but it's -- still convenient to be able to do something like (==) on them. class PidEq a b (=~=) :: (PidEq a b) => a -> b -> Bool data MultiReceive :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * MultiReceiveNil :: MultiReceive Nil prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res (~|||~) :: (MapLookup (TyMap keyToIdx idxToValue) ch (SessionState progS progS' (Cons (Recv (sp, t)) nxt, fromO, Cons t nxt'))) => (ch, InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue') res) -> MultiReceive chs prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res -> MultiReceive (Cons ch chs) prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res multiReceive :: (TyListLength chs len, SmallerThanBool (D0 E) len True, SetIncomingNotify (TyMap keyToIdx idxToValue) chs, FindNonEmptyIncoming (TyMap keyToIdx idxToValue) chs, TypeNumberToInt len) => (MultiReceive chs prog prog' invertedSessions sessionsToIdx idxsToPairStructs keyToIdx idxToValue keyToIdx' idxToValue' res) -> InterleavedChain (InternalPid prog prog' invertedSessions sessionsToIdx idxsToPairStructs) (TyMap keyToIdx idxToValue) (TyMap keyToIdx' idxToValue') res