aboutsummaryrefslogtreecommitdiffstats
path: root/src/Verismith/Verilog/CodeGen.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Verismith/Verilog/CodeGen.hs')
-rw-r--r--src/Verismith/Verilog/CodeGen.hs328
1 files changed, 170 insertions, 158 deletions
diff --git a/src/Verismith/Verilog/CodeGen.hs b/src/Verismith/Verilog/CodeGen.hs
index 39301e4..3c5d4c5 100644
--- a/src/Verismith/Verilog/CodeGen.hs
+++ b/src/Verismith/Verilog/CodeGen.hs
@@ -1,36 +1,34 @@
-{-|
-Module : Verismith.Verilog.CodeGen
-Description : Code generation for Verilog AST.
-Copyright : (c) 2018-2019, Yann Herklotz
-License : GPL-3
-Maintainer : yann [at] yannherklotz [dot] com
-Stability : experimental
-Portability : POSIX
-
-This module generates the code from the Verilog AST defined in
-"Verismith.Verilog.AST".
--}
-
{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleInstances #-}
-
+{-# LANGUAGE FlexibleInstances #-}
+
+-- |
+-- Module : Verismith.Verilog.CodeGen
+-- Description : Code generation for Verilog AST.
+-- Copyright : (c) 2018-2019, Yann Herklotz
+-- License : GPL-3
+-- Maintainer : yann [at] yannherklotz [dot] com
+-- Stability : experimental
+-- Portability : POSIX
+--
+-- This module generates the code from the Verilog AST defined in
+-- "Verismith.Verilog.AST".
module Verismith.Verilog.CodeGen
- ( -- * Code Generation
- GenVerilog(..)
- , Source(..)
- , render
- )
+ ( -- * Code Generation
+ GenVerilog (..),
+ Source (..),
+ render,
+ )
where
-import Data.Data (Data)
-import Data.List.NonEmpty (NonEmpty (..), toList)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Prettyprint.Doc
-import Numeric (showHex)
-import Verismith.Internal hiding (comma)
-import Verismith.Verilog.AST
-import Verismith.Verilog.BitVec
+import Data.Data (Data)
+import Data.List.NonEmpty (NonEmpty (..), toList)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Prettyprint.Doc
+import Numeric (showHex)
+import Verismith.Internal hiding (comma)
+import Verismith.Verilog.AST
+import Verismith.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
@@ -49,18 +47,19 @@ verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules
-- | Generate the 'ModDecl ann' for a module and convert it to 'Text'.
moduleDecl :: Show ann => ModDecl ann -> Doc a
-moduleDecl (ModDecl i outP inP items ps) = vsep
- [ sep ["module" <+> identifier i, params ps, ports <> semi]
- , indent 2 modI
- , "endmodule"
+moduleDecl (ModDecl i outP inP items ps) =
+ vsep
+ [ sep ["module" <+> identifier i, params ps, ports <> semi],
+ indent 2 modI,
+ "endmodule"
]
where
ports
- | null outP && null inP = ""
- | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn
- modI = vsep $ moduleItem <$> items
+ | null outP && null inP = ""
+ | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn
+ modI = vsep $ moduleItem <$> items
outIn = outP ++ inP
- params [] = ""
+ params [] = ""
params (p : pps) = hcat ["#", paramList (p :| pps)]
moduleDecl (ModDeclAnn a m) = sep [hsep ["/*", pretty $ show a, "*/"], moduleDecl m]
@@ -75,12 +74,12 @@ localParamList ps = tupled . toList $ localParam <$> ps
-- | Generates the assignment for a 'Parameter'.
parameter :: Parameter -> Doc a
parameter (Parameter name val) =
- hsep ["parameter", identifier name, "=", constExpr val]
+ hsep ["parameter", identifier name, "=", constExpr val]
-- | Generates the assignment for a 'LocalParam'.
localParam :: LocalParam -> Doc a
localParam (LocalParam name val) =
- hsep ["localparameter", identifier name, "=", constExpr val]
+ hsep ["localparameter", identifier name, "=", constExpr val]
identifier :: Identifier -> Doc a
identifier (Identifier i) = pretty i
@@ -100,117 +99,124 @@ addMay (Just a) = (a :)
-- | Generate the 'Port' description.
port :: Port -> Doc a
port (Port tp sgn r name) =
- hsep $ pType tp : addOpt sgn "signed" [range r, identifier name]
+ hsep $ pType tp : addOpt sgn "signed" [range r, identifier name]
range :: Range -> Doc a
range (Range msb lsb) = brackets $ hcat [constExpr msb, colon, constExpr lsb]
-- | Convert the 'PortDir' type to 'Text'.
portDir :: PortDir -> Doc a
-portDir PortIn = "input"
-portDir PortOut = "output"
+portDir PortIn = "input"
+portDir PortOut = "output"
portDir PortInOut = "inout"
-- | Generate a '(ModItem ann)'.
moduleItem :: Show ann => ModItem ann -> Doc a
moduleItem (ModCA ca) = contAssign ca
-moduleItem (ModInst i name conn) = (<> semi) $ hsep
- [ identifier i
- , identifier name
- , parens . hsep $ punctuate comma (mConn <$> conn)
- ]
-moduleItem (Initial stat ) = nest 2 $ vsep ["initial", statement stat]
-moduleItem (Always stat ) = nest 2 $ vsep ["always", statement stat]
-moduleItem (Decl dir p ini) = (<> semi) . hsep .
- addMay (portDir <$> dir) . (port p :) $ addMay (makeIni <$> ini) []
+moduleItem (ModInst i name conn) =
+ (<> semi) $
+ hsep
+ [ identifier i,
+ identifier name,
+ parens . hsep $ punctuate comma (mConn <$> conn)
+ ]
+moduleItem (Initial stat) = nest 2 $ vsep ["initial", statement stat]
+moduleItem (Always stat) = nest 2 $ vsep ["always", statement stat]
+moduleItem (Decl dir p ini) =
+ (<> semi) . hsep
+ . addMay (portDir <$> dir)
+ . (port p :)
+ $ addMay (makeIni <$> ini) []
where
- makeIni = ("=" <+>) . constExpr
-moduleItem (ParamDecl p) = hcat [paramList p, semi]
+ makeIni = ("=" <+>) . constExpr
+moduleItem (ParamDecl p) = hcat [paramList p, semi]
moduleItem (LocalParamDecl p) = hcat [localParamList p, semi]
moduleItem (ModItemAnn a mi) = sep [hsep ["/*", pretty $ show a, "*/"], moduleItem mi]
mConn :: ModConn -> Doc a
-mConn (ModConn c ) = expr c
+mConn (ModConn c) = expr c
mConn (ModConnNamed n c) = hcat [dot, identifier n, parens $ expr c]
-- | Generate continuous assignment
contAssign :: ContAssign -> Doc a
contAssign (ContAssign val e) =
- (<> semi) $ hsep ["assign", identifier val, "=", align $ expr e]
+ (<> semi) $ hsep ["assign", identifier val, "=", align $ expr e]
-- | Generate 'Expr' to 'Text'.
expr :: Expr -> Doc a
expr (BinOp eRhs bin eLhs) = parens $ hsep [expr eRhs, binaryOp bin, expr eLhs]
-expr (Number b ) = showNum b
-expr (Id i ) = identifier i
-expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e]
-expr (RangeSelect i r ) = hcat [identifier i, range r]
+expr (Number b) = showNum b
+expr (Id i) = identifier i
+expr (VecSelect i e) = hcat [identifier i, brackets $ expr e]
+expr (RangeSelect i r) = hcat [identifier i, range r]
expr (Concat c) = braces . nest 4 . sep . punctuate comma $ toList (expr <$> c)
-expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e]
+expr (UnOp u e) = parens $ hcat [unaryOp u, expr e]
expr (Cond l t f) =
- parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]]
+ parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]]
expr (Appl f e) = hcat [identifier f, parens $ expr e]
-expr (Str t ) = dquotes $ pretty t
+expr (Str t) = dquotes $ pretty t
showNum :: BitVec -> Doc a
-showNum (BitVec s n) = parens
- $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")]
+showNum (BitVec s n) =
+ parens $
+ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")]
where
- minus | signum n >= 0 = mempty
- | otherwise = "-"
+ minus
+ | signum n >= 0 = mempty
+ | otherwise = "-"
constExpr :: ConstExpr -> Doc a
constExpr (ConstNum b) = showNum b
-constExpr (ParamId i) = identifier i
+constExpr (ParamId i) = identifier i
constExpr (ConstConcat c) =
- braces . hsep . punctuate comma $ toList (constExpr <$> c)
+ braces . hsep . punctuate comma $ toList (constExpr <$> c)
constExpr (ConstUnOp u e) = parens $ hcat [unaryOp u, constExpr e]
constExpr (ConstBinOp eRhs bin eLhs) =
- parens $ hsep [constExpr eRhs, binaryOp bin, constExpr eLhs]
+ parens $ hsep [constExpr eRhs, binaryOp bin, constExpr eLhs]
constExpr (ConstCond l t f) =
- parens $ hsep [constExpr l, "?", constExpr t, colon, constExpr f]
+ parens $ hsep [constExpr l, "?", constExpr t, colon, constExpr f]
constExpr (ConstStr t) = dquotes $ pretty t
-- | Convert 'BinaryOperator' to 'Text'.
binaryOp :: BinaryOperator -> Doc a
-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 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 = ">>>"
+binaryOp BinPower = "**"
+binaryOp BinLSL = "<<"
+binaryOp BinLSR = ">>"
+binaryOp BinASL = "<<<"
+binaryOp BinASR = ">>>"
-- | Convert 'UnaryOperator' to 'Text'.
unaryOp :: UnaryOperator -> Doc a
-unaryOp UnPlus = "+"
-unaryOp UnMinus = "-"
-unaryOp UnLNot = "!"
-unaryOp UnNot = "~"
-unaryOp UnAnd = "&"
-unaryOp UnNand = "~&"
-unaryOp UnOr = "|"
-unaryOp UnNor = "~|"
-unaryOp UnXor = "^"
-unaryOp UnNxor = "~^"
+unaryOp UnPlus = "+"
+unaryOp UnMinus = "-"
+unaryOp UnLNot = "!"
+unaryOp UnNot = "~"
+unaryOp UnAnd = "&"
+unaryOp UnNand = "~&"
+unaryOp UnOr = "|"
+unaryOp UnNor = "~|"
+unaryOp UnXor = "^"
+unaryOp UnNxor = "~^"
unaryOp UnNxorInv = "^~"
event :: Event -> Doc a
@@ -218,13 +224,13 @@ event a = hcat ["@", parens $ eventRec a]
-- | Generate verilog code for an 'Event'.
eventRec :: Event -> Doc a
-eventRec (EId i) = identifier i
-eventRec (EExpr e) = expr e
-eventRec EAll = "*"
+eventRec (EId i) = identifier i
+eventRec (EExpr e) = expr e
+eventRec EAll = "*"
eventRec (EPosEdge i) = hsep ["posedge", identifier i]
eventRec (ENegEdge i) = hsep ["negedge", identifier i]
-eventRec (EOr a b ) = hsep [eventRec a, "or", eventRec b]
-eventRec (EComb a b ) = hsep $ punctuate comma [eventRec a, eventRec b]
+eventRec (EOr a b) = hsep [eventRec a, "or", eventRec b]
+eventRec (EComb a b) = hsep $ punctuate comma [eventRec a, eventRec b]
-- | Generates verilog code for a 'Delay'.
delay :: Delay -> Doc a
@@ -232,18 +238,18 @@ delay (Delay i) = "#" <> pretty i
-- | Generate the verilog code for an 'LVal'.
lVal :: LVal -> Doc a
-lVal (RegId i ) = identifier i
+lVal (RegId i) = identifier i
lVal (RegExpr i e) = hsep [identifier i, expr e]
lVal (RegSize i r) = hsep [identifier i, range r]
lVal (RegConcat e) = braces . hsep $ punctuate comma (expr <$> e)
pType :: PortType -> Doc a
pType Wire = "wire"
-pType Reg = "reg"
+pType Reg = "reg"
genAssign :: Text -> Assign -> Doc a
genAssign op (Assign r d e) =
- hsep . (lVal r : ) . (pretty op :) $ addMay (delay <$> d) [expr e]
+ hsep . (lVal r :) . (pretty op :) $ addMay (delay <$> d) [expr e]
caseType :: CaseType -> Doc a
caseType CaseStandard = "case"
@@ -252,46 +258,52 @@ caseType CaseZ = "casez"
casePair :: Show ann => (CasePair ann) -> Doc a
casePair (CasePair e s) =
- vsep [hsep [expr e, colon], indent 2 $ statement s]
+ vsep [hsep [expr e, colon], indent 2 $ statement s]
statement :: Show ann => Statement ann -> Doc a
-statement (TimeCtrl d stat) = hsep [delay d, defMap stat]
+statement (TimeCtrl d stat) = hsep [delay d, defMap stat]
statement (EventCtrl e stat) = hsep [event e, defMap stat]
statement (SeqBlock s) =
- vsep ["begin", indent 2 . vsep $ statement <$> s, "end"]
-statement (BlockAssign a) = hcat [genAssign "=" a, semi]
+ vsep ["begin", indent 2 . vsep $ statement <$> s, "end"]
+statement (BlockAssign a) = hcat [genAssign "=" a, semi]
statement (NonBlockAssign a) = hcat [genAssign "<=" a, semi]
-statement (TaskEnable t) = hcat [task t, semi]
-statement (SysTaskEnable t) = hcat ["$", task t, semi]
+statement (TaskEnable t) = hcat [task t, semi]
+statement (SysTaskEnable t) = hcat ["$", task t, semi]
statement (CondStmnt e t Nothing) =
- vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t]
+ vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t]
statement (StmntCase t e ls d) =
- vcat [hcat [caseType t, parens $ expr e],
- vcat $ casePair <$> ls,
- indent 2 $ vsep ["default:", indent 2 $ defMap d],
- "endcase"]
-statement (CondStmnt e t f) = vsep
- [ hsep ["if", parens $ expr e]
- , indent 2 $ defMap t
- , "else"
- , indent 2 $ defMap f
+ vcat
+ [ hcat [caseType t, parens $ expr e],
+ vcat $ casePair <$> ls,
+ indent 2 $ vsep ["default:", indent 2 $ defMap d],
+ "endcase"
+ ]
+statement (CondStmnt e t f) =
+ vsep
+ [ hsep ["if", parens $ expr e],
+ indent 2 $ defMap t,
+ "else",
+ indent 2 $ defMap f
]
-statement (ForLoop a e incr stmnt) = vsep
+statement (ForLoop a e incr stmnt) =
+ vsep
[ hsep
- [ "for"
- , parens . hsep $ punctuate
- semi
- [genAssign "=" a, expr e, genAssign "=" incr]
- ]
- , indent 2 $ statement stmnt
+ [ "for",
+ parens . hsep $
+ punctuate
+ semi
+ [genAssign "=" a, expr e, genAssign "=" incr]
+ ],
+ indent 2 $ statement stmnt
]
statement (StmntAnn a s) = sep [hsep ["/*", pretty $ show a, "*/"], statement s]
task :: Task -> Doc a
task (Task i e)
- | null e = identifier i
- | otherwise = hsep
- [identifier i, parens . hsep $ punctuate comma (expr <$> e)]
+ | null e = identifier i
+ | otherwise =
+ hsep
+ [identifier i, parens . hsep $ punctuate comma (expr <$> e)]
-- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'.
render :: (Source a) => a -> IO ()
@@ -300,58 +312,58 @@ render = print . genSource
-- Instances
instance Source Identifier where
- genSource = showT . identifier
+ genSource = showT . identifier
instance Source Task where
- genSource = showT . task
+ genSource = showT . task
instance Show ann => Source (Statement ann) where
- genSource = showT . statement
+ genSource = showT . statement
instance Source PortType where
- genSource = showT . pType
+ genSource = showT . pType
instance Source ConstExpr where
- genSource = showT . constExpr
+ genSource = showT . constExpr
instance Source LVal where
- genSource = showT . lVal
+ genSource = showT . lVal
instance Source Delay where
- genSource = showT . delay
+ genSource = showT . delay
instance Source Event where
- genSource = showT . event
+ genSource = showT . event
instance Source UnaryOperator where
- genSource = showT . unaryOp
+ genSource = showT . unaryOp
instance Source Expr where
- genSource = showT . expr
+ genSource = showT . expr
instance Source ContAssign where
- genSource = showT . contAssign
+ genSource = showT . contAssign
instance Show ann => Source (ModItem ann) where
- genSource = showT . moduleItem
+ genSource = showT . moduleItem
instance Source PortDir where
- genSource = showT . portDir
+ genSource = showT . portDir
instance Source Port where
- genSource = showT . port
+ genSource = showT . port
instance Show ann => Source (ModDecl ann) where
- genSource = showT . moduleDecl
+ genSource = showT . moduleDecl
instance Show ann => Source (Verilog ann) where
- genSource = showT . verilogSrc
+ genSource = showT . verilogSrc
instance Show ann => Source (SourceInfo ann) where
- genSource (SourceInfo _ src) = genSource src
+ genSource (SourceInfo _ src) = genSource src
-newtype GenVerilog a = GenVerilog { unGenVerilog :: a }
- deriving (Eq, Ord, Data)
+newtype GenVerilog a = GenVerilog {unGenVerilog :: a}
+ deriving (Eq, Ord, Data)
instance (Source a) => Show (GenVerilog a) where
- show = T.unpack . genSource . unGenVerilog
+ show = T.unpack . genSource . unGenVerilog
generated by cgit (git 2.34.1) at 2024-05-10 03:03:19 +0000