-----------------------------------------------------------------------------
-- |
-- Module  :  ForSyDe.Shallow.MoC.Untimed
-- Copyright   :  (c) ForSyDe Group, KTH 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.MoC.Untimed (
  -- * 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.Core

----------------------------------------
-- 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)