-------------------------------------------------------------------------------
--- $Id: Combinators.hs#7 2010/09/24 12:10:22 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.Combinators (module Lava.Combinators)
where
import Control.Monad.State
import Lava.Netlist

-- * Lava Combinators

-------------------------------------------------------------------------------

infixr 5 >->
infixr 5 >|>

-- ** Serial composition combinators

-------------------------------------------------------------------------------
-- | Serial composition with horizontal left to right layout

(>->) :: (a -> Out b) -> (b -> Out c) -> a -> Out c
(>->) circuit1 circuit2 input1
  = do incrementLayoutNesting
       intermediateResult <- circuit1 input1
       r <- circuit2 intermediateResult
       decrementLayoutNesting
       state <- get
       let l = layout state
           bTile:aTile:lrest = l
           (aW, aH) = sizeOfLayout aTile
           (bW, bH) = sizeOfLayout bTile
       when (length l >= 2) $
         put state{layout = Beside (aW+bW, aH `max` bH) aTile bTile : lrest}
       return r

-------------------------------------------------------------------------------
-- | Serial composition with overly layout

(>|>) :: (a -> Out b) -> (b -> Out c) -> a -> Out c
(>|>) circuit1 circuit2 input1
  = do incrementLayoutNesting
       intermediateResult <- circuit1 input1
       r <- circuit2 intermediateResult
       decrementLayoutNesting
       state <- get
       let l = layout state
           bTile:aTile:lrest = l
           (aW, aH) = sizeOfLayout aTile
           (bW, bH) = sizeOfLayout bTile
       when (length l >= 2) $
         put state{layout = Overlay (aW `max`bW, aH `max` bH) aTile bTile : lrest}
       return r

-------------------------------------------------------------------------------

-- ** Parallel composition combinators

-------------------------------------------------------------------------------
-- | Repeated serial composition (left to right)

hRepN :: Int -> (a -> Out a) -> a -> Out a
hRepN 1 circuit = circuit
hRepN n circuit
  = circuit >-> (hRepN (n-1) circuit)

-------------------------------------------------------------------------------
-- | Horizontal parallel composition of two circuits

par2 :: (a -> Out c) -> (b -> Out d) -> (a, b) -> Out (c, d)
par2 circuit1 circuit2 (a, b)
  = do incrementLayoutNesting
       c <- circuit1 a
       d <- circuit2 b
       decrementLayoutNesting
       state <- get
       let l = layout state
           bTile:aTile:lrest = l
           (aW, aH) = sizeOfLayout aTile
           (bW, bH) = sizeOfLayout bTile
       when (length l >= 2) $
         put state{layout = Below (aW `max` bW, aH+bH) aTile bTile : lrest}
       return (c, d)

-------------------------------------------------------------------------------
-- | Parallel composition of two circuit which have overlaid layout

par2Overlay :: (a -> Out c) -> (b -> Out d) -> (a, b) -> Out (c, d)
par2Overlay circuit1 circuit2 (a, b)
  = do incrementLayoutNesting
       c <- circuit1 a
       d <- circuit2 b
       decrementLayoutNesting
       state <- get
       let l = layout state
           bTile:aTile:lrest = l
           (aW, aH) = sizeOfLayout aTile
           (bW, bH) = sizeOfLayout bTile
       when (length l >= 2) $
         put state{layout = Overlay (aW `max` bW, aH `max` bH) aTile bTile : lrest}
       return (c, d)

-------------------------------------------------------------------------------
-- | Parallel composition of three circuit which have overlaid layout

par3Overlay :: (a -> Out ao) -> (b -> Out bo) -> (c -> Out co) 
                -> (a, b, c)
                -> Out (ao, bo, co)
par3Overlay circuit1 circuit2 circuit3 (a, b, c)
  = do ((ao,bo),co) <- par2Overlay (par2Overlay circuit1 circuit2) circuit3
                       ((a,b), c)
       return (ao, bo, co)

-------------------------------------------------------------------------------
-- | Horizontal parallel composition of a list of circuits

hpar :: [a -> Out b] -> [a] -> Out [b]
hpar [] [] = return []
hpar (c:cs) (i:is)
  = do (x,y) <- par2 c (hpar cs) (i, is)
       return (x:y)
    
-------------------------------------------------------------------------------
-- | Horizontal repeated parallel composition of a circuit

hparN :: Int -> (a -> Out b) -> [a] -> Out [b]
hparN n circuit = hpar (replicate n circuit)

-- ** Wiring combinators

-------------------------------------------------------------------------------
-- | Splits a wire into two

fork2 :: a -> Out (a, a)
fork2 a = return (a, a)

-------------------------------------------------------------------------------
-- | Converts a two element list into a pair

listToPair :: [a] -> Out (a, a)
listToPair [a, b] = return (a, b)
listToPair other 
  = error ("listToPair called with a list of length " ++ show (length other))

-------------------------------------------------------------------------------
-- | Converts a par into a list containing two elements

pairToList :: (a, a) -> Out [a]
pairToList (a, b) = return [a, b]

-------------------------------------------------------------------------------
-- | Takes a pair of lists and returns a zipped list of pairs

ziP :: ([a], [b]) -> Out [(a,b)]
ziP (a,b) = return (zip a b)

-------------------------------------------------------------------------------
-- | Takes a list of pairs and unzips it into a pair of  lists

unziP :: [(a,b)] -> Out ([a], [b])
unziP list = return (unzip list)

-------------------------------------------------------------------------------
-- | Takes a list containing two elements and returns a list of lists
--   where each element is a two element list

zipList :: [[a]] -> Out [[a]]
zipList [[], _] = return []
zipList [_, []] = return []
zipList [a:as, b:bs] 
  = do rest <- zipList [as, bs]
       return ([a,b] : rest) 

-------------------------------------------------------------------------------
-- | Undo the zipList operation

unzipList :: [[a]] -> Out [[a]]
unzipList list = return [map fstListPair list, map sndListPair list]

-------------------------------------------------------------------------------

fstListPair :: [a] -> a
fstListPair [a, _] = a 

-------------------------------------------------------------------------------

sndListPair :: [a] -> a
sndListPair [_, b] = b 

-------------------------------------------------------------------------------
-- | This makes pairs out of consequetive members of an even length list.

pair :: [a] -> Out [[a]]
pair [] = return []
pair lst | odd (length lst) 
  = error ("pair given odd length list of size " ++ show (length lst))
pair (a:b:rest) 
  = do rest <- pair rest
       return ([a,b]:rest)

-------------------------------------------------------------------------------
-- | Takes a list of pairs and returns a flattend list

unpair :: [[a]] -> Out [a]
unpair list = return (concat list)

-------------------------------------------------------------------------------
-- | Tales a list and returns a pair containing the two halves of the list

halve :: [a] -> Out ([a], [a])
halve l
  = return (take n l, drop n l)
    where
    n = length l `div` 2
 
-------------------------------------------------------------------------------
-- | Take a pair containing two list halves and undoes the halve

unhalve :: ([a], [a]) -> Out [a]
unhalve (a, b) = return (a ++ b)

-------------------------------------------------------------------------------
-- | Halves the input list into a list containign the two halves

halveList :: [a] -> Out [[a]]
halveList l
  = return [take n l, drop n l]
    where
    n = length l `div` 2
 
-------------------------------------------------------------------------------
-- | Undoes halveList

unhalveList :: [[a]] -> Out [a]
unhalveList [a, b] = return (a ++ b)

-------------------------------------------------------------------------------
-- | Chops a list into chunks

chop :: Int -> [a] -> Out [[a]]
chop n [] = return []
chop n l 
  = do rest <- chop n (drop n l)
       return ((take n l) : rest)

-------------------------------------------------------------------------------
-- | Takes a list of lists and returns their concatenation

concaT :: [[a]] -> Out [a]
concaT list = return (concat list)

-------------------------------------------------------------------------------
-- | Applies a circuit to the first halve of a list

fstList :: ([a] -> Out [a]) -> [a] -> Out [a]
fstList f = halve >-> fsT f >-> unhalve

-------------------------------------------------------------------------------
-- | Applies a circuit to the second halve of a list

sndList :: ([a] -> Out [a]) -> [a] -> Out [a]
sndList f = halve >-> snD f >-> unhalve

-------------------------------------------------------------------------------
-- | Applies a circuit to the first element of a pair

fsT :: (a -> Out b) -> (a, c) -> Out (b, c)
fsT f (a, b) 
  = do c <- f a
       return (c, b)

-------------------------------------------------------------------------------
-- | Applies a circuit to the second element of a pair

snD :: (b -> Out c) -> (a, b) -> Out (a, c)
snD f (a, b) 
  = do c <- f b
       return (a, c)

-------------------------------------------------------------------------------
-- Reverses a list

reversE :: [a] -> Out [a]
reversE list = return (reverse list)

-------------------------------------------------------------------------------