From 96fe986b2d8ce4976b0234f125e126117985116a Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Sun, 1 Dec 2019 23:25:33 -0500 Subject: [PATCH] cleanup case representation --- src/Convert/Jump.hs | 16 +++------ src/Convert/Traverse.hs | 22 +++++-------- src/Convert/Unique.hs | 16 ++++----- src/Language/SystemVerilog/AST/GenItem.hs | 18 ++++------ src/Language/SystemVerilog/AST/Stmt.hs | 31 +++++++++--------- src/Language/SystemVerilog/Parser/Parse.y | 40 +++++++++++------------ 6 files changed, 62 insertions(+), 81 deletions(-) diff --git a/src/Convert/Jump.hs b/src/Convert/Jump.hs index 3db2d53..0917778 100644 --- a/src/Convert/Jump.hs +++ b/src/Convert/Jump.hs @@ -4,7 +4,7 @@ - Conversion for `return`, `break`, and `continue` - - Because Verilog-2005 has no jumping statements, this conversion ends up - - producing significantly more verbose code to acheive the same control flow. + - producing significantly more verbose code to achieve the same control flow. -} module Convert.Jump (convert) where @@ -115,7 +115,7 @@ convertStmt (Block Seq x decls stmts) = do let comp = BinOp Eq (Ident loopID) runLoop let stmt = Block Seq "" [] ss' modify $ \t -> t { sJumpType = jt' } - return [s', If Nothing comp stmt Null] + return [s', If NoCheck comp stmt Null] else do return [Null] isBranch :: Stmt -> Bool @@ -130,19 +130,13 @@ convertStmt (If unique expr thenStmt elseStmt) = do modify $ \s -> s { sJumpType = newJT } return $ If unique expr thenStmt' elseStmt' -convertStmt (Case unique kw expr cases mdef) = do - (mdef', mdefJT) <- - case mdef of - Nothing -> return (Nothing, JTNone) - Just stmt -> do - (stmt', jt) <- convertSubStmt stmt - return (Just stmt', jt) +convertStmt (Case unique kw expr cases) = do results <- mapM convertSubStmt $ map snd cases let (stmts', jts) = unzip results let cases' = zip (map fst cases) stmts' - let newJT = foldl max mdefJT jts + let newJT = foldl max JTNone jts modify $ \s -> s { sJumpType = newJT } - return $ Case unique kw expr cases' mdef' + return $ Case unique kw expr cases' convertStmt (For inits comp incr stmt) = convertLoop loop comp stmt diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 28fbd7f..5d8a072 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -116,10 +116,6 @@ traverseDescriptions = unmonad traverseDescriptionsM collectDescriptionsM :: Monad m => CollectorM m Description -> CollectorM m AST collectDescriptionsM = collectify traverseDescriptionsM -maybeDo :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b) -maybeDo _ Nothing = return Nothing -maybeDo fun (Just val) = fun val >>= return . Just - traverseModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m Description traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = do items' <- mapM fullMapper items @@ -240,11 +236,10 @@ traverseSinglyNestedStmtsM fullMapper = cs explode other = [other] cs (Block kw name decls stmts) = mapM fullMapper stmts >>= return . Block kw name decls - cs (Case u kw expr cases def) = do + cs (Case u kw expr cases) = do caseStmts <- mapM fullMapper $ map snd cases let cases' = zip (map fst cases) caseStmts - def' <- maybeDo fullMapper def - return $ Case u kw expr cases' def' + return $ Case u kw expr cases' cs (AsgnBlk op lhs expr) = return $ AsgnBlk op lhs expr cs (Asgn mt lhs expr) = return $ Asgn mt lhs expr cs (For a b c stmt) = fullMapper stmt >>= return . For a b c @@ -647,11 +642,11 @@ traverseExprsM' strat exprMapper = moduleItemMapper genItemMapper (GenIf e i1 i2) = do e' <- exprMapper e return $ GenIf e' i1 i2 - genItemMapper (GenCase e cases def) = do + genItemMapper (GenCase e cases) = do e' <- exprMapper e caseExprs <- mapM (mapM exprMapper . fst) cases let cases' = zip caseExprs (map snd cases) - return $ GenCase e' cases' def + return $ GenCase e' cases' genItemMapper other = return other modportDeclMapper (dir, ident, Just e) = do @@ -688,10 +683,10 @@ traverseStmtExprsM exprMapper = flatStmtMapper flatStmtMapper (Block kw name decls stmts) = do decls' <- mapM declMapper decls return $ Block kw name decls' stmts - flatStmtMapper (Case u kw e cases def) = do + flatStmtMapper (Case u kw e cases) = do e' <- exprMapper e cases' <- mapM caseMapper cases - return $ Case u kw e' cases' def + return $ Case u kw e' cases' flatStmtMapper (AsgnBlk op lhs expr) = do lhs' <- lhsMapper lhs expr' <- exprMapper expr @@ -954,11 +949,10 @@ traverseSinglyNestedGenItemsM fullMapper = gim i1' <- fullMapper i1 i2' <- fullMapper i2 return $ GenIf e i1' i2' - gim (GenCase e cases def) = do + gim (GenCase e cases) = do caseItems <- mapM (fullMapper . snd) cases let cases' = zip (map fst cases) caseItems - def' <- maybeDo fullMapper def - return $ GenCase e cases' def' + return $ GenCase e cases' gim (GenModuleItem moduleItem) = return $ GenModuleItem moduleItem gim (GenNull) = return GenNull diff --git a/src/Convert/Unique.hs b/src/Convert/Unique.hs index 2d46164..65d85ae 100644 --- a/src/Convert/Unique.hs +++ b/src/Convert/Unique.hs @@ -1,11 +1,11 @@ {- sv2v - Author: Zachary Snow - - - Conversion for `unique`, `unique0`, and `priority` + - Conversion for `unique`, `unique0`, and `priority` (verification checks) - - - This conversion simply drops the keywords, as it is used only for - - optimization. There is no way to force toolchains which don't support - - the keyword to perform such optimization. + - This conversion simply drops these keywords, as they are only used for + - optimization and verification. There may be ways to communicate these + - attributes to certain downstream toolchains. -} module Convert.Unique (convert) where @@ -18,8 +18,8 @@ convert = map $ traverseDescriptions $ traverseModuleItems $ traverseStmts convertStmt convertStmt :: Stmt -> Stmt -convertStmt (If (Just _) cc s1 s2) = - If Nothing cc s1 s2 -convertStmt (Case (Just _) kw expr cases def) = - Case Nothing kw expr cases def +convertStmt (If _ cc s1 s2) = + If NoCheck cc s1 s2 +convertStmt (Case _ kw expr cases) = + Case NoCheck kw expr cases convertStmt other = other diff --git a/src/Language/SystemVerilog/AST/GenItem.hs b/src/Language/SystemVerilog/AST/GenItem.hs index 53ec954..673a6a4 100644 --- a/src/Language/SystemVerilog/AST/GenItem.hs +++ b/src/Language/SystemVerilog/AST/GenItem.hs @@ -21,7 +21,7 @@ import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem) data GenItem = GenBlock Identifier [GenItem] - | GenCase Expr [GenCase] (Maybe GenItem) + | GenCase Expr [GenCase] | GenFor (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) GenItem | GenIf Expr GenItem GenItem | GenNull @@ -34,13 +34,9 @@ instance Show GenItem where printf "begin%s\n%s\nend" (if null x then "" else " : " ++ x) (indent $ unlines' $ map show i) - show (GenCase e cs def) = - printf "case (%s)\n%s%s\nendcase" (show e) bodyStr defStr - where - bodyStr = indent $ unlines' $ map showCase cs - defStr = case def of - Nothing -> "" - Just c -> printf "\n\tdefault: %s" (show c) + show (GenCase e cs) = + printf "case (%s)\n%s\nendcase" (show e) bodyStr + where bodyStr = indent $ unlines' $ map showGenCase cs show (GenIf e a GenNull) = printf "if (%s) %s" (show e) (show a) show (GenIf e a b ) = printf "if (%s) %s\nelse %s" (show e) (show a) (show b) show (GenFor (new, x1, e1) c (x2, o2, e2) s) = @@ -55,6 +51,6 @@ instance Show GenItem where type GenCase = ([Expr], GenItem) -showCase :: (Show x, Show y) => ([x], y) -> String -showCase (a, b) = printf "%s: %s" (commas $ map show a) (show b) - +showGenCase :: GenCase -> String +showGenCase (a, b) = printf "%s: %s" exprStr (show b) + where exprStr = if null a then "default" else commas $ map show a diff --git a/src/Language/SystemVerilog/AST/Stmt.hs b/src/Language/SystemVerilog/AST/Stmt.hs index b5e6326..12b8ed9 100644 --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/src/Language/SystemVerilog/AST/Stmt.hs @@ -19,7 +19,7 @@ module Language.SystemVerilog.AST.Stmt , AssertionExpr , Assertion (..) , PropertySpec (..) - , UniquePriority (..) + , ViolationCheck (..) , BlockKW (..) ) where @@ -36,7 +36,7 @@ import Language.SystemVerilog.AST.Type (Identifier) data Stmt = StmtAttr Attr Stmt | Block BlockKW Identifier [Decl] [Stmt] - | Case (Maybe UniquePriority) CaseKW Expr [Case] (Maybe Stmt) + | Case ViolationCheck CaseKW Expr [Case] | For (Either [Decl] [(LHS, Expr)]) Expr [(LHS, AsgnOp, Expr)] Stmt | AsgnBlk AsgnOp LHS Expr | Asgn (Maybe Timing) LHS Expr @@ -45,7 +45,7 @@ data Stmt | DoWhile Expr Stmt | Forever Stmt | Foreach Identifier [Maybe Identifier] Stmt - | If (Maybe UniquePriority) Expr Stmt Stmt + | If ViolationCheck Expr Stmt Stmt | Timing Timing Stmt | Return Expr | Subroutine Expr Args @@ -64,13 +64,9 @@ instance Show Stmt where header = if null name then "" else " : " ++ name bodyLines = (map show decls) ++ (map show stmts) body = indent $ unlines' bodyLines - show (Case u kw e cs def) = - printf "%s%s (%s)\n%s%s\nendcase" (maybe "" showPad u) (show kw) (show e) bodyStr defStr - where - bodyStr = indent $ unlines' $ map showCase cs - defStr = case def of - Nothing -> "" - Just c -> printf "\n\tdefault: %s" (show c) + show (Case u kw e cs) = + printf "%s%s (%s)\n%s\nendcase" (showPad u) (show kw) (show e) bodyStr + where bodyStr = indent $ unlines' $ map showCase cs show (For inits cond assigns stmt) = printf "for (%s; %s; %s)\n%s" (showInits inits) @@ -93,8 +89,8 @@ instance Show Stmt where show (DoWhile e s) = printf "do %s while (%s);" (show s) (show e) show (Forever s ) = printf "forever %s" (show s) show (Foreach x i s) = printf "foreach (%s [ %s ]) %s" x (commas $ map (maybe "" id) i) (show s) - show (If u a b Null) = printf "%sif (%s)%s" (maybe "" showPad u) (show a) (showBranch b) - show (If u a b c ) = printf "%sif (%s)%s\nelse%s" (maybe "" showPad u) (show a) (showBlockedBranch b) (showElseBranch c) + show (If u a b Null) = printf "%sif (%s)%s" (showPad u) (show a) (showBranch b) + show (If u a b c ) = printf "%sif (%s)%s\nelse%s" (showPad u) (show a) (showBlockedBranch b) (showElseBranch c) show (Return e ) = printf "return %s;" (show e) show (Timing t s ) = printf "%s%s" (show t) (showShortBranch s) show (Trigger b x) = printf "->%s %s;" (if b then "" else ">") x @@ -134,8 +130,9 @@ showShortBranch (stmt @ AsgnBlk{}) = ' ' : show stmt showShortBranch (stmt @ Asgn{}) = ' ' : show stmt showShortBranch stmt = showBranch stmt -showCase :: ([Expr], Stmt) -> String -showCase (a, b) = printf "%s:%s" (commas $ map show a) (showShortBranch b) +showCase :: Case -> String +showCase (a, b) = printf "%s:%s" exprStr (showShortBranch b) + where exprStr = if null a then "default" else commas $ map show a data CaseKW = CaseN @@ -252,16 +249,18 @@ instance Show PropertySpec where Nothing -> "" Just e -> printf "disable iff (%s)" (show e) -data UniquePriority +data ViolationCheck = Unique | Unique0 | Priority + | NoCheck deriving Eq -instance Show UniquePriority where +instance Show ViolationCheck where show Unique = "unique" show Unique0 = "unique0" show Priority = "priority" + show NoCheck = "" data BlockKW = Seq diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index be842e1..536b564 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -920,7 +920,7 @@ StmtNonBlock :: { Stmt } | Unique "if" "(" Expr ")" Stmt "else" Stmt { If $1 $4 $6 $8 } | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null } | "for" "(" ForInit ForCond ForStep ")" Stmt { For $3 $4 $5 $7 } - | Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 (fst $6) (snd $6) } + | Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 $6 } | TimingControl Stmt { Timing $1 $2 } | "return" Expr ";" { Return $2 } | "return" ";" { Return Nil } @@ -942,11 +942,11 @@ BlockKWPar :: { BlockKW } BlockKWSeq :: { BlockKW } : "begin" { Seq } -Unique :: { Maybe UniquePriority } - : {- empty -} { Nothing } - | "unique" { Just Unique } - | "unique0" { Just Unique0 } - | "priority" { Just Priority } +Unique :: { ViolationCheck } + : {- empty -} { NoCheck } + | "unique" { Unique } + | "unique0" { Unique0 } + | "priority" { Priority } ForInit :: { Either [Decl] [(LHS, Expr)] } : ";" { Right [] } @@ -1045,17 +1045,16 @@ CaseKW :: { CaseKW } | "casex" { CaseX } | "casez" { CaseZ } -Cases :: { ([Case], Maybe Stmt) } - : {- empty -} { ([], Nothing) } - | Case Cases { ($1 : fst $2, snd $2) } - | CaseDefault CasesNoDefault { ($2, Just $1) } +Cases :: { [Case] } + : {- empty -} { [] } + | Case Cases { $1 : $2 } + | CaseDefault CasesNoDefault { ([], $1) : $2 } CasesNoDefault :: { [Case] } - : {- empty -} { [] } - | CasesNoDefault Case { $1 ++ [$2] } + : {- empty -} { [] } + | CasesNoDefault Case { $1 ++ [$2] } Case :: { Case } : Exprs ":" Stmt { ($1, $3) } - CaseDefault :: { Stmt } : "default" opt(":") Stmt { $3 } @@ -1209,24 +1208,23 @@ GenItem :: { GenItem } ConditionalGenerateConstruct :: { GenItem } : "if" "(" Expr ")" GenItemOrNull "else" GenItemOrNull { GenIf $3 $5 $7 } | "if" "(" Expr ")" GenItemOrNull %prec NoElse { GenIf $3 $5 GenNull } - | "case" "(" Expr ")" GenCasesWithDefault "endcase" { GenCase $3 (fst $5) (snd $5) } + | "case" "(" Expr ")" GenCases "endcase" { GenCase $3 $5 } LoopGenerateConstruct :: { GenItem } : "for" "(" GenvarInitialization ";" Expr ";" GenvarIteration ")" GenItem { GenFor $3 $5 $7 $9 } GenBlock :: { (Identifier, [GenItem]) } : "begin" StrTag GenItems "end" StrTag { (combineTags $2 $5, $3) } -GenCasesWithDefault :: { ([GenCase], Maybe GenItem) } - : {- empty -} { ([], Nothing) } - | GenCase GenCasesWithDefault { ($1 : fst $2, snd $2) } - | GenCaseDefault GenCases { ($2, Just $1) } GenCases :: { [GenCase] } - : {- empty -} { [] } - | GenCases GenCase { $1 ++ [$2] } + : {- empty -} { [] } + | GenCase GenCases { $1 : $2 } + | GenCaseDefault GenCasesNoDefault { ([], $1) : $2 } +GenCasesNoDefault :: { [GenCase] } + : {- empty -} { [] } + | GenCasesNoDefault GenCase { $1 ++ [$2] } GenCase :: { GenCase } : Exprs ":" GenItemOrNull { ($1, $3) } - GenCaseDefault :: { GenItem } : "default" opt(":") GenItemOrNull { $3 }