{-
SessionType.hs
Copyright 2008 Matthew Sackman <matthew@wellquite.org>
This file is part of Session Types for Haskell.
Session Types for Haskell is free software: you can redistribute it
and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
Session Types for Haskell is distributed in the hope that it will
be useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Session Types for Haskell.
If not, see <http://www.gnu.org/licenses/>.
-}{-# LANGUAGE KindSignatures, GADTs, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, FlexibleContexts, OverlappingInstances #-}-- | 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 examplesmoduleControl.Concurrent.Session.SessionTypewhereimportControl.Concurrent.Session.ListimportControl.Concurrent.Session.NumberdataEnd=EndderivingShowend::ConsEndNilend=consEndnildataSend::*->*whereSend::t->SendtSendInt::SendIntSendBool::SendBoolSendChar::SendCharSendStr::SendStringSendDouble::SendDoubledataRecv::*->*whereRecv::t->RecvtRecvInt::RecvIntRecvBool::RecvBoolRecvChar::RecvCharRecvStr::RecvStringRecvDouble::RecvDoubledataJumpl=Jumplderiving(Show)jump::(TyNumn)=>n->Cons(Jumpn)Niljumpl=cons(Jumpl)nildataSelect::*->*whereSelect::lstOfLabels->SelectlstOfLabelsselect::(SListOfJumps(Consvalnxt))=>(Consvalnxt)->Cons(Select(Consvalnxt))Nilselectlol=cons(Selectlol)nildataOffer::*->*whereOffer::lstOfLabels->OfferlstOfLabelsoffer::(SListOfJumps(Consvalnxt))=>(Consvalnxt)->Cons(Offer(Consvalnxt))Nilofferlol=cons(Offerlol)nilclassDualab|a->b,b->awheredual::a->binstanceDualEndEndwheredualEnd=EndinstanceDual(Jumpl)(Jumpl)wheredual(Jumpl)=JumplinstanceDual(Sendt)(Recvt)wheredual(Sendt)=RecvtdualSendInt=RecvIntdualSendBool=RecvBooldualSendChar=RecvChardualSendStr=RecvStrdualSendDouble=RecvDoubleinstanceDual(Recvt)(Sendt)wheredual(Recvt)=SendtdualRecvInt=SendIntdualRecvBool=SendBooldualRecvChar=SendChardualRecvStr=SendStrdualRecvDouble=SendDoubleinstanceDual(Selectlst)(Offerlst)wheredual(Selectlst)=OfferlstinstanceDual(Offerlst)(Selectlst)wheredual(Offerlst)=SelectlstinstanceDualNilNilwheredualNil=Nilinstance(Dualvalval',Dualnxtnxt')=>Dual(Consvalnxt)(Consval'nxt')wheredual(Consvalnxt)=Cons(dualval)(dualnxt)classSListOfJumpslstinstanceSListOfJumpsNilinstance(SListOfJumpsnxt,TyNumval)=>SListOfJumps(Cons(Cons(Jumpval)Nil)nxt)classSListOfSessionTypeslstOfListsinstanceSListOfSessionTypesNilinstance(SValidSessionTypeval,SListOfSessionTypesnxt)=>SListOfSessionTypes(Consvalnxt)classSNonTerminalainstanceSNonTerminal(Sendt)instanceSNonTerminal(Recvt)classSTerminalainstanceSTerminalEndinstance(TyNuml)=>STerminal(Jumpl)instance(SListOfJumps(Consvalnxt))=>STerminal(Select(Consvalnxt))instance(SListOfJumps(Consvalnxt))=>STerminal(Offer(Consvalnxt))classSValidSessionTypelstinstance(STerminala)=>SValidSessionType(ConsaNil)instance(SValidSessionTypenxt,SNonTerminalval)=>SValidSessionType(Consvalnxt)infixr5~>(~>)::(TyListnxt,SNonTerminala,SValidSessionTypenxt)=>a->nxt->(Consanxt)(~>)=consinfixr5~|~(~|~)::(TyNumtarget,TyListnxt)=>target->nxt->Cons(Cons(Jumptarget)Nil)nxt(~|~)targetrest=cons(jumptarget)restclassSNoJumpsBeyondsidxinstanceSNoJumpsBeyondEndidxinstance(SmallerThanlidx)=>SNoJumpsBeyond(Jumpl)idxinstanceSNoJumpsBeyond(Sendt)idxinstanceSNoJumpsBeyond(Recvt)idxinstance(SNoJumpsBeyondlolidx)=>SNoJumpsBeyond(Selectlol)idxinstance(SNoJumpsBeyondlolidx)=>SNoJumpsBeyond(Offerlol)idxinstanceSNoJumpsBeyondNilidxinstance(SNoJumpsBeyondvalidx,SNoJumpsBeyondnxtidx)=>SNoJumpsBeyond(Consvalnxt)idxclassSWellFormedConfigidxAidxBssinstance(SListOfSessionTypesss,ListLengthsslen,SNoJumpsBeyondsslen,SmallerThanidxAlen,ElemssidxAst,ListLengthstlen',SmallerThanidxBlen')=>SWellFormedConfigidxAidxBsstestWellformed::(SWellFormedConfigidxAidxBss)=>ss->idxA->idxB->BooltestWellformed___=TruedataChoice::*->*whereChoice::lstOfLabels->ChoicelstOfLabelsclassOnlyOutgoingab|a->bwhereonlyOutgoing::a->binstance(OnlyOutgoingnxtnxt')=>OnlyOutgoing(Cons(Recvt)nxt)nxt'whereonlyOutgoing(Cons_nxt)=onlyOutgoingnxtinstanceOnlyOutgoing(Cons(Offerjl)Nil)(Cons(Choicejl)Nil)whereonlyOutgoing(Cons(Offerjl)Nil)=Cons(Choicejl)NilinstanceOnlyOutgoing(Cons(Selectjl)Nil)(Cons(Choicejl)Nil)whereonlyOutgoing(Cons(Selectjl)Nil)=Cons(Choicejl)NilinstanceOnlyOutgoing(ConsEndNil)(ConsEndNil)whereonlyOutgoing(ConsEndNil)=(ConsEndNil)instanceOnlyOutgoing(Cons(Jumpl)Nil)(Cons(Jumpl)Nil)whereonlyOutgoing(Cons(Jumpl)Nil)=(Cons(Jumpl)Nil)instance(OnlyOutgoingnxtnxt')=>OnlyOutgoing(Cons(Sendt)nxt)(Constnxt')whereonlyOutgoing(Cons(Sendt)nxt)=Const$onlyOutgoingnxtonlyOutgoing(ConsSendIntnxt)=Cons(undefined::Int)$onlyOutgoingnxtonlyOutgoing(ConsSendBoolnxt)=Cons(undefined::Bool)$onlyOutgoingnxtonlyOutgoing(ConsSendCharnxt)=Cons(undefined::Char)$onlyOutgoingnxtonlyOutgoing(ConsSendStrnxt)=Cons(undefined::String)$onlyOutgoingnxtonlyOutgoing(ConsSendDoublenxt)=Cons(undefined::Double)$onlyOutgoingnxt