support for casex and casez, and their conversions

Convert.hs

@@ -9,6 +9,7 @@ module Convert (convert) where
 import Language.SystemVerilog.AST
 
 import qualified Convert.AlwaysKW
+import qualified Convert.CaseKW
 import qualified Convert.Logic
 import qualified Convert.Typedef
 import qualified Convert.PackedArrayFlatten
@@ -19,6 +20,7 @@ type Phase = AST -> AST
 phases :: [Phase]
 phases =
     [ Convert.AlwaysKW.convert
+    , Convert.CaseKW.convert
     , Convert.Logic.convert
     , Convert.Typedef.convert
     , Convert.PackedArrayFlatten.convert

Convert/CaseKW.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Conversion for `casez` and `casex`
+ -
+ - Note that this conversion does not completely replicate the behavior of
+ - `casex` and `casez` in cases where that case expression itself (rather than
+ - just the case item patterns) contains wildcard values. This is apparently
+ - rarely ever intentially done.
+ -}
+
+module Convert.CaseKW (convert) where
+
+import Convert.Template.Stmt (stmtConverter)
+
+import Language.SystemVerilog.AST
+
+convert :: AST -> AST
+convert = stmtConverter convertStmt
+
+-- Conversions:
+-- `casez` -> `case` with wildcards (?, z) expanded
+-- `casex` -> `case` with wildcards (?, z, x) expanded
+
+-- to be either 0 or 1
+
+wildcards :: CaseKW -> [Char]
+wildcards CaseN = [] -- CaseN == `case`
+wildcards CaseZ = ['?', 'z', 'Z']
+wildcards CaseX = ['?', 'z', 'Z', 'x', 'X']
+
+possibilities :: [Char]
+possibilities = ['0', '1']
+
+explodeBy :: [Char] -> String -> [String]
+explodeBy _ "" = [""]
+explodeBy wilds (x : xs) =
+    if elem x wilds
+        then concat $ map (\c -> map (c :) prev) possibilities
+        else map (x :) prev
+    where prev = explodeBy wilds xs
+
+expandExpr :: [Char] -> Expr -> [Expr]
+expandExpr wilds (Number s) = map Number $ explodeBy wilds s
+expandExpr [] other = [other]
+-- TODO: Hopefully they only give us constant expressions...
+expandExpr _ other = error $ "CaseKW conversione encountered case that was not a number, which is dubious..." ++ (show other)
+
+-- Note that we don't have to convert the statements within the cases, as the
+-- conversion template takes care of that for us.
+convertStmt :: Stmt -> Stmt
+convertStmt (Case kw expr cases def) =
+    Case CaseN expr cases' def
+    where
+        wilds = wildcards kw
+        cases' = map convertCase cases
+        convertCase :: Case -> Case
+        convertCase (exprs, stmt) = (exprs', stmt)
+            where exprs' = concat $ map (expandExpr wilds) exprs
+convertStmt other = other

Convert/Logic.hs

@@ -32,8 +32,8 @@ convertDescription other = other
 
 getStmtLHSs :: Stmt -> [LHS]
 getStmtLHSs (Block _ stmts) = concat $ map getStmtLHSs stmts
-getStmtLHSs (Case e cases (Just stmt)) = (getStmtLHSs stmt) ++ (getStmtLHSs $ Case e cases Nothing)
-getStmtLHSs (Case _ cases Nothing) = concat $ map getStmtLHSs $ map snd cases
+getStmtLHSs (Case kw e cases (Just stmt)) = (getStmtLHSs stmt) ++ (getStmtLHSs $ Case kw e cases Nothing)
+getStmtLHSs (Case _  _ cases Nothing) = concat $ map getStmtLHSs $ map snd cases
 getStmtLHSs (BlockingAssignment    lhs _) = [lhs]
 getStmtLHSs (NonBlockingAssignment lhs _) = [lhs]
 getStmtLHSs (For _ _ _ stmt) = getStmtLHSs stmt

Convert/PackedArrayFlatten.hs

@@ -194,7 +194,7 @@ rewriteStmt dimMap orig = rs orig
     where
         rs :: Stmt -> Stmt
         rs (Block decls stmts) = Block decls (map rs stmts)
-        rs (Case e cases def) = Case e' cases' def'
+        rs (Case kw e cases def) = Case kw e' cases' def'
             where
                 re :: Expr -> Expr
                 re = rewriteExpr dimMap

Convert/Template/Stmt.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Template converter for Stmt transformations
+ -}
+
+module Convert.Template.Stmt (stmtConverter) where
+
+import Convert.Template.ModuleItem (moduleItemConverter)
+import Language.SystemVerilog.AST
+
+type Converter = Stmt -> Stmt
+
+stmtConverter :: Converter -> (AST -> AST)
+stmtConverter = moduleItemConverter . convertModuleItem
+
+convertModuleItem :: Converter -> ModuleItem -> ModuleItem
+convertModuleItem f (AlwaysC kw stmt) =
+    AlwaysC kw (convertStmt f stmt)
+convertModuleItem f (Function ret name decls stmt) =
+    Function ret name decls (convertStmt f stmt)
+convertModuleItem _ other = other
+
+convertStmt :: Converter -> (Stmt -> Stmt)
+convertStmt f = f . convertStmt'
+    where
+        cs :: Stmt -> Stmt
+        cs = convertStmt f
+        convertStmt' :: Stmt -> Stmt
+        convertStmt' (Block decls stmts) = Block decls (map cs stmts)
+        convertStmt' (Case kw expr cases def) =
+            Case kw expr cases' def'
+            where
+                cases' = map (\(exprs, stmt) -> (exprs, cs stmt)) cases
+                def' = case def of
+                    Nothing -> Nothing
+                    Just stmt -> Just (cs stmt)
+        convertStmt' (BlockingAssignment    lhs expr) = BlockingAssignment    lhs expr
+        convertStmt' (NonBlockingAssignment lhs expr) = NonBlockingAssignment lhs expr
+        convertStmt' (For a b c stmt) = For a b c (cs stmt)
+        convertStmt' (If e s1 s2) = If e (cs s1) (cs s2)
+        convertStmt' (Timing sense stmt) = Timing sense (cs stmt)
+        convertStmt' (Null) = Null

Language/SystemVerilog/AST.hs

@@ -15,7 +15,8 @@ module Language.SystemVerilog.AST
   , Localparam (..)
   , IntegerV   (..)
   , GenItem    (..)
-  , AlwaysKW (..)
+  , AlwaysKW   (..)
+  , CaseKW     (..)
   , AST
   , PortBinding
   , Case
@@ -308,9 +309,20 @@ instance Show LHS where
   show (LHSRange   a (b, c)) = printf "%s[%s:%s]" a (show b) (show c)
   show (LHSConcat  a       ) = printf "{%s}" (commas $ map show a)
 
+data CaseKW
+  = CaseN
+  | CaseZ
+  | CaseX
+  deriving Eq
+
+instance Show CaseKW where
+  show CaseN = "case"
+  show CaseZ = "casez"
+  show CaseX = "casex"
+
 data Stmt
   = Block                 (Maybe (Identifier, [BlockItemDeclaration])) [Stmt]
-  | Case                  Expr [Case] (Maybe Stmt)
+  | Case                  CaseKW Expr [Case] (Maybe Stmt)
   | BlockingAssignment    LHS Expr
   | NonBlockingAssignment LHS Expr
   | For                   (Identifier, Expr) Expr (Identifier, Expr) Stmt
@@ -325,8 +337,8 @@ commas = intercalate ", "
 instance Show Stmt where
   show (Block                 Nothing       b  ) = printf "begin\n%s\nend" $ indent $ unlines' $ map show b
   show (Block                 (Just (a, i)) b  ) = printf "begin : %s\n%s\nend" a $ indent $ unlines' $ (map show i ++ map show b)
-  show (Case                  a b Nothing      ) = printf "case (%s)\n%s\nendcase"                 (show a) (indent $ unlines' $ map showCase b)
-  show (Case                  a b (Just c)     ) = printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c)
+  show (Case                  kw a b Nothing   ) = printf "%s (%s)\n%s\nendcase"                 (show kw) (show a) (indent $ unlines' $ map showCase b)
+  show (Case                  kw a b (Just c)  ) = printf "%s (%s)\n%s\n\tdefault:\n%s\nendcase" (show kw) (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c)
   show (BlockingAssignment    a b              ) = printf "%s = %s;" (show a) (show b)
   show (NonBlockingAssignment a b              ) = printf "%s <= %s;" (show a) (show b)
   show (For                   (a, b) c (d, e) f) = printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f

Language/SystemVerilog/Parser/Lex.x

@@ -10,16 +10,18 @@ import Language.SystemVerilog.Parser.Tokens
 
 $nonZeroDecimalDigit = [1-9]
 $decimalDigit = [0-9]
-@binaryDigit  = [0-1]
-@octalDigit   = [0-7]
-@hexDigit     = [0-9a-fA-F]
+@xDigit       = [xX]
+@zDigit       = [zZ\?]
+@binaryDigit  = @xDigit | @zDigit | [0-1]
+@octalDigit   = @xDigit | @zDigit | [0-7]
+@hexDigit     = @xDigit | @zDigit | [0-9a-fA-F]
 
 @decimalBase = "'" [dD]
 @binaryBase  = "'" [bB]
 @octalBase   = "'" [oO]
 @hexBase     = "'" [hH]
 
-@binaryValue         = @binaryDigit ("_" | @binaryDigit)*
+@binaryValue = @binaryDigit ("_" | @binaryDigit)*
 @octalValue  = @octalDigit  ("_" | @octalDigit)*
 @hexValue    = @hexDigit    ("_" | @hexDigit)*
 
@@ -57,6 +59,8 @@ tokens :-
   "assign"           { tok KW_assign     }
   "begin"            { tok KW_begin      }
   "case"             { tok KW_case       }
+  "casex"            { tok KW_casex      }
+  "casez"            { tok KW_casez      }
   "default"          { tok KW_default    }
   "else"             { tok KW_else       }
   "end"              { tok KW_end        }
@@ -83,6 +87,7 @@ tokens :-
   "posedge"          { tok KW_posedge    }
   "reg"              { tok KW_reg        }
   "typedef"          { tok KW_typedef    }
+  "unique"           { tok KW_unique     }
   "wire"             { tok KW_wire       }
 
   @simpleIdentifier  { tok Id_simple  }

Language/SystemVerilog/Parser/Parse.y

@@ -24,6 +24,7 @@ import Language.SystemVerilog.Parser.Tokens
 "assign"           { Token KW_assign     _ _ }
 "begin"            { Token KW_begin      _ _ }
 "case"             { Token KW_case       _ _ }
+"casex"            { Token KW_casex      _ _ }
 "casez"            { Token KW_casez      _ _ }
 "default"          { Token KW_default    _ _ }
 "else"             { Token KW_else       _ _ }
@@ -51,6 +52,7 @@ import Language.SystemVerilog.Parser.Tokens
 "posedge"          { Token KW_posedge    _ _ }
 "reg"              { Token KW_reg        _ _ }
 "typedef"          { Token KW_typedef    _ _ }
+"unique"           { Token KW_unique     _ _ }
 "wire"             { Token KW_wire       _ _ }
 
 simpleIdentifier   { Token Id_simple     _ _ }
@@ -376,7 +378,7 @@ Stmt :: { Stmt }
   | "for" "(" Identifier "=" Expr ";" Expr ";" Identifier "=" Expr ")" Stmt { For ($3, $5) $7 ($9, $11) $13 }
   | LHS "=" Expr ";"                                 { BlockingAssignment $1 $3 }
   | LHS "<=" Expr ";"                                { NonBlockingAssignment $1 $3 }
-  | "case" "(" Expr ")" Cases opt(CaseDefault) "endcase" { Case $3 $5 $6 }
+  | CaseKW "(" Expr ")" Cases opt(CaseDefault) "endcase" { Case $1 $3 $5 $6 }
   | EventControl Stmt                                { Timing $1 $2 }
 
 BlockItemDeclarations :: { [BlockItemDeclaration] }
@@ -394,6 +396,13 @@ BlockVariableIdentifiers :: { [(Identifier, [Range])] }
 BlockVariableType :: { (Identifier, [Range]) }
   : Identifier Dimensions { ($1, $2) }
 
+CaseKW :: { CaseKW }
+  -- We just drop the unique keyword, for now. In the future, we should add it
+  -- to the AST and add a conversion phase for removing it.
+  : opt("unique") "case"  { CaseN }
+  | opt("unique") "casex" { CaseX }
+  | opt("unique") "casez" { CaseZ }
+
 Cases :: { [Case] }
   : {- empty -}  { [] }
   | Cases Case   { $1 ++ [$2] }

sv2v.cabal

@@ -61,11 +61,13 @@ executable sv2v
     Language.SystemVerilog.Parser.Tokens
     Convert
     Convert.AlwaysKW
+    Convert.CaseKW
     Convert.Logic
     Convert.PackedArrayFlatten
     Convert.StarPort
     Convert.Typedef
     Convert.Template.ModuleItem
+    Convert.Template.Stmt
   ghc-options:
     -O3
     -threaded