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

module Lava.CircuitGraphToVHDL (putXilinxVHDL)
where
import System.IO
	
import Control.Monad.State
import Data.Array.Unboxed
import Lava.Netlist
import Lava.PortRange
import Lava.RPM
import Lava.Utils
import Lava.Version

-- * Generating VHDL from a Lava netlist

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

putXilinxVHDL :: Netlist -> IO ()
putXilinxVHDL netlist
  = do putStr ("Generating " ++ filename ++ " ...")
       file <- openFile (name ++ ".vhd") WriteMode
       ds <- dateString
       hPutStrLn file (replicate 79 '-')
       hPutStrLn file ("-- Automatically generated by Lava version " ++
                        versionStr)
       hPutStrLn file ("-- Generated on " ++ ds) 
       hPutStrLn file ("-- Architecture: " ++ show (xilinxArchitecture netlist))
       when (wh /= (0,0)) $
         hPutStrLn file ("-- Layout (width, height) = " ++ show wh)
       hPutStrLn file (replicate 79 '-')
       hPutStrLn file ""

       circuitToVHDL file netlist

       hClose file
       putStrLn " [done]"
    where
    name = circuitName netlist
    filename = name++".vhd"
    circuitPorts = ports netlist
    circuitInstances = instances netlist
    nC = netCount netlist
    (major1, major2, minor, patch) = lavaVersion
    versionStr = show major1 ++ "." ++ show major2 ++ "." ++ show minor ++ 
                 "." ++ show patch
    wh = if layout netlist == [] then
           (0, 0)
         else
           sizeOfLayout (head (layout netlist))

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

circuitToVHDL :: Handle -> Netlist -> IO ()
circuitToVHDL file netlist
  = do mapM_ (circuitToVHDL file) (subCircuits netlist)
       when (wh /= (0,0)) $
         hPutStrLn file ("-- Layout (width, height) = " ++ show wh)
       vhdlPackage file name circuitPorts
       vhdlEntity file name circuitPorts
       vhdlArchitecture file name (subCircuits netlist)
                        circuitPorts circuitInstances nC
                        (computedShifts netlist) (xilinxArchitecture netlist)
       hPutStrLn file ""
       hPutStrLn file (replicate 79 '-')
       hPutStrLn file ""
    where
    name = circuitName netlist
    filename = name++".vhd"
    circuitPorts = ports netlist
    circuitInstances = instances netlist
    nC = netCount netlist
    wh = if layout netlist == [] then
           (0, 0)
         else
           sizeOfLayout (head (layout netlist))

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

vhdlPackage :: Handle -> String -> [PortDeclaration] -> IO ()
vhdlPackage handle name interface
  = do hPutStr handle (unlines entity)
    where
    entity =
     ["library ieee ;",
      "use ieee.std_logic_1164.all ;",
      "package " ++ name ++ "_package is",
      "",
      "  component " ++ name ++ " is ",
      "    port(" ++ vhdlPorts (reverse interface)] ++
     ["        ) ;",
      "  end component " ++ name ++ " ;",
      "",
      "end package " ++ name ++ "_package ;",
      ""]
     
-------------------------------------------------------------------------------

vhdlEntity :: Handle -> String -> [PortDeclaration] -> IO ()
vhdlEntity handle name interface
  = do hPutStr handle (unlines entity)
    where
    entity =
     ["library ieee ;",
      "use ieee.std_logic_1164.all ;",
      "entity " ++ name ++ " is ",
      "  port(" ++ vhdlPorts (reverse interface)] ++
     ["      ) ;",
      "end entity " ++ name ++ " ;",
      ""]
     
-------------------------------------------------------------------------------

vhdlPorts :: [PortDeclaration] -> String
vhdlPorts intf
  = insertString " ;\n       " (map vhdlPort [p | p <- intf, isNotKept p])

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

vhdlPort :: PortDeclaration -> String

vhdlPort (Port name InputPort typ net)
  = name ++ " : in " ++ showType typ

vhdlPort (Port name OutputPort typ net)
  = name ++ " : out " ++ showType typ   

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

isNotKept :: PortDeclaration -> Bool
isNotKept (Port _ LocalInput _ _) = False
isNotKept (Port _ LocalOutput _ _) = False
isNotKept other = True

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

showType :: NetType -> String
showType BitType = "std_logic"
showType (BitVec low dir high)
   = "std_logic_vector (" ++ show low ++ " " ++ showDir dir ++ " " ++ show high ++
     ")"

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

showDir :: Dir -> String
showDir To = "to"
showDir Downto = "downto"

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

vhdlArchitecture :: Handle ->
                    String -> [Netlist] ->
                    [PortDeclaration] ->  [Instance] -> Int -> 
                    (Array Int Int, Array Int Int) -> XilinxArchitecture ->
                    IO ()
vhdlArchitecture file name subcirs ports gates netCount shifts architecture
  = do hPutStr file
        (unlines (["library ieee, unisim ;",
          "use ieee.std_logic_1164.all ;",
          "use unisim.vcomponents.all ;"] ++
         ["use work." ++ circuitName nl ++ "_package.all ;" | nl <- subcirs] ++
         ["architecture lava of " ++ name ++ " is ",
          "  attribute rloc : string ;",
          "  attribute keep : string ;",
          netDefs]))
       declareKeptPorts file ports
       writeRLOCs file architecture shifts gates
       hPutStr file "begin\n"
       hPutStrLn file "  net(0) <= '0' ;" 
       hPutStrLn file "  net(1) <= '1' ;"
       wirePorts file ports
       vhdlInstances file gates
       hPutStr file "end architecture lava ;\n"
     where
     netDefs :: String
     netDefs = if netCount == 1 then
                  "  -- no local Lava nets"
               else
                  "  signal net : std_logic_vector (0 to " ++ 
                  show (netCount-1) ++ ") ;"
-------------------------------------------------------------------------------

declareKeptPorts :: Handle -> [PortDeclaration] -> IO ()
declareKeptPorts file [] = return ()
declareKeptPorts file ((Port name LocalOutput typ@(BitVec a dir b) nets):rest)
  = do hPutStrLn file ("  signal " ++ name ++ " :  " ++ showType typ ++ " ;")
       declareKeptPorts file rest
       hPutStrLn file ("  attribute keep of " ++ name ++ " : signal is \"true\" ;")
declareKeptPorts file ((Port name LocalInput typ@(BitVec a dir b) nets):rest)
  = do hPutStrLn file ("  signal " ++ name ++ " :  " ++ showType typ ++ " ;")
       hPutStrLn file ("  attribute keep of " ++ name ++ " : signal is \"true\" ;")
       declareKeptPorts file rest
declareKeptPorts file (_:rest)
  =  declareKeptPorts file rest

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

wirePorts :: Handle -> [PortDeclaration] -> IO ()
wirePorts file = mapM_ (wirePort file)

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

wirePort :: Handle -> PortDeclaration -> IO ()

-- Wire up a single bit input port.
wirePort file (Port name InputPort BitType [net])
  = hPutStrLn file ("  net(" ++ show net ++ ") <= " ++ name ++ ";")

-- Wire up an input bit-vector
wirePort file (Port name InputPort (BitVec a dir b) nets)
  = sequence_ 
      [hPutStrLn file ("  net(" ++ show net ++ ") <= " ++ name ++ "(" ++ show i ++ ")" ++ ";") | (i, net) <- zip (portRange a dir b) nets]

-- Wire up a local input bit-vector
wirePort file (Port name LocalInput (BitVec a dir b) nets)
  = sequence_ 
      [hPutStrLn file ("  net(" ++ show net ++ ") <= " ++ name ++ "(" ++ show i ++ ")" ++ ";") | (i, net) <- zip (portRange a dir b) nets]


-- Wire up a single bit output port.
wirePort file (Port name OutputPort BitType [net])
  = hPutStrLn file ("  " ++ name ++ " <= net(" ++show  net ++ ") ;")

-- Wire up an output bit-vector
wirePort file (Port name OutputPort (BitVec a dir b) nets)
  = sequence_ [hPutStrLn file ("  " ++ name ++ "(" ++ show i ++ ") <= net(" ++show  net ++ ") ;")
               | (i, net) <- zip (portRange a dir b) nets]
wirePort file (Port name LocalOutput (BitVec a dir b) nets)
  = sequence_ [hPutStrLn file ("  " ++ name ++ "(" ++ show i ++ ") <= net(" ++show  net ++ ") ;")
               | (i, net) <- zip (portRange a dir b) nets]

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

vhdlInstances :: Handle -> [Instance] -> IO ()
vhdlInstances file gates
   = mapM_ (vhdlInstance file) gates

-------------------------------------------------------------------------------
   
vhdlInstance :: Handle -> Instance -> IO ()
vhdlInstance file inst
  = case component inst of
      Lut1 opBits i0 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut1 " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), o => net(" ++ 
                     show o ++ ")) " ++
                     if comment /= "" then "; -- " ++ comment else ";")
      Lut2 opBits i0 i1 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut2 " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), " ++
                               "i1 => net(" ++ show i1 ++ "), " ++
                               "o => net(" ++ show o ++ ")) " ++ 
                     if comment /= "" then "; -- " ++ comment else ";")
      Lut2_l opBits i0 i1 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut2_l " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), " ++
                               "i1 => net(" ++ show i1 ++ "), " ++
                               "lo => net(" ++ show o ++ ")) " ++ 
                     if comment /= "" then "; -- " ++ comment else ";")
      Lut3 opBits i0 i1 i2 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut3 " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), " ++
                               "i1 => net(" ++ show i1 ++ "), " ++
                               "i2 => net(" ++ show i2 ++ "), " ++
                               "o => net(" ++ show o ++ ")) " ++ 
                     if comment /= "" then "; -- " ++ comment else ";")
      Lut4 opBits i0 i1 i2 i3 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut4 " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), " ++
                               "i1 => net(" ++ show i1 ++ "), " ++
                               "i2 => net(" ++ show i2 ++ "), " ++
                               "i3 => net(" ++ show i3 ++ "), " ++
                               "o => net(" ++ show o ++ ")) " ++ 
                     if comment /= "" then "; -- " ++ comment else ";")
      Lut5 opBits i0 i1 i2 i3 i4 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut5 " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), " ++
                               "i1 => net(" ++ show i1 ++ "), " ++
                               "i2 => net(" ++ show i2 ++ "), " ++
                               "i3 => net(" ++ show i3 ++ "), " ++
                               "i4 => net(" ++ show i4 ++ "), " ++
                               "o => net(" ++ show o ++ ")) " ++ 
                     if comment /= "" then "; -- " ++ comment else ";")
      Lut6 opBits i0 i1 i2 i3 i4 i5 o comment ->
         hPutStrLn file ("  " ++ instName ++ " : lut6 " ++
                     "generic map (init => \"" ++ showOpBits opBits ++
                      "\") " ++
                     "port map (i0 => net(" ++ show i0 ++ "), " ++
                               "i1 => net(" ++ show i1 ++ "), " ++
                               "i2 => net(" ++ show i2 ++ "), " ++
                               "i3 => net(" ++ show i3 ++ "), " ++
                               "i4 => net(" ++ show i4 ++ "), " ++
                               "i5 => net(" ++ show i5 ++ "), " ++
                               "o => net(" ++ show o ++ ")) " ++ 
                     if comment /= "" then "; -- " ++ comment else ";")
      PrimitiveGate inputPorts outputs ->
         hPutStrLn file ("  " ++ instName ++ " : " ++ componentName inst ++
                         " port map (" ++
                   insertCommas [p ++ " => net(" ++ show a ++ ")" | (p,a) <- inputPorts ++ outputs] ++
                  ") ; ")
    where
    instName = componentName inst ++ "_" ++ show (instanceNumber inst)

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

showOpBits = map intToChar 
intToChar 0 = '0'
intToChar 1 = '1'

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

writeRLOCs :: Handle -> XilinxArchitecture -> (Array Int Int, Array Int Int) 
              -> [Instance] -> IO ()
writeRLOCs file arch dxy  = mapM_ (writeRLOC file arch dxy) 

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

writeRLOC :: Handle -> XilinxArchitecture ->  (Array Int Int, Array Int Int) 
             -> Instance -> IO ()
writeRLOC file arch (dx, dy) inst
   = if pos == Unplaced then
       return ()
     else
       hPutStrLn file ("  attribute rloc of " ++ instName ++ " : label is \"" 
                         ++ showRLOC arch (dx!i,dy!i) ++ "\" ;")
     where
     pos = position inst
     i = instanceNumber inst
     instName = componentName inst ++ "_" ++ show i

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