clash-testbench Framework

cabal.project

@@ -9,6 +9,7 @@ packages:
   ./clash-prelude
   ./clash-prelude-hedgehog
   ./clash-cores
+  ./clash-testbench
   ./tests
 
 write-ghc-environment-files: always

clash-testbench/LICENSE

@@ -0,0 +1,22 @@
+Copyright (c) 2023 QBayLogic B.V.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

clash-testbench/clash-testbench.cabal

@@ -0,0 +1,57 @@
+cabal-version:      2.2
+
+name:               clash-testbench
+version:            0.1.0.0
+synopsis:           Design your TestBenches in Clash
+description:        Design your TestBenches in Clash
+bug-reports:        https://github.com/clash-lang/clash-compiler/issues
+license:            BSD-2-Clause
+license-file:       LICENSE
+author:             QBayLogic B.V.
+maintainer:         devops@qbaylogic.com
+copyright:          Copyright © 2023, QBayLogic B.V.
+category:           Hardware
+
+library
+  default-language: Haskell2010
+  default-extensions:
+    DataKinds
+    FlexibleContexts
+    FlexibleInstances
+    GADTs
+    ImplicitParams
+    LambdaCase
+    MagicHash
+    MultiWayIf
+    NamedFieldPuns
+    RankNTypes
+    RecordWildCards
+    ScopedTypeVariables
+    TupleSections
+    TypeApplications
+    TypeFamilies
+    ViewPatterns
+  ghc-options:
+    -Wall -Wcompat
+  exposed-modules:
+    Clash.Testbench
+    Clash.Testbench.Signal
+    Clash.Testbench.Input
+    Clash.Testbench.Output
+    Clash.Testbench.Simulate
+    Clash.Testbench.Generate
+    Clash.Testbench.Internal.ID
+    Clash.Testbench.Internal.Signal
+    Clash.Testbench.Internal.Monad
+    Control.Monad.Extra
+  build-depends:
+    base,
+    mtl,
+    array,
+    lattices,
+    hedgehog,
+    containers,
+    bytestring,
+    clash-ffi,
+    clash-prelude,
+  hs-source-dirs: src

clash-testbench/example/Calculator.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+module Calculator where
+
+import Clash.Prelude hiding (Word)
+
+type Word = Signed 4
+data OPC a = ADD | MUL | Imm a | Pop | Push
+  deriving (Lift, Generic, BitPack, NFDataX, Show)
+
+(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
+(f .: g) a b = f (g a b)
+
+infixr 9 .:
+
+alu :: Num a => OPC a -> a -> a -> Maybe a
+alu ADD     = Just .: (+)
+alu MUL     = Just .: (*)
+alu (Imm i) = const . const (Just i)
+alu _       = const . const Nothing
+
+pu :: (Num a, Num b)
+   => (OPC a -> a -> a -> Maybe a)
+   -> (a, a, b)       -- Current state
+   -> (a, OPC a)      -- Input
+   -> ( (a, a, b)     -- New state
+      , (b, Maybe a)  -- Output
+      )
+pu _ (op1,   _, cnt) (dmem, Pop)  = ((dmem, op1, cnt - 1), (cnt, Nothing)      )
+pu _ (op1, op2, cnt) (   _, Push) = ((op1, op2, cnt + 1) , (cnt, Nothing)      )
+pu a (op1, op2, cnt) (   _, opc)  = ((op1, op2, cnt)     , (cnt, a opc op1 op2))
+
+datamem :: (KnownNat n, Integral i)
+        => Vec n a       -- Current state
+        -> (i, Maybe a)  -- Input
+        -> (Vec n a, a)  -- (New state, Output)
+datamem mem (addr,Nothing)  = (mem                 ,mem !! addr)
+datamem mem (addr,Just val) = (replace addr val mem,mem !! addr)
+
+topEntity
+  :: Clock  System
+  -> Reset  System
+  -> Enable System
+  -> Signal System (OPC Word)
+  -> Signal System (Maybe Word)
+topEntity = exposeClockResetEnable go where
+  go i = val where
+    (addr,val) = (pu alu <^> (0,0,0 :: Unsigned 3)) (mem,i)
+    mem        = (datamem <^> initMem) (addr,val)
+    initMem    = replicate d8 0
+{-# NOINLINE topEntity #-}

clash-testbench/example/LICENSE

@@ -0,0 +1,22 @@
+Copyright (c) 2023 QBayLogic B.V.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

clash-testbench/example/Main.hs

@@ -0,0 +1,111 @@
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Data.Bool (bool)
+
+import Clash.Prelude (Signal, Clock, Reset, Enable, Signed, System, exposeClockResetEnable, register, bundle, unsafeFromReset, hasReset, fromEnable, hasEnable)
+
+import Clash.Testbench
+
+import Calculator (OPC(..))
+--import qualified Calculator (topEntity)
+import qualified Register (topEntity)
+import qualified RegisterFail (topEntity)
+
+import Control.Monad (void)
+import Control.Monad.IO.Class
+import Clash.Hedgehog.Sized.Signed
+import Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+
+{-
+genIO :: Gen [(OPC (Signed 4), Maybe (Signed 4))]
+genIO = do
+  -- generate 7 constants
+  cs  <- Gen.list (Range.singleton 7) (genSigned Range.constantBounded)
+  -- generate 6 operations
+  ops <- map (bool (ADD, (+)) (MUL, (*))) <$> Gen.list (Range.singleton 6) Gen.bool
+
+  let
+    -- push the constants to the stack
+    in1 = concatMap ((: [Push])    . Imm)  cs -- inputs
+    eo1 = concatMap ((: [Nothing]) . Just) cs -- expected outputs
+
+    -- calculate the results of the applied operations
+    x : xr = reverse cs
+    rs = [ foldl (\a (op, b) -> op a b) x $ zip (map snd ops) $ take n xr
+         | n <- [1,2..length xr]
+         ]
+
+    -- apply the operations
+    in2 = concatMap ((replicate 3 Pop     <>) . pure . fst)  ops -- inputs
+    eo2 = concatMap ((replicate 3 Nothing <>) . pure . Just) rs  -- expected outputs
+
+  return $ zip (in1 <> in2) (eo1 <> eo2)
+
+myTestbench
+  :: TB ()
+myTestbench = mdo
+  input <- fromList Pop [Imm 1, Push, Imm 2, Push, Pop, Pop, Pop, ADD]
+--  input <- matchIOGenN output genIO
+  output <- ("topEntity" @@ Calculator.topEntity) auto auto auto input
+  watch input
+  watch output
+-}
+
+rstenb
+  :: Clock  System
+  -> Reset  System
+  -> Enable System
+  -> Signal System (Bool, Bool)
+rstenb = exposeClockResetEnable
+  $ bundle (unsafeFromReset hasReset, fromEnable hasEnable)
+
+myTestbench
+  :: TB ()
+myTestbench = mdo
+  input <- matchIOGenN output $ do
+    cs  <- Gen.list (Range.singleton 7) (genSigned Range.constantBounded)
+    return $ ((0,0) :) $ zip cs $ 0 : cs
+  output <- ("topEntity" @@ Register.topEntity) auto auto auto input
+--  x <- ("rstenb" @@ rstenb) auto auto auto
+--  watch x
+  watch input
+  watch output
+
+myTestbenchFail
+  :: TB ()
+myTestbenchFail = mdo
+  input <- matchIOGenN output $ do
+    cs  <- Gen.list (Range.singleton 7) (genSigned Range.constantBounded)
+    return $ ((0,0) :) $ zip cs $ 0 : cs
+  output <- ("topEntity" @@ RegisterFail.topEntity) auto auto auto input
+--  x <- ("rstenb" @@ rstenb) auto auto auto
+--  watch x
+  watch input
+  watch output
+
+
+main :: IO ()
+main =
+--  simulate 10 myTestbench
+  void $ checkParallel $ Group "Default"
+    [ ("'successful test'", withTests 1 $ tbProperty myTestbench)
+    , ("'failing test'", withTests 1 $ tbProperty myTestbenchFail)
+    ]
+
+foreign export ccall "clash_ffi_main"
+  ffiMain :: IO ()
+
+ffiMain :: IO ()
+ffiMain = do
+--  simulateFFI (SimSettings False False) myTestbench
+  sync <- ffiHedgehog
+  ffiCheckGroup sync $ Group "Default"
+    [ ("'successful test'", withTests 1 $ (tbPropertyFFI sync) myTestbench)
+--    [ ("'failing test'", withTests 1 $ (tbPropertyFFI sync) myTestbenchFail)
+    ]

clash-testbench/example/Register.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE DataKinds #-}
+module Register where
+
+import Clash.Prelude
+
+topEntity
+  :: Clock  System
+  -> Reset  System
+  -> Enable System
+  -> Signal System (Signed 4)
+  -> Signal System (Signed 4)
+
+topEntity = exposeClockResetEnable reg
+  where
+    reg i = register 0 i

clash-testbench/example/RegisterFail.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds #-}
+module RegisterFail where
+
+import Clash.Prelude
+
+topEntity
+  :: Clock  System
+  -> Reset  System
+  -> Enable System
+  -> Signal System (Signed 4)
+  -> Signal System (Signed 4)
+
+topEntity = exposeClockResetEnable regFail
+  where    
+    reg i = register 0 i
+
+    count ::
+      HiddenClockResetEnable dom =>
+      Signal dom (Signed 3)
+    count =
+      register 0 ((+1) <$> count)
+
+    regFail ::
+      HiddenClockResetEnable dom =>
+      Signal dom (Signed 4) ->
+      Signal dom (Signed 4)
+
+    regFail =
+      mux ((== 4) <$> count) 0 . reg    
+
+