{-
List.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, OverlappingInstances #-}-- | Heterogeneous lists. This has been done many times, in many-- different ways. Explicit constructors are hidden deliberately.moduleControl.Concurrent.Session.List(Nil(),Cons(),TyListLength(..),nil,cons,modifyCons,tyHead,tyTail,TyList(),TyListIndex(..),TyListUpdateVar(..),TyListTake(..),TyListDrop(..),TyListAppend(..),TyListReverse(..),TyListElem(..),TyListMember(..),TyListConsSet(..),TyListToSet(..),TyListSortNums(..),TyListMap(..),TyListMapFunc(..))whereimportControl.Concurrent.Session.NumberimportControl.Concurrent.Session.BooldataNil::*whereNil::NildataCons::*->*->*whereCons::t->n->Constn-- | Find the length of a list.classTyListLengthlistlength|list->lengthwheretyListLength::list->lengthinstanceTyListLengthNil(D0E)wheretyListLengthNil=(D0E)instance(TyListLengthnlen,Succlenlen')=>TyListLength(Constn)len'wheretyListLength(Cons_nxt)=tySucc.tyListLength$nxtinstanceShowNilwhereshowNil="Nil"instance(TyListLengthnl,Succll',Shown,Showt)=>Show(Constn)whereshow(Consvalnxt)="Cons "++(showval)++" ("++(shownxt)++")"nil::Nilnil=Nilcons::(TyListn)=>t->n->(Constn)constn=ConstnmodifyCons::(TyListn1,TyListn2)=>(t1->t2)->(n1->n2)->(Const1n1)->(Const2n2)modifyConsfg(Constn)=cons(ft)(gn)classTyListlinstanceTyListNilinstance(TyListnxt)=>TyList(Consvalnxt)tyHead::(Constn)->ttyHead(Const_)=ttyTail::(Constn)->ntyTail(Cons_n)=n-- | Index or update a list. When updating, the type of the new value-- must be the same as the type of the old value.classTyListIndexlstidxres|lstidx->reswheretyListIndex::lst->idx->restyListUpdate::lst->idx->res->lstinstanceTyListIndex(Consresnxt)(D0E)reswheretyListIndex(Consval_)_=valtyListUpdate(Cons_nxt)_val=(Consvalnxt)instance(TyListIndexnxtidx'res,Predidxidx',SmallerThanBoolidx'lenTrue,TyListLengthnxtlen)=>TyListIndex(Consvalnxt)idxreswheretyListIndex(Cons_nxt)idx=tyListIndexnxt(tyPredidx)tyListUpdate(Consvalnxt)idxval'=Consval(tyListUpdatenxt(tyPredidx)val')-- | Update a list but allow the type of the new value to be different-- from the type of the old value.classTyListUpdateVarlst1idxvallst2|lst1idxval->lst2wheretyListUpdateVar::lst1->idx->val->lst2instance(TyListTakeidxlst1prefix,TyListDropidxPlst1suffix,SuccidxidxP,TyListAppendprefix(Consvalsuffix)lst2)=>TyListUpdateVarlst1idxvallst2wheretyListUpdateVarlst1idxval=tyListAppendprefix(Consvalsuffix)whereprefix=tyListTakeidxlst1idxP=tySuccidxsuffix=tyListDropidxPlst1-- | Append two lists together. Mirrors the "Prelude" function '(++)'.classTyListAppendabc|ab->cwheretyListAppend::a->b->cinstanceTyListAppendNilbbwheretyListAppend_b=binstance(TyListAppendnxtbnxt')=>TyListAppend(Consvalnxt)b(Consvalnxt')wheretyListAppend(Consvalnxt)b=Consval$tyListAppendnxtb-- | Drop from the head of a list. Mirrors the "Prelude" function 'drop'.classTyListDropcntlstres|cntlst->reswheretyListDrop::cnt->lst->resinstanceTyListDrop(D0E)(Consvalnxt)(Consvalnxt)wheretyListDrop_lst=lstinstanceTyListDropcntNilNilwheretyListDrop_lst=lstinstance(TyListDropcnt'nxtlst,Predcntcnt')=>TyListDropcnt(Consvalnxt)lstwheretyListDropcnt(Cons_nxt)=tyListDrop(tyPredcnt)nxt-- | Take from the head of a list. Mirrors the "Prelude" function 'take'.classTyListTakecntlstres|cntlst->reswheretyListTake::cnt->lst->resinstanceTyListTake(D0E)NilNilwheretyListTake__=nilinstanceTyListTake(D0E)(Consvalnxt)NilwheretyListTake__=nilinstance(TyListTakecnt'nxtnxt',Pred(D1r)cnt')=>TyListTake(D1r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D2r)cnt')=>TyListTake(D2r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D3r)cnt')=>TyListTake(D3r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D4r)cnt')=>TyListTake(D4r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D5r)cnt')=>TyListTake(D5r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D6r)cnt')=>TyListTake(D6r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D7r)cnt')=>TyListTake(D7r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D8r)cnt')=>TyListTake(D8r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)instance(TyListTakecnt'nxtnxt',Pred(D9r)cnt')=>TyListTake(D9r)(Consvalnxt)(Consvalnxt')wheretyListTakecnt(Consvalnxt)=Consval(tyListTake(tyPredcnt)nxt)classTyListElemlstvalidx|lstval->idxwheretyListElem::lst->val->idxinstance(TyListElem'lst(D0E)validx)=>TyListElemlstvalidxwheretyListElemlstval=tyListElem'lst(D0E)valclassTyListElem'lstaccvalidx|lstaccval->idxwheretyListElem'::lst->acc->val->idxinstanceTyListElem'(Consvalnxt)idxvalidxwheretyListElem'_idx_=idxinstance(Succaccacc',TyListElem'nxtacc'validx)=>TyListElem'(Consval'nxt)accvalidxwheretyListElem'(Cons_nxt)accval=tyListElem'nxt(tySuccacc)val-- | Reverse a list.classTyListReversemn|m->n,n->mwheretyListReverse::m->ninstance(TyListReverse'mNiln)=>TyListReversemnwheretyListReverselst=tyListReverse'lstnilclassTyListReverse'man|ma->nwheretyListReverse'::m->a->ninstanceTyListReverse'NilaccaccwheretyListReverse'_=idinstance(TyListReverse'nxt(Consvacc)n,TyListacc)=>TyListReverse'(Consvnxt)accnwheretyListReverse'(Consvnxt)acc=tyListReverse'nxt(consvacc)classTyListMemberlstvalres|lstval->reswhereisTyListMember::val->lst->resinstanceTyListMemberNilvalFalsewhereisTyListMember__=FFinstanceTyListMember(Consvalnxt)valTruewhereisTyListMember__=TTinstance(TyListMembernxtvalres)=>TyListMember(Consval'nxt)valreswhereisTyListMemberval(Cons_nxt)=isTyListMembervalnxtclassTyListConsSetesetset'|eset->set'wheretyListConsSet::e->set->set'instance(TyListMemberseteres,TyListConsSet'resesetset')=>TyListConsSetesetset'wheretyListConsSetelemlst=tyListConsSet'(isTyListMemberelemlst)elemlstclassTyListConsSet'boolesetset'|booleset->set'wheretyListConsSet'::bool->e->set->set'instance(TyListset)=>TyListConsSet'Falseeset(Conseset)wheretyListConsSet'_elemlst=conselemlstinstanceTyListConsSet'TrueesetsetwheretyListConsSet'__lst=lstclassTyListToSetlstset|lst->setwheretyListToSet::lst->setinstanceTyListToSetNilNilwheretyListToSet=idinstance(TyListToSetnxtset,TyListConsSetvsetset')=>TyListToSet(Consvnxt)set'wheretyListToSet(Consvnxt)=tyListConsSetv.tyListToSet$nxtclassTyListSortNumslstAlstB|lstA->lstBwheretyListSortNums::lstA->lstBinstanceTyListSortNumsNilNilwheretyListSortNums_=nilinstance(TyNumnum,TyListSortNumsnxtlst',Insertnumvallst'lst'')=>TyListSortNums(Cons(num,val)nxt)lst''wheretyListSortNums(Cons(num,val)nxt)=insertnumval(tyListSortNumsnxt)classInsertnumvallstAlstB|numvallstA->lstBwhereinsert::num->val->lstA->lstBinstanceInsertnumvalNil(Cons(num,val)Nil)whereinsertnumval_=cons(num,val)nilinstance(SmallerThanBoolnumnum'isSmaller,Insert'isSmallernumval(Cons(num',val')nxt)lstB)=>Insertnumval(Cons(num',val')nxt)lstBwhereinsertnumvallst@(Cons(num',_)_)=insert'isSmallernumvallstwhereisSmaller=isSmallerThannumnum'classInsert'isSmallernumvallstAlstB|isSmallernumvallstA->lstBwhereinsert'::isSmaller->num->val->lstA->lstBinstance(TyListlstA)=>Insert'TruenumvallstA(Cons(num,val)lstA)whereinsert'TTnumvallst=cons(num,val)lstinstance(InsertnumvalnxtlstB,TyListlstB)=>Insert'Falsenumval(Cons(num',val')nxt)(Cons(num',val')lstB)whereinsert'FFnumval(Cons(num',val')nxt)=cons(num',val')$insertnumvalnxtclassTyListMapab|a->bwheretyListMap::a->binstanceTyListMapNilNilwheretyListMap_=nilinstance(TyListMapFuncxx',TyListMapnxtnxt',TyListnxt,TyListnxt')=>TyListMap(Consxnxt)(Consx'nxt')wheretyListMap=modifyConstyListMapFunctyListMapclassTyListMapFuncxy|x->ywheretyListMapFunc::x->y