support for inside case statements

src/Language/SystemVerilog/AST/Expr.hs

@@ -16,6 +16,7 @@ module Language.SystemVerilog.AST.Expr
     , DimFn (..)
     , showAssignment
     , showRanges
+    , showExprOrRange
     , simplify
     , rangeSize
     , endianCondExpr
@@ -85,9 +86,6 @@ instance Show Expr where
     show (Inside  e l  ) = printf "(%s inside { %s })"  (show e) (intercalate ", " strs)
         where
             strs = map showExprOrRange l
-            showExprOrRange :: ExprOrRange -> String
-            showExprOrRange (Left  x) = show x
-            showExprOrRange (Right x) = show x
     show (Pattern l    ) =
         printf "'{\n%s\n}" (indent $ intercalate ",\n" $ map showPatternItem l)
         where
@@ -159,6 +157,10 @@ showRanges l = " " ++ (concatMap showRange l)
 showRange :: Range -> String
 showRange (h, l) = printf "[%s:%s]" (show h) (show l)
 
+showExprOrRange :: ExprOrRange -> String
+showExprOrRange (Left  x) = show x
+showExprOrRange (Right x) = show x
+
 clog2Help :: Int -> Int -> Int
 clog2Help p n = if p >= n then 0 else 1 + clog2Help (p*2) n
 clog2 :: Int -> Int

src/Language/SystemVerilog/AST/Stmt.hs

@@ -28,7 +28,7 @@ import Text.Printf (printf)
 import Language.SystemVerilog.AST.ShowHelp (commas, indent, unlines', showPad)
 import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Decl)
-import Language.SystemVerilog.AST.Expr (Expr, Args(..))
+import Language.SystemVerilog.AST.Expr (Expr(Inside, Nil), Args(..), showExprOrRange)
 import Language.SystemVerilog.AST.LHS (LHS)
 import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq))
 import Language.SystemVerilog.AST.Type (Identifier)
@@ -132,7 +132,11 @@ showShortBranch stmt = showBranch stmt
 
 showCase :: Case -> String
 showCase (a, b) = printf "%s:%s" exprStr (showShortBranch b)
-    where exprStr = if null a then "default" else commas $ map show a
+    where
+        exprStr = case a of
+            [] -> "default"
+            [Inside Nil c] -> commas $ map showExprOrRange c
+            _ -> commas $ map show a
 
 data CaseKW
     = CaseN

src/Language/SystemVerilog/Parser/Parse.y

@@ -1046,17 +1046,13 @@ CaseKW :: { CaseKW }
   | "casez" { CaseZ }
 
 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 }
+  : opt("inside") InsideCases { validateCases $1 $2 }
+InsideCases :: { [([ExprOrRange], Stmt)] }
+  : InsideCase             { [$1] }
+  | InsideCases InsideCase { $1 ++ [$2] }
+InsideCase :: { ([ExprOrRange], Stmt) }
+  : OpenRangeList ":"  Stmt { ($1, $3) }
+  | "default" opt(":") Stmt { ([], $3) }
 
 Number :: { String }
   : number    { tokenString $1 }
@@ -1223,17 +1219,11 @@ GenBlock :: { (Identifier, [GenItem]) }
   : "begin" StrTag GenItems "end" StrTag { (combineTags $2 $5, $3) }
 
 GenCases :: { [GenCase] }
-  : {- empty -}                      { [] }
-  | GenCase        GenCases          { $1       : $2 }
-  | GenCaseDefault GenCasesNoDefault { ([], $1) : $2 }
-GenCasesNoDefault :: { [GenCase] }
-  : {- empty -}               { [] }
-  | GenCasesNoDefault GenCase { $1 ++ [$2] }
-
+  : GenCase          { [$1] }
+  | GenCases GenCase { validateGenCases $ $1 ++ [$2] }
 GenCase :: { GenCase }
-  : Exprs ":" GenItemOrNull { ($1, $3) }
-GenCaseDefault :: { GenItem }
-  : "default" opt(":") GenItemOrNull { $3 }
+  : Exprs         ":"  GenItemOrNull { ($1, $3) }
+  | "default" opt(":") GenItemOrNull { ([], $3) }
 
 GenvarInitialization :: { (Bool, Identifier, Expr) }
   : "genvar" Identifier "=" Expr { (True , $2, $4) }
@@ -1335,4 +1325,34 @@ fieldDecl t (x, rs2) =
   (tf $ rs2 ++ rs1, x)
   where (tf, rs1) = typeRanges t
 
+validateCases :: Maybe Token -> [([ExprOrRange], Stmt)] -> [Case]
+validateCases Nothing items =
+  if length (filter null exprs) <= 1
+    then zip exprs' stmts
+    else error $ "multiple default cases: " ++ show items
+  where
+    (exprs, stmts) = unzip items
+    exprs' = map (map unwrap) exprs
+    unwrap (Left expr) = expr
+    unwrap (Right range) =
+      error $ "illegal use of a range (" ++ show range
+        ++ ") in a non-inside case"
+validateCases (Just _) items =
+  if length (filter null sets) <= 1
+    then zip sets' stmts
+    else error $ "multiple default cases: " ++ show items
+  where
+    (sets, stmts) = unzip items
+    sets' = map unwrap sets
+    unwrap [] = []
+    unwrap ls = [Inside Nil ls]
+
+validateGenCases :: [GenCase] -> [GenCase]
+validateGenCases items =
+  if length (filter null exprs) <= 1
+    then items
+    else error $ "multiple default generate cases: " ++ show items
+  where
+    (exprs, _) = unzip items
+
 }