From 31c0d84a385c311b52860b86664ba459ac93ad5f Mon Sep 17 00:00:00 2001
From: Yann Herklotz <ymherklotz@gmail.com>
Date: Tue, 25 Dec 2018 13:24:43 +0100
Subject: Add code generation for new types

---
 src/Test/VeriFuzz/CodeGen.hs | 150 +++++++++++++++++++++++++++++++++++++------
 1 file changed, 130 insertions(+), 20 deletions(-)

diff --git a/src/Test/VeriFuzz/CodeGen.hs b/src/Test/VeriFuzz/CodeGen.hs
index 755f52f..acfa020 100644
--- a/src/Test/VeriFuzz/CodeGen.hs
+++ b/src/Test/VeriFuzz/CodeGen.hs
@@ -16,12 +16,19 @@ This module generates the code from the Verilog AST defined in
 module Test.VeriFuzz.CodeGen where
 
 import           Control.Lens
+import           Data.Maybe                    (fromMaybe)
 import           Data.Text                     (Text)
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import           Test.VeriFuzz.Internal.Shared
 import           Test.VeriFuzz.VerilogAST
 
+showT :: (Show a) => a -> Text
+showT = T.pack . show
+
+defMap :: Maybe Statement -> Text
+defMap stat = fromMaybe ";" $ genStatement <$> stat
+
 -- | Convert the 'SourceText' type to 'Text' so that it can be rendered.
 genSourceText :: SourceText -> Text
 genSourceText source =
@@ -32,23 +39,26 @@ genDescription :: Description -> Text
 genDescription desc =
   genModuleDecl $ desc ^. getDescription
 
--- | Generate the 'ModuleDecl' for a module and convert it to 'Text'.
-genModuleDecl :: ModuleDecl -> Text
+-- | Generate the 'ModDecl' for a module and convert it to 'Text'.
+genModuleDecl :: ModDecl -> Text
 genModuleDecl mod =
   "module " <> mod ^. moduleId . getIdentifier
-  <> "(\n" <> ports <> "\n);\n"
+  <> ports <> ";\n"
   <> modItems
   <> "endmodule\n"
   where
-    ports = sep ",\n" $ genPort <$> mod ^. modPorts
+    ports
+      | null $ mod ^. modPorts = ""
+      | otherwise = "(\n" <> (sep ",\n" $ genPort <$> mod ^. modPorts) <> "\n)"
     modItems = fromList $ genModuleItem <$> mod ^. moduleItems
 
 -- | Generate the 'Port' description.
 genPort :: Port -> Text
 genPort port =
-  "  " <> dir <> " " <> name
+  "  " <> dir <> " " <> t <> " " <> name
   where
-    dir = genPortDir $ port ^. portDir
+    dir = fromMaybe "" $ genPortDir <$> port ^. portDir
+    t = fromMaybe "" $ genPortType <$> port ^. portType
     name = port ^. portName . getIdentifier
 
 -- | Convert the 'PortDir' type to 'Text'.
@@ -57,25 +67,33 @@ genPortDir Input  = "input"
 genPortDir Output = "output"
 genPortDir InOut  = "inout"
 
--- | Generate a 'ModuleItem'.
-genModuleItem :: ModuleItem -> Text
-genModuleItem (Assign assign) = genContAssign assign
+-- | Generate a 'ModItem'.
+genModuleItem :: ModItem -> Text
+genModuleItem (ModCA ca) = genContAssign ca
+genModuleItem (ModInst (Identifier id) (Identifier name) conn) =
+  id <> " " <> name <> "(" <> sep ", " (genExpr . _modConn <$> conn) <> ")" <> ";\n"
+genModuleItem (Initial stat) = "initial\n" <> genStatement stat
+genModuleItem (Always stat) = "always\n" <> genStatement stat
+genModuleItem (Decl port) = genPort port <> ";\n"
 
--- | Generate the 'ContinuousAssignment' to 'Text'.
+-- | Generate continuous assignment
 genContAssign :: ContAssign -> Text
-genContAssign assign =
+genContAssign (ContAssign val e) =
   "  assign " <> name <> " = " <> expr <> ";\n"
   where
-    name = assign ^. contAssignNetLVal . getIdentifier
-    expr = genExpr $ assign ^. contAssignExpr
+    name = val ^. getIdentifier
+    expr = genExpr $ e
 
 -- | Generate 'Expression' to 'Text'.
 genExpr :: Expression -> Text
 genExpr (OpExpr exprRhs bin exprLhs) =
-  genExpr exprRhs <> genBinaryOperator bin <> genExpr exprLhs
-genExpr (PrimExpr prim) =
-  genPrimary prim
-genExpr _ = "TODO"
+  "(" <> genExpr exprRhs <> genBinaryOperator bin <> genExpr exprLhs <> ")"
+genExpr (PrimExpr prim) = genPrimary prim
+genExpr (UnPrimExpr u e) =
+  "(" <> genUnaryOperator u <> genPrimary e <> ")"
+genExpr (CondExpr l t f) =
+  "(" <> genExpr l <> " ? " <> genExpr t <> " : " <> genExpr f
+genExpr (ExprStr t) = "\"" <> t <> "\""
 
 -- | Generate a 'PrimaryExpression' to 'Text'.
 genPrimary :: Primary -> Text
@@ -90,9 +108,101 @@ genPrimary (PrimId ident) = ident ^. getIdentifier
 
 -- | Convert 'BinaryOperator' to 'Text'.
 genBinaryOperator :: BinaryOperator -> Text
-genBinaryOperator BinAnd = " & "
-genBinaryOperator BinOr  = " | "
-genBinaryOperator BinXor = " ^ "
+genBinaryOperator BinPlus    = " + "
+genBinaryOperator BinMinus   = " - "
+genBinaryOperator BinTimes   = " * "
+genBinaryOperator BinDiv     = " / "
+genBinaryOperator BinMod     = " % "
+genBinaryOperator BinEq      = " == "
+genBinaryOperator BinNEq     = " != "
+genBinaryOperator BinCEq     = " === "
+genBinaryOperator BinCNEq    = " !== "
+genBinaryOperator BinLAnd    = " && "
+genBinaryOperator BinLOr     = " || "
+genBinaryOperator BinLT      = " < "
+genBinaryOperator BinLEq     = " <= "
+genBinaryOperator BinGT      = " > "
+genBinaryOperator BinGEq     = " >= "
+genBinaryOperator BinAnd     = " & "
+genBinaryOperator BinOr      = " | "
+genBinaryOperator BinXor     = " ^ "
+genBinaryOperator BinXNor    = " ^~ "
+genBinaryOperator BinXNorInv = " ~^ "
+genBinaryOperator BinPower   = " ** "
+genBinaryOperator BinLSL     = " << "
+genBinaryOperator BinLSR     = " >> "
+genBinaryOperator BinASL     = " <<< "
+genBinaryOperator BinASR     = " >>> "
+
+genUnaryOperator :: UnaryOperator -> Text
+genUnaryOperator UnPlus    = " + "
+genUnaryOperator UnMinus   = " - "
+genUnaryOperator UnNot     = " ! "
+genUnaryOperator UnAnd     = " & "
+genUnaryOperator UnNand    = " ~& "
+genUnaryOperator UnOr      = " | "
+genUnaryOperator UnNor     = " ~| "
+genUnaryOperator UnXor     = " ^ "
+genUnaryOperator UnNxor    = " ~^ "
+genUnaryOperator UnNxorInv = " ^~ "
+
+genNet :: Net -> Text
+genNet Wire    = "wire"
+genNet Tri     = "tri"
+genNet Tri1    = "tri1"
+genNet Supply0 = "supply0"
+genNet Wand    = "wand"
+genNet TriAnd  = "triand"
+genNet Tri0    = "tri0"
+genNet Supply1 = "supply1"
+genNet Wor     = "wor"
+genNet Trior   = "trior"
+
+genEvent :: Event -> Text
+genEvent (EId id)     = "@" <> id ^. getIdentifier
+genEvent (EExpr expr) = "@" <> genExpr expr
+genEvent EAll         = "@*"
+
+genDelay :: Delay -> Text
+genDelay (Delay i) = "#" <> showT i
+
+genRegLVal :: RegLVal -> Text
+genRegLVal (RegId id) = id ^. getIdentifier
+genRegLVal (RegExpr id expr) =
+  id ^. getIdentifier <> " [" <> genExpr expr <> "]"
+genRegLVal (RegSize id msb lsb) =
+  id ^. getIdentifier <> " [" <> genConstExpr msb <> ":" <> genConstExpr lsb <> "]"
+
+genConstExpr :: ConstExpr -> Text
+genConstExpr (ConstExpr num) = showT num
+
+genPortType :: PortType -> Text
+genPortType (PortNet net) = genNet net
+genPortType (Reg signed)
+  | signed = " reg signed "
+  | otherwise = " reg "
+
+genAssign :: Text -> Assign -> Text
+genAssign op (Assign r d e) =
+  genRegLVal r <> op <> fromMaybe "" (genDelay <$> d) <> genExpr e
+
+genStatement :: Statement -> Text
+genStatement (TimeCtrl d stat) = genDelay d <> " " <> defMap stat
+genStatement (EventCtrl e stat) = genEvent e <> " " <> defMap stat
+genStatement (SeqBlock s) =
+  "begin\n" <> fromList (genStatement <$> s) <> "end\n"
+genStatement (BlockAssign a) = genAssign " = " a <> ";\n"
+genStatement (NonBlockAssign a) = genAssign " <= " a <> ";\n"
+genStatement (StatCA a) = genContAssign a
+genStatement (TaskEnable task) = genTask task <> ";\n"
+genStatement (SysTaskEnable task) = "$" <> genTask task <> ";\n"
+
+genTask :: Task -> Text
+genTask (Task name expr)
+  | null expr = id
+  | otherwise = id <> "(" <> sep ", " (genExpr <$> expr) <> ")"
+  where
+    id = name ^. getIdentifier
 
 -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'.
 render :: Text -> IO ()
-- 
cgit