packages feed

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 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