From c2ada55bccc73cb604b77270049f0cfcc7e92bb8 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 29 Jul 2019 15:47:22 +0200 Subject: Use HashMap for context --- src/VeriFuzz/Context.hs | 59 ++++++++++++++++++++ src/VeriFuzz/Eval.hs | 117 ++++++++++++++++++++++++++++++++++++++++ src/VeriFuzz/Generate.hs | 126 +++++++++++++++++++++++-------------------- src/VeriFuzz/Verilog.hs | 7 +++ src/VeriFuzz/Verilog/AST.hs | 3 +- src/VeriFuzz/Verilog/Eval.hs | 119 ---------------------------------------- verifuzz.cabal | 4 +- 7 files changed, 257 insertions(+), 178 deletions(-) create mode 100644 src/VeriFuzz/Context.hs create mode 100644 src/VeriFuzz/Eval.hs delete mode 100644 src/VeriFuzz/Verilog/Eval.hs 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/Eval.hs b/src/VeriFuzz/Eval.hs new file mode 100644 index 0000000..f231772 --- /dev/null +++ b/src/VeriFuzz/Eval.hs @@ -0,0 +1,117 @@ +{-| +Module : VeriFuzz.Eval +Description : Evaluation of Verilog expressions and statements. +Copyright : (c) 2019, Yann Herklotz Grave +License : GPL-3 +Maintainer : yann [at] yannherklotz [dot] com +Stability : experimental +Portability : POSIX + +Evaluation of Verilog expressions and statements. +-} + +module VeriFuzz.Eval + ( evaluateConst + , resize + ) +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 + +paramIdent_ :: Parameter -> Identifier +paramIdent_ (Parameter i _) = i + +paramValue_ :: Parameter -> ConstExpr +paramValue_ (Parameter _ v) = v + +applyUnary :: (Num a, FiniteBits a) => UnaryOperator -> a -> a +applyUnary UnPlus a = a +applyUnary UnMinus a = negate a +applyUnary UnLNot a | a == 0 = 0 + | otherwise = 1 +applyUnary UnNot a = complement a +applyUnary UnAnd a | finiteBitSize a == popCount a = 1 + | otherwise = 0 +applyUnary UnNand a | finiteBitSize a == popCount a = 0 + | otherwise = 1 +applyUnary UnOr a | popCount a == 0 = 0 + | otherwise = 1 +applyUnary UnNor a | popCount a == 0 = 1 + | otherwise = 0 +applyUnary UnXor a | popCount a `mod` 2 == 0 = 0 + | otherwise = 1 +applyUnary UnNxor a | popCount a `mod` 2 == 0 = 1 + | otherwise = 0 +applyUnary UnNxorInv a | popCount a `mod` 2 == 0 = 1 + | otherwise = 0 + +compXor :: Bits c => c -> c -> c +compXor a = complement . xor a + +toIntegral :: Num p => (t1 -> t2 -> Bool) -> t1 -> t2 -> p +toIntegral a b c = if a b c then 1 else 0 + +toInt :: (Integral a, Num t1) => (t2 -> t1 -> t3) -> t2 -> a -> t3 +toInt a b c = a b $ fromIntegral c + +applyBinary :: (Integral a, Bits a) => BinaryOperator -> a -> a -> a +applyBinary BinPlus = (+) +applyBinary BinMinus = (-) +applyBinary BinTimes = (*) +applyBinary BinDiv = quot +applyBinary BinMod = rem +applyBinary BinEq = toIntegral (==) +applyBinary BinNEq = toIntegral (/=) +applyBinary BinCEq = toIntegral (==) +applyBinary BinCNEq = toIntegral (/=) +applyBinary BinLAnd = undefined +applyBinary BinLOr = undefined +applyBinary BinLT = toIntegral (<) +applyBinary BinLEq = toIntegral (<=) +applyBinary BinGT = toIntegral (>) +applyBinary BinGEq = toIntegral (>=) +applyBinary BinAnd = (.&.) +applyBinary BinOr = (.|.) +applyBinary BinXor = xor +applyBinary BinXNor = compXor +applyBinary BinXNorInv = compXor +applyBinary BinPower = undefined +applyBinary BinLSL = toInt shiftL +applyBinary BinLSR = toInt shiftR +applyBinary BinASL = toInt shiftL +applyBinary BinASR = toInt shiftR + +-- | 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_ $ 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 +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/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/src/VeriFuzz/Verilog/Eval.hs b/src/VeriFuzz/Verilog/Eval.hs deleted file mode 100644 index c802267..0000000 --- a/src/VeriFuzz/Verilog/Eval.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-| -Module : VeriFuzz.Verilog.Eval -Description : Evaluation of Verilog expressions and statements. -Copyright : (c) 2019, Yann Herklotz Grave -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Evaluation of Verilog expressions and statements. --} - -module VeriFuzz.Verilog.Eval - ( evaluateConst - , resize - ) -where - -import Data.Bits -import Data.Foldable (fold) -import Data.Functor.Foldable hiding (fold) -import Data.Maybe (listToMaybe) -import VeriFuzz.Verilog.AST -import VeriFuzz.Verilog.BitVec - -type Bindings = [Parameter] - -paramIdent_ :: Parameter -> Identifier -paramIdent_ (Parameter i _) = i - -paramValue_ :: Parameter -> ConstExpr -paramValue_ (Parameter _ v) = v - -applyUnary :: (Num a, FiniteBits a) => UnaryOperator -> a -> a -applyUnary UnPlus a = a -applyUnary UnMinus a = negate a -applyUnary UnLNot a | a == 0 = 0 - | otherwise = 1 -applyUnary UnNot a = complement a -applyUnary UnAnd a | finiteBitSize a == popCount a = 1 - | otherwise = 0 -applyUnary UnNand a | finiteBitSize a == popCount a = 0 - | otherwise = 1 -applyUnary UnOr a | popCount a == 0 = 0 - | otherwise = 1 -applyUnary UnNor a | popCount a == 0 = 1 - | otherwise = 0 -applyUnary UnXor a | popCount a `mod` 2 == 0 = 0 - | otherwise = 1 -applyUnary UnNxor a | popCount a `mod` 2 == 0 = 1 - | otherwise = 0 -applyUnary UnNxorInv a | popCount a `mod` 2 == 0 = 1 - | otherwise = 0 - -compXor :: Bits c => c -> c -> c -compXor a = complement . xor a - -toIntegral :: Num p => (t1 -> t2 -> Bool) -> t1 -> t2 -> p -toIntegral a b c = if a b c then 1 else 0 - -toInt :: (Integral a, Num t1) => (t2 -> t1 -> t3) -> t2 -> a -> t3 -toInt a b c = a b $ fromIntegral c - -applyBinary :: (Integral a, Bits a) => BinaryOperator -> a -> a -> a -applyBinary BinPlus = (+) -applyBinary BinMinus = (-) -applyBinary BinTimes = (*) -applyBinary BinDiv = quot -applyBinary BinMod = rem -applyBinary BinEq = toIntegral (==) -applyBinary BinNEq = toIntegral (/=) -applyBinary BinCEq = toIntegral (==) -applyBinary BinCNEq = toIntegral (/=) -applyBinary BinLAnd = undefined -applyBinary BinLOr = undefined -applyBinary BinLT = toIntegral (<) -applyBinary BinLEq = toIntegral (<=) -applyBinary BinGT = toIntegral (>) -applyBinary BinGEq = toIntegral (>=) -applyBinary BinAnd = (.&.) -applyBinary BinOr = (.|.) -applyBinary BinXor = xor -applyBinary BinXNor = compXor -applyBinary BinXNorInv = compXor -applyBinary BinPower = undefined -applyBinary BinLSL = toInt shiftL -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 -evaluateConst _ (ConstNumF b) = b -evaluateConst p (ParamIdF i) = - cata (evaluateConst p) . maybe 0 paramValue_ . listToMaybe $ filter - ((== i) . paramIdent_) - p -evaluateConst _ (ConstConcatF c ) = fold c -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/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 -- cgit