diff options
Diffstat (limited to 'src/Verismith/Verilog/CodeGen.hs')
-rw-r--r-- | src/Verismith/Verilog/CodeGen.hs | 328 |
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 |