2013-2014 Matteo Acerbi

Dependent sessions in Agda [WIP]

module Session where

open import Session.Base public

Types

The syntax for types is heavily inspired by both Strictly Positive Families (the version in Peter Morris's PhD thesis) and (indexed) Descriptions (Chapman et al, "The Gentle Art of Levitation").

In our case, however, we do not want to describe indexed functors: we just want to be able to close the language under a (greatest) fixpoint operator/binder `nu, allowing nested usages thanks to a "well-typed Bird-Paterson" encoding of binding.

To compare with the cited universes, note that if we tried to give a (I → Set) → (O → Set) semantics to the `I, , , codes we would have to ignore the input of type O: in any case, such an interpretation would not make much sense here.

As opposed to Wadler's CP, the typing rules for the additional constructors , , ¡, ¿ will not correspond directly to those of classical linear logic: however, the corresponding syntax maintains similar operational meaning (channel transmission and client/server interactions).

We add a type called Side (endpoint of a channel), with two only inhabitants: +, - . Entry is a type of optionally "sided" (session typed) codes, where absence of a side corresponds to the session not having started yet.

When a Side is specified, the Entry corresponds to an obligation for the process that contains it in its (input) context: if it is + then the session type is to be interpreted without changes, otherwise the process must behave along that channel by following the dual obligation (receiving vs sending, reading vs writing, connecting vs accepting).

Note that for what concerns _⊗_ and _⅋_ a whole Entry is required as the description of how a process participates to a channel needs to be preserved by the transfer.

mutual 

  De    = λ I  I  
  Code  = Σ _ λ I  Σ _ λ O  I  O
  Entry = 1+ Side × Code

  data _▹_ (I O : Set) : Set₁ where
    `I      :                     (i : I)  I  O
        : (S : Set)(T : I  S)         I  O
    `^      : (T : O  De I)               I  O
    _⊗_ _⅋_ : (L : Entry)(R : I  O)       I  O
    ¡_ ¿_   : Code                         I  O
          : (F : O  De (I  O))(o : O)  I  O
`Σ^ `Π^ : {I O : Set}(S : Set)(T : S  De I)  I  O
`Σ^ S T =  S (`^ T)
`Π^ S T =  S (`^ T)
_◂_ : Set  Set  Set₁
O  I = I  O

This representation of the language of types should not be considered definitive but it seems reasonably effective.

Other approaches, where the session types inductive definition _▹_ would only have one parameter (as in Descriptions), seemed more difficult to implement and led to more awkward encodings of the syntax: we probably did not try all the possibilities, though.

Types and sides

A "sided" type former (code) [_]F is the type former (code) F when the side is +, the dual of F when it is -.

[_]Σ   [_]Π   : Side   {I O : Set}(S : Set)(T : I  S)     I  O
[_]Σ^  [_]Π^  : Side   {I O : Set}(S : Set)(T : S  De I)  I  O
_[_]⊗_ _[_]⅋_ : Entry  Side  {I O : Set}  I  O          I  O
[_]¡_  [_]¿_  : Side   Code   {I O : Set}                 I  O
[ +      = 
[ -      = 
[ +      =  
[ -      =  
[ s ]Σ^ S T = [ s  S (`^ T)
[ s ]Π^ S T = [ s  S (`^ T)
L [ + ]⊗ R = L  R
L [ - ]⊗ R = L  R
L [ + ]⅋ R = L  R
L [ - ]⅋ R = L  R
[ +  F   = ¡ F    
[ -  F   = ¿ F    
[ + ]¿ F   = ¿ F     
[ - ]¿ F   = ¡ F

Contexts

A context is a simple list of entries, i.e. codes paired with an optional side. Absence of the side corresponds to the session not being started yet: in this situation we say that the channel is "new".

Cx = List Entry

is¿ means "is it safe to duplicate this entry?".

is¿ : Entry  Set
is¿ (> + , (_ , _ , ¿ F)) = 
is¿ (> - , (_ , _ , ¡ F)) = 
is¿  _                    = 

To construct a server we must check (at compile time) that it will be safe to duplicate all the channels that its runtime copies will have access to: All¿ is the predicate over contexts which corresponds to this condition.

All¿ : Cx  Set _
All¿ = All is¿

Splitting contexts

We need to define what it means to split an (input) context in two.

data SplitNew : Set where 
  + - +- -+ : SplitNew

Split : 1+ Side × Code  Set
Split (> _ , x) = Side
Split (ε   , x) = SplitNew

split : (τ : 1+ Side × Code)  Split τ  Cx × Cx  Cx × Cx
split (> s , C)  + (L , R) = (L  (> s , C)) ,  R
split (> s , C)  - (L , R) =  L              , (R  (> s , C))
split (ε   , C)  + (L , R) = (L  (ε   , C)) ,  R
split (ε   , C)  - (L , R) =  L              , (R  (ε   , C))
split (ε   , C) +- (L , R) = (L  (> + , C)) , (R  (> - , C))
split (ε   , C) -+ (L , R) = (L  (> - , C)) , (R  (> + , C))

At fork time, if Γ is the input context, the user is asked to inhabit a Splits Γ, whose meaning as a pair of contexts is given by splits.

Splits :  Γ  Set _
Splits = All Split

splits :  {Γ}  Splits Γ  Cx × Cx
splits []       = [] , []
splits (ds  s) = split _ s (splits ds)

all-splits is a generic functions which allows to lift splits to "boxed" predicates.

all-splits :  {lP}{P : Code  Set lP}{Γ} 
                     All (P  snd) Γ 
                (d : Splits Γ)        
                     All (P  snd) (fst (splits d))
                   × All (P  snd) (snd (splits d))
all-splits                      ps       []         =
  [] , []
all-splits {Γ = Γ  (ε   , C)} (ps  p) (ds     +) =
  Σ.map (flip _,̇_ p)  id          (all-splits ps ds)
all-splits {Γ = Γ  (ε   , C)} (ps  p) (ds     -) =
  Σ.map  id          (flip _,̇_ p) (all-splits ps ds)
all-splits {Γ = Γ  (ε   , C)} (ps  p) (ds    +-) = 
  Σ.map (flip _,̇_ p) (flip _,̇_ p) (all-splits ps ds)
all-splits {Γ = Γ  (ε   , C)} (ps  p) (ds    -+) =
  Σ.map (flip _,̇_ p) (flip _,̇_ p) (all-splits ps ds)
all-splits {Γ = Γ  (> _ , C)} (ps  p) (ds     +) = 
  Σ.map (flip _,̇_ p)  id          (all-splits ps ds)
all-splits {Γ = Γ  (> _ , C)} (ps  p) (ds     -) = 
  Σ.map  id          (flip _,̇_ p) (all-splits ps ds)

We use some patterns to deal more easily with dependent tuples and objects of type Entry.

pattern %_  x = _ , x
pattern %2_ x = % %  x
pattern %3_ x = % %2 x
pattern %4_ x = % %3 x

pattern »»_ x = > + , %2 x
pattern _«« x = > - , %2 x

Terms

Introduction

Here we would like to provide a human-readable representation of the syntax which is encoded below, also discussing the choice of encoding.

For now we limit ourselves to illustrating the Agda code step-by-step.

Functors

We define several (indexed) functors: we will obtain our process syntax by taking their fixpoint. While in the future we plan to move to codes for a universe of functors such as the ones cited above, for the purpose of illustrating the method we do not want to add further complications.

Most of the productions are non-recursive, so we will first define some families in Ty.

private Ty = Cx  Cx  Set₁

The functor corresponding to the new grammar production/constructor simply imposes that the output context contains a new channel, i.e. a channel whose side is ε (Maybe.nothing).

New : Ty
New Γ Δ = Σ _ λ F  Δ  Γ  ε , F

We can send and receive channels along channels: in the former case the sent session type is omitted from the output context, in the latter the context is extended with the entry corresponding to the received channel.

Send Receive : Ty
Send Γ Δ = Σ (Entry × Side × Code) λ W 
           let L , s , %2 R = W in
           Σ (                      L  Γ   ) λ i 
           Σ ((> s , %2 (L [ s ]⊗ R))  rm i)
             (_≡_ Δ  ud (> s , _ , _ , R))
Receive Γ Δ = Σ (Side × _ × Code) λ W 
              let s , L , _ , _ , R = W in
              Σ ((> s , %2 (L [ s ]⅋ R))  Γ) λ i  
                Δ  ud (> s , %2 R) i  L

Writing to and reading from channels changes the type accordingly, without necessarily introducing dependencies.

Write Read : Ty
Write Γ Δ = Σ (Σ Code λ { (I , J , T)  J × Side × Set }) λ W 
            let (I , J , T) , j , s , O = W in
            Σ ((> s , I , O , [ s  J T)  Γ)
              (_≡_ Δ  ud (> s , %2 T))
Read Γ Δ = Σ (Code × Side × _) λ W 
           let (I , J , T) , s , O = W in
           Σ ((> s , I , O , [ s  J T)  Γ)
             (_≡_ Δ  ud (> s , %2 T))

This functor "consumes" `^ from the session type: it "allows" you to choose a value from which the rest of the type is dependent, but most often this value will be forced by the type.

At : Ty
At Γ Δ = Σ (Σ _ λ I  Σ _ λ O  Σ (O  De I) λ _  O × Side) λ W 
         let I , O , T , o , s = W in
         Σ ((> s , %2 `^ T)  Γ)
            (_≡_ Δ  ud (> s , %2 T o))

Session types have "identity" codes `I as leaves, so to end a session we need to consume it and remove the type from the context.

End : Ty
End Γ Δ = Σ (Σ Set λ I  Set × I × Side) λ W 
          let I , O , i , s = W in
          Σ ((> s , (I , O , `I i))  Γ)
            (_≡_ Δ  rm)

The following definitions are actual (strictly positive) indexed functors: calls to the F argument correspond to recursion in the grammar.

When forking, we need to split the input context sensibly (see Splits above): the child must do all ΓR, the continuation must do ΓL.

Fork : Ty  Ty
Fork F Γ Δ = Σ (Splits Γ) λ ds 
             let ΓL , ΓR = splits ds in
               F ΓR []
             × Δ  ΓL

A server process can only be launched in a context where it is possible to duplicate all channels.

The server is located on the + side of the channel.

Server : Ty  Ty
Server F Γ Δ = Σ (Code × Side × _) λ W  let A , s , I , O = W in
               Σ ((> s , I , O , [ s  A)  Γ) λ i 
                 All¿ Δ
               × F (ud (> + , A) i) Δ
               × Δ  rm i

The client is positioned on the - side of the channel.

In this case execution is synchronous: we account for the fact that the client might also interact on some other channels by passing Δ to F.

Client : (Set  Ty)  Set  Ty
Client F X Γ Δ = Σ (Code × Side × _) λ W  let A , s , I , O = W in
                 Σ ((> s , I , O , [ s ]¿ A)  Γ) λ i 
                   F X (ud (> - , A) i) Δ

We are free to run clients as many times as we want (Ctr), or even refrain from doing so (Wk).

Wk Ctr : Ty
Wk Γ Δ = Σ (Code × Side × _) λ W 
         let A , s , I , O = W in
         Σ ((> s , I , O , [ s ]¿ A)  Γ)
           (_≡_ Δ  rm)
Ctr Γ Δ = Σ (Code × Side × _) λ W 
          let A , s , I , O = W in
          let τ = > s , I , O , [ s ]¿ A in
            τ  Γ
          × Δ  Γ  τ

To add corecursion, we must first define what we consider a guarded (hence, hopefully, productive) session.

Guarded :  {I O}  I  O  Set₁
Guarded (`I i    ) = 
Guarded ( S T  ) = 
Guarded ( S T  ) = 
Guarded (`^ T    ) =  s  Guarded (T s)
Guarded (%3 L  R) = Guarded R
Guarded (%3 L  R) = Guarded R
Guarded (¡ F     ) = 
Guarded (¿ F     ) = 
Guarded ( F _  ) =  o  Guarded (F o)

To provide syntax to productive nested loops that run for a possibly infinite amount of time, we use the following definition:

CoRec : (Set  Ty)  Set  Ty
CoRec F X Γ Δ = Σ (Side × Σ _ λ I  Σ _ λ O  (O  De (I  O)) × O) λ W 
                let s , I , O , T , o = W in 
                Σ ((> s , %2  T o)  Γ) λ i 
                  ((o : O)    Guarded (T o)
                             × F (X  O) (ud (> s , %2 T o) i) Δ)
                × Δ  rm i

Tags

We adopt a "tagful" syntax, where nodes of the syntax tree are made of dependent pairs whose first component is of type Tag.

module T where

  data Tag : Set where
    new fork       : Tag
    send recv      : Tag
    !! ?? wk ctr   : Tag
    corec          : Tag
    write read     : Tag
    at             : Tag
    end            : Tag

open T using (Tag)

The tagged family of functors

The type of the second component is given by the following family, which groups all the above functors.

π : Tag  (Set  Ty)  Set  Ty
π T.new   T X Γ Δ = New          Γ Δ                 × X  
π T.fork  T X Γ Δ = Fork   (T X) Γ Δ                 × X  
π T.send  T X Γ Δ = Send         Γ Δ                 × X  
π T.recv  T X Γ Δ = Receive      Γ Δ                 × X  
π T.!!    T X Γ Δ = Server (T X) Γ Δ                 × X  
π T.??    T X Γ Δ = Client  T X  Γ Δ
π T.wk    T X Γ Δ = Wk           Γ Δ                 × X  
π T.ctr   T X Γ Δ = Ctr          Γ Δ                 × X  
π T.corec T X Γ Δ = CoRec   T X  Γ Δ
π T.write T X Γ Δ = Write        Γ Δ                 × X  
π T.read  T X Γ Δ = Σ (Read Γ Δ) λ p                           
                    let ((_ , J , _) , _) , _ = p in   X  J       
π T.at    T X Γ Δ = Σ (At Γ Δ) λ p 
                    let (_ , O , _) , _ = p in         X  O
π T.end   T X Γ Δ = Σ (End  Γ Δ) λ p                              
                    let (I , _ , _) , _ = p in         X  I

Process terms

As already stated, we plan to adopt codes for indexed functors instead of defining those directly. We could then simply use a generic indexed free monad construction, as in McBride's "Kleisli Arrows of Outrageous Fortune", encoding our "Atkey-style" parameterisation in the way described there.

To make things simpler we use the following definition for now: this is neither a monad nor a monad transfomer, it is just convenient temporary syntax.

module Process where

  infix 2 _[_⊢_]>_

  F = λ T X Γ Δ  Σ T.Tag λ t  π t T X Γ Δ

  data _[_⊢_]>_ Γ (M : Set  Set) X : Cx  Set₁ where
    ⇑_    :             M X                                 Γ [ M  X ]> Γ
    [_]   :  {Δ}      F  Z A B  A [ M  Z ]> B) X Γ Δ  Γ [ M  X ]> Δ
    _»=_  :  {Ξ Δ Y}  Γ [ M  Y ]> Ξ                      
                   (Y  Ξ [ M  X ]> Δ)                     Γ [ M  X ]> Δ

open Process using (_[_⊢_]>_ ; ⇑_ ; _»=_ ; [_]) public

Note that referring to the above operators as "strictly positive functors" as we did, while very reasonable from their definitions, is also justified by the fact that Agda's positivity checker accepts _[_⊢_]>_.

Syntactic sugar

Patterns

To construct and pattern match on processes we make extensive use of Agda's pattern facility.

pattern fork    d x    = [ T.fork  , (d , x , <>)                 , <> ] 
pattern new            = [ T.new   , (_ , <>)                     , <> ] 
pattern send    i j    = [ T.send  , % (i , j , <>)               , <> ] 
pattern receive i      = [ T.recv  , % (i , <>)                   , <> ] 
pattern accept  i a p  = [ T.!!    , % (i , a , p , <>)           , <> ] 
pattern connect i   p  = [ T.??    , % (i , p)                         ] 
pattern wont    i      = [ T.wk    , % (i , <>)                   , <> ] 
pattern twice   i      = [ T.ctr   , % (i , <>)                   , <> ] 
pattern write   i x    = [ T.write , ((_ , x , _) , i , <>)       , <> ] 
pattern read    i      = [ T.read  , % (i , <>)                   , <> ] 
pattern end/    i r    = [ T.end   , ((_ , _ , r , _) , (i , <>)) , <> ] 
pattern end     i      = end/ i _
pattern at/     i o    = [ T.at    , ((%3 (o , _) , (i , <>)))    , <> ] 
pattern at      i      = at/ i _                                         
pattern corec   i o gp = [ T.corec , (%4 o) , (i , (gp , <>))          ]

(We plan to also define a view for these patterns, so that Agda's interactive splitting (C-c C-c) can be recovered after a with)

Monadic binding notation

For the binding operator we mimic Haskell's do-notation with a syntax declaration.

infixr 5 bind
bind :  {M Γ Ξ Δ X Y}  Γ [ M  Y ]> Ξ   
                    (Y  Ξ [ M  X ]> Δ)  Γ [ M  X ]> Δ
bind = _»=_
syntax bind m  x  y) = x <- m ⋯ y
infixr 5 _»_
_»_ :  {M Γ Ξ Δ X Y}  Γ [ M  X ]> Ξ  Ξ [ M  Y ]> Δ  Γ [ M  Y ]> Δ
m » n = m »= λ _  n

write and read dependently

We added `^ to recover the possibility of making use of data exchanged by write and read at the type level.

put :  {M Γ}{I O A : Set}{T : A  De I}{s} 
      (i : (> s , I , O , [ s  A (`^ T))  Γ) 
      (a : A)  Γ [ M  A ]> (ud (> s , %2 T a) (∈ud i))
put i a = write i a »= λ _  at (∈ud i)

get :  {M Γ Δ}{I O A B : Set}{T : A  De I}{s}
      (i : (> s , I , O , [ s  A (`^ T))  Γ) 
      (f :  a  ud (> s , %2 T a) (∈ud i) [ M  B ]> Δ) 
      Γ [ M  B ]> Δ
get i f = read i »= λ a  at (∈ud i) » f a

new channel for ⊤-indexed sessions

We often create channels for stateful sessions where both index sets are : using new⊤ helps inference.

new⊤ :  {Γ M F}  Γ [ M   ]> Γ  (ε ,  ,  , F)
new⊤ = new

Haskell evaluator

To make an efficient use of Haskell channels, while forgetting the data required to compute their "changing" types, we resort to making a sensible use of unsafe casts. What follows should therefore be considered as an extension to the trusted base.

We provide no correctness proof for this evaluator.

private

  postulate
    unsafeCoerce :  {l1}{A : Set l1}{l2}{B : Set l2}  A  B

  {-# IMPORT   Unsafe.Coerce                                          #-}
  {-# COMPILED unsafeCoerce (\ _ _ _ _ -> Unsafe.Coerce.unsafeCoerce) #-}
open import IO.Primitive using (IO ; return ; _>>=_ ; putStr ; putStrLn)
module IO = IO.Primitive
infix 2 _[IO_]>_
_[IO_]>_ = λ Γ X Δ  Γ [ IO  X ]> Δ

IOProc = λ X  [] [IO X ]> []

open import Control.Concurrent as C
open import Control.Concurrent.Chan.Synchronous

We need our channels to be untyped, to obtain which we postulate an abstract type and use unsafe coercions to and from it.

This is similar to Pucella and Tov's embedding in "Haskell Session Types with (Almost) No Class".

postulate Abs : Set

UChan = Chan Abs

The channels for a context.

⟦_⟧Cx : Cx  Set₁
⟦_⟧Cx = All λ _  UChan
lookupUChan :  {Γ C}  (i : C  Γ)   Γ ⟧Cx  UChan
lookupUChan i cs = snd (lookupAll i cs)

We need some Haskell helpers.

Note that our channels are ultimately implemented on top of Jesse Tov's synchronous-channels package: for this reason, currently all the interactions are synchronous (blocking).

infixl 1 _>>_

_>>_ :  {lA lB}{A : Set lA}{B : Set lB}  IO A  IO B  IO B
m >> n = m >>= λ _  n

mapIO :  {lA lB}{A : Set lA}{B : Set lB}  (A  B)  IO A  IO B
mapIO f xs = xs >>= return  f

Every communication with the untyped channels uses unsafeCoerce.

writeUChan : {A : Set}  UChan  A  IO C.<>
writeUChan c = writeChan c  unsafeCoerce

readUChan : {A : Set}  UChan  IO A
readUChan {A = A} c = readChan c >>= return  unsafeCoerce

Here is the actual test evaluator, to implement which we disable termination checking: we already use "unsafe" features so we do not bother defining a coinductive wrapper as in the IO module of Agda's standard library.

{-# NO_TERMINATION_CHECK #-}
run : {Γ Δ : Cx}{X : Set}  Γ [IO X ]> Δ   Γ ⟧Cx  IO (X ×  Δ ⟧Cx)

We map the embedded monadic actions to themselves, and the binding syntax to the binding operator for the IO monad.

run ( m           ) cs = mapIO (flip _,_ cs) m                                           
                                                                                          
run (m »= f        ) cs = run m cs >>= λ { (x , cs)  run (f x) cs }                      

new just creates a new channel.

run (new           ) cs = newChan >>= λ c  return (_ , (cs  c))

fork x interprets the Splits in s obtaining two lists of channels ls and rs: it keeps ls for the parent thread and leaves access to rs to the child (x).

run (fork       s x) cs = let ls , rs = all-splits cs s in
                          forkIO (run x rs >> return ⟨⟩) >>                               
                          return (tt , ls)                                                

send i j writes channel i on channel j and frees the continuation from the burden of communicating along i.

We could avoid many uses of unsafeCoerce in the following but we think it is more efficient to avoid calling functions like all-ud as in the commented-out code: they perform no operations on the actual lists of untyped channels.

The usages of unsafeCoerce which are more difficult to justify are those inside every call to readUChan and writeUChan.

run (send       i j) cs = let chanToSend    = lookupUChan        i  cs in                 
                          let chanToWriteOn = lookupUChan (wk/ i j) cs in                 
                          writeUChan chanToWriteOn chanToSend >>
                          return (tt , unsafeCoerce (all-rm i cs))
                       -- return (tt , all-ud j (all-rm i cs) chanToWriteOn)

receive i receives a channel from channel i and allows/forces the continuation to also take care of it.

run (receive      i) cs = let chanToReadFrom = lookupUChan i cs in                        
                          readUChan chanToReadFrom >>= λ receivedChan                    
                          return (tt , (unsafeCoerce cs  receivedChan))                  

accept i a p forks a process that waits for channels: whenever one is received it spawns a new copy of the server p along it.

run (accept   i a p) cs = forkIO server >> return (tt , all-rm i cs)                   
  where c = lookupUChan i cs                                            
        service : UChan  IO _                                          
        service n = run p (all-ud i cs n) >> return ⟨⟩
        server : IO C.<>                                                
        server = readUChan c        >>= λ n                            
                 forkIO (service n) >>                                  
                 server                                                 

connect i p creates a channel and sends it along channel i, which is (or should be) shared by construction with a server, then it becomes process p.

run (connect    i p) cs = newChan                         >>= λ n                        
                          writeUChan (lookupUChan i cs) n >>                              
                          run p (all-ud i cs n)

wont i avoids starting the client/server interaction with the server which waits for channels on i.

run (wont         i) cs = return (tt , all-rm i cs)

twice i duplicates the server which waits for channels on i.

run (twice        i) cs = return (tt , (cs  lookupUChan i cs))                           

write i x writes x on channel i.

run (write      i x) cs = let c = lookupUChan i cs in                                     
                          writeUChan c x >>                                               
                          return (tt , unsafeCoerce cs)                                   

read i reads from i and returns what it read.

run (read         i) cs = let c = lookupUChan i cs in                                     
                          readUChan c >>= λ x 
                          return (x , unsafeCoerce cs)                                    

end i terminates the (sub)session

run (end/       i r) cs = return (r , all-rm i cs)                                     

at/ i o simply returns o.

run (at/        i o) cs = return (o , unsafeCoerce cs)                                    

corec enters a loop whose body is contained in gp: the coiteration will possibly be exited whenever the value the process returns is inl x for some x.

run (corec   i o gp) cs = aux o
  where aux = λ o  run (snd (gp o)) (unsafeCoerce cs) >>=
                    uc ⊎.[ cu return ,  o _  aux o) ]

Closed processes describe IO computations.

run[] :  {X}   IOProc X  IO X
run[] P = mapIO fst (run P [])

Note that as the evaluator allows for processes that embed any IO action one could easily add unwanted behaviours: the user is still free to capture a fragment of IO to be considered safe and simply compose this evaluator after a translation phase to IO.

For simplicity, the currently provided examples just use IO for basic operations like suspending processes for finite amounts of time or accessing the standard output.