Create Arbitrary module

5 files changed, 234 insertions, 213 deletions

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