Add support for more event lists

3 files changed, 41 insertions, 7 deletions

diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs
index 0ef9057..f122214 100644
--- a/src/VeriFuzz/Verilog/AST.hs
+++ b/src/VeriFuzz/Verilog/AST.hs
@@ -158,6 +158,8 @@ data Event = EId {-# UNPACK #-} !Identifier
            | EAll
            | EPosEdge {-# UNPACK #-} !Identifier
            | ENegEdge {-# UNPACK #-} !Identifier
+           | EOr !Event !Event
+           | EComb !Event !Event
            deriving (Eq, Show, Ord, Data)
 
 -- | Binary operators that are currently supported in the verilog generation.
@@ -477,6 +479,7 @@ $(makeWrapped ''Verilog)
 $(makeWrapped ''Identifier)
 $(makeWrapped ''Delay)
 
+$(makeBaseFunctor ''Event)
 $(makeBaseFunctor ''Expr)
 $(makeBaseFunctor ''ConstExpr)
 
diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs
index 3b9c7ad..361d27e 100644
--- a/src/VeriFuzz/Verilog/CodeGen.hs
+++ b/src/VeriFuzz/Verilog/CodeGen.hs
@@ -204,13 +204,18 @@ unaryOp UnXor     = "^"
 unaryOp UnNxor    = "~^"
 unaryOp UnNxorInv = "^~"
 
--- | Generate verilog code for an 'Event'.
 event :: Event -> Text
-event (EId   i)    = "@(" <> getIdentifier i <> ")"
-event (EExpr e)    = "@(" <> expr e <> ")"
-event EAll         = "@*"
-event (EPosEdge i) = "@(posedge " <> getIdentifier i <> ")"
-event (ENegEdge i) = "@(negedge " <> getIdentifier i <> ")"
+event a = "@(" <> eventRec a <> ")"
+
+-- | Generate verilog code for an 'Event'.
+eventRec :: Event -> Text
+eventRec (EId   i)    = getIdentifier i
+eventRec (EExpr e)    = expr e
+eventRec EAll         = "@*"
+eventRec (EPosEdge i) = "posedge " <> getIdentifier i
+eventRec (ENegEdge i) = "negedge " <> getIdentifier i
+eventRec (EOr a b)    = "(" <> eventRec a <> " or " <> eventRec b <> ")"
+eventRec (EComb a b)  = "(" <> eventRec a <> ", " <> eventRec b <> ")"
 
 -- | Generates verilog code for a 'Delay'.
 delay :: Delay -> Text
diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs
index 8ff63ef..6159766 100644
--- a/src/VeriFuzz/Verilog/Gen.hs
+++ b/src/VeriFuzz/Verilog/Gen.hs
@@ -28,7 +28,7 @@ import           Control.Monad.Trans.Class        (lift)
 import           Control.Monad.Trans.Reader       hiding (local)
 import           Control.Monad.Trans.State.Strict
 import           Data.Foldable                    (fold)
-import           Data.List.NonEmpty               (toList)
+import           Data.List.NonEmpty               (NonEmpty (..), toList)
 import qualified Data.Text                        as T
 import           Hedgehog                         (Gen)
 import qualified Hedgehog.Gen                     as Hog
@@ -319,6 +319,32 @@ statement = do
         ]
     where onDepth c n = if c ^. stmntDepth > 0 then n else 0
 
+recEventList :: NonEmpty Identifier -> Hog.Size -> Gen Event
+recEventList ids size
+    | size <= 0 = idgen
+    | size > 0 = Hog.choice
+                 [ idgen
+                 , EOr <$> recCall <*> recCall
+                 ]
+    where
+        idgen = fmap EId . Hog.element $ toList ids
+        recCall = (recEventList ids (size `div` 2))
+
+eventList :: StateGen Event
+eventList = do
+    prob    <- askProbability
+    context <- get
+    let defProb i = prob ^. probEventList . i
+    gen $ Hog.frequency
+        [ (defProb probEventListAll, return EAll)
+        , (defProb probEventListVar, case context ^. variables of
+                  []   -> return EAll
+                  x:xs -> Hog.sized . recEventList $ fmap toId (x :| xs))
+        , (defProb probEventListClk, return $ EPosEdge "clk")
+        ]
+    where
+        toId (Port _ _ _ i) = i
+
 always :: StateGen ModItem
 always = do
     stat <- SeqBlock <$> some statement