From 97693128e2d09cce93fb284a0ae56d094ca75e92 Mon Sep 17 00:00:00 2001
From: Yann Herklotz Grave <git@yannherklotzgrave.com>
Date: Wed, 6 Mar 2019 18:31:21 +0000
Subject: Add more probabilities to config

---
 src/VeriFuzz/CodeGen.hs |  2 +-
 src/VeriFuzz/Config.hs  | 50 ++++++++++++++++++++++++++-----------------------
 2 files changed, 28 insertions(+), 24 deletions(-)

(limited to 'src/VeriFuzz')

diff --git a/src/VeriFuzz/CodeGen.hs b/src/VeriFuzz/CodeGen.hs
index fa0530b..3a2f9b0 100644
--- a/src/VeriFuzz/CodeGen.hs
+++ b/src/VeriFuzz/CodeGen.hs
@@ -220,7 +220,7 @@ genAssign op (Assign r d e) =
 genStatement :: Statement -> Text
 genStatement (TimeCtrl  d stat   ) = genDelay d <> " " <> defMap stat
 genStatement (EventCtrl e stat   ) = genEvent e <> " " <> defMap stat
-genStatement (SeqBlock       s   ) = "begin\n" <> fold (genStatement <$> s) <> "end\n"
+genStatement (SeqBlock s) = "begin\n" <> fold (genStatement <$> s) <> "end\n"
 genStatement (BlockAssign    a   ) = genAssign " = " a <> ";\n"
 genStatement (NonBlockAssign a   ) = genAssign " <= " a <> ";\n"
 genStatement (StatCA         a   ) = genContAssign a
diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs
index 57363b3..d7fccb6 100644
--- a/src/VeriFuzz/Config.hs
+++ b/src/VeriFuzz/Config.hs
@@ -16,6 +16,8 @@ module VeriFuzz.Config
     ( Config(..)
     , defaultConfig
     , Probability(..)
+    , probBlock
+    , probNonBlock
     , probAssign
     , probAlways
     , propSize
@@ -34,8 +36,10 @@ import           Data.Text           (Text)
 import           Toml                (TomlCodec, (.=))
 import qualified Toml
 
-data Probability = Probability { _probAssign :: {-# UNPACK #-} !Int
-                               , _probAlways :: {-# UNPACK #-} !Int
+data Probability = Probability { _probAssign   :: {-# UNPACK #-} !Int
+                               , _probAlways   :: {-# UNPACK #-} !Int
+                               , _probBlock    :: {-# UNPACK #-} !Int
+                               , _probNonBlock :: {-# UNPACK #-} !Int
                                }
                  deriving (Eq, Show)
 
@@ -63,8 +67,7 @@ defaultValue
 defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional
 
 defaultConfig :: Config
-defaultConfig =
-    Config (Probability 1 1) (Property 100 Nothing)
+defaultConfig = Config (Probability 1 1 1 1) (Property 100 Nothing)
 
 probCodec :: TomlCodec Probability
 probCodec =
@@ -73,8 +76,11 @@ probCodec =
         .=  _probAssign
         <*> defaultValue (defProb probAlways) (Toml.int "always")
         .=  _probAlways
-    where
-        defProb i = defaultConfig ^. configProbability . i
+        <*> defaultValue (defProb probBlock) (Toml.int "blocking")
+        .=  _probAlways
+        <*> defaultValue (defProb probNonBlock) (Toml.int "nonblocking")
+        .=  _probAlways
+    where defProb i = defaultConfig ^. configProbability . i
 
 propCodec :: TomlCodec Property
 propCodec =
@@ -82,30 +88,28 @@ propCodec =
         <$> defaultValue (defProp propSize) (Toml.int "size")
         .=  _propSize
         <*> Toml.dioptional (Toml.int "seed")
-        .= _propSeed
-    where
-        defProp i = defaultConfig ^. configProperty . i
+        .=  _propSeed
+    where defProp i = defaultConfig ^. configProperty . i
 
 configCodec :: TomlCodec Config
-configCodec = Config
-    <$> defaultValue (defaultConfig ^. configProbability) (Toml.table probCodec "probability")
-    .= _configProbability
-    <*> defaultValue (defaultConfig ^. configProperty) (Toml.table propCodec "property")
-    .= _configProperty
+configCodec =
+    Config
+        <$> defaultValue (defaultConfig ^. configProbability)
+                         (Toml.table probCodec "probability")
+        .=  _configProbability
+        <*> defaultValue (defaultConfig ^. configProperty)
+                         (Toml.table propCodec "property")
+        .=  _configProperty
 
 parseConfigFile :: FilePath -> IO Config
 parseConfigFile = Toml.decodeFile configCodec
 
 parseConfig :: Text -> Config
 parseConfig t = case Toml.decode configCodec t of
-    Right c -> c
-    Left Toml.TrivialError ->
-        error "Trivial error while parsing Toml config"
-    Left (Toml.KeyNotFound k) ->
-        error $ "Key " ++ show k ++ " not found"
-    Left (Toml.TableNotFound k) ->
-        error $ "Table " ++ show k ++ " not found"
+    Right c                      -> c
+    Left Toml.TrivialError -> error "Trivial error while parsing Toml config"
+    Left  (Toml.KeyNotFound   k) -> error $ "Key " ++ show k ++ " not found"
+    Left  (Toml.TableNotFound k) -> error $ "Table " ++ show k ++ " not found"
     Left (Toml.TypeMismatch k _ _) ->
         error $ "Type mismatch with key " ++ show k
-    Left (Toml.ParseError _) ->
-        error "Config file parse error"
+    Left (Toml.ParseError _) -> error "Config file parse error"
-- 
cgit