---------------------------------------------------------------------------------- $Id: Combinators.hs#12 2010/10/01 19:17:36 REDMOND\\satnams $-------------------------------------------------------------------------------moduleLava.Combinators(moduleLava.Combinators)whereimportControl.Monad.StateimportLava.Netlist-- * Lava Combinators-------------------------------------------------------------------------------infixr5>->infixr5>|>infixr5>=>infixr5->--- ** Serial composition combinators--------------------------------------------------------------------------------- | Serial composition with no layout(->-)::(a->Outb)->(b->Outc)->a->Outc(->-)circuit1circuit2input1=doinput2<-circuit1input1circuit2input2--------------------------------------------------------------------------------- | Serial composition with horizontal left to right layout(>->)::(a->Outb)->(b->Outc)->a->Outc(>->)circuit1circuit2input1=dopreState<-getletl0=length(layoutpreState)incrementLayoutNestingintermediateResult<-circuit1input1r<-circuit2intermediateResultdecrementLayoutNestingstate<-getletl=layoutstatel1=lengthlbTile:aTile:lrest=l(aW,aH)=sizeOfLayoutaTile(bW,bH)=sizeOfLayoutbTilewhen(l1-l0>=2)$putstate{layout=Beside(aW+bW,aH`max`bH)aTilebTile:lrest}returnr--------------------------------------------------------------------------------- | Serial composition with mid-horizontal left to right layout(>=>)::(a->Outb)->(b->Outc)->a->Outc(>=>)circuit1circuit2input1=dopreState<-getletl0=length(layoutpreState)incrementLayoutNestingintermediateResult<-circuit1input1r<-circuit2intermediateResultdecrementLayoutNestingstate<-getletl=layoutstatel1=lengthlbTile:aTile:lrest=l(aW,aH)=sizeOfLayoutaTile(bW,bH)=sizeOfLayoutbTilevGap=(aH-bH)`div`2bTile'=Below(bW,bH+vGap)(Space(0,vGap))bTilewhen(l1-l0>=2)$putstate{layout=Beside(aW+bW,aH`max`bH)aTilebTile':lrest}returnr--------------------------------------------------------------------------------- | Serial composition with overly layout(>|>)::(a->Outb)->(b->Outc)->a->Outc(>|>)circuit1circuit2input1=dopreState<-getletl0=length(layoutpreState)incrementLayoutNestingintermediateResult<-circuit1input1r<-circuit2intermediateResultdecrementLayoutNestingstate<-getletl=layoutstatel1=lengthlbTile:aTile:lrest=l(aW,aH)=sizeOfLayoutaTile(bW,bH)=sizeOfLayoutbTilewhen(l1-l0>=2)$putstate{layout=Overlay(aW`max`bW,aH`max`bH)aTilebTile:lrest}returnr--------------------------------------------------------------------------------- ** Conditional shift for obstacle avoidancecondShift::(Int->Bool,Int->Int)->(Int->Bool,Int->Int)->Out()condShiftxshiftyshift=donetlist<-getl<-popLayoutpushLayout(ConditionalShift(CondShiftFnxshiftyshift)l)--------------------------------------------------------------------------------- ** Parallel composition combinators--------------------------------------------------------------------------------- | Repeated serial composition (left to right)hRepN::Int->(a->Outa)->a->OutahRepN1circuit=circuithRepNncircuit=circuit>->(hRepN(n-1)circuit)--------------------------------------------------------------------------------- | Vertical parallel composition of two circuitspar2::(a->Outc)->(b->Outd)->(a,b)->Out(c,d)par2circuit1circuit2(a,b)=dopreState<-getletl0=length(layoutpreState)incrementLayoutNestingc<-circuit1ad<-circuit2bdecrementLayoutNestingstate<-getletl=layoutstatel1=lengthlbTile:aTile:lrest=l(aW,aH)=sizeOfLayoutaTile(bW,bH)=sizeOfLayoutbTilewhen(l1-l0>=2)$putstate{layout=Below(aW`max`bW,aH+bH)aTilebTile:lrest}return(c,d)--------------------------------------------------------------------------------- | Vertical map of a circuitmaP::(a->Outb)->[a]->Out[b]maPcircuit[]=return[]maPcircuit(x:xs)=do(y,ys)<-par2circuit(maPcircuit)(x,xs)return(y:ys)--------------------------------------------------------------------------------- | 'mapPair' maps a circuit over adajcent pairs of elements in a listmapPair::((a,a)->Outa)->[a]->Out[a]mapPaircircuitl|odd(lengthl)=dor<-(chopPair>->maPcircuit)(initl)return(r++[lastl])mapPaircircuitl=(chopPair>->maPcircuit)l--------------------------------------------------------------------------------- | Horizontal parallel composition of two circuitshpar2::(a->Outc)->(b->Outd)->(a,b)->Out(c,d)hpar2circuit1circuit2(a,b)=dopreState<-getletl0=length(layoutpreState)incrementLayoutNestingc<-circuit1ad<-circuit2bdecrementLayoutNestingstate<-getletl=layoutstatel1=lengthlbTile:aTile:lrest=l(aW,aH)=sizeOfLayoutaTile(bW,bH)=sizeOfLayoutbTilewhen(l1-l0>=2)$putstate{layout=Beside(aW+bW,aH`max`bH)aTilebTile:lrest}return(c,d)--------------------------------------------------------------------------------- | Horizontal map of a circuithmaP::(a->Outb)->[a]->Out[b]hmaPcircuit[]=return[]hmaPcircuit(x:xs)=do(y,ys)<-hpar2circuit(hmaPcircuit)(x,xs)return(y:ys)--------------------------------------------------------------------------------- | Parallel composition of two circuit which have overlaid layoutpar2Overlay::(a->Outc)->(b->Outd)->(a,b)->Out(c,d)par2Overlaycircuit1circuit2(a,b)=dopreState<-getletl0=length(layoutpreState)incrementLayoutNestingc<-circuit1ad<-circuit2bdecrementLayoutNestingstate<-getletl=layoutstatel1=lengthlbTile:aTile:lrest=l(aW,aH)=sizeOfLayoutaTile(bW,bH)=sizeOfLayoutbTilewhen(l1-l0>=2)$putstate{layout=Overlay(aW`max`bW,aH`max`bH)aTilebTile:lrest}return(c,d)--------------------------------------------------------------------------------- | Parallel composition of three circuit which have overlaid layoutpar3Overlay::(a->Outao)->(b->Outbo)->(c->Outco)->(a,b,c)->Out(ao,bo,co)par3Overlaycircuit1circuit2circuit3(a,b,c)=do((ao,bo),co)<-par2Overlay(par2Overlaycircuit1circuit2)circuit3((a,b),c)return(ao,bo,co)--------------------------------------------------------------------------------- | Horizontal parallel composition of a list of circuitshpar::[a->Outb]->[a]->Out[b]hpar[][]=return[]hpar(c:cs)(i:is)=do(x,y)<-hpar2c(hparcs)(i,is)return(x:y)--------------------------------------------------------------------------------- | Horizontal repeated parallel composition of a circuithparN::Int->(a->Outb)->[a]->Out[b]hparNncircuit=hpar(replicatencircuit)-- ** Wiring combinators--------------------------------------------------------------------------------- | Splits a wire into twofork2::a->Out(a,a)fork2a=return(a,a)--------------------------------------------------------------------------------- | Converts a two element list into a pairlistToPair::[a]->Out(a,a)listToPair[a,b]=return(a,b)listToPairother=error("listToPair called with a list of length "++show(lengthother))--------------------------------------------------------------------------------- | Converts a par into a list containing two elementspairToList::(a,a)->Out[a]pairToList(a,b)=return[a,b]--------------------------------------------------------------------------------- | Takes a pair of lists and returns a zipped list of pairsziP::([a],[b])->Out[(a,b)]ziP(a,b)=return(zipab)--------------------------------------------------------------------------------- | Takes a list of pairs and unzips it into a pair of listsunziP::[(a,b)]->Out([a],[b])unziPlist=return(unziplist)--------------------------------------------------------------------------------- | Takes a list containing two elements and returns a list of lists-- where each element is a two element listzipList::[[a]]->Out[[a]]zipList[[],_]=return[]zipList[_,[]]=return[]zipList[a:as,b:bs]=dorest<-zipList[as,bs]return([a,b]:rest)--------------------------------------------------------------------------------- | Undo the zipList operationunzipList::[[a]]->Out[[a]]unzipListlist=return[mapfstListPairlist,mapsndListPairlist]-------------------------------------------------------------------------------fstListPair::[a]->afstListPair[a,_]=a-------------------------------------------------------------------------------sndListPair::[a]->asndListPair[_,b]=b--------------------------------------------------------------------------------- | This makes pairs out of consequetive members of an even length list.pair::[a]->Out[[a]]pair[]=return[]pairlst|odd(lengthlst)=error("pair given odd length list of size "++show(lengthlst))pair(a:b:rest)=dorest<-pairrestreturn([a,b]:rest)--------------------------------------------------------------------------------- | Takes a list of pairs and returns a flattend listunpair::[[a]]->Out[a]unpairlist=return(concatlist)--------------------------------------------------------------------------------- | 'halveListToPair' will take a list and return a pair containing the-- two halves.halveListToPair::[a]->([a],[a])halveListToPairl=(takenl,dropnl)wheren=lengthl`div`2--------------------------------------------------------------------------------- | Tales a list and returns a pair containing the two halves of the listhalve::[a]->Out([a],[a])halvel=return(halveListToPairl)--------------------------------------------------------------------------------- | Take a pair containing two list halves and undoes the halveunhalve::([a],[a])->Out[a]unhalve(a,b)=return(a++b)--------------------------------------------------------------------------------- | Halves the input list into a list containign the two halveshalveList::[a]->Out[[a]]halveListl=return[takenl,dropnl]wheren=lengthl`div`2--------------------------------------------------------------------------------- | Undoes halveListunhalveList::[[a]]->Out[a]unhalveList[a,b]=return(a++b)--------------------------------------------------------------------------------- | Chops a list into chunkschop::Int->[a]->Out[[a]]chopn[]=return[]chopnl|lengthl<n=return[l]chopnl=dorest<-chopn(dropnl)return((takenl):rest)--------------------------------------------------------------------------------- | Chops a list into chunks formed as pairschopPair::[a]->Out[(a,a)]chopPair=chop2>->maPlistToPair--------------------------------------------------------------------------------- | Takes a list of lists and returns their concatenationconcaT::[[a]]->Out[a]concaTlist=return(concatlist)--------------------------------------------------------------------------------- | Applies a circuit to the first halve of a listfstList::([a]->Out[a])->[a]->Out[a]fstListf=halve>->fsTf>->unhalve--------------------------------------------------------------------------------- | Applies a circuit to the second halve of a listsndList::([a]->Out[a])->[a]->Out[a]sndListf=halve>->snDf>->unhalve--------------------------------------------------------------------------------- | Applies a circuit to the first element of a pairfsT::(a->Outb)->(a,c)->Out(b,c)fsTf(a,b)=doc<-fareturn(c,b)--------------------------------------------------------------------------------- | Applies a circuit to the second element of a pairsnD::(b->Outc)->(a,b)->Out(a,c)snDf(a,b)=doc<-fbreturn(a,c)-------------------------------------------------------------------------------projectFst::(a,b)->OutaprojectFst(a,b)=returna-------------------------------------------------------------------------------projectSnd::(a,b)->OutbprojectSnd(a,b)=returnb---------------------------------------------------------------------------------------------------------------------------------------------------------------- Reverses a listreversE::[a]->Out[a]reversElist=return(reverselist)-------------------------------------------------------------------------------