Add random bit selection for wires

This has not been tested fully yet

6 files changed, 89 insertions, 44 deletions

diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs
index 77d62a4..8a3d422 100644
--- a/src/VeriFuzz/Config.hs
+++ b/src/VeriFuzz/Config.hs
@@ -44,6 +44,7 @@ module VeriFuzz.Config
     , probEventList
     , probExprNum
     , probExprId
+    , probExprRangeSelect
     , probExprUnOp
     , probExprBinOp
     , probExprCond
@@ -160,30 +161,32 @@ import qualified Toml
 -- <BLANKLINE>
 
 -- | Probability of different expressions nodes.
-data ProbExpr = ProbExpr { _probExprNum      :: {-# UNPACK #-} !Int
+data ProbExpr = ProbExpr { _probExprNum         :: {-# UNPACK #-} !Int
                          -- ^ Probability of generation a number like
                          -- @4'ha@. This should never be set to 0, as it is used
                          -- as a fallback in case there are no viable
                          -- identifiers, such as none being in scope.
-                         , _probExprId       :: {-# UNPACK #-} !Int
+                         , _probExprId          :: {-# UNPACK #-} !Int
                          -- ^ Probability of generating an identifier that is in
                          -- scope and of the right type.
-                         , _probExprUnOp     :: {-# UNPACK #-} !Int
+                         , _probExprRangeSelect :: {-# UNPACK #-} !Int
+                         -- ^ Probability of generating a range selection from a port.
+                         , _probExprUnOp        :: {-# UNPACK #-} !Int
                          -- ^ Probability of generating a unary operator.
-                         , _probExprBinOp    :: {-# UNPACK #-} !Int
+                         , _probExprBinOp       :: {-# UNPACK #-} !Int
                          -- ^ Probability of generation a binary operator.
-                         , _probExprCond     :: {-# UNPACK #-} !Int
+                         , _probExprCond        :: {-# UNPACK #-} !Int
                          -- ^ probability of generating a conditional ternary
                          -- operator.
-                         , _probExprConcat   :: {-# UNPACK #-} !Int
+                         , _probExprConcat      :: {-# UNPACK #-} !Int
                          -- ^ Probability of generating a concatenation.
-                         , _probExprStr      :: {-# UNPACK #-} !Int
+                         , _probExprStr         :: {-# UNPACK #-} !Int
                          -- ^ Probability of generating a string. This is not
                          -- fully supported therefore currently cannot be set.
-                         , _probExprSigned   :: {-# UNPACK #-} !Int
+                         , _probExprSigned      :: {-# UNPACK #-} !Int
                          -- ^ Probability of generating a signed function
                          -- @$signed(...)@.
-                         , _probExprUnsigned :: {-# UNPACK #-} !Int
+                         , _probExprUnsigned    :: {-# UNPACK #-} !Int
                          -- ^ Probability of generating an unsigned function
                          -- @$unsigned(...)@.
                          }
@@ -265,7 +268,7 @@ defaultConfig = Config
   where
     defModItem = ProbModItem 5 1 1
     defStmnt   = ProbStatement 0 15 1 1
-    defExpr    = ProbExpr 1 1 1 1 1 1 0 1 1
+    defExpr    = ProbExpr 1 1 1 1 1 1 1 0 1 1
     defEvent   = ProbEventList 1 1 1
 
 twoKey :: Toml.Piece -> Toml.Piece -> Toml.Key
@@ -281,6 +284,8 @@ exprCodec =
         .=  _probExprNum
         <*> defaultValue (defProb probExprId) (intE "variable")
         .=  _probExprId
+        <*> defaultValue (defProb probExprRangeSelect) (intE "rangeselect")
+        .= _probExprRangeSelect
         <*> defaultValue (defProb probExprUnOp) (intE "unary")
         .=  _probExprUnOp
         <*> defaultValue (defProb probExprBinOp) (intE "binary")
diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs
index f122214..ea7ef1b 100644
--- a/src/VeriFuzz/Verilog/AST.hs
+++ b/src/VeriFuzz/Verilog/AST.hs
@@ -209,6 +209,8 @@ data UnaryOperator = UnPlus    -- ^ @+@
 data Expr = Number {-# UNPACK #-} !BitVec
           -- ^ Number implementation containing the size and the value itself
           | Id {-# UNPACK #-} !Identifier
+          | VecSelect {-# UNPACK #-} !Identifier !Expr
+          | RangeSelect {-# UNPACK #-} !Identifier !Range
           -- ^ Symbols
           | Concat ![Expr]
           -- ^ Bit-wise concatenation of expressions represented by braces.
diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs
index 09d6d6f..2cd2b13 100644
--- a/src/VeriFuzz/Verilog/CodeGen.hs
+++ b/src/VeriFuzz/Verilog/CodeGen.hs
@@ -138,6 +138,8 @@ expr (BinOp eRhs bin eLhs) =
     "(" <> expr eRhs <> binaryOp bin <> expr eLhs <> ")"
 expr (Number b             ) = showNum b
 expr (Id     i             ) = getIdentifier i
+expr (VecSelect i e) = getIdentifier i <> "[" <> genExpr e <> "]"
+expr (RangeSelect i r) = getIdentifier i <> range r
 expr (Concat c             ) = "{" <> comma (expr <$> c) <> "}"
 expr (UnOp u e             ) = "(" <> unaryOp u <> expr e <> ")"
 expr (Cond l t f) = "(" <> expr l <> " ? " <> expr t <> " : " <> expr f <> ")"
diff --git a/src/VeriFuzz/Verilog/Eval.hs b/src/VeriFuzz/Verilog/Eval.hs
index 7a3126e..5dbee8c 100644
--- a/src/VeriFuzz/Verilog/Eval.hs
+++ b/src/VeriFuzz/Verilog/Eval.hs
@@ -12,13 +12,14 @@ Evaluation of Verilog expressions and statements.
 
 module VeriFuzz.Verilog.Eval
     ( evaluateConst
+    , resize
     )
 where
 
 import           Data.Bits
 import           Data.Foldable           (fold)
-import           Data.Functor.Foldable   (cata)
-import           Data.Maybe              (fromMaybe, listToMaybe)
+import           Data.Functor.Foldable   hiding (fold)
+import           Data.Maybe              (listToMaybe)
 import           VeriFuzz.Verilog.AST
 import           VeriFuzz.Verilog.BitVec
 
@@ -92,8 +93,7 @@ evaluateConst :: Bindings -> ConstExprF BitVec -> BitVec
 evaluateConst _ (ConstNumF b) = b
 evaluateConst p (ParamIdF i) =
     cata (evaluateConst p)
-        . fromMaybe 0
-        . fmap paramValue_
+        . maybe 0 paramValue_
         . listToMaybe
         $ filter ((== i) . paramIdent_) p
 evaluateConst _ (ConstConcatF c       ) = fold c
@@ -101,3 +101,20 @@ evaluateConst _ (ConstUnOpF unop c    ) = applyUnary unop c
 evaluateConst _ (ConstBinOpF a binop b) = applyBinary binop a b
 evaluateConst _ (ConstCondF  a b     c) = if a > 0 then b else c
 evaluateConst _ (ConstStrF _          ) = 0
+
+-- | Apply a function to all the bitvectors. Would be fixed by having a
+-- 'Functor' instance for a polymorphic 'ConstExpr'.
+applyBitVec :: (BitVec -> BitVec) -> ConstExpr -> ConstExpr
+applyBitVec f (ConstNum b)       = ConstNum $ f b
+applyBitVec f (ConstConcat c)    = ConstConcat $ fmap (applyBitVec f) c
+applyBitVec f (ConstUnOp unop c) = ConstUnOp unop $ applyBitVec f c
+applyBitVec f (ConstBinOp a binop b) = ConstBinOp (applyBitVec f a) binop (applyBitVec f b)
+applyBitVec f (ConstCond a b c) = ConstCond (abv a) (abv b) (abv c) where abv = applyBitVec f
+applyBitVec _ a = a
+
+-- | This probably could be implemented using some recursion scheme in the
+-- future. It would also be fixed by having a polymorphic expression type.
+resize :: Int -> ConstExpr -> ConstExpr
+resize n = applyBitVec (resize' n)
+    where
+        resize' n' (BitVec _ a) = BitVec n' a
diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs
index 592b4e7..bc5d329 100644
--- a/src/VeriFuzz/Verilog/Gen.hs
+++ b/src/VeriFuzz/Verilog/Gen.hs
@@ -28,6 +28,7 @@ import           Control.Monad.Trans.Class        (lift)
 import           Control.Monad.Trans.Reader       hiding (local)
 import           Control.Monad.Trans.State.Strict
 import           Data.Foldable                    (fold)
+import           Data.Functor.Foldable            (cata)
 import           Data.List.NonEmpty               (NonEmpty (..), toList)
 import qualified Data.Text                        as T
 import           Hedgehog                         (Gen)
@@ -37,6 +38,7 @@ import           VeriFuzz.Config
 import           VeriFuzz.Internal
 import           VeriFuzz.Verilog.AST
 import           VeriFuzz.Verilog.BitVec
+import           VeriFuzz.Verilog.Eval
 import           VeriFuzz.Verilog.Internal
 import           VeriFuzz.Verilog.Mutate
 
@@ -63,22 +65,22 @@ toPort ident = do
 sumSize :: [Port] -> Range
 sumSize ps = sum $ ps ^.. traverse . portSize
 
-random :: [Identifier] -> (Expr -> ContAssign) -> Gen ModItem
+random :: [Port] -> (Expr -> ContAssign) -> Gen ModItem
 random ctx fun = do
-    expr <- Hog.sized (exprWithContext (ProbExpr 1 1 1 1 1 1 0 1 1) ctx)
+    expr <- Hog.sized (exprWithContext (ProbExpr 1 1 0 1 1 1 1 0 1 1) [] ctx)
     return . ModCA $ fun expr
 
 --randomAssigns :: [Identifier] -> [Gen ModItem]
 --randomAssigns ids = random ids . ContAssign <$> ids
 
-randomOrdAssigns :: [Identifier] -> [Identifier] -> [Gen ModItem]
+randomOrdAssigns :: [Port] -> [Port] -> [Gen ModItem]
 randomOrdAssigns inp ids = snd $ foldr generate (inp, []) ids
-    where generate cid (i, o) = (cid : i, random i (ContAssign cid) : o)
+    where generate cid (i, o) = (cid : i, random i (ContAssign (_portName cid)) : o)
 
 randomMod :: Int -> Int -> Gen ModDecl
 randomMod inps total = do
-    x     <- sequence $ randomOrdAssigns start end
     ident <- sequence $ toPort <$> ids
+    x     <- sequence $ randomOrdAssigns (start ident) (end ident)
     let inputs_ = take inps ident
     let other   = drop inps ident
     let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids
@@ -90,8 +92,8 @@ randomMod inps total = do
                                         []
   where
     ids   = toId <$> [1 .. total]
-    end   = drop inps ids
-    start = take inps ids
+    end   = drop inps
+    start = take inps
 
 gen :: Gen a -> StateGen a
 gen = lift . lift
@@ -184,7 +186,7 @@ constExprWithContext ps prob size
     where subexpr y = constExprWithContext ps prob $ size `div` y
 
 exprSafeList :: ProbExpr -> [(Int, Gen Expr)]
-exprSafeList prob = [(prob ^. probExprNum, Number <$> genBitVec)]
+exprSafeList prob = [ (prob ^. probExprNum, Number <$> genBitVec)]
 
 exprRecList :: ProbExpr -> (Hog.Size -> Gen Expr) -> [(Int, Gen Expr)]
 exprRecList prob subexpr =
@@ -198,23 +200,32 @@ exprRecList prob subexpr =
     , (prob ^. probExprUnsigned, Appl <$> pure "$unsigned" <*> subexpr 2)
     ]
 
-exprWithContext :: ProbExpr -> [Identifier] -> Hog.Size -> Gen Expr
-exprWithContext prob [] n | n == 0    = Hog.frequency $ exprSafeList prob
-                          | n > 0     = Hog.frequency $ exprRecList prob subexpr
-                          | otherwise = exprWithContext prob [] 0
-    where subexpr y = exprWithContext prob [] $ n `div` y
-exprWithContext prob l n
+rangeSelect :: [Parameter] -> [Port] -> Gen Expr
+rangeSelect ps ports = do
+    p <- Hog.element 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)
+    return . RangeSelect (_portName p) $ Range (fromIntegral msb) (fromIntegral lsb)
+
+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 prob ps l n
     | n == 0
     = Hog.frequency
-        $ (prob ^. probExprId, Id <$> Hog.element l)
+        $ (prob ^. probExprId, Id . fromPort <$> Hog.element l)
         : exprSafeList prob
     | n > 0
     = Hog.frequency
-        $ (prob ^. probExprId, Id <$> Hog.element l)
+        $ (prob ^. probExprId, Id . fromPort <$> Hog.element l)
+        : (prob ^. probExprRangeSelect, rangeSelect ps l)
         : exprRecList prob subexpr
     | otherwise
-    = exprWithContext prob l 0
-    where subexpr y = exprWithContext prob l $ n `div` y
+    = exprWithContext prob ps l 0
+    where subexpr y = exprWithContext prob ps l $ n `div` y
 
 some :: StateGen a -> StateGen [a]
 some f = do
@@ -244,11 +255,7 @@ scopedExpr :: StateGen Expr
 scopedExpr = do
     context <- get
     prob    <- askProbability
-    gen . Hog.sized . exprWithContext (prob ^. probExpr) $ vars context
-  where
-    vars cont =
-        (cont ^.. variables . traverse . portName)
-            <> (cont ^.. parameters . traverse . paramIdent)
+    gen . Hog.sized . exprWithContext (_probExpr prob) (_parameters context) $ _variables context
 
 contAssign :: StateGen ContAssign
 contAssign = do
@@ -337,11 +344,10 @@ eventList = do
         , ( defProb probEventListVar
           , case context ^. variables of
               []     -> return EAll
-              x : xs -> Hog.sized . recEventList $ toIds <$> (x :| xs)
+              x : xs -> Hog.sized . recEventList $ fromPort <$> (x :| xs)
           )
         , (defProb probEventListClk, return $ EPosEdge "clk")
         ]
-    where toIds (Port _ _ _ i) = i
 
 always :: StateGen ModItem
 always = do
@@ -442,6 +448,15 @@ parameter = do
     parameters %= (param :)
     return param
 
+-- | Evaluate a range to an integer, and cast it back to a range.
+evalRange :: [Parameter] -> Int -> Range -> Range
+evalRange ps n (Range l r) = Range (eval l) (eval r)
+    where eval = ConstNum . cata (evaluateConst ps) . resize n
+
+calcRange :: [Parameter] -> Maybe Int -> Range -> Int
+calcRange ps i (Range l r) = eval l - eval r + 1
+    where eval a = fromIntegral . cata (evaluateConst ps) $ maybe a (flip resize a) i
+
 -- | Generates a module definition randomly. It always has one output port which
 -- is set to @y@. The size of @y@ is the total combination of all the locally
 -- defined wires, so that it correctly reflects the internal state of the
@@ -451,15 +466,15 @@ moduleDef top = do
     name     <- moduleName top
     portList <- some $ newPort Wire
     mi       <- Hog.list (Hog.linear 4 100) modItem
+    ps <- many parameter
     context  <- get
-    let local = filter (`notElem` portList) $ context ^. variables
-    let size  = sum $ local ^.. traverse . portSize
+    let local = filter (`notElem` portList) $ _variables context
+    let size  = evalRange (_parameters context) 32 . sum $ local ^.. traverse . portSize
     let clock = Port Wire False 1 "clk"
     let yport = Port Wire False size "y"
     let comb  = combineAssigns_ yport local
-    declareMod local
-        .   ModDecl name [yport] (clock : portList) (mi <> [comb])
-        <$> many parameter
+    return . declareMod local
+        .   ModDecl name [yport] (clock : portList) (mi <> [comb]) $ ps
 
 -- | Procedural generation method for random Verilog. Uses internal 'Reader' and
 -- 'State' to keep track of the current Verilog code structure.
diff --git a/src/VeriFuzz/Verilog/Mutate.hs b/src/VeriFuzz/Verilog/Mutate.hs
index 39a136e..7b93633 100644
--- a/src/VeriFuzz/Verilog/Mutate.hs
+++ b/src/VeriFuzz/Verilog/Mutate.hs
@@ -33,6 +33,7 @@ module VeriFuzz.Verilog.Mutate
     , combineAssigns
     , combineAssigns_
     , declareMod
+    , fromPort
     )
 where
 
@@ -284,3 +285,6 @@ combineAssigns_ p ps =
         <$> ps
         ^.. traverse
         .   portName
+
+fromPort :: Port -> Identifier
+fromPort (Port _ _ _ i) = i