From b81341c0acc0feaa3fb7f706c5ca38bf3e580ebd Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Sat, 23 Feb 2019 15:10:25 -0500 Subject: [PATCH] support for casex and casez, and their conversions --- Convert.hs | 2 + Convert/CaseKW.hs | 60 +++++++++++++++++++++++++++ Convert/Logic.hs | 4 +- Convert/PackedArrayFlatten.hs | 2 +- Convert/Template/Stmt.hs | 43 +++++++++++++++++++ Language/SystemVerilog/AST.hs | 20 +++++++-- Language/SystemVerilog/Parser/Lex.x | 13 ++++-- Language/SystemVerilog/Parser/Parse.y | 11 ++++- sv2v.cabal | 2 + 9 files changed, 145 insertions(+), 12 deletions(-) create mode 100644 Convert/CaseKW.hs create mode 100644 Convert/Template/Stmt.hs diff --git a/Convert.hs b/Convert.hs index 2df5068..3a04510 100644 --- a/Convert.hs +++ b/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 diff --git a/Convert/CaseKW.hs b/Convert/CaseKW.hs new file mode 100644 index 0000000..888b9a5 --- /dev/null +++ b/Convert/CaseKW.hs @@ -0,0 +1,60 @@ +{- sv2v + - Author: Zachary Snow + - + - 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 diff --git a/Convert/Logic.hs b/Convert/Logic.hs index f464bf4..ebbe4cc 100644 --- a/Convert/Logic.hs +++ b/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 diff --git a/Convert/PackedArrayFlatten.hs b/Convert/PackedArrayFlatten.hs index 8d9a6dc..22dd555 100644 --- a/Convert/PackedArrayFlatten.hs +++ b/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 diff --git a/Convert/Template/Stmt.hs b/Convert/Template/Stmt.hs new file mode 100644 index 0000000..a80651c --- /dev/null +++ b/Convert/Template/Stmt.hs @@ -0,0 +1,43 @@ +{- sv2v + - Author: Zachary Snow + - + - 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 diff --git a/Language/SystemVerilog/AST.hs b/Language/SystemVerilog/AST.hs index 187f3b8..30b734c 100644 --- a/Language/SystemVerilog/AST.hs +++ b/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 diff --git a/Language/SystemVerilog/Parser/Lex.x b/Language/SystemVerilog/Parser/Lex.x index c16330e..2c3fd93 100644 --- a/Language/SystemVerilog/Parser/Lex.x +++ b/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 } diff --git a/Language/SystemVerilog/Parser/Parse.y b/Language/SystemVerilog/Parser/Parse.y index 0936fb7..09cf937 100644 --- a/Language/SystemVerilog/Parser/Parse.y +++ b/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] } diff --git a/sv2v.cabal b/sv2v.cabal index ca6c252..c8f810c 100644 --- a/sv2v.cabal +++ b/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