-- |
-- Module      :  RingSkels
-- Copyright   :  (c) Philipps Universitaet Marburg 2009-2010
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  eden@mathematik.uni-marburg.de
-- Stability   :  beta
-- Portability :  not portable
--
-- The following Haskell module provides different ring skeletons in Eden.
-- (just for testing)
-- Note that ringRD is defined as standard ring skeleton 
-- in Control.Parallel.Eden.EdenSkel.topoSkels
--
-- Depends on the Eden Compiler.
--
-- Eden Project

module RingSkels (ringSimple,ring,ringRD) where
import Control.Parallel.Eden
       
ring :: (Trans a,Trans b,Trans c) =>
         Int -> (Int -> a -> [a]) -> ([b] -> b) ->
         ((a,[c]) -> (b,[c])) -> a -> b
ring n dist comb f input = comb toParent  where
  (toParent,nexts) = unzip outss
  outss      = spawn (repeat (plink f)) inss -- [(plink f) # ins | ins <- inss]
  inss       = mzip toChildren prevs
  toChildren = dist n input
  prevs      = tail nexts ++ [head nexts]   

-- each link process in the ring
plink ::(Trans a,Trans b,Trans c) =>
         ((a,[c]) -> (b,[c])) -> Process (a,ChanName [c]) (b,ChanName [c])
plink f = process fun_link
	  where fun_link (fromParent,nextChan) =
		    new (\prevChan prev ->
			 let (toParent,next) = f (fromParent,prev)
			 in parfill nextChan next (toParent,prevChan))

mzip (x:xs) ~(y:ys) = (x,y) : mzip xs ys
mzip _ _            = []

ringSimple :: (Trans a,Trans b,Trans c) =>
         Int -> (Int -> a -> [a]) -> ([b] -> b) ->
         ((a,[c]) -> (b,[c])) -> a -> b
ringSimple n dist comb f input = comb toParent  where
  (toParent,nexts) = unzip outss
  outss      = spawn (repeat (process f)) inss -- [f # ins | ins <- inss]
  inss       = mzip toChildren prevs
  toChildren = dist n input
  prevs      = -- tail nexts ++ [head nexts]   --
               last nexts : init nexts

ringRD :: (Trans a,Trans b,Trans c) =>
         Int -> (Int -> a -> [a]) -> ([b] -> b) ->
         ((a,[c]) -> (b,[c])) -> a -> b
ringRD n dist comb f input = comb toParent  where
  (toParent,nexts) = unzip outss
  outss      = spawn (repeat (process f_RD)) inss -- [f # ins | ins <- inss]
  inss       = mzip toChildren prevs
  toChildren = dist n input
  prevs      = last nexts : init nexts
  f_RD (i, ringIn) = (o, release ringOut)
      where (o, ringOut) = f (i, fetch ringIn)