Add simple Hedgehog generator support

Author: kleinreact

clash-testbench/clash-testbench.cabal

@@ -39,6 +39,7 @@ library
     Clash.Testbench.Input
     Clash.Testbench.Output
     Clash.Testbench.Simulate
+    Clash.Testbench.Generate
   other-modules:
     Clash.Testbench.Internal.ID
     Clash.Testbench.Internal.Signal
@@ -48,6 +49,7 @@ library
     base,
     mtl,
     array,
+    hedgehog,
     containers,
     bytestring,
     clash-ffi,

clash-testbench/src/Clash/Testbench.hs

@@ -10,9 +10,11 @@ module Clash.Testbench
   , module Clash.Testbench.Input
   , module Clash.Testbench.Output
   , module Clash.Testbench.Simulate
+  , module Clash.Testbench.Generate
   ) where
 
 import Clash.Testbench.Signal
 import Clash.Testbench.Input
 import Clash.Testbench.Output
 import Clash.Testbench.Simulate
+import Clash.Testbench.Generate

clash-testbench/src/Clash/Testbench/Generate.hs

@@ -0,0 +1,24 @@
+module Clash.Testbench.Generate where
+
+import Hedgehog
+import Hedgehog.Gen
+
+import Clash.Prelude (KnownDomain(..), BitPack(..), NFDataX)
+
+import Clash.Testbench.Signal
+import Clash.Testbench.Internal.ID
+import Clash.Testbench.Internal.Signal hiding (TBSignal, TBClock, TBReset, TBEnable)
+import Clash.Testbench.Internal.Monad
+
+generate ::
+  (NFDataX a, BitPack a, KnownDomain dom) =>
+  Gen a -> TB (TBSignal dom a)
+generate generator =
+  mindSignal Generator
+    { signalId     = NoID
+    , signalCurVal = sample generator
+    , signalPrint  = Nothing
+    , ..
+    }
+
+ 

clash-testbench/src/Clash/Testbench/Internal/Monad.hs

@@ -247,6 +247,15 @@ runTB mode testbench = do
                 , ..
                 } :: Internal.TBSignal 'FINAL dom a
             )
+        (Generator{..} :: TBSignal dom a) ->
+          return $ SomeSignal
+            ( Generator
+                { signalId = case signalId of
+                    NoID       -> NoID
+                    SignalID x -> SignalID x
+                , ..
+                } :: Internal.TBSignal 'FINAL dom a
+            )
         Internal.TBSignal{..} -> do
           deps <- mapM fixAutoDomIds signalDeps
           return $ SomeSignal $ Internal.TBSignal
@@ -257,6 +266,8 @@ runTB mode testbench = do
             , ..
             }
 
+
+
     FreeID n <- gets idCount
     let a :: A.Array Int (SomeSignal 'FINAL)
         a = A.array (0, n-1)

clash-testbench/src/Clash/Testbench/Internal/Signal.hs

@@ -8,6 +8,8 @@ import Clash.Prelude
   , ssymbolToString
   )
 
+import Hedgehog (Gen)
+
 import Clash.FFI.VPI.Module (Module)
 import Clash.FFI.VPI.Port (Port, Direction)
 
@@ -46,6 +48,12 @@ data TBSignal (s :: Stage) (dom :: Domain) a =
       , signalCurVal :: IO a
       , signalPrint  :: Maybe (a -> String)
       }
+  | Generator
+      { signalId     :: ID s SIGNAL
+      , signalCurVal :: IO a
+      , signalPrint  :: Maybe (a -> String)
+      , generator    :: Gen a
+      }
 
 instance (KnownDomain dom, AnyStage s) => Show (TBSignal s dom a) where
   show = case knownDomain @dom of
@@ -58,6 +66,8 @@ instance (KnownDomain dom, AnyStage s) => Show (TBSignal s dom a) where
           <> show signalDeps
       IOInput{..} ->
         "Input " <> show signalId
+      Generator{..} ->
+        "Gen " <> show signalId
 
 instance AnyStage s => Eq (TBSignal s dom a) where
   (==) = (==) `on` signalId
@@ -79,20 +89,24 @@ instance Functor (TBSignal 'USER dom) where
         , signalUpdate = Nothing
           -- we lose printing abilities at this point. This is fine,
           -- since printing capabilities are recovered automatically
-          -- once the new signal gets watched.
+          -- once the new signal requires printing capabilities again.
         , signalPrint  = Nothing
         , ..
         }
     IOInput{..} ->
       IOInput
         { signalId     = NoID
         , signalCurVal = f <$> signalCurVal
-          -- we lose printing abilities at this point. This is fine,
-          -- since printing capabilities are recovered automatically
-          -- once the new signal gets watched.
         , signalPrint  = Nothing
         , ..
         }
+    Generator{..} ->
+      Generator
+        { signalId = NoID
+        , signalCurVal = f <$> signalCurVal
+        , signalPrint  = Nothing
+        , generator    = f <$> generator
+        }
 
 instance Applicative (TBSignal 'USER dom) where
   pure x =

clash-testbench/src/Clash/Testbench/Simulate.hs

@@ -67,8 +67,9 @@ simulate steps testbench = do
       when (i > 0) $ case signalPrint s of
         Nothing    -> return ()
         Just toStr -> Prelude.putStrLn . (<> toStr v) $ case s of
-          IOInput{}  -> "I "
-          TBSignal{} -> "O "
+          IOInput{}   -> "I "
+          Generator{} -> "I "
+          TBSignal{}  -> "O "
     modifyIORef tbSimStepRef (+ 1)
   return r
 
@@ -167,8 +168,9 @@ assignInputs = do
 --  putStrLn $ "assignInputs " <> show (time, vpiClock, vpiInit)
 
   forM_ vpiSignals $ onAllSignalTypes $ \case
-    IOInput{}    -> return ()
     TBSignal{..} -> mapM_ (assignModuleInputs vpiInstance) signalDeps
+    _            -> return ()
+
 
   let ?state = ?state { vpiClock = complement vpiClock
                       , vpiInit = False
@@ -207,7 +209,6 @@ readOutputs = do
 --  putStrLn $ "readOutputs " <> show time
 
   forM_ vpiSignals $ onAllSignalTypes $ \case
-    IOInput{}    -> return ()
     TBSignal{..} -> case vpiInstance of
       Nothing -> error "Cannot read from module"
       Just VPIInstance{..} ->
@@ -216,6 +217,7 @@ readOutputs = do
             Just upd -> liftIO $ upd $ unpack $ resize v
             Nothing  -> error "No signal update"
           _ -> error "Unexpected return format"
+    _ -> return ()
 
   -- print the watched signals
   i <- liftIO $ readIORef vpiStepRef
@@ -224,8 +226,9 @@ readOutputs = do
     case signalPrint s of
       Nothing    -> return ()
       Just toStr -> putStrLn . (<> toStr v) $ case s of
-        IOInput{}  -> "I "
-        TBSignal{} -> "O "
+        IOInput{}   -> "I "
+        Generator{} -> "I "
+        TBSignal{}  -> "O "
 
   -- proceed time for all instances not running trough Clash-FFI
   liftIO $ modifyIORef vpiStepRef (+ 1)
@@ -260,7 +263,6 @@ vpiInst ::
   (?signalFromID :: ID 'FINAL () -> SomeSignal 'FINAL, KnownDomain dom, BitPack a, Typeable b) =>
   Module -> TBSignal 'FINAL dom a -> SimCont b (TBSignal 'FINAL dom a)
 vpiInst vpiModule = \case
-  IOInput{}  -> error "Unfiltered IOInput"
   tbs@TBSignal{..} -> do
     ports <- modulePorts vpiModule
     dirs  <- mapM direction ports
@@ -292,6 +294,7 @@ vpiInst vpiModule = \case
       _   -> error "TODO: later / "
 
     return tbs { vpiInstance = Just VPIInstance{..} }
+  _ -> error "Unfiltered TBS"
 
  where
   isInput = \case