-------------------------------------------------------------------------------
--  $Id: Netlist.hs#1 2009/10/01 10:31:09 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.Netlist (module Lava.Netlist,
                     module Lava.Instance,
                     module Lava.Primitives,
                     module Lava.TypeExpr)
where 
import Lava.Elaborate
import Lava.Instance
import Lava.Primitives
import Lava.TypeExpr

import Control.Monad.State
import Data.Array.IArray
import Data.Array.IO

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

type RawNetlist = (Int, Int, [Port], [Instance], IODriverArray)

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

netlist :: Out () -> IO RawNetlist
netlist circuit
  = do da <- driverListToDriverArray netCount dl
       return (elaborate (netCount, instCount, ports, instTree, da))
    where
    (netCount, instCount, ports, instTree, dl) 
       = execState (addGroundAndPower circuit) (0, 1, [], [], [])

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

driverListToDriverArray :: Int -> DriverList -> IO IODriverArray
driverListToDriverArray netCount driverList
   = do da <- newListArray (0, netCount-1) (replicate netCount [])
        driverListToDriverArray' driverList da
        return da

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

driverListToDriverArray' :: DriverList -> IODriverArray -> IO ()
driverListToDriverArray' [] driverArray = return ()
driverListToDriverArray' ((driver, driven@(inst, port)):rest) driverArray
  = do currentValue <- readArray driverArray driver
       writeArray driverArray driver (driven:currentValue)
       driverListToDriverArray' rest driverArray

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


addGroundAndPower circuit
  = do g <- gnd_nl
       v <- vcc_nl
       circuit

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

putRawNetlist :: RawNetlist -> IO ()
putRawNetlist nl
  = putStrLn (unlines (showRawNetlist nl))

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

showRawNetlist :: RawNetlist -> [String]
showRawNetlist (netCount, instCount, ports, instances, dl)
  = showPorts ports ++ showInstances instances

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

showPorts :: [Port] -> [String]
showPorts = map showPort

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

showPort :: Port -> String
showPort (InputPort name typ net)
  = name ++ " #" ++ show net ++ " : in " ++ show typ
showPort (OutputPort name typ net)
  = name ++ " #" ++ show net ++ " : out " ++ show typ

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

showInstances :: [Instance] -> [String]
showInstances = map showInstance

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

showInstance :: Instance -> String
showInstance (instNr, primitive, inputs, outputs)
  = show instNr ++ " : " ++ showPrimitive primitive ++ " " ++ show inputs ++
    " " ++ show outputs

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

showPrimitive :: Primitive -> String
showPrimitive (Gate kind name pos size behav)
  = show kind ++ " " ++ name ++ " " ++ 
    show pos ++ " " ++ show size ++ " " ++ show behav

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