packages feed

sv2v 0.0.8 → 0.0.9

raw patch · 44 files changed

+1070/−511 lines, 44 files

Files

CHANGELOG.md view
@@ -1,3 +1,53 @@+## v0.0.9++### Breaking Changes++* Unsized number literals exceeding the maximum width of 32 bits (e.g.,+  `'h1_ffff_ffff`, `4294967296`) are now truncated and produce a warning, rather+  than being silently extended+  * Support for unsized number literals exceeding the standard-imposed 32-bit+    limit can be re-enabled with `--oversized-numbers`+* Input source files are now decoded as UTF-8 on all platforms, with transcoding+  failures tolerated, enabling reading files encoded using other ASCII supersets+  (e.g., Latin-1)++### New Features++* Added support for non-ANSI style port declarations where the port declaration+  is separate from the corresponding net or variable declaration+* Added support for typed value parameters declared in parameter port lists+  without explicitly providing a leading `parameter` or `localparam` marker+* Added support for tasks and functions with implicit port directions+* Added support for parameters which use a type-of as the data type+* Added support for bare delay controls with real number delays+* Added support for deferred immediate assertions++### Other Enhancements++* Explicitly-sized number literals with non-zero bits exceeding the given width+  (e.g., `1'b11`, `3'sd8`, `2'o7`) are now truncated and produce a warning,+  rather than yielding a cryptic error+* Number literals with leading zeroes which extend beyond the width of the+  literal (e.g., `1'b01`, `'h0_FFFF_FFFF`) now produce a warning+* Non-positive integer size casts are now detected and forbidden+* Negative indices in struct pattern literals are now detected and forbidden+* Escaped vendor block comments in macro bodies are now tolerated+* Illegal bit-selects and part-selects of scalar struct fields are now detected+  and forbidden, rather than yielding an internal assertion failure++### Bug Fixes++* Fixed parsing of sized ports with implicit directions+* Fixed flattening of arrays used in nested ternary expressions+* Fixed preprocessing of line comments which are neither preceded nor followed+  by whitespace except for the newline which terminates the comment+* Fixed parsing of alternate spacings of `@(*)`+* Fixed conversion of interface-based typedefs when used with explicit modports,+  unpacked arrays, or in designs with multi-dimensional instances+* Fixed conversion of module-scoped references to modports+* Fixed conversion of references to modports nested within types in expressions+* Fixed assertion removal in verbose mode causing orphaned statements+ ## v0.0.8  Future releases will have complete change logs.
README.md view
@@ -92,8 +92,8 @@      --siloed               Lex input files separately, so macros from                             earlier files are not defined in later files      --skip-preprocessor    Disable preprocessor-     --pass-through         Dump input without converting Conversion:+     --pass-through         Dump input without converting   -E --exclude=CONV         Exclude a particular conversion (always, assert,                             interface, or logic)   -v --verbose              Retain certain conversion artifacts@@ -101,6 +101,10 @@                             'adjacent' to create a .v file next to each input;                             use a path ending in .v to write to a file 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      --version              Print version information      --numeric-version      Print just the version number@@ -110,12 +114,14 @@ ## Supported Features  sv2v supports most synthesizable SystemVerilog features. Current notable-exceptions include `defparam` on interface instances and certain synthesizable-usages of parameterized classes. Assertions are also supported, but are simply-dropped during conversion.+exceptions include `defparam` on interface instances, certain synthesizable+usages of parameterized classes, and the `bind` keyword. Assertions are also+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.+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.++[create an issue]: https://github.com/zachjs/sv2v/issues/new   ## SystemVerilog Front End
src/Convert.hs view
@@ -6,6 +6,8 @@  module Convert (convert) where +import Control.Monad ((>=>))+ import Language.SystemVerilog.AST import qualified Job (Exclude(..)) @@ -36,6 +38,7 @@ import qualified Convert.Package import qualified Convert.ParamNoDefault import qualified Convert.ParamType+import qualified Convert.PortDecl import qualified Convert.RemoveComments import qualified Convert.ResolveBindings import qualified Convert.Simplify@@ -53,6 +56,7 @@ import qualified Convert.Wildcard  type Phase = [AST] -> [AST]+type IOPhase = [AST] -> IO [AST] type Selector = Job.Exclude -> Phase -> Phase  finalPhases :: Selector -> [Phase]@@ -104,27 +108,54 @@     , selectExclude Job.Assert Convert.Assertion.convert     , selectExclude Job.Always Convert.AlwaysKW.convert     , Convert.Package.convert+    , Convert.PortDecl.convert     , Convert.ParamNoDefault.convert     , Convert.ResolveBindings.convert     , Convert.UnnamedGenBlock.convert     ] -convert :: [Job.Exclude] -> Phase-convert excludes =-    final . loopMain . initial+convert :: FilePath -> [Job.Exclude] -> IOPhase+convert 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         combine = foldr1 (.)-        loopMain :: Phase-        loopMain descriptions =-            if descriptions == descriptions'-                then descriptions-                else loopMain descriptions'-            where descriptions' = main descriptions+         selectExclude :: Selector         selectExclude exclude phase =             if elem exclude excludes                 then id                 else phase++        dumper :: String -> IOPhase+        dumper =+            if null dumpPrefix+                then const return+                else fileDumper dumpPrefix++        -- add debug dumping to a phase+        step :: String -> Phase -> IOPhase+        step key = (dumper key .)++        -- add convergence and debug dumping to a phase+        loop :: Int -> String -> Phase -> IOPhase+        loop idx key phase files =+            if files == files'+                then return files+                else dumper key' files' >>= loop (idx + 1) key phase+            where+                files' = phase files+                key' = key ++ "_" ++ show idx++-- pass through dumper which writes ASTs to a file+fileDumper :: String -> String -> IOPhase+fileDumper prefix key files = do+    let path = prefix ++ key ++ ".sv"+    let output = show $ concat files+    writeFile path output+    return files
src/Convert/BlockDecl.hs view
@@ -42,7 +42,7 @@ convertStmt other = other  splitDecl :: Decl -> (Decl, Maybe (LHS, Expr))-splitDecl (decl @ (Variable _ _ _ _ Nil)) =+splitDecl decl@(Variable _ _ _ _ Nil) =     (decl, Nothing) splitDecl (Variable d t ident a e) =     (Variable d t ident a Nil, Just (LHSIdent ident, e))
src/Convert/Cast.hs view
@@ -41,11 +41,10 @@ convert = map $ traverseDescriptions convertDescription  convertDescription :: Description -> Description-convertDescription description =-    traverseModuleItems dropDuplicateCaster $-    partScoper-        traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM-        description+convertDescription =+    traverseModuleItems dropDuplicateCaster . evalScoper . scopePart scoper+    where scoper = scopeModuleItem+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM  type SC = Scoper () @@ -110,12 +109,17 @@     traverseSinglyNestedExprsM traverseExprM other  convertCastM :: Expr -> Expr -> Bool -> SC Expr+convertCastM (Number size) _ _+    | maybeInt == Nothing = illegal "an integer"+    | int <= 0            = illegal "a positive integer"+    where+        maybeInt = numberToInteger size+        Just int = maybeInt+        illegal s = error $ "size cast width " ++ show size ++ " is not " ++ s convertCastM (Number size) (Number value) signed =     return $ Number $-    case numberToInteger size of-        Just size' -> numberCast signed (fromIntegral size') value-        Nothing -> error $ "size cast width " ++ show size-                        ++ " is not an integer"+        numberCast signed (fromIntegral size') value+    where Just size' = numberToInteger size convertCastM size value signed = do     value' <- traverseExprM value     sizeUsesLocalVars <- embedScopes usesLocalVars size@@ -177,11 +181,8 @@     "sv2v_cast_" ++ sizeStr ++ suffix     where         sizeStr = case size of-            Number n ->-                case numberToInteger n of-                    Just v -> show v-                    _ -> error $ "size cast width " ++ show n-                            ++ " is not an integer"+            Number n -> show v+                where Just v = numberToInteger n             _ -> shortHash size         suffix = if signed then "_signed" else "" 
src/Convert/DimensionQuery.hs view
@@ -56,12 +56,12 @@     DimsFn fn $ Left $ TypeOf e convertExpr (DimFn fn (Right e) d) =     DimFn fn (Left $ TypeOf e) d-convertExpr (orig @ (DimsFn FnUnpackedDimensions (Left t))) =+convertExpr orig@(DimsFn FnUnpackedDimensions (Left t)) =     case t of         UnpackedType _ rs -> RawNum $ fromIntegral $ length rs         TypeOf{} -> orig         _ -> RawNum 0-convertExpr (orig @ (DimsFn FnDimensions (Left t))) =+convertExpr orig@(DimsFn FnDimensions (Left t)) =     case t of         IntegerAtom{} -> RawNum 1         Alias{} -> orig
src/Convert/EmptyArgs.hs view
@@ -20,7 +20,7 @@ convert = map $ traverseDescriptions convertDescription  convertDescription :: Description -> Description-convertDescription (description @ Part{}) =+convertDescription description@Part{} =     traverseModuleItems         (traverseExprs $ traverseNestedExprs $ convertExpr functions)         description'
src/Convert/ExprUtils.hs view
@@ -44,9 +44,9 @@     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 [e@Stream{}]) = e+simplifyStep (Concat [e@Concat{}]) = e+simplifyStep (Concat [e@Repeat{}]) = e simplifyStep (Concat es) = Concat $ filter (/= Concat []) es simplifyStep (Repeat (Dec 0) _) = Concat [] simplifyStep (Repeat (Dec 1) es) = Concat es@@ -91,23 +91,23 @@ simplifyBinOp Sub e1 (UniOp UniSub e2) = BinOp Add e1 e2 simplifyBinOp Sub (UniOp UniSub e1) e2 = UniOp UniSub $ BinOp Add e1 e2 -simplifyBinOp Add (BinOp Add e (n1 @ Number{})) (n2 @ Number{}) =+simplifyBinOp Add (BinOp Add e n1@Number{}) n2@Number{} =     BinOp Add e (BinOp Add n1 n2)-simplifyBinOp Sub (n1 @ Number{}) (BinOp Sub (n2 @ Number{}) e) =+simplifyBinOp Sub n1@Number{} (BinOp Sub n2@Number{} e) =     BinOp Add (BinOp Sub n1 n2) e-simplifyBinOp Sub (n1 @ Number{}) (BinOp Sub e (n2 @ Number{})) =+simplifyBinOp Sub n1@Number{} (BinOp Sub e n2@Number{}) =     BinOp Sub (BinOp Add n1 n2) e-simplifyBinOp Sub (BinOp Add e (n1 @ Number{})) (n2 @ Number{}) =+simplifyBinOp Sub (BinOp Add e n1@Number{}) n2@Number{} =     BinOp Add e (BinOp Sub n1 n2)-simplifyBinOp Add (n1 @ Number{}) (BinOp Add (n2 @ Number{}) e) =+simplifyBinOp Add n1@Number{} (BinOp Add n2@Number{} e) =     BinOp Add (BinOp Add n1 n2) e-simplifyBinOp Add (n1 @ Number{}) (BinOp Sub e (n2 @ Number{})) =+simplifyBinOp Add n1@Number{} (BinOp Sub e n2@Number{}) =     BinOp Add e (BinOp Sub n1 n2)-simplifyBinOp Sub (BinOp Sub e (n1 @ Number{})) (n2 @ Number{}) =+simplifyBinOp Sub (BinOp Sub e n1@Number{}) n2@Number{} =     BinOp Sub e (BinOp Add n1 n2)-simplifyBinOp Add (BinOp Sub e (n1 @ Number{})) (n2 @ Number{}) =+simplifyBinOp Add (BinOp Sub e n1@Number{}) n2@Number{} =     BinOp Sub e (BinOp Sub n1 n2)-simplifyBinOp Add (BinOp Sub (n1 @ Number{}) e) (n2 @ Number{}) =+simplifyBinOp Add (BinOp Sub n1@Number{} e) n2@Number{} =     BinOp Sub (BinOp Add n1 n2) e simplifyBinOp Ge (BinOp Sub e (Dec 1)) (Dec 0) = BinOp Ge e (toDec 1) @@ -177,7 +177,7 @@ pattern NegDec n <- UniOp UniSub (Dec n)  pattern Bas :: Integer -> Expr-pattern Bas n <- Number (Based _ _ _ n 0)+pattern Bas n <- Number (Based _ False _ n 0)   -- returns the size of a range
src/Convert/FuncRoutine.hs view
@@ -22,7 +22,7 @@ convert = map $ traverseDescriptions convertDescription  convertDescription :: Description -> Description-convertDescription (description @ Part{}) =+convertDescription description@Part{} =     traverseModuleItems traverseModuleItem description     where         traverseModuleItem =
src/Convert/HierConst.hs view
@@ -37,18 +37,19 @@             then items'             else map expand items'     where-        (items', mapping) = runScoper traverseDeclM+        (items', mapping) = runScoper $ scopeModuleItems scoper name items+        scoper = scopeModuleItem+            traverseDeclM             (traverseExprsM traverseExprM)             (traverseGenItemExprsM traverseExprM)             (traverseStmtExprsM traverseExprM)-            name items         shadowedParams = Map.keys $ Map.filter (fromLeft False) $             extractMapping mapping         expand = traverseNestedModuleItems $ expandParam shadowedParams convertDescription description = description  expandParam :: [Identifier] -> ModuleItem -> ModuleItem-expandParam shadowed (MIPackageItem (Decl (param @ (Param Parameter _ x _)))) =+expandParam shadowed (MIPackageItem (Decl param@(Param Parameter _ x _))) =     if elem x shadowed         then Generate $ map (GenModuleItem . wrap) [param, extra]         else wrap param@@ -82,14 +83,14 @@  -- substitute hierarchical references to constants traverseExprM :: Expr -> ST Expr-traverseExprM (expr @ (Dot _ x)) = do+traverseExprM expr@(Dot _ x) = do     expr' <- traverseSinglyNestedExprsM traverseExprM expr     detailsE <- lookupElemM expr'     detailsX <- lookupElemM x     case (detailsE, detailsX) of         (Just ([_, _], _, Left{}), Just ([_, _], _, Left{})) ->             return $ Ident x-        (Just (accesses @ [Access _ Nil, _], _, Left False), _) -> do+        (Just (accesses@[Access _ Nil, _], _, Left False), _) -> do             details <- lookupElemM $ prefix x             when (details == Nothing) $                 insertElem accesses (Left True)
src/Convert/ImplicitNet.hs view
@@ -49,20 +49,20 @@ traverseModuleItemM :: DefaultNetType -> ModuleItem -> Scoper () ModuleItem traverseModuleItemM _ (Genvar x) =     insertElem x () >> return (Genvar x)-traverseModuleItemM defaultNetType (orig @ (Assign _ x _)) = do+traverseModuleItemM defaultNetType orig@(Assign _ x _) = do     needsLHS defaultNetType x     return orig-traverseModuleItemM defaultNetType (orig @ (NInputGate _ _ x lhs exprs)) = do+traverseModuleItemM defaultNetType orig@(NInputGate _ _ x lhs exprs) = do     insertElem x ()     needsLHS defaultNetType lhs     _ <- mapM (needsExpr defaultNetType) exprs     return orig-traverseModuleItemM defaultNetType (orig @ (NOutputGate _ _ x lhss expr)) = do+traverseModuleItemM defaultNetType orig@(NOutputGate _ _ x lhss expr) = do     insertElem x ()     _ <- mapM (needsLHS defaultNetType) lhss     needsExpr defaultNetType expr     return orig-traverseModuleItemM defaultNetType (orig @ (Instance _ _ x _ ports)) = do+traverseModuleItemM defaultNetType orig@(Instance _ _ x _ ports) = do     insertElem x ()     _ <- mapM (needsExpr defaultNetType . snd) ports     return orig
src/Convert/Interface.hs view
@@ -63,11 +63,8 @@         PackageItem $ Decl $ CommentDecl $             "removed module with interface ports: " ++ name     where-        items' = evalScoper-            traverseDeclM traverseModuleItemM return return name items--        convertNested =-            scopeModuleItemT traverseDeclM traverseModuleItemM return return+        items' = evalScoper $ scopeModuleItems scoper name items+        scoper = scopeModuleItem traverseDeclM traverseModuleItemM return return          traverseDeclM :: Decl -> Scoper [ModportDecl] Decl         traverseDeclM decl = do@@ -88,13 +85,13 @@         traverseModuleItemM :: ModuleItem -> Scoper [ModportDecl] ModuleItem         traverseModuleItemM (Modport modportName modportDecls) =             insertElem modportName modportDecls >> return (Generate [])-        traverseModuleItemM (instanceItem @ Instance{}) = do+        traverseModuleItemM instanceItem@Instance{} = do             modports <- embedScopes (\l () -> l) ()             if isNothing maybePartInfo then                 return instanceItem             else if partKind == Interface then                 -- inline instantiation of an interface-                convertNested $ Generate $ map GenModuleItem $+                scoper $ Generate $ map GenModuleItem $                     inlineInstance modports rs []                     partItems part instanceName paramBindings portBindings             else if null modportInstances then@@ -108,7 +105,7 @@                             ++ " has interface ports "                             ++ showKeys modportInstances ++ ", but only "                             ++ showKeys modportBindings ++ " are connected"-                    else convertNested $ Generate $ map GenModuleItem $+                    else scoper $ Generate $ map GenModuleItem $                             inlineInstance modports rs modportBindings partItems                             part instanceName paramBindings portBindings             where@@ -129,7 +126,7 @@          -- add explicit slices for bindings of entire modport instance arrays         addImpliedSlice :: Scopes [ModportDecl] -> Expr -> Expr-        addImpliedSlice modports (orig @ (Dot expr modportName)) =+        addImpliedSlice modports orig@(Dot expr modportName) =             case lookupIntfElem modports (InstArrKey expr) of                 Just (_, _, InstArrVal l r) ->                     Dot (Range expr NonIndexed (l, r)) modportName@@ -338,12 +335,13 @@     wrapInstance instanceName items'     : portBindings     where-        items' = evalScoper traverseDeclM traverseModuleItemM traverseGenItemM-            traverseStmtM partName $+        items' = evalScoper $ scopeModuleItems scoper partName $             map (traverseNestedModuleItems rewriteItem) $             if null modportBindings                 then items ++ [typeModport, dimensionModport, bundleModport]                 else items+        scoper = scopeModuleItem+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM          key = shortHash (partName, instanceName) @@ -427,10 +425,13 @@             embedScopes tagLHS >=>             embedScopes replaceLHS         tagLHS :: Scopes () -> LHS -> LHS-        tagLHS scopes lhs =-            if lookupElem scopes lhs /= Nothing-                then LHSDot (renamePartLHS lhs) "@"-                else traverseSinglyNestedLHSs (tagLHS scopes) lhs+        tagLHS scopes lhs+            | lookupElem scopes lhs /= Nothing =+                LHSDot (renamePartLHS lhs) "@"+            | Just portName <- partScopedModportRef $ lhsToExpr lhs =+                LHSIdent portName+            | otherwise =+                traverseSinglyNestedLHSs (tagLHS scopes) lhs         renamePartLHS :: LHS -> LHS         renamePartLHS (LHSDot (LHSIdent x) y) =             if x == partName@@ -457,16 +458,19 @@             embedScopes tagExpr >=>             embedScopes replaceExpr         tagExpr :: Scopes () -> Expr -> Expr-        tagExpr scopes expr =-            if lookupElem scopes expr /= Nothing-                then Dot (renamePartExpr expr) "@"-                else traverseSinglyNestedExprs (tagExpr scopes) expr+        tagExpr scopes expr+            | lookupElem scopes expr /= Nothing =+                Dot (renamePartExpr expr) "@"+            | Just portName <- partScopedModportRef expr =+                Ident portName+            | otherwise =+                visitExprsStep (tagExpr scopes) expr         renamePartExpr :: Expr -> Expr         renamePartExpr (Dot (Ident x) y) =             if x == partName                 then Dot scopedInstanceExpr y                 else Dot (Ident x) y-        renamePartExpr expr = traverseSinglyNestedExprs renamePartExpr expr+        renamePartExpr expr = visitExprsStep renamePartExpr expr         replaceExpr :: Scopes () -> Expr -> Expr         replaceExpr _ (Dot expr "@") = expr         replaceExpr local (Ident x) =@@ -485,11 +489,11 @@             case lookup (Bit expr Tag) exprReplacements of                 Just resolved -> replaceArrTag (replaceExpr' local elt) resolved                 Nothing -> Bit (replaceExpr' local expr) (replaceExpr' local elt)-        replaceExpr' local (expr @ (Dot Ident{} _)) =+        replaceExpr' local expr@(Dot Ident{} _) =             case lookup expr exprReplacements of                 Just expr' -> expr'                 Nothing -> checkExprResolution local expr $-                    traverseSinglyNestedExprs (replaceExprAny local) expr+                    visitExprsStep (replaceExprAny local) expr         replaceExpr' local (Ident x) =             checkExprResolution local (Ident x) (Ident x)         replaceExpr' local expr = replaceExprAny local expr@@ -498,12 +502,25 @@             case lookup expr exprReplacements of                 Just expr' -> expr'                 Nothing -> checkExprResolution local expr $-                    traverseSinglyNestedExprs (replaceExpr' local) expr+                    visitExprsStep (replaceExpr' local) expr         replaceArrTag :: Expr -> Expr -> Expr         replaceArrTag replacement Tag = replacement         replaceArrTag replacement expr =-            traverseSinglyNestedExprs (replaceArrTag replacement) expr+            visitExprsStep (replaceArrTag replacement) expr +        partScopedModportRef :: Expr -> Maybe Identifier+        partScopedModportRef (Dot (Ident x) y) =+            if x == partName && lookup y modportBindings /= Nothing+                then Just y+                else Nothing+        partScopedModportRef _ = Nothing++        visitExprsStep :: (Expr -> Expr) -> Expr -> Expr+        visitExprsStep exprMapper =+            traverseSinglyNestedExprs exprMapper+            . traverseExprTypes (traverseNestedTypes typeMapper)+            where typeMapper = traverseTypeExprs exprMapper+         checkExprResolution :: Scopes () -> Expr -> a -> a         checkExprResolution local expr =             if not (exprResolves local expr) && exprResolves global expr@@ -555,7 +572,7 @@                     Implicit Unspecified rs ->                         IntegerVector TLogic Unspecified rs                     _ -> t-        removeDeclDir decl @ Net{} =+        removeDeclDir decl@Net{} =             traverseNetAsVar removeDeclDir decl         removeDeclDir other = other @@ -589,18 +606,15 @@          overrideParam :: Decl -> Decl         overrideParam (Param Parameter t x e) =+            Param Localparam t x $             case lookup x instanceParams of-                Nothing -> Param Localparam t x e-                Just (Right _) -> Param Localparam t x (Ident $ paramTmp ++ x)-                Just (Left t') -> error $ inlineKind ++ " param " ++ x-                        ++ " expected expr, found type: " ++ show t'+                Nothing -> e+                Just _  -> Ident $ paramTmp ++ x         overrideParam (ParamType Parameter x t) =+            ParamType Localparam x $             case lookup x instanceParams of-                Nothing -> ParamType Localparam x t-                Just (Left _) ->-                    ParamType Localparam x $ Alias (paramTmp ++ x) []-                Just (Right e') -> error $ inlineKind ++ " param " ++ x-                        ++ " expected type, found expr: " ++ show e'+                Nothing -> t+                Just _  -> Alias (paramTmp ++ x) []         overrideParam other = other          portBindingItem :: PortBinding -> ModuleItem@@ -620,7 +634,7 @@         collectDeclDir (Variable dir _ ident _ _) =             when (dir /= Local) $                 tell $ Map.singleton ident dir-        collectDeclDir net @ Net{} =+        collectDeclDir net@Net{} =             collectNetAsVarM collectDeclDir net         collectDeclDir _ = return ()         findDeclDir :: Identifier -> Direction@@ -641,7 +655,7 @@         loopVar = "_arr_" ++ key          isArray = not $ null ranges-        [arrayRange @ (arrayLeft, arrayRight)] = ranges+        [arrayRange@(arrayLeft, arrayRight)] = ranges          -- wrap the given item in a generate loop if necessary         wrapInstance :: Identifier -> [ModuleItem] -> ModuleItem
src/Convert/Jump.hs view
@@ -105,7 +105,7 @@     where (decls, [stmt']) = addJumpStateDeclTF [] [stmt]  removeJumpState :: Stmt -> Stmt-removeJumpState (orig @ (Asgn _ _ (LHSIdent ident) _)) =+removeJumpState orig@(Asgn _ _ (LHSIdent ident) _) =     if ident == jumpState         then Null         else orig
src/Convert/KWArgs.hs view
@@ -55,7 +55,7 @@ convertStmt _ other = other  convertInvoke :: TFs -> (Expr -> Args -> a) -> Expr -> Args -> a-convertInvoke tfs constructor (Ident func) (Args pnArgs (kwArgs @ (_ : _))) =+convertInvoke tfs constructor (Ident func) (Args pnArgs kwArgs@(_ : _)) =     case tfs Map.!? func of         Nothing -> constructor (Ident func) (Args pnArgs kwArgs)         Just ordered -> constructor (Ident func) (Args args [])
src/Convert/Logic.hs view
@@ -64,15 +64,15 @@         collectDeclDirsM _ = return ()  convertDescription :: Ports -> Description -> Description-convertDescription ports description@(Part _ _ Module _ _ _ _) =-    -- rewrite reg continuous assignments and output port connections-    partScoper (rewriteDeclM locations) (traverseModuleItemM ports)-        return return description+convertDescription ports description =+    evalScoper $ scopeModule conScoper description     where+        locations = execWriter $ evalScoperT $ scopePart locScoper description         -- write down which vars are procedurally assigned-        locations = execWriter $ partScoperT-            traverseDeclM return return traverseStmtM description-convertDescription _ other = other+        locScoper = scopeModuleItem traverseDeclM return return traverseStmtM+        -- rewrite reg continuous assignments and output port connections+        conScoper = scopeModuleItem+            (rewriteDeclM locations) (traverseModuleItemM ports) return return  traverseModuleItemM :: Ports -> ModuleItem -> Scoper Type ModuleItem traverseModuleItemM ports = embedScopes $ traverseModuleItem ports
src/Convert/MultiplePacked.hs view
@@ -42,7 +42,7 @@ convert = map $ traverseDescriptions convertDescription  convertDescription :: Description -> Description-convertDescription (description @ (Part _ _ Module _ _ _ _)) =+convertDescription description@(Part _ _ Module _ _ _ _) =     partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM     description convertDescription other = other@@ -52,7 +52,7 @@ traverseDeclM (Variable dir t ident a e) = do     t' <- traverseTypeM t a ident     traverseDeclExprsM traverseExprM $ Variable dir t' ident a e-traverseDeclM net @ Net{} =+traverseDeclM net@Net{} =     traverseNetAsVarM traverseDeclM net traverseDeclM (Param s t ident e) = do     t' <- traverseTypeM t [] ident@@ -233,7 +233,7 @@             if head x == tag                 then Ident $ tail x                 else Ident x-        rewriteExpr (orig @ (Bit (Bit expr idxInner) idxOuter)) =+        rewriteExpr orig@(Bit (Bit expr idxInner) idxOuter) =             if isJust maybeDims && expr == rewriteExpr expr                 then Bit expr' idx'                 else rewriteExprLowPrec orig@@ -244,7 +244,7 @@                 idxOuter' = orientIdx dimOuter idxOuter                 base = BinOp Mul idxInner' (rangeSize dimOuter)                 idx' = simplify $ BinOp Add base idxOuter'-        rewriteExpr (orig @ (Range (Bit expr idxInner) NonIndexed rangeOuter)) =+        rewriteExpr orig@(Range (Bit expr idxInner) NonIndexed rangeOuter) =             if isJust maybeDims && expr == rewriteExpr expr                 then rewriteExpr $ Range exprOuter IndexedMinus range                 else rewriteExprLowPrec orig@@ -256,7 +256,7 @@                 base = endianCondExpr rangeOuter baseDec baseInc                 len = rangeSize rangeOuter                 range = (base, len)-        rewriteExpr (orig @ (Range (Bit expr idxInner) modeOuter rangeOuter)) =+        rewriteExpr orig@(Range (Bit expr idxInner) modeOuter rangeOuter) =             if isJust maybeDims && expr == rewriteExpr expr                 then Range expr' modeOuter range'                 else rewriteExprLowPrec orig@@ -279,7 +279,7 @@             rewriteExprLowPrec other          rewriteExprLowPrec :: Expr -> Expr-        rewriteExprLowPrec (orig @ (Bit expr idx)) =+        rewriteExprLowPrec orig@(Bit expr idx) =             if isJust maybeDims && expr == rewriteExpr expr                 then Range expr' mode' range'                 else orig@@ -291,7 +291,7 @@                 len = rangeSize dimOuter                 base = BinOp Add (endianCondExpr dimOuter (snd dimOuter) (fst dimOuter)) (BinOp Mul idx' len)                 range' = (simplify base, simplify len)-        rewriteExprLowPrec (orig @ (Range expr NonIndexed range)) =+        rewriteExprLowPrec orig@(Range expr NonIndexed range) =             if isJust maybeDims && expr == rewriteExpr expr                 then rewriteExpr $ Range expr IndexedMinus range'                 else orig@@ -302,7 +302,7 @@                 base = endianCondExpr range baseDec baseInc                 len = rangeSize range                 range' = (base, len)-        rewriteExprLowPrec (orig @ (Range expr mode range)) =+        rewriteExprLowPrec orig@(Range expr mode range) =             if isJust maybeDims && expr == rewriteExpr expr                 then Range expr' mode' range'                 else orig
src/Convert/Package.hs view
@@ -31,7 +31,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set -import Convert.ResolveBindings (exprToType, resolveBindings)+import Convert.ResolveBindings (resolveBindings) import Convert.Scoper import Convert.Traverse import Language.SystemVerilog.AST@@ -87,8 +87,8 @@     tell (Map.empty, Map.singleton name (decls, map unpackClassItem items), [])     where         unpackClassItem :: ClassItem -> PackageItem-        unpackClassItem (item @ (_, Task{})) = checkTF item-        unpackClassItem (item @ (_, Function{})) = checkTF item+        unpackClassItem item@(_, Task{}) = checkTF item+        unpackClassItem item@(_, Function{}) = checkTF item         unpackClassItem item = checkNonTF item         checkTF :: ClassItem -> PackageItem         checkTF (QStatic, item) = item@@ -226,8 +226,7 @@ processItems :: Identifier -> Identifier -> [ModuleItem]     -> PackagesState (IdentStateMap, [ModuleItem]) processItems topName packageName moduleItems = do-    (moduleItems', scopes) <- runScoperT-        traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+    (moduleItems', scopes) <- runScoperT $ scopeModuleItems scoper         topName (reorderItems moduleItems)     let rawIdents = extractMapping scopes     externalIdentMaps <- mapM (resolveExportMI rawIdents) moduleItems@@ -239,10 +238,13 @@                     else exports     seq exports return (exports', moduleItems')     where+        scoper = scopeModuleItem+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+         -- produces partial mappings of exported identifiers, while also         -- checking the validity of the exports         resolveExportMI :: IdentStateMap -> ModuleItem -> PackagesState IdentStateMap-        resolveExportMI mapping (MIPackageItem (item @ (Export pkg ident))) =+        resolveExportMI mapping (MIPackageItem item@(Export pkg ident)) =             if null packageName                 then error $ "invalid " ++ (init $ show item)                         ++ " outside of package"@@ -304,12 +306,12 @@                         ++ intercalate ", " rootPkgs          traversePackageItemM :: PackageItem -> Scope PackageItem-        traversePackageItemM (orig @ (Import pkg ident)) = do+        traversePackageItemM orig@(Import pkg ident) = do             if null ident                 then wildcardImports pkg                 else explicitImport pkg ident             return $ Decl $ CommentDecl $ "removed " ++ show orig-        traversePackageItemM (orig @ (Export pkg ident)) = do+        traversePackageItemM orig@(Export pkg ident) = do             () <- when (not (null pkg || null ident)) $ do                 localName <- resolveIdent ident                 rootPkg <- lift $ resolveRootPackage pkg ident@@ -459,7 +461,7 @@     assertMsg (not $ elem packageName stack) $         "package dependency loop: " ++ show first ++ " depends on "             ++ intercalate ", which depends on " (map show rest)-    let Just (package @ (exports, _))= maybePackage+    let Just package@(exports, _) = maybePackage     if Map.null exports         then do             -- process and resolve this package@@ -613,7 +615,7 @@  -- nests packages items missing from modules convertDescription :: PIs -> Description -> Description-convertDescription pis (orig @ Part{}) =+convertDescription pis orig@Part{} =     if Map.null pis         then orig         else Part attrs extern kw lifetime name ports items'@@ -677,9 +679,9 @@ addUsedPIs item =     (item, usedPIs)     where-        usedPIs = execWriter $ evalScoperT-            writeDeclIdents writeModuleItemIdents writeGenItemIdents writeStmtIdents-            "" [item]+        usedPIs = execWriter $ evalScoperT $ scoper item+        scoper = scopeModuleItem writeDeclIdents writeModuleItemIdents+            writeGenItemIdents writeStmtIdents  type IdentWriter = ScoperT () (Writer Idents) 
src/Convert/ParamNoDefault.hs view
@@ -65,7 +65,7 @@  -- check for instances missing values for parameters without defaults traverseModuleItem :: Parts -> ModuleItem -> ModuleItem-traverseModuleItem parts (orig @ (Instance part params name _ _)) =+traverseModuleItem parts orig@(Instance part params name _ _) =     if maybePartInfo == Nothing || null missingParams         then orig         else error $ "instance " ++ show name ++ " of " ++ show part
src/Convert/ParamType.hs view
@@ -39,7 +39,7 @@         -- add type parameter instantiations         files'' = map (concatMap explodeDescription) files'         explodeDescription :: Description -> [Description]-        explodeDescription (part @ (Part _ _ _ _ name _ _)) =+        explodeDescription part@(Part _ _ _ _ name _ _) =             (part :) $             filter (not . alreadyExists) $             map (rewriteModule part) theseInstances@@ -57,7 +57,7 @@             both (Map.fromListWith Set.union) $             execWriter $ mapM (mapM collectUsageM) files''         collectUsageM :: Description -> Writer (UsageMap, UsageMap) ()-        collectUsageM (part @ (Part _ _ _ _ name _ _)) =+        collectUsageM part@(Part _ _ _ _ name _ _) =             tell $ both makeList $ execWriter $                 (collectModuleItemsM collectModuleItemM) part             where makeList s = zip (Set.toList s) (repeat $ Set.singleton name)@@ -93,7 +93,7 @@          -- instantiate the type parameters if this is a used default instance         reduceTypeDefaults :: Description -> Description-        reduceTypeDefaults (part @ (Part _ _ _ _ name _ _)) =+        reduceTypeDefaults part@(Part _ _ _ _ name _ _) =             if shouldntReduce                 then part                 else traverseModuleItems (traverseDecls rewriteDecl) part@@ -149,7 +149,7 @@                 additionalParamItems = concatMap makeAddedParams $                     Map.toList $ Map.map snd inst                 rewriteExpr :: Expr -> Expr-                rewriteExpr (orig @ (Dot (Ident x) y)) =+                rewriteExpr orig@(Dot (Ident x) y) =                     if x == m                         then Dot (Ident m') y                         else orig@@ -157,7 +157,7 @@                     traverseExprTypes rewriteType $                     traverseSinglyNestedExprs rewriteExpr other                 rewriteLHS :: LHS -> LHS-                rewriteLHS (orig @ (LHSDot (LHSIdent x) y)) =+                rewriteLHS orig@(LHSDot (LHSIdent x) y) =                     if x == m                         then LHSDot (LHSIdent m') y                         else orig@@ -192,7 +192,7 @@  -- write down module parameter names and type parameters collectDescriptionM :: Description -> Writer Modules ()-collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =+collectDescriptionM part@(Part _ _ _ _ name _ _) =     tell $ Map.singleton name typeMap     where         typeMap = Map.fromList $ execWriter $@@ -250,7 +250,7 @@         (traverseTypeExprsM $ traverseNestedExprsM prepareExpr)     where         prepareExpr :: Expr -> Writer (IdentSet, DeclMap) Expr-        prepareExpr (e @ Call{}) = do+        prepareExpr e@Call{} = do             tell (Set.empty, Map.singleton x decl)             prepareExpr $ Ident x             where@@ -281,7 +281,7 @@  -- attempt to rewrite instantiations with type parameters convertModuleItemM :: ModuleItem -> Writer Instances ModuleItem-convertModuleItemM (orig @ (Instance m bindings x r p)) =+convertModuleItemM orig@(Instance m bindings x r p) =     if hasOnlyExprs then         return orig     else if not hasUnresolvedTypes then do
+ src/Convert/PortDecl.hs view
@@ -0,0 +1,149 @@+{- sv2v+ - Author: Zachary Snow <zach@zachjs.com>+ -+ - Conversion for checking and standardizing port declarations+ -+ - Non-ANSI style port declarations can be split into two separate declarations.+ - Section 23.2.2.1 of IEEE 1800-2017 defines rules for determining the+ - resulting details of such declarations. This conversion is part of the+ - initial phases to avoid requiring that downstream conversions handle these+ - unusual otherwise conflicting declarations.+ -+ - To avoid creating spurious conflicts for redeclared ports, this conversion is+ - also responsible for defaulting variable ports to `logic`.+ -}++module Convert.PortDecl (convert) where++import Data.List (intercalate, (\\))+import Data.Maybe (mapMaybe)++import Convert.Traverse+import Language.SystemVerilog.AST++convert :: [AST] -> [AST]+convert = map $ traverseDescriptions traverseDescription++traverseDescription :: Description -> Description+traverseDescription (Part attrs extern kw liftetime name ports items) =+    Part attrs extern kw liftetime name ports items'+    where items' = convertPorts name ports items+traverseDescription (PackageItem item) =+    PackageItem $ convertPackageItem item+traverseDescription other = other++convertPackageItem :: PackageItem -> PackageItem+convertPackageItem (Function l t x decls stmts) =+   Function l t x (convertTFDecls decls) stmts+convertPackageItem (Task l x decls stmts) =+   Task l x (convertTFDecls decls) stmts+convertPackageItem other = other++convertPorts :: Identifier -> [Identifier] -> [ModuleItem] -> [ModuleItem]+convertPorts name ports items+    | not (null name) && not (null extraPorts) =+        error $ "declared ports " ++ intercalate ", " extraPorts+            ++ " are not in the port list of " ++ name+    | otherwise =+        map traverseItem items+    where+        portDecls = mapMaybe (findDecl True ) items+        dataDecls = mapMaybe (findDecl False) items+        extraPorts = map fst portDecls \\ ports++        -- rewrite a declaration if necessary+        traverseItem :: ModuleItem -> ModuleItem+        traverseItem (MIPackageItem (Decl decl))+            | Variable d _ x _ e <- decl = rewrite decl (combineIdent x) d x e+            | Net  d _ _ _ x _ e <- decl = rewrite decl (combineIdent x) d x e+            | otherwise = MIPackageItem $ Decl decl+        traverseItem (MIPackageItem item) =+            MIPackageItem $ convertPackageItem item+        traverseItem other = other++        -- produce the combined declaration for a port, if it has one+        combineIdent :: Identifier -> Maybe Decl+        combineIdent x = do+            portDecl <- lookup x portDecls+            dataDecl <- lookup x dataDecls+            Just $ combineDecls portDecl dataDecl++-- wrapper for convertPorts enabling its application to task or function decls+convertTFDecls :: [Decl] -> [Decl]+convertTFDecls =+    map unwrap . convertPorts "" [] . map wrap+    where+        wrap :: Decl -> ModuleItem+        wrap = MIPackageItem . Decl+        unwrap :: ModuleItem -> Decl+        unwrap item = decl+            where MIPackageItem (Decl decl) = item++-- given helpfully extracted information, update the given declaration+rewrite :: Decl -> Maybe Decl -> Direction -> Identifier -> Expr -> ModuleItem+-- implicitly-typed output ports default to `logic` in SystemVerilog+rewrite (Variable Output (Implicit sg rs) x a e) Nothing _ _ _ =+    MIPackageItem $ Decl $ Variable Output (IntegerVector TLogic sg rs) x a e+-- not a relevant port declaration+rewrite decl Nothing _ _ _ =+    MIPackageItem $ Decl decl+-- turn the non-ANSI style port and data declarations into fully-specified ports+-- and optional continuous assignments, respectively+rewrite _ (Just combined) d x e+    | d /= Local =+        MIPackageItem $ Decl combined+    | e /= Nil =+        Assign AssignOptionNone (LHSIdent x) e+    | otherwise =+        MIPackageItem $ Decl $ CommentDecl $ "combined with " ++ x++-- combine the two declarations defining a non-ANSI style port+combineDecls :: Decl -> Decl -> Decl+combineDecls portDecl dataDecl+    | eP /= Nil =+        mismatch "invalid initialization at port declaration"+    | aP /= aD =+        mismatch "different unpacked dimensions"+    | rsP /= rsD =+        mismatch "different packed dimensions"+    | otherwise =+        base (tf rsD) ident aD Nil+    where++        -- signed if *either* declaration is marked signed+        sg = if sgP == Signed || sgD == Signed+            then Signed+            else Unspecified++        -- the port cannot have a variable or net type+        Implicit sgP rsP = case tP of+            Implicit{} -> tP+            _ -> mismatch "redeclaration"++        -- pull out the base type, signedness, and packed dimensions+        (tf, sgD, rsD) = case tD of+            Implicit        s r -> (IntegerVector TLogic sg, s, r )+            IntegerVector k s r -> (IntegerVector k      sg, s, r )+            IntegerAtom   k s   -> (\[] -> IntegerAtom k s , s, [])+            -- TODO: other basic types may be worth supporting here+            _ -> mismatch "non-ANSI port declaration with unsupported data type"++        -- extract the core components of each declaration+        Variable dir tP ident aP eP = portDecl+        (base, tD, aD) = case dataDecl of+            Variable Local t _ a _ -> (Variable dir, t, a)+            Net  Local n s t _ a _ -> (Net  dir n s, t, a)+            _ -> undefined -- not possible given findDecl++        -- helpful error message utility+        mismatch :: String -> a+        mismatch msg = error $ "declarations `" ++ p portDecl ++ "` and `"+            ++ p dataDecl ++ "` are incompatible due to " ++ msg+            where p = init . show++-- used to build independent lists of port and data declarations+findDecl :: Bool -> ModuleItem -> Maybe (Identifier, Decl)+findDecl isPort (MIPackageItem (Decl decl))+    | Variable d _ x _ _ <- decl, (d /= Local) == isPort = Just (x, decl)+    | Net  d _ _ _ x _ _ <- decl, (d /= Local) == isPort = Just (x, decl)+findDecl _ _ = Nothing
src/Convert/ResolveBindings.hs view
@@ -12,7 +12,6 @@  module Convert.ResolveBindings     ( convert-    , exprToType     , resolveBindings     ) where @@ -20,7 +19,6 @@ import Data.List (intercalate, (\\)) import qualified Data.Map.Strict as Map -import Convert.ExprUtils (simplify) import Convert.Traverse import Language.SystemVerilog.AST @@ -99,20 +97,6 @@                 ++ ' ' : show value  mapInstance _ other = other---- attempt to convert an expression to syntactically equivalent type-exprToType :: Expr -> Maybe Type-exprToType (Ident       x) = Just $ Alias       x []-exprToType (PSIdent y   x) = Just $ PSAlias y   x []-exprToType (CSIdent y p x) = Just $ CSAlias y p x []-exprToType (Range e NonIndexed r) = do-    (tf, rs) <- fmap typeRanges $ exprToType e-    Just $ tf (rs ++ [r])-exprToType (Bit e i) = do-    (tf, rs) <- fmap typeRanges $ exprToType e-    let r = (simplify $ BinOp Sub i (RawNum 1), RawNum 0)-    Just $ tf (rs ++ [r])-exprToType _ = Nothing  type Binding t = (Identifier, t) -- give a set of bindings explicit names
src/Convert/Scoper.hs view
@@ -30,7 +30,10 @@     , runScoper     , runScoperT     , partScoper-    , partScoperT+    , scopeModuleItem+    , scopeModuleItems+    , scopePart+    , scopeModule     , accessesToExpr     , replaceInType     , replaceInExpr@@ -60,13 +63,11 @@     , loopVarDepthM     , lookupLocalIdent     , lookupLocalIdentM-    , scopeModuleItemT     , Replacements     , LookupResult     ) where  import Control.Monad.State.Strict-import Data.Functor.Identity (runIdentity) import Data.List (findIndices, partition) import Data.Maybe (isNothing) import qualified Data.Map.Strict as Map@@ -276,7 +277,7 @@     Entry _ "" subMapping <- Map.lookup x mapping     directResolve subMapping rest directResolve mapping (Access x e : rest) = do-    Entry _ (index @ (_ : _)) subMapping <- Map.lookup x mapping+    Entry _ index@(_ : _) subMapping <- Map.lookup x mapping     (replacements, element) <- directResolve subMapping rest     let replacements' = Map.insert index e replacements     Just (replacements', element)@@ -369,75 +370,57 @@ loopVarDepthM :: Monad m => Identifier -> ScoperT a m (Maybe Int) loopVarDepthM = embedScopes loopVarDepth -evalScoper-    :: MapperM (Scoper a) Decl-    -> MapperM (Scoper a) ModuleItem-    -> MapperM (Scoper a) GenItem-    -> MapperM (Scoper a) Stmt-    -> Identifier-    -> [ModuleItem]-    -> [ModuleItem]-evalScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =-    runIdentity $ evalScoperT-    declMapper moduleItemMapper genItemMapper stmtMapper topName items--evalScoperT-    :: forall a m. Monad m-    => MapperM (ScoperT a m) Decl-    -> MapperM (ScoperT a m) ModuleItem-    -> MapperM (ScoperT a m) GenItem-    -> MapperM (ScoperT a m) Stmt+scopeModuleItems+    :: Monad m+    => MapperM (ScoperT a m) ModuleItem     -> Identifier-    -> [ModuleItem]-    -> m [ModuleItem]-evalScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items = do-    (items', _) <- runScoperT-        declMapper moduleItemMapper genItemMapper stmtMapper-        topName items+    -> MapperM (ScoperT a m) [ModuleItem]+scopeModuleItems moduleItemMapper topName items = do+    enterScope topName ""+    items' <- mapM moduleItemMapper items+    exitScope     return items' -runScoper-    :: MapperM (Scoper a) Decl-    -> MapperM (Scoper a) ModuleItem-    -> MapperM (Scoper a) GenItem-    -> MapperM (Scoper a) Stmt-    -> Identifier-    -> [ModuleItem]-    -> ([ModuleItem], Scopes a)-runScoper declMapper moduleItemMapper genItemMapper stmtMapper topName items =-    runIdentity $ runScoperT-    declMapper moduleItemMapper genItemMapper stmtMapper topName items+scopeModule :: Monad m+    => MapperM (ScoperT a m) ModuleItem+    -> MapperM (ScoperT a m) Description+scopeModule moduleItemMapper description+    | Part _ _ Module _ _ _ _ <- description =+        scopePart moduleItemMapper description+    | otherwise = return description -runScoperT-    :: forall a m. Monad m-    => MapperM (ScoperT a m) Decl-    -> MapperM (ScoperT a m) ModuleItem-    -> MapperM (ScoperT a m) GenItem-    -> MapperM (ScoperT a m) Stmt-    -> Identifier-    -> [ModuleItem]-    -> m ([ModuleItem], Scopes a)-runScoperT declMapper moduleItemMapper genItemMapper stmtMapper topName items =-    runStateT operation initialState-    where-        operation :: ScoperT a m [ModuleItem]-        operation = do-            enterScope topName ""-            mapM wrappedModuleItemMapper items-        initialState = Scopes [] Map.empty [] [] []+scopePart :: Monad m+    => MapperM (ScoperT a m) ModuleItem+    -> MapperM (ScoperT a m) Description+scopePart moduleItemMapper description+    | Part attrs extern kw liftetime name ports items <- description =+        scopeModuleItems moduleItemMapper name items >>=+        return . Part attrs extern kw liftetime name ports+    | otherwise = return description -        wrappedModuleItemMapper = scopeModuleItemT-            declMapper moduleItemMapper genItemMapper stmtMapper+evalScoper :: Scoper a x -> x+evalScoper = flip evalState initialState -scopeModuleItemT+evalScoperT :: Monad m => ScoperT a m x -> m x+evalScoperT = flip evalStateT initialState++runScoper :: Scoper a x -> (x, Scopes a)+runScoper = flip runState initialState++runScoperT :: Monad m => ScoperT a m x -> m (x, Scopes a)+runScoperT = flip runStateT initialState++initialState :: Scopes a+initialState = Scopes [] Map.empty [] [] []++scopeModuleItem     :: forall a m. Monad m     => MapperM (ScoperT a m) Decl     -> MapperM (ScoperT a m) ModuleItem     -> MapperM (ScoperT a m) GenItem     -> MapperM (ScoperT a m) Stmt-    -> ModuleItem-    -> ScoperT a m ModuleItem-scopeModuleItemT declMapper moduleItemMapper genItemMapper stmtMapper =+    -> MapperM (ScoperT a m) ModuleItem+scopeModuleItem declMapper moduleItemMapper genItemMapper stmtMapper =     wrappedModuleItemMapper     where         fullStmtMapper :: Stmt -> ScoperT a m Stmt@@ -606,26 +589,8 @@     -> MapperM (Scoper a) ModuleItem     -> MapperM (Scoper a) GenItem     -> MapperM (Scoper a) Stmt-    -> Description-    -> Description-partScoper declMapper moduleItemMapper genItemMapper stmtMapper part =-    runIdentity $ partScoperT-        declMapper moduleItemMapper genItemMapper stmtMapper part--partScoperT-    :: Monad m-    => MapperM (ScoperT a m) Decl-    -> MapperM (ScoperT a m) ModuleItem-    -> MapperM (ScoperT a m) GenItem-    -> MapperM (ScoperT a m) Stmt-    -> Description-    -> m Description-partScoperT declMapper moduleItemMapper genItemMapper stmtMapper =-    mapper-    where-        operation = evalScoperT+    -> Mapper Description+partScoper declMapper moduleItemMapper genItemMapper stmtMapper =+    evalScoper . scopePart scoper+    where scoper = scopeModuleItem             declMapper moduleItemMapper genItemMapper stmtMapper-        mapper (Part attrs extern kw liftetime name ports items) = do-            items' <- operation name items-            return $ Part attrs extern kw liftetime name ports items'-        mapper description = return description
src/Convert/Simplify.hs view
@@ -155,6 +155,6 @@ substituteIdent :: Scopes Expr -> Expr -> Expr substituteIdent scopes (Ident x) =     case lookupElem scopes x of-        Just (_, _, n @ Number{}) -> n+        Just (_, _, n@Number{}) -> n         _ -> Ident x substituteIdent _ other = other
src/Convert/Stream.hs view
@@ -27,7 +27,7 @@         expr' = resize exprSize lhsSize expr         lhsSize = DimsFn FnBits $ Left t         exprSize = sizeof expr-traverseDeclM (Variable d t x [] (expr @ (Stream StreamL chunk exprs))) = do+traverseDeclM (Variable d t x [] expr@(Stream StreamL chunk exprs)) = do     inProcedure <- withinProcedureM     if inProcedure         then return $ Variable d t x [] expr@@ -40,7 +40,7 @@         expr' = Call (Ident fnName) (Args [Concat exprs] []) traverseDeclM (Variable d t x a expr) =     traverseExprM expr >>= return . Variable d t x a-traverseDeclM decl @ Net{} = traverseNetAsVarM traverseDeclM decl+traverseDeclM decl@Net{} = traverseNetAsVarM traverseDeclM decl traverseDeclM decl = return decl  traverseModuleItemM :: ModuleItem -> Scoper () ModuleItem
src/Convert/StringParam.hs view
@@ -72,7 +72,7 @@ elaborateStringParam :: Idents -> ModuleItem -> ModuleItem elaborateStringParam idents (MIAttr attr item) =     MIAttr attr $ elaborateStringParam idents item-elaborateStringParam idents (orig @ (StringParam x str)) =+elaborateStringParam idents orig@(StringParam x str) =     if Set.member x idents         then Generate $ map wrap [width, param]         else orig@@ -99,7 +99,7 @@     where         expand :: [Identifier] -> ParamBinding -> [ParamBinding]         expand _ (paramName, Left t) = [(paramName, Left t)]-        expand stringParams (orig @ (paramName, Right expr)) =+        expand stringParams orig@(paramName, Right expr) =             if elem paramName stringParams                 then [(widthName paramName, Right width), orig]                 else [orig]
src/Convert/Struct.hs view
@@ -24,7 +24,7 @@ convert = map $ traverseDescriptions convertDescription  convertDescription :: Description -> Description-convertDescription (description @ (Part _ _ Module _ _ _ _)) =+convertDescription description@(Part _ _ Module _ _ _ _) =     partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM     description convertDescription other = other@@ -103,7 +103,7 @@  -- write down the types of declarations traverseDeclM :: Decl -> Scoper Type Decl-traverseDeclM decl @ Net{} =+traverseDeclM decl@Net{} =     traverseNetAsVarM traverseDeclM decl traverseDeclM decl = do     decl' <- case decl of@@ -126,6 +126,7 @@         isRangeable IntegerAtom{} = False         isRangeable NonInteger{}  = False         isRangeable TypeOf{}      = False+        isRangeable TypedefRef{}  = False         isRangeable _ = True  traverseGenItemM :: GenItem -> Scoper Type GenItem@@ -196,7 +197,7 @@         e1' = convertExpr t e1         e2' = convertExpr t e2 -convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) =+convertExpr struct@(Struct _ fields []) (Pattern itemsOrig) =     if not (null extraNames) then         error $ "pattern " ++ show (Pattern itemsOrig) ++             " has extra named fields " ++ show extraNames ++@@ -229,7 +230,8 @@         isNumbered (Right (Number n)) =             if maybeIndex == Nothing                 then error msgNonInteger-                else index < length fieldNames || error msgOutOfBounds+                else 0 <= index && index < length fieldNames+                        || error msgOutOfBounds             where                 maybeIndex = fmap fromIntegral $ numberToInteger n                 Just index = maybeIndex@@ -301,7 +303,7 @@  -- TODO: This is a conversion for concat array literals with elements -- that are unsized numbers. This probably belongs somewhere else.-convertExpr (t @ IntegerVector{}) (Concat exprs) =+convertExpr t@IntegerVector{} (Concat exprs) =     if all isUnsizedNumber exprs         then Concat $ map (Cast $ Left t') exprs         else Concat $ map (convertExpr t') exprs@@ -316,7 +318,7 @@  -- TODO: This is really a conversion for using default patterns to -- populate arrays. Maybe this should be somewhere else?-convertExpr t (orig @ (Pattern [(Left UnknownType, expr)])) =+convertExpr t orig@(Pattern [(Left UnknownType, expr)]) =     if null rs         then orig         else Repeat count [expr']@@ -384,6 +386,9 @@         (UnknownType, orig')     else if structIsntReady subExprType then         (replaceInnerTypeRange NonIndexed rOuter' fieldType, orig')+    else if null dims then+        error $ "illegal access to range " ++ show (Range Nil NonIndexed rOuter)+            ++ " of " ++ show (Dot e x) ++ ", which has type " ++ show fieldType     else         (replaceInnerTypeRange NonIndexed rOuter' fieldType, undotted)     where@@ -406,6 +411,9 @@         (UnknownType, orig')     else if structIsntReady subExprType then         (replaceInnerTypeRange mode (baseO', lenO') fieldType, orig')+    else if null dims then+        error $ "illegal access to range " ++ show (Range Nil mode (baseO, lenO))+            ++ " of " ++ show (Dot e x) ++ ", which has type " ++ show fieldType     else         (replaceInnerTypeRange mode (baseO', lenO') fieldType, undotted)     where@@ -436,6 +444,9 @@         (dropInnerTypeRange backupType, orig')     else if structIsntReady subExprType then         (dropInnerTypeRange fieldType, orig')+    else if null dims then+        error $ "illegal access to bit " ++ show i ++ " of " ++ show (Dot e x)+            ++ ", which has type " ++ show fieldType     else         (dropInnerTypeRange fieldType, Bit e' iFlat)     where
src/Convert/Traverse.hs view
@@ -217,7 +217,9 @@     where         cs (StmtAttr a stmt) = fullMapper stmt >>= return . StmtAttr a         cs (Block _ "" [] []) = return Null+        cs (Block _ "" [] [CommentStmt{}]) = return Null         cs (Block _ "" [] [stmt]) = fullMapper stmt+        cs (Block _ "" [CommentDecl{}] []) = return Null         cs (Block Seq name decls stmts) = do             stmts' <- mapM fullMapper stmts             return $ Block Seq name decls $ concatMap explode stmts'@@ -345,10 +347,10 @@             e' <- mapper e             pe' <- propExprMapper pe             return $ PropertySpec ms e' pe'-        assertionExprMapper (Left e) =-            propSpecMapper e >>= return . Left-        assertionExprMapper (Right e) =-            mapper e >>= return . Right+        assertionExprMapper (Concurrent e) =+            propSpecMapper e >>= return . Concurrent+        assertionExprMapper (Immediate d e) =+            mapper e >>= return . Immediate d         assertionMapper (Assert e ab) = do             e' <- assertionExprMapper e             return $ Assert e' ab@@ -389,10 +391,10 @@             s2' <- senseMapper s2             return $ SenseOr s1' s2'         senseMapper (SenseStar       ) = return SenseStar-        assertionExprMapper (Left (PropertySpec (Just sense) me pe)) = do+        assertionExprMapper (Concurrent (PropertySpec (Just sense) me pe)) = do             sense' <- senseMapper sense-            return $ Left $ PropertySpec (Just sense') me pe-        assertionExprMapper other = return $ other+            return $ Concurrent $ PropertySpec (Just sense') me pe+        assertionExprMapper other = return other         assertionMapper (Assert e ab) = do             e' <- assertionExprMapper e             return $ Assert e' ab@@ -520,10 +522,7 @@ collectLHSExprsM = collectify traverseLHSExprsM  mapBothM :: Monad m => MapperM m t -> MapperM m (t, t)-mapBothM mapper (a, b) = do-    a' <- mapper a-    b' <- mapper b-    return (a', b')+mapBothM mapper = bimapM mapper mapper  traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem traverseExprsM exprMapper =@@ -885,7 +884,16 @@         typeOrExprMapper (Right e) = exprMapper e >>= return . Right         typeMapper (TypeOf expr) =             exprMapper expr >>= return . TypeOf-        -- TypedefRef is excluded because it isn't really an expression+        -- TypedefRef root is a reference to a port, but the "field" here is+        -- really a typename; this indirection circumvents the interface+        -- expression resolution check and ensures the underlying modport is+        -- appropriately resolved to the corresponding interface instance+        typeMapper (TypedefRef expr) = do+            let Dot inn typ = expr+            let wrap = Dot inn "*"+            wrap' <- exprMapper wrap+            let Dot inn' "*" = wrap'+            return $ TypedefRef $ Dot inn' typ         typeMapper (CSAlias ps pm xx rs) = do             vals' <- mapM typeOrExprMapper $ map snd pm             let pm' = zip (map fst pm) vals'
src/Convert/TypeOf.hs view
@@ -41,7 +41,7 @@  -- insert the given declaration into the scope, and convert an TypeOfs within traverseDeclM :: Decl -> ST Decl-traverseDeclM decl @ Net{} =+traverseDeclM decl@Net{} =     traverseNetAsVarM traverseDeclM decl traverseDeclM decl = do     decl' <- traverseDeclNodesM traverseTypeM traverseExprM decl@@ -98,7 +98,7 @@ traverseExprM (Cast (Left t) (Number (UnbasedUnsized bit))) =     -- defer until this expression becomes explicit     return $ Cast (Left t) (Number (UnbasedUnsized bit))-traverseExprM (Cast (Left (t @ (IntegerAtom TInteger _))) expr) =+traverseExprM (Cast (Left t@(IntegerAtom TInteger _)) expr) =     -- convert to cast to an integer vector type     traverseExprM $ Cast (Left t') expr     where@@ -128,6 +128,9 @@  -- carry forward the signedness of the expression when cast to the given size elaborateSizeCast :: Expr -> Expr -> ST Expr+elaborateSizeCast (Number size) _ | Just 0 == numberToInteger size =+    -- special case because zero-width ranges cannot be represented+    error $ "size cast width " ++ show size ++ " is not a positive integer" elaborateSizeCast size value = do     t <- typeof value     force <- isStringParam value@@ -186,14 +189,14 @@         size = numberBitLength n         sg = if numberIsSigned n then Signed else Unspecified typeof (Call (Ident x) args) = typeofCall x args-typeof (orig @ (Bit e _)) = do+typeof orig@(Bit e _) = do     t <- typeof e     let t' = popRange t     case t of         TypeOf{} -> lookupTypeOf orig         Alias{} -> return $ TypeOf orig         _ -> return $ typeSignednessOverride t' Unsigned t'-typeof (orig @ (Range e NonIndexed r)) = do+typeof orig@(Range e NonIndexed r) = do     t <- typeof e     let t' = replaceRange r t     return $ case t of@@ -214,7 +217,7 @@             if mode == IndexedPlus                 then BinOp Sub (BinOp Add base len) (RawNum 1)                 else BinOp Add (BinOp Sub base len) (RawNum 1)-typeof (orig @ (Dot e x)) = do+typeof orig@(Dot e x) = do     t <- typeof e     case t of         Struct _ fields [] -> return $ fieldsType fields@@ -401,7 +404,7 @@         sz2 = typeSize t2         typeSize :: Type -> Maybe Expr         typeSize (IntegerVector _ _ rs) = Just $ dimensionsSize rs-        typeSize (t @ IntegerAtom{}) =+        typeSize t@IntegerAtom{} =             typeSize $ tf [(RawNum 1, RawNum 1)]             where (tf, []) = typeRanges t         typeSize _ = Nothing
src/Convert/Typedef.hs view
@@ -16,8 +16,9 @@ import Language.SystemVerilog.AST  convert :: [AST] -> [AST]-convert = map $ traverseDescriptions $ partScoper-    traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM+convert = map $ traverseDescriptions $ evalScoper . scopeModule scoper+    where scoper = scopeModuleItem+            traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM  traverseTypeOrExprM :: TypeOrExpr -> Scoper Type TypeOrExpr traverseTypeOrExprM (Left (TypeOf (Ident x))) = do
src/Convert/UnbasedUnsized.hs view
@@ -207,7 +207,7 @@     Cast te $ convertExpr SelfDetermined e convertExpr _ (Concat exprs) =     Concat $ map (convertExpr SelfDetermined) exprs-convertExpr context (Pattern [(Left UnknownType, e @ UU{})]) =+convertExpr context (Pattern [(Left UnknownType, e@UU{})]) =     convertExpr context e convertExpr _ (Pattern items) =     Pattern $ zip@@ -218,7 +218,7 @@     where pnArgs' = map (convertExpr SelfDetermined) pnArgs convertExpr _ (Repeat count exprs) =     Repeat count $ map (convertExpr SelfDetermined) exprs-convertExpr SelfDetermined (Mux cond (e1 @ UU{}) (e2 @ UU{})) =+convertExpr SelfDetermined (Mux cond e1@UU{} e2@UU{}) =     Mux     (convertExpr SelfDetermined cond)     (convertExpr SelfDetermined e1)
src/Convert/UnnamedGenBlock.hs view
@@ -31,10 +31,10 @@ initialState = ([], 1)  traverseModuleItemM :: ModuleItem -> S ModuleItem-traverseModuleItemM (item @ (Genvar x)) = declaration x item-traverseModuleItemM (item @ (NInputGate  _ _ x _ _)) = declaration x item-traverseModuleItemM (item @ (NOutputGate _ _ x _ _)) = declaration x item-traverseModuleItemM (item @ (Instance    _ _ x _ _)) = declaration x item+traverseModuleItemM item@(Genvar x) = declaration x item+traverseModuleItemM item@(NInputGate  _ _ x _ _) = declaration x item+traverseModuleItemM item@(NOutputGate _ _ x _ _) = declaration x item+traverseModuleItemM item@(Instance    _ _ x _ _) = declaration x item traverseModuleItemM (MIPackageItem (Decl decl)) =     traverseDeclM decl >>= return . MIPackageItem . Decl traverseModuleItemM (MIAttr attr item) =@@ -56,10 +56,10 @@ -- label the generate blocks within an individual generate item which is already -- in a list of generate items (top level or generate block) traverseGenItemM :: GenItem -> S GenItem-traverseGenItemM (item @ GenIf{}) = do+traverseGenItemM item@GenIf{} = do     item' <- labelGenElse item     incrCount >> return item'-traverseGenItemM (item @ GenBlock{}) = do+traverseGenItemM item@GenBlock{} = do     item' <- labelBlock item     incrCount >> return item' traverseGenItemM (GenFor a b c item) = do
src/Convert/UnpackedArray.hs view
@@ -27,11 +27,14 @@  convertDescription :: Description -> Description convertDescription description@(Part _ _ Module _ _ ports _) =-    partScoper (rewriteDeclM locations) return return return description+    evalScoper $ scopePart conScoper description     where-        locations = execState (operation description) Map.empty-        operation = partScoperT+        locations = execState+            (evalScoperT $ scopePart locScoper description) Map.empty+        locScoper = scopeModuleItem             (traverseDeclM ports) traverseModuleItemM return traverseStmtM+        conScoper = scopeModuleItem+            (rewriteDeclM locations) return return return convertDescription other = other  -- tracks multi-dimensional unpacked array declarations@@ -101,11 +104,6 @@ traverseLHSM x = flatUsageM x >> return x  traverseAsgnM :: (LHS, Expr) -> ST (LHS, Expr)-traverseAsgnM (x, Mux cond y z) = do-    flatUsageM x-    flatUsageM y-    flatUsageM z-    return (x, Mux cond y z) traverseAsgnM (x, y) = do     flatUsageM x     flatUsageM y@@ -113,6 +111,8 @@  class ScopeKey t => Key t where     unbit :: t -> (t, Int)+    split :: t -> Maybe (t, t)+    split = const Nothing  instance Key Expr where     unbit (Bit e _) = (e', n + 1)@@ -120,6 +120,8 @@     unbit (Range e _ _) = (e', n)         where (e', n) = unbit e     unbit e = (e, 0)+    split (Mux _ a b) = Just (a, b)+    split _ = Nothing  instance Key LHS where     unbit (LHSBit e _) = (e', n + 1)@@ -132,6 +134,8 @@     unbit x = (x, 0)  flatUsageM :: Key k => k -> ST ()+flatUsageM k | Just (a, b) <- split k =+    flatUsageM a >> flatUsageM b flatUsageM k = do     let (k', depth) = unbit k     details <- lookupElemM k'
src/Job.hs view
@@ -43,6 +43,8 @@     , verbose :: Bool     , write :: Write     , writeRaw :: String+    , oversizedNumbers :: Bool+    , dumpPrefix :: FilePath     } deriving (Typeable, Data)  version :: String@@ -61,23 +63,30 @@         ++ " macros from earlier files are not defined in later files")     , skipPreprocessor = nam_ "skip-preprocessor" &= help "Disable preprocessor"     , passThrough = nam_ "pass-through" &= help "Dump input without converting"+        &= groupname "Conversion"     , exclude = nam_ "exclude" &= name "E" &= typ "CONV"         &= help ("Exclude a particular conversion (always, assert, interface,"             ++ " or logic)")-        &= groupname "Conversion"     , 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"         &= 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")+    , oversizedNumbers = nam_ "oversized-numbers"+        &= help ("Disable standard-imposed 32-bit limit on unsized number"+            ++ " literals (e.g., 'h1_ffff_ffff, 4294967296)")+        &= groupname "Other"+    , dumpPrefix = def &= name "dump-prefix" &= explicit &= typ "PATH"+        &= help ("Create intermediate output files with the given path prefix;"+            ++ " used for internal debugging")     }     &= program "sv2v"     &= summary ("sv2v " ++ version)     &= details [ "sv2v converts SystemVerilog to Verilog."                , "More info: https://github.com/zachjs/sv2v"                , "(C) 2019-2021 Zachary Snow, 2011-2015 Tom Hawkins" ]-    &= helpArg [explicit, name "help", groupname "Other"]+    &= helpArg [explicit, name "help"]     &= versionArg [explicit, name "version"]     &= verbosityArgs [ignore] [ignore]     where
src/Language/SystemVerilog/AST.hs view
@@ -28,6 +28,7 @@     , module Type     , exprToLHS     , lhsToExpr+    , exprToType     , shortHash     ) where @@ -80,6 +81,20 @@ lhsToExpr (LHSDot    l x   ) = Dot   (lhsToExpr l) x lhsToExpr (LHSConcat     ls) = Concat $ map lhsToExpr ls lhsToExpr (LHSStream o e ls) = Stream o e $ map lhsToExpr ls++-- attempt to convert an expression to a syntactically equivalent type+exprToType :: Expr -> Maybe Type+exprToType (Ident       x) = Just $ Alias       x []+exprToType (PSIdent y   x) = Just $ PSAlias y   x []+exprToType (CSIdent y p x) = Just $ CSAlias y p x []+exprToType (Range e NonIndexed r) = do+    (tf, rs) <- fmap typeRanges $ exprToType e+    Just $ tf (rs ++ [r])+exprToType (Bit e i) = do+    (tf, rs) <- fmap typeRanges $ exprToType e+    let r = (BinOp Sub i (RawNum 1), RawNum 0)+    Just $ tf (rs ++ [r])+exprToType _ = Nothing  shortHash :: (Show a) => a -> String shortHash x =
src/Language/SystemVerilog/AST/Expr.hs view
@@ -91,11 +91,11 @@             showPatternItem (Left t, v) = printf "%s: %s" tStr (show v)                 where tStr = if null (show t) then "default" else show t     show (MinTypMax a b c) = printf "(%s : %s : %s)" (show a) (show b) (show c)-    show (e @ UniOp{}) = showsPrec 0 e ""-    show (e @ BinOp{}) = showsPrec 0 e ""-    show (e @ Dot  {}) = showsPrec 0 e ""-    show (e @ Mux  {}) = showsPrec 0 e ""-    show (e @ Call {}) = showsPrec 0 e ""+    show e@UniOp{} = showsPrec 0 e ""+    show e@BinOp{} = showsPrec 0 e ""+    show e@Dot  {} = showsPrec 0 e ""+    show e@Mux  {} = showsPrec 0 e ""+    show e@Call {} = showsPrec 0 e ""      showsPrec _ (UniOp   o e  ) =         shows o .@@ -185,12 +185,12 @@ showRange (h, l) = '[' : show h ++ ':' : show l ++ "]"  showUniOpPrec :: Expr -> ShowS-showUniOpPrec (e @ UniOp{}) = (showParen True . shows) e-showUniOpPrec (e @ BinOp{}) = (showParen True . shows) e+showUniOpPrec e@UniOp{} = (showParen True . shows) e+showUniOpPrec e@BinOp{} = (showParen True . shows) e showUniOpPrec e = shows e  showBinOpPrec :: Expr -> ShowS-showBinOpPrec (e @ BinOp{}) = (showParen True . shows) e+showBinOpPrec e@BinOp{} = (showParen True . shows) e showBinOpPrec e = shows e  type ParamBinding = (Identifier, TypeOrExpr)
src/Language/SystemVerilog/AST/Number.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} {- sv2v  - Author: Zachary Snow <zach@zachjs.com>  -@@ -17,41 +18,132 @@     , bitToVK     ) where -import Data.Bits (shiftL)+import Data.Bits ((.&.), shiftL, xor) import Data.Char (digitToInt, intToDigit, toLower) import Data.List (elemIndex) import Text.Read (readMaybe) +{-# NOINLINE parseNumber #-}+parseNumber :: Bool -> String -> (Number, String)+parseNumber oversizedNumbers =+    (parseNormalized oversizedNumbers) . normalizeNumber+ -- normalize the number first, making everything lowercase and removing -- visual niceties like spaces and underscores-parseNumber :: String -> Number-parseNumber = parseNumber' . map toLower . filter (not . isPad)+normalizeNumber :: String -> String+normalizeNumber = map toLower . filter (not . isPad)     where isPad = flip elem "_ \n\t" -parseNumber' :: String -> Number-parseNumber' "'0" = UnbasedUnsized Bit0-parseNumber' "'1" = UnbasedUnsized Bit1-parseNumber' "'x" = UnbasedUnsized BitX-parseNumber' "'z" = UnbasedUnsized BitZ-parseNumber' str =+-- truncate the given decimal number literal, if necessary+validateDecimal :: Bool -> String -> Int -> Bool -> Integer -> (Number, String)+validateDecimal oversizedNumbers str sz sg v+    | sz < -32 && oversizedNumbers =+        valid $ Decimal sz sg v+    | sz < -32 =+        addTruncateMessage str $+        if sg && v' > widthMask 31+            -- avoid zero-pad on signed decimals+            then Based (-32) sg Hex v' 0+            else Decimal (-32) sg v'+    | sz > 0 && v > widthMask sz =+        addTruncateMessage str $+            Decimal sz sg v'+    | otherwise =+        valid $ Decimal sz sg v+    where+        v' = v .&. widthMask truncWidth+        truncWidth = if sz < -32 then -32 else sz++-- produce a warning message describing the applied truncation+addTruncateMessage :: String -> Number -> (Number, String)+addTruncateMessage orig trunc = (trunc, msg)+    where+        width = show $ numberBitLength trunc+        bit = if width == "1" then "bit" else "bits"+        msg = "Number literal " ++ orig ++ " exceeds " ++ width ++ " " ++ bit+            ++ "; truncating to " ++ show trunc ++ "."++-- when extending a wide unsized number, we use the bit width if the digits+-- cover exactly that many bits, and add an extra 0 padding bit otherwise+extendUnsizedBased :: Int -> Number -> Number+extendUnsizedBased sizeByDigits n+    | size > -32 || sizeByBits < 32 = n+    | sizeByBits == sizeByDigits    = useWidth sizeByBits+    | otherwise                     = useWidth $ sizeByBits + 1+    where+        Based size sg base vals knds = n+        sizeByBits = fromIntegral $ max (bits vals) (bits knds)+        useWidth sz = Based (negate sz) sg base vals knds++-- truncate the given based number literal, if necessary+validateBased :: String -> Int -> Int -> Number -> (Number, String)+validateBased orig sizeIfPadded sizeByDigits n+    -- more digits than the size would allow for, regardless of their values+    | sizeIfPadded < sizeByDigits            = truncated+    -- unsized literal with fewer than 32 bits+    | 0 > size && size > -32                 = validated+    -- no padding bits are present+    | abs size >= sizeIfPadded               = validated+    -- check the padding bits in the leading digit, if there are any+    | all (isLegalPad sizethBit) paddingBits = validated+    -- some of the padding bits aren't legal+    | otherwise                              = truncated+    where+        Based size sg base vals knds = n+        n' = Based size sg base' vals' knds'++        validated = valid n+        truncated = addTruncateMessage orig n'++        -- checking padding bits+        sizethBit = getBit $ abs size - 1+        paddingBits = map getBit [abs size..sizeIfPadded - 1]+        getBit = getVKBit vals knds++        -- truncated the number, and selected a valid new base+        vals' = vals .&. widthMask size+        knds' = knds .&. widthMask size+        base' = if size == -32 && baseSelect == Octal+            then Binary+            else baseSelect+        baseSelect = selectBase base vals' knds'++-- if the MSB post-truncation is X or Z, then any padding bits must match; if+-- the MSB post-truncation is 0 or 1, then non-zero padding bits are forbidden+isLegalPad :: Bit -> Bit -> Bool+isLegalPad Bit1 = (== Bit0)+isLegalPad bit = (== bit)++parseNormalized :: Bool -> String -> (Number, String)+parseNormalized _ "'0" = valid $ UnbasedUnsized Bit0+parseNormalized _ "'1" = valid $ UnbasedUnsized Bit1+parseNormalized _ "'x" = valid $ UnbasedUnsized BitX+parseNormalized _ "'z" = valid $ UnbasedUnsized BitZ+parseNormalized oversizedNumbers str =     -- simple decimal number     if maybeIdx == Nothing then-        let n = readDecimal str-        in Decimal (negate $ decimalSize True n) True n+        let num = readDecimal str+            sz = negate (decimalSize True num)+        in decimal sz True num     -- non-decimal based integral number     else if maybeBase /= Nothing then         let (values, kinds) = parseBasedDigits (baseSize base) digitsExtended-        in Based size signed base values kinds+            number = Based size signed base values kinds+            sizeIfPadded = sizeDigits * bitsPerDigit+            sizeByDigits = length digitsExtended * bitsPerDigit+        in if oversizedNumbers && size < 0+            then valid $ extendUnsizedBased sizeByDigits number+            else validateBased str sizeIfPadded sizeByDigits number     -- decimal X or Z literal-    else if numDigits == 1 && elem leadDigit xzDigits then-        let (vals, knds) = parseBasedDigits 2 $ replicate (abs size) leadDigit-        in Based size signed Binary vals knds+    else if numDigits == 1 && leadDigitIsXZ then+        let vals = if elem leadDigit zDigits then widthMask size else 0+            knds = widthMask size+        in valid $ Based size signed Binary vals knds     -- explicitly-based decimal number     else         let num = readDecimal digits-        in if rawSize == 0-            then Decimal (negate $ decimalSize signed num) signed num-            else Decimal size signed num+            sz = if rawSize == 0 then negate (decimalSize signed num) else size+        in decimal sz signed num     where         -- pull out the components of the literals         maybeIdx = elemIndex '\'' str@@ -63,8 +155,9 @@         -- high-order X or Z is extended up to the size of the literal         leadDigit = head digits         numDigits = length digits+        leadDigitIsXZ = elem leadDigit xzDigits         digitsExtended =-            if elem leadDigit xzDigits+            if leadDigitIsXZ                 then replicate (sizeDigits - numDigits) leadDigit ++ digits                 else digits @@ -84,12 +177,24 @@         size =             if rawSize /= 0 then                 rawSize-            else if maybeBase /= Nothing then-                negate $ bitsPerDigit * numDigits-            else+            else if maybeBase == Nothing || leadDigitIsXZ then                 -32+            else+                negate $ min 32 $ bitsPerDigit * numDigits         bitsPerDigit = bits $ baseSize base - 1 +        -- shortcut for decimal outputs+        decimal :: Int -> Bool -> Integer -> (Number, String)+        decimal = validateDecimal oversizedNumbers str++-- shorthand denoting a valid number literal+valid :: Number -> (Number, String)+valid = (, "")++-- mask with the lowest N bits set+widthMask :: Int -> Integer+widthMask pow = 2 ^ (abs pow) - 1+ -- read a simple unsigned decimal number readDecimal :: Read a => String -> a readDecimal str =@@ -171,6 +276,16 @@ bitToVK BitX = (0, 1) bitToVK BitZ = (1, 1) +-- get the logical bit value at the given index in a (values, kinds) pair+getVKBit :: Integer -> Integer -> Int -> Bit+getVKBit v k i =+    case (v .&. select, k .&. select) of+        (0, 0) -> Bit0+        (_, 0) -> Bit1+        (0, _) -> BitX+        (_, _) -> BitZ+    where select = 2 ^ i+ data Base     = Binary     | Octal@@ -220,8 +335,14 @@ numberToInteger (UnbasedUnsized Bit1) = Just 1 numberToInteger (UnbasedUnsized Bit0) = Just 0 numberToInteger UnbasedUnsized{} = Nothing-numberToInteger (Decimal _ _ num) = Just num-numberToInteger (Based _ _ _ num 0) = Just num+numberToInteger (Decimal sz sg num)+    | not sg || num .&. pow == 0 = Just num+    | otherwise                  = Just $ negate $ num `xor` mask + 1+    where+        pow = 2 ^ (abs sz - 1)+        mask = pow + pow - 1+numberToInteger (Based sz sg _ num 0) =+    numberToInteger $ Decimal sz sg num numberToInteger Based{} = Nothing  -- return the number of bits in a number (i.e. ilog2)@@ -328,7 +449,7 @@  -- number concatenation instance Semigroup Number where-    (n1 @ Based{}) <> (n2 @ Based{}) =+    n1@Based{} <> n2@Based{} =         Based size signed base values kinds         where             size = size1 + size2@@ -344,7 +465,7 @@     n1 <> n2 =         toBased n1 <> toBased n2         where-            toBased (n @ Based{}) = n+            toBased n@Based{} = n             toBased (Decimal size signed num) =                 Based size signed Hex num 0             toBased (UnbasedUnsized bit) =
src/Language/SystemVerilog/AST/Stmt.hs view
@@ -16,8 +16,9 @@     , SeqMatchItem (..)     , SeqExpr      (..)     , AssertionItem-    , AssertionExpr     , Assertion    (..)+    , AssertionKind(..)+    , Deferral     (..)     , PropertySpec (..)     , ViolationCheck (..)     , BlockKW (..)@@ -104,9 +105,9 @@ showAssign (l, op, e) = (showPad l) ++ (showPad op) ++ (show e)  showBranch :: Stmt -> String-showBranch (Block Seq "" [] (stmts @ [CommentStmt{}, _])) =+showBranch (Block Seq "" [] stmts@[CommentStmt{}, _]) =     '\n' : (indent $ show stmts)-showBranch (block @ Block{}) = ' ' : show block+showBranch block@Block{} = ' ' : show block showBranch stmt = '\n' : (indent $ show stmt)  showBlockedBranch :: Stmt -> String@@ -129,11 +130,11 @@             _ -> False  showElseBranch :: Stmt -> String-showElseBranch (stmt @ If{}) = ' ' : show stmt+showElseBranch stmt@If{} = ' ' : show stmt showElseBranch stmt = showBranch stmt  showShortBranch :: Stmt -> String-showShortBranch (stmt @ Asgn{}) = ' ' : show stmt+showShortBranch stmt@Asgn{} = ' ' : show stmt showShortBranch stmt = showBranch stmt  showCase :: Case -> String@@ -235,20 +236,34 @@     show (SeqExprFirstMatch e a) = printf "first_match(%s, %s)" (show e) (commas $ map show a)  type AssertionItem = (Identifier, Assertion)-type AssertionExpr = Either PropertySpec Expr+ data Assertion-    = Assert AssertionExpr ActionBlock-    | Assume AssertionExpr ActionBlock-    | Cover  AssertionExpr Stmt+    = Assert AssertionKind ActionBlock+    | Assume AssertionKind ActionBlock+    | Cover  AssertionKind Stmt     deriving Eq instance Show Assertion where-    show (Assert e a) = printf "assert %s%s" (showAssertionExpr e) (show a)-    show (Assume e a) = printf "assume %s%s" (showAssertionExpr e) (show a)-    show (Cover  e a) = printf  "cover %s%s" (showAssertionExpr e) (show a)+    show (Assert k a) = printf "assert %s%s" (show k) (show a)+    show (Assume k a) = printf "assume %s%s" (show k) (show a)+    show (Cover  k a) = printf  "cover %s%s" (show k) (show a) -showAssertionExpr :: AssertionExpr -> String-showAssertionExpr (Left e) = printf "property (%s\n)" (show e)-showAssertionExpr (Right e) = printf "(%s)" (show e)+data AssertionKind+    = Concurrent PropertySpec+    | Immediate Deferral Expr+    deriving Eq+instance Show AssertionKind where+    show (Concurrent e) = printf "property (%s\n)" (show e)+    show (Immediate d e) = printf "%s(%s)" (showPad d) (show e)++data Deferral+    = NotDeferred+    | ObservedDeferred+    | FinalDeferred+    deriving Eq+instance Show Deferral where+    show NotDeferred = ""+    show ObservedDeferred = "#0"+    show FinalDeferred = "final"  data PropertySpec     = PropertySpec (Maybe Sense) Expr PropExpr
src/Language/SystemVerilog/Parser.hs view
@@ -1,39 +1,63 @@+{-# LANGUAGE TupleSections #-} {- sv2v  - Author: Zachary Snow <zach@zachjs.com>  -} module Language.SystemVerilog.Parser-    ( parseFiles+    ( initialEnv+    , parseFiles+    , Config(..)     ) where  import Control.Monad.Except+import Data.List (elemIndex) import qualified Data.Map.Strict as Map+ 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)+import Language.SystemVerilog.Parser.Preprocess (preprocess, annotate, Env, Contents) --- parses a compilation unit given include search paths and predefined macros-parseFiles :: [FilePath] -> [(String, String)] -> Bool -> Bool -> [FilePath] -> IO (Either String [AST])-parseFiles includePaths defines siloed skipPreprocessor paths = do-    let env = Map.map (\a -> (a, [])) $ Map.fromList defines-    runExceptT (parseFiles' includePaths env siloed skipPreprocessor paths)+data Config = Config+    { cfEnv :: Env+    , cfIncludePaths :: [FilePath]+    , cfSiloed :: Bool+    , cfSkipPreprocessor :: Bool+    , cfOversizedNumbers :: Bool+    } --- parses a compilation unit given include search paths and predefined macros-parseFiles' :: [FilePath] -> Env -> Bool -> Bool -> [FilePath] -> ExceptT String IO [AST]-parseFiles' _ _ _ _ [] = return []-parseFiles' includePaths env siloed skipPreprocessor (path : paths) = do-    (ast, envEnd) <- parseFile' includePaths env skipPreprocessor path-    let envNext = if siloed then env else envEnd-    asts <- parseFiles' includePaths envNext siloed skipPreprocessor paths-    return $ ast : asts+-- parse CLI macro definitions into the internal macro environment format+initialEnv :: [String] -> Env+initialEnv = Map.map (, []) . Map.fromList . map splitDefine --- parses a file given include search paths, a table of predefined macros, and--- the file path-parseFile' :: [String] -> Env -> Bool -> FilePath -> ExceptT String IO (AST, Env)-parseFile' includePaths env skipPreprocessor path = do-    let runner = if skipPreprocessor then annotate else preprocess-    preResult <- liftIO $ runner includePaths env path-    (contents, env') <- liftEither preResult-    tokens <- liftEither $ uncurry lexStr $ unzip contents-    ast <- parse tokens-    return (ast, env')+-- split a raw CLI macro definition at the '=', if present+splitDefine :: String -> (String, String)+splitDefine str =+    case elemIndex '=' str of+        Nothing -> (str, "")+        Just idx -> (name, tail rest)+            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++-- 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+    tokens <- liftEither $ runExcept $ lexStr contents+    ast <- parse (cfOversizedNumbers config) tokens+    return (config', ast)++-- 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
src/Language/SystemVerilog/Parser/Lex.x view
@@ -20,6 +20,7 @@ import qualified Data.Vector as Vector  import Language.SystemVerilog.Parser.Keywords (specMap)+import Language.SystemVerilog.Parser.Preprocess (Contents) import Language.SystemVerilog.Parser.Tokens } @@ -471,10 +472,11 @@  { -- lexer entrypoint-lexStr :: String -> [Position] -> Either String [Token]-lexStr chars positions =-    runExcept $ postProcess [] tokens+lexStr :: Contents -> Except String [Token]+lexStr contents =+    postProcess [] tokens     where+        (chars, positions) = unzip contents         tokensRaw = alexScanTokens chars         positionsVec = Vector.fromList positions         tokens = map (\tkf -> tkf positionsVec) tokensRaw
src/Language/SystemVerilog/Parser/Parse.y view
@@ -19,6 +19,7 @@ import Control.Monad.Except import Control.Monad.State.Strict import Data.Maybe (catMaybes, fromMaybe)+import System.IO (hPutStrLn, stderr) import Language.SystemVerilog.AST import Language.SystemVerilog.Parser.ParseDecl import Language.SystemVerilog.Parser.Tokens@@ -431,7 +432,7 @@  %% -opt(p)+opt(p) :: { Maybe Token }   : p { Just $1 }   |   { Nothing } @@ -459,13 +460,13 @@   | Identifier ParamBindings "::" Identifier Dimensions { CSAlias $1 $2 $4 $5 } TypeNonIdent :: { Type }   : PartialType OptSigning Dimensions { $1 $2 $3 }-  | "type" "(" Expr ")" { TypeOf $3 } PartialType :: { Signing -> [Range] -> Type }   : PartialTypeP { snd $1 } PartialTypeP :: { (Position, Signing -> [Range] -> Type) }   : IntegerVectorTypeP { (fst $1, makeIntegerVector $1) }   | IntegerAtomTypeP   { (fst $1, makeIntegerAtom   $1) }   | NonIntegerTypeP    { (fst $1, makeNonInteger    $1) }+  | "type" "(" Expr ")" { makeTypeOf $1 $3 }   | "enum" EnumBaseType "{" EnumItems   "}" { makeComplex $1 $ Enum   $2 $4 }   | "struct" Packing    "{" StructItems "}" { makeComplex $1 $ Struct $2 $4 }   | "union"  Packing    "{" StructItems "}" { makeComplex $1 $ Union  $2 $4 }@@ -569,21 +570,9 @@ Params :: { [ModuleItem] }   : PIParams { map (MIPackageItem . Decl) $1 } PIParams :: { [Decl] }-  : {- empty -}          { [] }-  | "#" "(" ")"          { [] }-  | "#" "(" ParamsFollow { $3 }-ParamsFollow :: { [Decl] }-  : ParamAsgn ParamsEnd        { $1 }-  | ParamAsgn "," ParamsFollow { $1 ++ $3 }-  |               ParamsDecl   { $1 }-ParamsDecl :: { [Decl] }-  : ModuleParameterDecl(ParamsEnd)      { $1 }-  | ModuleParameterDecl(",") ParamsDecl { $1 ++ $2 }-ParamAsgn :: { [Decl] }-  : DeclTrace Identifier "=" Expr { [$1, Param Parameter (Implicit Unspecified []) $2 $4] }-ParamsEnd-  :     ")" {}-  | "," ")" {}+  : {- empty -} { [] }+  | "#" "(" ")" { [] }+  | "#" "(" ParamDeclTokens(")") { parseDTsAsParams $3 }  PortDecls :: { ([Identifier], [ModuleItem]) }   : "(" PortDeclTokens(")") { parseDTsAsPortDecls $2 }@@ -651,16 +640,16 @@   | "[" Expr "]"                       { DTBit      (tokenPosition $1) $2 }   | "." Identifier                     { DTDot      (tokenPosition $1) $2 }   | "automatic"                        { DTLifetime (tokenPosition $1) Automatic }-  | "type" "(" Expr ")"                { uncurry DTType $ makeTypeOf $1 $3 }   | IncOrDecOperatorP                  { DTAsgn     (fst $1) (AsgnOp $ snd $1) Nothing (RawNum 1) }   | IdentifierP               "::" Identifier { uncurry DTPSIdent $1    $3 }   | IdentifierP ParamBindings "::" Identifier { uncurry DTCSIdent $1 $2 $4 } DTDelim(delim) :: { DeclToken }   : delim { DTEnd (tokenPosition $1) (head $ tokenString $1) } DeclTokenAsgn :: { DeclToken }-  : "=" opt(DelayOrEvent) Expr { DTAsgn (tokenPosition $1) AsgnOpEq $2 $3 }-  | AsgnBinOpP Expr            { uncurry DTAsgn $1 Nothing $2 }-  | "<=" opt(DelayOrEvent) Expr { DTAsgn (tokenPosition $1) AsgnOpNonBlocking $2 $3 }+  : "=" DelayOrEvent     Expr { DTAsgn (tokenPosition $1) AsgnOpEq (Just $2) $3 }+  | "="                  Expr { DTAsgn (tokenPosition $1) AsgnOpEq Nothing   $2 }+  | "<=" OptDelayOrEvent Expr { DTAsgn (tokenPosition $1) AsgnOpNonBlocking $2 $3 }+  | AsgnBinOpP           Expr { uncurry DTAsgn $1 Nothing $2 } PortDeclTokens(delim) :: { [DeclToken] }   : DeclTokensBase(PortDeclTokens(delim), delim) { $1 }   | GenericInterfaceDecl   PortDeclTokens(delim) { $1 ++ $2}@@ -673,6 +662,16 @@ GenericInterfaceDecl :: { [DeclToken] }   : "interface" IdentifierP { [DTType (tokenPosition $1) (\Unspecified -> InterfaceT "" ""), uncurry DTIdent $2] } +ParamDeclTokens(delim) :: { [DeclToken] }+  : DeclTokensBase(ParamDeclTokens(delim), delim) { $1 }+  | DeclTokenAsgn ","              DTDelim(delim) { [$1, DTComma (tokenPosition $2), $3] }+  | ParamDeclToken         ParamDeclTokens(delim) { $1 ++ $2 }+  | ParamDeclToken                 DTDelim(delim) { $1 ++ [$2] }+ParamDeclToken :: { [DeclToken] }+  : "=" PartialTypeP   { [DTTypeAsgn (tokenPosition $1), uncurry DTType  $2] }+  | "type" IdentifierP { [DTTypeDecl (tokenPosition $1), uncurry DTIdent $2] }+  | ParameterDeclKW    { [uncurry DTParamKW $1] }+ VariablePortIdentifiers :: { [(Identifier, Expr)] }   : VariablePortIdentifier                             { [$1] }   | VariablePortIdentifiers "," VariablePortIdentifier { $1 ++ [$3] }@@ -721,31 +720,51 @@  -- for ModuleItem, for now AssertionItem :: { AssertionItem }-  : ConcurrentAssertionItem { $1 }+  : ConcurrentAssertionItem        { $1 }+  | DeferredImmediateAssertionItem { $1 }  -- for Stmt, for now ProceduralAssertionStatement :: { Assertion }   : ConcurrentAssertionStatement { $1 }   | ImmediateAssertionStatement  { $1 } +ImmediateAssertionStatement :: { Assertion }+  : SimpleImmediateAssertionStatement   { $1 }+  | DeferredImmediateAssertionStatement { $1 }++DeferredImmediateAssertionItem :: { AssertionItem }+  : Identifier ":" DeferredImmediateAssertionStatement { ($1, $3) }+  |                DeferredImmediateAssertionStatement { ("", $1) }+ ConcurrentAssertionItem :: { AssertionItem }   : Identifier ":" ConcurrentAssertionStatement { ($1, $3) }   |                ConcurrentAssertionStatement { ("", $1) }+ ConcurrentAssertionStatement :: { Assertion }-  : "assert" "property" "(" PropertySpec ")" ActionBlock { Assert (Left $4) $6 }-  | "assume" "property" "(" PropertySpec ")" ActionBlock { Assume (Left $4) $6 }-  | "cover"  "property" "(" PropertySpec ")" Stmt        { Cover  (Left $4) $6 }+  : "assert" "property" "(" PropertySpec ")" ActionBlock { Assert (Concurrent $4) $6 }+  | "assume" "property" "(" PropertySpec ")" ActionBlock { Assume (Concurrent $4) $6 }+  | "cover"  "property" "(" PropertySpec ")" Stmt        { Cover  (Concurrent $4) $6 } -ImmediateAssertionStatement :: { Assertion }-  : SimpleImmediateAssertionStatement { $1 }+DeferredImmediateAssertionStatement :: { Assertion }+  : "assert" Deferral "(" Expr ")" ActionBlock { Assert (Immediate $2 $4) $6 }+  | "assume" Deferral "(" Expr ")" ActionBlock { Assume (Immediate $2 $4) $6 }+  | "cover"  Deferral "(" Expr ")" Stmt        { Cover  (Immediate $2 $4) $6 }+ SimpleImmediateAssertionStatement :: { Assertion }-  : "assert" "(" Expr ")" ActionBlock { Assert (Right $3) $5 }-  | "assume" "(" Expr ")" ActionBlock { Assume (Right $3) $5 }-  | "cover"  "(" Expr ")" Stmt        { Cover  (Right $3) $5 }+  : "assert" "(" Expr ")" ActionBlock { Assert (Immediate NotDeferred $3) $5 }+  | "assume" "(" Expr ")" ActionBlock { Assume (Immediate NotDeferred $3) $5 }+  | "cover"  "(" Expr ")" Stmt        { Cover  (Immediate NotDeferred $3) $5 } +Deferral :: { Deferral }+  : "#" number {% expectZeroDelay $2 ObservedDeferred }+  | "final" { FinalDeferred }+ PropertySpec :: { PropertySpec }-  : opt(ClockingEvent) "disable" "iff" "(" Expr ")" PropExpr { PropertySpec $1 $5  $7 }-  | opt(ClockingEvent)                              PropExpr { PropertySpec $1 Nil $2 }+  : OptClockingEvent "disable" "iff" "(" Expr ")" PropExpr { PropertySpec $1 $5  $7 }+  | OptClockingEvent                              PropExpr { PropertySpec $1 Nil $2 }+OptClockingEvent :: { Maybe Sense }+  : ClockingEvent { Just $1 }+  | {- empty -}   { Nothing }  PropExpr :: { PropExpr }   : SeqExpr { PropExpr $1 }@@ -803,15 +822,15 @@   | NOutputGates "," NOutputGate { $1 ++ [$3]}  NInputGate :: { (Expr, Identifier, LHS, [Expr]) }-  : DelayControlOrNil opt(Identifier) "(" LHS "," Exprs ")" { ($1, fromMaybe "" $2, $4, $6) }+  : DelayControlOrNil OptIdentifier "(" LHS "," Exprs ")" { ($1, $2, $4, $6) } NOutputGate :: { (Expr, Identifier, [LHS], Expr) }-  : DelayControlOrNil opt(Identifier) "(" NOutputGateItems { ($1, fromMaybe "" $2, fst $4, snd $4) }-NOutputGateItems :: { ([LHS], Expr) }-  : Expr ")" { ([], $1) }-  | Expr "," NOutputGateItems { (toLHS $1 : fst $3, snd $3) }+  : DelayControlOrNil OptIdentifier "(" Exprs "," Expr ")" { ($1, $2, map toLHS $4, $6) } DelayControlOrNil :: { Expr }   : DelayControl { $1 }   | {- empty -} { Nil }+OptIdentifier :: { Identifier }+  : Identifier  { $1 }+  | {- empty -} { "" }  NInputGateKW :: { NInputGateKW }   : "and"  { GateAnd  }@@ -1037,9 +1056,9 @@   | StmtTrace StmtNonAsgn { $2 }  StmtAsgn :: { Stmt }-  : LHS "="  opt(DelayOrEvent) Expr ";" { Asgn AsgnOpEq $3 $1 $4 }-  | LHS "<=" opt(DelayOrEvent) Expr ";" { Asgn AsgnOpNonBlocking $3 $1 $4 }-  | LHS AsgnBinOp              Expr ";" { Asgn $2  Nothing $1 $3 }+  : LHS "="  OptDelayOrEvent Expr ";" { Asgn AsgnOpEq $3 $1 $4 }+  | LHS "<=" OptDelayOrEvent Expr ";" { Asgn AsgnOpNonBlocking $3 $1 $4 }+  | LHS AsgnBinOp            Expr ";" { Asgn $2  Nothing $1 $3 }   | LHS IncOrDecOperator ";" { Asgn (AsgnOp $2) Nothing $1 (RawNum 1) }   | IncOrDecOperator LHS ";" { Asgn (AsgnOp $1) Nothing $2 (RawNum 1) }   | LHS          ";" { Subroutine (lhsToExpr $1) (Args [] []) }@@ -1077,6 +1096,10 @@   | ProceduralAssertionStatement               { Assertion $1 }   | "void" "'" "(" Expr CallArgs ")" ";"       { Subroutine $4 $5 } +OptDelayOrEvent :: { Maybe Timing }+  : DelayOrEvent { Just $1 }+  | {- empty -}  { Nothing }+ CaseStmt :: { Stmt }   : Unique CaseKW "(" Expr ")"          Cases       "endcase" { Case $1 $2                   $4 $ validateCases $5 $6 }   | Unique CaseKW "(" Expr ")" "inside" InsideCases "endcase" { Case $1 (caseInsideKW $3 $2) $4 $ validateCases $5 $7 }@@ -1128,9 +1151,6 @@   : DeclTokens(";")    { parseDTsAsDeclOrStmt $1 }   | ParameterDecl(";") { ($1, []) } -ModuleParameterDecl(delim) :: { [Decl] }-  : ParameterDecl(delim) { $1 }-  | DeclTrace "type" TypeAsgns delim { $1 : map (uncurry $ ParamType Parameter) $3 } ParameterDecl(delim) :: { [Decl] }   : ParameterDeclKW           DeclAsgns delim { makeParamDecls $1 (Implicit Unspecified []) $2 }   | ParameterDeclKW ParamType DeclAsgns delim { makeParamDecls $1 $2 $3 }@@ -1159,6 +1179,7 @@   | EventControl { Event $1 } DelayControl :: { Expr }   : "#" Number { Number $2 }+  | "#" Real   { Real   $2 }   | "#" Time   { Time   $2 }   | "#" "(" Expr ")"  { $3 }   | "#" "(" Expr ":" Expr ":" Expr ")" { MinTypMax $3 $5 $7 }@@ -1170,6 +1191,10 @@ EventControl :: { Sense }   : "@" "(" Senses ")" { $3 }   | "@" "(*)"          { SenseStar }+  | "@" "(" "*" ")"    { SenseStar }+  | "@" "(*" ")"       { SenseStar }+  | "@" "(" "*)"       { SenseStar }+  | "@" "*"            { SenseStar }   | "@*"               { SenseStar }   | "@" Identifier     { Sense $ LHSIdent $2 } Senses :: { Sense }@@ -1193,7 +1218,7 @@   : Case       { [$1] }   | Case Cases { $1 : $2 } Case :: { Case }-  : Exprs ":"  Stmt { ($1, $3) }+  : Exprs         ":"  Stmt { ($1, $3) }   | "default" opt(":") Stmt { ([], $3) } InsideCases :: { [Case] }   : InsideCase             { [$1] }@@ -1206,7 +1231,7 @@   : real { tokenString $1 }  Number :: { Number }-  : number { parseNumber $ tokenString $1 }+  : number {% readNumber (tokenPosition $1) (tokenString $1) }  String :: { String }   : string { tail $ init $ tokenString $1 }@@ -1448,40 +1473,41 @@ position :: { Position }   : {- empty -} {% gets pPosition } -end          : "end"          {} | error {% missingToken "end"          }-endclass     : "endclass"     {} | error {% missingToken "endclass"     }-endfunction  : "endfunction"  {} | error {% missingToken "endfunction"  }-endgenerate  : "endgenerate"  {} | error {% missingToken "endgenerate"  }-endinterface : "endinterface" {} | error {% missingToken "endinterface" }-endmodule    : "endmodule"    {} | error {% missingToken "endmodule"    }-endpackage   : "endpackage"   {} | error {% missingToken "endpackage"   }-endtask      : "endtask"      {} | error {% missingToken "endtask"      }-join         : "join"         {} | error {% missingToken "join"         }+end          :: { () } : "end"          { () } | error {% missingToken "end"          }+endclass     :: { () } : "endclass"     { () } | error {% missingToken "endclass"     }+endfunction  :: { () } : "endfunction"  { () } | error {% missingToken "endfunction"  }+endgenerate  :: { () } : "endgenerate"  { () } | error {% missingToken "endgenerate"  }+endinterface :: { () } : "endinterface" { () } | error {% missingToken "endinterface" }+endmodule    :: { () } : "endmodule"    { () } | error {% missingToken "endmodule"    }+endpackage   :: { () } : "endpackage"   { () } | error {% missingToken "endpackage"   }+endtask      :: { () } : "endtask"      { () } | error {% missingToken "endtask"      }+join         :: { () } : "join"         { () } | error {% missingToken "join"         }  {  data ParseData = ParseData   { pPosition :: Position   , pTokens :: [Token]+  , pOversizedNumbers :: Bool   }  type ParseState = StateT ParseData (ExceptT String IO) -parse :: [Token] -> ExceptT String IO AST-parse [] = return []-parse tokens =+parse :: Bool -> [Token] -> ExceptT String IO AST+parse _ [] = return []+parse oversizedNumbers tokens =   evalStateT parseMain initialState   where     position = tokenPosition $ head tokens-    initialState = ParseData position tokens+    initialState = ParseData position tokens oversizedNumbers  positionKeep :: (Token -> ParseState a) -> ParseState a positionKeep cont = do-  tokens <- gets pTokens+  ParseData _ tokens oversizedNumbers <- get   case tokens of     [] -> cont TokenEOF     tok : toks -> do-      put $ ParseData (tokenPosition tok) toks+      put $ ParseData (tokenPosition tok) toks oversizedNumbers       cont tok  parseErrorTok :: Token -> ParseState a@@ -1576,7 +1602,7 @@   parseError (tokenPosition tok) $ "cannot use inside with " ++ show kw  addMIAttr :: Attr -> ModuleItem -> ModuleItem-addMIAttr _ (item @ (MIPackageItem (Decl CommentDecl{}))) = item+addMIAttr _ item@(MIPackageItem (Decl CommentDecl{})) = item addMIAttr attr item = MIAttr attr item  missingToken :: String -> ParseState a@@ -1644,15 +1670,15 @@     check sg [] = unexpectedSigning pos sg (show typ)  addMITrace :: ModuleItem -> [ModuleItem] -> [ModuleItem]-addMITrace _ items @ (MIPackageItem (Decl CommentDecl{}) : _) = items+addMITrace _ items@(MIPackageItem (Decl CommentDecl{}) : _) = items addMITrace trace items = trace : items  addPITrace :: PackageItem -> [PackageItem] -> [PackageItem]-addPITrace _ items @ (Decl CommentDecl{} : _) = items+addPITrace _ items@(Decl CommentDecl{} : _) = items addPITrace trace items = trace : items  addCITrace :: ClassItem -> [ClassItem] -> [ClassItem]-addCITrace _ items @ ((_, Decl CommentDecl{}) : _) = items+addCITrace _ items@((_, Decl CommentDecl{}) : _) = items addCITrace trace items = trace : items  makeFor :: Either [Decl] [(LHS, Expr)] -> Expr -> [(LHS, AsgnOp, Expr)] -> Stmt -> Stmt@@ -1671,5 +1697,21 @@ splitInit decl =   (Variable d t ident a Nil, Just (LHSIdent ident, e))   where Variable d t ident a e = decl++readNumber :: Position -> String -> ParseState Number+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+  return num++expectZeroDelay :: Token -> a -> ParseState a+expectZeroDelay tok a = do+  num <- readNumber pos str+  case num of+    Decimal (-32) True 0 -> return a+    _ -> parseError pos $ "expected 0 after #, but found " ++ str+  where Token { tokenString = str, tokenPosition = pos } = tok  }
src/Language/SystemVerilog/Parser/ParseDecl.hs view
@@ -29,6 +29,12 @@  - portion of a for loop also allows for declarations and assignments, and so a  - similar interface is provided for this case.  -+ - Parameter port lists allow the omission of the `parameter` and `localparam`+ - keywords, and so require special handling in the same vein as other+ - declarations. However, this custom parsing is not necessary for parameter+ - declarations outside of parameter port lists because the leading keyword is+ - otherwise required.+ -  - This parser is very liberal, and so accepts some syntactically invalid files.  - In the future, we may add some basic type-checking to complain about  - malformed input files. However, we generally assume that users have tested@@ -43,6 +49,7 @@ , parseDTsAsDecl , parseDTsAsDeclOrStmt , parseDTsAsDeclsOrAsgns+, parseDTsAsParams ) where  import Data.List (findIndex, partition, uncons)@@ -73,18 +80,23 @@     | DTLifetime Position Lifetime     | DTAttr     Position Attr     | DTEnd      Position Char+    | DTParamKW  Position ParamScope+    | DTTypeDecl Position+    | DTTypeAsgn Position   -- [PUBLIC]: parser for module port declarations, including interface ports -- Example: `input foo, bar, One inst` parseDTsAsPortDecls :: [DeclToken] -> ([Identifier], [ModuleItem]) parseDTsAsPortDecls = parseDTsAsPortDecls' . dropTrailingComma-    where-        dropTrailingComma :: [DeclToken] -> [DeclToken]-        dropTrailingComma [] = []-        dropTrailingComma [DTComma{}, end @ DTEnd{}] = [end]-        dropTrailingComma (tok : toks) = tok : dropTrailingComma toks +-- internal utility to drop a single trailing comma in port or parameter lists,+-- which we allow for compatibility with Yosys+dropTrailingComma :: [DeclToken] -> [DeclToken]+dropTrailingComma [] = []+dropTrailingComma [DTComma{}, end@DTEnd{}] = [end]+dropTrailingComma (tok : toks) = tok : dropTrailingComma toks+ -- internal parseDTsAsPortDecls after the removal of an optional trailing comma parseDTsAsPortDecls' :: [DeclToken] -> ([Identifier], [ModuleItem]) parseDTsAsPortDecls' pieces =@@ -96,28 +108,10 @@         Just simpleIdents = maybeSimpleIdents         isSimpleList = maybeSimpleIdents /= Nothing -        declarations = propagateDirections Input $-            parseDTsAsDecls ModeDefault pieces'+        declarations = parseDTsAsDecls Input ModeDefault pieces'          pieces' = filter (not . isAttr) pieces -        propagateDirections :: Direction -> [Decl] -> [Decl]-        propagateDirections dir (decl @ (Variable _ InterfaceT{} _ _ _) : decls) =-            decl : propagateDirections dir decls-        propagateDirections lastDir (Variable currDir t x a e : decls) =-            decl : propagateDirections dir decls-            where-                decl = Variable dir t x a e-                dir = if currDir == Local then lastDir else currDir-        propagateDirections lastDir (Net currDir n s t x a e : decls) =-            decl : propagateDirections dir decls-            where-                decl = Net dir n s t x a e-                dir = if currDir == Local then lastDir else currDir-        propagateDirections dir (decl : decls) =-            decl : propagateDirections dir decls-        propagateDirections _ [] = []-         portNames :: [Decl] -> [Identifier]         portNames = filter (not . null) . map portName         portName :: Decl -> Identifier@@ -167,7 +161,7 @@ -- internal; attempt to parse an elaboration system task asElabTask :: [DeclToken] -> Maybe ModuleItem asElabTask tokens = do-    DTIdent _ x @ ('$' : _) <- return $ head tokens+    DTIdent _ x@('$' : _) <- return $ head tokens     severity <- lookup x elabTasks     Just $ ElabTask severity args     where@@ -235,13 +229,13 @@  -- [PUBLIC]: parser for comma-separated task/function port declarations parseDTsAsTFDecls :: [DeclToken] -> [Decl]-parseDTsAsTFDecls = parseDTsAsDecls ModeDefault+parseDTsAsTFDecls = parseDTsAsDecls Input ModeDefault   -- [PUBLIC]; used for "single" declarations, i.e., declarations appearing -- outside of a port list parseDTsAsDecl :: [DeclToken] -> [Decl]-parseDTsAsDecl = parseDTsAsDecls ModeSingle+parseDTsAsDecl = parseDTsAsDecls Local ModeSingle   -- [PUBLIC]: parser for single block item declarations or assign or arg-less@@ -258,7 +252,7 @@ declLookahead l0 =     length l0 /= length l6 && tripLookahead l6     where-        (_, l1) = takeDir      l0+        (_, l1) = takeDir      l0 Local         (_, l2) = takeLifetime l1         (_, l3) = takeConst    l2         (_, l4) = takeVarOrNet l3@@ -302,7 +296,7 @@ parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)] parseDTsAsDeclsOrAsgns tokens =     if declLookahead tokens-        then Left $ parseDTsAsDecls ModeForLoop tokens+        then Left $ parseDTsAsDecls Local ModeForLoop tokens         else Right $ parseDTsAsAsgns $ shiftIncOrDec tokens  -- internal parser for basic assignment lists@@ -328,7 +322,7 @@             "unexpected " ++ surprise ++ " in for loop initialization"  shiftIncOrDec :: [DeclToken] -> [DeclToken]-shiftIncOrDec (tok @ (DTAsgn _ AsgnOp{} _ _) : toks) =+shiftIncOrDec (tok@(DTAsgn _ AsgnOp{} _ _) : toks) =     before ++ tok : delim : shiftIncOrDec after     where (before, delim : after) = break isCommaOrEnd toks shiftIncOrDec [] = []@@ -351,7 +345,6 @@ takeLHSStep curr (DTDot   _ x   : toks) = takeLHSStep (LHSDot   curr x  ) toks takeLHSStep lhs toks = (lhs, toks) - type DeclBase = Identifier -> [Range] -> Expr -> Decl type Triplet = (Identifier, [Range], Expr) @@ -362,8 +355,8 @@     deriving Eq  -- internal; entrypoint of the critical portion of our parser-parseDTsAsDecls :: Mode -> [DeclToken] -> [Decl]-parseDTsAsDecls mode l0 =+parseDTsAsDecls :: Direction -> Mode -> [DeclToken] -> [Decl]+parseDTsAsDecls backupDir mode l0 =     if l /= Nothing && l /= Just Automatic then         parseError (head l1) "unexpected non-automatic lifetime"     else if dir == Local && isImplicit t && not (isNet $ head l3) then@@ -373,29 +366,29 @@     else if mode == ModeSingle then         parseError (head l7) "unexpected token in declaration"     else-        decls ++ parseDTsAsDecls mode l7+        decls ++ parseDTsAsDecls dir mode l7     where         initReason             | hasDriveStrength (head l3) = "net with drive strength"             | mode == ModeForLoop = "for loop"             | con = "const"             | otherwise = ""-        (dir, l1) = takeDir      l0+        (dir, l1) = takeDir      l0 backupDir         (l  , l2) = takeLifetime l1         (con, l3) = takeConst    l2         (von, l4) = takeVarOrNet l3         (tf , l5) = takeType     l4         (rs , l6) = takeRanges   l5         (tps, l7) = takeTrips    l6 initReason-        pos = tokPos $ head l0         base = von dir t-        t = case (dir, tf rs) of-                (Output, Implicit sg _) -> IntegerVector TLogic sg rs-                (_, typ) -> typ+        t = tf rs         decls =-            CommentDecl ("Trace: " ++ show pos) :+            traceComment l0 :             map (\(x, a, e) -> base x a e) tps +traceComment :: [DeclToken] -> Decl+traceComment = CommentDecl . ("Trace: " ++) . show . tokPos . head+ hasDriveStrength :: DeclToken -> Bool hasDriveStrength (DTNet _ _ DriveStrength{}) = True hasDriveStrength _ = False@@ -431,10 +424,89 @@         (_, l2) = takeRanges l1         (_, l3) = takeAsgn   l2 "" -takeDir :: [DeclToken] -> (Direction, [DeclToken])-takeDir (DTDir _ dir : rest) = (dir  , rest)-takeDir                rest  = (Local, rest) +-- [PUBLIC]: parser for parameter lists in headers of modules, interfaces, etc.+parseDTsAsParams :: [DeclToken] -> [Decl]+parseDTsAsParams = parseDTsAsParams' Parameter . dropTrailingComma++-- internal variant of the above, used recursively after the optional trailing+-- comma has been removed+parseDTsAsParams' :: ParamScope -> [DeclToken] -> [Decl]+parseDTsAsParams' _ [] = []+parseDTsAsParams' prevParamScope l0 =+    nextStep paramScope l2+    where+        nextStep = if isParamType+            then parseDTsAsParamType+            else parseDTsAsParam+        (paramScope , l1) = takeParamScope l0 prevParamScope+        (isParamType, l2) = takeParamType  l1++-- parse one or more regular parameter declarations at the beginning of the decl+-- token list before continuing on to subsequent declarations+parseDTsAsParam :: ParamScope -> [DeclToken] -> [Decl]+parseDTsAsParam paramScope l0 =+    traceComment l0 :+    map base tps +++    parseDTsAsParams' paramScope l3+    where+        (tfO, l1) = takeType   l0+        (rsO, l2) = takeRanges l1+        (tps, l3) = takeTrips  l2 ""+        base :: Triplet -> Decl+        (tf, rs) = typeRanges $ tfO rsO -- for packing tolerance+        base (x, a, e) = Param paramScope (tf $ a ++ rs) x e++-- parse a single type parameter declaration at the beginning of the decl token+-- list before continuing on to subsequent declarations+parseDTsAsParamType :: ParamScope -> [DeclToken] -> [Decl]+parseDTsAsParamType paramScope l0 =+    traceComment l0 :+    ParamType paramScope x t :+    nextStep paramScope l3+    where+        nextStep = if typeAsgnLookahead l3+            then parseDTsAsParamType+            else parseDTsAsParams'+        (x, l1) = takeIdent    l0+        (t, l2) = takeTypeAsgn l1+        l3 = takeCommaOrEnd    l2++-- take the optional default value assignment for a type parameter declaration;+-- note that aliases are parsed as regular assignments to avoid conflicts, and+-- so are converted to types when encountered+takeTypeAsgn :: [DeclToken] -> (Type, [DeclToken])+takeTypeAsgn (DTTypeAsgn _ : l0) =+    (tf rs, l2)+    where+        (tf, l1) = takeType   l0+        (rs, l2) = takeRanges l1+takeTypeAsgn (DTAsgn pos AsgnOpEq Nothing expr : toks) =+    case exprToType expr of+        Nothing -> parseError pos "unexpected non-type parameter assignment"+        Just t -> (t, toks)+takeTypeAsgn toks = (UnknownType, toks)++-- check whether the front of the tokens could plausibly form a type parameter+-- declaration and optional assignment; type parameter declaration assignments+-- can only be "escaped" using an explicit non-type parameter/localparam keyword+typeAsgnLookahead :: [DeclToken] -> Bool+typeAsgnLookahead l0 =+    not (null l0) &&+    -- every type assignment *must* begin with an identifier+    isIdent (head l0) &&+    -- expecting to see a comma or the ending token after the identifier and+    -- optional assignment+    isCommaOrEnd (head l2)+    where+        (_, l1) = takeIdent    l0+        (_, l2) = takeTypeAsgn l1+++takeDir :: [DeclToken] -> Direction -> (Direction, [DeclToken])+takeDir (DTDir _ dir : rest) _   = (dir, rest)+takeDir                rest  dir = (dir, rest)+ takeLifetime :: [DeclToken] -> (Maybe Lifetime, [DeclToken]) takeLifetime (DTLifetime _ l : rest) = (Just  l, rest) takeLifetime                   rest  = (Nothing, rest)@@ -541,6 +613,15 @@ takeIdent tokens = parseError (head tokens) "expected identifier"  +takeParamScope :: [DeclToken] -> ParamScope -> (ParamScope, [DeclToken])+takeParamScope (DTParamKW _ psc : toks) _   = (psc, toks)+takeParamScope                    toks  psc = (psc, toks)++takeParamType :: [DeclToken] -> (Bool, [DeclToken])+takeParamType (DTTypeDecl _ : toks) = (True , toks)+takeParamType                 toks  = (False, toks)++ isAttr :: DeclToken -> Bool isAttr DTAttr{} = True isAttr _ = False@@ -591,6 +672,9 @@ tokPos (DTLifetime p _) = p tokPos (DTAttr     p _) = p tokPos (DTEnd      p _) = p+tokPos (DTParamKW  p _) = p+tokPos (DTTypeDecl p) = p+tokPos (DTTypeAsgn p) = p  class Loc t where     parseError :: t -> String -> a
src/Language/SystemVerilog/Parser/Preprocess.hs view
@@ -11,6 +11,7 @@     ( preprocess     , annotate     , Env+    , Contents     ) where  import Control.Monad.Except@@ -18,13 +19,17 @@ import Data.Char (ord) import Data.List (tails, isPrefixOf, findIndex, intercalate) import Data.Maybe (isJust, fromJust)+import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))+import GHC.IO.Encoding.UTF8 (mkUTF8) import System.Directory (findFile) import System.FilePath (dropFileName)+import System.IO (hGetContents, hSetEncoding, openFile, stdin, IOMode(ReadMode)) import qualified Data.Map.Strict as Map  import Language.SystemVerilog.Parser.Tokens (Position(..))  type Env = Map.Map String (String, [(String, Maybe String)])+type Contents = [(Char, Position)]  type PPS = StateT PP (ExceptT String IO) @@ -67,49 +72,53 @@         _ -> PreviouslyTrue  -- preprocessor entrypoint-preprocess :: [String] -> Env -> FilePath -> IO (Either String ([(Char, Position)], Env))+preprocess :: [String] -> Env -> FilePath -> ExceptT String IO (Env, Contents) preprocess includePaths env path = do-    contents <--        if path == "-"-            then getContents-            else loadFile path-    let initialState = PP contents [] (Position path 1 1) path env [] includePaths [] [(path, env)]-    result <- runExceptT $ execStateT preprocessInput initialState-    return $ case result of-        Left msg -> Left msg-        Right finalState ->-            if not $ null $ ppCondStack finalState then-                Left $ path ++ ": unfinished conditional directives: " ++-                    (show $ length $ ppCondStack finalState)-            else-                Right (output, env')-                where-                    output = reverse $ ppOutput finalState-                    env' = ppEnv finalState+    contents <- liftIO $ loadFile path+    let initialState = PP+            { ppInput        = contents+            , ppOutput       = []+            , ppPosition     = Position path 1 1+            , ppFilePath     = path+            , ppEnv          = env+            , ppCondStack    = []+            , ppIncludePaths = includePaths+            , ppMacroStack   = []+            , ppIncludeStack = [(path, env)]+            }+    finalState <- execStateT preprocessInput initialState+    when (not $ null $ ppCondStack finalState) $+        throwError $ path ++ ": unfinished conditional directives: " +++            (show $ length $ ppCondStack finalState)+    let env' = ppEnv finalState+    let output = reverse $ ppOutput finalState+    return (env', output)  -- position annotator entrypoint used for files that don't need any -- preprocessing-annotate :: [String] -> Env -> FilePath -> IO (Either String ([(Char, Position)], Env))-annotate _ env path = do-    contents <--        if path == "-"-            then getContents-            else loadFile path+annotate :: FilePath -> ExceptT String IO Contents+annotate path = do+    contents <- liftIO $ loadFile path     let positions = scanl advance (Position path 1 1) contents-    return $ Right (zip contents positions, env)+    return $ zip contents positions  -- read in the given file loadFile :: FilePath -> IO String loadFile path = do-    contents <- readFile path+    handle <-+        if path == "-"+            then return stdin+            else openFile path ReadMode+    hSetEncoding handle $ mkUTF8 TransliterateCodingFailure+    contents <- hGetContents handle     return $ normalize contents-    where-        -- removes carriage returns before newlines-        normalize :: String -> String-        normalize ('\r' : '\n' : rest) = '\n' : (normalize rest)-        normalize (ch : chs) = ch : (normalize chs)-        normalize [] = [] +-- removes carriage returns before newlines+normalize :: String -> String+normalize ('\r' : '\n' : rest) = '\n' : (normalize rest)+normalize (ch : chs) = ch : (normalize chs)+normalize [] = []+ -- find the given file for inclusion includeSearch :: FilePath -> PPS FilePath includeSearch file = do@@ -539,6 +548,10 @@         '/' : '*' : _ -> removeThrough "*/"         '`' : '"' : _ -> handleBacktickString         '"' : _ -> handleString+        '/' : '`' : '`' : '*' : _ ->+            if null macroStack+                then consume+                else removeThrough "*``/"         '`' : '`' : _ -> do             if null macroStack                 then do@@ -938,4 +951,7 @@             let chars = patternIdx + length pattern             let (dropped, rest) = splitAt chars str             advancePositions dropped+            when (pattern == "\n") $ do+                pos <- getPosition+                pushChar '\n' pos             setInput rest
src/sv2v.hs view
@@ -9,18 +9,13 @@ import System.Exit (exitFailure, exitSuccess)  import Control.Monad (filterM, when, zipWithM_)-import Data.List (elemIndex, intercalate)+import Control.Monad.Except (runExceptT)+import Data.List (intercalate)  import Convert (convert) import Job (readJob, Job(..), Write(..)) import Language.SystemVerilog.AST-import Language.SystemVerilog.Parser (parseFiles)--splitDefine :: String -> (String, String)-splitDefine str =-    case elemIndex '=' str of-        Nothing -> (str, "")-        Just idx -> (take idx str, drop (idx + 1) str)+import Language.SystemVerilog.Parser (initialEnv, parseFiles, Config(..))  isInterface :: Description -> Bool isInterface (Part _ _ Interface _ _ _ _ ) = True@@ -80,18 +75,23 @@ main = do     job <- readJob     -- parse the input files-    let defines = map splitDefine $ define job-    result <- parseFiles (incdir job) defines (siloed job)-        (skipPreprocessor job) (files job)+    let config = Config+            { cfEnv              = initialEnv (define job)+            , cfIncludePaths     = incdir job+            , cfSiloed           = siloed job+            , cfSkipPreprocessor = skipPreprocessor job+            , cfOversizedNumbers = oversizedNumbers job+            }+    result <- runExceptT $ parseFiles config (files job)     case result of         Left msg -> do             hPutStrLn stderr msg             exitFailure         Right asts -> do             -- convert the files if requested-            let asts' = if passThrough job-                            then asts-                            else convert (exclude job) asts+            asts' <- if passThrough job+                        then return asts+                        else convert (dumpPrefix job) (exclude job) asts             emptyWarnings (concat asts) (concat asts')             -- write the converted files out             writeOutput (write job) (files job) asts'
sv2v.cabal view
@@ -1,6 +1,6 @@ cabal-version:   2.4 name:            sv2v-version:         0.0.8+version:         0.0.9 license:         BSD-3-Clause license-file:    LICENSE NOTICE maintainer:      Zachary Snow <zach@zachjs.com>@@ -77,6 +77,7 @@         Convert.Package         Convert.ParamNoDefault         Convert.ParamType+        Convert.PortDecl         Convert.RemoveComments         Convert.ResolveBindings         Convert.Scoper