├── Control ├── Effect.hs └── Effect │ ├── Sessions.hs │ └── Sessions │ ├── Operations.lhs │ └── Process.lhs ├── Data └── Type │ ├── FiniteMap.lhs │ └── Set.hs ├── README.md ├── effect-sessions.cabal ├── examples.lhs └── popl16artifact.html /Control/Effect.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE KindSignatures, TypeFamilies, ConstraintKinds, PolyKinds, MultiParamTypeClasses #-} 2 | 3 | module Control.Effect where 4 | 5 | import Prelude hiding (Monad(..)) 6 | import GHC.Exts (Constraint) 7 | 8 | {-| Specifies "parametric effect monads" which are essentially monads but 9 | annotated by a type-level monoid formed by 'Plus' and 'Unit' -} 10 | class Effect (m :: k -> * -> *) where 11 | 12 | {-| Effect of a trivially effectful computation |-} 13 | type Unit m :: k 14 | {-| Cominbing effects of two subcomputations |-} 15 | type Plus m (f :: k) (g :: k) :: k 16 | 17 | {-| 'Inv' provides a way to give instances of 'Effect' their own constraints for '>>=' -} 18 | type Inv m (f :: k) (g :: k) :: Constraint 19 | type Inv m f g = () 20 | 21 | {-| Effect-parameterised version of 'return'. Annotated with the 'Unit m' effect, 22 | denoting pure compuation -} 23 | return :: a -> m (Unit m) a 24 | 25 | {-| Effect-parameterise version of '>>=' (bind). Combines 26 | two effect annotations 'f' and 'g' on its parameter computations into 'Plus' -} 27 | 28 | (>>=) :: (Inv m f g) => m f a -> (a -> m g b) -> m (Plus m f g) b 29 | 30 | (>>) :: (Inv m f g) => m f a -> m g b -> m (Plus m f g) b 31 | x >> y = x >>= (\_ -> y) 32 | 33 | fail = undefined 34 | 35 | {-| Specifies subeffecting behaviour -} 36 | class Subeffect (m :: k -> * -> *) f g where 37 | sub :: m f a -> m g a 38 | -------------------------------------------------------------------------------- /Control/Effect/Sessions.hs: -------------------------------------------------------------------------------- 1 | module Control.Effect.Sessions 2 | (Process(..), Chan(..), Name(..), Symbol, Session(..), Delegate(..), 3 | Dual, DualP, SessionSeq, Balanced, BalancedPar, NotBal, 4 | Effect(..), Control.Effect.fail, run, 5 | Map(..), (:@), Union, (:\), 6 | send, recv, new, par, rsend, chSend, chRecv, chRecvSeq, 7 | sub, subL, subR, subEnd, affineFix, caseUnion, 8 | print, putStrLn, liftIO, ifThenElse) where 9 | 10 | import GHC.TypeLits 11 | 12 | import Prelude hiding (print, putStrLn, Monad(..)) 13 | 14 | import Control.Effect 15 | import Control.Effect.Sessions.Process 16 | import Control.Effect.Sessions.Operations 17 | import Data.Type.FiniteMap 18 | 19 | chRecvSeq c k = (chRecv c) >>= (\kf -> kf k) 20 | -------------------------------------------------------------------------------- /Control/Effect/Sessions/Operations.lhs: -------------------------------------------------------------------------------- 1 | This file defines effectful operations which encode the core operations 2 | of the (session type) pi-calculus. 3 | 4 | > {-# LANGUAGE TypeOperators, DataKinds, GADTs, RankNTypes, FlexibleInstances, 5 | > MultiParamTypeClasses, FlexibleContexts, IncoherentInstances, 6 | > TypeFamilies, MagicHash, UnboxedTuples, ConstraintKinds #-} 7 | 8 | > module Control.Effect.Sessions.Operations where 9 | 10 | > import Control.Effect.Sessions.Process 11 | > import Data.Type.FiniteMap 12 | 13 | > import Unsafe.Coerce 14 | > import Control.Concurrent ( threadDelay ) 15 | > import qualified Control.Concurrent.Chan as C 16 | > import qualified Control.Concurrent as Conc 17 | 18 | > import Control.Monad.STM 19 | > import Control.Concurrent.STM.TMVar 20 | 21 | > import Control.Effect (Subeffect(..)) 22 | 23 | > {-| A process can be run if it is /closed/ (i.e., empty channel environment) -} 24 | > run :: Process '[] a -> IO a 25 | > run = getProcess 26 | 27 | > {-| Lift IO computations to a process -} 28 | > liftIO :: IO a -> Process '[] a 29 | > liftIO = Process 30 | 31 | > {-| Print to stdout in a process -} 32 | > print :: Show a => a -> Process '[] () 33 | > print = liftIO . (Prelude.print) 34 | 35 | > {-| putStrLn in a process -} 36 | > putStrLn = liftIO . Prelude.putStrLn 37 | 38 | The simplest operations, send and receive of primitive values, 39 | take a named channel 'Chan c' and return a 'Process' computation 40 | indexed by the session environment '[c :-> S]' where 'S' is either a 41 | send or receive action (terminated by 'End'). 42 | 43 | > {-| Send a primitive-typed value -} 44 | > send :: Chan c -> t -> Process '[c :-> t :! End] () 45 | > send (MkChan c) t = Process $ C.writeChan (unsafeCoerce c) t 46 | 47 | > {-| Receive a primitive-typed value -} 48 | > recv :: Chan c -> Process '[c :-> t :? End] t 49 | > recv (MkChan c) = Process $ C.readChan (unsafeCoerce c) -- >>= (return . unWrap) 50 | 51 | The 'new' combinator models $\nu$, which takes 52 | a function mapping from a pair of two channels names 53 | 'Ch c' and 'Op C' to a session with behaviour 's', and creates 54 | a session where any mention to 'Ch c' or 'Op c' is removed: 55 | 56 | > {-| Create a new channel and pass its two endpoints to the supplied continuation 57 | > (the first parameter). This channel is thus only in scope for this continuation -} 58 | > new :: (Duality env c) 59 | > => ((Chan (Ch c), Chan (Op c)) -> Process env t) 60 | > -> Process (env :\ (Op c) :\ (Ch c)) t 61 | > new f = Process $ C.newChan >>= (\c -> getProcess $ f (MkChan c, MkChan c)) 62 | 63 | > {-| Parallel compose two processes, if they contain balanced sessions -} 64 | > par :: (BalancedPar env env') => 65 | > Process env () -> Process env' () -> Process (DisjointUnion env env') () 66 | > par (Process x) (Process y) = Process $ do res <- newEmptyTMVarIO 67 | > res' <- newEmptyTMVarIO 68 | > Conc.forkIO $ (x >>= (atomically . (putTMVar res))) 69 | > Conc.forkIO $ (y >>= (atomically . (putTMVar res'))) 70 | > () <- atomically $ do { takeTMVar res } 71 | > () <- atomically $ do { takeTMVar res' } 72 | > return () 73 | 74 | > {-| Turn all session types into 'balancing checked' session types |-} 75 | > type family AllBal (env :: [Map Name Session]) :: [Map Name Session] where 76 | > AllBal '[] = '[] 77 | > AllBal ((c :-> s) ': env) = (c :-> Bal s) ': (AllBal env) 78 | 79 | > {-| Output a channel (dual to a replicated input) -} 80 | > rsend :: Chan c -> Chan d -> Process '[c :-> (Delg s) :*! End, d :-> Bal s] () 81 | > rsend (MkChan c) t = Process $ C.writeChan (unsafeCoerce c) t 82 | 83 | Channels can then be sent and received with the 'chSend' and 'chRecv' primitives: 84 | 85 | > {-| Send a channel 'd' over channel 'c' -} 86 | > chSend :: Chan c -> Chan d -> Process '[c :-> (Delg s) :! End, d :-> Bal s] () 87 | > chSend (MkChan c) t = Process $ C.writeChan (unsafeCoerce c) t 88 | 89 | > {-| Receive a channel over a channel 'c', bind to the name 'd' -} 90 | 91 | chRecv :: Chan c -> (Chan d -> Process env a) -> 92 | Process (UnionSeq '[c :-> (Delg (env :@ d)) :? (env :@ c)] (env :\ d)) a 93 | chRecv (MkChan c) f = Process $ C.readChan (unsafeCoerce c) >>= 94 | (getProcess . f . unsafeCoerce) 95 | 96 | > chRecv :: Chan c -> Process '[c :-> (Delg (env :@ d)) :? End] 97 | > ((Chan d -> Process env a) -> Process (env :\ d) a) 98 | > chRecv (MkChan c) = Process $ return $ 99 | > \f -> let y = (C.readChan (unsafeCoerce c) >>= 100 | > (getProcess . f . unsafeCoerce)) 101 | > in Process $ y 102 | 103 | 104 | Given a channel 'c', and a computation which binds channel 'd' to produces behaviour 105 | 'c', then this is provided by receiving 'd' over 'c'. Thus the resulting computation 106 | is the union of 'c' mapping to the session type of 'd' in the session environment 107 | 's', composed with the 's' but with 'd' deleted (removed). 108 | 109 | ------------------------------------------------------ 110 | 111 | Subeffecting instances for the least-upper bound :+ operator and for extending 112 | an environment with a closed session channel, i.e. with c :-> End. 113 | 114 | > instance Subeffect Process env env' => 115 | > Subeffect Process ((c :-> s) ': env) ((c :-> s :+ t) ': env') where 116 | > sub (Process p) = Process p 117 | 118 | > instance Subeffect Process env env' => 119 | > Subeffect Process ((c :-> t) ': env) ((c :-> s :+ t) ': env') where 120 | > sub (Process p) = Process p 121 | 122 | > instance Subeffect Process env env where 123 | > sub = id 124 | 125 | > instance Subeffect Process env env' => 126 | > Subeffect Process ((c :-> s) ': env) ((c :-> s) ': env') where 127 | > sub (Process p) = Process p 128 | 129 | > instance Subeffect Process env env' => 130 | > Subeffect Process env ((c :-> End) ': env') where 131 | > sub (Process p) = Process p 132 | 133 | Explicit subeffecting operations for subtyping on the left of a conditional 134 | and subtyping on the right of a conditional 135 | 136 | > {-| Explicit subeffecting introduction of ':+' with the current session behaviour on the left -} 137 | > subL :: Process '[c :-> s] a -> Process '[c :-> s :+ t] a 138 | > subL = sub 139 | 140 | > {-| Explicit subeffecting introduction of ':+' with the current session behaviour on the right -} 141 | > subR :: Process '[c :-> t] a -> Process '[c :-> s :+ t] a 142 | > subR = sub 143 | 144 | > {-| Explicit subeffecting introduction of a terminated session for channel 'c' -} 145 | > subEnd :: Chan c -> Process '[] a -> Process '[c :-> End] a 146 | > subEnd _ = sub 147 | 148 | instance Subeffect Process '[] '[d :-> s] where 149 | sub (Process p) = Process p 150 | 151 | > caseUnion :: Chan c -> Process env a -> Process ((c :-> s) ': env) a 152 | > caseUnion _ (Process p) = Process p 153 | 154 | 155 | > {-| Recursion combinator for recursive functions which have an affine fixed-point 156 | > equation on their effects. 157 | > For example, if 'h ~ (Seq h a) :+ b' then 'ToFix h = Fix a b,' 158 | > -} 159 | > affineFix :: ((a -> Process '[c :-> Star] b) 160 | > -> (a -> Process '[c :-> h] b)) 161 | > -> a -> Process '[c :-> ToFix h] b 162 | > affineFix f x = let (Process p) = f (\x' -> let (Process y) = affineFix f x' in Process y) x 163 | > in Process p -------------------------------------------------------------------------------- /Control/Effect/Sessions/Process.lhs: -------------------------------------------------------------------------------- 1 | > {-# LANGUAGE RebindableSyntax, TypeOperators, DataKinds, KindSignatures, PolyKinds, TypeFamilies, ConstraintKinds, NoMonomorphismRestriction, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, DeriveDataTypeable, StandaloneDeriving, ExistentialQuantification, RankNTypes, UndecidableInstances, EmptyDataDecls, ScopedTypeVariables, GADTs, InstanceSigs, ImplicitParams, IncoherentInstances #-} 2 | 3 | > module Control.Effect.Sessions.Process where 4 | 5 | > import Control.Concurrent ( threadDelay ) 6 | > import qualified Control.Concurrent.Chan as C 7 | > import qualified Control.Concurrent as Conc 8 | 9 | > import qualified Prelude as P 10 | > import Prelude hiding (Monad(..),print) 11 | 12 | > import Control.Effect 13 | > import GHC.TypeLits 14 | > import Unsafe.Coerce 15 | > import GHC.Exts (Constraint) 16 | 17 | > import Data.Type.FiniteMap 18 | > import Data.Type.Set (Sort) 19 | 20 | > -- Needed when you are using RebindableSyntax extension [most of the time] 21 | > ifThenElse True e1 e2 = e1 22 | > ifThenElse False e1 e2 = e2 23 | 24 | The baseis of the session calculus encoding in Haskell is: 25 | * the encoding of session types into an effect system as described in Section 7 26 | * using a Haskell implementation of /graded monads/ to embed effect systems 27 | (follows the technique in 'Embedding effect systems in Haskell', 28 | Orchard, Petricek, Haskell Symposoium 2014) 29 | 30 | Processes are captured by the following data type which wraps the IO monad 31 | and which is indexed a type-level finite map from names to session types: 32 | 33 | > {-| Process computation type indexed by an environment of the (free) channel 34 | > names used in the computation, paired with a specification of their behaviour. -} 35 | > data Process (s :: [Map Name Session]) a = Process { getProcess :: IO a } 36 | 37 | The type index represents a finite map of channel-session-type pairs as a type-level 38 | list. This treated as a finite map when taking 'union' of two maps, where duplicate 39 | mappings get merged by sequential session composition. 40 | 41 | Session types are given by the data type: 42 | 43 | > {-| Session types -} 44 | > data Session = 45 | > {-| Send -} 46 | > forall a . a :! Session 47 | > {-| Receive -} 48 | > | forall a . a :? Session 49 | > {-| Output -} 50 | > | forall a . a :*! Session 51 | > {-| Alternation (for branch/select) -} 52 | > | Session :+ Session 53 | > {-| Marks a session that should 'balance' when composed -} 54 | > | Bal Session 55 | > {-| End of session -} 56 | > | End 57 | > {-| Denotes an affine fixed point, where Fix a b = a* . b -} 58 | > | Fix Session Session 59 | > {-| A placeholder for a recursion variable- never generated by 60 | > the encoding or produced by any operation, but set as 61 | > the session type for a recursive call in a fixed-point (see `affineFix`). -} 62 | > | Star 63 | 64 | > {-| Delegated session -} 65 | > data Delegate = Delg Session 66 | 67 | > {-| Duality function: calculuate the dual of a simple, non-recursive session type -} 68 | > type family Dual s where 69 | > Dual End = End 70 | > Dual (t :! s) = t :? (Dual s) 71 | > Dual (t :*! s) = t :? (Dual s) 72 | > Dual (t :? s) = t :! (Dual s) 73 | > Dual (s :+ t) = (Dual s) :+ (Dual t) 74 | > Dual (Bal t) = Dual t 75 | > Dual Star = Star 76 | > -- Dual (Fix a b) is not computed here, only duality of non-recursive sessions 77 | 78 | > {-| Duality relation: extends the duality function to include recursive session types -} 79 | > type family DualP (s :: Session) (t :: Session) :: Constraint where 80 | > DualP End End = () 81 | > DualP (t :! s) (t' :? s') = (t ~ t', DualP s s') 82 | > DualP (t :? s) (t' :! s') = (t ~ t', DualP s s') 83 | > DualP (Bal s) s' = DualP s s' 84 | > DualP s (Bal s') = DualP s s' 85 | > DualP (s :+ t) (s' :+ t') = (DualP s s', DualP t t') 86 | > DualP (Fix a b) s = EqFix a (Fix a b) (Dual s) 87 | > DualP s (Fix a b) = EqFix a (Fix a b) (Dual s) 88 | 89 | > {-| Compute fixed-point equality of session types by unrolling -} 90 | > type family EqFix (f :: Session) (f' :: Session) (s :: Session) :: Constraint where 91 | > EqFix a (Fix Star b) b = () 92 | > EqFix a (Fix Star b) s = EqFix a (Fix a b) s 93 | > EqFix a (Fix (t :! s) b) (t' :! s') = (t ~ t', EqFix a (Fix s b) s') 94 | > EqFix a (Fix (t :? s) b) (t' :? s') = (t ~ t', EqFix a (Fix s b) s') 95 | > EqFix a (Fix (t1 :+ t2) b) (t1' :+ t2') = (t1 ~ t1', t2 ~ t2') 96 | > EqFix a (Fix (t :*! s) b) (t' :*! s') = (t ~ t', EqFix a (Fix s b) s') 97 | 98 | > {-| Predicate over environments that channel 'c' has dual endpoints with dual session types -} 99 | > type Duality env c = DualP (env :@ (Ch c)) (env :@ (Op c)) 100 | 101 | 102 | A specialised version of the usual 'Lookup' that replies 'End' if the key doesn't exist 103 | in the map. 104 | 105 | > {-| Lookup a channel from an enrivonment, returning 'End' if it is not a member -} 106 | > type family (:@) (m :: [Map Name Session]) (c :: Name) :: Session where 107 | > '[] :@ k = End 108 | > ((k :-> v) ': m) :@ k = v 109 | > (kvp ': m) :@ k = m :@ k 110 | 111 | The 'Combine' type family is used by the 'Union' function on finite maps when 112 | there are two matching keys in each map. It determines the new value in the resulting 113 | map, which in this case is defined by sequational composition of session types. 114 | 115 | > type instance Combine s t = SessionSeq s t 116 | 117 | > {-| Sequential composition of sessions -} 118 | > type family SessionSeq s t where 119 | > SessionSeq End s = s 120 | > SessionSeq (a :? s) t = a :? (SessionSeq s t) 121 | > SessionSeq (a :! s) t = a :! (SessionSeq s t) 122 | > SessionSeq (a :*! s) t = a :*! (SessionSeq s t) 123 | > SessionSeq (s1 :+ s2) t = (SessionSeq s1 t) :+ (SessionSeq s2 t) 124 | > SessionSeq Star Star = Star 125 | 126 | > {-| Channel endpoint names -} 127 | > data Name = Ch Symbol | Op Symbol 128 | > {-| Namec channels, encapsulating Concurrent Haskell channels -} 129 | > data Chan (n :: Name) = forall a . MkChan (C.Chan a) 130 | 131 | Channel names can be compared as follows (this is needed for the normalisation 132 | procedure in the type-level finite maps library). 133 | 134 | > {-| Compare channel names for normalising type-level finite map representations -} 135 | > type instance Cmp (c :-> a) (d :-> b) = CmpSessionMap (c :-> a) (d :-> b) 136 | 137 | > {-| Compare channel names for normalising type-level finite map representations -} 138 | > type family CmpSessionMap (x :: Map Name Session) (y :: Map Name Session) where 139 | > CmpSessionMap ((Ch c) :-> a) ((Op d) :-> b) = LT 140 | > CmpSessionMap ((Op c) :-> a) ((Ch d) :-> b) = GT 141 | > CmpSessionMap ((Ch c) :-> a) ((Ch d) :-> b) = CmpSymbol c d 142 | > CmpSessionMap ((Op c) :-> a) ((Op d) :-> b) = CmpSymbol c d 143 | 144 | We then define the effect-graded monads (in the style of Katusmata) 145 | for sessions, an instance of 'Effect' class from Control.Effect.Monad 146 | 147 | (see https://hackage.haskell.org/package/effect-mon:ad-0.6.1/docs/Control-Effect.html). 148 | 149 | > type UnionSeq s t = Union s t -- to remind us that the `union' is more like 150 | > -- sequential composition 151 | > instance Effect Process where 152 | > type Plus Process s t = UnionSeq s t 153 | > type Unit Process = '[] 154 | > type Inv Process s t = Balanced s t 155 | 156 | > return :: a -> Process (Unit Process) a 157 | > return a = Process (P.return a) 158 | 159 | > (>>=) :: (Inv Process s t) => Process s a -> (a -> Process t b) -> Process (Plus Process s t) b 160 | > x >>= k = Process ((P.>>=) (getProcess x) (getProcess . k)) 161 | 162 | > fail = error "Fail in a process computation" 163 | 164 | 165 | > {-| Normalises session types using the left-distributivity 166 | > rule for effects: i.e. f * (g + h) = (f * g) + (f * h) -} 167 | > type family DistribL g where 168 | > DistribL (a :! (s :+ t)) = (DistribL (a :! s)) :+ (DistribL (a :! t)) 169 | > DistribL (a :? (s :+ t)) = (DistribL (a :? s)) :+ (DistribL (a :? t)) 170 | > DistribL (a :? s) = DistribInsideSeq ((:?) a) (DistribL s) 171 | > DistribL (a :! s) = DistribInsideSeq ((:!) a) (DistribL s) 172 | > DistribL (a :+ b) = (DistribL a) :+ (DistribL b) 173 | > DistribL Star = Star 174 | > DistribL End = End 175 | 176 | > {-| Part of the normalisation procedure for left-distributivity -} 177 | > type family DistribInsideSeq (k :: Session -> Session) (a :: Session) :: Session where 178 | > DistribInsideSeq k (s :+ t) = (k s) :+ (k t) 179 | > DistribInsideSeq k s = k s 180 | 181 | > {-| Map an affine equation on effects to the fixed point solution: 182 | > That is '(Seq Star a) :+ b' where 'Star' is the placeholder for a recursion variable 183 | > then 'ToFix ((Seq Star a) :+ b) = Fix a b' -} 184 | > type ToFix s = ToFixP (DistribL s) 185 | 186 | > type family ToFixPP (a :: Session) (a' :: Session) (b :: Session) (b' :: Session) :: Session where 187 | > ToFixPP a (t :! s) b b' = ToFixPP a s b b' 188 | > ToFixPP a (t :? s) b b' = ToFixPP a s b b' 189 | > ToFixPP a End b b' = ToFixPP b b' a End 190 | > ToFixPP a Star b b' = Fix a b 191 | > ToFixPP a a' b Star = Fix b a 192 | 193 | > type family ToFixP s where 194 | > ToFixP (a :+ b) = ToFixPP a a b b 195 | > ToFixP s = ToFixPP s s End End 196 | 197 | 198 | > type family ToFixes (env :: [Map Name Session]) :: [Map Name Session] where 199 | > ToFixes '[] = '[] 200 | > ToFixes ((c :-> v) ': env) = (c :-> ToFix v) ': env 201 | 202 | > {-| Predicate for checking that two environments are balanced 203 | > (in context of sequential composition) -} 204 | > type family (Balanced s t) :: Constraint where 205 | > Balanced '[] '[] = () 206 | > Balanced env '[] = () 207 | > Balanced '[] env = () 208 | > Balanced ((c :-> s) ': env) env' = (BalancedF (c :-> s) env', Balanced env env') 209 | 210 | > {-| Side recursive case of balancing (check each var -> session type map against every other -} 211 | > type family (BalancedF s t) :: Constraint where 212 | > BalancedF (c :-> s) '[] = () 213 | > BalancedF (Ch c :-> s) ((Op c :-> Bal t) ': env) = (t ~ Dual s) 214 | > BalancedF (Op c :-> s) ((Ch c :-> Bal t) ': env) = (t ~ Dual s) 215 | > BalancedF (Ch c :-> Bal s) ((Op c :-> t) ': env) = (t ~ Dual s) 216 | > BalancedF (Op c :-> Bal s) ((Ch c :-> t) ': env) = (t ~ Dual s) 217 | > BalancedF (c :-> s) ((c :-> t) ': env) = (NotBal s, NotBal t) 218 | > BalancedF (c :-> s) ((d :-> t) ': env) = BalancedF (c :-> s) env 219 | 220 | > {-| Checks that we are not requiring a balanced session -} 221 | > type family (NotBal s) :: Constraint where 222 | > NotBal (s :! t) = () 223 | > NotBal (s :? t) = () 224 | > NotBal (s :+ t) = () 225 | > NotBal (s :*! t) = () 226 | > NotBal Star = () 227 | > NotBal End = () 228 | 229 | > {-| Predicate for checking that two environments are balanced 230 | > (in the context of parallel composition) -} 231 | > type family (BalancedPar s t) :: Constraint where 232 | > BalancedPar '[] '[] = () 233 | > BalancedPar env '[] = () 234 | > BalancedPar '[] env = () 235 | > BalancedPar ((c :-> s) ': env) env' = (BalancedParF (c :-> s) env', BalancedPar env env') 236 | 237 | > {-| Side recursive case of balancing for par (check each var -> session type map against every other -} 238 | > type family (BalancedParF s t) :: Constraint where 239 | > BalancedParF (c :-> s) '[] = () 240 | > BalancedParF (Ch c :-> s) ((Op c :-> t) ': env) = (DualP s t) 241 | > BalancedParF (Op c :-> s) ((Ch c :-> t) ': env) = (DualP s t) 242 | > {-| Can be equal if replicated send encoding in each part -} 243 | > BalancedParF (c :-> Int :! (s :*! t)) ((c :-> Int :! (s' :*! t')) ': env) 244 | > = (s ~ s', t ~ t') 245 | > BalancedParF (c :-> s) ((d :-> t) ': env) = (BalancedParF (c :-> s) env) 246 | -------------------------------------------------------------------------------- /Data/Type/FiniteMap.lhs: -------------------------------------------------------------------------------- 1 | This module provides type-level finite maps. 2 | The implementation is similar to that shown in the paper. 3 | "Embedding effect systems in Haskell" Orchard, Petricek 2014 4 | 5 | > {-# LANGUAGE TypeOperators, PolyKinds, DataKinds, KindSignatures, 6 | > TypeFamilies, UndecidableInstances, MultiParamTypeClasses, 7 | > FlexibleInstances #-} 8 | 9 | > module Data.Type.FiniteMap (Union, DisjointUnion, Map(..), 10 | > Lookup, Member, Combine, Cmp, (:\), (:++)) where 11 | 12 | > import Data.Type.Set hiding (X, Y, Z, (:->), Nub, Union, Append) 13 | 14 | > -- Mappings 15 | > infixr 4 :-> 16 | > data Map k v = k :-> v 17 | 18 | Throughout, type variables 19 | 'k' ranges over "keys" 20 | 'v' ranges over "values" 21 | 'kvp' ranges over "key-value-pairs" 22 | 'm', 'n' range over "maps" 23 | 24 | > -- Append type-level lists 25 | > type family (:++) (x :: [a]) (y :: [a]) :: [a] where 26 | > '[] :++ xs = xs 27 | > (x ': xs) :++ ys = x ': (xs :++ ys) 28 | 29 | > type family Combine (a :: v) (b :: v) :: v 30 | 31 | > -- Combines repeated channel mappings 32 | > type family Nub t where 33 | > Nub '[] = '[] 34 | > Nub '[kvp] = '[kvp] 35 | > Nub ((k :-> v1) ': (k :-> v2) ': m) = Nub ((k :-> Combine v1 v2) ': m) 36 | > Nub (kvp1 ': kvp2 ': s) = kvp1 ': Nub (kvp2 ': s) 37 | 38 | > -- Removes repeated channel mappings 39 | > type family NubEq t where 40 | > NubEq '[] = '[] 41 | > NubEq '[kvp] = '[kvp] 42 | > NubEq ((k :-> v) ': (k :-> v) ': m) = NubEq ((k :-> v) ': m) 43 | > NubEq (kvp1 ': kvp2 ': s) = kvp1 ': NubEq (kvp2 ': s) 44 | 45 | Union of two finite maps 46 | 47 | > type Union m n = Nub (Sort (m :++ n)) 48 | 49 | Union of two finite maps that have either different keys, or when the keys 50 | conincide so must the values 51 | 52 | > type DisjointUnion m n = NubEq (Sort (m :++ n)) 53 | 54 | Delete elements from a map 55 | 56 | > type family (m :: [Map k v]) :\ (c :: k) :: [Map k v] where 57 | > '[] :\ k = '[] 58 | > ((k :-> v) ': m) :\ k = m :\ k 59 | > (kvp ': m) :\ k = kvp ': (m :\ k) 60 | 61 | Lookup elements from a map 62 | 63 | > type family Lookup (m :: [Map k v]) (c :: k) :: Maybe v where 64 | > Lookup '[] k = Nothing 65 | > Lookup ((k :-> v) ': m) k = Just v 66 | > Lookup (kvp ': m) k = Lookup m k 67 | 68 | Membership 69 | 70 | > type family Member (c :: k) (m :: [Map k v]) :: Bool where 71 | > Member k '[] = False 72 | > Member k ((k :-> v) ': m) = True 73 | > Member k (kvp ': m) = Member k m 74 | -------------------------------------------------------------------------------- /Data/Type/Set.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators, TypeFamilies, 2 | MultiParamTypeClasses, FlexibleInstances, PolyKinds, FlexibleContexts, 3 | UndecidableInstances, ConstraintKinds, ScopedTypeVariables #-} 4 | 5 | module Data.Type.Set (Set(..), Union, Unionable, union, quicksort, append, 6 | Sort, Sortable, Append(..), Split(..), Cmp, 7 | Nub, Nubable(..), AsSet, asSet, IsSet, Subset(..), 8 | (:->)(..), Var(..)) where 9 | 10 | import GHC.TypeLits 11 | import Data.Type.Bool 12 | import Data.Type.Equality 13 | 14 | data Proxy (p :: k) = Proxy 15 | 16 | {-| Core Set definition, in terms of lists -} 17 | data Set (n :: [*]) where 18 | Empty :: Set '[] 19 | Ext :: e -> Set s -> Set (e ': s) 20 | 21 | instance Show (Set '[]) where 22 | show Empty = "{}" 23 | 24 | instance (Show e, Show' (Set s)) => Show (Set (e ': s)) where 25 | show (Ext e s) = "{" ++ show e ++ (show' s) ++ "}" 26 | 27 | class Show' t where 28 | show' :: t -> String 29 | instance Show' (Set '[]) where 30 | show' Empty = "" 31 | instance (Show' (Set s), Show e) => Show' (Set (e ': s)) where 32 | show' (Ext e s) = ", " ++ show e ++ (show' s) 33 | 34 | {-| At the type level, normalise the list form to the set form -} 35 | type AsSet s = Nub (Sort s) 36 | 37 | {-| At the value level, noramlise the list form to the set form -} 38 | asSet :: (Sortable s, Nubable (Sort s)) => Set s -> Set (AsSet s) 39 | asSet x = nub (quicksort x) 40 | 41 | {-| Predicate to check if in the set form -} 42 | type IsSet s = (s ~ Nub (Sort s)) 43 | 44 | {-| Useful properties to be able to refer to someties -} 45 | type SetProperties f = (Union f '[] ~ f, Split f '[] f, 46 | Union '[] f ~ f, Split '[] f f, 47 | Union f f ~ f, Split f f f, 48 | Unionable f '[], Unionable '[] f) 49 | 50 | {-- Union --} 51 | 52 | {-| Union of sets -} 53 | type Union s t = Nub (Sort (Append s t)) 54 | 55 | union :: (Unionable s t) => Set s -> Set t -> Set (Union s t) 56 | union s t = nub (quicksort (append s t)) 57 | 58 | type Unionable s t = (Sortable (Append s t), Nubable (Sort (Append s t))) 59 | 60 | {-| List append (essentially set disjoint union) -} 61 | type family Append (s :: [k]) (t :: [k]) :: [k] where 62 | Append '[] t = t 63 | Append (x ': xs) ys = x ': (Append xs ys) 64 | 65 | append :: Set s -> Set t -> Set (Append s t) 66 | append Empty x = x 67 | append (Ext e xs) ys = Ext e (append xs ys) 68 | 69 | {-| Useful alias for append -} 70 | type (s :: [k]) :++ (t :: [k]) = Append s t 71 | 72 | {-| Splitting a union a set, given the sets we want to split it into -} 73 | class Split s t st where 74 | -- where st ~ Union s t 75 | split :: Set st -> (Set s, Set t) 76 | 77 | instance Split '[] '[] '[] where 78 | split Empty = (Empty, Empty) 79 | 80 | instance Split s t st => Split (x ': s) (x ': t) (x ': st) where 81 | split (Ext x st) = let (s, t) = split st 82 | in (Ext x s, Ext x t) 83 | 84 | instance Split s t st => Split (x ': s) t (x ': st) where 85 | split (Ext x st) = let (s, t) = split st 86 | in (Ext x s, t) 87 | 88 | instance (Split s t st) => Split s (x ': t) (x ': st) where 89 | split (Ext x st) = let (s, t) = split st 90 | in (s, Ext x t) 91 | 92 | 93 | 94 | {-| Remove duplicates from a sorted list -} 95 | type family Nub t where 96 | Nub '[] = '[] 97 | Nub '[e] = '[e] 98 | Nub (e ': e ': s) = Nub (e ': s) 99 | Nub (e ': f ': s) = e ': Nub (f ': s) 100 | 101 | {-| Value-level counterpart to the type-level 'Nub' 102 | Note: the value-level case for equal types is not define here, 103 | but should be given per-application, e.g., custom 'merging' behaviour may be required -} 104 | 105 | class Nubable t where 106 | nub :: Set t -> Set (Nub t) 107 | 108 | instance Nubable '[] where 109 | nub Empty = Empty 110 | 111 | instance Nubable '[e] where 112 | nub (Ext x Empty) = Ext x Empty 113 | 114 | instance Nubable (e ': s) => Nubable (e ': e ': s) where 115 | nub (Ext _ (Ext e s)) = nub (Ext e s) 116 | 117 | instance (Nub (e ': f ': s) ~ (e ': Nub (f ': s)), 118 | Nubable (f ': s)) => Nubable (e ': f ': s) where 119 | nub (Ext e (Ext f s)) = Ext e (nub (Ext f s)) 120 | 121 | 122 | {-| Construct a subsetset 's' from a superset 't' -} 123 | class Subset s t where 124 | subset :: Set t -> Set s 125 | 126 | instance Subset '[] '[] where 127 | subset xs = Empty 128 | 129 | instance {-# OVERLAPPABLE #-} Subset '[] (x ': t) where 130 | subset xs = Empty 131 | 132 | instance {-# OVERLAPS #-} Subset s t => Subset (x ': s) (x ': t) where 133 | subset (Ext x xs) = Ext x (subset xs) 134 | 135 | 136 | {-| Type-level quick sort for normalising the representation of sets -} 137 | type family Sort (xs :: [k]) :: [k] where 138 | Sort '[] = '[] 139 | Sort (x ': xs) = ((Sort (Filter FMin x xs)) :++ '[x]) :++ (Sort (Filter FMax x xs)) 140 | 141 | data Flag = FMin | FMax 142 | 143 | type family Filter (f :: Flag) (p :: k) (xs :: [k]) :: [k] where 144 | Filter f p '[] = '[] 145 | Filter FMin p (x ': xs) = If (Cmp x p == LT) (x ': (Filter FMin p xs)) (Filter FMin p xs) 146 | Filter FMax p (x ': xs) = If (Cmp x p == GT || Cmp x p == EQ) (x ': (Filter FMax p xs)) (Filter FMax p xs) 147 | 148 | {-| Value-level quick sort that respects the type-level ordering -} 149 | class Sortable xs where 150 | quicksort :: Set xs -> Set (Sort xs) 151 | 152 | instance Sortable '[] where 153 | quicksort Empty = Empty 154 | 155 | instance (Sortable (Filter FMin p xs), 156 | Sortable (Filter FMax p xs), FilterV FMin p xs, FilterV FMax p xs) => Sortable (p ': xs) where 157 | quicksort (Ext p xs) = ((quicksort (less p xs)) `append` (Ext p Empty)) `append` (quicksort (more p xs)) 158 | where less = filterV (Proxy::(Proxy FMin)) 159 | more = filterV (Proxy::(Proxy FMax)) 160 | 161 | {- Filter out the elements less-than or greater-than-or-equal to the pivot -} 162 | class FilterV (f::Flag) p xs where 163 | filterV :: Proxy f -> p -> Set xs -> Set (Filter f p xs) 164 | 165 | instance FilterV f p '[] where 166 | filterV _ p Empty = Empty 167 | 168 | instance (Conder ((Cmp x p) == LT), FilterV FMin p xs) => FilterV FMin p (x ': xs) where 169 | filterV f@Proxy p (Ext x xs) = cond (Proxy::(Proxy ((Cmp x p) == LT))) 170 | (Ext x (filterV f p xs)) (filterV f p xs) 171 | 172 | instance (Conder (((Cmp x p) == GT) || ((Cmp x p) == EQ)), FilterV FMax p xs) => FilterV FMax p (x ': xs) where 173 | filterV f@Proxy p (Ext x xs) = cond (Proxy::(Proxy (((Cmp x p) == GT) || ((Cmp x p) == EQ)))) 174 | (Ext x (filterV f p xs)) (filterV f p xs) 175 | 176 | class Conder g where 177 | cond :: Proxy g -> Set s -> Set t -> Set (If g s t) 178 | 179 | instance Conder True where 180 | cond _ s t = s 181 | 182 | instance Conder False where 183 | cond _ s t = t 184 | 185 | {-| Open-family for the ordering operation in the sort -} 186 | 187 | type family Cmp (a :: k) (b :: k) :: Ordering 188 | 189 | {-| Pair a symbol (representing a variable) with a type -} 190 | infixl 2 :-> 191 | data (k :: Symbol) :-> (v :: *) = (Var k) :-> v 192 | 193 | data Var (k :: Symbol) where Var :: Var k 194 | {- Some special defaults for some common names -} 195 | X :: Var "x" 196 | Y :: Var "y" 197 | Z :: Var "z" 198 | 199 | 200 | instance (Show (Var k), Show v) => Show (k :-> v) where 201 | show (k :-> v) = "(" ++ show k ++ " :-> " ++ show v ++ ")" 202 | instance Show (Var "x") where 203 | show X = "x" 204 | show Var = "Var" 205 | instance {-# OVERLAPS #-} Show (Var "y") where 206 | show Y = "y" 207 | show Var = "Var" 208 | instance {-# OVERLAPS #-} Show (Var "z") where 209 | show Z = "z" 210 | show Var = "Var" 211 | instance {-# OVERLAPS #-} Show (Var v) where 212 | show _ = "Var" 213 | 214 | {-| Symbol comparison -} 215 | type instance Cmp (v :-> a) (u :-> b) = CmpSymbol v u 216 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Artefact from the POPL'16 paper "Effects as Sessions, Sessions as Effects" 2 | ### by Dominic Orchard, Nobuko Yoshida (Imperial College London) ### 3 | 4 | Effect and session type systems are two expressive behavioural type systems. The former is usually developed in the context of the lambda-calculus and its variants, the latter for the pi-calculus. In our paper we explored their relative expressive power. Firstly, we gave an embedding from PCF, augmented with a parameterised effect system, into a session-typed pi-calculus (session calculus), showing that session types are powerful enough to express effects. Secondly, we gave a reverse embedding, from the session calculus back into PCF, by instantiating PCF with concurrency primitives and its effect system with a session-like effect algebra (Section 6). The embedding of session types into an effect system is leveraged to give an implementation of session types in Haskell, via an effect system encoding (Section 7). *This is the artifact of this paper*, provided as the effect-sessions library. 5 | 6 | Section 6 and 7 are the relevant parts of the paper for the artifact. As explained in Section 7, the implementation is not explicitly designed to be a user-friendly interface for programming with sessions. Instead, it is a fairly direct rendering in Haskell of the encoding of Section 6. Its aim is to give credance to embedding of Section 6 and to provide a new basis for working with session types in Haskell-- but is not a full "end product" in terms of user programming. 7 | 8 | ##### Limitations ##### 9 | There are a number of limitations in the implementation due to the limits of Haskell compared with the variant of PCF in Section 6. Mainly, Haskell has no subtyping or equirecursive types. The former is solved via explicit subtyping combinators in Haskell. The latter (equirecursive types) is solved via restricted forms of recursion, with fixed-points computed at the type-level only for affine effect equations. In practice, this covers a multitude of examples. 10 | 11 | ### Instructions 12 | 13 | * Ensure you have GHC (Glasgow Haskell Compiler). 14 | The latest version of GHC can be downloaded as part of the Haskell Platform for Windows, Linux, or Mac OS X. 15 | 16 | * Install the stm package: 17 | cabal install stm 18 | * Download the library sources 19 | * The library also relies on the effect-monad and type-level-sets libraries. The relevant files from these are included with the download here for ease of use. The files comprising the contribution of the artifact are: 20 | - `Control/Effect/Sessions.hs` 21 | - `Control/Effect/Sessions/Process.lhs` 22 | - `Control/Effect/Sessions/Operations.lhs` 23 | - `Data/Type/FiniteMap.lhs` 24 | - `examples.lhs` 25 | - `effect-sessions.cabal` 26 | 27 | * The examples.lhs file in the top-level directory provides a tutorial-like set of examples showing how to use the library. Open this in GHC interactive mode via: 28 | ~~~~ 29 | $ ghci examples.lhs 30 | ... 31 | Main*> 32 | ~~~~ 33 | Then you are ready to try examples (by using run) and examine the types (e.g., executing :t simpleServer). Please follow the material in examples.lhs, which is a Literate Haskell file. This complements and expands on Section 7 of the paper. 34 | 35 | ### Documentation 36 | 37 | The library has full Haddock [documentation here](http://www.cl.cam.ac.uk/~dao29/popl16/sessions/doc/html/effect-sessions/index.html "Documentation"). 38 | Most useful is the documentation for Control.Effect.Sessions.Operations which explains each combinator provided by the library for concurrency. 39 | The main `examples.lhs` provides tutorial. 40 | 41 | ### Troubleshooting 42 | 43 | If experiencing problems running the examples.lhs, try running `cabal configure` in the top-level directory which should explain more clearly any missing dependencies in your Haskell setup. 44 | 45 | Whilst experimenting the library, the programmer may encounter some harder to read errors. This is a shortcoming of GHC type-level programming: it is hard to get good domain-specific errors. The following provides some hints. 46 | A common cause of errors is not naming channels. Channels should be named whenever there is more than one channel being used in a computation block. If two endpoints of a channel are being bound in new then only one needs to be named. 47 | Occasionally, extra type annotations are needed on primitive types to restrict them from polymorphic to monomorphic instances. e.g., write (x :: Int) <- recv c instead of just x <- recv c. 48 | Check that the error isn't an expected error: e.g., the types of the process don't match up, or a balancing check fails, e.g. NotBal (Bal s). 49 | 50 | ### Notes 51 | 52 | effect-sessions has been tested on the following architectures/versions: 53 | - Mac OS X 10.9.5: GHC 7.8.2, GHC 7.10.1, GHC 8.0.1 54 | - Windows 7, GHC 7.10.2 55 | - Ubuntu 15.04, GHC 7.10.2 56 | effect-sessions relies on the effect-monad and type-level-sets libraries. These are included with the download here for ease of use. These can also be installed via cabal (cabal install effect-monad, cabal install type-level-sets). 57 | effect-sessions itself can be installed (though this isn't necessary for experimenting with the examples) via: 58 | ~~~~ 59 | cabal configure 60 | cabal build 61 | cabal install 62 | ~~~~ 63 | 64 | Depending on your setup, the last command 'cabal install' may require super-user privileges. 65 | 66 | ### Acknowledgments 67 | 68 | Thanks to Julien Lange and Bernardo Toninho for their comments and testing. Any remaining issues are my own. 69 | -------------------------------------------------------------------------------- /effect-sessions.cabal: -------------------------------------------------------------------------------- 1 | name: effect-sessions 2 | version: 1.0 3 | synopsis: Sessions and session types for Concurrent Haskell 4 | description: Provides an implementation of sessions ontop 5 | of Concurrent Haskell, where session types are 6 | effect types via effect-monad. 7 | 8 | copyright: 2015 Imperial College London 9 | author: Dominic Orchard, Nobuko Yoshida 10 | stability: experimental 11 | build-type: Simple 12 | cabal-version: >= 1.6 13 | tested-with: GHC >= 7.8.1 14 | 15 | exposed-modules: Control.Effect.Sessions.Process, 16 | Control.Effect.Sessions, 17 | Control.Effect.Sessions.Operations, 18 | Data.Type.FiniteMap 19 | 20 | build-depends: base < 5, 21 | ghc-prim, 22 | effect-monad, 23 | stm > 2.4, 24 | type-level-sets 25 | 26 | 27 | -- ghc-options: -fglasgow-exts 28 | -------------------------------------------------------------------------------- /examples.lhs: -------------------------------------------------------------------------------- 1 | This document is a tutorial with various examples for using the 2 | 'Session types as an effect system' encoding, translated into Haskell, 3 | provided by our Control.Effect.Session library. 4 | 5 | The internals of the library can be explored in: 6 | Control/Effect/Sessions.hs 7 | Control/Effect/Sessions/Process.lhs 8 | Control/Effect/Sessions/Operations.lhs 9 | Or via the haddock documentation at: 10 | http://www.doc.ic.ac.uk/~dorchard/sessions/doc/html/effect-sessions/Control-Effect-Sessions.html 11 | 12 | Note that all the examples here have session types (embedded in effect types) 13 | that are inferred by GHC (given only some type signatures to name channels). This 14 | inference reduces programmer effort and eases development and verification. 15 | 16 | ****** Setup 17 | 18 | First, some language extensions and modules are required: 19 | 20 | > {-# LANGUAGE RebindableSyntax, DataKinds, TypeOperators, GADTs, ScopedTypeVariables, 21 | > FlexibleInstances, FlexibleContexts #-} 22 | 23 | > import Prelude hiding (Monad(..), print, putStrLn) -- hide the usual Monad 24 | > import Control.Effect.Sessions -- our library 25 | 26 | > import GHC.Exts (Constraint) 27 | 28 | The 'Msg' data type will be used throughout. 29 | 30 | > data Msg = Ping | Pong deriving Show 31 | 32 | All the examples from this file can be run in one go from here 33 | to get their outputs. 34 | 35 | > main = run $ 36 | > do putStrLn "Running all examples in this file...\n" 37 | > putStrLn "Simple send-receive example:" 38 | > simple 39 | > putStrLn "\nSend-receive with multiple channels:" 40 | > incProc 41 | > putStrLn "\nDelegation example: " 42 | > simpleDelg 43 | > putStrLn "\nExample 4 from the paper: " 44 | > process 45 | > putStrLn "\nConditionals (alternation): " 46 | > condProc 47 | > putStrLn "\nRecursion example, modelling replication in the session calculus: " 48 | > repProc 49 | > putStrLn "\nDone!" 50 | 51 | ****** Simple sending and receiving 52 | 53 | The first example gives two processes: 'simpleServer' which receives a message 54 | from 'simpleClient'. 55 | 56 | > simpleServer c = do x <- recv c 57 | > putStrLn $ "Received: " ++ x 58 | > 59 | > simpleClient c = do send c "Hello" 60 | > 61 | > simple = new $ \(c, c') -> simpleClient c `par` simpleServer c' 62 | 63 | This program can be run using ghci as follows: 64 | 65 | $ ghci examples.lhs 66 | 67 | Main*> run simple 68 | "Received: Hello" 69 | Main*> 70 | 71 | Depending on your system, you might get an output that overlaps 72 | the output message with the prompt message, e.g. 73 | 74 | Main*> run simple 75 | "ReMain*>cieved: Hello" 76 | 77 | This is normal: it is a result of the process 'simple' running in parallel 78 | with GHCi and interleaving output to the console. 79 | 80 | This example combines three elements: sending/receiving, 'new' 81 | channels, and 'parallel composition' via 'par. The session types of 82 | each component can be queried: 83 | 84 | *Main> :t simpleServer 85 | simpleServer :: Chan c -> Process '[c ':-> ([Char] ':? 'End)] () 86 | 87 | *Main> :t simpleClient 88 | simpleClient :: Chan c -> Process '[c ':-> ([Char] ':! 'End)] () 89 | 90 | *Main> :t simple 91 | simple :: Process '[] () 92 | 93 | This shows the inferred session types for the server, client, and 94 | composed whole. (Note '[Char]' is often aliased by Haskell to 95 | 'String') Since there are no free channels in 'simple', then it can be 96 | run via 'run :: Process '[] a -> IO a'. We see that 'simpleServer' 97 | receives a string then stops, and 'simpleClient' send a string. 98 | 99 | The 'new' combinator models $\nu$ from the session calculus, taking a 100 | function mapping from a pair of two endpoints for a channel to a 101 | process. We'll examine its type along with channel naming next. 102 | 103 | ****** Naming and endpoints 104 | 105 | Once we start using multiple channels we will need to explicitly 106 | name these with additional type signatures. Here's an example. 107 | 108 | > incServer (c :: Chan (Ch "c")) (d :: (Chan (Ch "d"))) = 109 | > do x <- recv c 110 | > send d (x + 1) 111 | 112 | > incClient (c :: Chan (Op "c")) (d :: (Chan (Op "d"))) = 113 | > do send c 42 114 | > x <- recv d 115 | > putStrLn $ "Got " ++ show x 116 | 117 | Names comprise either 'Ch' or 'Op' of a type-level symbol. In the 118 | above, the server 'incServer' has channels named 'Ch "c"' and 'Ch "d"' 119 | whereas 'incClient' has 'Op "c"' and 'Op "d"'-- the names of the opposite 120 | endpoints. These explicit names must be unique. This is a necessary 121 | part of the encoding due to Haskell limitations [aside: existentials could 122 | be used for (fresh) names, but this does not interact well with the type-level 123 | encoding of finite maps]. 124 | 125 | These two processes are then composed via: 126 | 127 | > incProc = new $ \(c, c') -> new $ \(d, d') -> incServer c d `par` incClient c' d' 128 | 129 | Again we can run this: 130 | 131 | $ ghci examples.lhs [if you haven't already loaded it] 132 | 133 | *Main> run incProc 134 | "Got 43" 135 | 136 | And we can query the inferred session types, e.g. 137 | 138 | Main*> :t incServer 139 | 140 | incServer 141 | :: Num t => 142 | Chan ('Ch "c") 143 | -> Chan ('Ch "d") 144 | -> Process 145 | '['Ch "c" ':-> (t ':? 'End), 'Ch "d" ':-> (t ':! 'End)] () 146 | 147 | Here we see the session types of the two channels "c" and "d", which receive 148 | and send a value of type 't' which is a member of the 'Num' class. 149 | 150 | Looking at the type of 'new' we can see that it generates two dual 151 | endpoints of a channel and passes them to a process function, and 152 | checking duality of their usage in the parameter process: 153 | 154 | *Main> :t new 155 | new :: DualP (env :@ 'Ch c) (env :@ 'Op c) => 156 | ((Chan ('Ch c), Chan ('Op c)) -> Process env a) 157 | -> Process ((env :\ 'Op c) :\ 'Ch c) a 158 | 159 | That is, check that "Ch c" and "Op c" are dual in "env" (lookup is via ':@') and then 160 | in the returned process, remove them from the environment (via ':\'). 'DualP' is a 161 | binary predicate (relation) for duality of session types (defined in 162 | Control.Effect.Sessions.Process). 163 | 164 | ****** Delegation 165 | 166 | Here is an example using delegation, which is essentially 'Example 4' 167 | in the paper (p.11). 168 | 169 | Consider the following process 'serverD' 170 | which receives a channel 'd' on 'c', and then sends a 'Ping' on it: 171 | 172 | > serverD (c :: (Chan (Ch "c"))) = do chRecvSeq c (\(d :: Chan (Ch "x")) -> send d Ping) 173 | 174 | Note, the variable name 'd' and the channel name 'Ch "x"' do not have to match. 175 | [chRecvSeq is a simplified version of chRecv] 176 | 177 | The type of 'serverD' is inferred as: 178 | 179 | serverD :: Chan ('Ch "c") 180 | -> Process '['Ch "c" ':-> ('Delg (Msg ':! 'End) ':? 'End)] () 181 | 182 | This explains that along the channel we receive a delegated session channel 183 | on which a 'Msg' can be sent. 184 | 185 | We then define a client to interact with this that binds d (and its dual d'), 186 | then sends d over c and waits to receive a ping on d'. 187 | 188 | > clientD (c :: Chan (Op "c")) = 189 | > new (\(d :: (Chan (Ch "d")), d') -> 190 | > do chSend c d 191 | > Ping <- recv d' 192 | > putStrLn "Client got a ping") 193 | 194 | > simpleDelg = new $ \(c, c') -> serverD c `par` clientD c' 195 | 196 | Let's examine the type of |clientD|: 197 | 198 | *Main> :t clientD 199 | clientD 200 | :: (DualP s (Msg ':? 'End), Dual s ~ (Msg ':? 'End)) => 201 | Chan ('Op "c") -> Process '['Op "c" ':-> ('Delg s ':! 'End)] () 202 | 203 | Looking at the body of the type, and not the constraint (before =>), 204 | we see that the 'Op "c"' channel endpoint has a channel sent over it 205 | with session type 's'. The constraint explains that the dual of 's' 206 | must be 'Msg :? 'End'. This constraint later gets satisfied when 207 | 'serverD' and 'clientD' are composed in parallel and restricted over 208 | by 'new'. 209 | 210 | Here is Example 4 exactly as it appears in the paper (which is similar to 211 | the above example): 212 | 213 | > client (c :: (Chan (Ch "c"))) 214 | > = new (\(d :: (Chan (Ch "d")), d') -> 215 | > do chSend c d 216 | > Ping <- recv d' 217 | > print "Client: got a ping") 218 | > 219 | > server c = do { k <- chRecv c; k (\x -> send x Ping) } 220 | > process = new (\(c, c') -> (client c) `par` (server c')) 221 | > 222 | 223 | Main*> run process 224 | "Client got a ping" 225 | 226 | Here's a slight variation, combining value and delegation communication. 227 | 228 | > clientV (c :: (Chan (Ch "c"))) 229 | > = new (\(d :: (Chan (Ch "d")), d') -> 230 | > do chSend c d 231 | > send c Ping 232 | > Ping <- recv d' 233 | > print "Client: got a ping") 234 | > 235 | > serverV c = do k <- chRecv c 236 | > k (\(x :: Chan (Ch "x")) -> do Ping <- recv c 237 | > send x Ping) 238 | > 239 | > processV = new (\(c, c') -> (client c) `par` (server c')) 240 | 241 | ****** Alternation 242 | 243 | The usual 'case' and 'if' constructs of Haskell can be used, but since 244 | Haskell does not have subtyping, any subeffecting that would occur in 245 | fPCF must be inserted explicitly via the 'sub' combinator. There are a 246 | number of specialised variants provided by the library for common cases 247 | of subeffecting: 248 | 249 | subL :: Process '[c :-> s] a -> Process '[c :-> s :+ t] a 250 | subR :: Process '[c :-> t] a -> Process '[c :-> s :+ t] a 251 | subEnd :: Chan c -> Process '[] a -> Process '[c :-> End] a 252 | 253 | where 'subL' and 'subR' are used to introduce the upper bound :+ 254 | effect type and 'subEnd' essentially provides a kind of weakening. 255 | 256 | The following shows an example: 257 | 258 | > condServer (c :: (Chan (Ch "x"))) = 259 | > do (l :: Int) <- recv c 260 | > case l of 0 -> subL $ send c True 261 | > n -> do (x :: Bool) <- subR $ recv c 262 | > return () 263 | 264 | The server receives an Int. If its 0 then it sends back 'True' 265 | else it waits to receive a 'Bool' before stopping. The inferred type 266 | of the server explains this protocol: 267 | 268 | *Main> :t condServer 269 | condServer 270 | :: Chan ('Ch "x") 271 | -> Process 272 | '['Ch "x" ':-> (Int ':? ((Bool ':! 'End) ':+ (Bool ':? 'End)))] () 273 | 274 | This is then composed in parallel with a dual client to make 'condProc' 275 | 276 | > condClient c' = do send c' (0 :: Int) 277 | > case 0 of 0 -> do { (x :: Bool) <- subL $ recv c'; print x } 278 | > n -> subR $ send c' False 279 | 280 | > condProc = new (\(c :: (Chan (Ch "x")), c') -> 281 | > (condServer c) `par` (condClient c')) 282 | 283 | *Main> run condProc 284 | True 285 | 286 | Note that 'condClient' does not happen to need an explicit channel 287 | name for c' since it is the only channel used in the 288 | computation. However, examining the type (via :t condClient in GHCi) 289 | reveals a large, unwieldy type, that exposes a lot of the internals of 290 | managing type-level finite sets. This is due to GHC expanding all the 291 | type functions as far as it can go, which is not the ideal behaviour 292 | for users. The clutter can be reduced by giving an explicit name to 293 | c', although we choose to leave it polymorphic in the channel name 294 | here for illustration. 295 | 296 | ****** Fixed-points 297 | 298 | Since Haskell does not have equi-recursive types, the full encoding of 299 | Section 6 cannot be directly embedded. Instead, we have opted for a 300 | mid-point, a restricted form of recursive processes is allowed: those 301 | whose fixed-point effect equation is *affine*. That is given an effect 302 | type that can be simplified (via some type-level normalisation) into x 303 | |-> a x + b then the effect type x = a* b is computed. 304 | 305 | The following gives the Haskell rendering of equation (19), p. 9, 306 | which for some channel 'c' and (encoded) process 'p', embeds 307 | '*c?(d).p', the replicated input of a channel 'd' along 'c', which is 308 | then bound in the scope of 'p'. 309 | 310 | > -- the type signature is not strictly necessary here, but is included for clarity 311 | > repInp :: (Chan (Ch "c")) -> (Chan (Ch "d") -> Process '[Ch "d" :-> s] ()) 312 | > -> (Process '[Ch "c" :-> Fix (Int :? ((Delg s) :? Star)) (Int :? End)] ()) 313 | > repInp c p = affineFix (\f -> \() -> 314 | > do (x :: Int) <- recv c 315 | > case x of 0 -> subL $ subEnd c $ return () 316 | > n -> subR $ do { k <- chRecv c; (k p) `par` (f ()) }) () 317 | 318 | As described in Section 6, replicated input proceeds by repeatedly 319 | receiving first an integer 'x' which signifies whether to stop 320 | receiving if x = 0 (the 'garbage collect' action) or to receive a 321 | channel and recurse if x > 0. Note again the use of explicit 322 | subeffecting which is needed in Haskell, whereas FPCF assumes the 323 | ability to implicitly insert subeffecting casts. 324 | 325 | For example, we might have a server that repeatedly receives and 326 | prints a message using the recursive 'repInp' process above. 327 | 328 | > serverA (c :: (Chan (Ch "c"))) = 329 | > repInp c (\(d :: (Chan (Ch "d"))) -> do (x :: Msg) <- recv d 330 | > print x) 331 | 332 | A number of clients can then have some finite number of repeated 333 | interactions with the server. 334 | 335 | > clientA (c :: (Chan (Op "c"))) = new (\(d :: Chan (Ch "d"), d') -> 336 | > do -- Send a ping 337 | > send c (1 :: Int) 338 | > rsend c d 339 | > send d' Ping) 340 | 341 | > clientB (c :: (Chan (Op "c"))) = new (\(d :: (Chan (Ch "d")), d') -> 342 | > do -- Send a pong 343 | > send c (1 :: Int) 344 | > rsend c d 345 | > send d' Pong) 346 | 347 | > repProc = new $ \(c, c') -> do (serverA c) `par` (do (clientA c') `par` (clientB c') 348 | > send c' (0 :: Int)) -- end the server 349 | 350 | 351 | [Note, with GHC 7.10.1 on Mac OS X, we noticed that 'run repProc' 352 | occasionally causes a runtime SegFault. This bug appears to be with 353 | the runtime for 7.10.1 and does not occur in GHC 7.8.* or GHC 7.10.2.] 354 | 355 | ---------------------- 356 | 357 | ******* Ill-typed erroneous processes 358 | 359 | The following are some examples of processes which fail to type check, either as is, 360 | or when composed with 'run'. This is a good thing, because these processes 361 | are erroneous! The types are doing their job. 362 | Uncomment them one at a time to see how they fail. 363 | 364 | * Non-dual behaviours 365 | 366 | Consider an erroneous permutation of the first example, 'simple'> 367 | 368 | > simpleServerE c = do x <- recv c 369 | > putStrLn $ "Received: " ++ x 370 | > y <- recv c 371 | > putStrLn $ "Received: " ++ y 372 | > 373 | > simpleClientE c = do send c "Hello" 374 | 375 | 'simpleServerE' receives two values, but only one is sent by the client. 376 | Uncomment the following line to fine the type error 377 | 378 | > -- Uncomment below to see the expected type error 379 | > -- simpleE = new $ \(c, c') -> simpleClientE c `par` simpleServerE c' 380 | 381 | GHC reports: 382 | 383 | Could not deduce (DualP 'End ([Char] ':? 'End)) 384 | 385 | Thus, we see that 'End (from the client) is not dual to the additional 386 | [Char] :? End operation of the server. 387 | 388 | * Unbalanced delegation behaviour. 389 | 390 | This example shows further how the balancing predicate inside the composition works. 391 | If we send a channel and then use it, this is 'unbalanced' behaviour: 392 | 393 | > unbalanced (c :: (Chan (Ch "c"))) (d :: Chan (Ch "d")) = do chSend c d; send d "Hello" 394 | 395 | If you look at the type of 'unbalanced', you will see that it has the constraint 396 | that 'NotBal (Bal s)', which can never be satisfied: 'NotBal' is a predicate on all 397 | session types apart from 'Bal' session types. [Furthermore, 'NotBal' is a 'closed class' 398 | and so cannot be maliciously extended with a 'Bal' instance in another file]. 399 | 400 | * Non-deterministic behaviour 401 | 402 | Session types rule out non-deterministic behaviours, for example, they reject 403 | the pi-calculus term: (c?(x).P | c?(x).Q | c!<0>) which non-deterministically 404 | reduces to either P or Q. This is ruled out by balancing, and thus by the 405 | 'balanced' predicate in 'par that checks all the right-hand session types 406 | are used in balanced way to the left. 407 | This rejects the encoding of the non-deterministic pi-calculus term above: 408 | 409 | > --badServer (c :: (Chan (Ch "c"))) = do { recv c; return () } `par` do { recv c; return () } 410 | > --badProc = new (\(c, c') -> badServer c `par` (send c' True)) 411 | 412 | If just 'badServer' is uncommented, we see in its type the unsatisfiable constraint 413 | of NotBal (Bal (a :? End)). When both are uncommented this error arises directly. 414 | -------------------------------------------------------------------------------- /popl16artifact.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Artifact for "Effects as sessions, sessions as effects" 4 | 5 | 6 | 26 | 27 | 28 |

Artifact for Effects as sessions, sessions as effects (preprint PDF)

29 |

Dominic Orchard, Nobuko Yoshida (Imperial College London)

30 | 31 |

32 | Effect and session type systems are two expressive behavioural type 33 | systems. The former is usually developed in the context of the 34 | lambda-calculus and its variants, the latter for the pi-calculus. In 35 | our paper we explored their relative expressive power. Firstly, we 36 | gave an embedding from PCF, augmented with a parameterised effect 37 | system, into a session-typed pi-calculus (session calculus), showing 38 | that session types are powerful enough to express effects. Secondly, 39 | we gave a reverse embedding, from the session calculus back into PCF, 40 | by instantiating PCF with concurrency primitives and its effect system 41 | with a session-like effect algebra (Section 6). The embedding of session types 42 | into an effect system is leveraged to give an implementation of 43 | session types in Haskell, via an effect system encoding (Section 44 | 7). This is the artifact of this paper, provided as the 45 | effect-sessions library.

46 | 47 |

48 | Section 6 and 7 49 | are the relevant parts of the paper for the artifact. As explained in 50 | Section 7, the implementation is not explicitly designed to be a 51 | user-friendly interface for programming with sessions. Instead, it is 52 | a fairly direct rendering in Haskell of the encoding of Section 6. 53 | Its aim is to give credance to embedding of Section 6 and to 54 | provide a new basis for working with session types in 55 | Haskell-- but is not a full "end product" in terms of user programming. 56 |

57 | 58 |

59 | Limitations. There are a number of limitations in the implementation 60 | due to the limits of Haskell compared with the variant of PCF in Section 6. 61 | Mainly, Haskell has no subtyping or equirecursive types. The former is solved 62 | via explicit subtyping combinators in Haskell. The latter (equirecursive types) 63 | is solved via restricted forms of recursion, with fixed-points computed at the 64 | type-level only for affine effect equations. In practice, this covers a multitude 65 | of examples. 66 |

67 |
68 | 69 |

Instructions

70 | 71 | 122 | 123 |

Documentation

124 | 125 | 130 | 131 |

Troubleshooting

132 | If experiencing problems running the examples.lhs, try running cabal configure in 133 | the top-level directory which should explain more clearly any missing dependencies in your Haskell 134 | setup.

135 | 136 | Whilst experimenting the library, the programmer may encounter some harder to read errors. 137 | This is a shortcoming of GHC type-level programming: it is hard to get good domain-specific errors. 138 | The following provides some hints.
139 | 149 | 150 |

Notes

151 | 152 | 162 | 163 | 175 | 176 |

Acknowledgments

177 | 178 | Thanks to Julien Lange and Bernardo Toninho for their comments and testing. Any remaining issues 179 | are my own. 180 | 181 |
182 |
183 | Last modified: Tue Oct 13 12:28:40 BST 2015 184 | 185 | --------------------------------------------------------------------------------