-------------------------------------------------------------------------------
--- $Id: NetlistToEDIF.hs#2 2010/10/04 00:29:53 REDMOND\\satnams $
-------------------------------------------------------------------------------

module Lava.NetlistToEDIF
where
import Control.Monad
import System.IO
import Data.Array

import Lava.ComputeNetDrivers
import Lava.Netlist
import Lava.PortRange
import Lava.RPM 

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

putXilinxEDIF :: Netlist -> IO ()
putXilinxEDIF netlist
  = do putStr ("Generating " ++ filename ++ " ...")
       file <- openFile filename WriteMode
       preamble file netlist
       mainPreamble file netlist
       mapM_ (putDriver file (netDrivers netlistWithDrivers) (ports netlist)) 
              [0..n-1]
       postamble file netlist
       hClose file
       putStrLn " [done]"
    where
    netlistWithDrivers = computeNetDrivers  netlist
    filename = circuitName netlist ++".edif"
    n = netCount netlist

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

putDriver :: Handle ->  Array Int DrivenPorts 
             -> [PortDeclaration] -> Int -> IO ()
putDriver file driven ports i | driven!i == [] = return ()
putDriver file driven ports i
  = do hPutStrLn file ("            (net (rename net_" ++ show i ++ "__ \"net<" ++ show i ++ ">\")")
       hPutStrLn file "              (joined"
       sequence_ [hPutStrLn file ("                (portRef " ++ port ++ " (instanceRef " ++ inst ++ "))") | (port, inst) <- driven!i]
       putPortWires file i ports
       hPutStrLn file "              )"
       hPutStrLn file "            )" 

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

preamble :: Handle -> Netlist -> IO ()
preamble file netlist
  = do hPutStrLn file ("(edif " ++ name)
       hPutStrLn file "  (edifVersion 2 0 0)"
       hPutStrLn file "  (edifLevel 0)"
       hPutStrLn file "  (keywordMap (keywordLevel 0))"
       hPutStrLn file "  (external UNISIMS"
       hPutStrLn file "    (edifLevel 0)"
       hPutStrLn file "    (technology (numberDefinition))"
       -- declareBUF file
       declareComponents file [] (instances netlist)
       hPutStrLn file "  )"
   where
   name = circuitName netlist

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

postamble :: Handle -> Netlist -> IO ()
postamble file netlist
  = do hPutStrLn file "          )"
       hPutStrLn file "      )"
       hPutStrLn file "    )"
       hPutStrLn file "  )"
       hPutStrLn file ""
       hPutStrLn file ("  (design " ++ name)
       hPutStrLn file ("    (cellRef " ++ name)
       hPutStrLn file ("      (libraryRef " ++ name ++ "_lib)")
       hPutStrLn file "    )"
       hPutStrLn file "  )"
       hPutStrLn file ")"
    where
    name = circuitName netlist

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

declareComponents :: Handle -> [String] -> [Instance] -> IO ()
declareComponents _ _ [] = return ()
declareComponents file alreadyDeclared (inst:insts)
  = if (componentName inst `elem` alreadyDeclared) then
      declareComponents file alreadyDeclared insts
     else
       do declareComponent file inst
          declareComponents file (componentName inst : alreadyDeclared) insts

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


declareComponent :: Handle -> Instance -> IO ()
declareComponent file inst
  = case component inst of
      Lut1 _ _ _ _ -> declareCell file "lut1" ["i0"] ["o"]
      Lut2 _ _ _ _ _ -> declareCell file "lut2" ["i0", "i1"] ["o"]
      PrimitiveGate inputs outputs -> declareCell file (componentName inst)
                                        (map fst inputs) (map fst outputs)
      
-------------------------------------------------------------------------------

declareCell :: Handle -> String -> [String] -> [String] -> IO ()
declareCell file cellName inputs outputs
  = do hPutStrLn file ("    (cell " ++ cellName)
       hPutStrLn file  "      (cellType GENERIC)"
       hPutStrLn file  "        (view view_1"
       hPutStrLn file  "          (viewType NETLIST)"
       hPutStrLn file  "          (interface"
       sequence_ [hPutStrLn file ("            (port " ++ i ++ " (direction INPUT))") | i <- inputs]
       sequence_ [hPutStrLn file ("            (port " ++ o ++ " (direction OUTPUT))") | o <- outputs]
       hPutStrLn file  "          )"
       hPutStrLn file  "        )"
       hPutStrLn file  "    )"

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

mainPreamble :: Handle -> Netlist -> IO ()
mainPreamble file netlist
  = do hPutStrLn file ("  (library " ++ name ++ "_lib")
       hPutStrLn file  "    (edifLevel 0)"
       hPutStrLn file  "    (technology (numberDefinition))"
       hPutStrLn file ("    (cell " ++ name)
       hPutStrLn file  "     (cellType GENERIC)"
       hPutStrLn file  "        (view view_1"
       hPutStrLn file  "          (viewType NETLIST)"
       hPutStrLn file  "          (interface"
       mapM_ (putEDIFPort file) (ports netlist)
       when (rlocOrigin netlist /= Nothing) $
         hPutStrLn file ("            (property RLOC_ORIGIN (string \"" ++
           showRLOC (xilinxArchitecture netlist) (x, y) ++ "\"))")
       hPutStrLn file "          )"
       hPutStrLn file "          (contents"
       -- declareBUFInstances file (ports netlist)
       mapM_ (putEDIFInstance file netlist) (instances netlist)
    where
    name = circuitName netlist
    Just (x, y) = rlocOrigin netlist

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

putEDIFPort :: Handle -> PortDeclaration -> IO ()
putEDIFPort file (Port name InputPort BitType _)
  = hPutStrLn file ("            (port " ++ name ++ " (direction INPUT))")
putEDIFPort file (Port name InputPort (BitVec a dir b) _)
  = hPutStrLn file ("            (port (array (rename " ++ name ++ " \"" ++
                     name ++ "<" ++ show a ++ ":" ++ show b ++ ">\") " ++
                     show (abs (a-b)+ 1) ++ ") (direction INPUT))")
putEDIFPort file (Port name OutputPort BitType _)
  = hPutStrLn file ("            (port " ++ name ++ " (direction OUTPUT))")
putEDIFPort file (Port name OutputPort (BitVec a dir b) _)
  = hPutStrLn file ("            (port (array (rename " ++ name ++ " \"" ++
                     name ++ "<" ++ show a ++ ":" ++ show b ++ ">\") " ++
                     show (abs (a-b)+ 1) ++ ") (direction OUTPUT))")

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

putEDIFInstance :: Handle -> Netlist -> Instance -> IO ()
putEDIFInstance file netlist inst
  = case component inst of
      Lut1 prog i0 o comment -> putLUTInstance file netlist inst prog
      Lut2 prog i0 i1 o comment -> putLUTInstance file netlist inst prog
      PrimitiveGate _ _ -> putPrimitiveInstance file netlist inst
    where
    instName = show (instanceNumber inst)

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

putLUTInstance :: Handle -> Netlist -> Instance -> [Int] -> IO ()
putLUTInstance file netlist inst prog
  = do hPutStrLn file ("            (instance " ++ instName)
       hPutStrLn file ("             (viewRef view_1 (cellRef " ++ cellName
                       ++ " (libraryRef UNISIMS)))")
       hPutStrLn file ("              (property INIT (string \"" ++
                       edifLUTInit prog ++ "\"))")
       when (position inst == Placed) $
         hPutStrLn file ("              (property RLOC (string \"" ++
                         showRLOC (xilinxArchitecture netlist)
                             (x!i,  y!i) ++ "\"))")
       hPutStrLn file "            )"
   where
   (x, y) = computedShifts netlist
   cellName = componentName inst
   i = instanceNumber inst
   instName = cellName ++ "_" ++ show i

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

putPrimitiveInstance :: Handle -> Netlist -> Instance -> IO ()
putPrimitiveInstance file netlist inst
  = do hPutStrLn file ("            (instance " ++ instName)
       hPutStrLn file ("             (viewRef view_1 (cellRef " ++ cellName
                       ++ " (libraryRef UNISIMS)))")
       when (position inst == Placed) $
         hPutStrLn file ("              (property RLOC (string \"" ++
                        showRLOC (xilinxArchitecture netlist)
                             (x!i,  y!i) ++ "\"))")
       hPutStrLn file "            )"
   where
   (x, y) = computedShifts netlist
   cellName = componentName inst
   i = instanceNumber inst
   instName = cellName ++ "_" ++ show i

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

edifLUTInit:: [Int] -> String
edifLUTInit xs = show (binaryListToInt xs)

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

binaryListToInt :: [Int] -> Int
binaryListToInt xs = sum [x*p | (x, p) <- zip (reverse xs) powersOfTwo]

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

powersOfTwo :: [Int]
powersOfTwo = [2^n | n <- [0..]]

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

declareBUF :: Handle -> IO ()
declareBUF file
  = do hPutStrLn file "    (cell buf"
       hPutStrLn file "      (cellType GENERIC)"
       hPutStrLn file "        (view view_1"
       hPutStrLn file "          (viewType NETLIST)"
       hPutStrLn file "          (interface"
       hPutStrLn file "            (port i (direction INPUT))"
       hPutStrLn file "            (port o (direction OUTPUT))"
       hPutStrLn file "          )"
       hPutStrLn file "        )"
       hPutStrLn file "    )"

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

declareBUFInstances :: Handle -> [PortDeclaration] -> IO ()
declareBUFInstances file ports
  = mapM_ (declareBUFInstance file) ports

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

declareBUFInstance :: Handle -> PortDeclaration -> IO ()
declareBUFInstance file (Port name _ _ _)
  = do hPutStrLn file ("            (instance buf_" ++ name)
       hPutStrLn file  "             (viewRef view_1 (cellRef buf (libraryRef UNISIMS))))"

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

putPortWires :: Handle -> Int -> [PortDeclaration] -> IO ()
putPortWires file i ports = mapM_ (putPortWire file i) ports

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

putPortWire :: Handle -> Int -> PortDeclaration -> IO ()
putPortWire file i (Port name _ BitType connections)
  = when (i `elem` connections) $
      hPutStrLn file ("                (portRef " ++ name ++ ")")
putPortWire file i (Port name _ (BitVec a dir b) connections)
  = when (maybeConnection /= Nothing) $
      hPutStrLn file ("                (portRef (member " ++ name ++
                      " " ++ show idx ++ "))")
    where
    maybeConnection = findConnection i connections (portRange a dir b)
    Just idx = maybeConnection

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

findConnection :: Int -> [Int] -> [Int] -> Maybe Int
findConnection i connections prange
  = if match == [] then
      Nothing
    else
      Just (head match)
  where
  match = [idx | (idx, c) <- zip prange connections, c == i]

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