-------------------------------------------------------------------------------
--- $Id: Combinators.hs#5 2010/09/21 16:53:24 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.Combinators (module Lava.Combinators)
where
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 inst0 <- getInstCount
       incrementLayoutNesting
       intermediateResult <- circuit1 input1
       inst1 <- getInstCount
       r <- circuit2 intermediateResult
       inst2 <- getInstCount
       decrementLayoutNesting
       if (inst1 - inst0 == 0) || (inst2 - inst1 == 0) then
         return r
        else
         do addLayout (Beside (inst0, inst1-1) (inst1, inst2-1))
            return r
       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
       return r

-- ** Parallel composition combinators

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

replicateHorizontal :: Int -> (a -> Out a) -> a -> Out a
replicateHorizontal 1 circuit = circuit
replicateHorizontal n circuit
  = circuit >-> (replicateHorizontal (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 inst0 <- getInstCount
       incrementLayoutNesting
       c <- circuit1 a
       inst1 <- getInstCount
       d <- circuit2 b
       inst2 <- getInstCount
       decrementLayoutNesting
       if (inst1 - inst0 == 0) || (inst2 - inst1 == 0) then
         return (c, d)
        else
         do addLayout (Below (inst0, inst1-1) (inst1, inst2-1))
            return (c, d)
       return (c, d)

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

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