diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,41 @@ +## v0.0.13 + +### New Features + +* Added support for module and interface input ports with default values +* Added conversion of severity system tasks and elaboration system tasks (e.g., + `$info`) into `$display` tasks that include source file and scope information; + pass `-E SeverityTask` to disable this new conversion +* Added support for gate arrays and conversion for multidimensional gate arrays +* Added parsing support for `not`, `strong`, `weak`, `nexttime`, and + `s_nexttime` in assertion property expressions +* Added `--bugpoint` utility for minimizing test cases for issue submission + +### Bug Fixes + +* Fixed `--write path/to/dir/` with directives like `` `default_nettype `` +* Fixed `logic` incorrectly converted to `wire` even when provided to a task or + function output port +* Fixed conversion of fields accessed from explicitly-cast structs +* Fixed generated parameter name collisions when inlining interfaces and + interfaced-bound modules +* Fixed conversion of enum item names and typenames nested deeply within the + left-hand side of an assignment +* Fixed `input signed` ports of interface-using modules producing invalid + declarations after inlining +* Fixed inlining of interfaces and interface-bound modules containing port + declarations tagged with an attribute +* Fixed stray attributes producing invalid nested output when attached to + inlined interfaces and interface-bounds modules +* Fixed conversion of struct variables that shadow their module's name +* Fixed `` `resetall `` not resetting the `` `default_nettype `` + +### Other Enhancements + +* Improved error messages for invalid port or parameter bindings +* Added warning for modules or interfaces defined more than once +* `--write path/to/dir/` can now also be used with `--pass-through` + ## v0.0.12 ### Breaking Changes diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -102,7 +102,7 @@ Conversion: --pass-through Dump input without converting -E --exclude=CONV Exclude a particular conversion (Always, Assert, - Interface, Logic, or UnbasedUnsized) + Interface, Logic, SeverityTask, or UnbasedUnsized) -v --verbose Retain certain conversion artifacts -w --write=MODE/FILE/DIR How to write output; default is 'stdout'; use 'adjacent' to create a .v file next to each input; @@ -116,6 +116,9 @@ number literals (e.g., 'h1_ffff_ffff, 4294967296) --dump-prefix=PATH Create intermediate output files with the given path prefix; used for internal debugging + --bugpoint=SUBSTR Reduce the input by pruning modules, wires, etc., + that aren't needed to produce the given output or + error substring when converted --help Display this help message --version Print version information --numeric-version Print just the version number diff --git a/src/Bugpoint.hs b/src/Bugpoint.hs new file mode 100644 --- /dev/null +++ b/src/Bugpoint.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{- sv2v + - Author: Zachary Snow + - + - Utility for reducing test cases that cause conversion errors or otherwise + - produce unexpected output. + -} + +module Bugpoint (runBugpoint) where + +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) + +import Control.Exception (catches, ErrorCall(..), Handler(..), PatternMatchFail(..)) +import Control.Monad (when, (>=>)) +import Data.Functor ((<&>)) +import Data.List (isInfixOf) + +import qualified Convert.RemoveComments +import Language.SystemVerilog.AST + +runBugpoint :: [String] -> ([AST] -> IO [AST]) -> [AST] -> IO [AST] +runBugpoint expected converter = + fmap pure . runBugpoint' expected converter' . concat + where + converter' :: AST -> IO AST + converter' = fmap concat . converter . pure + +runBugpoint' :: [String] -> (AST -> IO AST) -> AST -> IO AST +runBugpoint' expected converter ast = do + ast' <- runBugpointPass expected converter ast + if ast == ast' + then out "done minimizing" >> return ast + else runBugpoint' expected converter ast' + +out :: String -> IO () +out = hPutStrLn stderr . ("bugpoint: " ++) + +-- run the given converter and return the conversion failure if any or the +-- converted output otherwise +extractConversionResult :: (AST -> IO AST) -> AST -> IO String +extractConversionResult converter asts = + catches runner + [ Handler handleErrorCall + , Handler handlePatternMatchFail + ] + where + runner = converter asts <&> show + handleErrorCall (ErrorCall str) = return str + handlePatternMatchFail (PatternMatchFail str) = return str + +runBugpointPass :: [String] -> (AST -> IO AST) -> AST -> IO AST +runBugpointPass expected converter ast = do + out $ "beginning pass with " ++ (show $ length $ show ast) ++ " characters" + matches <- oracle ast + when (not matches) $ + out ("doesn't match expected strings: " ++ show expected) >> exitFailure + let ast' = concat $ Convert.RemoveComments.convert [ast] + matches' <- oracle ast' + minimizeContainer oracle minimizeDescription "" id $ + if matches' then ast' else ast + where + oracle :: AST -> IO Bool + oracle = fmap check . extractConversionResult converter + check :: String -> Bool + check = flip all expected . flip isInfixOf + +type Oracle t = t -> IO Bool +type Minimizer t = Oracle t -> t -> IO t + +-- given a subsequence-verifying oracle, a strategy for minimizing within +-- elements of the sequence, a name for debugging, a constructor for the +-- container, and the elements within the container, produce a minimized version +-- of the container +minimizeContainer :: forall a b. (Show a, Show b) + => Oracle a -> Minimizer b -> String -> ([b] -> a) -> [b] -> IO a +minimizeContainer oracle minimizer name constructor = + stepFilter 0 [] >=> + stepRecurse [] >=> + return . constructor + where + oracle' :: Oracle [b] + oracle' = oracle . constructor + + stepFilter :: Int -> [b] -> [b] -> IO [b] + stepFilter 0 [] pending = stepFilter (length pending) [] pending + stepFilter 1 need [] = return need + stepFilter width need [] = + stepFilter (max 1 $ width `div` 4) [] need + stepFilter width need pending = do + matches <- oracle' $ need ++ rest + if matches + then out msg >> stepFilter width need rest + else stepFilter width (need ++ curr) rest + where + (curr, rest) = splitAt width pending + msg = "removed " ++ show (length curr) ++ " items from " ++ name + + stepRecurse :: [b] -> [b] -> IO [b] + stepRecurse before [] = return before + stepRecurse before (isolated : after) = do + isolated' <- minimizer oracleRecurse isolated + stepRecurse (before ++ [isolated']) after + where oracleRecurse = (oracle' $) . (before ++) . (: after) + +minimizeDescription :: Minimizer Description +minimizeDescription oracle (Package lifetime name items) = + minimizeContainer oracle (const return) name constructor items + where constructor = Package lifetime name +minimizeDescription oracle (Part att ext kw lif name ports items) = + minimizeContainer oracle minimizeModuleItem name constructor items + where constructor = Part att ext kw lif name ports +minimizeDescription _ other = return other + +minimizeModuleItem :: Minimizer ModuleItem +minimizeModuleItem oracle (Generate items) = + minimizeContainer oracle minimizeGenItem "" Generate items +minimizeModuleItem _ item = return item + +minimizeGenItem :: Minimizer GenItem +minimizeGenItem _ GenNull = return GenNull +minimizeGenItem oracle item = do + matches <- oracle GenNull + if matches + then out "removed generate item" >> return GenNull + else minimizeGenItem' oracle item + +minimizeGenItem' :: Minimizer GenItem +minimizeGenItem' oracle (GenModuleItem item) = + minimizeModuleItem (oracle . GenModuleItem) item <&> GenModuleItem +minimizeGenItem' oracle (GenIf c t f) = do + t' <- minimizeGenItem (oracle . flip (GenIf c) f) t + f' <- minimizeGenItem (oracle . GenIf c t') f + return $ GenIf c t' f' +minimizeGenItem' _ (GenBlock _ []) = return GenNull +minimizeGenItem' oracle (GenBlock name items) = + minimizeContainer oracle minimizeGenItem' name constructor items + where constructor = GenBlock name +minimizeGenItem' oracle (GenFor a b c item) = + minimizeGenItem (oracle . constructor) item <&> constructor + where constructor = GenFor a b c +minimizeGenItem' oracle (GenCase expr cases) = + minimizeContainer oracle minimizeGenCase "" constructor cases + where constructor = GenCase expr +minimizeGenItem' _ GenNull = return GenNull + +minimizeGenCase :: Minimizer GenCase +minimizeGenCase oracle (exprs, item) = + minimizeGenItem' (oracle . constructor) item <&> constructor + where constructor = (exprs,) diff --git a/src/Convert.hs b/src/Convert.hs --- a/src/Convert.hs +++ b/src/Convert.hs @@ -43,8 +43,10 @@ import qualified Convert.ParamNoDefault import qualified Convert.ParamType import qualified Convert.PortDecl +import qualified Convert.PortDefault import qualified Convert.RemoveComments import qualified Convert.ResolveBindings +import qualified Convert.SeverityTask import qualified Convert.Simplify import qualified Convert.Stream import qualified Convert.StringParam @@ -73,6 +75,8 @@ , Convert.EmptyArgs.convert , Convert.FuncRet.convert , Convert.TFBlock.convert + , Convert.Unsigned.convert + , Convert.PortDefault.convert , Convert.StringType.convert ] @@ -95,7 +99,6 @@ , Convert.Struct.convert , Convert.Typedef.convert , Convert.UnpackedArray.convert - , Convert.Unsigned.convert , Convert.Wildcard.convert , Convert.Enum.convert , Convert.StringParam.convert @@ -119,6 +122,7 @@ , selectExclude Job.Assert Convert.Assertion.convert , selectExclude Job.Always Convert.AlwaysKW.convert , Convert.Interface.disambiguate + , selectExclude Job.SeverityTask Convert.SeverityTask.convert , Convert.Package.convert , Convert.StructConst.convert , Convert.PortDecl.convert diff --git a/src/Convert/Enum.hs b/src/Convert/Enum.hs --- a/src/Convert/Enum.hs +++ b/src/Convert/Enum.hs @@ -47,7 +47,7 @@ insertElem x Nil >> return (Genvar x) traverseModuleItemM item = traverseNodesM traverseExprM return traverseTypeM traverseLHSM return item - where traverseLHSM = traverseLHSExprsM traverseExprM + where traverseLHSM = traverseNestedLHSsM $ traverseLHSExprsM traverseExprM traverseGenItemM :: GenItem -> SC GenItem traverseGenItemM = traverseGenItemExprsM traverseExprM diff --git a/src/Convert/HierConst.hs b/src/Convert/HierConst.hs --- a/src/Convert/HierConst.hs +++ b/src/Convert/HierConst.hs @@ -20,7 +20,6 @@ module Convert.HierConst (convert) where import Control.Monad (when) -import Data.Either (fromLeft) import qualified Data.Map.Strict as Map import Convert.Scoper @@ -43,7 +42,7 @@ (traverseExprsM traverseExprM) (traverseGenItemExprsM traverseExprM) (traverseStmtExprsM traverseExprM) - shadowedParams = Map.keys $ Map.filter (fromLeft False) $ + shadowedParams = Map.keys $ Map.filter (== HierParam True) $ extractMapping mapping expand = traverseNestedModuleItems $ expandParam shadowedParams convertDescription description = description @@ -61,23 +60,31 @@ prefix :: Identifier -> Identifier prefix = (++) "_sv2v_disambiguate_" -type ST = Scoper (Either Bool Expr) +data Hier + = HierParam Bool + | HierLocalparam Expr + | HierVar + deriving Eq +type ST = Scoper Hier + traverseDeclM :: Decl -> ST Decl traverseDeclM decl = do case decl of Param Parameter _ x _ -> - insertElem x (Left False) + insertElem x (HierParam False) Param Localparam UnknownType x e -> - scopeExpr e >>= insertElem x . Right + scopeExpr e >>= insertElem x . HierLocalparam Param Localparam (Implicit sg rs) x e -> - scopeExpr (Cast (Left t) e) >>= insertElem x . Right + scopeExpr (Cast (Left t) e) >>= insertElem x . HierLocalparam where t = IntegerVector TBit sg rs Param Localparam (IntegerVector _ sg rs) x e -> - scopeExpr (Cast (Left t) e) >>= insertElem x . Right + scopeExpr (Cast (Left t) e) >>= insertElem x . HierLocalparam where t = IntegerVector TBit sg rs Param Localparam t x e -> - scopeExpr (Cast (Left t) e) >>= insertElem x . Right + scopeExpr (Cast (Left t) e) >>= insertElem x . HierLocalparam + Variable _ _ x [] _ -> insertElem x HierVar + Net _ _ _ _ x [] _ -> insertElem x HierVar _ -> return () traverseDeclExprsM traverseExprM decl @@ -88,21 +95,23 @@ detailsE <- lookupElemM expr' detailsX <- lookupElemM x case (detailsE, detailsX) of - (Just ([_, _], _, Left{}), Just ([_, _], _, Left{})) -> + (Just ([_, _], _, HierParam{}), Just ([_, _], _, HierParam{})) -> return $ Ident x - (Just (accesses@[Access _ Nil, _], _, Left False), _) -> do + (Just ([_, _], _, HierVar), Just ([_, _], _, HierVar)) -> + return $ Ident x + (Just (accesses@[Access _ Nil, _], _, HierParam False), _) -> do details <- lookupElemM $ prefix x when (details == Nothing) $ - insertElem accesses (Left True) + insertElem accesses (HierParam True) return $ Ident $ prefix x - (Just ([Access _ Nil, _], _, Left True), _) -> + (Just ([Access _ Nil, _], _, HierParam True), _) -> return $ Ident $ prefix x - (Just (aE, replacements, Right value), Just (aX, _, _)) -> + (Just (aE, replacements, HierLocalparam value), Just (aX, _, _)) -> if aE == aX && Map.null replacements then return $ Ident x else traverseSinglyNestedExprsM traverseExprM $ replaceInExpr replacements value - (Just (_, replacements, Right value), Nothing) -> + (Just (_, replacements, HierLocalparam value), Nothing) -> traverseSinglyNestedExprsM traverseExprM $ replaceInExpr replacements value _ -> traverseSinglyNestedExprsM traverseExprM expr diff --git a/src/Convert/ImplicitNet.hs b/src/Convert/ImplicitNet.hs --- a/src/Convert/ImplicitNet.hs +++ b/src/Convert/ImplicitNet.hs @@ -27,9 +27,12 @@ where prefix = "`default_nettype " defaultNetType' = - if isPrefixOf prefix str - then parseDefaultNetType $ drop (length prefix) str - else defaultNetType + if isPrefixOf prefix str then + parseDefaultNetType $ drop (length prefix) str + else if str == "`resetall" then + Just TWire + else + defaultNetType traverseDescription defaultNetType description = (defaultNetType, partScoper traverseDeclM (traverseModuleItemM defaultNetType) @@ -51,12 +54,12 @@ 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 diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -422,7 +422,7 @@ scoper = scopeModuleItem traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM - key = shortHash (partName, instanceName) + key = shortHash (partName, instanceName, hierarchyPath global) -- synthetic modports to be collected and removed after inlining bundleModport = Modport "" (impliedModport items) @@ -631,11 +631,14 @@ removeDeclDir :: Decl -> Decl removeDeclDir (Variable _ t x a e) = - Variable Local t' x a e - where t' = case t of - Implicit Unspecified rs -> - IntegerVector TLogic Unspecified rs + Variable Local t' x a e' + where + t' = case t of + Implicit sg rs -> IntegerVector TLogic sg rs _ -> t + e' = if isNothing (lookup x instancePorts) + then e + else Nil removeDeclDir decl@Net{} = traverseNetAsVar removeDeclDir decl removeDeclDir other = other @@ -692,8 +695,8 @@ then idn instanceName else bit (idn instanceName) (Ident loopVar) - declDirs = execWriter $ - mapM (collectDeclsM collectDeclDir) items + declDirs = execWriter $ mapM + (collectNestedModuleItemsM $ collectDeclsM collectDeclDir) items collectDeclDir :: Decl -> Writer (Map.Map Identifier Direction) () collectDeclDir (Variable dir _ ident _ _) = when (dir /= Local) $ diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs --- a/src/Convert/Logic.hs +++ b/src/Convert/Logic.hs @@ -25,7 +25,7 @@ module Convert.Logic (convert) where -import Control.Monad (when) +import Control.Monad (when, zipWithM) import Control.Monad.Writer.Strict import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -37,7 +37,8 @@ type Ports = Map.Map Identifier [(Identifier, Direction)] type Location = [Identifier] type Locations = Set.Set Location -type ST = ScoperT Type (Writer Locations) +type DT = (Direction, Type) +type ST = ScoperT DT (Writer Locations) convert :: [AST] -> [AST] convert = @@ -70,16 +71,17 @@ where locations = execWriter $ evalScoperT $ scopePart locScoper description -- write down which vars are procedurally assigned - locScoper = scopeModuleItem traverseDeclM return return traverseStmtM + locScoper = scopeModuleItem + traverseDeclM traverseModuleItemM return traverseStmtM -- rewrite reg continuous assignments and output port connections conScoper = scopeModuleItem - (rewriteDeclM locations) (traverseModuleItemM ports) return return + (rewriteDeclM locations) (rewriteModuleItemM ports) return return -traverseModuleItemM :: Ports -> ModuleItem -> Scoper Type ModuleItem -traverseModuleItemM ports = embedScopes $ traverseModuleItem ports +rewriteModuleItemM :: Ports -> ModuleItem -> Scoper DT ModuleItem +rewriteModuleItemM ports = embedScopes $ rewriteModuleItem ports -traverseModuleItem :: Ports -> Scopes Type -> ModuleItem -> ModuleItem -traverseModuleItem ports scopes = +rewriteModuleItem :: Ports -> Scopes DT -> ModuleItem -> ModuleItem +rewriteModuleItem ports scopes = fixModuleItem where isReg :: LHS -> Bool @@ -92,7 +94,7 @@ isReg' :: LHS -> Writer [Bool] () isReg' lhs = case lookupElem scopes lhs of - Just (_, _, t) -> tell [isRegType t] + Just (_, _, (_, t)) -> tell [isRegType t] _ -> tell [False] always_comb = AlwaysC Always . Timing (Event EventStar) @@ -146,14 +148,18 @@ maybeModulePorts = Map.lookup moduleName ports fixModuleItem other = other +traverseModuleItemM :: ModuleItem -> ST ModuleItem +traverseModuleItemM = traverseNodesM traverseExprM return return return return + traverseDeclM :: Decl -> ST Decl -traverseDeclM decl@(Variable _ t x _ _) = - insertElem x t >> return decl -traverseDeclM decl@(Net _ _ _ t x _ _) = - insertElem x t >> return decl -traverseDeclM decl = return decl +traverseDeclM decl = do + case decl of + Variable d t x _ _ -> insertElem x (d, t) + Net d _ _ t x _ _ -> insertElem x (d, t) + _ -> return () + traverseDeclNodesM return traverseExprM decl -rewriteDeclM :: Locations -> Decl -> Scoper Type Decl +rewriteDeclM :: Locations -> Decl -> Scoper DT Decl rewriteDeclM locations (Variable d (IntegerVector TLogic sg rs) x a e) = do accesses <- localAccessesM x let location = map accessName accesses @@ -163,11 +169,11 @@ then do let d' = if d == Inout then Output else d let t' = IntegerVector TReg sg rs - insertElem accesses t' + insertElem accesses (d', t') return $ Variable d' t' x a e else do let t' = Implicit sg rs - insertElem accesses t' + insertElem accesses (d, t') return $ Net d TWire DefaultStrength t' x a e rewriteDeclM locations decl@(Variable d t x a e) = do inProcedure <- withinProcedureM @@ -178,12 +184,12 @@ (Input, IntegerVector TReg sg rs, False) -> rewriteDeclM locations $ Variable Input t' x a e where t' = IntegerVector TLogic sg rs - _ -> insertElem x t >> return decl + _ -> insertElem x (d, t) >> return decl rewriteDeclM _ (Net d n s (IntegerVector _ sg rs) x a e) = - insertElem x t >> return (Net d n s t x a e) + insertElem x (d, t) >> return (Net d n s t x a e) where t = Implicit sg rs -rewriteDeclM _ decl@(Net _ _ _ t x _ _) = - insertElem x t >> return decl +rewriteDeclM _ decl@(Net d _ _ t x _ _) = + insertElem x (d, t) >> return decl rewriteDeclM _ (Param s (IntegerVector _ sg []) x e) = return $ Param s (Implicit sg [(zero, zero)]) x e where zero = RawNum 0 @@ -195,12 +201,37 @@ traverseStmtM (Asgn op Just{} lhs expr) = -- ignore the timing LHSs traverseStmtM $ Asgn op Nothing lhs expr -traverseStmtM stmt@(Subroutine (Ident f) (Args (_ : Ident x : _) [])) = - when (f == "$readmemh" || f == "$readmemb") (collectLHSM $ LHSIdent x) - >> return stmt +traverseStmtM stmt@(Subroutine (Ident f) (Args (_ : Ident x : _) [])) + | f == "$readmemh" || f == "$readmemb" = + collectLHSM (LHSIdent x) >> return stmt +traverseStmtM (Subroutine fn (Args args [])) = do + fn' <- traverseExprM fn + args' <- traverseCall fn' args + return $ Subroutine fn' $ Args args' [] traverseStmtM stmt = collectStmtLHSsM (collectNestedLHSsM collectLHSM) stmt - >> return stmt + >> traverseStmtExprsM traverseExprM stmt + +traverseExprM :: Expr -> ST Expr +traverseExprM (Call fn (Args args [])) = do + fn' <- traverseExprM fn + args' <- traverseCall fn' args + return $ Call fn' $ Args args' [] +traverseExprM other = + traverseSinglyNestedExprsM traverseExprM other + +traverseCall :: Expr -> [Expr] -> ST [Expr] +traverseCall fn = zipWithM (traverseCallArg fn) [0..] + +-- task and function ports might be outputs, thus requiring a given logic to be +-- a reg rather than a wire +traverseCallArg :: Expr -> Int -> Expr -> ST Expr +traverseCallArg fn idx arg = do + details <- lookupElemM $ Dot fn (show idx) + case (details, exprToLHS arg) of + (Just (_, _, (Output, _)), Just lhs) -> collectLHSM lhs + _ -> return () + return arg -- no rewriting collectLHSM :: LHS -> ST () collectLHSM lhs = do diff --git a/src/Convert/MultiplePacked.hs b/src/Convert/MultiplePacked.hs --- a/src/Convert/MultiplePacked.hs +++ b/src/Convert/MultiplePacked.hs @@ -89,20 +89,32 @@ flattenFields :: [Field] -> [Field] flattenFields = map $ first flattenType +traverseInstanceRanges :: Identifier -> [Range] -> Scoper TypeInfo [Range] +traverseInstanceRanges x rs + | length rs <= 1 = return rs + | otherwise = do + let t = Implicit Unspecified rs + tScoped <- scopeType t + insertElem x (tScoped, []) + let r1 : r2 : rest = rs + return $ (combineRanges r1 r2) : rest + traverseModuleItemM :: ModuleItem -> Scoper TypeInfo ModuleItem traverseModuleItemM (Instance m p x rs l) = do -- converts multi-dimensional instances - rs' <- if length rs <= 1 - then return rs - else do - let t = Implicit Unspecified rs - tScoped <- scopeType t - insertElem x (tScoped, []) - let r1 : r2 : rest = rs - return $ (combineRanges r1 r2) : rest + rs' <- traverseInstanceRanges x rs traverseExprsM traverseExprM $ Instance m p x rs' l -traverseModuleItemM item = - traverseLHSsM traverseLHSM item >>= +traverseModuleItemM (NInputGate kw d x rs lhs exprs) = do + rs' <- traverseInstanceRanges x rs + traverseModuleItemM' $ NInputGate kw d x rs' lhs exprs +traverseModuleItemM (NOutputGate kw d x rs lhss expr) = do + rs' <- traverseInstanceRanges x rs + traverseModuleItemM' $ NOutputGate kw d x rs' lhss expr +traverseModuleItemM item = traverseModuleItemM' item + +traverseModuleItemM' :: ModuleItem -> Scoper TypeInfo ModuleItem +traverseModuleItemM' = + traverseLHSsM traverseLHSM >=> traverseExprsM traverseExprM -- combines two ranges into one flattened range diff --git a/src/Convert/PortDefault.hs b/src/Convert/PortDefault.hs new file mode 100644 --- /dev/null +++ b/src/Convert/PortDefault.hs @@ -0,0 +1,92 @@ +{- sv2v + - Author: Zachary Snow + - + - Conversion for input ports with default values + - + - The default values are permitted to depend on complex constants declared + - within the instantiated module. The relevant constants are copied into the + - site of the instantiation. + -} + +module Convert.PortDefault (convert) where + +import Control.Monad.Writer.Strict +import Data.Functor ((<&>)) +import qualified Data.Map.Strict as Map +import Data.Maybe (isNothing) + +import Convert.Traverse +import Convert.UnbasedUnsized (inlineConstants) +import Language.SystemVerilog.AST + +type Part = ([ModuleItem], [PortDefault]) +type Parts = Map.Map Identifier Part +type PortDefault = (Identifier, Decl) + +convert :: [AST] -> [AST] +convert files = + map (traverseDescriptions convertDescription) files' + where + (files', parts) = runWriter $ + mapM (traverseDescriptionsM preparePart) files + convertDescription = traverseModuleItems $ convertModuleItem parts + +-- remove and record input ports with defaults +preparePart :: Description -> Writer Parts Description +preparePart description@(Part att ext kw lif name ports items) = + if null portDefaults + then return description + else do + tell $ Map.singleton name (items, portDefaults) + return $ Part att ext kw lif name ports items' + where + (items', portDefaults) = runWriter $ + mapM (traverseNestedModuleItemsM prepareModuleItem) items +preparePart other = return other + +prepareModuleItem :: ModuleItem -> Writer [PortDefault] ModuleItem +prepareModuleItem (MIPackageItem (Decl decl)) = + prepareDecl decl <&> MIPackageItem . Decl +prepareModuleItem other = return other + +prepareDecl :: Decl -> Writer [PortDefault] Decl +prepareDecl (Variable Input t x [] e) | e /= Nil = + preparePortDefault t x e >> return (Variable Input t x [] Nil) +prepareDecl (Net Input n s t x [] e) | e /= Nil = + preparePortDefault t x e >> return (Net Input n s t x [] Nil) +prepareDecl other = return other + +preparePortDefault :: Type -> Identifier -> Expr -> Writer [PortDefault] () +preparePortDefault t x e = tell [(x, decl)] + where + decl = Param Localparam t' x e + t' = case t of + Implicit sg [] -> Implicit sg [(RawNum 0, RawNum 0)] + _ -> t + +-- add default port bindings to module instances that need them +convertModuleItem :: Parts -> ModuleItem -> ModuleItem +convertModuleItem parts (Instance moduleName params instanceName ds bindings) = + if isNothing maybePart || null neededDecls + then instanceBase bindings + else Generate $ map GenModuleItem $ + stubItems ++ [instanceBase $ neededBindings ++ bindings] + where + instanceBase = Instance moduleName params instanceName ds + maybePart = Map.lookup moduleName parts + Just (moduleItems, portDefaults) = maybePart + + -- determine which defaulted ports are unbound + (neededBindings, neededDecls) = unzip + [ ( (port, Ident $ blockName ++ '_' : port) + , MIPackageItem $ Decl decl + ) + | (port, decl) <- portDefaults + , isNothing (lookup port bindings) + ] + + -- inline and prefix the declarations used by the defaults + stubItems = inlineConstants blockName params moduleItems neededDecls + blockName = "sv2v_pd_" ++ instanceName + +convertModuleItem _ other = other diff --git a/src/Convert/ResolveBindings.hs b/src/Convert/ResolveBindings.hs --- a/src/Convert/ResolveBindings.hs +++ b/src/Convert/ResolveBindings.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances #-} {- sv2v - Author: Zachary Snow - @@ -16,12 +17,14 @@ import Control.Monad.Writer.Strict import Data.List (intercalate, (\\)) +import Data.Maybe (isNothing) import qualified Data.Map.Strict as Map import Convert.Traverse import Language.SystemVerilog.AST -type Parts = Map.Map Identifier ([(Identifier, Bool)], [Identifier]) +data PartInfo = PartInfo PartKW [(Identifier, Bool)] [Identifier] +type Parts = Map.Map Identifier PartInfo convert :: [AST] -> [AST] convert = @@ -30,8 +33,8 @@ (traverseDescriptions . traverseModuleItems . mapInstance) collectPartsM :: Description -> Writer Parts () -collectPartsM (Part _ _ _ _ name ports items) = - tell $ Map.singleton name (params, ports) +collectPartsM (Part _ _ kw _ name ports items) = + tell $ Map.singleton name $ PartInfo kw params ports where params = parameterInfos items collectPartsM _ = return () @@ -48,16 +51,17 @@ mapInstance :: Parts -> ModuleItem -> ModuleItem mapInstance parts (Instance m paramBindings x rs portBindings) = -- if we can't find it, just skip :( - if maybePartInfo == Nothing + if isNothing maybePartInfo then Instance m paramBindings x rs portBindings else Instance m paramBindings' x rs portBindings' where maybePartInfo = Map.lookup m parts - Just (paramInfos, portNames) = maybePartInfo + Just (PartInfo kw paramInfos portNames) = maybePartInfo paramNames = map fst paramInfos msg :: String -> String - msg = flip (++) $ " in instance " ++ show x ++ " of " ++ show m + msg = flip (++) $ " in instance " ++ show x ++ " of " ++ show kw ++ " " + ++ show m paramBindings' = map checkParam $ resolveBindings (msg "parameter overrides") paramNames paramBindings @@ -101,22 +105,41 @@ mapInstance _ other = other +class BindingArg k where + showBinding :: k -> String + +instance BindingArg TypeOrExpr where + showBinding = either show show + +instance BindingArg Expr where + showBinding = show + type Binding t = (Identifier, t) -- give a set of bindings explicit names -resolveBindings :: String -> [Identifier] -> [Binding t] -> [Binding t] +resolveBindings + :: BindingArg t => String -> [Identifier] -> [Binding t] -> [Binding t] resolveBindings _ _ [] = [] resolveBindings location available bindings@(("", _) : _) = if length available < length bindings then - error $ "too many bindings specified for " ++ location + error $ "too many bindings specified for " ++ location ++ ": " + ++ describeList "specified" (map (showBinding . snd) bindings) + ++ ", but only " ++ describeList "available" (map show available) else zip available $ map snd bindings resolveBindings location available bindings = if not $ null unknowns then error $ "unknown binding" ++ unknownsPlural ++ " " - ++ unknownsStr ++ " specified for " ++ location + ++ unknownsStr ++ " specified for " ++ location ++ ", " + ++ describeList "available" (map show available) else bindings where unknowns = map fst bindings \\ available unknownsPlural = if length unknowns == 1 then "" else "s" unknownsStr = intercalate ", " $ map show unknowns + +describeList :: String -> [String] -> String +describeList desc [] = "0 " ++ desc +describeList desc xs = + show (length xs) ++ " " ++ desc ++ " (" ++ xsStr ++ ")" + where xsStr = intercalate ", " xs diff --git a/src/Convert/Scoper.hs b/src/Convert/Scoper.hs --- a/src/Convert/Scoper.hs +++ b/src/Convert/Scoper.hs @@ -58,6 +58,10 @@ , withinProcedureM , procedureLoc , procedureLocM + , sourceLocation + , sourceLocationM + , hierarchyPath + , hierarchyPathM , scopedError , scopedErrorM , isLoopVar @@ -72,6 +76,7 @@ import Control.Monad (join, when) import Control.Monad.State.Strict +import Data.Functor ((<&>)) import Data.List (findIndices, intercalate, isPrefixOf, partition) import Data.Maybe (isNothing) import qualified Data.Map.Strict as Map @@ -200,18 +205,24 @@ -- refer to currently visible declarations so it can be substituted elsewhere scopeExpr :: Monad m => Expr -> ScoperT a m Expr scopeExpr expr = do - expr' <- traverseSinglyNestedExprsM scopeExpr expr - >>= traverseExprTypesM scopeType - details <- lookupElemM expr' + details <- lookupElemM expr case details of - Just (accesses, _, _) -> return $ accessesToExpr accesses - _ -> return expr' + Just (accesses, replacements, _) -> + mapM (scopeResolvedAccess replacements) accesses <&> accessesToExpr + _ -> traverseSinglyNestedExprsM scopeExpr expr + >>= traverseExprTypesM scopeType scopeType :: Monad m => Type -> ScoperT a m Type scopeType = traverseNestedTypesM $ traverseTypeExprsM scopeExpr {-# INLINABLE scopeExpr #-} {-# INLINABLE scopeType #-} +scopeResolvedAccess :: Monad m => Replacements -> Access -> ScoperT a m Access +scopeResolvedAccess _ access@(Access _ Nil) = return access +scopeResolvedAccess replacements access@(Access _ (Ident index)) + | Map.member index replacements = return access +scopeResolvedAccess _ (Access name expr) = scopeExpr expr <&> Access name + scopeExprWithScopes :: Scopes a -> Expr -> Expr scopeExprWithScopes scopes = flip evalState scopes . scopeExpr @@ -367,12 +378,25 @@ debugLocation :: Scopes a -> String debugLocation s = hierarchy ++ - if null latestTrace + if null location then " (use -v to get approximate source location)" - else ", near " ++ latestTrace + else ", near " ++ location where - hierarchy = intercalate "." $ map tierToStr $ sCurrent s - latestTrace = sLatestTrace s + hierarchy = hierarchyPath s + location = sourceLocation s + +sourceLocationM :: Monad m => ScoperT a m String +sourceLocationM = gets sourceLocation + +sourceLocation :: Scopes a -> String +sourceLocation = sLatestTrace + +hierarchyPathM :: Monad m => ScoperT a m String +hierarchyPathM = gets hierarchyPath + +hierarchyPath :: Scopes a -> String +hierarchyPath = intercalate "." . map tierToStr . sCurrent + where tierToStr :: Tier -> String tierToStr (Tier "" _) = "" tierToStr (Tier x "") = x diff --git a/src/Convert/SeverityTask.hs b/src/Convert/SeverityTask.hs new file mode 100644 --- /dev/null +++ b/src/Convert/SeverityTask.hs @@ -0,0 +1,64 @@ +{- sv2v + - Author: Ethan Sifferman + - + - Conversion of severity system tasks (IEEE 1800-2017 Section 20.10) and + - elaboration system tasks (Section 20.11) `$info`, `$warning`, `$error`, and + - `$fatal`, which sv2v collectively refers to as "severity tasks". + - + - 1. Severity task messages are converted into `$display` tasks. + - 2. `$fatal` tasks also run `$finish` directly after running `$display`. + -} + +module Convert.SeverityTask (convert) where + +import Data.Char (toUpper) +import Data.Functor ((<&>)) + +import Convert.Scoper +import Convert.Traverse +import Language.SystemVerilog.AST + +type SC = Scoper () + +convert :: [AST] -> [AST] +convert = map $ traverseDescriptions traverseDescription + +traverseDescription :: Description -> Description +traverseDescription = partScoper return traverseModuleItem return traverseStmt + +-- convert elaboration severity tasks +traverseModuleItem :: ModuleItem -> SC ModuleItem +traverseModuleItem (ElabTask severity taskArgs) = + elab severity taskArgs "elaboration" [] <&> Initial +traverseModuleItem other = return other + +-- convert standard severity tasks +traverseStmt :: Stmt -> SC Stmt +traverseStmt (SeverityStmt severity taskArgs) = + elab severity taskArgs "%0t" [Ident "$time"] +traverseStmt other = return other + +elab :: Severity -> [Expr] -> String -> [Expr] -> SC Stmt +elab severity args prefixStr prefixArgs = do + scopeName <- hierarchyPathM + fileLocation <- sourceLocationM + let contextArg = String $ msg scopeName fileLocation + let stmtDisplay = call "$display" $ contextArg : prefixArgs ++ displayArgs + return $ Block Seq "" [] [stmtDisplay, stmtFinish] + where + msg scope file = severityToString severity ++ " [" ++ prefixStr ++ "] " + ++ file ++ " - " ++ scope + ++ if null displayArgs then "" else "\\n msg: " + displayArgs = if severity /= SeverityFatal || null args + then args + else tail args + stmtFinish = if severity /= SeverityFatal + then Null + else call "$finish" $ if null args then [] else [head args] + +call :: Identifier -> [Expr] -> Stmt +call func args = Subroutine (Ident func) (Args args []) + +severityToString :: Severity -> String +severityToString severity = toUpper ch : str + where '$' : ch : str = show severity diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -298,10 +298,6 @@ Just value = numberToInteger n Right (Number n) = item -convertExpr scopes _ (Cast (Left t) expr) = - Cast (Left t') $ convertExpr scopes t expr - where t' = convertType t - convertExpr scopes (Implicit _ []) expr = traverseSinglyNestedExprs (convertExpr scopes UnknownType) expr convertExpr scopes (Implicit sg rs) expr = @@ -380,7 +376,7 @@ -- try expression conversion by looking at the *innermost* type first convertSubExpr :: Scopes Type -> Expr -> (Type, Expr) convertSubExpr scopes (Dot e x) = - if isntStruct subExprType then + if isntStruct subExprType || isHier then fallbackType scopes $ Dot e' x else if structIsntReady subExprType then (fieldType, Dot e' x) @@ -388,7 +384,7 @@ (fieldType, undottedWithSign) where (subExprType, e') = convertSubExpr scopes e - (fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x + (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x base = fst bounds len = rangeSize bounds undotted = if null dims || rangeSize (head dims) == RawNum 1 @@ -403,7 +399,7 @@ else undotted convertSubExpr scopes (Range (Dot e x) NonIndexed rOuter) = - if isntStruct subExprType then + if isntStruct subExprType || isHier then (UnknownType, orig') else if structIsntReady subExprType then (replaceInnerTypeRange NonIndexed rOuter' fieldType, orig') @@ -420,7 +416,7 @@ (_, roRight') = convertSubExpr scopes roRight rOuter' = (roLeft', roRight') orig' = Range (Dot e' x) NonIndexed rOuter' - (fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x + (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x [dim] = dims rangeLeft = ( BinOp Sub (fst bounds) $ BinOp Sub (fst dim) roLeft' , BinOp Sub (fst bounds) $ BinOp Sub (fst dim) roRight' ) @@ -429,7 +425,7 @@ undotted = Range e' NonIndexed $ endianCondRange dim rangeLeft rangeRight convertSubExpr scopes (Range (Dot e x) mode (baseO, lenO)) = - if isntStruct subExprType then + if isntStruct subExprType || isHier then (UnknownType, orig') else if structIsntReady subExprType then (replaceInnerTypeRange mode (baseO', lenO') fieldType, orig') @@ -444,7 +440,7 @@ (_, baseO') = convertSubExpr scopes baseO (_, lenO') = convertSubExpr scopes lenO orig' = Range (Dot e' x) mode (baseO', lenO') - (fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x + (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x [dim] = dims baseLeft = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) baseO' baseRight = BinOp Add (snd bounds) $ BinOp Sub (snd dim) baseO' @@ -463,7 +459,7 @@ (_, right') = convertSubExpr scopes right r' = (left', right') convertSubExpr scopes (Bit (Dot e x) i) = - if isntStruct subExprType then + if isntStruct subExprType || isHier then (dropInnerTypeRange backupType, orig') else if structIsntReady subExprType then (dropInnerTypeRange fieldType, orig') @@ -477,7 +473,7 @@ (_, i') = convertSubExpr scopes i (backupType, _) = fallbackType scopes $ Dot e' x orig' = Bit (Dot e' x) i' - (fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x + (isHier, fieldType, bounds, dims) = lookupFieldInfo scopes subExprType e' x [dim] = dims left = BinOp Sub (fst bounds) $ BinOp Sub (fst dim) i' right = BinOp Add (snd bounds) $ BinOp Sub (snd dim) i' @@ -495,7 +491,7 @@ (retType, _) = fallbackType scopes e args' = convertCall scopes e args convertSubExpr scopes (Cast (Left t) e) = - (t', Cast (Left t') e') + (t, Cast (Left t') e') where e' = convertExpr scopes t $ snd $ convertSubExpr scopes e t' = convertType t @@ -536,13 +532,11 @@ -- get the field type, flattened bounds, and original type dimensions lookupFieldInfo :: Scopes Type -> Type -> Expr -> Identifier - -> (Type, Range, [Range]) + -> (Bool, Type, Range, [Range]) lookupFieldInfo scopes struct base fieldName = if maybeFieldType == Nothing - then scopedError scopes $ "field '" ++ fieldName ++ "' not found in " - ++ show struct ++ ", in expression " - ++ show (Dot base fieldName) - else (fieldType, bounds, dims) + then (isHier, err, err, err) + else (False, fieldType, bounds, dims) where Just fields = getFields struct maybeFieldType = lookup fieldName $ map swap fields @@ -550,6 +544,10 @@ dims = snd $ typeRanges fieldType Just (_, unstructRanges) = convertStruct struct Just bounds = lookup fieldName unstructRanges + err = scopedError scopes $ "field '" ++ fieldName ++ "' not found in " + ++ show struct ++ ", in expression " + ++ show (Dot base fieldName) + isHier = lookupElem scopes (Dot base fieldName) /= Nothing -- attempts to convert based on the assignment-like contexts of TF arguments convertCall :: Scopes Type -> Expr -> Args -> Args diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -111,6 +111,7 @@ ) where import Data.Bitraversable (bimapM) +import Data.Functor ((<&>)) import Data.Functor.Identity (Identity, runIdentity) import Control.Monad ((>=>)) import Control.Monad.Writer.Strict @@ -138,6 +139,8 @@ breakGenerate :: ModuleItem -> [ModuleItem] -> [ModuleItem] breakGenerate (Generate genItems) items = foldr breakGenerateStep items genItems +breakGenerate (MIAttr _ (Generate genItems)) items = + foldr breakGenerateStep items genItems breakGenerate item items = item : items breakGenerateStep :: GenItem -> [ModuleItem] -> [ModuleItem] @@ -255,6 +258,7 @@ cs (Timing event stmt) = fullMapper stmt >>= return . Timing event cs (Return expr) = return $ Return expr cs (Subroutine expr exprs) = return $ Subroutine expr exprs + cs (SeverityStmt severity exprs) = return $ SeverityStmt severity exprs cs (Trigger blocks x) = return $ Trigger blocks x cs stmt@Force{} = return stmt cs (Wait e stmt) = fullMapper stmt >>= return . Wait e @@ -343,6 +347,16 @@ p1' <- traversePropExprExprsM mapper p1 p2' <- traversePropExprExprsM mapper p2 return $ PropExprIff p1' p2' +traversePropExprExprsM mapper (PropExprNeg pe) = + traversePropExprExprsM mapper pe <&> PropExprNeg +traversePropExprExprsM mapper (PropExprStrong se) = + traverseSeqExprExprsM mapper se <&> PropExprStrong +traversePropExprExprsM mapper (PropExprWeak se) = + traverseSeqExprExprsM mapper se <&> PropExprWeak +traversePropExprExprsM mapper (PropExprNextTime strong index prop) = do + index' <- mapper index + prop' <- traversePropExprExprsM mapper prop + return $ PropExprNextTime strong index' prop' seqExprHelper :: Monad m => MapperM m Expr -> (SeqExpr -> SeqExpr -> SeqExpr) @@ -592,16 +606,18 @@ return $ Instance m p' x rs' l' moduleItemMapper (Modport x l) = mapM modportDeclMapper l >>= return . Modport x - moduleItemMapper (NInputGate kw d x lhs exprs) = do + moduleItemMapper (NInputGate kw d x rs lhs exprs) = do d' <- exprMapper d exprs' <- mapM exprMapper exprs + rs' <- mapM (mapBothM exprMapper) rs lhs' <- lhsMapper lhs - return $ NInputGate kw d' x lhs' exprs' - moduleItemMapper (NOutputGate kw d x lhss expr) = do + return $ NInputGate kw d' x rs' lhs' exprs' + moduleItemMapper (NOutputGate kw d x rs lhss expr) = do d' <- exprMapper d + rs' <- mapM (mapBothM exprMapper) rs lhss' <- mapM lhsMapper lhss expr' <- exprMapper expr - return $ NOutputGate kw d' x lhss' expr' + return $ NOutputGate kw d' x rs' lhss' expr' moduleItemMapper (Genvar x) = return $ Genvar x moduleItemMapper (Generate items) = do items' <- mapM (traverseNestedGenItemsM genItemMapper) items @@ -622,11 +638,8 @@ return $ MIPackageItem $ DPIExport spec alias kw name moduleItemMapper (AssertionItem item) = assertionItemMapper item >>= return . AssertionItem - moduleItemMapper (ElabTask severity (Args pnArgs kwArgs)) = do - pnArgs' <- mapM exprMapper pnArgs - kwArgs' <- fmap (zip kwNames) $ mapM exprMapper kwExprs - return $ ElabTask severity $ Args pnArgs' kwArgs' - where (kwNames, kwExprs) = unzip kwArgs + moduleItemMapper (ElabTask severity args) = + mapM exprMapper args >>= return . ElabTask severity assertionItemMapper (MIAssertion mx a) = do a' <- traverseAssertionStmtsM stmtMapper a @@ -705,6 +718,8 @@ pes <- mapM exprMapper $ map snd p let p' = zip (map fst p) pes return $ Subroutine e' (Args l' p') + flatStmtMapper (SeverityStmt s l) = + mapM exprMapper l >>= return . SeverityStmt s flatStmtMapper (Return expr) = exprMapper expr >>= return . Return flatStmtMapper (Trigger blocks x) = return $ Trigger blocks x @@ -755,12 +770,12 @@ traverseModuleItemLHSsM (Defparam lhs expr) = do lhs' <- mapper lhs return $ Defparam lhs' expr - traverseModuleItemLHSsM (NOutputGate kw d x lhss expr) = do + traverseModuleItemLHSsM (NOutputGate kw d x rs lhss expr) = do lhss' <- mapM mapper lhss - return $ NOutputGate kw d x lhss' expr - traverseModuleItemLHSsM (NInputGate kw d x lhs exprs) = do + return $ NOutputGate kw d x rs lhss' expr + traverseModuleItemLHSsM (NInputGate kw d x rs lhs exprs) = do lhs' <- mapper lhs - return $ NInputGate kw d x lhs' exprs + return $ NInputGate kw d x rs lhs' exprs traverseModuleItemLHSsM (AssertionItem (MIAssertion mx a)) = do converted <- traverseNestedStmtsM (traverseStmtLHSsM mapper) (Assertion a) @@ -1053,8 +1068,14 @@ traverseNestedGenItems :: Mapper GenItem -> Mapper GenItem traverseNestedGenItems = unmonad traverseNestedGenItemsM +innerGenItems :: ModuleItem -> Maybe [GenItem] +innerGenItems (MIAttr _ item) = innerGenItems item +innerGenItems (Generate items) = Just items +innerGenItems _ = Nothing + flattenGenBlocks :: GenItem -> [GenItem] -flattenGenBlocks (GenModuleItem (Generate items)) = items +flattenGenBlocks (GenModuleItem item) + | Just items <- innerGenItems item = items flattenGenBlocks (GenFor _ _ _ GenNull) = [] flattenGenBlocks GenNull = [] flattenGenBlocks other = [other] diff --git a/src/Convert/TypeOf.hs b/src/Convert/TypeOf.hs --- a/src/Convert/TypeOf.hs +++ b/src/Convert/TypeOf.hs @@ -79,7 +79,7 @@ traverseModuleItemM :: ModuleItem -> ST ModuleItem traverseModuleItemM = traverseNodesM traverseExprM return traverseTypeM traverseLHSM return - where traverseLHSM = traverseLHSExprsM traverseExprM + where traverseLHSM = traverseNestedLHSsM $ traverseLHSExprsM traverseExprM -- convert TypeOf in a GenItem traverseGenItemM :: GenItem -> ST GenItem @@ -159,8 +159,11 @@ -- checks if referring to part.wire is needlessly explicit unneededModuleScope :: Identifier -> Identifier -> ST Bool unneededModuleScope part wire = do + partDetails <- lookupElemM part accessesLocal <- localAccessesM wire - if accessesLocal == accessesTop then + if partDetails /= Nothing then + return False + else if accessesLocal == accessesTop then return True else if head accessesLocal == head accessesTop then do details <- lookupElemM wire diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -88,7 +88,7 @@ traverseModuleItemM' :: ModuleItem -> SC ModuleItem traverseModuleItemM' = traverseNodesM traverseExprM return traverseTypeM traverseLHSM return - where traverseLHSM = traverseLHSExprsM traverseExprM + where traverseLHSM = traverseNestedLHSsM $ traverseLHSExprsM traverseExprM traverseGenItemM :: GenItem -> SC GenItem traverseGenItemM = traverseGenItemExprsM traverseExprM diff --git a/src/Convert/UnbasedUnsized.hs b/src/Convert/UnbasedUnsized.hs --- a/src/Convert/UnbasedUnsized.hs +++ b/src/Convert/UnbasedUnsized.hs @@ -14,7 +14,10 @@ - creating hierarchical or generate-scoped references. -} -module Convert.UnbasedUnsized (convert) where +module Convert.UnbasedUnsized + ( convert + , inlineConstants + ) where import Control.Monad.Writer.Strict import Data.Either (isLeft) @@ -62,7 +65,7 @@ -- checking whether we're ready to inline hasTypeParams = any (isLeft . snd) params - moduleIsResolved = isEntirelyResolved selectedStubItems + moduleIsResolved = isEntirelyResolved stubItems -- transform the existing bindings to reference extension declarations (bindings', extensionDeclLists) = unzip $ @@ -71,13 +74,18 @@ -- inline the necessary portions of the module alongside the selected -- extension declarations - stubItems = - map (traverseDecls overrideParam) $ - prefixItems blockName selectedStubItems - selectedStubItems = inject rawStubItems extensionDecls - rawStubItems = createModuleStub moduleItems + stubItems = inlineConstants blockName params moduleItems extensionDecls blockName = "sv2v_uu_" ++ instanceName +convertModuleItem _ other = convertModuleItem' other + +inlineConstants :: Identifier -> [ParamBinding] -> [ModuleItem] -> [ModuleItem] + -> [ModuleItem] +inlineConstants blockName params moduleItems = + map (traverseDecls overrideParam) . + prefixItems blockName . + inject (createModuleStub moduleItems) + where -- override a parameter value in the stub overrideParam :: Decl -> Decl overrideParam (Param Parameter t x e) = @@ -88,8 +96,6 @@ Nothing -> e where xOrig = drop (length blockName + 1) x overrideParam decl = decl - -convertModuleItem _ other = convertModuleItem' other -- convert a port binding and produce a list of needed extension decls convertBinding :: Identifier -> PortBinding -> (PortBinding, [Decl]) diff --git a/src/Convert/UnnamedGenBlock.hs b/src/Convert/UnnamedGenBlock.hs --- a/src/Convert/UnnamedGenBlock.hs +++ b/src/Convert/UnnamedGenBlock.hs @@ -33,9 +33,9 @@ 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@(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) = diff --git a/src/Convert/Unsigned.hs b/src/Convert/Unsigned.hs --- a/src/Convert/Unsigned.hs +++ b/src/Convert/Unsigned.hs @@ -18,7 +18,8 @@ map $ traverseDescriptions $ traverseModuleItems $ - traverseTypes $ traverseNestedTypes convertType + -- doesn't need to visit nested types, as they have been elaborated + traverseTypes convertType convertType :: Type -> Type convertType (Implicit Unsigned rs) = Implicit Unspecified rs diff --git a/src/Job.hs b/src/Job.hs --- a/src/Job.hs +++ b/src/Job.hs @@ -27,6 +27,7 @@ | Assert | Interface | Logic + | SeverityTask | Succinct | UnbasedUnsized deriving (Typeable, Data, Eq) @@ -53,6 +54,7 @@ , top :: [String] , oversizedNumbers :: Bool , dumpPrefix :: FilePath + , bugpoint :: [String] } deriving (Typeable, Data) version :: String @@ -82,7 +84,7 @@ &= groupname "Conversion" , exclude = nam_ "exclude" &= name "E" &= typ "CONV" &= help ("Exclude a particular conversion (Always, Assert, Interface," - ++ " Logic, or UnbasedUnsized)") + ++ " Logic, SeverityTask, or UnbasedUnsized)") , verbose = nam "verbose" &= help "Retain certain conversion artifacts" , write = Stdout &= ignore -- parsed from the flexible flag below , writeRaw = "s" &= name "write" &= name "w" &= explicit @@ -101,6 +103,10 @@ , dumpPrefix = def &= name "dump-prefix" &= explicit &= typ "PATH" &= help ("Create intermediate output files with the given path prefix;" ++ " used for internal debugging") + , bugpoint = nam_ "bugpoint" &= typ "SUBSTR" + &= help ("Reduce the input by pruning modules, wires, etc., that" + ++ " aren't needed to produce the given output or error substring" + ++ " when converted") } &= program "sv2v" &= summary ("sv2v " ++ version) @@ -139,11 +145,7 @@ setWrite :: Job -> IO Job setWrite job = do w <- parseWrite $ writeRaw job - case (w, passThrough job) of - (Directory{}, True) -> do - hPutStr stderr "can't use --pass-through when writing to a dir" - exitFailure - _ -> return $ job { write = w } + return $ job { write = w } setSuccinct :: Job -> Job setSuccinct job | verbose job = job { exclude = Succinct : exclude job } diff --git a/src/Language/SystemVerilog/AST/ModuleItem.hs b/src/Language/SystemVerilog/AST/ModuleItem.hs --- a/src/Language/SystemVerilog/AST/ModuleItem.hs +++ b/src/Language/SystemVerilog/AST/ModuleItem.hs @@ -13,7 +13,6 @@ , NInputGateKW (..) , NOutputGateKW (..) , AssignOption (..) - , Severity (..) , AssertionItem (..) ) where @@ -25,10 +24,10 @@ import Language.SystemVerilog.AST.Attr (Attr) import Language.SystemVerilog.AST.Decl (Direction) import Language.SystemVerilog.AST.Description (PackageItem) -import Language.SystemVerilog.AST.Expr (Expr(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args) +import Language.SystemVerilog.AST.Expr (Expr(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args(Args)) import Language.SystemVerilog.AST.GenItem (GenItem) import Language.SystemVerilog.AST.LHS (LHS) -import Language.SystemVerilog.AST.Stmt (Stmt, Assertion, Timing(Delay), PropertySpec, SeqExpr) +import Language.SystemVerilog.AST.Stmt (Stmt, Assertion, Severity, Timing(Delay), PropertySpec, SeqExpr) import Language.SystemVerilog.AST.Type (Identifier, Strength0, Strength1) data ModuleItem @@ -42,10 +41,10 @@ | Modport Identifier [ModportDecl] | Initial Stmt | Final Stmt - | ElabTask Severity Args + | ElabTask Severity [Expr] | MIPackageItem PackageItem - | NInputGate NInputGateKW Expr Identifier LHS [Expr] - | NOutputGate NOutputGateKW Expr Identifier [LHS] Expr + | NInputGate NInputGateKW Expr Identifier [Range] LHS [Expr] + | NOutputGate NOutputGateKW Expr Identifier [Range] [LHS] Expr | AssertionItem AssertionItem deriving Eq @@ -60,11 +59,11 @@ show (Modport x l) = printf "modport %s(\n%s\n);" x (indent $ intercalate ",\n" $ map showModportDecl l) show (Initial s ) = printf "initial %s" (show s) show (Final s ) = printf "final %s" (show s) - show (ElabTask s a) = printf "%s%s;" (show s) (show a) - show (NInputGate kw d x lhs exprs) = - showGate kw d x $ show lhs : map show exprs - show (NOutputGate kw d x lhss expr) = - showGate kw d x $ (map show lhss) ++ [show expr] + show (ElabTask s a) = printf "%s%s;" (show s) (show $ Args a []) + show (NInputGate kw d x rs lhs exprs) = + showGate kw d x rs $ show lhs : map show exprs + show (NOutputGate kw d x rs lhss expr) = + showGate kw d x rs $ (map show lhss) ++ [show expr] show (AssertionItem i) = show i show (Instance m params i rs ports) = if null params @@ -82,12 +81,13 @@ then show arg else printf ".%s(%s)" i (show arg) -showGate :: Show k => k -> Expr -> Identifier -> [String] -> String -showGate kw d x args = - printf "%s %s%s(%s);" (show kw) delayStr nameStr (commas args) +showGate :: Show k => k -> Expr -> Identifier -> [Range] -> [String] -> String +showGate kw d x rs args = + printf "%s %s%s%s(%s);" (show kw) delayStr nameStr rsStr (commas args) where delayStr = if d == Nil then "" else showPad $ Delay d nameStr = showPad $ Ident x + rsStr = if null rs then "" else tail $ showRanges rs showModportDecl :: ModportDecl -> String showModportDecl (dir, ident, e) = @@ -148,19 +148,6 @@ show AssignOptionNone = "" show (AssignOptionDelay de) = printf "#(%s)" (show de) show (AssignOptionDrive s0 s1) = printf "(%s, %s)" (show s0) (show s1) - -data Severity - = SeverityInfo - | SeverityWarning - | SeverityError - | SeverityFatal - deriving Eq - -instance Show Severity where - show SeverityInfo = "$info" - show SeverityWarning = "$warning" - show SeverityError = "$error" - show SeverityFatal = "$fatal" data AssertionItem = MIAssertion Identifier Assertion diff --git a/src/Language/SystemVerilog/AST/Stmt.hs b/src/Language/SystemVerilog/AST/Stmt.hs --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/src/Language/SystemVerilog/AST/Stmt.hs @@ -23,6 +23,7 @@ , PropertySpec (..) , ViolationCheck (..) , BlockKW (..) + , Severity (..) ) where import Text.Printf (printf) @@ -50,6 +51,7 @@ | Timing Timing Stmt | Return Expr | Subroutine Expr Args + | SeverityStmt Severity [Expr] | Trigger Bool Identifier | Assertion Assertion | Force Bool LHS Expr @@ -86,6 +88,7 @@ where showInit (l, e) = showAssign (l, AsgnOpEq, e) show (Subroutine e a) = printf "%s%s;" (show e) aStr where aStr = if a == Args [] [] then "" else show a + show (SeverityStmt s a) = printf "%s%s;" (show s) (show $ Args a []) show (Asgn o t v e) = printf "%s %s %s%s;" (show v) (show o) tStr (show e) where tStr = maybe "" showPad t show (If u c s1 s2) = @@ -232,6 +235,10 @@ | PropExprFollowsO SeqExpr PropExpr | PropExprFollowsNO SeqExpr PropExpr | PropExprIff PropExpr PropExpr + | PropExprNeg PropExpr + | PropExprStrong SeqExpr + | PropExprWeak SeqExpr + | PropExprNextTime Bool Expr PropExpr deriving Eq instance Show PropExpr where show (PropExpr se) = show se @@ -240,6 +247,14 @@ show (PropExprFollowsO a b) = printf "(%s #-# %s)" (show a) (show b) show (PropExprFollowsNO a b) = printf "(%s #=# %s)" (show a) (show b) show (PropExprIff a b) = printf "(%s iff %s)" (show a) (show b) + show (PropExprNeg pe) = printf "not (%s)" (show pe) + show (PropExprStrong se) = printf "strong (%s)" (show se) + show (PropExprWeak se) = printf "weak (%s)" (show se) + show (PropExprNextTime strong index prop) = + printf "%s%s (%s)" kwStr indexStr (show prop) + where + kwStr = (if strong then "s_" else "") ++ "nexttime" + indexStr = if index == Nil then "" else printf " [%s]" (show index) data SeqMatchItem = SeqMatchAsgn (LHS, AsgnOp, Expr) | SeqMatchCall Identifier Args @@ -339,3 +354,16 @@ blockEndToken :: BlockKW -> Identifier blockEndToken Seq = "end" blockEndToken Par = "join" + +data Severity + = SeverityInfo + | SeverityWarning + | SeverityError + | SeverityFatal + deriving Eq + +instance Show Severity where + show SeverityInfo = "$info" + show SeverityWarning = "$warning" + show SeverityError = "$error" + show SeverityFatal = "$fatal" diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -57,6 +57,7 @@ show (Alias xx rs) = printf "%s%s" xx (showRanges rs) show (PSAlias ps xx rs) = printf "%s::%s%s" ps xx (showRanges rs) show (CSAlias ps pm xx rs) = printf "%s#%s::%s%s" ps (showParams pm) xx (showRanges rs) + show (Implicit sg []) = show sg show (Implicit sg rs) = printf "%s%s" (showPad sg) (dropWhile (== ' ') $ showRanges rs) show (IntegerVector kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs) show (IntegerAtom kw sg ) = printf "%s%s" (show kw) (showPadBefore sg) diff --git a/src/Language/SystemVerilog/Parser.hs b/src/Language/SystemVerilog/Parser.hs --- a/src/Language/SystemVerilog/Parser.hs +++ b/src/Language/SystemVerilog/Parser.hs @@ -19,9 +19,11 @@ import Language.SystemVerilog.Parser.Lex (lexStr) import Language.SystemVerilog.Parser.Parse (parse) import Language.SystemVerilog.Parser.Preprocess (preprocess, annotate, Env, Contents) +import Language.SystemVerilog.Parser.Tokens (Position) type Output = (FilePath, AST) type Strings = Set.Set String +type Positions = Map.Map String Position data Config = Config { cfDefines :: [String] @@ -36,7 +38,7 @@ { ctConfig :: Config , ctEnv :: Env , ctUsed :: Strings - , ctHave :: Strings + , ctHave :: Positions } -- parse CLI macro definitions into the internal macro environment format @@ -70,7 +72,8 @@ then return [] else parseFiles' context possibleFiles where - missingParts = Set.toList $ ctUsed context Set.\\ ctHave context + missingParts = Set.toList $ ctUsed context Set.\\ + (Map.keysSet $ ctHave context) libdirs = cfLibraryPaths $ ctConfig context lookupLibrary partName = ((partName, ) <$>) <$> lookupLibFile partName lookupLibFile = liftIO . findFile libdirs . (++ ".sv") @@ -78,7 +81,7 @@ -- load the files, but complain if an expected part is missing parseFiles' context ((part, path) : files) = do (context', ast) <- parseFile context path - let misdirected = not $ null part || Set.member part (ctHave context') + let misdirected = not $ null part || Map.member part (ctHave context') when misdirected $ throwError $ "Expected to find module or interface " ++ show part ++ " in file " ++ show path ++ " selected from the library path." @@ -89,9 +92,10 @@ parseFile context path = do (context', contents) <- preprocessFile context path tokens <- liftEither $ runExcept $ lexStr contents - (ast, used, have) <- parse (cfOversizedNumbers config) tokens + (ast, used, have') <- + parse (cfOversizedNumbers config) (ctHave context) tokens let context'' = context' { ctUsed = used <> ctUsed context - , ctHave = have <> ctHave context } + , ctHave = have' } return (context'', ast) where config = ctConfig context diff --git a/src/Language/SystemVerilog/Parser/Lex.x b/src/Language/SystemVerilog/Parser/Lex.x --- a/src/Language/SystemVerilog/Parser/Lex.x +++ b/src/Language/SystemVerilog/Parser/Lex.x @@ -108,6 +108,10 @@ "$high" { tok KW_dollar_high } "$increment" { tok KW_dollar_increment } "$size" { tok KW_dollar_size } + "$info" { tok KW_dollar_info } + "$warning" { tok KW_dollar_warning } + "$error" { tok KW_dollar_error } + "$fatal" { tok KW_dollar_fatal } "accept_on" { tok KW_accept_on } "alias" { tok KW_alias } diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -20,6 +20,7 @@ import Control.Monad.State.Strict import Data.Maybe (catMaybes, fromMaybe) import System.IO (hPutStrLn, stderr) +import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Language.SystemVerilog.AST import Language.SystemVerilog.Parser.ParseDecl @@ -45,6 +46,10 @@ "$high" { Token KW_dollar_high _ _ } "$increment" { Token KW_dollar_increment _ _ } "$size" { Token KW_dollar_size _ _ } +"$info" { Token KW_dollar_info _ _ } +"$warning" { Token KW_dollar_warning _ _ } +"$error" { Token KW_dollar_error _ _ } +"$fatal" { Token KW_dollar_fatal _ _ } "accept_on" { Token KW_accept_on _ _ } "alias" { Token KW_alias _ _ } @@ -409,6 +414,7 @@ %right "iff" %left "or" "," %left "and" +%nonassoc "not" "nexttime" "s_nexttime" %left "intersect" %left "within" %right "throughout" @@ -648,6 +654,7 @@ | NetTypeP Strength { uncurry DTNet $1 $2 } | PortBindingsP { uncurry DTPorts $1 } | SigningP { uncurry DTSigning $1 } + | SeverityP { uncurry DTSeverity $1 } | "[" Expr "]" { DTBit (tokenPosition $1) $2 } | "." Identifier { DTDot (tokenPosition $1) $2 } | "automatic" { DTLifetime (tokenPosition $1) Automatic } @@ -713,8 +720,8 @@ | "modport" ModportItems ";" { map (uncurry Modport) $2 } | NonDeclPackageItem { map MIPackageItem $1 } | TaskOrFunction { [MIPackageItem $1] } - | NInputGateKW NInputGates ";" { map (\(a, b, c, d) -> NInputGate $1 a b c d) $2 } - | NOutputGateKW NOutputGates ";" { map (\(a, b, c, d) -> NOutputGate $1 a b c d) $2 } + | NInputGateKW NInputGates ";" { map (\(a, b, c, d, e) -> NInputGate $1 a b c d e) $2 } + | NOutputGateKW NOutputGates ";" { map (\(a, b, c, d, e) -> NOutputGate $1 a b c d e) $2 } | AttributeInstance ModuleItem { map (addMIAttr $1) $2 } | AssertionItem { [AssertionItem $1] } @@ -789,6 +796,13 @@ | SeqExpr "#-#" PropExpr { PropExprFollowsO $1 $3 } | SeqExpr "#=#" PropExpr { PropExprFollowsNO $1 $3 } | PropExpr "iff" PropExpr { PropExprIff $1 $3 } + | "not" PropExpr { PropExprNeg $2 } + | "strong" "(" SeqExpr ")" { PropExprStrong $3 } + | "weak" "(" SeqExpr ")" { PropExprWeak $3 } + | "nexttime" PropExpr { PropExprNextTime False Nil $2 } + | "nexttime" "[" Expr "]" PropExpr { PropExprNextTime False $3 $5 } + | "s_nexttime" PropExpr { PropExprNextTime True Nil $2 } + | "s_nexttime" "[" Expr "]" PropExpr { PropExprNextTime True $3 $5 } SeqExpr :: { SeqExpr } : Expr { SeqExpr $1 } | SeqExprParens { $1 } @@ -839,23 +853,23 @@ AttrSpec :: { AttrSpec } : Identifier OptAsgn { ($1, $2) } -NInputGates :: { [(Expr, Identifier, LHS, [Expr])] } +NInputGates :: { [(Expr, Identifier, [Range], LHS, [Expr])] } : NInputGate { [$1] } | NInputGates "," NInputGate { $1 ++ [$3]} -NOutputGates :: { [(Expr, Identifier, [LHS], Expr)] } +NOutputGates :: { [(Expr, Identifier, [Range], [LHS], Expr)] } : NOutputGate { [$1] } | NOutputGates "," NOutputGate { $1 ++ [$3]} -NInputGate :: { (Expr, Identifier, LHS, [Expr]) } - : DelayControlOrNil OptIdentifier "(" LHS "," Exprs ")" { ($1, $2, $4, $6) } -NOutputGate :: { (Expr, Identifier, [LHS], Expr) } - : DelayControlOrNil OptIdentifier "(" Exprs "," Expr ")" { ($1, $2, map toLHS $4, $6) } +NInputGate :: { (Expr, Identifier, [Range], LHS, [Expr]) } + : DelayControlOrNil OptGateName "(" LHS "," Exprs ")" { ($1, fst $2, snd $2, $4, $6) } +NOutputGate :: { (Expr, Identifier, [Range], [LHS], Expr) } + : DelayControlOrNil OptGateName "(" Exprs "," Expr ")" { ($1, fst $2, snd $2, map toLHS $4, $6) } DelayControlOrNil :: { Expr } : DelayControl { $1 } | {- empty -} { Nil } -OptIdentifier :: { Identifier } - : Identifier { $1 } - | {- empty -} { "" } +OptGateName :: { (Identifier, [Range]) } + : Identifier Dimensions { ($1, $2) } + | {- empty -} { ("", []) } NInputGateKW :: { NInputGateKW } : "and" { GateAnd } @@ -1112,6 +1126,7 @@ | 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) } + | SeverityStmt ";" { $1 } | LHS ";" { Subroutine (lhsToExpr $1) (Args [] []) } | LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 } | Identifier "::" Identifier ";" { Subroutine (PSIdent $1 $3) (Args [] []) } @@ -1156,6 +1171,11 @@ : DelayOrEvent { Just $1 } | {- empty -} { Nothing } +SeverityStmt :: { Stmt } + : Severity { SeverityStmt $1 [] } + | Severity "(" ")" { SeverityStmt $1 [] } + | Severity "(" Exprs ")" { SeverityStmt $1 $3 } + 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 } @@ -1520,6 +1540,14 @@ | "$increment" { FnIncrement } | "$size" { FnSize } +Severity :: { Severity } + : SeverityP { snd $1 } +SeverityP :: { (Position, Severity) } + : "$info" { withPos $1 SeverityInfo } + | "$warning" { withPos $1 SeverityWarning } + | "$error" { withPos $1 SeverityError } + | "$fatal" { withPos $1 SeverityFatal } + MITrace :: { ModuleItem } : PITrace { MIPackageItem $1 } PITrace :: { PackageItem } @@ -1552,20 +1580,22 @@ , pTokens :: [Token] , pOversizedNumbers :: Bool , pPartsUsed :: Strings - , pPartsHave :: Strings + , pPartsHave :: Positions } type ParseState = StateT ParseData (ExceptT String IO) type Strings = Set.Set String +type Positions = Map.Map String Position -parse :: Bool -> [Token] -> ExceptT String IO (AST, Strings, Strings) -parse _ [] = return mempty -parse oversizedNumbers tokens = do +parse :: Bool -> Positions -> [Token] + -> ExceptT String IO (AST, Strings, Positions) +parse _ partsHave [] = return ([], Set.empty, partsHave) +parse oversizedNumbers partsHave tokens = do (ast, finalState) <- runStateT parseMain initialState return (ast, pPartsUsed finalState, pPartsHave finalState) where position = tokenPosition $ head tokens - initialState = ParseData position tokens oversizedNumbers mempty mempty + initialState = ParseData position tokens oversizedNumbers mempty partsHave positionKeep :: (Token -> ParseState a) -> ParseState a positionKeep cont = do @@ -1858,8 +1888,14 @@ recordPartHave :: Identifier -> ParseState () recordPartHave partName = do + currPos <- gets pPosition partsHave <- gets pPartsHave - let partsHave' = Set.insert partName partsHave - modify' $ \s -> s { pPartsHave = partsHave' } + case Map.lookup partName partsHave of + Nothing -> do + let partsHave' = Map.insert partName currPos partsHave + modify' $ \s -> s { pPartsHave = partsHave' } + Just prevPos -> + parseWarning currPos $ "Redefinition of " ++ show partName + ++ ". Previously defined at " ++ show prevPos ++ "." } diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -77,6 +77,7 @@ | DTLHSBase Position LHS | DTDot Position Identifier | DTSigning Position Signing + | DTSeverity Position Severity | DTLifetime Position Lifetime | DTAttr Position Attr | DTEnd Position Char @@ -160,23 +161,17 @@ -- internal; attempt to parse an elaboration system task asElabTask :: [DeclToken] -> Maybe ModuleItem -asElabTask tokens = do - DTIdent _ x@('$' : _) <- return $ head tokens - severity <- lookup x elabTasks +asElabTask (DTSeverity _ severity : toks) = Just $ ElabTask severity args where args = - case tail tokens of - [DTEnd{}] -> Args [] [] - [DTPorts _ ports, DTEnd{}] -> portsToArgs ports + case toks of + [DTEnd{}] -> [] + [DTPorts _ ports, DTEnd{}] -> portsToExprs (head toks) ports DTPorts{} : tok : _ -> parseError tok msg - toks -> parseError (head toks) msg + _ -> parseError (head toks) msg msg = "unexpected token after elaboration system task" - --- lookup table for elaboration system task severities -elabTasks :: [(String, Severity)] -elabTasks = map (\x -> (show x, x)) - [SeverityInfo, SeverityWarning, SeverityError, SeverityFatal] +asElabTask _ = Nothing -- internal; parser for module instantiations parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem] @@ -261,6 +256,13 @@ -- internal; parser for leading statements in a procedural block parseDTsAsStmt :: [DeclToken] -> [Stmt] +parseDTsAsStmt (tok@(DTSeverity _ severity) : toks) = + [traceStmt tok, SeverityStmt severity args] + where + args = case init toks of + [] -> [] + [DTPorts _ ports] -> portsToExprs (head toks) ports + extraTok : _ -> parseError extraTok "unexpected severity task token" parseDTsAsStmt l0 = [traceStmt $ head l0, stmt] where @@ -291,6 +293,13 @@ pnArgs = map snd pnBindings kwArgs = kwBindings +-- converts port bindings to a list of expressions +portsToExprs :: DeclToken -> [PortBinding] -> [Expr] +portsToExprs tok bindings = + case portsToArgs bindings of + Args args [] -> args + _ -> parseError tok "unexpected keyword argument" + -- [PUBLIC]: parser for comma-separated declarations or assignment lists; this -- is only used for `for` loop initialization lists parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)] @@ -669,6 +678,7 @@ tokPos (DTLHSBase p _) = p tokPos (DTDot p _) = p tokPos (DTSigning p _) = p +tokPos (DTSeverity p _) = p tokPos (DTLifetime p _) = p tokPos (DTAttr p _) = p tokPos (DTEnd p _) = p diff --git a/src/Language/SystemVerilog/Parser/Tokens.hs b/src/Language/SystemVerilog/Parser/Tokens.hs --- a/src/Language/SystemVerilog/Parser/Tokens.hs +++ b/src/Language/SystemVerilog/Parser/Tokens.hs @@ -39,6 +39,10 @@ | KW_dollar_high | KW_dollar_increment | KW_dollar_size + | KW_dollar_info + | KW_dollar_warning + | KW_dollar_error + | KW_dollar_fatal | KW_accept_on | KW_alias | KW_always diff --git a/src/Split.hs b/src/Split.hs new file mode 100644 --- /dev/null +++ b/src/Split.hs @@ -0,0 +1,106 @@ +{- sv2v + - Author: Zachary Snow + - + - Split descriptions into individual files + -} + +module Split (splitDescriptions) where + +import Data.List (isPrefixOf) + +import Language.SystemVerilog.AST + +splitDescriptions :: AST -> [PackageItem] -> ([(String, AST)], [PackageItem]) +splitDescriptions (PackageItem item : ungrouped) itemsBefore = + (grouped, item : itemsAfter) + where + (grouped, itemsAfter) = splitDescriptions ungrouped (item : itemsBefore) +splitDescriptions (description : descriptions) itemsBefore = + ((name, surrounded) : grouped, itemsAfter) + where + (grouped, itemsAfter) = splitDescriptions descriptions itemsBefore + name = case description of + Part _ _ _ _ x _ _ -> x + Package _ x _ -> x + Class _ x _ _ -> x + surrounded = surroundDescription itemsBefore description itemsAfter +splitDescriptions [] _ = ([], []) + +data SurroundState = SurroundState + { sKeptBefore :: [PackageItem] + , sKeptAfter :: [PackageItem] + , sCellDefine :: Bool + , sUnconnectedDrive :: Maybe PackageItem + , sDefaultNettype :: Maybe PackageItem + , sComment :: Maybe PackageItem + } + +-- filter and include the surrounding package items for this description +surroundDescription :: [PackageItem] -> Description -> [PackageItem] -> AST +surroundDescription itemsBefore description itemsAfter = + map PackageItem itemsBefore' ++ description : map PackageItem itemsAfter' + where + itemsBefore' = extraBefore ++ reverse (sKeptBefore state2) + itemsAfter' = sKeptAfter state2 ++ reverse extraAfter + + state0 = SurroundState [] [] False Nothing Nothing Nothing + state1 = foldr stepBefore state0 itemsBefore + state2 = foldr stepAfter state1 itemsAfter + + (extraBefore, extraAfter) = foldr (<>) mempty $ map ($ state2) $ + [ applyLeader sDefaultNettype + , applyCellDefine + , applyUnconnectedDrive + , applyLeader sComment + ] + +applyCellDefine :: SurroundState -> ([PackageItem], [PackageItem]) +applyCellDefine state + | sCellDefine state = + ([Directive "`celldefine"], [Directive "`endcelldefine"]) + | otherwise = ([], []) + +applyUnconnectedDrive :: SurroundState -> ([PackageItem], [PackageItem]) +applyUnconnectedDrive state + | Just item <- sUnconnectedDrive state = + ([item], [Directive "`nounconnected_drive"]) + | otherwise = ([], []) + +applyLeader :: (SurroundState -> Maybe PackageItem) -> SurroundState + -> ([PackageItem], [PackageItem]) +applyLeader getter state + | Just item <- getter state = ([item], []) + | otherwise = ([], []) + +-- update the state with a pre-description item +stepBefore :: PackageItem -> SurroundState -> SurroundState +stepBefore item@(Decl CommentDecl{}) state = + state { sComment = Just item } +stepBefore item@(Directive directive) state + | matches "celldefine" = state { sCellDefine = True } + | matches "endcelldefine" = state { sCellDefine = False } + | matches "unconnected_drive" = state { sUnconnectedDrive = Just item } + | matches "nounconnected_drive" = state { sUnconnectedDrive = Nothing } + | matches "default_nettype" = state { sDefaultNettype = Just item } + | matches "resetall" = state + { sCellDefine = False + , sUnconnectedDrive = Nothing + , sDefaultNettype = Nothing + } + where matches = flip isPrefixOf directive . ('`' :) +stepBefore item state = + state { sKeptBefore = item : sKeptBefore state } + +-- update the state with a post-description item +stepAfter :: PackageItem -> SurroundState -> SurroundState +stepAfter (Decl CommentDecl{}) state = state +stepAfter (Directive directive) state + | matches "celldefine" = state + | matches "endcelldefine" = state + | matches "unconnected_drive" = state + | matches "nounconnected_drive" = state + | matches "default_nettype" = state + | matches "resetall" = state + where matches = flip isPrefixOf directive . ('`' :) +stepAfter item state = + state { sKeptAfter = item : sKeptAfter state } diff --git a/src/sv2v.hs b/src/sv2v.hs --- a/src/sv2v.hs +++ b/src/sv2v.hs @@ -12,10 +12,12 @@ import Control.Monad.Except (runExceptT) import Data.List (nub) +import Bugpoint (runBugpoint) import Convert (convert) import Job (readJob, Job(..), Write(..)) import Language.SystemVerilog.AST import Language.SystemVerilog.Parser (parseFiles, Config(..)) +import Split (splitDescriptions) isComment :: Description -> Bool isComment (PackageItem (Decl CommentDecl{})) = True @@ -60,17 +62,6 @@ ext = ".sv" (base, end) = splitExtension path -splitModules :: FilePath -> AST -> [(FilePath, String)] -splitModules dir (PackageItem (Decl CommentDecl{}) : ast) = - splitModules dir ast -splitModules dir (description : ast) = - (path, output) : splitModules dir ast - where - Part _ _ Module _ name _ _ = description - path = combine dir $ name ++ ".v" - output = show description ++ "\n" -splitModules _ [] = [] - writeOutput :: Write -> [FilePath] -> [AST] -> IO () writeOutput _ [] [] = hPutStrLn stderr "Warning: No input files specified (try `sv2v --help`)" @@ -82,9 +73,16 @@ outPaths <- mapM rewritePath inPaths let results = map (++ "\n") $ map show asts zipWithM_ writeFile outPaths results -writeOutput (Directory d) _ asts = do - let (outPaths, outputs) = unzip $ splitModules d $ concat asts +writeOutput (Directory d) _ asts = zipWithM_ writeFile outPaths outputs + where + (outPaths, outputs) = + unzip $ map prepare $ fst $ splitDescriptions (concat asts) [] + prepare :: (String, AST) -> (FilePath, String) + prepare (name, ast) = (path, output) + where + path = combine d $ name ++ ".v" + output = concatMap (++ "\n") $ map show ast main :: IO () main = do @@ -110,6 +108,8 @@ asts' <- if passThrough job then return asts + else if bugpoint job /= [] then + runBugpoint (bugpoint job) converter asts else converter asts emptyWarnings (concat asts) (concat asts') diff --git a/sv2v.cabal b/sv2v.cabal --- a/sv2v.cabal +++ b/sv2v.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: sv2v -version: 0.0.12 +version: 0.0.13 license: BSD-3-Clause license-file: LICENSE NOTICE maintainer: Zachary Snow @@ -24,7 +24,7 @@ executable sv2v main-is: sv2v.hs - build-tool-depends: alex:alex >=3.2 && <4, happy:happy >=1.19 && <2 + build-tool-depends: alex:alex >=3.2 && <4, happy:happy >=1.19 && <3 hs-source-dirs: src other-modules: Language.SystemVerilog @@ -82,9 +82,11 @@ Convert.ParamNoDefault Convert.ParamType Convert.PortDecl + Convert.PortDefault Convert.RemoveComments Convert.ResolveBindings Convert.Scoper + Convert.SeverityTask Convert.Simplify Convert.Stream Convert.StringParam @@ -101,7 +103,9 @@ Convert.UnpackedArray Convert.Unsigned Convert.Wildcard + Bugpoint Job + Split Paths_sv2v autogen-modules: Paths_sv2v @@ -112,13 +116,13 @@ -funbox-strict-fields -Wall -Wno-incomplete-uni-patterns build-depends: - array >=0.5.6.0 && <0.6, - base >=4.18.2.0 && <4.19, - cmdargs >=0.10.22 && <0.11, - containers >=0.6.7 && <0.7, - directory >=1.3.8.1 && <1.4, - filepath >=1.4.200.1 && <1.5, - githash >=0.1.7.0 && <0.2, - hashable >=1.4.4.0 && <1.5, - mtl >=2.3.1 && <2.4, - vector >=0.13.1.0 && <0.14 + array <0.6, + base <4.19, + cmdargs <0.11, + containers <0.7, + directory <1.4, + filepath <1.5, + githash <0.2, + hashable <1.5, + mtl <2.4, + vector <0.14