clash-prelude-hedgehog (empty) → 1.6.0
raw patch · 9 files changed
+441/−0 lines, 9 filesdep +basedep +clash-preludedep +ghc-typelits-knownnat
Dependencies added: base, clash-prelude, ghc-typelits-knownnat, ghc-typelits-natnormalise, hedgehog, text
Files
- LICENSE +22/−0
- clash-prelude-hedgehog.cabal +56/−0
- src/Clash/Hedgehog/Signal.hs +39/−0
- src/Clash/Hedgehog/Sized/BitVector.hs +82/−0
- src/Clash/Hedgehog/Sized/Index.hs +47/−0
- src/Clash/Hedgehog/Sized/RTree.hs +46/−0
- src/Clash/Hedgehog/Sized/Signed.hs +47/−0
- src/Clash/Hedgehog/Sized/Unsigned.hs +47/−0
- src/Clash/Hedgehog/Sized/Vector.hs +55/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2021 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-prelude-hedgehog.cabal view
@@ -0,0 +1,56 @@+cabal-version: 2.2++name: clash-prelude-hedgehog+version: 1.6.0+synopsis: Hedgehog Generators for clash-prelude+description: Hedgehog Generators for clash-prelude+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 © 2021, QBayLogic B.V.+category: Hardware+build-type: Simple++common basic-config+ default-language: Haskell2010++ default-extensions:+ BinaryLiterals+ DataKinds+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators++ if impl(ghc >= 8.6)+ default-extensions:+ NoStarIsType++ ghc-options:+ -Wall -Wcompat++ build-depends:+ base >= 4.11 && < 5,+ hedgehog >= 1.0.3 && < 1.1,++library+ import: basic-config+ hs-source-dirs: src++ exposed-modules:+ Clash.Hedgehog.Signal+ Clash.Hedgehog.Sized.BitVector+ Clash.Hedgehog.Sized.Index+ Clash.Hedgehog.Sized.Signed+ Clash.Hedgehog.Sized.Unsigned+ Clash.Hedgehog.Sized.RTree+ Clash.Hedgehog.Sized.Vector++ build-depends:+ ghc-typelits-knownnat >= 0.7.2 && < 0.8,+ ghc-typelits-natnormalise >= 0.7.2 && < 0.8,+ text >= 1.2.2 && < 1.4,++ clash-prelude == 1.6.0,
+ src/Clash/Hedgehog/Signal.hs view
@@ -0,0 +1,39 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of types from "Clash.Signal.Internal".+-}++module Clash.Hedgehog.Signal+ ( genSignal+ , genActiveEdge+ , genInitBehavior+ , genResetKind+ , genResetPolarity+ ) where++import Control.Applicative (liftA2)+import Hedgehog (MonadGen)+import qualified Hedgehog.Gen as Gen++import Clash.Signal.Internal++genSignal :: (MonadGen m) => m a -> m (Signal dom a)+genSignal genElem = liftA2 (:-) genElem (genSignal genElem)++genActiveEdge :: (MonadGen m) => m ActiveEdge+genActiveEdge = Gen.element [Rising, Falling]++genInitBehavior :: (MonadGen m) => m InitBehavior+genInitBehavior = Gen.element [Unknown, Defined]++genResetKind :: (MonadGen m) => m ResetKind+genResetKind = Gen.element [Asynchronous, Synchronous]++genResetPolarity :: (MonadGen m) => m ResetPolarity+genResetPolarity = Gen.element [ActiveHigh, ActiveLow]++-- TODO Generate a full domain configuration.+-- We probably want some type like SomeSDomainConfiguration to generate GADTs
+ src/Clash/Hedgehog/Sized/BitVector.hs view
@@ -0,0 +1,82 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of BitVector.+-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}++{-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}++module Clash.Hedgehog.Sized.BitVector+ ( genDefinedBit+ , genBit+ , genDefinedBitVector+ , genBitVector+ , SomeBitVector(..)+ , genSomeBitVector+ ) where++import GHC.Natural (Natural)+import GHC.TypeNats+import Hedgehog (MonadGen, Range)+import qualified Hedgehog.Gen as Gen++import Clash.Promoted.Nat+import Clash.Sized.Internal.BitVector+import Clash.Sized.Vector (v2bv)+import Clash.XException (errorX)++import Clash.Hedgehog.Sized.Vector (genVec)++-- | Generate a bit which is guaranteed to be defined.+-- This will either have the value 'low' or 'high'.+--+genDefinedBit :: (MonadGen m) => m Bit+genDefinedBit = Gen.element [low, high]++-- | Generate a bit which is not guaranteed to be defined.+-- This will either have the value 'low' or 'high', or throw an 'XException'.+--+genBit :: (MonadGen m) => m Bit+genBit = Gen.element [low, high, errorX "X"]++-- | Generate a bit vector where all bits are defined.+--+genDefinedBitVector :: (MonadGen m, KnownNat n) => m (BitVector n)+genDefinedBitVector =+ Gen.frequency+ [ (60, fmap v2bv (genVec genDefinedBit))+ , (20, Gen.constant minBound)+ , (20, Gen.constant maxBound)+ ]++-- | Generate a bit vector where some bits may be undefined.+--+genBitVector :: (MonadGen m, KnownNat n) => m (BitVector n)+genBitVector =+ Gen.frequency+ [ (55, fmap v2bv (genVec genBit))+ , (15, Gen.constant minBound)+ , (15, Gen.constant maxBound)+ , (15, Gen.constant undefined#)+ ]++data SomeBitVector atLeast where+ SomeBitVector :: SNat n -> BitVector (atLeast + n) -> SomeBitVector atLeast++genSomeBitVector+ :: forall m atLeast+ . (MonadGen m, KnownNat atLeast)+ => Range Natural+ -> (forall n. KnownNat n => m (BitVector n))+ -> m (SomeBitVector atLeast)+genSomeBitVector rangeBv genBv = do+ numExtra <- Gen.integral rangeBv++ case someNatVal numExtra of+ SomeNat proxy -> SomeBitVector (snatProxy proxy) <$> genBv
+ src/Clash/Hedgehog/Sized/Index.hs view
@@ -0,0 +1,47 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of Index.+-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}++{-# LANGUAGE GADTs #-}++module Clash.Hedgehog.Sized.Index+ ( genIndex+ , SomeIndex(..)+ , genSomeIndex+ ) where++import GHC.Natural (Natural)+import GHC.TypeNats+import Hedgehog (MonadGen, Range)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Clash.Promoted.Nat+import Clash.Sized.Internal.Index++genIndex :: (MonadGen m, KnownNat n) => Range (Index n) -> m (Index n)+genIndex range =+ Gen.frequency+ [ (60, Gen.integral range)+ , (20, Gen.constant minBound)+ , (20, Gen.constant maxBound)+ ]++data SomeIndex atLeast where+ SomeIndex :: SNat n -> Index (atLeast + n) -> SomeIndex atLeast++genSomeIndex+ :: (MonadGen m, KnownNat atLeast)+ => Range Natural+ -> m (SomeIndex atLeast)+genSomeIndex rangeIx = do+ numExtra <- Gen.integral rangeIx++ case someNatVal numExtra of+ SomeNat proxy -> SomeIndex (snatProxy proxy) <$> genIndex Range.linearBounded
+ src/Clash/Hedgehog/Sized/RTree.hs view
@@ -0,0 +1,46 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of RTree.+-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}++{-# LANGUAGE GADTs #-}++module Clash.Hedgehog.Sized.RTree+ ( genRTree+ , genNonEmptyRTree+ , SomeRTree(..)+ , genSomeRTree+ ) where++import GHC.Natural (Natural)+import GHC.TypeNats+import Hedgehog (MonadGen, Range)+import qualified Hedgehog.Gen as Gen++import Clash.Promoted.Nat+import Clash.Sized.RTree++genRTree :: (MonadGen m, KnownNat n) => m a -> m (RTree n a)+genRTree genElem = sequenceA (trepeat genElem)++genNonEmptyRTree :: (MonadGen m, KnownNat n, 1 <= n) => m a -> m (RTree n a)+genNonEmptyRTree = genRTree++data SomeRTree atLeast a where+ SomeRTree :: SNat n -> RTree (atLeast + n) a -> SomeRTree atLeast a++genSomeRTree+ :: (MonadGen m, KnownNat atLeast)+ => Range Natural+ -> m a+ -> m (SomeRTree atLeast a)+genSomeRTree rangeElems genElem = do+ numExtra <- Gen.integral rangeElems++ case someNatVal numExtra of+ SomeNat proxy -> SomeRTree (snatProxy proxy) <$> genRTree genElem
+ src/Clash/Hedgehog/Sized/Signed.hs view
@@ -0,0 +1,47 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of Signed numbers.+-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}++{-# LANGUAGE GADTs #-}++module Clash.Hedgehog.Sized.Signed+ ( genSigned+ , SomeSigned(..)+ , genSomeSigned+ ) where++import GHC.Natural (Natural)+import GHC.TypeNats+import Hedgehog (MonadGen, Range)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Clash.Promoted.Nat+import Clash.Sized.Internal.Signed++genSigned :: (MonadGen m, KnownNat n) => Range (Signed n) -> m (Signed n)+genSigned range =+ Gen.frequency+ [ (60, Gen.integral range)+ , (20, Gen.constant minBound)+ , (20, Gen.constant maxBound)+ ]++data SomeSigned atLeast where+ SomeSigned :: SNat n -> Signed (atLeast + n) -> SomeSigned atLeast++genSomeSigned+ :: (MonadGen m, KnownNat atLeast)+ => Range Natural+ -> m (SomeSigned atLeast)+genSomeSigned rangeSigned = do+ numExtra <- Gen.integral rangeSigned++ case someNatVal numExtra of+ SomeNat proxy -> SomeSigned (snatProxy proxy) <$> genSigned Range.linearBounded
+ src/Clash/Hedgehog/Sized/Unsigned.hs view
@@ -0,0 +1,47 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of Unsigned numbers.+-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}++{-# LANGUAGE GADTs #-}++module Clash.Hedgehog.Sized.Unsigned+ ( genUnsigned+ , SomeUnsigned(..)+ , genSomeUnsigned+ ) where++import GHC.Natural (Natural)+import GHC.TypeNats+import Hedgehog (MonadGen, Range)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Clash.Promoted.Nat+import Clash.Sized.Internal.Unsigned++genUnsigned :: (MonadGen m, KnownNat n) => Range (Unsigned n) -> m (Unsigned n)+genUnsigned range =+ Gen.frequency+ [ (60, Gen.integral range)+ , (20, Gen.constant minBound)+ , (20, Gen.constant maxBound)+ ]++data SomeUnsigned atLeast where+ SomeUnsigned :: SNat n -> Unsigned (atLeast + n) -> SomeUnsigned atLeast++genSomeUnsigned+ :: (MonadGen m, KnownNat atLeast)+ => Range Natural+ -> m (SomeUnsigned atLeast)+genSomeUnsigned rangeUnsigned = do+ numExtra <- Gen.integral rangeUnsigned++ case someNatVal numExtra of+ SomeNat proxy -> SomeUnsigned (snatProxy proxy) <$> genUnsigned Range.linearBounded
+ src/Clash/Hedgehog/Sized/Vector.hs view
@@ -0,0 +1,55 @@+{-|+Copyright : (C) 2021, QBayLogic B.V.+License : BSD2 (see the file LICENSE)+Maintainer : QBayLogic B.V. <devops@qbaylogic.com>++Random generation of vectors.+-}++{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver #-}++{-# LANGUAGE GADTs #-}+{-# LANGUAGE MagicHash #-}++module Clash.Hedgehog.Sized.Vector+ ( genVec+ , genNonEmptyVec+ , SomeVec(..)+ , genSomeVec+ ) where++import Prelude hiding (repeat)++import GHC.Natural (Natural)+import GHC.TypeNats+import Hedgehog (MonadGen, Range)+import qualified Hedgehog.Gen as Gen++import Clash.Promoted.Nat+import Clash.Sized.Vector++-- | Generate a potentially empty vector, where each element is produced+-- using the supplied generator. For a non-empty vector, see 'genNonEmptyVec'.+--+genVec :: (MonadGen m, KnownNat n) => m a -> m (Vec n a)+genVec genElem = traverse# id (repeat genElem)++-- | Generate a non-empty vector, where each element is produced using the+-- supplied generator. For a potentially empty vector, see 'genVec'.+--+genNonEmptyVec :: (MonadGen m, KnownNat n, 1 <= n) => m a -> m (Vec n a)+genNonEmptyVec = genVec++data SomeVec atLeast a where+ SomeVec :: SNat n -> Vec (atLeast + n) a -> SomeVec atLeast a++genSomeVec+ :: (MonadGen m, KnownNat atLeast)+ => Range Natural+ -> m a+ -> m (SomeVec atLeast a)+genSomeVec rangeElems genElem = do+ numExtra <- Gen.integral rangeElems++ case someNatVal numExtra of+ SomeNat proxy -> SomeVec (snatProxy proxy) <$> genVec genElem