cleanup case representation

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

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

src/Convert/Unique.hs

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

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

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

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] }
 
 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] }
+  | 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 }