module Lava.SystemVerilog
where
import Lava.Graph
import Lava.RTL

writeSystemVerilog :: String -> RTL () -> IO( )
writeSystemVerilog fileName topModule
  = writeFile fileName (unlines (systemVerilogText fileName topModule))

systemVerilogText :: String -> RTL () -> [String]
systemVerilogText fileName topModule
  = ["module " ++ name ++ "("] ++
    declarePorts portList ++
    ["  );"] ++
    concatMap emitStatement components ++
    ["endmodule: " ++ name]
    where
    graph = computeGraph (Netlist name Nothing []) topModule
    gD = graphData graph
    components = nodes graph
    portList = ports gD
    name = if moduleName gD == "" then fileName
           else moduleName gD

declarePorts :: [PortSpec] -> [String]
declarePorts [] = []
declarePorts [p] = [declarePort "" p]
declarePorts (p:ps) = declarePort "," p : declarePorts ps

declarePort :: String -> PortSpec -> String
declarePort comma (PortSpec portDir name typ)
  = "  " ++ showPortDir portDir ++ " " ++ showType typ ++ " " ++ name ++ comma ++ lint_waiver
    where
    lint_waiver = if length name < 2 then
                    " // ri lint_check_waive MIN_NAME_LEN"
                  else
                    ""
    showPortDir InputPort = "input"
    showPortDir OutputPort = "output"

showType :: NetType a -> String
showType net
  = case net of
       BitType -> "logic"
       VecType {} -> "logic" ++  showVecType net

showVecType :: NetType a ->  String
showVecType BitType = ""
showVecType (VecType hi dir lo typ) = showVecIndexType hi dir lo ++ showVecType typ

showVecIndexType :: Int -> VecDir -> Int -> String
showVecIndexType hi DownTo lo = "[" ++ show hi ++ ":" ++ show lo ++ "]"
showVecIndexType lo UpTo hi = "[" ++ show lo ++ ":" ++ show hi ++ "]"

emitStatement :: (Int, Statement) -> [String]
emitStatement (n, PrimitiveInstanceStatement inst) = instantiateComponent n inst
emitStatement (_, LocalNetDeclaration n typ) = ["  " ++ showType typ ++ " net" ++ show n ++ ";"]
emitStatement (_, Delay clk lhs rhs) = ["  always_ff @(posedge " ++ showNet clk ++ ") " ++ showNet lhs ++ " <= " ++ showNet rhs ++ ";"]
emitStatement (_, Assignment lhs rhs) = ["  assign " ++ showNet lhs ++ " = " ++ showNet rhs ++ ";"]

instantiateComponent :: Int -> PrimitiveInstance -> [String]
instantiateComponent ic component
  = case component of
      BufPrim i o      ->  ["  buf buf_" ++ show ic ++ " " ++ showArgs [o, i] ++ ";"]
      NotPrim i o      ->  ["  not not_" ++ show ic ++ " " ++ showArgs [o, i] ++ ";"]
      AndPrim inputs o ->  ["  and and_" ++ show ic ++ " " ++ showArgs (o:inputs) ++ ";"]
      OrPrim inputs o  ->  ["  or or_" ++ show ic ++ " " ++ showArgs (o:inputs) ++ ";"]
      NorPrim inputs o  -> ["  nor nor_" ++ show ic ++ " " ++ showArgs (o:inputs) ++ ";"]
      XorPrim inputs o  -> ["  xor xor_" ++ show ic ++ " " ++ showArgs (o:inputs) ++ ";"]
      XnorPrim inputs o  -> [" xnor xnor_" ++ show ic ++ " " ++ showArgs (o:inputs) ++ ";"]

showNet :: Net a -> String
showNet signal
  = case signal of
      NamedNet name _ -> name
      LocalNet n _ -> "net" ++ show n

showArgs :: [Net a] -> String
showArgs args = "(" ++ (insertCommas (map showNet args)) ++ ")"

insertString :: String -> [String] -> String
insertString _ [] = []
insertString _ [x] = x
insertString s (x:xs) = (x ++ s) ++ insertString s xs

insertCommas :: [String] -> String
insertCommas = insertString ", "