From 7653f8fd33162b8b166a12e125c988663ec2fe79 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 8 Apr 2019 21:24:39 +0100 Subject: Create Arbitrary module --- src/VeriFuzz/Verilog.hs | 3 +- src/VeriFuzz/Verilog/AST.hs | 209 +---------------------------------- src/VeriFuzz/Verilog/Arbitrary.hs | 221 ++++++++++++++++++++++++++++++++++++++ src/VeriFuzz/Verilog/CodeGen.hs | 13 +-- src/VeriFuzz/Verilog/Gen.hs | 1 + 5 files changed, 234 insertions(+), 213 deletions(-) create mode 100644 src/VeriFuzz/Verilog/Arbitrary.hs (limited to 'src') diff --git a/src/VeriFuzz/Verilog.hs b/src/VeriFuzz/Verilog.hs index fdf2ac0..e6f8c54 100644 --- a/src/VeriFuzz/Verilog.hs +++ b/src/VeriFuzz/Verilog.hs @@ -69,7 +69,6 @@ module VeriFuzz.Verilog , exprFunc , exprBody , exprStr - , exprWithContext , traverseExpr , ConstExpr(..) , constNum @@ -122,9 +121,11 @@ module VeriFuzz.Verilog , Arb , arb , genPositive + , exprWithContext ) where +import VeriFuzz.Verilog.Arbitrary import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen import VeriFuzz.Verilog.Gen diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs index 405b712..4473b96 100644 --- a/src/VeriFuzz/Verilog/AST.hs +++ b/src/VeriFuzz/Verilog/AST.hs @@ -69,7 +69,6 @@ module VeriFuzz.Verilog.AST , exprFunc , exprBody , exprStr - , exprWithContext , traverseExpr , ConstExpr(..) , constNum @@ -118,25 +117,15 @@ module VeriFuzz.Verilog.AST -- * Useful Lenses and Traversals , getModule , getSourceId - -- * Arbitrary - , Arb - , arb - , genPositive ) where import Control.Lens -import Control.Monad (replicateM) import Data.Data import Data.Data.Lens -import Data.List.NonEmpty (toList) -import Data.String (IsString, fromString) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Traversable (sequenceA) -import Hedgehog (Gen) -import qualified Hedgehog.Gen as Hog -import qualified Hedgehog.Range as Hog +import Data.String (IsString, fromString) +import Data.Text (Text) +import Data.Traversable (sequenceA) -- | Identifier in Verilog. This is just a string of characters that can either -- be lowercase and uppercase for now. This might change in the future though, @@ -423,195 +412,3 @@ getModule = getVerilog . traverse . getDescription getSourceId :: Traversal' Verilog Text getSourceId = getModule . modId . getIdentifier {-# INLINE getSourceId #-} - -listOf1 :: Gen a -> Gen [a] -listOf1 a = toList <$> Hog.nonEmpty (Hog.linear 0 100) a - -listOf :: Gen a -> Gen [a] -listOf = Hog.list (Hog.linear 0 100) - -genPositive :: Gen Int -genPositive = Hog.filter (>= 0) $ Hog.int (Hog.linear 1 99) - -integral :: Gen Integer -integral = Hog.integral (Hog.linear 0 100) - -class Arb a where - arb :: Gen a - -instance Arb Identifier where - arb = do - l <- genPositive - Identifier . T.pack <$> replicateM (l + 1) (Hog.element ['a'..'z']) - -instance Arb Delay where - arb = Delay <$> genPositive - -instance Arb Event where - arb = EId <$> arb - -instance Arb BinaryOperator where - arb = Hog.element - [ BinPlus - , BinMinus - , BinTimes - -- , BinDiv - -- , BinMod - , BinEq - , BinNEq - -- , BinCEq - -- , BinCNEq - , BinLAnd - , BinLOr - , BinLT - , BinLEq - , BinGT - , BinGEq - , BinAnd - , BinOr - , BinXor - , BinXNor - , BinXNorInv - -- , BinPower - , BinLSL - , BinLSR - , BinASL - , BinASR - ] - -instance Arb UnaryOperator where - arb = Hog.element - [ UnPlus - , UnMinus - , UnNot - , UnLNot - , UnAnd - , UnNand - , UnOr - , UnNor - , UnXor - , UnNxor - , UnNxorInv - ] - -instance Arb Function where - arb = Hog.element - [ SignedFunc - , UnSignedFunc - ] - -instance Arb Expr where - arb = Hog.sized expr - -exprSafeList :: [Gen Expr] -exprSafeList = [Number <$> genPositive <*> integral] - -exprRecList :: (Hog.Size -> Gen Expr) -> [Gen Expr] -exprRecList subexpr = - [ Number <$> genPositive <*> integral - , Concat <$> listOf1 (subexpr 8) - , UnOp - <$> arb - <*> subexpr 2 - -- , Str <$> arb - , BinOp <$> subexpr 2 <*> arb <*> subexpr 2 - , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 - , Func <$> arb <*> subexpr 2 - ] - -expr :: Hog.Size -> Gen Expr -expr n | n == 0 = Hog.choice $ (Id <$> arb) : exprSafeList - | n > 0 = Hog.choice $ (Id <$> arb) : exprRecList subexpr - | otherwise = expr 0 - where subexpr y = expr (n `div` y) - -exprWithContext :: [Identifier] -> Hog.Size -> Gen Expr -exprWithContext [] n | n == 0 = Hog.choice exprSafeList - | n > 0 = Hog.choice $ exprRecList subexpr - | otherwise = exprWithContext [] 0 - where subexpr y = exprWithContext [] (n `div` y) -exprWithContext l n - | n == 0 = Hog.choice $ (Id <$> Hog.element l) : exprSafeList - | n > 0 = Hog.choice $ (Id <$> Hog.element l) : exprRecList subexpr - | otherwise = exprWithContext l 0 - where subexpr y = exprWithContext l (n `div` y) - -instance Arb Int where - arb = Hog.int (Hog.linear 0 100) - -instance Arb ConstExpr where - arb = ConstExpr <$> Hog.int (Hog.linear 0 100) - -instance Arb Task where - arb = Task <$> arb <*> listOf arb - -instance Arb LVal where - arb = Hog.choice [ RegId <$> arb - , RegExpr <$> arb <*> arb - , RegSize <$> arb <*> arb <*> arb - ] - -instance Arb PortDir where - arb = Hog.element [PortIn, PortOut, PortInOut] - -instance Arb PortType where - arb = Hog.element [Wire, Reg] - -instance Arb Port where - arb = Port <$> arb <*> arb <*> genPositive <*> arb - -instance Arb ModConn where - arb = ModConn <$> arb - -instance Arb Assign where - arb = Assign <$> arb <*> Hog.maybe arb <*> arb - -instance Arb ContAssign where - arb = ContAssign <$> arb <*> arb - -instance Arb Statement where - arb = Hog.sized statement - -statement :: Hog.Size -> Gen Statement -statement n - | n == 0 = Hog.choice - [ BlockAssign <$> arb - , NonBlockAssign <$> arb - -- , StatCA <$> arb - , TaskEnable <$> arb - , SysTaskEnable <$> arb - ] - | n > 0 = Hog.choice - [ TimeCtrl <$> arb <*> (Just <$> substat 2) - , SeqBlock <$> listOf1 (substat 4) - , BlockAssign <$> arb - , NonBlockAssign <$> arb - -- , StatCA <$> arb - , TaskEnable <$> arb - , SysTaskEnable <$> arb - ] - | otherwise = statement 0 - where substat y = statement (n `div` y) - -instance Arb ModItem where - arb = Hog.choice [ ModCA <$> arb - , ModInst <$> arb <*> arb <*> listOf arb - , Initial <$> arb - , Always <$> (EventCtrl <$> arb <*> Hog.maybe arb) - , Decl <$> pure Nothing <*> arb - ] - -modPortGen :: Gen Port -modPortGen = Port <$> arb <*> arb <*> arb <*> arb - -instance Arb ModDecl where - arb = ModDecl <$> arb <*> listOf arb <*> listOf1 modPortGen <*> listOf arb - -instance Arb Description where - arb = Description <$> arb - -instance Arb Verilog where - arb = Verilog <$> listOf1 arb - -instance Arb Bool where - arb = Hog.element [True, False] diff --git a/src/VeriFuzz/Verilog/Arbitrary.hs b/src/VeriFuzz/Verilog/Arbitrary.hs new file mode 100644 index 0000000..72b4cc2 --- /dev/null +++ b/src/VeriFuzz/Verilog/Arbitrary.hs @@ -0,0 +1,221 @@ +{-| +Module : VeriFuzz.Verilog.Arbitrary +Description : Arb instance for all the types. +Copyright : (c) 2019, Yann Herklotz Grave +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Arb instance for all the types. +-} + +module VeriFuzz.Verilog.Arbitrary + ( + -- * Arbitrary + Arb + , arb + , genPositive + , exprWithContext + ) +where + +import Control.Monad (replicateM) +import Data.List.NonEmpty (toList) +import qualified Data.Text as T +import Hedgehog (Gen) +import qualified Hedgehog.Gen as Hog +import qualified Hedgehog.Range as Hog +import VeriFuzz.Verilog.AST + +listOf1 :: Gen a -> Gen [a] +listOf1 a = toList <$> Hog.nonEmpty (Hog.linear 0 100) a + +listOf :: Gen a -> Gen [a] +listOf = Hog.list (Hog.linear 0 100) + +genPositive :: Gen Int +genPositive = Hog.filter (>= 0) $ Hog.int (Hog.linear 1 99) + +integral :: Gen Integer +integral = Hog.integral (Hog.linear 0 100) + +class Arb a where + arb :: Gen a + +instance Arb Identifier where + arb = do + l <- genPositive + Identifier . T.pack <$> replicateM (l + 1) (Hog.element ['a'..'z']) + +instance Arb Delay where + arb = Delay <$> genPositive + +instance Arb Event where + arb = EId <$> arb + +instance Arb BinaryOperator where + arb = Hog.element + [ BinPlus + , BinMinus + , BinTimes + -- , BinDiv + -- , BinMod + , BinEq + , BinNEq + -- , BinCEq + -- , BinCNEq + , BinLAnd + , BinLOr + , BinLT + , BinLEq + , BinGT + , BinGEq + , BinAnd + , BinOr + , BinXor + , BinXNor + , BinXNorInv + -- , BinPower + , BinLSL + , BinLSR + , BinASL + , BinASR + ] + +instance Arb UnaryOperator where + arb = Hog.element + [ UnPlus + , UnMinus + , UnNot + , UnLNot + , UnAnd + , UnNand + , UnOr + , UnNor + , UnXor + , UnNxor + , UnNxorInv + ] + +instance Arb Function where + arb = Hog.element + [ SignedFunc + , UnSignedFunc + ] + +instance Arb Expr where + arb = Hog.sized expr + +exprSafeList :: [Gen Expr] +exprSafeList = [Number <$> genPositive <*> integral] + +exprRecList :: (Hog.Size -> Gen Expr) -> [Gen Expr] +exprRecList subexpr = + [ Number <$> genPositive <*> integral + , Concat <$> listOf1 (subexpr 8) + , UnOp + <$> arb + <*> subexpr 2 + -- , Str <$> arb + , BinOp <$> subexpr 2 <*> arb <*> subexpr 2 + , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 + , Func <$> arb <*> subexpr 2 + ] + +expr :: Hog.Size -> Gen Expr +expr n | n == 0 = Hog.choice $ (Id <$> arb) : exprSafeList + | n > 0 = Hog.choice $ (Id <$> arb) : exprRecList subexpr + | otherwise = expr 0 + where subexpr y = expr (n `div` y) + +exprWithContext :: [Identifier] -> Hog.Size -> Gen Expr +exprWithContext [] n | n == 0 = Hog.choice exprSafeList + | n > 0 = Hog.choice $ exprRecList subexpr + | otherwise = exprWithContext [] 0 + where subexpr y = exprWithContext [] (n `div` y) +exprWithContext l n + | n == 0 = Hog.choice $ (Id <$> Hog.element l) : exprSafeList + | n > 0 = Hog.choice $ (Id <$> Hog.element l) : exprRecList subexpr + | otherwise = exprWithContext l 0 + where subexpr y = exprWithContext l (n `div` y) + +instance Arb Int where + arb = Hog.int (Hog.linear 0 100) + +instance Arb ConstExpr where + arb = ConstExpr <$> Hog.int (Hog.linear 0 100) + +instance Arb Task where + arb = Task <$> arb <*> listOf arb + +instance Arb LVal where + arb = Hog.choice [ RegId <$> arb + , RegExpr <$> arb <*> arb + , RegSize <$> arb <*> arb <*> arb + ] + +instance Arb PortDir where + arb = Hog.element [PortIn, PortOut, PortInOut] + +instance Arb PortType where + arb = Hog.element [Wire, Reg] + +instance Arb Port where + arb = Port <$> arb <*> arb <*> genPositive <*> arb + +instance Arb ModConn where + arb = ModConn <$> arb + +instance Arb Assign where + arb = Assign <$> arb <*> Hog.maybe arb <*> arb + +instance Arb ContAssign where + arb = ContAssign <$> arb <*> arb + +instance Arb Statement where + arb = Hog.sized statement + +statement :: Hog.Size -> Gen Statement +statement n + | n == 0 = Hog.choice + [ BlockAssign <$> arb + , NonBlockAssign <$> arb + -- , StatCA <$> arb + , TaskEnable <$> arb + , SysTaskEnable <$> arb + ] + | n > 0 = Hog.choice + [ TimeCtrl <$> arb <*> (Just <$> substat 2) + , SeqBlock <$> listOf1 (substat 4) + , BlockAssign <$> arb + , NonBlockAssign <$> arb + -- , StatCA <$> arb + , TaskEnable <$> arb + , SysTaskEnable <$> arb + ] + | otherwise = statement 0 + where substat y = statement (n `div` y) + +instance Arb ModItem where + arb = Hog.choice [ ModCA <$> arb + , ModInst <$> arb <*> arb <*> listOf arb + , Initial <$> arb + , Always <$> (EventCtrl <$> arb <*> Hog.maybe arb) + , Decl <$> pure Nothing <*> arb + ] + +modPortGen :: Gen Port +modPortGen = Port <$> arb <*> arb <*> arb <*> arb + +instance Arb ModDecl where + arb = ModDecl <$> arb <*> listOf arb <*> listOf1 modPortGen <*> listOf arb + +instance Arb Description where + arb = Description <$> arb + +instance Arb Verilog where + arb = Verilog <$> listOf1 arb + +instance Arb Bool where + arb = Hog.element [True, False] diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs index a05309f..c42c880 100644 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -21,14 +21,15 @@ module VeriFuzz.Verilog.CodeGen ) where -import Control.Lens (view, (^.)) -import Data.Foldable (fold) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Numeric (showHex) +import Control.Lens (view, (^.)) +import Data.Foldable (fold) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Numeric (showHex) import VeriFuzz.Internal import VeriFuzz.Sim.Internal +import VeriFuzz.Verilog.Arbitrary import VeriFuzz.Verilog.AST -- | 'Source' class which determines that source code is able to be generated diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs index 87a0a31..3afdd1a 100644 --- a/src/VeriFuzz/Verilog/Gen.hs +++ b/src/VeriFuzz/Verilog/Gen.hs @@ -30,6 +30,7 @@ import Hedgehog (Gen) import qualified Hedgehog.Gen as Hog import VeriFuzz.Config import VeriFuzz.Internal +import VeriFuzz.Verilog.Arbitrary import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.Internal import VeriFuzz.Verilog.Mutate -- cgit