upgrade system severity task AST representation

src/Convert/Traverse.hs

@@ -255,6 +255,7 @@ traverseSinglyNestedStmtsM fullMapper = cs
         cs (Timing event stmt) = fullMapper stmt >>= return . Timing event
         cs (Return expr) = return $ Return expr
         cs (Subroutine expr exprs) = return $ Subroutine expr exprs
+        cs (SeverityStmt severity exprs) = return $ SeverityStmt severity exprs
         cs (Trigger blocks x) = return $ Trigger blocks x
         cs stmt@Force{} = return stmt
         cs (Wait e stmt) = fullMapper stmt >>= return . Wait e
@@ -622,11 +623,8 @@ traverseNodesM exprMapper declMapper typeMapper lhsMapper stmtMapper =
         return $ MIPackageItem $ DPIExport spec alias kw name
     moduleItemMapper (AssertionItem item) =
         assertionItemMapper item >>= return . AssertionItem
-    moduleItemMapper (ElabTask severity (Args pnArgs kwArgs)) = do
-        pnArgs' <- mapM exprMapper pnArgs
-        kwArgs' <- fmap (zip kwNames) $ mapM exprMapper kwExprs
-        return $ ElabTask severity $ Args pnArgs' kwArgs'
-        where (kwNames, kwExprs) = unzip kwArgs
+    moduleItemMapper (ElabTask severity args) =
+        mapM exprMapper args >>= return . ElabTask severity
 
     assertionItemMapper (MIAssertion mx a) = do
         a' <- traverseAssertionStmtsM stmtMapper a
@@ -705,6 +703,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper
         pes <- mapM exprMapper $ map snd p
         let p' = zip (map fst p) pes
         return $ Subroutine e' (Args l' p')
+    flatStmtMapper (SeverityStmt s l) =
+        mapM exprMapper l >>= return . SeverityStmt s
     flatStmtMapper (Return expr) =
         exprMapper expr >>= return . Return
     flatStmtMapper (Trigger blocks x) = return $ Trigger blocks x

src/Language/SystemVerilog/AST/ModuleItem.hs

@@ -13,7 +13,6 @@ module Language.SystemVerilog.AST.ModuleItem
     , NInputGateKW  (..)
     , NOutputGateKW (..)
     , AssignOption  (..)
-    , Severity      (..)
     , AssertionItem (..)
     ) where
 
@@ -25,10 +24,10 @@ import Language.SystemVerilog.AST.ShowHelp
 import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Direction)
 import Language.SystemVerilog.AST.Description (PackageItem)
-import Language.SystemVerilog.AST.Expr (Expr(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args)
+import Language.SystemVerilog.AST.Expr (Expr(Nil), pattern Ident, Range, showRanges, ParamBinding, showParams, Args(Args))
 import Language.SystemVerilog.AST.GenItem (GenItem)
 import Language.SystemVerilog.AST.LHS (LHS)
-import Language.SystemVerilog.AST.Stmt (Stmt, Assertion, Timing(Delay), PropertySpec, SeqExpr)
+import Language.SystemVerilog.AST.Stmt (Stmt, Assertion, Severity, Timing(Delay), PropertySpec, SeqExpr)
 import Language.SystemVerilog.AST.Type (Identifier, Strength0, Strength1)
 
 data ModuleItem
@@ -42,7 +41,7 @@ data ModuleItem
     | Modport    Identifier [ModportDecl]
     | Initial    Stmt
     | Final      Stmt
-    | ElabTask   Severity Args
+    | ElabTask   Severity [Expr]
     | MIPackageItem PackageItem
     | NInputGate  NInputGateKW  Expr Identifier  LHS [Expr]
     | NOutputGate NOutputGateKW Expr Identifier [LHS] Expr
@@ -60,7 +59,7 @@ instance Show ModuleItem where
     show (Modport     x l) = printf "modport %s(\n%s\n);" x (indent $ intercalate ",\n" $ map showModportDecl l)
     show (Initial     s  ) = printf "initial %s" (show s)
     show (Final       s  ) = printf   "final %s" (show s)
-    show (ElabTask    s a) = printf "%s%s;" (show s) (show a)
+    show (ElabTask    s a) = printf "%s%s;" (show s) (show $ Args a [])
     show (NInputGate  kw d x lhs exprs) =
         showGate kw d x $ show lhs : map show exprs
     show (NOutputGate kw d x lhss expr) =
@@ -149,19 +148,6 @@ instance Show AssignOption where
     show (AssignOptionDelay de) = printf "#(%s)" (show de)
     show (AssignOptionDrive s0 s1) = printf "(%s, %s)" (show s0) (show s1)
 
-data Severity
-    = SeverityInfo
-    | SeverityWarning
-    | SeverityError
-    | SeverityFatal
-    deriving Eq
-
-instance Show Severity where
-    show SeverityInfo    = "$info"
-    show SeverityWarning = "$warning"
-    show SeverityError   = "$error"
-    show SeverityFatal   = "$fatal"
-
 data AssertionItem
     = MIAssertion  Identifier Assertion
     | PropertyDecl Identifier PropertySpec

src/Language/SystemVerilog/AST/Stmt.hs

@@ -23,6 +23,7 @@ module Language.SystemVerilog.AST.Stmt
     , PropertySpec (..)
     , ViolationCheck (..)
     , BlockKW (..)
+    , Severity      (..)
     ) where
 
 import Text.Printf (printf)
@@ -50,6 +51,7 @@ data Stmt
     | Timing  Timing Stmt
     | Return  Expr
     | Subroutine Expr Args
+    | SeverityStmt Severity [Expr]
     | Trigger Bool Identifier
     | Assertion Assertion
     | Force Bool LHS Expr
@@ -86,6 +88,7 @@ instance Show Stmt where
                 where showInit (l, e) = showAssign (l, AsgnOpEq, e)
     show (Subroutine e a) = printf "%s%s;" (show e) aStr
         where aStr = if a == Args [] [] then "" else show a
+    show (SeverityStmt s a) = printf "%s%s;" (show s) (show $ Args a [])
     show (Asgn  o t v e) = printf "%s %s %s%s;" (show v) (show o) tStr (show e)
         where tStr = maybe "" showPad t
     show (If u c s1 s2) =
@@ -339,3 +342,16 @@ instance Show BlockKW where
 blockEndToken :: BlockKW -> Identifier
 blockEndToken Seq = "end"
 blockEndToken Par = "join"
+
+data Severity
+    = SeverityInfo
+    | SeverityWarning
+    | SeverityError
+    | SeverityFatal
+    deriving Eq
+
+instance Show Severity where
+    show SeverityInfo    = "$info"
+    show SeverityWarning = "$warning"
+    show SeverityError   = "$error"
+    show SeverityFatal   = "$fatal"

src/Language/SystemVerilog/Parser/Lex.x

@@ -108,6 +108,10 @@ tokens :-
     "$high"                { tok KW_dollar_high                }
     "$increment"           { tok KW_dollar_increment           }
     "$size"                { tok KW_dollar_size                }
+    "$info"                { tok KW_dollar_info                }
+    "$warning"             { tok KW_dollar_warning             }
+    "$error"               { tok KW_dollar_error               }
+    "$fatal"               { tok KW_dollar_fatal               }
 
     "accept_on"        { tok KW_accept_on    }
     "alias"            { tok KW_alias        }

src/Language/SystemVerilog/Parser/Parse.y

@@ -45,6 +45,10 @@ import Language.SystemVerilog.Parser.Tokens
 "$high"                { Token KW_dollar_high                _ _ }
 "$increment"           { Token KW_dollar_increment           _ _ }
 "$size"                { Token KW_dollar_size                _ _ }
+"$info"                { Token KW_dollar_info                _ _ }
+"$warning"             { Token KW_dollar_warning             _ _ }
+"$error"               { Token KW_dollar_error               _ _ }
+"$fatal"               { Token KW_dollar_fatal               _ _ }
 
 "accept_on"        { Token KW_accept_on    _ _ }
 "alias"            { Token KW_alias        _ _ }
@@ -648,6 +652,7 @@ DeclToken :: { DeclToken }
   | NetTypeP Strength                  { uncurry DTNet $1 $2 }
   | PortBindingsP                      { uncurry DTPorts $1 }
   | SigningP                           { uncurry DTSigning $1 }
+  | SeverityP                          { uncurry DTSeverity $1 }
   | "[" Expr "]"                       { DTBit      (tokenPosition $1) $2 }
   | "." Identifier                     { DTDot      (tokenPosition $1) $2 }
   | "automatic"                        { DTLifetime (tokenPosition $1) Automatic }
@@ -1112,6 +1117,7 @@ StmtAsgn :: { Stmt }
   | LHS AsgnBinOp            Expr ";" { Asgn $2  Nothing $1 $3 }
   | LHS IncOrDecOperator ";" { Asgn (AsgnOp $2) Nothing $1 (RawNum 1) }
   | IncOrDecOperator LHS ";" { Asgn (AsgnOp $1) Nothing $2 (RawNum 1) }
+  | SeverityStmt ";" { $1 }
   | LHS          ";" { Subroutine (lhsToExpr $1) (Args [] []) }
   | LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 }
   | Identifier "::" Identifier          ";" { Subroutine (PSIdent $1 $3) (Args [] []) }
@@ -1156,6 +1162,11 @@ OptDelayOrEvent :: { Maybe Timing }
   : DelayOrEvent { Just $1 }
   | {- empty -}  { Nothing }
 
+SeverityStmt :: { Stmt }
+  : Severity               { SeverityStmt $1 [] }
+  | Severity "("       ")" { SeverityStmt $1 [] }
+  | Severity "(" Exprs ")" { SeverityStmt $1 $3 }
+
 CaseStmt :: { Stmt }
   : Unique CaseKW "(" Expr ")"          Cases       "endcase" { Case $1 $2                   $4 $ validateCases $5 $6 }
   | Unique CaseKW "(" Expr ")" "inside" InsideCases "endcase" { Case $1 (caseInsideKW $3 $2) $4 $ validateCases $5 $7 }
@@ -1520,6 +1531,14 @@ DimFn :: { DimFn }
   | "$increment"           { FnIncrement          }
   | "$size"                { FnSize               }
 
+Severity :: { Severity }
+  : SeverityP { snd $1 }
+SeverityP :: { (Position, Severity) }
+  : "$info"    { withPos $1 SeverityInfo    }
+  | "$warning" { withPos $1 SeverityWarning }
+  | "$error"   { withPos $1 SeverityError   }
+  | "$fatal"   { withPos $1 SeverityFatal   }
+
 MITrace :: { ModuleItem }
   : PITrace { MIPackageItem $1 }
 PITrace :: { PackageItem }

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -77,6 +77,7 @@ data DeclToken
     | DTLHSBase  Position LHS
     | DTDot      Position Identifier
     | DTSigning  Position Signing
+    | DTSeverity Position Severity
     | DTLifetime Position Lifetime
     | DTAttr     Position Attr
     | DTEnd      Position Char
@@ -160,23 +161,17 @@ parseDTsAsModuleItems tokens =
 
 -- internal; attempt to parse an elaboration system task
 asElabTask :: [DeclToken] -> Maybe ModuleItem
-asElabTask tokens = do
-    DTIdent _ x@('$' : _) <- return $ head tokens
-    severity <- lookup x elabTasks
+asElabTask (DTSeverity _ severity : toks) =
     Just $ ElabTask severity args
     where
         args =
-            case tail tokens of
-                [DTEnd{}] -> Args [] []
-                [DTPorts _ ports, DTEnd{}] -> portsToArgs ports
+            case toks of
+                [DTEnd{}] -> []
+                [DTPorts _ ports, DTEnd{}] -> portsToExprs (head toks) ports
                 DTPorts{} : tok : _ -> parseError tok msg
-                toks -> parseError (head toks) msg
+                _ -> parseError (head toks) msg
         msg = "unexpected token after elaboration system task"
-
--- lookup table for elaboration system task severities
-elabTasks :: [(String, Severity)]
-elabTasks = map (\x -> (show x, x))
-    [SeverityInfo, SeverityWarning, SeverityError, SeverityFatal]
+asElabTask _ = Nothing
 
 -- internal; parser for module instantiations
 parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem]
@@ -261,6 +256,13 @@ declLookahead l0 =
 
 -- internal; parser for leading statements in a procedural block
 parseDTsAsStmt :: [DeclToken] -> [Stmt]
+parseDTsAsStmt (tok@(DTSeverity _ severity) : toks) =
+    [traceStmt tok, SeverityStmt severity args]
+    where
+        args = case init toks of
+            [] -> []
+            [DTPorts _ ports] -> portsToExprs (head toks) ports
+            extraTok : _ -> parseError extraTok "unexpected severity task token"
 parseDTsAsStmt l0 =
     [traceStmt $ head l0, stmt]
     where
@@ -291,6 +293,13 @@ portsToArgs bindings =
         pnArgs = map snd pnBindings
         kwArgs = kwBindings
 
+-- converts port bindings to a list of expressions
+portsToExprs :: DeclToken -> [PortBinding] -> [Expr]
+portsToExprs tok bindings =
+    case portsToArgs bindings of
+        Args args [] -> args
+        _ -> parseError tok "unexpected keyword argument"
+
 -- [PUBLIC]: parser for comma-separated declarations or assignment lists; this
 -- is only used for `for` loop initialization lists
 parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)]
@@ -669,6 +678,7 @@ tokPos (DTBit      p _) = p
 tokPos (DTLHSBase  p _) = p
 tokPos (DTDot      p _) = p
 tokPos (DTSigning  p _) = p
+tokPos (DTSeverity p _) = p
 tokPos (DTLifetime p _) = p
 tokPos (DTAttr     p _) = p
 tokPos (DTEnd      p _) = p

src/Language/SystemVerilog/Parser/Tokens.hs

@@ -39,6 +39,10 @@ data TokenName
     | KW_dollar_high
     | KW_dollar_increment
     | KW_dollar_size
+    | KW_dollar_info
+    | KW_dollar_warning
+    | KW_dollar_error
+    | KW_dollar_fatal
     | KW_accept_on
     | KW_alias
     | KW_always

test/error/severity_task_arg.sv

+// pattern: unexpected keyword argument
+// location: severity_task_arg.sv:4:11
+module top;
+    $fatal(.x("x"));
+endmodule

test/error/severity_task_token.sv

+// pattern: unexpected severity task token
+// location: severity_task_token.sv:5:16
+module top;
+    task t;
+        $fatal x;
+    endtask
+endmodule