-------------------------------------------------------------------------------
--- $Id: ApplyLayout.hs#7 2010/10/01 19:17:36 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.ComputeNetDrivers
where

import Data.Array
import Data.Array.ST
import Control.Monad.State
import Control.Monad.ST
import Lava.Netlist

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

computeNetDrivers :: Netlist -> Netlist
computeNetDrivers netlist
  = netlist{netDrivers = runST (computeNetDrivers' netlist)}
 
-------------------------------------------------------------------------------

computeNetDrivers' :: Netlist -> ST s (Array Int DrivenPorts)
computeNetDrivers' netlist
  = do driven <- newArray (0, n-1) [] :: ST s (STArray s Int DrivenPorts)
       mapM_ (addDrivenNets driven) (instances netlist)
       freeze driven
    where
    n = netCount netlist

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

addDrivenNets :: STArray s Int DrivenPorts -> Instance -> ST s ()
addDrivenNets drivenPorts inst
  = case component inst of
      Lut1 _ i _ _ -> pushDriver drivenPorts i "i" 
                        (componentName inst ++ "_" ++ 
                         show (instanceNumber inst))
      Lut2 _ i0 i1 _ _ -> do pushDriver drivenPorts i0 "i0" instName
                             pushDriver drivenPorts i1 "i1" instName
 
   where
   instName = componentName inst ++ "_" ++ show (instanceNumber inst)

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

pushDriver :: STArray s Int DrivenPorts
              -> Int -> String -> String -> ST s ()
pushDriver drivenArray i port inst
  = do driven <- readArray drivenArray i
       writeArray drivenArray i ((port, inst) : driven)

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