From 3fbb87fe5c5058ecb2a2bdc30a999835aaced8af Mon Sep 17 00:00:00 2001
From: Yann Herklotz Grave <git@yannherklotzgrave.com>
Date: Sun, 3 Mar 2019 18:57:07 +0000
Subject: Add transformers and procedural generation

---
 src/VeriFuzz/Gen.hs | 95 ++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 84 insertions(+), 11 deletions(-)

(limited to 'src/VeriFuzz/Gen.hs')

diff --git a/src/VeriFuzz/Gen.hs b/src/VeriFuzz/Gen.hs
index 1e83888..1a64344 100644
--- a/src/VeriFuzz/Gen.hs
+++ b/src/VeriFuzz/Gen.hs
@@ -10,19 +10,44 @@ Portability : POSIX
 Various useful generators.
 -}
 
+{-# LANGUAGE TemplateHaskell #-}
+
 module VeriFuzz.Gen where
 
-import           Control.Lens
-import           Data.Foldable     (fold)
-import qualified Data.Text         as T
-import           Test.QuickCheck   (Gen)
-import qualified Test.QuickCheck   as QC
+import           Control.Lens                   hiding (Context)
+import           Control.Monad                  (replicateM)
+import           Control.Monad.Trans.Class      (lift)
+import           Control.Monad.Trans.Reader     hiding (local)
+import           Control.Monad.Trans.State.Lazy
+import           Data.Foldable                  (fold)
+import qualified Data.Text                      as T
+import           Test.QuickCheck                (Gen)
+import qualified Test.QuickCheck                as QC
 import           VeriFuzz.AST
 import           VeriFuzz.ASTGen
+import           VeriFuzz.CodeGen
 import           VeriFuzz.Internal
 import           VeriFuzz.Mutate
 import           VeriFuzz.Random
 
+data Context = Context { _variables :: [Port]
+                       , _modules   :: [ModDecl]
+                       }
+
+makeLenses ''Context
+
+data ProbModItem = ProbModItem { _probAssign :: {-# UNPACK #-} !Int
+                               , _probAlways :: {-# UNPACK #-} !Int
+                               }
+
+makeLenses ''ProbModItem
+
+data Probabilities = Probabilities { _probModItem :: {-# UNPACK #-} !ProbModItem }
+
+makeLenses ''Probabilities
+
+type StateGen =  StateT Context (ReaderT Probabilities Gen)
+
 toId :: Int -> Identifier
 toId = Identifier . ("w" <>) . T.pack . show
 
@@ -54,12 +79,7 @@ randomMod inps total = do
     let other   = drop inps ident
     let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids
     let yport   = [wire (sumSize other) "y"]
-    return
-        .  initMod
-        .  declareMod other
-        .  ModDecl "test_module" yport inputs_
-        $  x
-        ++ [y]
+    return . declareMod other . ModDecl "test_module" yport inputs_ $ x ++ [y]
   where
     ids   = toId <$> [1 .. total]
     end   = drop inps ids
@@ -75,3 +95,56 @@ fromGraph = do
         ^.. getVerilogSrc
         .   traverse
         .   getDescription
+
+gen :: Gen a -> StateGen a
+gen = lift . lift
+
+proceduralContAssign :: StateGen ContAssign
+proceduralContAssign = do
+    name    <- gen QC.arbitrary
+    size    <- gen positiveArb
+    signed  <- gen QC.arbitrary
+    context <- get
+    variables %= (Port Wire signed size name :)
+    ContAssign name
+        <$> (   gen
+            .   QC.sized
+            .   exprWithContext
+            $   context
+            ^.. variables
+            .   traverse
+            .   portName
+            )
+
+proceduralModItem :: StateGen ModItem
+proceduralModItem = ModCA <$> proceduralContAssign
+
+proceduralPorts :: StateGen [Port]
+proceduralPorts = do
+    portList <- gen $ QC.listOf1 QC.arbitrary
+    variables %= (<> portList)
+    return portList
+
+proceduralMod :: Bool -> StateGen ModDecl
+proceduralMod top = do
+    name     <- if top then return "top" else gen QC.arbitrary
+    portList <- proceduralPorts
+    amount   <- gen positiveArb
+    mi       <- replicateM amount proceduralModItem
+    context  <- get
+    let local = filter (\p -> notElem p portList) $ context ^. variables
+    let size  = sum $ local ^.. traverse . portSize
+    let yport = Port Wire False size "y"
+    return . declareMod local . ModDecl name [yport] portList $ combineAssigns
+        yport
+        mi
+
+procedural :: Gen VerilogSrc
+procedural =
+    VerilogSrc
+        .   (: [])
+        .   Description
+        <$> runReaderT (evalStateT (proceduralMod True) context) config
+  where
+    config  = Probabilities (ProbModItem 5 1)
+    context = Context [] []
-- 
cgit