sv2v 0.0.8 → 0.0.9
raw patch · 44 files changed
+1070/−511 lines, 44 files
Files
- CHANGELOG.md +50/−0
- README.md +12/−6
- src/Convert.hs +40/−9
- src/Convert/BlockDecl.hs +1/−1
- src/Convert/Cast.hs +15/−14
- src/Convert/DimensionQuery.hs +2/−2
- src/Convert/EmptyArgs.hs +1/−1
- src/Convert/ExprUtils.hs +13/−13
- src/Convert/FuncRoutine.hs +1/−1
- src/Convert/HierConst.hs +6/−5
- src/Convert/ImplicitNet.hs +4/−4
- src/Convert/Interface.hs +50/−36
- src/Convert/Jump.hs +1/−1
- src/Convert/KWArgs.hs +1/−1
- src/Convert/Logic.hs +7/−7
- src/Convert/MultiplePacked.hs +8/−8
- src/Convert/Package.hs +15/−13
- src/Convert/ParamNoDefault.hs +1/−1
- src/Convert/ParamType.hs +8/−8
- src/Convert/PortDecl.hs +149/−0
- src/Convert/ResolveBindings.hs +0/−16
- src/Convert/Scoper.hs +49/−84
- src/Convert/Simplify.hs +1/−1
- src/Convert/Stream.hs +2/−2
- src/Convert/StringParam.hs +2/−2
- src/Convert/Struct.hs +17/−6
- src/Convert/Traverse.hs +20/−12
- src/Convert/TypeOf.hs +9/−6
- src/Convert/Typedef.hs +3/−2
- src/Convert/UnbasedUnsized.hs +2/−2
- src/Convert/UnnamedGenBlock.hs +6/−6
- src/Convert/UnpackedArray.hs +12/−8
- src/Job.hs +11/−2
- src/Language/SystemVerilog/AST.hs +15/−0
- src/Language/SystemVerilog/AST/Expr.hs +8/−8
- src/Language/SystemVerilog/AST/Number.hs +147/−26
- src/Language/SystemVerilog/AST/Stmt.hs +30/−15
- src/Language/SystemVerilog/Parser.hs +49/−25
- src/Language/SystemVerilog/Parser/Lex.x +5/−3
- src/Language/SystemVerilog/Parser/Parse.y +106/−64
- src/Language/SystemVerilog/Parser/ParseDecl.hs +127/−43
- src/Language/SystemVerilog/Parser/Preprocess.hs +48/−32
- src/sv2v.hs +14/−14
- sv2v.cabal +2/−1
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