{-|
Module      : VeriFuzz.Verilog.CodeGen
Description : Code generation for Verilog AST.
Copyright   : (c) 2018-2019, Yann Herklotz
License     : BSD-3
Maintainer  : ymherklotz [at] gmail [dot] com
Stability   : experimental
Portability : POSIX

This module generates the code from the Verilog AST defined in
"VeriFuzz.Verilog.AST".
-}

{-# LANGUAGE FlexibleInstances #-}

module VeriFuzz.Verilog.CodeGen
    ( -- * Code Generation
      GenVerilog(..)
    , genSource
    , render
    )
where

import           Data.Foldable           (fold)
import           Data.List.NonEmpty      (NonEmpty (..), toList)
import           Data.Text               (Text)
import qualified Data.Text               as T
import qualified Data.Text.IO            as T
import           Numeric                 (showHex)
import           VeriFuzz.Internal
import           VeriFuzz.Verilog.AST
import           VeriFuzz.Verilog.BitVec

-- | 'Source' class which determines that source code is able to be generated
-- from the data structure using 'genSource'. This will be stored in 'Text' and
-- can then be processed further.
class Source a where
  genSource :: a -> Text

-- | Map a 'Maybe Statement' to 'Text'. If it is 'Just statement', the generated
-- statements are returned. If it is 'Nothing', then @;\n@ is returned.
defMap :: Maybe Statement -> Text
defMap = maybe ";\n" statement

-- | Convert the 'Verilog' type to 'Text' so that it can be rendered.
verilogSrc :: Verilog -> Text
verilogSrc (Verilog modules) = fold $ moduleDecl <$> modules

-- | Generate the 'ModDecl' for a module and convert it to 'Text'.
moduleDecl :: ModDecl -> Text
moduleDecl (ModDecl i outP inP items ps) =
    "module "
        <> identifier i
        <> params ps
        <> ports
        <> ";\n"
        <> modI
        <> "endmodule\n\n"
  where
    ports | null outP && null inP = ""
          | otherwise             = "(" <> comma (modPort <$> outIn) <> ")"
    modI  = fold $ moduleItem <$> items
    outIn = outP ++ inP
    params []        = ""
    params (p : pps) = "\n#(\n" <> paramList (p :| pps) <> "\n)\n"

-- | Generates a parameter list. Can only be called with a 'NonEmpty' list.
paramList :: NonEmpty Parameter -> Text
paramList ps = "parameter " <> (commaNL . toList $ parameter <$> ps)

-- | Generates a localparam list. Can only be called with a 'NonEmpty' list.
localParamList :: NonEmpty LocalParam -> Text
localParamList ps = "localparam " <> (commaNL . toList $ localParam <$> ps)

-- | Generates the assignment for a 'Parameter'.
parameter :: Parameter -> Text
parameter (Parameter name val) = identifier name <> " = " <> constExpr val

-- | Generates the assignment for a 'LocalParam'.
localParam :: LocalParam -> Text
localParam (LocalParam name val) = identifier name <> " = " <> constExpr val

identifier :: Identifier -> Text
identifier (Identifier i) = i

-- | Conversts 'Port' to 'Text' for the module list, which means it only
-- generates a list of identifiers.
modPort :: Port -> Text
modPort (Port _ _ _ (Identifier i)) = i

-- | Generate the 'Port' description.
port :: Port -> Text
port (Port tp sgn r (Identifier name)) = t <> sign <> range r <> name
  where
    t    = flip mappend " " $ pType tp
    sign = signed sgn

range :: Range -> Text
range (Range msb lsb) = "[" <> constExpr msb <> ":" <> constExpr lsb <> "] "

signed :: Bool -> Text
signed True = "signed "
signed _    = ""

-- | Convert the 'PortDir' type to 'Text'.
portDir :: PortDir -> Text
portDir PortIn    = "input"
portDir PortOut   = "output"
portDir PortInOut = "inout"

-- | Generate a 'ModItem'.
moduleItem :: ModItem -> Text
moduleItem (ModCA ca) = contAssign ca
moduleItem (ModInst (Identifier i) (Identifier name) conn) =
    i <> " " <> name <> "(" <> comma (mConn <$> conn) <> ")" <> ";\n"
moduleItem (Initial stat) = "initial " <> statement stat
moduleItem (Always  stat) = "always " <> statement stat
moduleItem (Decl dir p ini) =
    maybe "" makePort dir <> port p <> maybe "" makeIni ini <> ";\n"
  where
    makePort = (<> " ") . portDir
    makeIni  = (" = " <>) . constExpr
moduleItem (ParamDecl      p) = paramList p <> ";\n"
moduleItem (LocalParamDecl p) = localParamList p <> ";\n"

mConn :: ModConn -> Text
mConn (ModConn c       ) = expr c
mConn (ModConnNamed n c) = "." <> getIdentifier n <> "(" <> expr c <> ")"

-- | Generate continuous assignment
contAssign :: ContAssign -> Text
contAssign (ContAssign val e) =
    "assign " <> getIdentifier val <> " = " <> expr e <> ";\n"

-- | Generate 'Expr' to 'Text'.
expr :: Expr -> Text
expr (BinOp eRhs bin eLhs) =
    "(" <> expr eRhs <> binaryOp bin <> expr eLhs <> ")"
expr (Number b             ) = showNum b
expr (Id     i             ) = getIdentifier i
expr (VecSelect   i e      ) = getIdentifier i <> "[" <> expr e <> "]"
expr (RangeSelect i r      ) = getIdentifier i <> range r
expr (Concat c             ) = "{" <> comma (expr <$> c) <> "}"
expr (UnOp u e             ) = "(" <> unaryOp u <> expr e <> ")"
expr (Cond l t f) = "(" <> expr l <> " ? " <> expr t <> " : " <> expr f <> ")"
expr (Appl (Identifier f) e) = f <> "(" <> expr e <> ")"
expr (Str t                ) = "\"" <> t <> "\""

showNum :: BitVec -> Text
showNum (BitVec s n) =
    "(" <> minus <> showT s <> "'h" <> T.pack (showHex (abs n) "") <> ")"
  where
    minus | signum n >= 0 = ""
          | otherwise     = "-"

constExpr :: ConstExpr -> Text
constExpr (ConstNum    b) = showNum b
constExpr (ParamId     i) = identifier i
constExpr (ConstConcat c) = "{" <> comma (constExpr <$> c) <> "}"
constExpr (ConstUnOp u e) = "(" <> unaryOp u <> constExpr e <> ")"
constExpr (ConstBinOp eRhs bin eLhs) =
    "(" <> constExpr eRhs <> binaryOp bin <> constExpr eLhs <> ")"
constExpr (ConstCond l t f) =
    "(" <> constExpr l <> " ? " <> constExpr t <> " : " <> constExpr f <> ")"
constExpr (ConstStr t) = "\"" <> t <> "\""

-- | Convert 'BinaryOperator' to 'Text'.
binaryOp :: BinaryOperator -> Text
binaryOp BinPlus    = " + "
binaryOp BinMinus   = " - "
binaryOp BinTimes   = " * "
binaryOp BinDiv     = " / "
binaryOp BinMod     = " % "
binaryOp BinEq      = " == "
binaryOp BinNEq     = " != "
binaryOp BinCEq     = " === "
binaryOp BinCNEq    = " !== "
binaryOp BinLAnd    = " && "
binaryOp BinLOr     = " || "
binaryOp BinLT      = " < "
binaryOp BinLEq     = " <= "
binaryOp BinGT      = " > "
binaryOp BinGEq     = " >= "
binaryOp BinAnd     = " & "
binaryOp BinOr      = " | "
binaryOp BinXor     = " ^ "
binaryOp BinXNor    = " ^~ "
binaryOp BinXNorInv = " ~^ "
binaryOp BinPower   = " ** "
binaryOp BinLSL     = " << "
binaryOp BinLSR     = " >> "
binaryOp BinASL     = " <<< "
binaryOp BinASR     = " >>> "

-- | Convert 'UnaryOperator' to 'Text'.
unaryOp :: UnaryOperator -> Text
unaryOp UnPlus    = "+"
unaryOp UnMinus   = "-"
unaryOp UnLNot    = "!"
unaryOp UnNot     = "~"
unaryOp UnAnd     = "&"
unaryOp UnNand    = "~&"
unaryOp UnOr      = "|"
unaryOp UnNor     = "~|"
unaryOp UnXor     = "^"
unaryOp UnNxor    = "~^"
unaryOp UnNxorInv = "^~"

event :: Event -> Text
event a = "@(" <> eventRec a <> ")"

-- | Generate verilog code for an 'Event'.
eventRec :: Event -> Text
eventRec (EId   i)    = getIdentifier i
eventRec (EExpr e)    = expr e
eventRec EAll         = "*"
eventRec (EPosEdge i) = "posedge " <> getIdentifier i
eventRec (ENegEdge i) = "negedge " <> getIdentifier i
eventRec (EOr   a b ) = eventRec a <> " or " <> eventRec b
eventRec (EComb a b ) = eventRec a <> ", " <> eventRec b

-- | Generates verilog code for a 'Delay'.
delay :: Delay -> Text
delay (Delay i) = "#" <> showT i

-- | Generate the verilog code for an 'LVal'.
lVal :: LVal -> Text
lVal (RegId i    ) = getIdentifier i
lVal (RegExpr i e) = getIdentifier i <> " [" <> expr e <> "]"
lVal (RegSize i r) = getIdentifier i <> " " <> range r
lVal (RegConcat e) = "{" <> comma (expr <$> e) <> "}"

pType :: PortType -> Text
pType Wire = "wire"
pType Reg  = "reg"

genAssign :: Text -> Assign -> Text
genAssign op (Assign r d e) = lVal r <> op <> maybe "" delay d <> expr e

statement :: Statement -> Text
statement (TimeCtrl  d stat     ) = delay d <> " " <> defMap stat
statement (EventCtrl e stat     ) = event e <> " " <> defMap stat
statement (SeqBlock s) = "begin\n" <> fold (statement <$> s) <> "end\n"
statement (BlockAssign    a     ) = genAssign " = " a <> ";\n"
statement (NonBlockAssign a     ) = genAssign " <= " a <> ";\n"
statement (TaskEnable     t     ) = task t <> ";\n"
statement (SysTaskEnable  t     ) = "$" <> task t <> ";\n"
statement (CondStmnt e t Nothing) = "if(" <> expr e <> ")\n" <> defMap t
statement (CondStmnt e t f) =
    "if(" <> expr e <> ")\n" <> defMap t <> "else\n" <> defMap f
statement (ForLoop a e incr stmnt) =
    "for("
        <> genAssign " = " a
        <> "; "
        <> expr e
        <> "; "
        <> genAssign " = " incr
        <> ")\n"
        <> statement stmnt

task :: Task -> Text
task (Task (Identifier i) e) | null e    = i
                             | otherwise = i <> "(" <> comma (expr <$> e) <> ")"

-- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'.
render :: (Source a) => a -> IO ()
render = T.putStrLn . genSource

-- Instances

instance Source Identifier where
    genSource = getIdentifier

instance Source Task where
    genSource = task

instance Source Statement where
    genSource = statement

instance Source PortType where
    genSource = pType

instance Source ConstExpr where
    genSource = constExpr

instance Source LVal where
    genSource = lVal

instance Source Delay where
    genSource = delay

instance Source Event where
    genSource = event

instance Source UnaryOperator where
    genSource = unaryOp

instance Source Expr where
    genSource = expr

instance Source ContAssign where
    genSource = contAssign

instance Source ModItem where
    genSource = moduleItem

instance Source PortDir where
    genSource = portDir

instance Source Port where
    genSource = port

instance Source ModDecl where
    genSource = moduleDecl

instance Source Verilog where
    genSource = verilogSrc

instance Source SourceInfo where
    genSource (SourceInfo _ src) = genSource src

newtype GenVerilog a = GenVerilog { unGenVerilog :: a }

instance (Source a) => Show (GenVerilog a) where
    show = T.unpack . genSource . unGenVerilog