diff options
Diffstat (limited to 'src/Verismith/Verilog/Mutate.hs')
-rw-r--r-- | src/Verismith/Verilog/Mutate.hs | 344 |
1 files changed, 179 insertions, 165 deletions
diff --git a/src/Verismith/Verilog/Mutate.hs b/src/Verismith/Verilog/Mutate.hs index 260d759..0855000 100644 --- a/src/Verismith/Verilog/Mutate.hs +++ b/src/Verismith/Verilog/Mutate.hs @@ -1,177 +1,185 @@ -{-| -Module : Verismith.Verilog.Mutate -Description : Functions to mutate the Verilog AST. -Copyright : (c) 2018-2019, Yann Herklotz -License : GPL-3 -Maintainer : yann [at] yannherklotz [dot] com -Stability : experimental -Portability : POSIX - -Functions to mutate the Verilog AST from "Verismith.Verilog.AST" to generate more -random patterns, such as nesting wires instead of creating new ones. --} - {-# LANGUAGE FlexibleInstances #-} +-- | +-- Module : Verismith.Verilog.Mutate +-- Description : Functions to mutate the Verilog AST. +-- Copyright : (c) 2018-2019, Yann Herklotz +-- License : GPL-3 +-- Maintainer : yann [at] yannherklotz [dot] com +-- Stability : experimental +-- Portability : POSIX +-- +-- Functions to mutate the Verilog AST from "Verismith.Verilog.AST" to generate more +-- random patterns, such as nesting wires instead of creating new ones. module Verismith.Verilog.Mutate - ( Mutate(..) - , inPort - , findAssign - , idTrans - , replace - , nestId - , nestSource - , nestUpTo - , allVars - , instantiateMod - , instantiateMod_ - , instantiateModSpec_ - , filterChar - , initMod - , makeIdFrom - , makeTop - , makeTopAssert - , simplify - , removeId - , combineAssigns - , combineAssigns_ - , declareMod - , fromPort - ) + ( Mutate (..), + inPort, + findAssign, + idTrans, + replace, + nestId, + nestSource, + nestUpTo, + allVars, + instantiateMod, + instantiateMod_, + instantiateModSpec_, + filterChar, + initMod, + makeIdFrom, + makeTop, + makeTopAssert, + simplify, + removeId, + combineAssigns, + combineAssigns_, + declareMod, + fromPort, + ) where -import Control.Lens -import Data.Foldable (fold) -import Data.Maybe (catMaybes, fromMaybe) -import Data.Text (Text) -import qualified Data.Text as T -import Verismith.Circuit.Internal -import Verismith.Internal -import Verismith.Verilog.AST -import Verismith.Verilog.BitVec -import Verismith.Verilog.CodeGen -import Verismith.Verilog.Internal +import Control.Lens +import Data.Foldable (fold) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import Verismith.Circuit.Internal +import Verismith.Internal +import Verismith.Verilog.AST +import Verismith.Verilog.BitVec +import Verismith.Verilog.CodeGen +import Verismith.Verilog.Internal class Mutate a where - mutExpr :: (Expr -> Expr) -> a -> a + mutExpr :: (Expr -> Expr) -> a -> a instance Mutate Identifier where - mutExpr _ = id + mutExpr _ = id instance Mutate Delay where - mutExpr _ = id + mutExpr _ = id instance Mutate Event where - mutExpr f (EExpr e) = EExpr $ f e - mutExpr _ a = a + mutExpr f (EExpr e) = EExpr $ f e + mutExpr _ a = a instance Mutate BinaryOperator where - mutExpr _ = id + mutExpr _ = id instance Mutate UnaryOperator where - mutExpr _ = id + mutExpr _ = id instance Mutate Expr where - mutExpr f = f + mutExpr f = f instance Mutate ConstExpr where - mutExpr _ = id + mutExpr _ = id instance Mutate Task where - mutExpr f (Task i e) = Task i $ fmap f e + mutExpr f (Task i e) = Task i $ fmap f e instance Mutate LVal where - mutExpr f (RegExpr a e) = RegExpr a $ f e - mutExpr _ a = a + mutExpr f (RegExpr a e) = RegExpr a $ f e + mutExpr _ a = a instance Mutate PortDir where - mutExpr _ = id + mutExpr _ = id instance Mutate PortType where - mutExpr _ = id + mutExpr _ = id instance Mutate Range where - mutExpr _ = id + mutExpr _ = id instance Mutate Port where - mutExpr _ = id + mutExpr _ = id instance Mutate ModConn where - mutExpr f (ModConn e) = ModConn $ f e - mutExpr f (ModConnNamed a e) = ModConnNamed a $ f e + mutExpr f (ModConn e) = ModConn $ f e + mutExpr f (ModConnNamed a e) = ModConnNamed a $ f e instance Mutate Assign where - mutExpr f (Assign a b c) = Assign a b $ f c + mutExpr f (Assign a b c) = Assign a b $ f c instance Mutate ContAssign where - mutExpr f (ContAssign a e) = ContAssign a $ f e + mutExpr f (ContAssign a e) = ContAssign a $ f e + +instance Mutate (CasePair ann) where + mutExpr f (CasePair e s) = CasePair (f e) $ mutExpr f s instance Mutate (Statement ann) where - mutExpr f (TimeCtrl d s) = TimeCtrl d $ mutExpr f <$> s - mutExpr f (EventCtrl e s) = EventCtrl e $ mutExpr f <$> s - mutExpr f (SeqBlock s) = SeqBlock $ mutExpr f <$> s - mutExpr f (BlockAssign a) = BlockAssign $ mutExpr f a - mutExpr f (NonBlockAssign a) = NonBlockAssign $ mutExpr f a - mutExpr f (TaskEnable a) = TaskEnable $ mutExpr f a - mutExpr f (SysTaskEnable a) = SysTaskEnable $ mutExpr f a - mutExpr f (CondStmnt a b c) = CondStmnt (f a) (mutExpr f <$> b) $ mutExpr f <$> c - mutExpr f (ForLoop a1 e a2 s) = ForLoop a1 e a2 $ mutExpr f s + mutExpr f (TimeCtrl d s) = TimeCtrl d $ mutExpr f <$> s + mutExpr f (EventCtrl e s) = EventCtrl e $ mutExpr f <$> s + mutExpr f (SeqBlock s) = SeqBlock $ mutExpr f <$> s + mutExpr f (BlockAssign a) = BlockAssign $ mutExpr f a + mutExpr f (NonBlockAssign a) = NonBlockAssign $ mutExpr f a + mutExpr f (TaskEnable a) = TaskEnable $ mutExpr f a + mutExpr f (SysTaskEnable a) = SysTaskEnable $ mutExpr f a + mutExpr f (CondStmnt a b c) = CondStmnt (f a) (mutExpr f <$> b) $ mutExpr f <$> c + mutExpr f (ForLoop a1 e a2 s) = ForLoop a1 e a2 $ mutExpr f s + mutExpr f (StmntAnn a s) = StmntAnn a $ mutExpr f s + mutExpr f (StmntCase t e cp cd) = StmntCase t (f e) (mutExpr f cp) $ mutExpr f cd instance Mutate Parameter where - mutExpr _ = id + mutExpr _ = id instance Mutate LocalParam where - mutExpr _ = id + mutExpr _ = id instance Mutate (ModItem ann) where - mutExpr f (ModCA (ContAssign a e)) = ModCA . ContAssign a $ f e - mutExpr f (ModInst a b conns) = ModInst a b $ mutExpr f conns - mutExpr f (Initial s) = Initial $ mutExpr f s - mutExpr f (Always s) = Always $ mutExpr f s - mutExpr _ d@Decl{} = d - mutExpr _ p@ParamDecl{} = p - mutExpr _ l@LocalParamDecl{} = l + mutExpr f (ModCA (ContAssign a e)) = ModCA . ContAssign a $ f e + mutExpr f (ModInst a b conns) = ModInst a b $ mutExpr f conns + mutExpr f (Initial s) = Initial $ mutExpr f s + mutExpr f (Always s) = Always $ mutExpr f s + mutExpr f (ModItemAnn a s) = ModItemAnn a $ mutExpr f s + mutExpr _ d@Decl {} = d + mutExpr _ p@ParamDecl {} = p + mutExpr _ l@LocalParamDecl {} = l instance Mutate (ModDecl ann) where - mutExpr f (ModDecl a b c d e) = ModDecl (mutExpr f a) (mutExpr f b) (mutExpr f c) (mutExpr f d) (mutExpr f e) + mutExpr f (ModDecl a b c d e) = + ModDecl (mutExpr f a) (mutExpr f b) (mutExpr f c) (mutExpr f d) (mutExpr f e) + mutExpr f (ModDeclAnn a m) = ModDeclAnn a $ mutExpr f m instance Mutate (Verilog ann) where - mutExpr f (Verilog a) = Verilog $ mutExpr f a + mutExpr f (Verilog a) = Verilog $ mutExpr f a instance Mutate (SourceInfo ann) where - mutExpr f (SourceInfo a b) = SourceInfo a $ mutExpr f b + mutExpr f (SourceInfo a b) = SourceInfo a $ mutExpr f b instance Mutate a => Mutate [a] where - mutExpr f a = mutExpr f <$> a + mutExpr f a = mutExpr f <$> a instance Mutate a => Mutate (Maybe a) where - mutExpr f a = mutExpr f <$> a + mutExpr f a = mutExpr f <$> a instance Mutate a => Mutate (GenVerilog a) where - mutExpr f (GenVerilog a) = GenVerilog $ mutExpr f a + mutExpr f (GenVerilog a) = GenVerilog $ mutExpr f a -- | Return if the 'Identifier' is in a '(ModDecl ann)'. inPort :: Identifier -> (ModDecl ann) -> Bool inPort i m = inInput where inInput = - any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts + any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts -- | Find the last assignment of a specific wire/reg to an expression, and -- returns that expression. findAssign :: Identifier -> [ModItem ann] -> Maybe Expr findAssign i items = safe last . catMaybes $ isAssign <$> items where - isAssign (ModCA (ContAssign val expr)) | val == i = Just expr - | otherwise = Nothing + isAssign (ModCA (ContAssign val expr)) + | val == i = Just expr + | otherwise = Nothing isAssign _ = Nothing -- | Transforms an expression by replacing an Identifier with an -- expression. This is used inside 'transformOf' and 'traverseExpr' to replace -- the 'Identifier' recursively. idTrans :: Identifier -> Expr -> Expr -> Expr -idTrans i expr (Id id') | id' == i = expr - | otherwise = Id id' +idTrans i expr (Id id') + | id' == i = expr + | otherwise = Id id' idTrans _ _ e = e -- | Replaces the identifier recursively in an expression. @@ -186,11 +194,11 @@ replace = (transform .) . idTrans -- expression. This would require a different approach though. nestId :: Identifier -> (ModDecl ann) -> (ModDecl ann) nestId i m - | not $ inPort i m - = let expr = fromMaybe def . findAssign i $ m ^. modItems - in m & get %~ replace i expr - | otherwise - = m + | not $ inPort i m = + let expr = fromMaybe def . findAssign i $ m ^. modItems + in m & get %~ replace i expr + | otherwise = + m where get = modItems . traverse . modContAssign . contAssignExpr def = Id i @@ -202,12 +210,12 @@ nestSource i src = src & getModule %~ nestId i -- | Nest variables in the format @w[0-9]*@ up to a certain number. nestUpTo :: Int -> (Verilog ann) -> (Verilog ann) nestUpTo i src = - foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] + foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] allVars :: (ModDecl ann) -> [Identifier] allVars m = - (m ^.. modOutPorts . traverse . portName) - <> (m ^.. modInPorts . traverse . portName) + (m ^.. modOutPorts . traverse . portName) + <> (m ^.. modInPorts . traverse . portName) -- $setup -- >>> import Verismith.Verilog.CodeGen @@ -231,19 +239,21 @@ instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) where out = Decl Nothing <$> m ^. modOutPorts <*> pure Nothing regIn = - Decl Nothing - <$> (m ^. modInPorts & traverse . portType .~ Reg) - <*> pure Nothing - inst = ModInst (m ^. modId) - (m ^. modId <> (Identifier . showT $ count + 1)) - conns + Decl Nothing + <$> (m ^. modInPorts & traverse . portType .~ Reg) + <*> pure Nothing + inst = + ModInst + (m ^. modId) + (m ^. modId <> (Identifier . showT $ count + 1)) + conns count = - length - . filter (== m ^. modId) - $ main - ^.. modItems - . traverse - . modInstId + length + . filter (== m ^. modId) + $ main + ^.. modItems + . traverse + . modInstId conns = uncurry ModConnNamed . fmap Id <$> zip (allVars m) (allVars m) -- | Instantiate without adding wire declarations. It also does not count the @@ -256,10 +266,10 @@ instantiateMod_ :: (ModDecl ann) -> (ModItem ann) instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns where conns = - ModConn - . Id - <$> (m ^.. modOutPorts . traverse . portName) - ++ (m ^.. modInPorts . traverse . portName) + ModConn + . Id + <$> (m ^.. modOutPorts . traverse . portName) + ++ (m ^.. modInPorts . traverse . portName) -- | Instantiate without adding wire declarations. It also does not count the -- current instantiations of the same module. @@ -270,14 +280,14 @@ instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns instantiateModSpec_ :: Text -> (ModDecl ann) -> (ModItem ann) instantiateModSpec_ outChar m = ModInst (m ^. modId) (m ^. modId) conns where - conns = zipWith ModConnNamed ids (Id <$> instIds) - ids = filterChar outChar (name modOutPorts) <> name modInPorts + conns = zipWith ModConnNamed ids (Id <$> instIds) + ids = filterChar outChar (name modOutPorts) <> name modInPorts instIds = name modOutPorts <> name modInPorts name v = m ^.. v . traverse . portName filterChar :: Text -> [Identifier] -> [Identifier] filterChar t ids = - ids & traverse . _Wrapped %~ (\x -> fromMaybe x . safe head $ T.splitOn t x) + ids & traverse . _Wrapped %~ (\x -> fromMaybe x . safe head $ T.splitOn t x) -- | Initialise all the inputs and outputs to a module. -- @@ -304,18 +314,20 @@ makeIdFrom a i = (i <>) . Identifier . ("_" <>) $ showT a makeTop :: Int -> (ModDecl ann) -> (ModDecl ann) makeTop i m = ModDecl (m ^. modId) ys (m ^. modInPorts) modIt [] where - ys = yPort . flip makeIdFrom "y" <$> [1 .. i] + ys = yPort . flip makeIdFrom "y" <$> [1 .. i] modIt = instantiateModSpec_ "_" . modN <$> [1 .. i] modN n = - m & modId %~ makeIdFrom n & modOutPorts .~ [yPort (makeIdFrom n "y")] + m & modId %~ makeIdFrom n & modOutPorts .~ [yPort (makeIdFrom n "y")] -- | Make a top module with an assert that requires @y_1@ to always be equal to -- @y_2@, which can then be proven using a formal verification tool. makeTopAssert :: (ModDecl ann) -> (ModDecl ann) makeTopAssert = (modItems %~ (++ [assert])) . makeTop 2 where - assert = Always . EventCtrl e . Just $ SeqBlock - [TaskEnable $ Task "assert" [BinOp (Id "y_1") BinEq (Id "y_2")]] + assert = + Always . EventCtrl e . Just $ + SeqBlock + [TaskEnable $ Task "assert" [BinOp (Id "y_1") BinEq (Id "y_2")]] e = EPosEdge "clk" -- | Provide declarations for all the ports that are passed to it. If they are @@ -324,7 +336,7 @@ declareMod :: [Port] -> (ModDecl ann) -> (ModDecl ann) declareMod ports = initMod . (modItems %~ (fmap decl ports ++)) where decl p@(Port Reg _ _ _) = Decl Nothing p (Just 0) - decl p = Decl Nothing p Nothing + decl p = Decl Nothing p Nothing -- | Simplify an 'Expr' by using constants to remove 'BinaryOperator' and -- simplify expressions. To make this work effectively, it should be run until @@ -336,30 +348,30 @@ declareMod ports = initMod . (modItems %~ (fmap decl ports ++)) -- >>> GenVerilog . simplify $ (Id "y") + (Id "x") -- (y + x) simplify :: Expr -> Expr -simplify (BinOp (Number (BitVec _ 1)) BinAnd e) = e -simplify (BinOp e BinAnd (Number (BitVec _ 1))) = e -simplify (BinOp (Number (BitVec _ 0)) BinAnd _) = Number 0 -simplify (BinOp _ BinAnd (Number (BitVec _ 0))) = Number 0 -simplify (BinOp e BinPlus (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinPlus e) = e +simplify (BinOp (Number (BitVec _ 1)) BinAnd e) = e +simplify (BinOp e BinAnd (Number (BitVec _ 1))) = e +simplify (BinOp (Number (BitVec _ 0)) BinAnd _) = Number 0 +simplify (BinOp _ BinAnd (Number (BitVec _ 0))) = Number 0 +simplify (BinOp e BinPlus (Number (BitVec _ 0))) = e +simplify (BinOp (Number (BitVec _ 0)) BinPlus e) = e simplify (BinOp e BinMinus (Number (BitVec _ 0))) = e simplify (BinOp (Number (BitVec _ 0)) BinMinus e) = e simplify (BinOp e BinTimes (Number (BitVec _ 1))) = e simplify (BinOp (Number (BitVec _ 1)) BinTimes e) = e simplify (BinOp _ BinTimes (Number (BitVec _ 0))) = Number 0 simplify (BinOp (Number (BitVec _ 0)) BinTimes _) = Number 0 -simplify (BinOp e BinOr (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinOr e) = e -simplify (BinOp e BinLSL (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinLSL e) = e -simplify (BinOp e BinLSR (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinLSR e) = e -simplify (BinOp e BinASL (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinASL e) = e -simplify (BinOp e BinASR (Number (BitVec _ 0))) = e -simplify (BinOp (Number (BitVec _ 0)) BinASR e) = e -simplify (UnOp UnPlus e) = e -simplify e = e +simplify (BinOp e BinOr (Number (BitVec _ 0))) = e +simplify (BinOp (Number (BitVec _ 0)) BinOr e) = e +simplify (BinOp e BinLSL (Number (BitVec _ 0))) = e +simplify (BinOp (Number (BitVec _ 0)) BinLSL e) = e +simplify (BinOp e BinLSR (Number (BitVec _ 0))) = e +simplify (BinOp (Number (BitVec _ 0)) BinLSR e) = e +simplify (BinOp e BinASL (Number (BitVec _ 0))) = e +simplify (BinOp (Number (BitVec _ 0)) BinASL e) = e +simplify (BinOp e BinASR (Number (BitVec _ 0))) = e +simplify (BinOp (Number (BitVec _ 0)) BinASR e) = e +simplify (UnOp UnPlus e) = e +simplify e = e -- | Remove all 'Identifier' that do not appeare in the input list from an -- 'Expr'. The identifier will be replaced by @1'b0@, which can then later be @@ -370,32 +382,34 @@ simplify e = e removeId :: [Identifier] -> Expr -> Expr removeId i = transform trans where - trans (Id ident) | ident `notElem` i = Number 0 - | otherwise = Id ident + trans (Id ident) + | ident `notElem` i = Number 0 + | otherwise = Id ident trans e = e combineAssigns :: Port -> [ModItem ann] -> [ModItem ann] combineAssigns p a = - a - <> [ ModCA - . ContAssign (p ^. portName) - . UnOp UnXor - . fold - $ Id + a + <> [ ModCA + . ContAssign (p ^. portName) + . UnOp UnXor + . fold + $ Id <$> assigns - ] - where assigns = a ^.. traverse . modContAssign . contAssignNetLVal + ] + where + assigns = a ^.. traverse . modContAssign . contAssignNetLVal combineAssigns_ :: Bool -> Port -> [Port] -> (ModItem ann) combineAssigns_ comb p ps = - ModCA - . ContAssign (p ^. portName) - . (if comb then UnOp UnXor else id) - . fold - $ Id - <$> ps - ^.. traverse - . portName + ModCA + . ContAssign (p ^. portName) + . (if comb then UnOp UnXor else id) + . fold + $ Id + <$> ps + ^.. traverse + . portName fromPort :: Port -> Identifier fromPort (Port _ _ _ i) = i |