-- Communicating Haskell Processes.-- Copyright (c) 2008--2009, University of Kent.-- All rights reserved.-- -- Redistribution and use in source and binary forms, with or without-- modification, are permitted provided that the following conditions are-- met:---- * Redistributions of source code must retain the above copyright-- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above copyright-- notice, this list of conditions and the following disclaimer in the-- documentation and/or other materials provided with the distribution.-- * Neither the name of the University of Kent nor the names of its-- contributors may be used to endorse or promote products derived from-- this software without specific prior written permission.---- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-- | This module contains helper functions for wiring up collections of processes-- into a two-dimensional arrangement.moduleControl.Concurrent.CHP.Connect.TwoDim(FourWay(..),wrappedGridFour,wrappedGridFour_,FourWayDiag(..),EightWay,wrappedGridEight,wrappedGridEight_)whereimportControl.ArrowimportControl.Concurrent.CHPimportControl.Concurrent.CHP.ConnectimportControl.MonadimportData.ListimportPreludehiding(abs)-- | A data type representing four-way connectivity for a process, with channels-- to the left and right, above and below.dataFourWayabovebelowleftright=FourWay{above::above,below::below,left::left,right::right}deriving(Eq)-- | A data type representing four-way diagonal connectivity for a process, with-- channels above-left, below-right, above-right and below-left.dataFourWayDiagaboveLeftbelowRightaboveRightbelowLeft=FourWayDiag{aboveLeft::aboveLeft,belowRight::belowRight,aboveRight::aboveRight,belowLeft::belowLeft}deriving(Eq)-- | EightWay is simply a synonym for a pair of 'FourWay' and 'FourWayDiag'.typeEightWayablralbrarbl=(FourWayablr,FourWayDiagalbrarbl)-- | Wires the given grid of processes (that require four-way connectivity) together-- into a wrapped around grid (a torus) and runs them all in parallel.---- The parameter is a list of rows, and should be rectangular (i.e. all the rows-- should be the same length). If not, an error will result. The return value-- is guaranteed to be the same shape as the input.---- It is worth remembering that if you have only one row or one column (or-- both), processes can be connected to themselves, so make sure that if a-- process is connected to itself (e.g. its left channel connects to its right-- channel), it is coded such that it won't deadlock -- or if needed, checks for this-- possibility using 'sameChannel'. Processes may also be connected to each other-- multiple times -- in a two-wide grid, each process's left channel connects to-- the same process as its right.wrappedGridFour::(Connectableabovebelow,Connectableleftright)=>[[FourWayabovebelowleftright->CHPa]]->CHP[[a]]wrappedGridFourps-- If ps == [], this will succeed, and map connectRowCycle ps will be [],-- and thus connectColumnsCycle _ [] will return [] (without forcing the-- head call), and it will all work correctly.|length(nub$maplengthps)<=1=connectColumnsCycle(length(headps))$mapconnectRowCycleps|otherwise=error$"Control.Concurrent.CHP.Connect.TwoDim.wrappedGrid: Non-rectangular input "++" height: "++show(lengthps)++" widths: "++show(maplengthps)-- | Like 'wrappedGridFour' but discards the return values.wrappedGridFour_::(Connectableabovebelow,Connectableleftright)=>[[FourWayabovebelowleftright->CHPa]]->CHP()wrappedGridFour_ps=wrappedGridFourps>>return()--TODO fix this-- | Like 'wrappedGridFour' but provides eight-way connectivity.---- The note on 'wrappedGridFour' about processes being connected to themselves-- applies here too -- as does the note about processes being connected to-- each other multiple times. If you have one row, a process's left,-- above-left and below-left channels all connect to the same process. If you-- have a two-by-two grid, a process's four diagonal channels all connect to-- the same process.wrappedGridEight::(Connectableabovebelow,Connectableleftright,ConnectableaboveLeftbelowRight,ConnectablebelowLeftaboveRight)=>[[EightWayabovebelowleftrightaboveLeftbelowRightaboveRightbelowLeft->CHPa]]->CHP[[a]]wrappedGridEightps|length(nub$maplengthps)<=1=connectColumnsCycleDiag(length(headps))$mapconnectRowCycleDiagps|otherwise=error$"Control.Concurrent.CHP.Connect.TwoDim.wrappedGridDiag: Non-rectangular input "++" height: "++show(lengthps)++" widths: "++show(maplengthps)-- | Like 'wrappedGridEight' but discards the output.wrappedGridEight_::(Connectableabovebelow,Connectableleftright,ConnectableaboveLeftbelowRight,ConnectablebelowLeftaboveRight)=>[[EightWayabovebelowleftrightaboveLeftbelowRightaboveRightbelowLeft->CHPa]]->CHP()wrappedGridEight_ps=wrappedGridEightps>>return()connectRowCycle::Connectableleftright=>[FourWayabovebelowleftright->CHPa]->([(above,below)]->CHP[a])connectRowCycle[]_=return[]connectRowCycleallpsabs=connect$foldrconnLR-- The last process is special because it must take both channels for itself:(liftM(:[]).lastallps.uncurry(uncurryFourWay$lastabs))(zip(initallps)(initabs))connLR::Connectableleftright=>(FourWayabovebelowleftright->CHPa,(above,below))->((left,right)->CHP[a])->((left,right)->CHP[a])connLR(p,(a,b))q(l,r)=liftM(uncurry(:)).connect$\(l',r')->p(FourWayablr')<||>q(l',r)connectColumnsCycle::Connectableabovebelow=>Int->[[(above,below)]->CHP[a]]->CHP[[a]]connectColumnsCycle_[]=return[]connectColumnsCyclenps=connectListn$foldl1(connABn)(map(liftM(:[]).)ps)connAB::Connectableabovebelow=>Int->([(above,below)]->CHP[a])->([(above,below)]->CHP[a])->([(above,below)]->CHP[a])connABnpqabs=liftM(uncurry(++))$connectListn$\abs'->p(zip(mapfstabs)(mapsndabs'))<||>q(zip(mapfstabs')(mapsndabs))connectColumnsCycleDiag::(Connectableab,Connectableblar,Connectablealbr)=>Int->[[((a,b),FourWayDiagalbrarbl)]->CHP[z]]->CHP[[z]]connectColumnsCycleDiag_[]=return[]connectColumnsCycleDiagnps=connectListn$\abs->connectListn$\leadingDiag->connectListn$\otherDiag->foldl1(connABDiagn)(map(liftM(:[]).)ps)$zipabs[FourWayDiagalbrarbl|(_,ar)<-otherDiag|(bl,_)<-shiftRightotherDiag|(al,_)<-leadingDiag|(_,br)<-shiftLeftleadingDiag]-- Let's imagine we have a square:---- A B C-- D E F-- G H I---- We pass in the outer-most channels as the processes need them to be wired.---- So for example, A will recieve:-- aboveLeft: AI-- aboveRight AH-- belowLeft: AF-- belowRight: AE---- So for example when we create the leadingDiag channels:---- \1 \2 \3 -- A B C---- The ends are passed to the above channels as-is, but to the below channels shifted lleft:---- G H I-- \2 \3 \1---- For the otherDiag, shifted right when below:---- /1 /2 /3-- A B C---- G H I-- /3 /1 /2shiftLeft,shiftRight::[a]->[a]shiftLeft[]=[]shiftLeftxs=tailxs++[headxs]shiftRight[]=[]shiftRightxs=lastxs:initxsconnABDiag::(Connectableabovebelow,Connectablealbr,Connectableblar)=>Int->([((above,below),FourWayDiagalbrarbl)]->CHP[a])->([((above,below),FourWayDiagalbrarbl)]->CHP[a])->([((above,below),FourWayDiagalbrarbl)]->CHP[a])connABDiagnpqabs=liftM(uncurry(++))$connectListn$\abs'->connectListn$\leadingDiag->connectListn$\otherDiag->p[((a,b),FourWayDiagalbrarbl)|((a,_),_)<-abs|(_,b)<-abs'|(_,FourWayDiagal_ar_)<-abs|(bl,_)<-shiftRightotherDiag|(_,br)<-shiftLeftleadingDiag]<||>q[((a,b),FourWayDiagalbrarbl)|((_,b),_)<-abs|(a,_)<-abs'|(al,_)<-leadingDiag|(_,ar)<-otherDiag|(_,FourWayDiag_br_bl)<-abs]-- We are given our own above and below as we need them to be arranged already.connectRowCycleDiag::Connectablelr=>[EightWayablralbrarbl->CHPz]->([((a,b),FourWayDiagalbrarbl)]->CHP[z])connectRowCycleDiag[]_=return[]connectRowCycleDiagallpsabs=connect$foldrconnLRDiag-- The last process is special because it must take both channels for itself:(\lr->liftM(:[])$lastallps$first(($lr).uncurry.uncurryFourWay)(lastabs))(zip(initallps)(initabs))connLRDiag::Connectablelr=>(EightWayablralbrarbl->CHPz,((a,b),FourWayDiagalbrarbl))->((l,r)->CHP[z])->((l,r)->CHP[z])connLRDiag(p,((a,b),diag))q(l,r)=liftM(uncurry(:)).connect$\(l',r')->p(FourWayablr',diag)<||>q(l',r)