-----------------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Shallow.UntimedLib
-- Copyright   :  (c) SAM Group, KTH/ICT/ECS 2007-2008
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  forsyde-dev@ict.kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- The untimed library defines process constructors and processes for
-- the untimed computational model. A process constructor is a higher
-- order function which together with combinational function(s) and
-- values as arguments constructs a process.
-----------------------------------------------------------------------------
module ForSyDe.Shallow.UntimedLib(  
                    -- * Combinational process constructors
		    -- | Combinational process constructors are used for processes that do not have a state.
                    combU, comb2U, comb2UC,
		    mapU,
           	    -- * Sequential process constructors
		    -- | Sequential process constructors are used for processes that have a state. One of the input parameters is the initial state.
                    scanU, mealyU, mooreU, sourceU, sinkU, initU,
		    -- * Zipping and unzipping signals
		    zipU, zipUs,
		    zipWithU, zipWith3U, zipWith4U,
		    unzipU
                  )
where

import ForSyDe.Shallow.CoreLib

----------------------------------------
--                                    --
-- COMBINATIONAL PROCESS CONSTRUCTORS --
--                                    --
----------------------------------------

combU :: Int -> ([a] -> [b]) -> Signal a -> Signal b
combU = mapU

comb2U :: Int -> Int -> ([a]->[b]->[c]) -> Signal a -> Signal b -> Signal c
comb2U = zipWithU

comb2UC :: Int -> (a->[b]->[c]) -> Signal a -> Signal b -> Signal c
comb2UC = zipWithUC

-- | The first parameter of 'mapU' is a constant integer defining the number of tokens consumed in every evaluation cycle. The second argument is a function on lists of the input type and returning a list of the output type. For instance,
--
-- > r2 = mapU 1 f
-- >   where f :: [Int] -> [Int]
-- >         f [x] = [2*x]
--
-- defines a process r2 which consumes one token in each evaluation cycle and multiplies it by two.
mapU :: Int -> ([a] -> [b]) -> Signal a -> Signal b
mapU _ _ NullS = NullS
mapU c f xs | lengthS (takeS c xs) < c = NullS
            | otherwise
	      = signal (f (takeL c xs)) +-+ (mapU c f (dropS c xs))
	      
--mapUC :: Int -> ([a] -> b) -> Signal a -> Signal b
--mapUC _ _ NullS = NullS
--mapUC c f xs | lengthS (takeS c xs) < c = NullS
--             | otherwise 
--	       =  signal [(f (takeL c xs))] +-+ (mapUC c f (dropS c xs))

---------------------------
--                       --
-- SYNCHRONOUS PROCESSES --
--                       --
---------------------------

-- | 'scanU' has an internal state which is visible at the output. The first argument is a function \'gamma\' which, given the state returns the number of tokens consumed next. The second argument is the next state function and the third is the initial state.
scanU :: (b->Int) -> (b->[a]->b) -> b -> Signal a -> Signal b
scanU _     _ _     NullS = NullS
scanU gamma g state xs 
    | length as == c = newstate :- scanU gamma g newstate (dropS c xs)
    | otherwise       = NullS
    where c        = gamma state
	  as       = takeL c xs
	  newstate = g state as



-- | The process constructor 'mooreU' creates a state machine of Moore type. In addition to the next state function they also have an output encoding function. The output depends directly on the internal state.
mooreU :: (b->Int) -> (b->[a]->b) -> (b -> [c]) -> b -> Signal a -> Signal c
mooreU _ _ _ _ NullS = NullS
mooreU gamma g f state xs
    | length as == c = (signal bs) +-+ mooreU gamma g f newstate (dropS c xs)
    | otherwise      = NullS
    where c        = gamma state
	  as       = takeL c xs
	  newstate = g state as 
	  bs       = f state

-- | The process constructor 'mealyU' creates a state machine of Moore type. In addition to the next state function they also have an output encoding function. The output depends directly on the internal state.
mealyU :: (b->Int) -> (b->[a]->b) -> (b -> [a] -> [c]) -> b 
       -> Signal a -> Signal c
mealyU _ _ _ _ NullS = NullS
mealyU gamma g f state xs
    | length as == c = (signal bs) 
		       +-+ mealyU gamma g f newstate (dropS c xs)
    | otherwise      = NullS
    where c        = gamma state
	  as       = takeL c xs
	  newstate = g state as
	  bs       = f state as


zipU  :: Signal (Int,Int) -> Signal a -> Signal b -> Signal ([a],[b])
zipU NullS _ _ = NullS
zipU _ NullS _ = NullS
zipU _ _ NullS = NullS
zipU ((c1,c2):-cs) xs ys
     | lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
       = (takeL c1 xs,takeL c2 ys) :- zipU cs (dropS c1 xs) (dropS c2 ys)
     | otherwise = NullS

zipUs :: Int -> Int ->       Signal a -> Signal b -> Signal ([a],[b])
zipUs _ _ NullS _ = NullS 
zipUs _ _ _ NullS = NullS 
zipUs c1 c2 xs ys 
      | lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
        = (takeL c1 xs,takeL c2 ys) 
	  :- zipUs c1 c2 (dropS c1 xs) (dropS c2 ys)
      | otherwise = NullS

zipWithU :: Int -> Int -> ([a]->[b]->[c]) -> Signal a -> Signal b -> Signal c
zipWithU _ _ _ NullS _     = NullS
zipWithU _ _ _ _     NullS = NullS
zipWithU c1 c2 f xs ys 
	 | lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2
	   = signal (f (takeL c1 xs) (takeL c2 ys))
	     +-+ zipWithU c1 c2 f (dropS c1 xs) (dropS c2 ys)
         | otherwise = NullS

zipWithUC :: Int -> (a->[b]->[c]) -> Signal a -> Signal b -> Signal c
zipWithUC _ _ NullS _ = NullS
zipWithUC _ _ _ NullS = NullS
zipWithUC c1 f xs ys
	 | lengthS (takeS 1 xs) == 1 && lengthS (takeS c1 ys) == c1
	   = signal (f (headS xs) (takeL c1 ys))
	     +-+ zipWithUC c1 f (tailS xs) (dropS c1 ys)
         | otherwise = NullS

zipWith3U :: Int -> Int -> Int -> ([a]->[b]->[c]->[d]) -> Signal a -> Signal b -> Signal c -> Signal d
zipWith3U _ _ _ _ NullS _ _ = NullS
zipWith3U _ _ _ _ _ NullS _ = NullS
zipWith3U _ _ _ _ _ _ NullS = NullS
zipWith3U c1 c2 c3 f xs ys zs
	 | lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2 && lengthS (takeS c3 zs) == c3
	   = signal (f (takeL c1 xs) (takeL c2 ys) (takeL c3 zs))
	     +-+ zipWith3U c1 c2 c3 f (dropS c1 xs) (dropS c2 ys) (dropS c3 zs)
         | otherwise = NullS
         
zipWith4U :: Int -> Int -> Int -> Int -> ([a]->[b]->[c]->[d]->[e]) ->
               Signal a -> Signal b -> Signal c -> Signal d -> Signal e
zipWith4U _ _ _ _ _ NullS _ _ _= NullS
zipWith4U _ _ _ _ _ _ NullS _ _ = NullS
zipWith4U _ _ _ _ _ _ _ NullS _ = NullS
zipWith4U _ _ _ _ _ _ _ _ NullS = NullS
zipWith4U c1 c2 c3 c4 f xs ys zs as
	 | lengthS (takeS c1 xs) == c1 && lengthS (takeS c2 ys) == c2 
           && lengthS (takeS c3 zs) == c3 && lengthS (takeS c4 as) == c4
	   = signal (f (takeL c1 xs) (takeL c2 ys) (takeL c3 zs) (takeL c4 as))
	     +-+ zipWith4U c1 c2 c3 c4 f (dropS c1 xs) (dropS c2 ys) (dropS c3 zs) (dropS c4 as)
         | otherwise = NullS

unzipU :: Signal ([a],[b]) -> (Signal a,Signal b)
unzipU NullS = (NullS,NullS)
unzipU ((as,bs):-xs) = (signal as +-+ ass, 
		        signal bs +-+ bss)
		     where (ass,bss) = unzipU xs

sourceU :: (a->a) -> a -> Signal a
sourceU g state = newstate :- sourceU g newstate
		where newstate = g state

sinkU :: (a->Int) -> (a->a) -> a -> Signal b -> Signal b
sinkU _ _ _ NullS = NullS
sinkU gamma g state xs 
      |  length as == c = sinkU gamma g newstate (dropS c xs)
      | otherwise      = NullS
      where as       = takeL c xs
	    c        = gamma state
	    newstate = g state


-- | 'initU' is used to initialise a signal. Its first argument is prepended to its second argument, a signal.
initU ::  [a] -> Signal a -> Signal a
initU initial s = (signal initial) +-+ s

takeL :: Int -> Signal a -> [a]
takeL c = fromSignal . (takeS c)