refactor event control internals

- event expressions use Expr over LHS
- stricter AST representation of event controls
- property specs use event expressions directly

CHANGELOG.md

@@ -10,6 +10,7 @@
 * Added support for excluding the conversion of unbased unsized literals (e.g.,
   `'1`, `'x`) via `--exclude UnbasedUniszed`
 * Added support for enumerated type ranges (e.g., `enum { X[3:5] }`)
+* Added support for complex event expressions (e.g., `@(x ^ y)`)
 * Added support for the SystemVerilog `edge` event
 * Added support for cycle delay ranges in assertion sequence expressions
 * Added conversion for `do` `while` loops

src/Convert.hs

@@ -21,6 +21,7 @@ import qualified Convert.DoWhile
 import qualified Convert.DuplicateGenvar
 import qualified Convert.EmptyArgs
 import qualified Convert.Enum
+import qualified Convert.EventEdge
 import qualified Convert.ExprAsgn
 import qualified Convert.ForAsgn
 import qualified Convert.Foreach
@@ -43,7 +44,6 @@ import qualified Convert.ParamType
 import qualified Convert.PortDecl
 import qualified Convert.RemoveComments
 import qualified Convert.ResolveBindings
-import qualified Convert.SenseEdge
 import qualified Convert.Simplify
 import qualified Convert.Stream
 import qualified Convert.StringParam
@@ -105,7 +105,7 @@ initialPhases selectExclude =
     , Convert.ExprAsgn.convert
     , Convert.KWArgs.convert
     , Convert.Unique.convert
-    , Convert.SenseEdge.convert
+    , Convert.EventEdge.convert
     , Convert.LogOp.convert
     , Convert.EmptyArgs.convert
     , Convert.DoWhile.convert

src/Convert/AlwaysKW.hs

@@ -18,9 +18,9 @@ convert = map $ traverseDescriptions $ traverseModuleItems replaceAlwaysKW
 
 replaceAlwaysKW :: ModuleItem -> ModuleItem
 replaceAlwaysKW (AlwaysC AlwaysLatch stmt) =
-    AlwaysC Always $ Timing (Event SenseStar) stmt
+    AlwaysC Always $ Timing (Event EventStar) stmt
 replaceAlwaysKW (AlwaysC AlwaysComb stmt) =
-    AlwaysC Always $ Timing (Event SenseStar) stmt
+    AlwaysC Always $ Timing (Event EventStar) stmt
 replaceAlwaysKW (AlwaysC AlwaysFF stmt) =
     AlwaysC Always stmt
 replaceAlwaysKW other = other

src/Convert/SenseEdge.hs → src/Convert/EventEdge.hs

@@ -8,7 +8,7 @@
  - or fully supported downstream.
  -}
 
-module Convert.SenseEdge (convert) where
+module Convert.EventEdge (convert) where
 
 import Convert.Traverse
 import Language.SystemVerilog.AST
@@ -26,12 +26,16 @@ convertStmt (Timing timing stmt) =
 convertStmt other = other
 
 convertTiming :: Timing -> Timing
-convertTiming (Event sense) = Event $ convertSense sense
+convertTiming (Event event) = Event $ convertEvent event
 convertTiming other = other
 
-convertSense :: Sense -> Sense
-convertSense (SenseOr s1 s2) =
-    SenseOr (convertSense s1) (convertSense s2)
-convertSense (SenseEdge lhs) =
-    SenseOr (SensePosedge lhs) (SenseNegedge lhs)
-convertSense other = other
+convertEvent :: Event -> Event
+convertEvent EventStar = EventStar
+convertEvent (EventExpr e) = EventExpr $ convertEventExpr e
+
+convertEventExpr :: EventExpr -> EventExpr
+convertEventExpr (EventExprOr v1 v2) =
+    EventExprOr (convertEventExpr v1) (convertEventExpr v2)
+convertEventExpr (EventExprEdge Edge lhs) =
+    EventExprOr (EventExprEdge Posedge lhs) (EventExprEdge Negedge lhs)
+convertEventExpr other@EventExprEdge{} = other

src/Convert/Logic.hs

@@ -94,7 +94,7 @@ traverseModuleItem ports scopes =
                         Just (_, _, t) -> tell [isRegType t]
                         _ -> tell [False]
 
-        always_comb = AlwaysC Always . Timing (Event SenseStar)
+        always_comb = AlwaysC Always . Timing (Event EventStar)
 
         fixModuleItem :: ModuleItem -> ModuleItem
         -- rewrite bad continuous assignments to use procedural assignments
@@ -183,9 +183,6 @@ rewriteDeclM _ (Param s (IntegerVector _ sg rs) x e) =
 rewriteDeclM _ decl = return decl
 
 traverseStmtM :: Stmt -> ST Stmt
-traverseStmtM stmt@Timing{} =
-    -- ignore the timing LHSs
-    return stmt
 traverseStmtM (Asgn op Just{} lhs expr) =
     -- ignore the timing LHSs
     traverseStmtM $ Asgn op Nothing lhs expr

src/Convert/Traverse.hs

@@ -343,10 +343,11 @@ traverseAssertionExprsM mapper = assertionMapper
             spMapper PropExprFollowsNO se pe
         propExprMapper (PropExprIff p1 p2) =
             ppMapper PropExprIff p1 p2
-        propSpecMapper (PropertySpec ms e pe) = do
+        propSpecMapper (PropertySpec mv e pe) = do
+            mv' <- mapM (traverseEventExprsM mapper) mv
             e' <- mapper e
             pe' <- propExprMapper pe
-            return $ PropertySpec ms e' pe'
+            return $ PropertySpec mv' e' pe'
         assertionExprMapper (Concurrent e) =
             propSpecMapper e >>= return . Concurrent
         assertionExprMapper (Immediate d e) =
@@ -365,13 +366,6 @@ traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt
 traverseStmtLHSsM mapper = stmtMapper
     where
         fullMapper = mapper
-        stmtMapper (Timing (Event sense) stmt) = do
-            sense' <- senseMapper sense
-            return $ Timing (Event sense') stmt
-        stmtMapper (Asgn op (Just (Event sense)) lhs expr) = do
-            lhs' <- fullMapper lhs
-            sense' <- senseMapper sense
-            return $ Asgn op (Just $ Event sense') lhs' expr
         stmtMapper (Asgn op mt lhs expr) =
             fullMapper lhs >>= \lhs' -> return $ Asgn op mt lhs' expr
         stmtMapper (For inits me incrs stmt) = do
@@ -380,31 +374,7 @@ traverseStmtLHSsM mapper = stmtMapper
             lhss' <- mapM fullMapper lhss
             let incrs' = zip3 lhss' asgnOps exprs
             return $ For inits' me incrs' stmt
-        stmtMapper (Assertion a) =
-            assertionMapper a >>= return . Assertion
         stmtMapper other = return other
-        senseMapper (Sense        lhs) = fullMapper lhs >>= return . Sense
-        senseMapper (SensePosedge lhs) = fullMapper lhs >>= return . SensePosedge
-        senseMapper (SenseNegedge lhs) = fullMapper lhs >>= return . SenseNegedge
-        senseMapper (SenseEdge    lhs) = fullMapper lhs >>= return . SenseEdge
-        senseMapper (SenseOr    s1 s2) = do
-            s1' <- senseMapper s1
-            s2' <- senseMapper s2
-            return $ SenseOr s1' s2'
-        senseMapper (SenseStar       ) = return SenseStar
-        assertionExprMapper (Concurrent (PropertySpec (Just sense) me pe)) = do
-            sense' <- senseMapper sense
-            return $ Concurrent $ PropertySpec (Just sense') me pe
-        assertionExprMapper other = return other
-        assertionMapper (Assert e ab) = do
-            e' <- assertionExprMapper e
-            return $ Assert e' ab
-        assertionMapper (Assume e ab) = do
-            e' <- assertionExprMapper e
-            return $ Assume e' ab
-        assertionMapper (Cover e stmt) = do
-            e' <- assertionExprMapper e
-            return $ Cover e' stmt
 
 traverseStmtLHSs :: Mapper LHS -> Mapper Stmt
 traverseStmtLHSs = unmonad traverseStmtLHSsM
@@ -672,7 +642,6 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     caseMapper (exprs, stmt) = do
         exprs' <- mapM exprMapper exprs
         return (exprs', stmt)
-    stmtMapper = traverseNestedStmtsM flatStmtMapper
     flatStmtMapper (StmtAttr attr stmt) =
         -- note: we exclude expressions in attributes from conversion
         return $ StmtAttr attr stmt
@@ -702,7 +671,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     flatStmtMapper (Foreach x vars stmt) = return $ Foreach x vars stmt
     flatStmtMapper (If u cc s1 s2) =
         exprMapper cc >>= \cc' -> return $ If u cc' s1 s2
-    flatStmtMapper (Timing event stmt) = return $ Timing event stmt
+    flatStmtMapper (Timing timing stmt) =
+        timingMapper timing >>= \timing' -> return $ Timing timing' stmt
     flatStmtMapper (Subroutine e (Args l p)) = do
         e' <- exprMapper e
         l' <- mapM exprMapper l
@@ -712,10 +682,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     flatStmtMapper (Return expr) =
         exprMapper expr >>= return . Return
     flatStmtMapper (Trigger blocks x) = return $ Trigger blocks x
-    flatStmtMapper (Assertion a) = do
-        a' <- traverseAssertionStmtsM stmtMapper a
-        a'' <- traverseAssertionExprsM exprMapper a'
-        return $ Assertion a''
+    flatStmtMapper (Assertion a) =
+        traverseAssertionExprsM exprMapper a >>= return . Assertion
     flatStmtMapper (Continue) = return Continue
     flatStmtMapper (Break) = return Break
     flatStmtMapper (Null) = return Null
@@ -723,6 +691,22 @@ traverseStmtExprsM exprMapper = flatStmtMapper
 
     asgnMapper (l, op, e) = exprMapper e >>= \e' -> return $ (l, op, e')
 
+    timingMapper (Event e) = eventMapper e >>= return . Event
+    timingMapper (Delay e) = exprMapper e >>= return . Delay
+    timingMapper (Cycle e) = exprMapper e >>= return . Cycle
+
+    eventMapper EventStar = return EventStar
+    eventMapper (EventExpr e) =
+        traverseEventExprsM exprMapper e >>= return . EventExpr
+
+traverseEventExprsM :: Monad m => MapperM m Expr -> MapperM m EventExpr
+traverseEventExprsM mapper (EventExprEdge edge expr) =
+    mapper expr >>= return . EventExprEdge edge
+traverseEventExprsM mapper (EventExprOr e1 e2) = do
+    e1' <- traverseEventExprsM mapper e1
+    e2' <- traverseEventExprsM mapper e2
+    return $ EventExprOr e1' e2'
+
 traverseStmtExprs :: Mapper Expr -> Mapper Stmt
 traverseStmtExprs = unmonad traverseStmtExprsM
 collectStmtExprsM :: Monad m => CollectorM m Expr -> CollectorM m Stmt

src/Language/SystemVerilog/AST/Stmt.hs

@@ -8,7 +8,9 @@
 module Language.SystemVerilog.AST.Stmt
     ( Stmt   (..)
     , Timing (..)
-    , Sense  (..)
+    , Event        (..)
+    , EventExpr    (..)
+    , Edge         (..)
     , CaseKW (..)
     , Case
     , ActionBlock  (..)
@@ -160,32 +162,46 @@ instance Show CaseKW where
 type Case = ([Expr], Stmt)
 
 data Timing
-    = Event Sense
+    = Event Event
     | Delay Expr
     | Cycle Expr
     deriving Eq
 
 instance Show Timing where
-    show (Event s) = printf  "@(%s)" (show s)
+    show (Event e) = printf  "@(%s)" (show e)
     show (Delay e) = printf  "#(%s)" (show e)
     show (Cycle e) = printf "##(%s)" (show e)
 
-data Sense
-    = Sense        LHS
-    | SenseOr      Sense Sense
-    | SensePosedge LHS
-    | SenseNegedge LHS
-    | SenseEdge    LHS
-    | SenseStar
+data Event
+    = EventStar
+    | EventExpr EventExpr
     deriving Eq
 
-instance Show Sense where
-    show (Sense        a  ) = show a
-    show (SenseOr      a b) = printf "%s or %s" (show a) (show b)
-    show (SensePosedge a  ) = printf "posedge %s" (show a)
-    show (SenseNegedge a  ) = printf "negedge %s" (show a)
-    show (SenseEdge    a  ) = printf "edge %s" (show a)
-    show (SenseStar       ) = "*"
+instance Show Event where
+    show EventStar = "*"
+    show (EventExpr e) = show e
+
+data EventExpr
+    = EventExprEdge Edge Expr
+    | EventExprOr EventExpr EventExpr
+    deriving Eq
+
+instance Show EventExpr where
+    show (EventExprEdge g e) = printf "%s%s" (showPad g) (show e)
+    show (EventExprOr   a b) = printf "%s or %s" (show a) (show b)
+
+data Edge
+    = Posedge
+    | Negedge
+    | Edge
+    | NoEdge
+    deriving Eq
+
+instance Show Edge where
+    show Posedge = "posedge"
+    show Negedge = "negedge"
+    show Edge    = "edge"
+    show NoEdge  = ""
 
 data ActionBlock
     = ActionBlock Stmt Stmt
@@ -273,15 +289,15 @@ instance Show Deferral where
     show FinalDeferred = "final"
 
 data PropertySpec
-    = PropertySpec (Maybe Sense) Expr PropExpr
+    = PropertySpec (Maybe EventExpr) Expr PropExpr
     deriving Eq
 instance Show PropertySpec where
-    show (PropertySpec ms e pe) =
-        printf "%s%s\n\t%s" msStr eStr (show pe)
+    show (PropertySpec mv e pe) =
+        printf "%s%s\n\t%s" mvStr eStr (show pe)
         where
-            msStr = case ms of
+            mvStr = case mv of
                 Nothing -> ""
-                Just s -> printf "@(%s) " (show s)
+                Just v -> printf "@(%s) " (show v)
             eStr = case e of
                 Nil -> ""
                 _ -> printf "disable iff (%s)" (show e)

src/Language/SystemVerilog/Parser/Parse.y

@@ -406,7 +406,7 @@ time               { Token Lit_time        _ _ }
 %nonassoc "else"
 %right  "|->" "|=>" "#-#" "#=#"
 %right "iff"
-%left "or"
+%left "or" ","
 %left "and"
 %left "intersect"
 %left "within"
@@ -766,7 +766,7 @@ Deferral :: { Deferral }
 PropertySpec :: { PropertySpec }
   : OptClockingEvent "disable" "iff" "(" Expr ")" PropExpr { PropertySpec $1 $5  $7 }
   | OptClockingEvent                              PropExpr { PropertySpec $1 Nil $2 }
-OptClockingEvent :: { Maybe Sense }
+OptClockingEvent :: { Maybe EventExpr }
   : ClockingEvent { Just $1 }
   | {- empty -}   { Nothing }
 
@@ -1208,8 +1208,8 @@ TypeAsgn :: { (Identifier, Type) }
   | Identifier          { ($1, UnknownType) }
 
 -- TODO: This does not allow for @identifier
-ClockingEvent :: { Sense }
-  : "@" "(" Senses ")" { $3 }
+ClockingEvent :: { EventExpr }
+  : "@" "(" EventExpr ")" { $3 }
 
 TimingControl :: { Timing }
   : DelayOrEvent { $1 }
@@ -1228,28 +1228,27 @@ DelayControl :: { Expr }
   | "#" Identifier ParamBindings "::" Identifier { CSIdent $2 $3 $5 }
 CycleDelay :: { Expr }
   : "##" Expr { $2 }
-EventControl :: { Sense }
-  : "@" "(" Senses ")" { $3 }
-  | "@" "(*)"          { SenseStar }
-  | "@" "(" "*" ")"    { SenseStar }
-  | "@" "(*" ")"       { SenseStar }
-  | "@" "(" "*)"       { SenseStar }
-  | "@" "*"            { SenseStar }
-  | "@*"               { SenseStar }
-  | "@" Identifier     { Sense $ LHSIdent $2 }
-Senses :: { Sense }
-  : Sense             { $1 }
-  | Senses "or" Sense { SenseOr $1 $3 }
-  | Senses ","  Sense { SenseOr $1 $3 }
-Sense :: { Sense }
-  : "(" Sense ")"         {              $2 }
-  |           LHS         { Sense        $1 }
-  | "posedge" LHSOptParen { SensePosedge $2 }
-  | "negedge" LHSOptParen { SenseNegedge $2 }
-  | "edge"    LHSOptParen { SenseEdge    $2 }
-LHSOptParen :: { LHS }
-  :     LHS     { $1 }
-  | "(" LHS ")" { $2 }
+EventControl :: { Event }
+  : "@*"            { EventStar }
+  | "@" "(*)"       { EventStar }
+  | "@" "(" "*" ")" { EventStar }
+  | "@" "(*" ")"    { EventStar }
+  | "@" "(" "*)"    { EventStar }
+  | "@" "*"         { EventStar }
+  | "@" "(" EventExpr ")" { EventExpr $3 }
+  | "@" Identifier        { EventExpr $ EventExprEdge NoEdge $ Ident $2 }
+EventExpr :: { EventExpr }
+  : Expr { EventExprEdge NoEdge $1 }
+  | EventExprComplex { $1 }
+EventExprComplex :: { EventExpr }
+  : "(" EventExprComplex ")" { $2 }
+  | Edge Expr { EventExprEdge $1 $2 }
+  | EventExpr "or" EventExpr { EventExprOr $1 $3 }
+  | EventExpr ","  EventExpr { EventExprOr $1 $3 }
+Edge :: { Edge }
+  : "posedge" { Posedge }
+  | "negedge" { Negedge }
+  | "edge"    { Edge    }
 
 CaseKW :: { CaseKW }
   : "case"  { CaseN }

sv2v.cabal

@@ -72,6 +72,7 @@ executable sv2v
     Convert.DuplicateGenvar
     Convert.EmptyArgs
     Convert.Enum
+    Convert.EventEdge
     Convert.ExprAsgn
     Convert.ExprUtils
     Convert.ForAsgn
@@ -96,7 +97,6 @@ executable sv2v
     Convert.RemoveComments
     Convert.ResolveBindings
     Convert.Scoper
-    Convert.SenseEdge
     Convert.Simplify
     Convert.Stream
     Convert.StringParam

test/basic/event_xor.sv

+module top;
+    reg x, y;
+    always @(x ^ y)
+        $display("%d %b %b", $time, x, y);
+    initial begin
+        #1 {x, y} = 2'b00;
+        #1 {x, y} = 2'b01;
+        #1 {x, y} = 2'b10;
+        #1 {x, y} = 2'b11;
+        #1 {x, y} = 2'b00;
+        #1 {x, y} = 2'b10;
+    end
+endmodule