From 3f1190cd7fc873449a1fd430386aa4b773d010ac Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Thu, 10 Jan 2019 15:48:13 +0000 Subject: Rename module names so that I can move them --- src/Test/VeriFuzz/Circuit.hs | 4 +- src/Test/VeriFuzz/Graph/ASTGen.hs | 24 +-- src/Test/VeriFuzz/Graph/CodeGen.hs | 22 +-- src/Test/VeriFuzz/Graph/Random.hs | 4 +- src/Test/VeriFuzz/Graph/RandomAlt.hs | 4 +- src/Test/VeriFuzz/Internal/Gen.hs | 4 +- src/Test/VeriFuzz/Internal/Shared.hs | 4 +- src/Test/VeriFuzz/Simulator/General.hs | 31 +--- src/Test/VeriFuzz/Simulator/Icarus.hs | 24 +-- src/Test/VeriFuzz/Simulator/Xst.hs | 20 +-- src/Test/VeriFuzz/Simulator/Yosys.hs | 22 +-- src/Test/VeriFuzz/Verilog/AST.hs | 289 +++++++++++++++++++++++++-------- src/Test/VeriFuzz/Verilog/CodeGen.hs | 22 +-- src/Test/VeriFuzz/Verilog/Helpers.hs | 8 +- src/Test/VeriFuzz/Verilog/Mutate.hs | 16 +- 15 files changed, 315 insertions(+), 183 deletions(-) (limited to 'src') diff --git a/src/Test/VeriFuzz/Circuit.hs b/src/Test/VeriFuzz/Circuit.hs index 96f550b..7958f6a 100644 --- a/src/Test/VeriFuzz/Circuit.hs +++ b/src/Test/VeriFuzz/Circuit.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Circuit +Module : VeriFuzz.Circuit Description : Definition of the circuit graph. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,7 +10,7 @@ Portability : POSIX Definition of the circuit graph. -} -module Test.VeriFuzz.Circuit where +module VeriFuzz.Circuit where import Data.Graph.Inductive (Gr, LNode) import System.Random diff --git a/src/Test/VeriFuzz/Graph/ASTGen.hs b/src/Test/VeriFuzz/Graph/ASTGen.hs index d652752..2b241e1 100644 --- a/src/Test/VeriFuzz/Graph/ASTGen.hs +++ b/src/Test/VeriFuzz/Graph/ASTGen.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Graph.ASTGen +Module : VeriFuzz.Graph.ASTGen Description : Generates the AST from the graph directly. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,18 +10,18 @@ Portability : POSIX Generates the AST from the graph directly. -} -module Test.VeriFuzz.Graph.ASTGen where +module VeriFuzz.Graph.ASTGen where -import Data.Foldable (fold) -import Data.Graph.Inductive (LNode, Node) -import qualified Data.Graph.Inductive as G -import Data.Maybe (catMaybes) -import qualified Data.Text as T -import Test.VeriFuzz.Circuit -import Test.VeriFuzz.Internal.Gen -import Test.VeriFuzz.Internal.Shared -import Test.VeriFuzz.Verilog.AST -import Test.VeriFuzz.Verilog.Helpers +import Data.Foldable (fold) +import Data.Graph.Inductive (LNode, Node) +import qualified Data.Graph.Inductive as G +import Data.Maybe (catMaybes) +import qualified Data.Text as T +import VeriFuzz.Circuit +import VeriFuzz.Internal.Gen +import VeriFuzz.Internal.Shared +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.Helpers -- | Converts a 'CNode' to an 'Identifier'. frNode :: Node -> Identifier diff --git a/src/Test/VeriFuzz/Graph/CodeGen.hs b/src/Test/VeriFuzz/Graph/CodeGen.hs index b890a04..0d23044 100644 --- a/src/Test/VeriFuzz/Graph/CodeGen.hs +++ b/src/Test/VeriFuzz/Graph/CodeGen.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Graph.Random +Module : VeriFuzz.Graph.Random Description : Code generation directly from DAG. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,19 +10,19 @@ Portability : POSIX Define the code generation directly from the random DAG. -} -module Test.VeriFuzz.Graph.CodeGen +module VeriFuzz.Graph.CodeGen ( generate ) where -import Data.Foldable (fold) -import Data.Graph.Inductive (Graph, LNode, Node, indeg, - labNodes, nodes, outdeg, pre) -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import Test.VeriFuzz.Circuit -import Test.VeriFuzz.Internal.Gen -import Test.VeriFuzz.Internal.Shared +import Data.Foldable (fold) +import Data.Graph.Inductive (Graph, LNode, Node, indeg, labNodes, + nodes, outdeg, pre) +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import VeriFuzz.Circuit +import VeriFuzz.Internal.Gen +import VeriFuzz.Internal.Shared toOperator :: Gate -> Text toOperator And = " & " diff --git a/src/Test/VeriFuzz/Graph/Random.hs b/src/Test/VeriFuzz/Graph/Random.hs index 9483bdf..0514f6d 100644 --- a/src/Test/VeriFuzz/Graph/Random.hs +++ b/src/Test/VeriFuzz/Graph/Random.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Graph.Random +Module : VeriFuzz.Graph.Random Description : Random generation for DAG Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,7 +10,7 @@ Portability : POSIX Define the random generation for the directed acyclic graph. -} -module Test.VeriFuzz.Graph.Random where +module VeriFuzz.Graph.Random where import Data.Graph.Inductive (Context, Graph, LEdge) import qualified Data.Graph.Inductive as G diff --git a/src/Test/VeriFuzz/Graph/RandomAlt.hs b/src/Test/VeriFuzz/Graph/RandomAlt.hs index 9fe72e2..d9ee138 100644 --- a/src/Test/VeriFuzz/Graph/RandomAlt.hs +++ b/src/Test/VeriFuzz/Graph/RandomAlt.hs @@ -1,5 +1,5 @@ {-|p -Module : Test.VeriFuzz.Graph.RandomAlt +Module : VeriFuzz.Graph.RandomAlt Description : RandomAlt generation for DAG Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,7 +10,7 @@ Portability : POSIX Define the random generation for the directed acyclic graph. -} -module Test.VeriFuzz.Graph.RandomAlt where +module VeriFuzz.Graph.RandomAlt where import Data.Graph.Inductive (Graph, LEdge, mkGraph) import qualified Data.Graph.Inductive.Arbitrary as G diff --git a/src/Test/VeriFuzz/Internal/Gen.hs b/src/Test/VeriFuzz/Internal/Gen.hs index fdd958d..be275dd 100644 --- a/src/Test/VeriFuzz/Internal/Gen.hs +++ b/src/Test/VeriFuzz/Internal/Gen.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Internal.Gen +Module : VeriFuzz.Internal.Gen Description : Internal helpers for generation. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,7 +10,7 @@ Portability : POSIX Internal helpers for generation. -} -module Test.VeriFuzz.Internal.Gen where +module VeriFuzz.Internal.Gen where import Data.Graph.Inductive (Graph, Node) import qualified Data.Graph.Inductive as G diff --git a/src/Test/VeriFuzz/Internal/Shared.hs b/src/Test/VeriFuzz/Internal/Shared.hs index 54abb53..c7d2760 100644 --- a/src/Test/VeriFuzz/Internal/Shared.hs +++ b/src/Test/VeriFuzz/Internal/Shared.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Internal.Shared +Module : VeriFuzz.Internal.Shared Description : Shared high level code used in the other modules internally. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,7 +10,7 @@ Portability : POSIX Shared high level code used in the other modules internally. -} -module Test.VeriFuzz.Internal.Shared where +module VeriFuzz.Internal.Shared where -- | Converts unsafe list functions in the Prelude to a safe version. safe :: ([a] -> b) -> [a] -> Maybe b diff --git a/src/Test/VeriFuzz/Simulator/General.hs b/src/Test/VeriFuzz/Simulator/General.hs index 8c5c7ec..a024029 100644 --- a/src/Test/VeriFuzz/Simulator/General.hs +++ b/src/Test/VeriFuzz/Simulator/General.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Simulator.General +Module : VeriFuzz.Simulator.General Description : Class of the simulator. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,22 +10,15 @@ Portability : POSIX Class of the simulator and the synthesize tool. -} -module Test.VeriFuzz.Simulator.General where - -import Data.Bits (shiftL) -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.ByteString.Builder (byteStringHex, toLazyByteString) -import qualified Data.ByteString.Lazy as BL -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import Data.Text.Lazy.Builder (toLazyText) -import Data.Text.Lazy.Builder.Int (hexadecimal) -import Prelude hiding (FilePath) +module VeriFuzz.Simulator.General where + +import Data.Bits (shiftL) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Text (Text) +import Prelude hiding (FilePath) import Shelly -import Test.VeriFuzz.Internal.Shared -import Test.VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.AST -- | Simulator class. class Simulator a where @@ -51,12 +44,6 @@ timeout = command1 "timeout" ["180"] . toTextIgnore timeout_ :: FilePath -> [Text] -> Sh () timeout_ = command1_ "timeout" ["180"] . toTextIgnore -synthesizers :: [Text] -synthesizers = ["yosys", "xst"] - -simulators :: [Text] -simulators = ["yosim", "iverilog"] - -- | Helper function to convert bytestrings to integers bsToI :: ByteString -> Integer bsToI = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 diff --git a/src/Test/VeriFuzz/Simulator/Icarus.hs b/src/Test/VeriFuzz/Simulator/Icarus.hs index f2da676..744deb8 100644 --- a/src/Test/VeriFuzz/Simulator/Icarus.hs +++ b/src/Test/VeriFuzz/Simulator/Icarus.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Simulator.Icarus +Module : VeriFuzz.Simulator.Icarus Description : Icarus verilog module. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,21 +10,21 @@ Portability : POSIX Icarus verilog module. -} -module Test.VeriFuzz.Simulator.Icarus where +module VeriFuzz.Simulator.Icarus where import Control.Lens -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Foldable (fold) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Foldable (fold) import Data.Hashable -import Data.List (transpose) -import Data.Text (Text) -import qualified Data.Text as T -import Prelude hiding (FilePath) +import Data.List (transpose) +import Data.Text (Text) +import qualified Data.Text as T +import Prelude hiding (FilePath) import Shelly -import Test.VeriFuzz.Simulator.General -import Test.VeriFuzz.Verilog -import Text.Shakespeare.Text (st) +import Text.Shakespeare.Text (st) +import VeriFuzz.Simulator.General +import VeriFuzz.Verilog data Icarus = Icarus { icarusPath :: FilePath , vvpPath :: FilePath diff --git a/src/Test/VeriFuzz/Simulator/Xst.hs b/src/Test/VeriFuzz/Simulator/Xst.hs index dbc307b..902b244 100644 --- a/src/Test/VeriFuzz/Simulator/Xst.hs +++ b/src/Test/VeriFuzz/Simulator/Xst.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Simulator.Xst +Module : VeriFuzz.Simulator.Xst Description : Xst (ise) simulator implementation. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -12,17 +12,17 @@ Xst (ise) simulator implementation. {-# LANGUAGE QuasiQuotes #-} -module Test.VeriFuzz.Simulator.Xst where +module VeriFuzz.Simulator.Xst where -import Control.Lens hiding ((<.>)) -import Data.Text (Text) -import qualified Data.Text as T -import Prelude hiding (FilePath) +import Control.Lens hiding ((<.>)) +import Data.Text (Text) +import qualified Data.Text as T +import Prelude hiding (FilePath) import Shelly -import Test.VeriFuzz.Simulator.General -import Test.VeriFuzz.Verilog.AST -import Test.VeriFuzz.Verilog.CodeGen -import Text.Shakespeare.Text (st) +import Text.Shakespeare.Text (st) +import VeriFuzz.Simulator.General +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.CodeGen data Xst = Xst { xstPath :: FilePath , netgenPath :: FilePath diff --git a/src/Test/VeriFuzz/Simulator/Yosys.hs b/src/Test/VeriFuzz/Simulator/Yosys.hs index e96edad..3ac732d 100644 --- a/src/Test/VeriFuzz/Simulator/Yosys.hs +++ b/src/Test/VeriFuzz/Simulator/Yosys.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Simulator.Yosys +Module : VeriFuzz.Simulator.Yosys Description : Yosys simulator implementation. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -12,19 +12,19 @@ Yosys simulator implementation. {-# LANGUAGE QuasiQuotes #-} -module Test.VeriFuzz.Simulator.Yosys where +module VeriFuzz.Simulator.Yosys where import Control.Lens -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import Prelude hiding (FilePath) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Prelude hiding (FilePath) import Shelly -import Test.VeriFuzz.Simulator.General -import Test.VeriFuzz.Verilog -import Text.Shakespeare.Text (st) +import Text.Shakespeare.Text (st) +import VeriFuzz.Simulator.General +import VeriFuzz.Verilog newtype Yosys = Yosys { yosysPath :: FilePath } diff --git a/src/Test/VeriFuzz/Verilog/AST.hs b/src/Test/VeriFuzz/Verilog/AST.hs index b13ab30..63b1923 100644 --- a/src/Test/VeriFuzz/Verilog/AST.hs +++ b/src/Test/VeriFuzz/Verilog/AST.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Verilog.AST +Module : VeriFuzz.Verilog.AST Description : Definition of the Verilog AST types. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,18 +10,17 @@ Poratbility : POSIX Defines the types to build a Verilog AST. -} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} -module Test.VeriFuzz.Verilog.AST where +module VeriFuzz.Verilog.AST where -import Control.Lens -import qualified Data.Graph.Inductive as G -import Data.String -import Data.Text (Text) -import qualified Data.Text as T -import qualified Test.QuickCheck as QC -import Test.VeriFuzz.Circuit -import Test.VeriFuzz.Graph.Random +import Control.Lens (makeLenses, (^.)) +import Data.String (IsString, fromString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Traversable (sequenceA) +import qualified QuickCheck as QC -- | 'Source' class which determines that source code is able to be generated -- from the data structure using 'genSource'. This will be stored in 'Text' and @@ -29,26 +28,28 @@ import Test.VeriFuzz.Graph.Random class Source a where genSource :: a -> Text +positiveArb :: (QC.Arbitrary a, Ord a, Num a) => QC.Gen a +positiveArb = QC.suchThat QC.arbitrary (>0) + +instance QC.Arbitrary Text where + arbitrary = T.pack <$> QC.arbitrary + -- | 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, -- as Verilog supports many more characters in Identifiers. newtype Identifier = Identifier { _getIdentifier :: Text } - deriving (Eq) + deriving (Eq, IsString, Semigroup, Monoid) makeLenses ''Identifier -instance IsString Identifier where - fromString = Identifier . T.pack - -instance Semigroup Identifier where - (Identifier a) <> (Identifier b) = Identifier (a <> b) - -instance Monoid Identifier where - mempty = Identifier mempty - instance Show Identifier where show i = T.unpack $ i ^. getIdentifier +instance QC.Arbitrary Identifier where + arbitrary = do + l <- QC.choose (2, 10) + Identifier . T.pack <$> replicateM l (QC.elements ['a'..'z']) + -- | Verilog syntax for adding a delay, which is represented as @#num@. newtype Delay = Delay { _delay :: Int } deriving (Eq) @@ -62,28 +63,17 @@ instance Num Delay where signum (Delay a) = Delay $ signum a fromInteger = Delay . fromInteger +instance QC.Arbitrary Delay where + arbitrary = Delay <$> positiveArb + -- | Verilog syntax for an event, such as @\@x@, which is used for always blocks data Event = EId Identifier | EExpr Expr | EAll deriving (Eq) --- | Type that represents the left hand side of an assignment, which can be a --- concatenation such as in: --- --- @ --- {a, b, c} = 32'h94238; --- @ -data LVal = RegId Identifier - | RegExpr { _regExprId :: Identifier - , _regExpr :: Expr - } - | RegSize { _regSizeId :: Identifier - , _regSizeMSB :: ConstExpr - , _regSizeLSB :: ConstExpr - } - | RegConcat { _regConc :: [Expr] } - deriving (Eq) +instance QC.Arbitrary Event where + arbitrary = EId <$> QC.arbitrary -- | Binary operators that are currently supported in the verilog generation. data BinaryOperator = BinPlus -- ^ @+@ @@ -113,6 +103,35 @@ data BinaryOperator = BinPlus -- ^ @+@ | BinASR -- ^ @>>>@ deriving (Eq) +instance QC.Arbitrary BinaryOperator where + arbitrary = QC.elements + [ 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 + ] + -- | Unary operators that are currently supported by the generator. data UnaryOperator = UnPlus -- ^ @+@ | UnMinus -- ^ @-@ @@ -126,6 +145,20 @@ data UnaryOperator = UnPlus -- ^ @+@ | UnNxorInv -- ^ @^~@ deriving (Eq) +instance QC.Arbitrary UnaryOperator where + arbitrary = QC.elements + [ UnPlus + , UnMinus + , UnNot + , UnAnd + , UnNand + , UnOr + , UnNor + , UnXor + , UnNxor + , UnNxorInv + ] + -- | Verilog expression, which can either be a primary expression, unary -- expression, binary operator expression or a conditional expression. data Expr = Number { _numSize :: Int @@ -168,17 +201,70 @@ instance Monoid Expr where instance IsString Expr where fromString = Str . fromString +expr :: Int -> QC.Gen Expr +expr 0 = QC.oneof + [ Id <$> QC.arbitrary + , Number <$> positiveArb <*> QC.arbitrary + , UnOp <$> QC.arbitrary <*> QC.arbitrary + -- , Str <$> QC.arbitrary + ] +expr n + | n > 0 = QC.oneof + [ Id <$> QC.arbitrary + , Number <$> positiveArb <*> QC.arbitrary + , Concat <$> QC.listOf1 (subexpr 4) + , UnOp <$> QC.arbitrary <*> QC.arbitrary + -- , Str <$> QC.arbitrary + , BinOp <$> subexpr 2 <*> QC.arbitrary <*> subexpr 2 + , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 + ] + | otherwise = expr 0 + where + subexpr y = expr (n `div` y) + +instance QC.Arbitrary Expr where + arbitrary = QC.sized expr + +traverseExpr :: (Applicative f) => (Expr -> f Expr) -> Expr -> f Expr +traverseExpr f (Concat e) = Concat <$> sequenceA (f <$> e) +traverseExpr f (UnOp un e) = UnOp un <$> f e +traverseExpr f (BinOp l op r) = BinOp <$> f l <*> pure op <*> f r +traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r +traverseExpr _ e = pure e + +makeLenses ''Expr + -- | Constant expression, which are known before simulation at compilation time. newtype ConstExpr = ConstExpr { _constNum :: Int } - deriving (Eq) + deriving (Eq, Num) -instance Num ConstExpr where - ConstExpr a + ConstExpr b = ConstExpr $ a + b - ConstExpr a * ConstExpr b = ConstExpr $ a * b - ConstExpr a - ConstExpr b = ConstExpr $ a - b - abs (ConstExpr a) = ConstExpr $ abs a - signum (ConstExpr a) = ConstExpr $ signum a - fromInteger = ConstExpr . fromInteger +instance QC.Arbitrary ConstExpr where + arbitrary = ConstExpr <$> positiveArb + +-- | Type that represents the left hand side of an assignment, which can be a +-- concatenation such as in: +-- +-- @ +-- {a, b, c} = 32'h94238; +-- @ +data LVal = RegId Identifier + | RegExpr { _regExprId :: Identifier + , _regExpr :: Expr + } + | RegSize { _regSizeId :: Identifier + , _regSizeMSB :: ConstExpr + , _regSizeLSB :: ConstExpr + } + | RegConcat { _regConc :: [Expr] } + deriving (Eq) + +makeLenses ''LVal + +instance QC.Arbitrary LVal where + arbitrary = QC.oneof [ RegId <$> QC.arbitrary + , RegExpr <$> QC.arbitrary <*> QC.arbitrary + , RegSize <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary + ] -- | Different port direction that are supported in Verilog. data PortDir = PortIn -- ^ Input direction for port (@input@). @@ -186,12 +272,20 @@ data PortDir = PortIn -- ^ Input direction for port (@input@). | PortInOut -- ^ Inout direction for port (@inout@). deriving (Eq) +instance QC.Arbitrary PortDir where + arbitrary = QC.elements [PortIn, PortOut, PortInOut] + -- | Currently, only @wire@ and @reg@ are supported, as the other net types are -- not that common and not a priority. data PortType = Wire | Reg { _regSigned :: Bool } deriving (Eq) +instance QC.Arbitrary PortType where + arbitrary = QC.oneof [pure Wire, Reg <$> QC.arbitrary] + +makeLenses ''PortType + -- | Port declaration. It contains information about the type of the port, the -- size, and the port name. It used to also contain information about if it was -- an input or output port. However, this is not always necessary and was more @@ -205,6 +299,11 @@ data Port = Port { _portType :: PortType , _portName :: Identifier } deriving (Eq) +makeLenses ''Port + +instance QC.Arbitrary Port where + arbitrary = Port <$> QC.arbitrary <*> positiveArb <*> QC.arbitrary + -- | This is currently a type because direct module declaration should also be -- added: -- @@ -214,17 +313,28 @@ data Port = Port { _portType :: PortType newtype ModConn = ModConn { _modConn :: Expr } deriving (Eq) +makeLenses ''ModConn + +instance QC.Arbitrary ModConn where + arbitrary = ModConn <$> QC.arbitrary + data Assign = Assign { _assignReg :: LVal , _assignDelay :: Maybe Delay , _assignExpr :: Expr } deriving (Eq) +instance QC.Arbitrary Assign where + arbitrary = Assign <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary + data ContAssign = ContAssign { _contAssignNetLVal :: Identifier , _contAssignExpr :: Expr } deriving (Eq) makeLenses ''ContAssign +instance QC.Arbitrary ContAssign where + arbitrary = ContAssign <$> QC.arbitrary <*> QC.arbitrary + -- | Stmnts in Verilog. data Stmnt = TimeCtrl { _statDelay :: Delay , _statDStat :: Maybe Stmnt @@ -249,10 +359,40 @@ instance Semigroup Stmnt where instance Monoid Stmnt where mempty = SeqBlock [] +statement :: Int -> QC.Gen Stmnt +statement 0 = QC.oneof + [ BlockAssign <$> QC.arbitrary + , NonBlockAssign <$> QC.arbitrary + -- , StatCA <$> QC.arbitrary + , TaskEnable <$> QC.arbitrary + , SysTaskEnable <$> QC.arbitrary + ] +statement n + | n > 0 = QC.oneof + [ TimeCtrl <$> QC.arbitrary <*> (Just <$> substat 2) + , SeqBlock <$> QC.listOf1 (substat 4) + , BlockAssign <$> QC.arbitrary + , NonBlockAssign <$> QC.arbitrary + -- , StatCA <$> QC.arbitrary + , TaskEnable <$> QC.arbitrary + , SysTaskEnable <$> QC.arbitrary + ] + | otherwise = statement 0 + where + substat y = statement (n `div` y) + +instance QC.Arbitrary Stmnt where + arbitrary = QC.sized statement + data Task = Task { _taskName :: Identifier , _taskExpr :: [Expr] } deriving (Eq) +makeLenses ''Task + +instance QC.Arbitrary Task where + arbitrary = Task <$> QC.arbitrary <*> QC.arbitrary + -- | Module item which is the body of the module expression. data ModItem = ModCA ContAssign | ModInst { _modInstId :: Identifier @@ -266,6 +406,16 @@ data ModItem = ModCA ContAssign } deriving (Eq) +makeLenses ''ModItem + +instance QC.Arbitrary ModItem where + arbitrary = QC.oneof [ ModCA <$> QC.arbitrary + , ModInst <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary + , Initial <$> QC.arbitrary + , Always <$> (EventCtrl <$> QC.arbitrary <*> QC.arbitrary) + , Decl <$> pure Nothing <*> QC.arbitrary + ] + -- | 'module' module_identifier [list_of_ports] ';' { module_item } 'end_module' data ModDecl = ModDecl { _moduleId :: Identifier , _modOutPorts :: [Port] @@ -273,44 +423,39 @@ data ModDecl = ModDecl { _moduleId :: Identifier , _moduleItems :: [ModItem] } deriving (Eq) +makeLenses ''ModDecl + +modPortGen :: QC.Gen Port +modPortGen = QC.oneof + [ Port Wire <$> positiveArb <*> QC.arbitrary + , Port <$> (Reg <$> QC.arbitrary) <*> positiveArb <*> QC.arbitrary + ] + + +instance QC.Arbitrary ModDecl where + arbitrary = ModDecl <$> QC.arbitrary <*> QC.arbitrary + <*> QC.listOf1 modPortGen <*> QC.arbitrary + -- | Description of the Verilog module. newtype Description = Description { _getDescription :: ModDecl } deriving (Eq) +makeLenses ''Description + +instance QC.Arbitrary Description where + arbitrary = Description <$> QC.arbitrary + -- | The complete sourcetext for the Verilog module. newtype VerilogSrc = VerilogSrc { _getVerilogSrc :: [Description] } deriving (Eq) +makeLenses ''VerilogSrc + instance Semigroup VerilogSrc where VerilogSrc a <> VerilogSrc b = VerilogSrc $ a ++ b instance Monoid VerilogSrc where mempty = VerilogSrc [] --- Traversal Instance - -traverseExpr :: Traversal' Expr Expr -traverseExpr f (Concat e) = Concat <$> sequenceA (f <$> e) -traverseExpr f (UnOp un e) = UnOp un <$> f e -traverseExpr f (BinOp l op r) = BinOp <$> f l <*> pure op <*> f r -traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r -traverseExpr _ e = pure e - --- Create all the necessary lenses - -makeLenses ''VerilogSrc -makeLenses ''Description -makeLenses ''ModDecl -makeLenses ''ModItem -makeLenses ''Port -makeLenses ''PortDir -makeLenses ''BinaryOperator -makeLenses ''UnaryOperator -makeLenses ''Expr -makeLenses ''PortType - --- Make all the necessary prisms - -makePrisms ''Expr -makePrisms ''ModItem -makePrisms ''ModConn +instance QC.Arbitrary VerilogSrc where + arbitrary = VerilogSrc <$> QC.arbitrary diff --git a/src/Test/VeriFuzz/Verilog/CodeGen.hs b/src/Test/VeriFuzz/Verilog/CodeGen.hs index eaac48b..d97c8b9 100644 --- a/src/Test/VeriFuzz/Verilog/CodeGen.hs +++ b/src/Test/VeriFuzz/Verilog/CodeGen.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Verilog.CodeGen +Module : VeriFuzz.Verilog.CodeGen Description : Code generation for Verilog AST. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -8,20 +8,20 @@ Stability : experimental Portability : POSIX This module generates the code from the Verilog AST defined in -"Test.VeriFuzz.Verilog.AST". +"VeriFuzz.Verilog.AST". -} -module Test.VeriFuzz.Verilog.CodeGen where +module VeriFuzz.Verilog.CodeGen where import Control.Lens -import Data.Foldable (fold) -import Data.Maybe (isNothing) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Numeric (showHex) -import Test.VeriFuzz.Internal.Shared -import Test.VeriFuzz.Verilog.AST +import Data.Foldable (fold) +import Data.Maybe (isNothing) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Numeric (showHex) +import VeriFuzz.Internal.Shared +import VeriFuzz.Verilog.AST -- | Inserts commas between '[Text]' and except the last one. comma :: [Text] -> Text diff --git a/src/Test/VeriFuzz/Verilog/Helpers.hs b/src/Test/VeriFuzz/Verilog/Helpers.hs index 20c3b0d..0204379 100644 --- a/src/Test/VeriFuzz/Verilog/Helpers.hs +++ b/src/Test/VeriFuzz/Verilog/Helpers.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Verilog.Helpers +Module : VeriFuzz.Verilog.Helpers Description : Defaults and common functions. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -10,12 +10,12 @@ Portability : POSIX Defaults and common functions. -} -module Test.VeriFuzz.Verilog.Helpers where +module VeriFuzz.Verilog.Helpers where import Control.Lens -import Data.Text (Text) +import Data.Text (Text) import qualified Data.Text -import Test.VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.AST regDecl :: Identifier -> ModItem regDecl = Decl Nothing . Port (Reg False) 1 diff --git a/src/Test/VeriFuzz/Verilog/Mutate.hs b/src/Test/VeriFuzz/Verilog/Mutate.hs index 367516a..501d217 100644 --- a/src/Test/VeriFuzz/Verilog/Mutate.hs +++ b/src/Test/VeriFuzz/Verilog/Mutate.hs @@ -1,5 +1,5 @@ {-| -Module : Test.VeriFuzz.Verilog.Mutation +Module : VeriFuzz.Verilog.Mutation Description : Functions to mutate the Verilog AST. Copyright : (c) 2018-2019, Yann Herklotz Grave License : BSD-3 @@ -7,18 +7,18 @@ Maintainer : ymherklotz [at] gmail [dot] com Stability : experimental Portability : POSIX -Functions to mutate the Verilog AST from "Test.VeriFuzz.Verilog.AST" to generate +Functions to mutate the Verilog AST from "VeriFuzz.Verilog.AST" to generate more random patterns, such as nesting wires instead of creating new ones. -} -module Test.VeriFuzz.Verilog.Mutate where +module VeriFuzz.Verilog.Mutate where import Control.Lens -import Data.Maybe (catMaybes, fromMaybe) -import Test.VeriFuzz.Internal.Gen -import Test.VeriFuzz.Internal.Shared -import Test.VeriFuzz.Verilog.AST -import Test.VeriFuzz.Verilog.CodeGen +import Data.Maybe (catMaybes, fromMaybe) +import VeriFuzz.Internal.Gen +import VeriFuzz.Internal.Shared +import VeriFuzz.Verilog.AST +import VeriFuzz.Verilog.CodeGen -- | Return if the 'Identifier' is in a 'ModDecl'. inPort :: Identifier -> ModDecl -> Bool -- cgit