Add support for more event lists

4 files changed, 74 insertions, 11 deletions

diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs
index a2e4497..28a0ad8 100644
--- a/src/VeriFuzz/Config.hs
+++ b/src/VeriFuzz/Config.hs
@@ -21,6 +21,7 @@ module VeriFuzz.Config
     , probModItem
     , probStmnt
     , probExpr
+    , probEventList
     , ProbExpr(..)
     , probExprNum
     , probExprId
@@ -31,6 +32,10 @@ module VeriFuzz.Config
     , probExprStr
     , probExprSigned
     , probExprUnsigned
+    , ProbEventList(..)
+    , probEventListAll
+    , probEventListVar
+    , probEventListClk
     , ProbModItem(..)
     , probModItemAssign
     , probModItemAlways
@@ -86,9 +91,16 @@ data ProbStatement = ProbStatement { _probStmntBlock    :: {-# UNPACK #-} !Int
                                    }
                    deriving (Eq, Show)
 
-data Probability = Probability { _probModItem :: {-# UNPACK #-} !ProbModItem
-                               , _probStmnt   :: {-# UNPACK #-} !ProbStatement
-                               , _probExpr    :: {-# UNPACK #-} !ProbExpr
+data ProbEventList = ProbEventList { _probEventListAll :: {-# UNPACK #-} !Int
+                                   , _probEventListClk :: {-# UNPACK #-} !Int
+                                   , _probEventListVar :: {-# UNPACK #-} !Int
+                                   }
+                   deriving (Eq, Show)
+
+data Probability = Probability { _probModItem   :: {-# UNPACK #-} !ProbModItem
+                               , _probStmnt     :: {-# UNPACK #-} !ProbStatement
+                               , _probExpr      :: {-# UNPACK #-} !ProbExpr
+                               , _probEventList :: {-# UNPACK #-} !ProbEventList
                                }
                  deriving (Eq, Show)
 
@@ -108,6 +120,7 @@ data Config = Config { _configProbability :: {-# UNPACK #-} !Probability
 makeLenses ''ProbExpr
 makeLenses ''ProbModItem
 makeLenses ''ProbStatement
+makeLenses ''ProbEventList
 makeLenses ''Probability
 makeLenses ''Property
 makeLenses ''Config
@@ -120,12 +133,13 @@ defaultValue
 defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional
 
 defaultConfig :: Config
-defaultConfig = Config (Probability defModItem defStmnt defExpr)
+defaultConfig = Config (Probability defModItem defStmnt defExpr defEvent)
                        (Property 20 Nothing 3 2 5)
   where
     defModItem = ProbModItem 5 1 1
     defStmnt   = ProbStatement 0 15 1 1
     defExpr    = ProbExpr 1 1 1 1 1 1 0 1 1
+    defEvent = ProbEventList 1 1 1
 
 twoKey :: Toml.Piece -> Toml.Piece -> Toml.Key
 twoKey a b = Toml.Key (a :| [b])
@@ -186,6 +200,19 @@ modItemCodec =
     defProb i = defaultConfig ^. configProbability . probModItem . i
     intM = int "moditem"
 
+eventListCodec :: TomlCodec ProbEventList
+eventListCodec =
+    ProbEventList
+    <$> defaultValue (defProb probEventListClk) (intE "clk")
+    .= _probEventListClk
+    <*> defaultValue (defProb probEventListClk) (intE "all")
+    .= _probEventListAll
+    <*> defaultValue (defProb probEventListClk) (intE "var")
+    .= _probEventListClk
+    where
+        defProb i = defaultConfig ^. configProbability . probEventList . i
+        intE = int "eventlist"
+
 probCodec :: TomlCodec Probability
 probCodec =
     Probability
@@ -195,6 +222,8 @@ probCodec =
         .=  _probStmnt
         <*> defaultValue (defProb probExpr) exprCodec
         .=  _probExpr
+        <*> defaultValue (defProb probEventList) eventListCodec
+        .= _probEventList
     where defProb i = defaultConfig ^. configProbability . i
 
 propCodec :: TomlCodec Property
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