diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,48 @@ +## v0.0.11 + +### New Features + +* Added `-y`/`--libdir` for specifying library directories from which to + automatically load modules and interfaces used in the design that are not + found in the provided input files +* Added `--top` for pruning unneeded modules during conversion +* Added `--write path/to/dir/` for creating an output `.v` in the specified + preexisting directory for each module in the converted result +* The `string` data type is now dropped from parameters and localparams +* Added support for passing through `sequence` and `property` declarations + +### Bug Fixes + +* Fixed crash when converting multi-dimensional arrays or arrays of structs or + unions used in certain expressions involving unbased unsized literals +* Fixed module-level localparams being needlessly inlined when forming longest + static prefixes, which could cause deep recursion and run out of memory on + some designs +* Fixed overzealous removal of explicitly unconnected ports (e.g., `.a()`) +* Fixed an issue that left `always_comb`, `always_latch`, and `always_ff` + unconverted when tagged with an attribute +* Fixed unneeded scoping of constant function calls used in type lookups +* `/*/` is no longer interpreted as a self-closing block comment, e.g., + `$display("a"/*/,"b"/* */);` previously printed "ab", but now prints "a" +* Fixed missing `begin`/`end` when disambiguating procedural branches tagged + with an attribute +* Fixed keywords included in the "1364-2001" and "1364-2001-noconfig" + `begin_keywords` version specifiers + +### Other Enhancements + +* Added elaboration for accesses to fields of struct constants, which can + substantially improve conversion speed on some designs +* Added constant folding for comparisons involving string literals +* Port connection attributes (e.g., [pulp_soc.sv]) are now ignored with a + warning rather than failing to parse +* Improved error message when specifying an extraneous named port connection +* Improved error message for an unfinished conditional directive, e.g., an + `ifdef` with no `endif` +* Added checks for accidental usage of interface or module names as type names + +[pulp_soc.sv]: https://github.com/pulp-platform/pulp_soc/blob/0573a85c/rtl/pulp_soc/pulp_soc.sv#L733 + ## v0.0.10 ### Breaking Changes diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright 2019-2022 Zachary Snow +Copyright 2019-2023 Zachary Snow Copyright 2011-2015 Tom Hawkins All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -12,11 +12,11 @@ limited in scope. This project was originally developed to target [Yosys], and so allows for -disabling the conversion of (passing through) those [SystemVerilog features -which Yosys supports]. +disabling the conversion of (passing through) those [SystemVerilog features that +Yosys supports]. -[Yosys]: http://www.clifford.at/yosys/ -[SystemVerilog features which Yosys supports]: https://github.com/YosysHQ/yosys#supported-features-from-systemverilog +[Yosys]: https://yosyshq.net/yosys/ +[SystemVerilog features that Yosys supports]: https://github.com/YosysHQ/yosys#supported-features-from-systemverilog The idea for this project was shared with me while I was an undergraduate at Carnegie Mellon University as part of a joint Computer Science and Electrical @@ -36,9 +36,10 @@ * [Haskell Stack](https://www.haskellstack.org/) - Haskell build system * Haskell dependencies are managed in `sv2v.cabal` * Test Dependencies - * [Icarus Verilog](http://iverilog.icarus.com) - for Verilog simulation + * [Icarus Verilog](https://steveicarus.github.io/iverilog/) - for Verilog + simulation * [shUnit2](https://github.com/kward/shunit2) - test framework - * Python (any version) - for generating certain test cases + * Python 3.x - for evaluating certain test cases ## Installation @@ -72,40 +73,50 @@ ## Usage -sv2v takes in a list of files and prints the converted Verilog to `stdout`. -Using `--write=adjacent` will create a converted `.v` for every `.sv` input file -rather than printing to `stdout`. `--write`/`-w` can also be used to specify a -path to a `.v` output file. +sv2v takes in a list of files and prints the converted Verilog to `stdout` by +default. Users should typically pass all of their SystemVerilog source files to +sv2v at once so it can properly resolve packages, interfaces, type parameters, +etc., across files. Using `--write=adjacent` will create a converted `.v` for +every `.sv` input file rather than printing to `stdout`. `--write`/`-w` can also +be used to specify a path to a `.v` output file. Undefined modules and +interfaces can be automatically loaded from library directories using +`--libdir`/`-y`. Users may specify `include` search paths, define macros during preprocessing, and exclude some of the conversions. Specifying `-` as an input file will read from `stdin`. -Below is the current usage printout. This interface is subject to change. +Below is the current usage printout. ``` sv2v [OPTIONS] [FILES] Preprocessing: - -I --incdir=DIR Add directory to include search path + -I --incdir=DIR Add a directory to the include search path + -y --libdir=DIR Add a directory to the library search path used + when looking for undefined modules and interfaces -D --define=NAME[=VALUE] Define a macro for preprocessing --siloed Lex input files separately, so macros from earlier files are not defined in later files - --skip-preprocessor Disable preprocessor + --skip-preprocessor Disable preprocessing of macros, comments, etc. Conversion: --pass-through Dump input without converting -E --exclude=CONV Exclude a particular conversion (Always, Assert, Interface, Logic, or UnbasedUnsized) -v --verbose Retain certain conversion artifacts - -w --write=MODE/FILE How to write output; default is 'stdout'; use + -w --write=MODE/FILE/DIR How to write output; default is 'stdout'; use 'adjacent' to create a .v file next to each input; - use a path ending in .v to write to a file + use a path ending in .v to write to a file; use a + path to an existing directory to create a .v within + for each converted module + --top=NAME Remove uninstantiated modules except the given + top module; can be used multiple times Other: --oversized-numbers Disable standard-imposed 32-bit limit on unsized number literals (e.g., 'h1_ffff_ffff, 4294967296) --dump-prefix=PATH Create intermediate output files with the given path prefix; used for internal debugging - --help Display help message + --help Display this help message --version Print version information --numeric-version Print just the version number ``` @@ -119,7 +130,7 @@ supported, but are simply dropped during conversion. If you find a bug or have a feature request, please [create an issue]. -Preference will be given to issues which include examples or test cases. +Preference will be given to issues that include examples or test cases. [create an issue]: https://github.com/zachjs/sv2v/issues/new @@ -137,16 +148,21 @@ ## Testing -Once the [test dependencies](#dependencies) are installed, tests can be run with -`make test`. GitHub Actions is used to automatically test commits. +Once the [test dependencies] are installed, tests can be run with `make test`. +GitHub Actions is used to [automatically test] commits. Please review the [test +documentation] for guidance on adding, debugging, and interpreting tests. -There is also a [SystemVerilog compliance suite] being created to test -open-source tools' SystemVerilog support. Although not every test in the suite -is applicable, it has been a valuable asset in finding edge cases. +[test dependencies]: #dependencies +[test documentation]: test/README.md +[automatically test]: https://github.com/zachjs/sv2v/actions -[SystemVerilog compliance suite]: https://github.com/SymbiFlow/sv-tests +There is also a [SystemVerilog compliance suite] that tests open-source tools' +SystemVerilog support. Although not every test in the suite is applicable, it +has been a valuable asset in finding edge cases. +[SystemVerilog compliance suite]: https://github.com/chipsalliance/sv-tests + ## Acknowledgements This project was originally forked from [Tom Hawkin's Verilog parser]. While the @@ -156,12 +172,11 @@ [Tom Hawkin's Verilog parser]: https://github.com/tomahawkins/verilog Reid Long was invaluable in developing this tool, providing significant tests -and advice, and isolating many bugs. His projects can be found -[here](https://bitbucket.org/ReidLong/). +and advice, and isolating many bugs. Edric Kusuma helped me with the ins and outs of SystemVerilog, with which I had no prior experience, and has also helped with test cases. -Since sv2v's public release, several people have taken the time to file detailed +Since sv2v's public release, many people have taken the time to file detailed bug reports and feature requests. I greatly appreciate their help in furthering the project. diff --git a/src/Convert.hs b/src/Convert.hs --- a/src/Convert.hs +++ b/src/Convert.hs @@ -47,7 +47,9 @@ import qualified Convert.Simplify import qualified Convert.Stream import qualified Convert.StringParam +import qualified Convert.StringType import qualified Convert.Struct +import qualified Convert.StructConst import qualified Convert.TFBlock import qualified Convert.Typedef import qualified Convert.TypeOf @@ -70,10 +72,11 @@ , Convert.EmptyArgs.convert , Convert.FuncRet.convert , Convert.TFBlock.convert + , Convert.StringType.convert ] -mainPhases :: Selector -> [Phase] -mainPhases selectExclude = +mainPhases :: [String] -> Selector -> [Phase] +mainPhases tops selectExclude = [ Convert.BlockDecl.convert , selectExclude Job.Logic Convert.Logic.convert , Convert.ImplicitNet.convert @@ -82,7 +85,7 @@ , Convert.MultiplePacked.convert , selectExclude Job.UnbasedUnsized Convert.UnbasedUnsized.convert , Convert.Cast.convert - , Convert.ParamType.convert + , Convert.ParamType.convert tops , Convert.HierConst.convert , Convert.TypeOf.convert , Convert.DimensionQuery.convert @@ -95,12 +98,12 @@ , Convert.Wildcard.convert , Convert.Enum.convert , Convert.StringParam.convert - , selectExclude Job.Interface Convert.Interface.convert + , selectExclude Job.Interface $ Convert.Interface.convert tops , selectExclude Job.Succinct Convert.RemoveComments.convert ] -initialPhases :: Selector -> [Phase] -initialPhases selectExclude = +initialPhases :: [String] -> Selector -> [Phase] +initialPhases tops selectExclude = [ Convert.ForAsgn.convert , Convert.Jump.convert , Convert.ExprAsgn.convert @@ -114,22 +117,23 @@ , selectExclude Job.Assert Convert.Assertion.convert , selectExclude Job.Always Convert.AlwaysKW.convert , Convert.Package.convert + , Convert.StructConst.convert , Convert.PortDecl.convert - , Convert.ParamNoDefault.convert + , Convert.ParamNoDefault.convert tops , Convert.ResolveBindings.convert , Convert.UnnamedGenBlock.convert ] -convert :: FilePath -> [Job.Exclude] -> IOPhase -convert dumpPrefix excludes = +convert :: [String] -> FilePath -> [Job.Exclude] -> IOPhase +convert tops dumpPrefix excludes = step "parse" id >=> step "initial" initial >=> loop 1 "main" main >=> step "final" final where final = combine $ finalPhases selectExclude - main = combine $ mainPhases selectExclude - initial = combine $ initialPhases selectExclude + main = combine $ mainPhases tops selectExclude + initial = combine $ initialPhases tops selectExclude combine = foldr1 (.) selectExclude :: Selector diff --git a/src/Convert/AlwaysKW.hs b/src/Convert/AlwaysKW.hs --- a/src/Convert/AlwaysKW.hs +++ b/src/Convert/AlwaysKW.hs @@ -37,7 +37,6 @@ = Const Expr | Var | Proc [Expr] [PortDir] - deriving Eq scoper :: ModuleItem -> SC ModuleItem scoper = scopeModuleItem traverseDecl return traverseGenItem traverseStmt @@ -130,6 +129,7 @@ asConstRaw :: Scopes Kind -> Expr -> Writer Any Expr asConstRaw scopes expr = case lookupElem scopes expr of + Just (accesses@[_, _], _, Const{}) -> return $ accessesToExpr accesses Just (_, _, Const Nil) -> recurse Just (_, _, Const expr') -> asConstRaw scopes expr' Just{} -> tell (Any True) >> return Nil @@ -197,6 +197,8 @@ traverseModuleItem item@(MIPackageItem (Task _ x decls _)) = do insertElem x $ Proc [] (ports decls) return item +traverseModuleItem (MIAttr attr item) = + MIAttr attr <$> traverseModuleItem item traverseModuleItem other = return other toEvent :: (Bool, [Expr]) -> Event @@ -210,7 +212,6 @@ port :: Decl -> PortDir port (Variable d _ x _ _) = (x, d) -port (Net d _ _ _ x _ _) = (x, d) port _ = ("", Local) -- get a list of non-local variables referenced within a module item, and diff --git a/src/Convert/Assertion.hs b/src/Convert/Assertion.hs --- a/src/Convert/Assertion.hs +++ b/src/Convert/Assertion.hs @@ -13,11 +13,11 @@ convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem convertModuleItem :: ModuleItem -> ModuleItem -convertModuleItem (AssertionItem item) = - Generate $ - map (GenModuleItem . MIPackageItem . Decl . CommentDecl) $ - "removed an assertion item" : - (lines $ show $ AssertionItem item) +convertModuleItem item@AssertionItem{} = + Generate $ map toItem comments + where + toItem = GenModuleItem . MIPackageItem . Decl . CommentDecl + comments = "removed an assertion item" : (lines $ show item) convertModuleItem other = traverseStmts (traverseNestedStmts convertStmt) other diff --git a/src/Convert/Cast.hs b/src/Convert/Cast.hs --- a/src/Convert/Cast.hs +++ b/src/Convert/Cast.hs @@ -99,7 +99,7 @@ traverseExprM :: Expr -> SC Expr traverseExprM (Cast (Left (IntegerVector kw sg rs)) value) | kw /= TBit = do - value' <- traverseExprM value + value' <- fmap simplify $ traverseExprM value size' <- traverseExprM size convertCastM size' value' signed where @@ -121,8 +121,9 @@ return $ Number $ numberCast signed (fromIntegral size') value where Just size' = numberToInteger size +convertCastM size@Number{} (String str) signed = + convertCastM size (stringToNumber str) signed convertCastM size value signed = do - value' <- traverseExprM value sizeUsesLocalVars <- embedScopes usesLocalVars size inProcedure <- withinProcedureM if not sizeUsesLocalVars || not inProcedure then do @@ -135,12 +136,12 @@ else do details <- lookupElemM name when (details == Nothing) (injectTopItem item) - return $ Call (Ident name) (Args [value'] []) + return $ Call (Ident name) (Args [value] []) else do name <- castDeclName 0 insertElem name () useVar <- withinStmt - injectDecl $ castDecl useVar name value' size signed + injectDecl $ castDecl useVar name value size signed return $ Ident name -- checks if a cast size references any vars not defined at the top level scope diff --git a/src/Convert/ExprUtils.hs b/src/Convert/ExprUtils.hs --- a/src/Convert/ExprUtils.hs +++ b/src/Convert/ExprUtils.hs @@ -13,9 +13,11 @@ , endianCondExpr , endianCondRange , dimensionsSize + , stringToNumber ) where -import Data.Bits (shiftL, shiftR) +import Data.Bits ((.&.), (.|.), shiftL, shiftR) +import Data.Char (ord) import Convert.Traverse import Language.SystemVerilog.AST @@ -36,18 +38,13 @@ simplifyStep (UniOp UniSub (UniOp UniSub e)) = e simplifyStep (UniOp UniSub (BinOp Sub e1 e2)) = BinOp Sub e2 e1 -simplifyStep (Concat (Number n1 : Number n2 : rest)) = - simplifyStep $ Concat $ Number n : rest - where n = n1 <> n2 - simplifyStep (Concat [Number (Decimal size _ value)]) = Number $ Decimal size False value simplifyStep (Concat [Number (Based size _ base value kinds)]) = Number $ Based size False base value kinds simplifyStep (Concat [e@Stream{}]) = e -simplifyStep (Concat [e@Concat{}]) = e simplifyStep (Concat [e@Repeat{}]) = e -simplifyStep (Concat es) = Concat $ filter (/= Concat []) es +simplifyStep (Concat es) = Concat $ flattenConcat es simplifyStep (Repeat (Dec 0) _) = Concat [] simplifyStep (Repeat (Dec 1) es) = Concat es simplifyStep (Mux (Number n) e1 e2) = @@ -73,7 +70,17 @@ simplifyStep (BinOp op e1 e2) = simplifyBinOp op e1 e2 simplifyStep other = other +-- flatten and coalesce concatenations +flattenConcat :: [Expr] -> [Expr] +flattenConcat (Number n1 : Number n2 : es) = + flattenConcat $ Number (n1 <> n2) : es +flattenConcat (Concat es1 : es2) = + flattenConcat $ es1 ++ es2 +flattenConcat (e : es) = + e : flattenConcat es +flattenConcat [] = [] + simplifyBinOp :: BinOp -> Expr -> Expr -> Expr simplifyBinOp Sub e (Dec 0) = e @@ -107,11 +114,51 @@ BinOp Sub (BinOp Add n1 n2) e simplifyBinOp Ge (BinOp Sub e (Dec 1)) (Dec 0) = BinOp Ge e (toDec 1) -simplifyBinOp ShiftAL (Dec x) (Dec y) = toDec $ shiftL x (fromIntegral y) -simplifyBinOp ShiftAR (Dec x) (Dec y) = toDec $ shiftR x (fromIntegral y) -simplifyBinOp ShiftL (Dec x) (Dec y) = toDec $ shiftL x (fromIntegral y) -simplifyBinOp ShiftR (Dec x) (Dec y) = toDec $ shiftR x (fromIntegral y) +-- simplify bit shifts of decimal literals +simplifyBinOp op (Dec x) (Number yRaw) + | ShiftAL <- op = decShift shiftL + | ShiftAR <- op = decShift shiftR + | ShiftL <- op = decShift shiftL + | ShiftR <- op = decShift shiftR + where + decShift shifter = + case numberToInteger yRaw of + Just y -> toDec $ shifter x (fromIntegral y) + Nothing -> constantFold undefined Div undefined 0 +-- simply comparisons with string literals +simplifyBinOp op (Number n) (String s) | isCmpOp op = + simplifyBinOp op (Number n) (sizeStringAs s n) +simplifyBinOp op (String s) (Number n) | isCmpOp op = + simplifyBinOp op (sizeStringAs s n) (Number n) +simplifyBinOp op (String s1) (String s2) | isCmpOp op = + simplifyBinOp op (stringToNumber s1) (stringToNumber s2) + +-- simply basic arithmetic comparisons +simplifyBinOp op (Number n1) (Number n2) + | Eq <- op = cmp (==) + | Ne <- op = cmp (/=) + | Lt <- op = cmp (<) + | Le <- op = cmp (<=) + | Gt <- op = cmp (>) + | Ge <- op = cmp (>=) + where + cmp :: (Integer -> Integer -> Bool) -> Expr + cmp folder = + case (numberToInteger n1', numberToInteger n2') of + (Just i1, Just i2) -> bool $ folder i1 i2 + _ -> BinOp op (Number n1') (Number n2') + sg = numberIsSigned n1 && numberIsSigned n2 + sz = fromIntegral $ max (numberBitLength n1) (numberBitLength n2) + n1' = numberCast sg sz n1 + n2' = numberCast sg sz n2 + +-- simply comparisons with unbased unsized literals +simplifyBinOp op (Number n) (ConvertedUU sz v k) | isCmpOp op = + simplifyBinOp op (Number n) (uuExtend sz v k) +simplifyBinOp op (ConvertedUU sz v k) (Number n) | isCmpOp op = + simplifyBinOp op (uuExtend sz v k) (Number n) + simplifyBinOp op e1 e2 = case (e1, e2) of (Dec x, Dec y) -> constantFold orig op x y @@ -142,6 +189,8 @@ constantFold _ Ge x y = bool $ x >= y constantFold _ Lt x y = bool $ x < y constantFold _ Le x y = bool $ x <= y +constantFold _ BitAnd x y = toDec $ x .&. y +constantFold _ BitOr x y = toDec $ x .|. y constantFold fallback _ _ _ = fallback @@ -224,3 +273,49 @@ -- similar to the above pattern, we assume E >= 1 for any range like [0:E-1] pattern RevSzRange :: Expr -> Range pattern RevSzRange expr = (RawNum 0, BinOp Sub expr (RawNum 1)) + +-- convert a string to decimal number +stringToNumber :: String -> Expr +stringToNumber str = + Number $ Decimal size False value + where + size = 8 * length str + value = stringToInteger str + +-- convert a string to big integer +stringToInteger :: String -> Integer +stringToInteger [] = 0 +stringToInteger (x : xs) = + fromIntegral (ord x) + (256 :: Integer) * stringToInteger xs + +-- cast string to number at least as big as the width of the given number +sizeStringAs :: String -> Number -> Expr +sizeStringAs str num = + Cast (Left typ) (stringToNumber str) + where + typ = IntegerVector TReg Unspecified [(RawNum size, RawNum 1)] + size = max strSize numSize + strSize = fromIntegral $ 8 * length str + numSize = numberBitLength num + +-- excludes wildcard and strict comparison operators +isCmpOp :: BinOp -> Bool +isCmpOp Eq = True +isCmpOp Ne = True +isCmpOp Lt = True +isCmpOp Le = True +isCmpOp Gt = True +isCmpOp Ge = True +isCmpOp _ = False + +-- sign extend a converted unbased unsized literal into a based number +uuExtend :: Integer -> Integer -> Integer -> Expr +uuExtend sz v k = + Number $ + numberCast False (fromIntegral sz) $ + Based 1 True Hex v k + +pattern ConvertedUU :: Integer -> Integer -> Integer -> Expr +pattern ConvertedUU sz v k <- Repeat + (RawNum sz) + [Number (Based 1 True Binary v k)] diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -10,6 +10,7 @@ import Data.List (intercalate, (\\)) import Data.Maybe (isJust, isNothing, mapMaybe) import Control.Monad.Writer.Strict +import Text.Read (readMaybe) import qualified Data.Map.Strict as Map import Convert.ExprUtils (endianCondExpr) @@ -28,13 +29,13 @@ type ModportBinding = (Identifier, (Substitutions, Expr)) type Substitutions = [(Expr, Expr)] -convert :: [AST] -> [AST] -convert files = +convert :: [Identifier] -> [AST] -> [AST] +convert tops files = if needsFlattening then files else traverseFiles (collectDescriptionsM collectPart) - (map . convertDescription) + (map . convertDescription tops) files where -- we can only collect/map non-extern interfaces and modules @@ -54,12 +55,22 @@ checkItem (Instance _ _ _ rs _) = when (length rs > 1) $ tell $ Any True checkItem _ = return () -convertDescription :: PartInfos -> Description -> Description -convertDescription _ (Part _ _ Interface _ name _ _) = - PackageItem $ Decl $ CommentDecl $ "removed interface: " ++ name -convertDescription parts (Part attrs extern Module lifetime name ports items) = +topInterfaceError :: String -> String -> a +topInterfaceError name issue = error $ + "Specified top module " ++ name ++ " " ++ issue ++ ". Please " ++ + "instantiate it somewhere and use that as your top module instead." + +convertDescription :: [Identifier] -> PartInfos -> Description -> Description +convertDescription tops _ (Part _ _ Interface _ name _ _) + | elem name tops = + topInterfaceError name "is an interface" + | otherwise = + PackageItem $ Decl $ CommentDecl $ "removed interface: " ++ name +convertDescription tops parts (Part att ext Module lif name ports items) = if null $ extractModportInstances name $ PartInfo Module ports items then - Part attrs extern Module lifetime name ports items' + Part att ext Module lif name ports items' + else if elem name tops then + topInterfaceError name "has interface ports" else PackageItem $ Decl $ CommentDecl $ "removed module with interface ports: " ++ name @@ -70,13 +81,24 @@ traverseDeclM :: Decl -> Scoper [ModportDecl] Decl traverseDeclM decl = do case decl of - Variable _ _ x _ _ -> insertElem x DeclVal - Net _ _ _ _ x _ _ -> insertElem x DeclVal - Param _ _ x _ -> insertElem x DeclVal + Variable _ t x _ _ -> checkDeclType t x >> insertElem x DeclVal + Net _ _ _ t x _ _ -> checkDeclType t x >> insertElem x DeclVal + Param _ t x _ -> checkDeclType t x >> insertElem x DeclVal ParamType _ x _ -> insertElem x DeclVal CommentDecl{} -> return () return decl + -- check for module or interface names used as type names + checkDeclType :: Type -> Identifier -> Scoper a () + checkDeclType (Alias typeName _) declName + | isNothing (readMaybe declName :: Maybe Int) + , Just part <- Map.lookup typeName parts = do + maybeType <- lookupElemM typeName + when (isNothing maybeType) $ scopedErrorM $ + "declaration " ++ declName ++ " uses " ++ show (pKind part) + ++ " name " ++ typeName ++ " where a type name is expected" + checkDeclType _ _ = return () + lookupIntfElem :: Scopes [ModportDecl] -> Expr -> LookupResult [ModportDecl] lookupIntfElem modports expr = case lookupElem modports expr of @@ -285,6 +307,7 @@ else if elem x (pPorts partInfo) then tell [(x, info)] >> return decl else + -- TODO: This does not handle shadowed typenames. scopedErrorM $ "Modport not in port list: " ++ show t ++ " " ++ x ++ ". Is this an interface missing a port list?" @@ -311,7 +334,7 @@ Nothing -> False Just info -> pKind info == Interface -convertDescription _ other = other +convertDescription _ _ other = other isDecl :: ModuleItem -> Bool isDecl (MIPackageItem Decl{}) = True diff --git a/src/Convert/Jump.hs b/src/Convert/Jump.hs --- a/src/Convert/Jump.hs +++ b/src/Convert/Jump.hs @@ -41,7 +41,9 @@ convertModuleItem (MIPackageItem (Function ml t f decls stmtsOrig)) = MIPackageItem $ Function ml t f decls' stmts'' where - stmts = map (traverseNestedStmts convertReturn) stmtsOrig + stmts = if t == Void + then stmtsOrig + else map (traverseNestedStmts convertReturn) stmtsOrig convertReturn :: Stmt -> Stmt convertReturn (Return Nil) = Return Nil convertReturn (Return e) = @@ -223,11 +225,12 @@ assertMsg jumpAllowed "encountered break inside fork-join" modify $ \s -> s { sHasJump = True } return $ asgn jumpState jsBreak -convertStmt (Return Nil) = do +convertStmt (Return e) = do jumpAllowed <- gets sJumpAllowed returnAllowed <- gets sReturnAllowed assertMsg jumpAllowed "encountered return inside fork-join" assertMsg returnAllowed "encountered return outside of task or function" + assertMsg (e == Nil) "non-void return inside task or void function" modify $ \s -> s { sHasJump = True } return $ asgn jumpState jsReturn @@ -253,8 +256,6 @@ convertStmt (StmtAttr attr stmt) = convertStmt stmt >>= return . StmtAttr attr -convertStmt (Return{}) = return $ - error "non-void return should have been elaborated already" convertStmt (Foreach{}) = return $ error "foreach should have been elaborated already" diff --git a/src/Convert/MultiplePacked.hs b/src/Convert/MultiplePacked.hs --- a/src/Convert/MultiplePacked.hs +++ b/src/Convert/MultiplePacked.hs @@ -153,7 +153,14 @@ return lhs' convertExprM :: Expr -> Scoper TypeInfo Expr -convertExprM = embedScopes convertExpr +convertExprM = + traverseExprTypesM convertTypeM >=> + embedScopes convertExpr + +convertTypeM :: Type -> Scoper TypeInfo Type +convertTypeM = + traverseNestedTypesM $ traverseTypeExprsM $ + traverseNestedExprsM convertExprM convertExpr :: Scopes TypeInfo -> Expr -> Expr convertExpr scopes = diff --git a/src/Convert/ParamNoDefault.hs b/src/Convert/ParamNoDefault.hs --- a/src/Convert/ParamNoDefault.hs +++ b/src/Convert/ParamNoDefault.hs @@ -23,21 +23,32 @@ type Parts = Map.Map Identifier [(Identifier, Bool)] -convert :: [AST] -> [AST] -convert files = +convert :: [Identifier] -> [AST] -> [AST] +convert tops files = + flip (foldr $ ensureTopExists parts) tops $ map convertFile files' where (files', parts) = runWriter $ - mapM (traverseDescriptionsM traverseDescriptionM) files + mapM (traverseDescriptionsM $ traverseDescriptionM tops) files convertFile = traverseDescriptions $ traverseModuleItems $ traverseModuleItem parts -traverseDescriptionM :: Description -> Writer Parts Description -traverseDescriptionM (Part attrs extern kw lifetime name ports items) = do +ensureTopExists :: Parts -> Identifier -> a -> a +ensureTopExists parts top = + if Map.member top parts + then id + else error $ "Could not find top module " ++ top + +traverseDescriptionM :: [Identifier] -> Description -> Writer Parts Description +traverseDescriptionM tops (Part attrs extern kw lifetime name ports items) = do let (items', params) = runWriter $ mapM traverseModuleItemM items tell $ Map.singleton name params + let missing = map fst $ filter snd params + when (not (null tops) && elem name tops && not (null missing)) $ + error $ "Specified top module " ++ name ++ " is missing default " + ++ "parameter value(s) for " ++ intercalate ", " missing return $ Part attrs extern kw lifetime name ports items' -traverseDescriptionM other = return other +traverseDescriptionM _ other = return other traverseModuleItemM :: ModuleItem -> Writer [(Identifier, Bool)] ModuleItem traverseModuleItemM (MIAttr attr item) = diff --git a/src/Convert/ParamType.hs b/src/Convert/ParamType.hs --- a/src/Convert/ParamType.hs +++ b/src/Convert/ParamType.hs @@ -26,8 +26,8 @@ type DeclMap = Map.Map Identifier Decl type UsageMap = [(Identifier, Set.Set Identifier)] -convert :: [AST] -> [AST] -convert files = +convert :: [Identifier] -> [AST] -> [AST] +convert tops files = files''' where modules = execWriter $ @@ -74,10 +74,11 @@ keepDescription :: Description -> Bool keepDescription (Part _ _ _ _ name _ _) = isNewModule - || isntTyped + || isntTyped && (isTopOrNoTop || isInstantiated) || isUsedAsUntyped || isUsedAsTyped && isInstantiatedViaNonTyped || allTypesHaveDefaults && notInstantiated && isntTemplateTagged + && isTopOrNoTop where maybeTypeMap = Map.lookup name modules Just typeMap = maybeTypeMap @@ -88,7 +89,9 @@ isInstantiatedViaNonTyped = untypedUsageSearch $ Set.singleton name allTypesHaveDefaults = all (/= UnknownType) (Map.elems typeMap) notInstantiated = lookup name instances == Nothing + isInstantiated = not notInstantiated isntTemplateTagged = not $ isTemplateTagged name + isTopOrNoTop = null tops || elem name tops keepDescription _ = True -- instantiate the type parameters if this is a used default instance diff --git a/src/Convert/RemoveComments.hs b/src/Convert/RemoveComments.hs --- a/src/Convert/RemoveComments.hs +++ b/src/Convert/RemoveComments.hs @@ -61,4 +61,6 @@ isCommentDecl _ = False convertStmts :: [Stmt] -> [Stmt] -convertStmts = map $ traverseNestedStmts convertStmt +convertStmts = + filter (/= Null) . + map (traverseNestedStmts convertStmt) diff --git a/src/Convert/ResolveBindings.hs b/src/Convert/ResolveBindings.hs --- a/src/Convert/ResolveBindings.hs +++ b/src/Convert/ResolveBindings.hs @@ -62,9 +62,13 @@ paramBindings' = map checkParam $ resolveBindings (msg "parameter overrides") paramNames paramBindings - portBindings' = filter ((/= Nil) . snd) $ - resolveBindings (msg "port connections") portNames $ - concatMap expandStar portBindings + portBindings' = resolveBindings (msg "port connections") portNames $ + concatMap expandStar $ + -- drop the trailing comma in positional port bindings + if length portNames + 1 == length portBindings + && last portBindings == ("", Nil) + then init portBindings + else portBindings expandStar :: PortBinding -> [PortBinding] expandStar ("*", Nil) = @@ -102,12 +106,13 @@ -- give a set of bindings explicit names resolveBindings :: String -> [Identifier] -> [Binding t] -> [Binding t] resolveBindings _ _ [] = [] -resolveBindings location available bindings = +resolveBindings location available bindings@(("", _) : _) = if length available < length bindings then error $ "too many bindings specified for " ++ location - else if null $ fst $ head bindings then + else zip available $ map snd bindings - else if not $ null unknowns then +resolveBindings location available bindings = + if not $ null unknowns then error $ "unknown binding" ++ unknownsPlural ++ " " ++ unknownsStr ++ " specified for " ++ location else diff --git a/src/Convert/Simplify.hs b/src/Convert/Simplify.hs --- a/src/Convert/Simplify.hs +++ b/src/Convert/Simplify.hs @@ -42,6 +42,8 @@ where t = IntegerVector TLogic sg rs Param Localparam t x e -> insertExpr x $ Cast (Left t) e + Variable _ _ x _ _ -> insertElem x Nil + Net _ _ _ _ x _ _ -> insertElem x Nil _ -> return () return decl' @@ -66,6 +68,8 @@ isSimpleExpr _ = False traverseModuleItemM :: ModuleItem -> Scoper Expr ModuleItem +traverseModuleItemM (Genvar x) = + insertElem x Nil >> return (Genvar x) traverseModuleItemM (Instance m p x rs l) = do p' <- mapM paramBindingMapper p traverseExprsM traverseExprM $ Instance m p' x rs l @@ -147,8 +151,8 @@ substitute' :: Expr -> Expr substitute' (Ident x) = case lookupElem scopes x of - Nothing -> Ident x - Just (_, _, e) -> e + Just (_, _, e) | e /= Nil -> e + _ -> Ident x substitute' other = traverseSinglyNestedExprs substitute' other diff --git a/src/Convert/StringType.hs b/src/Convert/StringType.hs new file mode 100644 --- /dev/null +++ b/src/Convert/StringType.hs @@ -0,0 +1,23 @@ +{- sv2v + - Author: Zachary Snow + - + - Drop explicit `string` data type from parameters and localparams + -} + +module Convert.StringType (convert) where + +import Convert.Traverse +import Language.SystemVerilog.AST + +convert :: [AST] -> [AST] +convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem + +convertModuleItem :: ModuleItem -> ModuleItem +convertModuleItem = traverseNodes id traverseDecl id id traverseStmt + +traverseStmt :: Stmt -> Stmt +traverseStmt = traverseNestedStmts $ traverseStmtDecls traverseDecl + +traverseDecl :: Decl -> Decl +traverseDecl (Param s (NonInteger TString) x e) = Param s UnknownType x e +traverseDecl other = other diff --git a/src/Convert/StructConst.hs b/src/Convert/StructConst.hs new file mode 100644 --- /dev/null +++ b/src/Convert/StructConst.hs @@ -0,0 +1,97 @@ +{- sv2v + - Author: Zachary Snow + - + - High-level elaboration for struct constant accesses + - + - This greatly simplifies designs with long sequences of struct parameters + - which extend and reference one another, as seen in BlackParrot. + -} + +module Convert.StructConst (convert) where + +import Control.Monad.State.Strict +import Data.Maybe (fromMaybe) +import Data.Tuple (swap) +import qualified Data.Map.Strict as Map + +import Convert.Traverse +import Language.SystemVerilog.AST + +type StructType = [Field] +type StructValue = [(TypeOrExpr, Expr)] + +type Const = (StructType, StructValue) +type Consts = Map.Map Identifier Const +type Types = Map.Map Identifier StructType + +type SC = State (Types, Consts) + +convert :: [AST] -> [AST] +convert = map $ traverseDescriptions convertDescription + +convertDescription :: Description -> Description +convertDescription = + flip evalState mempty . + traverseModuleItemsM (traverseDeclsM elaborateDecl) + +insertType :: Identifier -> [Field] -> SC () +insertType ident typ = do + (types, consts) <- get + let types' = Map.insert ident typ types + put (types', consts) + +insertConst :: Identifier -> Const -> SC () +insertConst ident cnst = do + (types, consts) <- get + let consts' = Map.insert ident cnst consts + put (types, consts') + +lookupType :: Type -> SC [Field] +lookupType (Alias ident []) = do + maybeFields <- gets $ Map.lookup ident . fst + return $ fromMaybe [] maybeFields +lookupType (Struct (Packed Unspecified) fields []) = + return fields +lookupType _ = return [] + +lookupConst :: Identifier -> SC (Maybe Const) +lookupConst param = gets $ Map.lookup param . snd + +elaborateDecl :: Decl -> SC Decl +-- track struct type parameters +elaborateDecl decl@(ParamType Localparam x t) + | Struct (Packed Unspecified) fields [] <- t = + insertType x fields >> return decl +-- track and resolve struct constants +elaborateDecl (Param Localparam t x e) = do + e' <- elaborateExpr e + fields <- lookupType t + when (not $ null fields) $ do + maybeValues <- extractStructValue e' + case maybeValues of + Just values -> insertConst x (fields, values) + Nothing -> return () + return $ Param Localparam t x e' +elaborateDecl decl = return decl + +-- extract the pattern items, including for simple aliases +extractStructValue :: Expr -> SC (Maybe StructValue) +extractStructValue (Pattern values) = return $ Just values +extractStructValue (Ident param) = fmap (fmap snd) $ lookupConst param +extractStructValue _ = return Nothing + +-- elaborate constant field accesses +elaborateExpr :: Expr -> SC Expr +elaborateExpr expr@(Dot (Ident param) field) = + fmap (fromMaybe expr . join . fmap (resolveParam field)) (lookupConst param) +elaborateExpr expr = + traverseSinglyNestedExprsM elaborateExpr expr + +-- lookup value in struct constant +resolveParam :: Identifier -> Const -> Maybe Expr +resolveParam field (fields, values) = do + fieldType <- lookup field (map swap fields) + value <- mplus + (lookup (Right $ Ident field) values) + (lookup (Left UnknownType) values) + Just $ Cast (Left fieldType) value diff --git a/src/Convert/TFBlock.hs b/src/Convert/TFBlock.hs --- a/src/Convert/TFBlock.hs +++ b/src/Convert/TFBlock.hs @@ -47,11 +47,6 @@ then (declsA ++ declsB, stmtsB) else (declsA, [stmt]) where (declsB, stmtsB) = flattenOuterBlocks stmt -flattenOuterBlocks (Block Seq "" declsA (Block Seq name declsB stmtsA : stmtsB)) = - if canCombine declsA declsB - then flattenOuterBlocks $ - Block Seq name (declsA ++ declsB) (stmtsA ++ stmtsB) - else (declsA, Block Seq name declsB stmtsA : stmtsB) flattenOuterBlocks (Block Seq name decls stmts) | null name = (decls, stmts) | otherwise = ([], [Block Seq name decls stmts]) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -282,75 +282,89 @@ assertionMapper (Cover e stmt) = mapper stmt >>= return . Cover e +traverseSeqExprExprsM :: Monad m => MapperM m Expr -> MapperM m SeqExpr +traverseSeqExprExprsM mapper (SeqExpr e) = + mapper e >>= return . SeqExpr +traverseSeqExprExprsM mapper (SeqExprAnd s1 s2) = + seqExprHelper mapper SeqExprAnd s1 s2 +traverseSeqExprExprsM mapper (SeqExprOr s1 s2) = + seqExprHelper mapper SeqExprOr s1 s2 +traverseSeqExprExprsM mapper (SeqExprIntersect s1 s2) = + seqExprHelper mapper SeqExprIntersect s1 s2 +traverseSeqExprExprsM mapper (SeqExprWithin s1 s2) = + seqExprHelper mapper SeqExprWithin s1 s2 +traverseSeqExprExprsM mapper (SeqExprThroughout e s) = do + e' <- mapper e + s' <- traverseSeqExprExprsM mapper s + return $ SeqExprThroughout e' s' +traverseSeqExprExprsM mapper (SeqExprDelay ms r s) = do + ms' <- case ms of + Nothing -> return Nothing + Just x -> traverseSeqExprExprsM mapper x >>= return . Just + r' <- mapBothM mapper r + s' <- traverseSeqExprExprsM mapper s + return $ SeqExprDelay ms' r' s' +traverseSeqExprExprsM mapper (SeqExprFirstMatch s items) = do + s' <- traverseSeqExprExprsM mapper s + items' <- mapM (traverseSeqMatchItemExprsM mapper) items + return $ SeqExprFirstMatch s' items' + +traverseSeqMatchItemExprsM :: Monad m => MapperM m Expr -> MapperM m SeqMatchItem +traverseSeqMatchItemExprsM mapper (SeqMatchAsgn (a, b, c)) = do + c' <- mapper c + return $ SeqMatchAsgn (a, b, c') +traverseSeqMatchItemExprsM mapper (SeqMatchCall x (Args l p)) = do + l' <- mapM mapper l + pes <- mapM mapper $ map snd p + let p' = zip (map fst p) pes + return $ SeqMatchCall x (Args l' p') + +traversePropertySpecExprsM :: Monad m => MapperM m Expr -> MapperM m PropertySpec +traversePropertySpecExprsM mapper (PropertySpec mv e pe) = do + mv' <- mapM (traverseEventExprsM mapper) mv + e' <- mapper e + pe' <- traversePropExprExprsM mapper pe + return $ PropertySpec mv' e' pe' + +traversePropExprExprsM :: Monad m => MapperM m Expr -> MapperM m PropExpr +traversePropExprExprsM mapper (PropExpr se) = + traverseSeqExprExprsM mapper se >>= return . PropExpr +traversePropExprExprsM mapper (PropExprImpliesO se pe) = + propExprHelper mapper PropExprImpliesO se pe +traversePropExprExprsM mapper (PropExprImpliesNO se pe) = + propExprHelper mapper PropExprImpliesNO se pe +traversePropExprExprsM mapper (PropExprFollowsO se pe) = + propExprHelper mapper PropExprFollowsO se pe +traversePropExprExprsM mapper (PropExprFollowsNO se pe) = + propExprHelper mapper PropExprFollowsNO se pe +traversePropExprExprsM mapper (PropExprIff p1 p2) = do + p1' <- traversePropExprExprsM mapper p1 + p2' <- traversePropExprExprsM mapper p2 + return $ PropExprIff p1' p2' + +seqExprHelper :: Monad m => MapperM m Expr + -> (SeqExpr -> SeqExpr -> SeqExpr) + -> SeqExpr -> SeqExpr -> m SeqExpr +seqExprHelper mapper constructor s1 s2 = do + s1' <- traverseSeqExprExprsM mapper s1 + s2' <- traverseSeqExprExprsM mapper s2 + return $ constructor s1' s2' + +propExprHelper :: Monad m => MapperM m Expr + -> (SeqExpr -> PropExpr -> PropExpr) + -> SeqExpr -> PropExpr -> m PropExpr +propExprHelper mapper constructor se pe = do + se' <- traverseSeqExprExprsM mapper se + pe' <- traversePropExprExprsM mapper pe + return $ constructor se' pe' + -- Note that this does not include the expressions without the statements of the -- actions associated with the assertions. traverseAssertionExprsM :: Monad m => MapperM m Expr -> MapperM m Assertion traverseAssertionExprsM mapper = assertionMapper where - seqExprMapper (SeqExpr e) = - mapper e >>= return . SeqExpr - seqExprMapper (SeqExprAnd s1 s2) = - ssMapper SeqExprAnd s1 s2 - seqExprMapper (SeqExprOr s1 s2) = - ssMapper SeqExprOr s1 s2 - seqExprMapper (SeqExprIntersect s1 s2) = - ssMapper SeqExprIntersect s1 s2 - seqExprMapper (SeqExprWithin s1 s2) = - ssMapper SeqExprWithin s1 s2 - seqExprMapper (SeqExprThroughout e s) = do - e' <- mapper e - s' <- seqExprMapper s - return $ SeqExprThroughout e' s' - seqExprMapper (SeqExprDelay ms r s) = do - ms' <- case ms of - Nothing -> return Nothing - Just x -> seqExprMapper x >>= return . Just - r' <- mapBothM mapper r - s' <- seqExprMapper s - return $ SeqExprDelay ms' r' s' - seqExprMapper (SeqExprFirstMatch s items) = do - s' <- seqExprMapper s - items' <- mapM seqMatchItemMapper items - return $ SeqExprFirstMatch s' items' - seqMatchItemMapper (SeqMatchAsgn (a, b, c)) = do - c' <- mapper c - return $ SeqMatchAsgn (a, b, c') - seqMatchItemMapper (SeqMatchCall x (Args l p)) = do - l' <- mapM mapper l - pes <- mapM mapper $ map snd p - let p' = zip (map fst p) pes - return $ SeqMatchCall x (Args l' p') - ppMapper constructor p1 p2 = do - p1' <- propExprMapper p1 - p2' <- propExprMapper p2 - return $ constructor p1' p2' - ssMapper constructor s1 s2 = do - s1' <- seqExprMapper s1 - s2' <- seqExprMapper s2 - return $ constructor s1' s2' - spMapper constructor se pe = do - se' <- seqExprMapper se - pe' <- propExprMapper pe - return $ constructor se' pe' - propExprMapper (PropExpr se) = - seqExprMapper se >>= return . PropExpr - propExprMapper (PropExprImpliesO se pe) = - spMapper PropExprImpliesO se pe - propExprMapper (PropExprImpliesNO se pe) = - spMapper PropExprImpliesNO se pe - propExprMapper (PropExprFollowsO se pe) = - spMapper PropExprFollowsO se pe - propExprMapper (PropExprFollowsNO se pe) = - spMapper PropExprFollowsNO se pe - propExprMapper (PropExprIff p1 p2) = - ppMapper PropExprIff p1 p2 - propSpecMapper (PropertySpec mv e pe) = do - mv' <- mapM (traverseEventExprsM mapper) mv - e' <- mapper e - pe' <- propExprMapper pe - return $ PropertySpec mv' e' pe' assertionExprMapper (Concurrent e) = - propSpecMapper e >>= return . Concurrent + traversePropertySpecExprsM mapper e >>= return . Concurrent assertionExprMapper (Immediate d e) = mapper e >>= return . Immediate d assertionMapper (Assert e ab) = do @@ -604,16 +618,23 @@ return $ MIPackageItem item' moduleItemMapper (MIPackageItem (DPIExport spec alias kw name)) = return $ MIPackageItem $ DPIExport spec alias kw name - moduleItemMapper (AssertionItem (mx, a)) = do - a' <- traverseAssertionStmtsM stmtMapper a - a'' <- traverseAssertionExprsM exprMapper a' - return $ AssertionItem (mx, a'') + moduleItemMapper (AssertionItem item) = + assertionItemMapper item >>= return . AssertionItem moduleItemMapper (ElabTask severity (Args pnArgs kwArgs)) = do pnArgs' <- mapM exprMapper pnArgs kwArgs' <- fmap (zip kwNames) $ mapM exprMapper kwExprs return $ ElabTask severity $ Args pnArgs' kwArgs' where (kwNames, kwExprs) = unzip kwArgs + assertionItemMapper (MIAssertion mx a) = do + a' <- traverseAssertionStmtsM stmtMapper a + a'' <- traverseAssertionExprsM exprMapper a' + return $ MIAssertion mx a'' + assertionItemMapper (PropertyDecl x p) = + traversePropertySpecExprsM exprMapper p >>= return . PropertyDecl x + assertionItemMapper (SequenceDecl x e) = + traverseSeqExprExprsM exprMapper e >>= return . SequenceDecl x + genItemMapper = traverseGenItemExprsM exprMapper modportDeclMapper (dir, ident, e) = do @@ -736,11 +757,11 @@ traverseModuleItemLHSsM (NInputGate kw d x lhs exprs) = do lhs' <- mapper lhs return $ NInputGate kw d x lhs' exprs - traverseModuleItemLHSsM (AssertionItem (mx, a)) = do + traverseModuleItemLHSsM (AssertionItem (MIAssertion mx a)) = do converted <- traverseNestedStmtsM (traverseStmtLHSsM mapper) (Assertion a) return $ case converted of - Assertion a' -> AssertionItem (mx, a') + Assertion a' -> AssertionItem $ MIAssertion mx a' _ -> error $ "redirected AssertionItem traverse failed: " ++ show converted traverseModuleItemLHSsM (Generate items) = do diff --git a/src/Convert/TypeOf.hs b/src/Convert/TypeOf.hs --- a/src/Convert/TypeOf.hs +++ b/src/Convert/TypeOf.hs @@ -22,6 +22,7 @@ module Convert.TypeOf (convert) where +import Control.Monad.State.Strict import Data.Tuple (swap) import Convert.ExprUtils (dimensionsSize, endianCondRange, simplify) @@ -71,7 +72,8 @@ -- rewrite and store a non-genvar data declaration's type information insertType :: Identifier -> Type -> ST () insertType ident typ = do - typ' <- scopeType typ + -- hack to make this evaluation lazy + typ' <- gets $ evalState $ scopeType typ insertElem ident typ' -- convert TypeOf in a ModuleItem @@ -122,6 +124,11 @@ expr' <- traverseExprM expr size' <- traverseExprM size elaborateSizeCast size' expr' +traverseExprM orig@(Dot (Ident x) f) = do + unneeded <- unneededModuleScope x f + return $ if unneeded + then Ident f + else orig traverseExprM other = traverseSinglyNestedExprsM traverseExprM other >>= traverseExprTypesM traverseTypeM @@ -150,6 +157,21 @@ Just (_, _, typ) -> typ == TypeOf (Ident x) isStringParam _ = return False +-- checks if referring to part.wire is needlessly explicit +unneededModuleScope :: Identifier -> Identifier -> ST Bool +unneededModuleScope part wire = do + accessesLocal <- localAccessesM wire + if accessesLocal == accessesTop then + return True + else if head accessesLocal == head accessesTop then do + details <- lookupElemM wire + return $ case details of + Just (accessesFound, _, _) -> accessesTop == accessesFound + _ -> False + else + return False + where accessesTop = [Access part Nil, Access wire Nil] + -- convert TypeOf in a Type traverseTypeM :: Type -> ST Type traverseTypeM (TypeOf expr) = @@ -192,18 +214,20 @@ typeof (Call (Ident x) args) = typeofCall x args typeof orig@(Bit e _) = do t <- typeof e - let t' = popRange t case t of - TypeOf{} -> lookupTypeOf orig + TypeOf{} -> return $ TypeOf orig Alias{} -> return $ TypeOf orig - _ -> return $ typeSignednessOverride t' Unsigned t' + _ -> do + t' <- popRange orig t + return $ typeSignednessOverride t' Unsigned t' typeof orig@(Range e NonIndexed r) = do t <- typeof e - let t' = replaceRange r t - return $ case t of - TypeOf{} -> TypeOf orig - Alias{} -> TypeOf orig - _ -> typeSignednessOverride t' Unsigned t' + case t of + TypeOf{} -> return $ TypeOf orig + Alias{} -> return $ TypeOf orig + _ -> do + t' <- replaceRange orig r t + return $ typeSignednessOverride t' Unsigned t' typeof (Range expr mode (base, len)) = typeof $ Range expr NonIndexed $ endianCondRange index (base, end) (end, base) @@ -376,23 +400,31 @@ injectRanges t unpacked = UnpackedType t unpacked -- removes the most significant range of the given type -popRange :: Type -> Type -popRange (UnpackedType t [_]) = t -popRange (IntegerAtom TInteger sg) = - IntegerVector TLogic sg [] -popRange t = - tf rs - where (tf, _ : rs) = typeRanges t +popRange :: Expr -> Type -> ST Type +popRange _ (UnpackedType t [_]) = return t +popRange _ (IntegerAtom TInteger sg) = + return $ IntegerVector TLogic sg [] +popRange e t = + case typeRanges t of + (tf, _ : rs) -> return $ tf rs + _ -> indexedAtomError e t -- replaces the most significant range of the given type -replaceRange :: Range -> Type -> Type -replaceRange r (UnpackedType t (_ : rs)) = - UnpackedType t (r : rs) -replaceRange r (IntegerAtom TInteger sg) = - IntegerVector TLogic sg [r] -replaceRange r t = - tf (r : rs) - where (tf, _ : rs) = typeRanges t +replaceRange :: Expr -> Range -> Type -> ST Type +replaceRange _ r (UnpackedType t (_ : rs)) = + return $ UnpackedType t (r : rs) +replaceRange _ r (IntegerAtom TInteger sg) = + return $ IntegerVector TLogic sg [r] +replaceRange e r t = + case typeRanges t of + (tf, _ : rs) -> return $ tf (r : rs) + _ -> indexedAtomError e t + +-- readable error message when looking up the type of a portion of an atom +indexedAtomError :: Expr -> Type -> ST a +indexedAtomError e t = + scopedErrorM $ "can't determine the type of " ++ show e ++ " because the" + ++ " inner type " ++ show t ++ " can't be indexed" -- checks for a cast type which already trivially matches the expression type typeCastUnneeded :: Type -> Type -> Bool diff --git a/src/Job.hs b/src/Job.hs --- a/src/Job.hs +++ b/src/Job.hs @@ -8,6 +8,7 @@ module Job where +import Control.Monad (when) import Data.Char (toLower) import Data.List (isPrefixOf, isSuffixOf) import Data.Version (showVersion) @@ -15,6 +16,7 @@ import qualified Paths_sv2v (version) import System.IO (stderr, hPutStr) import System.Console.CmdArgs +import System.Directory (doesDirectoryExist) import System.Environment (getArgs, withArgs) import System.Exit (exitFailure) @@ -31,11 +33,13 @@ = Stdout | Adjacent | File FilePath + | Directory FilePath deriving (Typeable, Data) data Job = Job { files :: [FilePath] , incdir :: [FilePath] + , libdir :: [FilePath] , define :: [String] , siloed :: Bool , skipPreprocessor :: Bool @@ -44,6 +48,7 @@ , verbose :: Bool , write :: Write , writeRaw :: String + , top :: [String] , oversizedNumbers :: Bool , dumpPrefix :: FilePath } deriving (Typeable, Data) @@ -56,13 +61,17 @@ defaultJob = Job { files = def &= args &= typ "FILES" , incdir = nam_ "I" &= name "incdir" &= typDir - &= help "Add directory to include search path" + &= help "Add a directory to the include search path" &= groupname "Preprocessing" + , libdir = nam_ "y" &= name "libdir" &= typDir + &= help ("Add a directory to the library search path used when looking" + ++ " for undefined modules and interfaces") , define = nam_ "D" &= name "define" &= typ "NAME[=VALUE]" &= help "Define a macro for preprocessing" , siloed = nam_ "siloed" &= help ("Lex input files separately, so" ++ " macros from earlier files are not defined in later files") - , skipPreprocessor = nam_ "skip-preprocessor" &= help "Disable preprocessor" + , skipPreprocessor = nam_ "skip-preprocessor" + &= help "Disable preprocessing of macros, comments, etc." , passThrough = nam_ "pass-through" &= help "Dump input without converting" &= groupname "Conversion" , exclude = nam_ "exclude" &= name "E" &= typ "CONV" @@ -70,10 +79,15 @@ ++ " Logic, or UnbasedUnsized)") , verbose = nam "verbose" &= help "Retain certain conversion artifacts" , write = Stdout &= ignore -- parsed from the flexible flag below - , writeRaw = "s" &= name "write" &= name "w" &= explicit &= typ "MODE/FILE" + , writeRaw = "s" &= name "write" &= name "w" &= explicit + &= typ "MODE/FILE/DIR" &= help ("How to write output; default is 'stdout'; use 'adjacent' to" ++ " create a .v file next to each input; use a path ending in .v" - ++ " to write to a file") + ++ " to write to a file; use a path to an existing directory to" + ++ " create a .v within for each converted module") + , top = def &= name "top" &= explicit &= typ "NAME" + &= help ("Remove uninstantiated modules except the given top module;" + ++ " can be used multiple times") , oversizedNumbers = nam_ "oversized-numbers" &= help ("Disable standard-imposed 32-bit limit on unsized number" ++ " literals (e.g., 'h1_ffff_ffff, 4294967296)") @@ -86,8 +100,8 @@ &= summary ("sv2v " ++ version) &= details [ "sv2v converts SystemVerilog to Verilog." , "More info: https://github.com/zachjs/sv2v" - , "(C) 2019-2022 Zachary Snow, 2011-2015 Tom Hawkins" ] - &= helpArg [explicit, name "help"] + , "(C) 2019-2023 Zachary Snow, 2011-2015 Tom Hawkins" ] + &= helpArg [explicit, name "help", help "Display this help message"] &= versionArg [explicit, name "version"] &= verbosityArgs [ignore] [ignore] where @@ -100,9 +114,13 @@ parseWrite w | w `matches` "adjacent" = return Adjacent parseWrite w | ".v" `isSuffixOf` w = return $ File w parseWrite w | otherwise = do - hPutStr stderr $ "invalid --write " ++ show w - ++ ", expected stdout, adjacent, or a path ending in .v" - exitFailure + isDir <- doesDirectoryExist w + when (not isDir) $ do + hPutStr stderr $ "invalid --write " ++ show w ++ ", expected stdout," + ++ " adjacent, a path ending in .v, or a path to an existing" + ++ " directory" + exitFailure + return $ Directory w matches :: String -> String -> Bool matches = isPrefixOf . map toLower @@ -134,11 +152,16 @@ >>= flagRename "-e" "-E" withArgs strs' $ cmdArgs defaultJob >>= setWrite . setSuccinct - where - setWrite :: Job -> IO Job - setWrite job = do - w <- parseWrite $ writeRaw job - return $ job { write = w } - setSuccinct :: Job -> Job - setSuccinct job | verbose job = job { exclude = Succinct : exclude job } - setSuccinct job | otherwise = job + +setWrite :: Job -> IO Job +setWrite job = do + w <- parseWrite $ writeRaw job + case (w, passThrough job) of + (Directory{}, True) -> do + hPutStr stderr "can't use --pass-through when writing to a dir" + exitFailure + _ -> return $ job { write = w } + +setSuccinct :: Job -> Job +setSuccinct job | verbose job = job { exclude = Succinct : exclude job } +setSuccinct job | otherwise = job diff --git a/src/Language/SystemVerilog/AST/ModuleItem.hs b/src/Language/SystemVerilog/AST/ModuleItem.hs --- a/src/Language/SystemVerilog/AST/ModuleItem.hs +++ b/src/Language/SystemVerilog/AST/ModuleItem.hs @@ -15,6 +15,7 @@ , NOutputGateKW (..) , AssignOption (..) , Severity (..) + , AssertionItem (..) ) where import Data.List (intercalate) @@ -28,7 +29,7 @@ import Language.SystemVerilog.AST.Expr (Expr(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args) import Language.SystemVerilog.AST.GenItem (GenItem) import Language.SystemVerilog.AST.LHS (LHS) -import Language.SystemVerilog.AST.Stmt (Stmt, AssertionItem, Timing(Delay)) +import Language.SystemVerilog.AST.Stmt (Stmt, Assertion, Timing(Delay), PropertySpec, SeqExpr) import Language.SystemVerilog.AST.Type (Identifier, Strength0, Strength1) data ModuleItem @@ -65,10 +66,7 @@ showGate kw d x $ show lhs : map show exprs show (NOutputGate kw d x lhss expr) = showGate kw d x $ (map show lhss) ++ [show expr] - show (AssertionItem (x, a)) = - if null x - then show a - else printf "%s : %s" x (show a) + show (AssertionItem i) = show i show (Instance m params i rs ports) = if null params then printf "%s %s%s%s;" m i rsStr (showPorts ports) @@ -164,3 +162,16 @@ show SeverityWarning = "$warning" show SeverityError = "$error" show SeverityFatal = "$fatal" + +data AssertionItem + = MIAssertion Identifier Assertion + | PropertyDecl Identifier PropertySpec + | SequenceDecl Identifier SeqExpr + deriving Eq + +instance Show AssertionItem where + show (MIAssertion x a) + | null x = show a + | otherwise = printf "%s : %s" x (show a) + show (PropertyDecl x p) = printf "property %s;\n%s\nendproperty" x (indent $ show p) + show (SequenceDecl x e) = printf "sequence %s;\n%s\nendsequence" x (indent $ show e) diff --git a/src/Language/SystemVerilog/AST/Number.hs b/src/Language/SystemVerilog/AST/Number.hs --- a/src/Language/SystemVerilog/AST/Number.hs +++ b/src/Language/SystemVerilog/AST/Number.hs @@ -454,7 +454,7 @@ where size = size1 + size2 signed = False - base = selectBase (min base1 base2) values kinds + base = selectBase (max base1 base2) values kinds trim = flip mod . (2 ^) values = trim size2 values2 + shiftL (trim size1 values1) size2 kinds = trim size2 kinds2 + shiftL (trim size1 kinds1) size2 diff --git a/src/Language/SystemVerilog/AST/Stmt.hs b/src/Language/SystemVerilog/AST/Stmt.hs --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/src/Language/SystemVerilog/AST/Stmt.hs @@ -17,7 +17,6 @@ , PropExpr (..) , SeqMatchItem (..) , SeqExpr (..) - , AssertionItem , Assertion (..) , AssertionKind(..) , Deferral (..) @@ -88,8 +87,9 @@ where aStr = if a == Args [] [] then "" else show a show (Asgn o t v e) = printf "%s %s %s%s;" (show v) (show o) tStr (show e) where tStr = maybe "" showPad t - show (If u c s Null) = printf "%sif (%s)%s" (showPad u) (show c) (showBranch s) - show (If u c s1 s2 ) = printf "%sif (%s)%s\nelse%s" (showPad u) (show c) (showBlockedBranch s1) (showElseBranch s2) + show (If u c s1 s2) = + -- print the then branch inside a block to avoid dangling else issues + printf "%sif (%s)%s%s" (showPad u) (show c) (showBlockedBranch s1) (showElseBranch s2) show (While e s) = printf "while (%s) %s" (show e) (show s) show (RepeatL e s) = printf "repeat (%s) %s" (show e) (show s) show (DoWhile e s) = printf "do %s while (%s);" (show s) (show e) @@ -120,28 +120,32 @@ showBranch block@Block{} = ' ' : show block showBranch stmt = '\n' : (indent $ show stmt) +-- add a block around the true branch of an if statement when a dangling else is +-- possible to avoid any potential ambiguity downstream showBlockedBranch :: Stmt -> String showBlockedBranch stmt = showBranch $ - if isControl stmt + if danglingElse stmt then Block Seq "" [] [stmt] else stmt - where - isControl s = case s of - If{} -> True - For{} -> True - While{} -> True - RepeatL{} -> True - DoWhile{} -> True - Forever{} -> True - Foreach{} -> True - Timing _ subStmt -> isControl subStmt - Block Seq "" [] [CommentStmt{}, subStmt] -> isControl subStmt - _ -> False +danglingElse :: Stmt -> Bool +danglingElse s = case s of + If{} -> True + For _ _ _ subStmt -> danglingElse subStmt + While _ subStmt -> danglingElse subStmt + RepeatL _ subStmt -> danglingElse subStmt + Forever subStmt -> danglingElse subStmt + Foreach _ _ subStmt -> danglingElse subStmt + Timing _ subStmt -> danglingElse subStmt + StmtAttr _ subStmt -> danglingElse subStmt + Block Seq "" [] [CommentStmt{}, subStmt] -> danglingElse subStmt + _ -> False + showElseBranch :: Stmt -> String -showElseBranch stmt@If{} = ' ' : show stmt -showElseBranch stmt = showBranch stmt +showElseBranch Null = "" +showElseBranch stmt@If{} = "\nelse " ++ show stmt +showElseBranch stmt = "\nelse" ++ showBranch stmt showShortBranch :: Stmt -> String showShortBranch stmt@Asgn{} = ' ' : show stmt @@ -265,8 +269,6 @@ showCycleDelayRange (Nil, e) = printf "(%s)" (show e) showCycleDelayRange (e, Nil) = printf "[%s:$]" (show e) showCycleDelayRange r = showRange r - -type AssertionItem = (Identifier, Assertion) data Assertion = Assert AssertionKind ActionBlock diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} {- sv2v - Author: Zachary Snow diff --git a/src/Language/SystemVerilog/Parser.hs b/src/Language/SystemVerilog/Parser.hs --- a/src/Language/SystemVerilog/Parser.hs +++ b/src/Language/SystemVerilog/Parser.hs @@ -3,28 +3,41 @@ - Author: Zachary Snow -} module Language.SystemVerilog.Parser - ( initialEnv - , parseFiles + ( parseFiles , Config(..) ) where import Control.Monad.Except import Data.List (elemIndex) +import Data.Maybe (catMaybes) +import System.Directory (findFile) import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import Language.SystemVerilog.AST (AST) import Language.SystemVerilog.Parser.Lex (lexStr) import Language.SystemVerilog.Parser.Parse (parse) import Language.SystemVerilog.Parser.Preprocess (preprocess, annotate, Env, Contents) +type Output = (FilePath, AST) +type Strings = Set.Set String + data Config = Config - { cfEnv :: Env + { cfDefines :: [String] , cfIncludePaths :: [FilePath] + , cfLibraryPaths :: [FilePath] , cfSiloed :: Bool , cfSkipPreprocessor :: Bool , cfOversizedNumbers :: Bool } +data Context = Context + { ctConfig :: Config + , ctEnv :: Env + , ctUsed :: Strings + , ctHave :: Strings + } + -- parse CLI macro definitions into the internal macro environment format initialEnv :: [String] -> Env initialEnv = Map.map (, []) . Map.fromList . map splitDefine @@ -38,26 +51,58 @@ where (name, rest) = splitAt idx str -- parse a list of files according to the given configuration -parseFiles :: Config -> [FilePath] -> ExceptT String IO [AST] -parseFiles _ [] = return [] -parseFiles config (path : paths) = do - (config', ast) <- parseFile config path - fmap (ast :) $ parseFiles config' paths +parseFiles :: Config -> [FilePath] -> ExceptT String IO [Output] +parseFiles config = parseFiles' context . zip (repeat "") + where + context = Context config env mempty mempty + env = initialEnv $ cfDefines config --- parse an individual file, potentially updating the configuration -parseFile :: Config -> FilePath -> ExceptT String IO (Config, AST) -parseFile config path = do - (config', contents) <- preprocessFile config path +-- parse files, keeping track of which parts are defined and used +parseFiles' :: Context -> [(String, FilePath)] -> ExceptT String IO [Output] + +-- look for missing parts in libraries if any library paths were provided +parseFiles' context [] + | null libdirs = return [] + | otherwise = do + possibleFiles <- catMaybes <$> mapM lookupLibrary missingParts + if null possibleFiles + then return [] + else parseFiles' context possibleFiles + where + missingParts = Set.toList $ ctUsed context Set.\\ ctHave context + libdirs = cfLibraryPaths $ ctConfig context + lookupLibrary partName = ((partName, ) <$>) <$> lookupLibFile partName + lookupLibFile = liftIO . findFile libdirs . (++ ".sv") + +-- load the files, but complain if an expected part is missing +parseFiles' context ((part, path) : files) = do + (context', ast) <- parseFile context path + let misdirected = not $ null part || Set.member part (ctHave context') + when misdirected $ throwError $ + "Expected to find module or interface " ++ show part ++ " in file " + ++ show path ++ " selected from the library path." + ((path, ast) :) <$> parseFiles' context' files + +-- parse an individual file, updating the context +parseFile :: Context -> FilePath -> ExceptT String IO (Context, AST) +parseFile context path = do + (context', contents) <- preprocessFile context path tokens <- liftEither $ runExcept $ lexStr contents - ast <- parse (cfOversizedNumbers config) tokens - return (config', ast) + (ast, used, have) <- parse (cfOversizedNumbers config) tokens + let context'' = context' { ctUsed = used <> ctUsed context + , ctHave = have <> ctHave context } + return (context'', ast) + where config = ctConfig context --- preprocess an individual file, potentially updating the configuration -preprocessFile :: Config -> FilePath -> ExceptT String IO (Config, Contents) -preprocessFile config path | cfSkipPreprocessor config = - fmap (config, ) $ annotate path -preprocessFile config path = do - (env', contents) <- preprocess (cfIncludePaths config) env path - let config' = config { cfEnv = if cfSiloed config then env else env' } - return (config', contents) - where env = cfEnv config +-- preprocess an individual file, potentially updating the environment +preprocessFile :: Context -> FilePath -> ExceptT String IO (Context, Contents) +preprocessFile context path + | cfSkipPreprocessor config = + (context, ) <$> annotate path + | otherwise = do + (env', contents) <- preprocess (cfIncludePaths config) env path + let context' = context { ctEnv = if cfSiloed config then env else env' } + return (context', contents) + where + config = ctConfig context + env = ctEnv context diff --git a/src/Language/SystemVerilog/Parser/Keywords.hs b/src/Language/SystemVerilog/Parser/Keywords.hs --- a/src/Language/SystemVerilog/Parser/Keywords.hs +++ b/src/Language/SystemVerilog/Parser/Keywords.hs @@ -33,12 +33,12 @@ KW_trireg, KW_vectored, KW_wait, KW_wand, KW_weak0, KW_weak1, KW_while, KW_wire, KW_wor, KW_xnor, KW_xor]), - ("1364-2001-noconfig", [KW_cell, KW_config, KW_design, KW_endconfig, - KW_incdir, KW_include, KW_instance, KW_liblist, KW_library, KW_use]), - - ("1364-2001", [KW_automatic, KW_endgenerate, KW_generate, KW_genvar, - KW_localparam, KW_noshowcancelled, KW_pulsestyle_ondetect, + ("1364-2001-noconfig", [KW_automatic, KW_endgenerate, KW_generate, + KW_genvar, KW_localparam, KW_noshowcancelled, KW_pulsestyle_ondetect, KW_pulsestyle_onevent, KW_showcancelled, KW_signed, KW_unsigned]), + + ("1364-2001", [KW_cell, KW_config, KW_design, KW_endconfig, KW_incdir, + KW_include, KW_instance, KW_liblist, KW_library, KW_use]), ("1364-2005", [KW_uwire]), diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -20,6 +20,7 @@ import Control.Monad.State.Strict import Data.Maybe (catMaybes, fromMaybe) import System.IO (hPutStrLn, stderr) +import qualified Data.Set as Set import Language.SystemVerilog.AST import Language.SystemVerilog.Parser.ParseDecl import Language.SystemVerilog.Parser.Tokens @@ -554,7 +555,7 @@ PartHeader :: { [Attr] -> Bool -> PartKW -> [ModuleItem] -> Identifier -> ParseState Description } : Lifetime Identifier PackageImportDeclarations Params PortDecls ";" - { \attrs extern kw items label -> checkTag $2 label $ Part attrs extern kw $1 $2 (fst $5) ($3 ++ $4 ++ (snd $5) ++ items) } + {% recordPartHave $2 >> return \attrs extern kw items label -> checkTag $2 label $ Part attrs extern kw $1 $2 (fst $5) ($3 ++ $4 ++ (snd $5) ++ items) } ModuleKW :: { PartKW } : "module" { Module } @@ -701,7 +702,7 @@ | "generate" GenItems endgenerate { [Generate $2] } NonGenerateModuleItem :: { [ModuleItem] } -- This item covers module instantiations and all declarations - : ModuleDeclTokens(";") { parseDTsAsModuleItems $1 } + : ModuleDeclTokens(";") {% mapM recordPartUsed $ parseDTsAsModuleItems $1 } | ParameterDecl(";") { map (MIPackageItem . Decl) $1 } | "defparam" LHSAsgns ";" { map (uncurry Defparam) $2 } | "assign" AssignOption LHSAsgns ";" { map (uncurry $ Assign $2) $3 } @@ -726,7 +727,15 @@ AssertionItem :: { AssertionItem } : ConcurrentAssertionItem { $1 } | DeferredImmediateAssertionItem { $1 } + | SequenceDecl { $1 } + | PropertyDecl { $1 } +SequenceDecl :: { AssertionItem } + : "sequence" Identifier ";" SeqExpr opt(";") "endsequence" StrTag {% checkTag $2 $7 $ SequenceDecl $2 $4 } + +PropertyDecl :: { AssertionItem } + : "property" Identifier ";" PropertySpec opt(";") "endproperty" StrTag {% checkTag $2 $7 $ PropertyDecl $2 $4 } + -- for Stmt, for now ProceduralAssertionStatement :: { Assertion } : ConcurrentAssertionStatement { $1 } @@ -737,12 +746,12 @@ | DeferredImmediateAssertionStatement { $1 } DeferredImmediateAssertionItem :: { AssertionItem } - : Identifier ":" DeferredImmediateAssertionStatement { ($1, $3) } - | DeferredImmediateAssertionStatement { ("", $1) } + : Identifier ":" DeferredImmediateAssertionStatement { MIAssertion $1 $3 } + | DeferredImmediateAssertionStatement { MIAssertion "" $1 } ConcurrentAssertionItem :: { AssertionItem } - : Identifier ":" ConcurrentAssertionStatement { ($1, $3) } - | ConcurrentAssertionStatement { ("", $1) } + : Identifier ":" ConcurrentAssertionStatement { MIAssertion $1 $3 } + | ConcurrentAssertionStatement { MIAssertion "" $1 } ConcurrentAssertionStatement :: { Assertion } : "assert" "property" "(" PropertySpec ")" ActionBlock { Assert (Concurrent $4) $6 } @@ -820,6 +829,8 @@ | AttributeInstance AttributeInstances { $1 : $2 } AttributeInstance :: { Attr } : AttributeInstanceP { snd $1 } +AttributeInstancesP :: { (Position, [Attr]) } + : AttributeInstanceP AttributeInstances { (fst $1, snd $1 : $2) } AttributeInstanceP :: { (Position, Attr) } : "(*" AttrSpecs "*)" { withPos $1 $ Attr $2 } AttrSpecs :: { [AttrSpec] } @@ -1068,6 +1079,7 @@ OptPortBinding :: { PortBinding } : {- empty -} { ("", Nil) } | PortBinding { $1 } + | AttributeInstancesP PortBinding {% portBindingAttrs $1 >> return $2 } PortBinding :: { PortBinding } : "." Identifier "(" ExprOrNil ")" { ($2, $4) } @@ -1538,25 +1550,29 @@ { pPosition :: Position , pTokens :: [Token] , pOversizedNumbers :: Bool + , pPartsUsed :: Strings + , pPartsHave :: Strings } type ParseState = StateT ParseData (ExceptT String IO) +type Strings = Set.Set String -parse :: Bool -> [Token] -> ExceptT String IO AST -parse _ [] = return [] -parse oversizedNumbers tokens = - evalStateT parseMain initialState +parse :: Bool -> [Token] -> ExceptT String IO (AST, Strings, Strings) +parse _ [] = return mempty +parse oversizedNumbers tokens = do + (ast, finalState) <- runStateT parseMain initialState + return (ast, pPartsUsed finalState, pPartsHave finalState) where position = tokenPosition $ head tokens - initialState = ParseData position tokens oversizedNumbers + initialState = ParseData position tokens oversizedNumbers mempty mempty positionKeep :: (Token -> ParseState a) -> ParseState a positionKeep cont = do - ParseData _ tokens oversizedNumbers <- get + tokens <- gets pTokens case tokens of [] -> cont TokenEOF tok : toks -> do - put $ ParseData (tokenPosition tok) toks oversizedNumbers + modify' $ \s -> s { pPosition = tokenPosition tok, pTokens = toks } cont tok parseErrorTok :: Token -> ParseState a @@ -1661,13 +1677,21 @@ parseErrorM p $ "missing expected `" ++ expected ++ "`" checkPortBindings :: [PortBinding] -> ParseState [PortBinding] -checkPortBindings [] = return [] +-- empty port bindings should stay empty +checkPortBindings [("", Nil)] = return [] +-- drop the trailing comma in named port bindings +checkPortBindings bindings + | (_ : _, _) <- head bindings + , ("", Nil) <- last bindings + = checkPortBindings' $ init bindings +-- a trailing comma is indistinguishable from an explicit unconnected positional +-- binding, so this is passed-through cleanly and resolved downstream checkPortBindings bindings = - checkBindings "port connections" $ - if last bindings == ("", Nil) - then init bindings - else bindings + checkPortBindings' bindings +checkPortBindings' :: [PortBinding] -> ParseState [PortBinding] +checkPortBindings' = checkBindings "port connections" + checkParamBindings :: [ParamBinding] -> ParseState [ParamBinding] checkParamBindings = checkBindings "parameter overrides" @@ -1752,10 +1776,15 @@ readNumber pos str = do oversizedNumbers <- gets pOversizedNumbers let (num, msg) = parseNumber oversizedNumbers str - when (not $ null msg) $ lift $ lift $ - hPutStrLn stderr $ show pos ++ ": Warning: " ++ msg + when (not $ null msg) $ + parseWarning pos msg return num +parseWarning :: Position -> String -> ParseState () +parseWarning pos msg = + lift $ lift $ hPutStrLn stderr $ + show pos ++ ": Warning: " ++ msg + expectZeroDelay :: Token -> a -> ParseState a expectZeroDelay tok a = do num <- readNumber pos str @@ -1812,5 +1841,25 @@ expr' <- makeIncrExprAsgn False (pos, op) expr return $ BinOp op expr' minusOne where minusOne = Number $ Decimal 1 True 1 + +portBindingAttrs :: (Position, [Attr]) -> ParseState () +portBindingAttrs (pos, attrs) = parseWarning pos msg + where msg = "Ignored port connection attributes " + ++ concatMap show attrs ++ "." + +recordPartUsed :: ModuleItem -> ParseState ModuleItem +recordPartUsed item@(Instance partName _ _ _ _) = do + partsUsed <- gets pPartsUsed + when (Set.notMember partName partsUsed) $ do + let partsUsed' = Set.insert partName partsUsed + modify' $ \s -> s { pPartsUsed = partsUsed' } + return item +recordPartUsed item = return item + +recordPartHave :: Identifier -> ParseState () +recordPartHave partName = do + partsHave <- gets pPartsHave + let partsHave' = Set.insert partName partsHave + modify' $ \s -> s { pPartsHave = partsHave' } } diff --git a/src/Language/SystemVerilog/Parser/Preprocess.hs b/src/Language/SystemVerilog/Parser/Preprocess.hs --- a/src/Language/SystemVerilog/Parser/Preprocess.hs +++ b/src/Language/SystemVerilog/Parser/Preprocess.hs @@ -39,12 +39,19 @@ , ppPosition :: Position -- current file position , ppFilePath :: FilePath -- currently active filename , ppEnv :: Env -- active macro definitions - , ppCondStack :: [Cond] -- if-else cascade state + , ppCondStack :: [Level] -- if-else cascade state , ppIncludePaths :: [FilePath] -- folders to search for includes , ppMacroStack :: [[(String, String)]] -- arguments for in-progress macro expansions , ppIncludeStack :: [(FilePath, Env)] -- in-progress includes for loop detection } +-- if-else cascade level state and error information +data Level = Level + { cfDesc :: String -- text of the directive, e.g., "ifdef FOO" + , cfPos :: Position -- location where this level started + , cfCond :: Cond -- whether or not this level is as has been satisfied + } + -- keeps track of the state of an if-else cascade level data Cond = CurrentlyTrue -- an active if/elsif/else branch (condition is met) @@ -86,14 +93,19 @@ , ppMacroStack = [] , ppIncludeStack = [(path, env)] } - finalState <- execStateT preprocessInput initialState - when (not $ null $ ppCondStack finalState) $ - throwError $ path ++ ": unfinished conditional directives: " ++ - (show $ length $ ppCondStack finalState) + finalState <- execStateT (preprocessInput >> checkConds) initialState let env' = ppEnv finalState let output = reverse $ ppOutput finalState return (env', output) +checkConds :: PPS () +checkConds = do + condStack <- getCondStack + when (not $ null condStack) $ do + let level = head condStack + lexicalError $ "unfinished conditional directive `" ++ cfDesc level ++ + " started at " ++ show (cfPos level) + -- position annotator entrypoint used for files that don't need any -- preprocessing annotate :: FilePath -> ExceptT String IO Contents @@ -162,9 +174,9 @@ setEnv :: Env -> PPS () setEnv x = modify $ \s -> s { ppEnv = x } -- cond stack accessors -getCondStack :: PPS [Cond] +getCondStack :: PPS [Level] getCondStack = gets ppCondStack -setCondStack :: [Cond] -> PPS () +setCondStack :: [Level] -> PPS () setCondStack x = modify $ \s -> s { ppCondStack = x } -- macro stack accessors getMacroStack :: PPS [[(String, String)]] @@ -204,11 +216,15 @@ modify $ \s -> s { ppIncludeStack = stack' } -- Push a condition onto the top of the preprocessor condition stack -pushCondStack :: Cond -> PPS () -pushCondStack c = getCondStack >>= setCondStack . (c :) +pushCondStack :: String -> String -> Position -> Cond -> PPS () +pushCondStack typ name pos cond = + getCondStack >>= setCondStack . (level :) + where + level = Level { cfDesc = desc, cfPos = pos, cfCond = cond } + desc = typ ++ if null name then "" else " " ++ name -- Pop the top from the preprocessor condition stack -popCondStack :: String -> PPS Cond +popCondStack :: String -> PPS Level popCondStack directive = do cs <- getCondStack case cs of @@ -545,7 +561,10 @@ macroStack <- getMacroStack case str of '/' : '/' : _ -> removeThrough "\n" - '/' : '*' : _ -> removeThrough "*/" + '/' : '*' : _ -> + -- prevent treating `/*/` as self-closing + takeChar >> takeChar >> + removeThrough "*/" '`' : '"' : _ -> handleBacktickString '"' : _ -> handleString '/' : '`' : '`' : '*' : _ -> @@ -563,7 +582,7 @@ return () '`' : _ -> handleDirective False _ : _ -> do - condStack <- getCondStack + condStack <- map cfCond <$> getCondStack if null macroStack && all (== CurrentlyTrue) condStack then consumeMany else consumeWithSubstitution @@ -724,7 +743,7 @@ pushChars directive directivePos env <- getEnv - condStack <- getCondStack + condStack <- map cfCond <$> getCondStack if any (/= CurrentlyTrue) condStack && not (elem directive unskippableDirectives) then return () @@ -792,19 +811,22 @@ "ifdef" -> do dropSpaces name <- takeIdentifier - pushCondStack $ ifCond $ Map.member name env + pushCondStack "ifdef" name directivePos $ + ifCond $ Map.member name env "ifndef" -> do dropSpaces name <- takeIdentifier - pushCondStack $ ifCond $ Map.notMember name env + pushCondStack "ifndef" name directivePos $ + ifCond $ Map.notMember name env "else" -> do - c <- popCondStack "else" - pushCondStack $ elseCond c + c <- cfCond <$> popCondStack "else" + pushCondStack "else" "" directivePos (elseCond c) "elsif" -> do dropSpaces name <- takeIdentifier - c <- popCondStack "elsif" - pushCondStack $ elsifCond (Map.member name env) c + c <- cfCond <$> popCondStack "elsif" + pushCondStack "elsif" name directivePos $ + elsifCond (Map.member name env) c "endif" -> do _ <- popCondStack "endif" return () @@ -927,7 +949,7 @@ -- adds a character (and its position) to the output state pushChar :: Char -> Position -> PPS () pushChar c p = do - condStack <- getCondStack + condStack <- map cfCond <$> getCondStack when (all (== CurrentlyTrue) condStack) $ do output <- getOutput setOutput $ (c, p) : output diff --git a/src/sv2v.hs b/src/sv2v.hs --- a/src/sv2v.hs +++ b/src/sv2v.hs @@ -6,6 +6,7 @@ import System.IO (hPrint, hPutStrLn, stderr, stdout) import System.Exit (exitFailure, exitSuccess) +import System.FilePath (combine, splitExtension) import Control.Monad (when, zipWithM_) import Control.Monad.Except (runExceptT) @@ -13,7 +14,7 @@ import Convert (convert) import Job (readJob, Job(..), Write(..)) import Language.SystemVerilog.AST -import Language.SystemVerilog.Parser (initialEnv, parseFiles, Config(..)) +import Language.SystemVerilog.Parser (parseFiles, Config(..)) isInterface :: Description -> Bool isInterface (Part _ _ Interface _ _ _ _ ) = True @@ -50,8 +51,19 @@ return $ base ++ ".v" where ext = ".sv" - (base, end) = splitAt (length path - length ext) path + (base, end) = splitExtension path +splitModules :: FilePath -> AST -> [(FilePath, String)] +splitModules dir (PackageItem (Decl CommentDecl{}) : ast) = + splitModules dir ast +splitModules dir (description : ast) = + (path, output) : splitModules dir ast + where + Part _ _ Module _ name _ _ = description + path = combine dir $ name ++ ".v" + output = show description ++ "\n" +splitModules _ [] = [] + writeOutput :: Write -> [FilePath] -> [AST] -> IO () writeOutput _ [] [] = hPutStrLn stderr "Warning: No input files specified (try `sv2v --help`)" @@ -63,14 +75,18 @@ outPaths <- mapM rewritePath inPaths let results = map (++ "\n") $ map show asts zipWithM_ writeFile outPaths results +writeOutput (Directory d) _ asts = do + let (outPaths, outputs) = unzip $ splitModules d $ concat asts + zipWithM_ writeFile outPaths outputs main :: IO () main = do job <- readJob -- parse the input files let config = Config - { cfEnv = initialEnv (define job) + { cfDefines = define job , cfIncludePaths = incdir job + , cfLibraryPaths = libdir job , cfSiloed = siloed job , cfSkipPreprocessor = skipPreprocessor job , cfOversizedNumbers = oversizedNumbers job @@ -80,12 +96,16 @@ Left msg -> do hPutStrLn stderr msg exitFailure - Right asts -> do + Right inputs -> do + let (inPaths, asts) = unzip inputs -- convert the files if requested - asts' <- if passThrough job - then return asts - else convert (dumpPrefix job) (exclude job) asts + let converter = convert (top job) (dumpPrefix job) (exclude job) + asts' <- + if passThrough job then + return asts + else + converter asts emptyWarnings (concat asts) (concat asts') -- write the converted files out - writeOutput (write job) (files job) asts' + writeOutput (write job) inPaths asts' exitSuccess diff --git a/sv2v.cabal b/sv2v.cabal --- a/sv2v.cabal +++ b/sv2v.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: sv2v -version: 0.0.10 +version: 0.0.11 license: BSD-3-Clause license-file: LICENSE NOTICE maintainer: Zachary Snow @@ -87,7 +87,9 @@ Convert.Simplify Convert.Stream Convert.StringParam + Convert.StringType Convert.Struct + Convert.StructConst Convert.TFBlock Convert.Traverse Convert.Typedef @@ -108,13 +110,13 @@ -funbox-strict-fields -Wall build-depends: - array >=0.5.4.0 && <0.6, - base >=4.14.3.0 && <4.15, - cmdargs >=0.10.21 && <0.11, - containers >=0.6.5.1 && <0.7, - directory >=1.3.6.0 && <1.4, - filepath >=1.4.2.1 && <1.5, - githash >=0.1.6.2 && <0.2, - hashable >=1.3.0.0 && <1.4, - mtl >=2.2.2 && <2.3, - vector >=0.12.3.1 && <0.13 + array <0.6, + base <4.15, + cmdargs <0.11, + containers <0.7, + directory <1.4, + filepath <1.5, + githash <0.2, + hashable <1.4, + mtl <2.3, + vector <0.13