luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

cleanup case representation

This commit is contained in:
Zachary Snow 2019-12-01 23:25:33 -05:00
parent 92d827f3a5
commit 96fe986b2d
6 changed files with 62 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Convert/Jump.hs
View File

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

22
src/Convert/Traverse.hs
View File

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

16
src/Convert/Unique.hs
View File

@ -1,11 +1,11 @@
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
-
- 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

18
src/Language/SystemVerilog/AST/GenItem.hs
View File

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

31
src/Language/SystemVerilog/AST/Stmt.hs
View File

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

40
src/Language/SystemVerilog/Parser/Parse.y
View File

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