sv2v 0.0.10 → 0.0.11
raw patch · 32 files changed
+882/−324 lines, 32 filesdep ~arraydep ~basedep ~cmdargs
Dependency ranges changed: array, base, cmdargs, containers, directory, filepath, githash, hashable, mtl, vector
Files
- CHANGELOG.md +45/−0
- LICENSE +1/−1
- README.md +41/−26
- src/Convert.hs +15/−11
- src/Convert/AlwaysKW.hs +3/−2
- src/Convert/Assertion.hs +5/−5
- src/Convert/Cast.hs +5/−4
- src/Convert/ExprUtils.hs +106/−11
- src/Convert/Interface.hs +35/−12
- src/Convert/Jump.hs +5/−4
- src/Convert/MultiplePacked.hs +8/−1
- src/Convert/ParamNoDefault.hs +17/−6
- src/Convert/ParamType.hs +6/−3
- src/Convert/RemoveComments.hs +3/−1
- src/Convert/ResolveBindings.hs +11/−6
- src/Convert/Simplify.hs +6/−2
- src/Convert/StringType.hs +23/−0
- src/Convert/StructConst.hs +97/−0
- src/Convert/TFBlock.hs +0/−5
- src/Convert/Traverse.hs +90/−69
- src/Convert/TypeOf.hs +56/−24
- src/Job.hs +40/−17
- src/Language/SystemVerilog/AST/ModuleItem.hs +16/−5
- src/Language/SystemVerilog/AST/Number.hs +1/−1
- src/Language/SystemVerilog/AST/Stmt.hs +22/−20
- src/Language/SystemVerilog/AST/Type.hs +0/−1
- src/Language/SystemVerilog/Parser.hs +68/−23
- src/Language/SystemVerilog/Parser/Keywords.hs +5/−5
- src/Language/SystemVerilog/Parser/Parse.y +69/−20
- src/Language/SystemVerilog/Parser/Preprocess.hs +42/−20
- src/sv2v.hs +28/−8
- sv2v.cabal +13/−11
CHANGELOG.md view
@@ -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
LICENSE view
@@ -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.
README.md view
@@ -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.
src/Convert.hs view
@@ -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
src/Convert/AlwaysKW.hs view
@@ -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
src/Convert/Assertion.hs view
@@ -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
src/Convert/Cast.hs view
@@ -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
src/Convert/ExprUtils.hs view
@@ -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)]
src/Convert/Interface.hs view
@@ -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
src/Convert/Jump.hs view
@@ -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"
src/Convert/MultiplePacked.hs view
@@ -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 =
src/Convert/ParamNoDefault.hs view
@@ -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) =
src/Convert/ParamType.hs view
@@ -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
src/Convert/RemoveComments.hs view
@@ -61,4 +61,6 @@ isCommentDecl _ = False convertStmts :: [Stmt] -> [Stmt]-convertStmts = map $ traverseNestedStmts convertStmt+convertStmts =+ filter (/= Null) .+ map (traverseNestedStmts convertStmt)
src/Convert/ResolveBindings.hs view
@@ -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
src/Convert/Simplify.hs view
@@ -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
+ src/Convert/StringType.hs view
@@ -0,0 +1,23 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - 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
+ src/Convert/StructConst.hs view
@@ -0,0 +1,97 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - 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
src/Convert/TFBlock.hs view
@@ -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])
src/Convert/Traverse.hs view
@@ -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
src/Convert/TypeOf.hs view
@@ -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
src/Job.hs view
@@ -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
src/Language/SystemVerilog/AST/ModuleItem.hs view
@@ -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)
src/Language/SystemVerilog/AST/Number.hs view
@@ -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
src/Language/SystemVerilog/AST/Stmt.hs view
@@ -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
src/Language/SystemVerilog/AST/Type.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} {- sv2v - Author: Zachary Snow <zach@zachjs.com>
src/Language/SystemVerilog/Parser.hs view
@@ -3,28 +3,41 @@ - Author: Zachary Snow <zach@zachjs.com> -} 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
src/Language/SystemVerilog/Parser/Keywords.hs view
@@ -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]),
src/Language/SystemVerilog/Parser/Parse.y view
@@ -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' } }
src/Language/SystemVerilog/Parser/Preprocess.hs view
@@ -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
src/sv2v.hs view
@@ -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
sv2v.cabal view
@@ -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 <zach@zachjs.com>@@ -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