Use HashMap for contextfeature/hashmap

6 files changed, 147 insertions, 68 deletions

diff --git a/src/VeriFuzz/Context.hs b/src/VeriFuzz/Context.hs
new file mode 100644
index 0000000..8aeed8d
--- /dev/null
+++ b/src/VeriFuzz/Context.hs
@@ -0,0 +1,59 @@
+{-|
+Module      : VeriFuzz.Context
+Description : Context types used in the generation.
+Copyright   : (c) 2019, Yann Herklotz
+License     : GPL-3
+Maintainer  : yann [at] yannherklotz [dot] com
+Stability   : experimental
+Portability : POSIX
+
+Context types used in the generation of the Verilog.
+-}
+
+{-# LANGUAGE TemplateHaskell #-}
+
+module VeriFuzz.Context
+    ( -- * Context types
+      Context (..)
+    , variables
+    , parameters
+    , modules
+    , nameCounter
+    , stmntDepth
+    , modDepth
+    , determinism
+    , VarContext (..)
+    , ParamContext (..)
+    , ModuleContext (..)
+    , PortContext (..)
+    , portContPort
+    , portContND
+    )
+where
+
+import           Control.Lens      (makeLenses)
+import           Data.HashMap.Lazy (HashMap)
+import           VeriFuzz.Verilog
+
+data PortContext = PortContext { _portContPort :: !Port
+                               , _portContND   :: !Bool
+                               }
+
+$(makeLenses ''PortContext)
+
+type VarContext = HashMap Identifier PortContext
+
+type ParamContext = HashMap Identifier Parameter
+
+type ModuleContext = HashMap Identifier ModDecl
+
+data Context = Context { _variables   :: VarContext
+                       , _parameters  :: ParamContext
+                       , _modules     :: ModuleContext
+                       , _nameCounter :: {-# UNPACK #-} !Int
+                       , _stmntDepth  :: {-# UNPACK #-} !Int
+                       , _modDepth    :: {-# UNPACK #-} !Int
+                       , _determinism :: !Bool
+                       }
+
+$(makeLenses ''Context)
diff --git a/src/VeriFuzz/Verilog/Eval.hs b/src/VeriFuzz/Eval.hs
index c802267..f231772 100644
--- a/src/VeriFuzz/Verilog/Eval.hs
+++ b/src/VeriFuzz/Eval.hs
@@ -1,5 +1,5 @@
 {-|
-Module      : VeriFuzz.Verilog.Eval
+Module      : VeriFuzz.Eval
 Description : Evaluation of Verilog expressions and statements.
 Copyright   : (c) 2019, Yann Herklotz Grave
 License     : GPL-3
@@ -10,7 +10,7 @@ Portability : POSIX
 Evaluation of Verilog expressions and statements.
 -}
 
-module VeriFuzz.Verilog.Eval
+module VeriFuzz.Eval
     ( evaluateConst
     , resize
     )
@@ -19,12 +19,12 @@ where
 import           Data.Bits
 import           Data.Foldable           (fold)
 import           Data.Functor.Foldable   hiding (fold)
+import qualified Data.HashMap.Lazy       as Map (lookup)
 import           Data.Maybe              (listToMaybe)
+import           VeriFuzz.Context
 import           VeriFuzz.Verilog.AST
 import           VeriFuzz.Verilog.BitVec
 
-type Bindings = [Parameter]
-
 paramIdent_ :: Parameter -> Identifier
 paramIdent_ (Parameter i _) = i
 
@@ -88,13 +88,11 @@ applyBinary BinLSR     = toInt shiftR
 applyBinary BinASL     = toInt shiftL
 applyBinary BinASR     = toInt shiftR
 
--- | Evaluates a 'ConstExpr' using a context of 'Bindings' as input.
-evaluateConst :: Bindings -> ConstExprF BitVec -> BitVec
+-- | Evaluates a 'ConstExpr' using a context of 'ParamContext' as input.
+evaluateConst :: ParamContext -> ConstExprF BitVec -> BitVec
 evaluateConst _ (ConstNumF b) = b
 evaluateConst p (ParamIdF i) =
-    cata (evaluateConst p) . maybe 0 paramValue_ . listToMaybe $ filter
-        ((== i) . paramIdent_)
-        p
+    cata (evaluateConst p) . maybe 0 paramValue_ $ Map.lookup i p
 evaluateConst _ (ConstConcatF c       ) = fold c
 evaluateConst _ (ConstUnOpF unop c    ) = applyUnary unop c
 evaluateConst _ (ConstBinOpF a binop b) = applyBinary binop a b
diff --git a/src/VeriFuzz/Generate.hs b/src/VeriFuzz/Generate.hs
index a82f56b..ea81c4c 100644
--- a/src/VeriFuzz/Generate.hs
+++ b/src/VeriFuzz/Generate.hs
@@ -68,31 +68,23 @@ import           Control.Monad.Trans.Reader       hiding (local)
 import           Control.Monad.Trans.State.Strict
 import           Data.Foldable                    (fold)
 import           Data.Functor.Foldable            (cata)
+import           Data.HashMap.Lazy                (HashMap, (!))
+import qualified Data.HashMap.Lazy                as Map
 import           Data.List                        (foldl', partition)
 import qualified Data.Text                        as T
-import           Hedgehog                         (Gen)
+import           Hedgehog                         (Gen, MonadGen)
 import qualified Hedgehog.Gen                     as Hog
 import qualified Hedgehog.Range                   as Hog
 import           VeriFuzz.Config
+import           VeriFuzz.Context
+import           VeriFuzz.Eval
 import           VeriFuzz.Internal
 import           VeriFuzz.Verilog.AST
 import           VeriFuzz.Verilog.BitVec
-import           VeriFuzz.Verilog.Eval
 import           VeriFuzz.Verilog.Internal
 import           VeriFuzz.Verilog.Mutate
 
-data Context = Context { _variables   :: [Port]
-                       , _parameters  :: [Parameter]
-                       , _modules     :: [ModDecl]
-                       , _nameCounter :: {-# UNPACK #-} !Int
-                       , _stmntDepth  :: {-# UNPACK #-} !Int
-                       , _modDepth    :: {-# UNPACK #-} !Int
-                       , _determinism :: !Bool
-                       }
-
-makeLenses ''Context
-
-type StateGen =  StateT Context (ReaderT Config Gen)
+type StateGen = StateT Context (ReaderT Config Gen)
 
 toId :: Int -> Identifier
 toId = Identifier . ("w" <>) . T.pack . show
@@ -105,9 +97,14 @@ toPort ident = do
 sumSize :: [Port] -> Range
 sumSize ps = sum $ ps ^.. traverse . portSize
 
+toContext :: [Port] -> VarContext
+toContext ps = Map.fromList $ chg <$> ps
+    where
+        chg p@(Port _ _ _ i) = (i, PortContext p False)
+
 random :: [Port] -> (Expr -> ContAssign) -> Gen ModItem
 random ctx fun = do
-    expr <- Hog.sized (exprWithContext (ProbExpr 1 1 0 1 1 1 1 0 1 1) [] ctx)
+    expr <- Hog.sized (exprWithContext (ProbExpr 1 1 0 1 1 1 1 0 1 1) mempty (toContext ctx))
     return . ModCA $ fun expr
 
 --randomAssigns :: [Identifier] -> [Gen ModItem]
@@ -153,6 +150,23 @@ askProbability = lift $ asks probability
 gen :: Gen a -> StateGen a
 gen = lift . lift
 
+chooseMap :: MonadGen m => HashMap a b -> m b
+chooseMap = Hog.element . Map.elems
+
+chooseMapKey :: MonadGen m => HashMap a b -> m a
+chooseMapKey = Hog.element . Map.keys
+
+chooseMapBoth :: MonadGen m => HashMap a b -> m (a, b)
+chooseMapBoth = Hog.element . Map.toList
+
+choosePort :: MonadGen m => HashMap a PortContext -> m Port
+choosePort = fmap extract . chooseMap
+    where
+        extract = view portContPort
+
+mapToPorts :: HashMap a PortContext -> [Port]
+mapToPorts m = Map.elems m ^.. traverse . portContPort
+
 -- | Generates a random large number, which can also be negative.
 largeNum :: Gen Int
 largeNum = Hog.int $ Hog.linear (-100) 100
@@ -221,18 +235,18 @@ unOp = Hog.element
     ]
 
 -- | Generate a random 'ConstExpr' by using the current context of 'Parameter'.
-constExprWithContext :: [Parameter] -> ProbExpr -> Hog.Size -> Gen ConstExpr
+constExprWithContext :: ParamContext -> ProbExpr -> Hog.Size -> Gen ConstExpr
 constExprWithContext ps prob size
     | size == 0 = Hog.frequency
         [ (prob ^. probExprNum, ConstNum <$> genBitVec)
-        , ( if null ps then 0 else prob ^. probExprId
-          , ParamId . view paramIdent <$> Hog.element ps
+        , ( if Map.null ps then 0 else prob ^. probExprId
+          , ParamId . view paramIdent <$> chooseMap ps
           )
         ]
     | size > 0 = Hog.frequency
         [ (prob ^. probExprNum, ConstNum <$> genBitVec)
-        , ( if null ps then 0 else prob ^. probExprId
-          , ParamId . view paramIdent <$> Hog.element ps
+        , ( if Map.null ps then 0 else prob ^. probExprId
+          , ParamId . view paramIdent <$> chooseMap ps
           )
         , (prob ^. probExprUnOp, ConstUnOp <$> unOp <*> subexpr 2)
         , ( prob ^. probExprBinOp
@@ -271,9 +285,9 @@ exprRecList prob subexpr =
 
 -- | Select a random port from a list of ports and generate a safe bit selection
 -- for that port.
-rangeSelect :: [Parameter] -> [Port] -> Gen Expr
+rangeSelect :: ParamContext -> VarContext -> Gen Expr
 rangeSelect ps ports = do
-    p <- Hog.element ports
+    p <- choosePort ports
     let s = calcRange ps (Just 32) $ _portSize p
     msb <- Hog.int (Hog.constantFrom (s `div` 2) 0 (s - 1))
     lsb <- Hog.int (Hog.constantFrom (msb `div` 2) 0 msb)
@@ -282,24 +296,22 @@ rangeSelect ps ports = do
 
 -- | Generate a random expression from the 'Context' with a guarantee that it
 -- will terminate using the list of safe 'Expr'.
-exprWithContext :: ProbExpr -> [Parameter] -> [Port] -> Hog.Size -> Gen Expr
-exprWithContext prob ps [] n | n == 0 = Hog.frequency $ exprSafeList prob
-                             | n > 0 = Hog.frequency $ exprRecList prob subexpr
-                             | otherwise = exprWithContext prob ps [] 0
-    where subexpr y = exprWithContext prob ps [] $ n `div` y
+exprWithContext :: ProbExpr -> ParamContext -> VarContext -> Hog.Size -> Gen Expr
 exprWithContext prob ps l n
     | n == 0
     = Hog.frequency
-        $ (prob ^. probExprId, Id . fromPort <$> Hog.element l)
-        : exprSafeList prob
+        . lists [(prob ^. probExprId, Id . fromPort <$> choosePort l)]
+        $ exprSafeList prob
     | n > 0
     = Hog.frequency
-        $ (prob ^. probExprId         , Id . fromPort <$> Hog.element l)
-        : (prob ^. probExprRangeSelect, rangeSelect ps l)
-        : exprRecList prob subexpr
+        . lists [ (prob ^. probExprId, Id . fromPort <$> choosePort l)
+                , (prob ^. probExprRangeSelect, rangeSelect ps l) ]
+        $ exprRecList prob subexpr
     | otherwise
     = exprWithContext prob ps l 0
-    where subexpr y = exprWithContext prob ps l $ n `div` y
+    where
+        subexpr y = exprWithContext prob ps l $ n `div` y
+        lists extra l = if Map.null ps then l else extra <> l
 
 -- | Runs a 'StateGen' for a random number of times, limited by an 'Int' that is
 -- passed to it.
@@ -317,11 +329,10 @@ makeIdentifier prefix = do
     nameCounter += 1
     return ident
 
-getPort' :: PortType -> Identifier -> [Port] -> StateGen Port
-getPort' pt i c = case filter portId c of
-    x : _ -> return x
-    []    -> newPort i pt
-    where portId (Port pt' _ _ i') = i == i' && pt == pt'
+getPort' :: PortType -> Identifier -> VarContext -> StateGen Port
+getPort' pt i c = case Map.lookup i c of
+    Just x  -> return $ view portContPort x
+    Nothing -> newPort i pt
 
 -- | Makes a new 'Identifier' and then checks if the 'Port' already exists, if
 -- it does the existant 'Port' is returned, otherwise a new port is created with
@@ -339,7 +350,7 @@ nextPort pt = do
 newPort :: Identifier -> PortType -> StateGen Port
 newPort ident pt = do
     p <- gen $ Port pt <$> Hog.bool <*> range <*> pure ident
-    variables %= (p :)
+    variables %= (Map.insert (view portName p) $ PortContext p False)
     return p
 
 -- | Generates an expression from variables that are currently in scope.
@@ -350,7 +361,7 @@ scopedExpr = do
     gen
         . Hog.sized
         . exprWithContext (_probExpr prob) (_parameters context)
-        $ _variables context
+       $ _variables context
 
 -- | Generates a random continuous assignment and assigns it to a random wire
 -- that is created.
@@ -424,12 +435,12 @@ alwaysSeq = Always . EventCtrl (EPosEdge "clk") . Just <$> seqBlock
 -- | Should resize a port that connects to a module port if the latter is
 -- larger.  This should not cause any problems if the same net is used as input
 -- multiple times, and is resized multiple times, as it should only get larger.
-resizePort :: [Parameter] -> Identifier -> Range -> [Port] -> [Port]
-resizePort ps i ra = foldl' func []
+resizePort :: ParamContext -> Identifier -> Range -> VarContext -> VarContext
+resizePort ps i ra map = Map.adjust func i map
     where
-        func l p@(Port t _ ri i')
-            | i' == i && calc ri < calc ra = (p & portSize .~ ra) : l
-            | otherwise = p : l
+        func p@(PortContext (Port t _ ri i') _)
+            | i' == i && calc ri < calc ra = (p & portContPort . portSize .~ ra)
+            | otherwise = p
         calc = calcRange ps $ Just 64
 
 -- | Instantiate a module, where the outputs are new nets that are created, and
@@ -443,7 +454,7 @@ instantiate :: ModDecl -> StateGen ModItem
 instantiate (ModDecl i outP inP _ _) = do
     context <- get
     outs    <- replicateM (length outP) (nextPort Wire)
-    ins <- take (length inpFixed) <$> Hog.shuffle (context ^. variables)
+    ins <- take (length inpFixed) <$> Hog.shuffle (mapToPorts $ _variables context)
     mapM_ (uncurry process) . zip (ins ^.. traverse . portName) $ inpFixed ^.. traverse . portSize
     ident <- makeIdentifier "modinst"
     vs <- view variables <$> get
@@ -491,9 +502,9 @@ modInst = do
             let currMods = context ^. modules
             let params   = context ^. parameters
             let vars     = context ^. variables
-            modules .= []
-            variables .= []
-            parameters .= []
+            modules .= mempty
+            variables .= mempty
+            parameters .= mempty
             modDepth -= 1
             chosenMod <- moduleDef Nothing
             ncont     <- get
@@ -501,9 +512,9 @@ modInst = do
             modDepth += 1
             parameters .= params
             variables .= vars
-            modules .= chosenMod : currMods <> genMods
+            modules .= Map.insert (_modId chosenMod) chosenMod (currMods <> genMods)
             instantiate chosenMod
-        else Hog.element (context ^. modules) >>= instantiate
+        else chooseMap (context ^. modules) >>= instantiate
 
 -- | Generate a random module item.
 modItem :: StateGen ModItem
@@ -544,16 +555,16 @@ parameter = do
     ident <- makeIdentifier "param"
     cexpr <- constExpr
     let param = Parameter ident cexpr
-    parameters %= (param :)
+    parameters %= Map.insert (_paramIdent param) param
     return param
 
 -- | Evaluate a range to an integer, and cast it back to a range.
-evalRange :: [Parameter] -> Int -> Range -> Range
+evalRange :: ParamContext -> Int -> Range -> Range
 evalRange ps n (Range l r) = Range (eval l) (eval r)
     where eval = ConstNum . cata (evaluateConst ps) . resize n
 
 -- | Calculate a range to an int by maybe resizing the ranges to a value.
-calcRange :: [Parameter] -> Maybe Int -> Range -> Int
+calcRange :: ParamContext -> Maybe Int -> Range -> Int
 calcRange ps i (Range l r) = eval l - eval r + 1
   where
     eval a = fromIntegral . cata (evaluateConst ps) $ maybe a (`resize` a) i
@@ -575,7 +586,7 @@ moduleDef top = do
     ps       <- Hog.list (Hog.linear 0 10) parameter
     context  <- get
     config   <- lift ask
-    let (newPorts, local) = partition (`identElem` portList) $ _variables context
+    let (newPorts, local) = partition (`identElem` portList) $ mapToPorts (_variables context)
     let
          size =
             evalRange (_parameters context) 32
@@ -600,10 +611,11 @@ procedural top config = do
     (mainMod, st) <- Hog.resize num $ runReaderT
         (runStateT (moduleDef (Just $ Identifier top)) context)
         config
-    return . Verilog $ mainMod : st ^. modules
+    return . Verilog $ mainMod : Map.elems (st ^. modules)
   where
     context =
-        Context [] [] [] 0 (confProp propStmntDepth) (confProp propModDepth) True
+        Context mempty mempty mempty 0
+        (confProp propStmntDepth) (confProp propModDepth) True
     num = fromIntegral $ confProp propSize
     confProp i = config ^. configProperty . i
 
diff --git a/src/VeriFuzz/Verilog.hs b/src/VeriFuzz/Verilog.hs
index 4b5029c..6605e23 100644
--- a/src/VeriFuzz/Verilog.hs
+++ b/src/VeriFuzz/Verilog.hs
@@ -61,6 +61,13 @@ module VeriFuzz.Verilog
     , ContAssign(..)
     , contAssignNetLVal
     , contAssignExpr
+    -- ** Parameters
+    , Parameter(..)
+    , paramIdent
+    , paramValue
+    , LocalParam(..)
+    , localParamIdent
+    , localParamValue
     -- * Statment
     , Statement(..)
     , statDelay
diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs
index a85c365..23d773d 100644
--- a/src/VeriFuzz/Verilog/AST.hs
+++ b/src/VeriFuzz/Verilog/AST.hs
@@ -145,6 +145,7 @@ import           Control.Lens             hiding ((<|))
 import           Data.Data
 import           Data.Data.Lens
 import           Data.Functor.Foldable.TH (makeBaseFunctor)
+import           Data.Hashable            (Hashable)
 import           Data.List.NonEmpty       (NonEmpty (..), (<|))
 import           Data.String              (IsString, fromString)
 import           Data.Text                (Text, pack)
@@ -156,7 +157,7 @@ import           VeriFuzz.Verilog.BitVec
 -- 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, Show, Ord, Data, Generic, NFData)
+                   deriving (Eq, Show, Ord, Data, Generic, NFData, Hashable)
 
 instance IsString Identifier where
     fromString = Identifier . pack
diff --git a/verifuzz.cabal b/verifuzz.cabal
index 6d15d45..f9a717a 100644
--- a/verifuzz.cabal
+++ b/verifuzz.cabal
@@ -34,6 +34,8 @@ library
                  , VeriFuzz.Circuit.Internal
                  , VeriFuzz.Circuit.Random
                  , VeriFuzz.Config
+                 , VeriFuzz.Context
+                 , VeriFuzz.Eval
                  , VeriFuzz.Fuzz
                  , VeriFuzz.Generate
                  , VeriFuzz.Internal
@@ -53,7 +55,6 @@ library
                  , VeriFuzz.Verilog.AST
                  , VeriFuzz.Verilog.BitVec
                  , VeriFuzz.Verilog.CodeGen
-                 , VeriFuzz.Verilog.Eval
                  , VeriFuzz.Verilog.Internal
                  , VeriFuzz.Verilog.Lex
                  , VeriFuzz.Verilog.Mutate
@@ -97,6 +98,7 @@ library
                , statistics >=0.14.0.2 && <0.16
                , vector >=0.12.0.1 && <0.13
                , unordered-containers >=0.2.10 && <0.3
+               , hashable >=1.2.7 && <1.4
   default-extensions: OverloadedStrings
 
 executable verifuzz