From 56fb22af3fb34ea9d9ae80afd0b03bd22b7b2dd0 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sat, 11 May 2019 21:51:54 +0100 Subject: Add new reduction techniques --- src/VeriFuzz/Reduce.hs | 214 +++++++++++++++++++++---------------------------- test/Reduce.hs | 171 +++++++++++++++++++++++++++++++-------- 2 files changed, 232 insertions(+), 153 deletions(-) diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index df92d99..65b0e86 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -19,10 +19,15 @@ module VeriFuzz.Reduce , reduce , reduce_ , halveModules + , halveModItems + , halveExpr + , findActiveWires ) where import Control.Lens +import Data.List (nub) +import Data.Maybe (catMaybes) import Data.Text (Text) import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen @@ -54,12 +59,9 @@ import VeriFuzz.Verilog.Mutate data Replacement a = Dual a a | Single a | None - deriving (Eq) + deriving (Show, Eq) -instance Show a => Show (Replacement a) where - show None = "None" - show (Single a) = "--- Only try:\n" <> show a - show (Dual a b) = "--- Try:\n" <> show a <> "\n--- Then:\n" <> show b +type Replace a = a -> Replacement a instance Functor Replacement where fmap f (Dual a b) = Dual (f a) $ f b @@ -86,7 +88,7 @@ instance Traversable Replacement where traverse f (Dual a b) = Dual <$> f a <*> f b -- | Split a list in two halves. -halve :: [a] -> Replacement [a] +halve :: Replace [a] halve [] = None halve [_] = Single [] halve l = Dual a b where (a, b) = splitAt (length l `div` 2) l @@ -94,13 +96,13 @@ halve l = Dual a b where (a, b) = splitAt (length l `div` 2) l -- | When given a Lens and a function that works on a lower replacement, it will -- go down, apply the replacement, and return a replacement of the original -- module. -combine :: Lens' a b -> (b -> Replacement b) -> a -> Replacement a +combine :: Lens' a b -> Replace b -> Replace a combine l f i = modify <$> f (i ^. l) where modify res = i & l .~ res -- | Deletes Id 'Expr' if they are not part of the current scope, and replaces -- these by 0. filterExpr :: [Identifier] -> Expr -> Expr -filterExpr ids (Id i) = if i `notElem` ids then Number 0 else Id i +filterExpr ids (Id i) = if i `elem` ids then Id i else Number 0 filterExpr _ e = e -- | Checks if a declaration is part of the current scope. If not, it returns @@ -116,17 +118,15 @@ filterAssigns out (ModCA (ContAssign i _)) = elem i $ out ^.. traverse . portName filterAssigns _ _ = True +clean :: (Mutate a) => [Identifier] -> a -> a +clean ids a = mutExpr (transform $ filterExpr ids) a + cleanUndefined :: [Identifier] -> [ModItem] -> [ModItem] -cleanUndefined ids mis = - filter (filterDecl usedWires) mis - & traverse - . modContAssign - . contAssignExpr - %~ transform (filterExpr usedWires) +cleanUndefined ids mis = clean usedWires mis where usedWires = mis ^.. traverse . modContAssign . contAssignNetLVal <> ids -halveModAssign :: ModDecl -> Replacement ModDecl +halveModAssign :: Replace ModDecl halveModAssign m = cleanMod m $ modify <$> assigns (m ^. modItems) where assigns = halve . filter (filterAssigns $ m ^. modOutPorts) @@ -151,11 +151,7 @@ cleanMod m newm = modify . change <$> newm -- halveStatements (ForLoop _ _ _ s ) = Single s -- halveStatements _ = None --- | Split a module declaration in half by trying to remove assign statements. -halveAssigns :: SourceInfo -> Replacement SourceInfo -halveAssigns = combine mainModule halveModAssign - -halveIndExpr :: Expr -> Replacement Expr +halveIndExpr :: Replace Expr halveIndExpr (Concat l ) = Concat <$> halve l halveIndExpr (BinOp e1 _ e2) = Dual e1 e2 halveIndExpr (Cond _ e1 e2) = Dual e1 e2 @@ -163,106 +159,10 @@ halveIndExpr (UnOp _ e ) = Single e halveIndExpr (Appl _ e ) = Single e halveIndExpr e = Single e -halveModExpr :: ModItem -> Replacement ModItem +halveModExpr :: Replace ModItem halveModExpr (ModCA ca) = ModCA <$> combine contAssignExpr halveIndExpr ca halveModExpr a = Single a -halveExpr :: SourceInfo -> Replacement SourceInfo -halveExpr = combine contexpr $ traverse halveModExpr - where - contexpr :: Lens' SourceInfo [ModItem] - contexpr = mainModule . modItems - --- $setup --- >>> import VeriFuzz.Verilog.CodeGen --- >>> let m = initMod $ ModDecl (Identifier "m") [Port Wire False 5 (Identifier "y")] [Port Wire False 5 "x"] [] [] --- >>> let m2 = m & modId .~ "m2" --- >>> let inst = ModInst "m" "m" [ModConn (Id "y"), ModConn (Id "x")] --- >>> let inst2 = ModInst "m2" "m2" [ModConn (Id "y"), ModConn (Id "x")] --- >>> let srcInfo = SourceInfo "top" (Verilog [(m & (modId .~ "top") . (modItems %~ (++[inst]))), m]) --- >>> let srcInfo2 = SourceInfo "top" (Verilog [(m & (modId .~ "top") . (modItems %~ (++[inst, inst2]))), m, m2]) - --- | Removes half the modules randomly, until it reaches a minimal amount of --- modules. This is done by doing a binary search on the list of modules and --- removing the instantiations from the main module body. --- --- >>> GenVerilog srcInfo --- module top(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- m m(y, x); --- endmodule --- --- module m(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- --- --- >>> GenVerilog <$> halveModules srcInfo --- --- Only try: --- module top(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- --- --- >>> GenVerilog srcInfo2 --- module top(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- m m(y, x); --- m2 m2(y, x); --- endmodule --- --- module m(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- module m2(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- --- --- >>> GenVerilog <$> halveModules srcInfo2 --- --- Try: --- module top(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- m m(y, x); --- endmodule --- --- module m(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- --- --- Then: --- module top(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- m2 m2(y, x); --- endmodule --- --- module m2(y, x); --- output wire [(3'h4):(1'h0)] y; --- input wire [(3'h4):(1'h0)] x; --- endmodule --- --- -halveModules :: SourceInfo -> Replacement SourceInfo -halveModules srcInfo@(SourceInfo top _) = - cleanModInst . addMod main <$> combine (infoSrc . _Wrapped) repl srcInfo - where - repl = halve . filter (not . matchesModName top) - main = srcInfo ^. mainModule - -- | Remove all the undefined mod instances. cleanModInst :: SourceInfo -> SourceInfo cleanModInst srcInfo = srcInfo & infoSrc . _Wrapped .~ cleaned @@ -270,11 +170,14 @@ cleanModInst srcInfo = srcInfo & infoSrc . _Wrapped .~ cleaned validInst = srcInfo ^.. infoSrc . _Wrapped . traverse . modId cleaned = cleanModInst' validInst <$> srcInfo ^. infoSrc . _Wrapped +-- | Clean all the undefined module instances in a specific module using a +-- context. cleanModInst' :: [Identifier] -> ModDecl -> ModDecl cleanModInst' ids m = m & modItems .~ newModItem where newModItem = filter (validModInst ids) $ m ^.. modItems . traverse +-- | Check if a mod instance is in the current context. validModInst :: [Identifier] -> ModItem -> Bool validModInst ids (ModInst i _ _) = i `elem` ids validModInst _ _ = True @@ -287,9 +190,78 @@ addMod m srcInfo = srcInfo & infoSrc . _Wrapped %~ (m :) matchesModName :: Text -> ModDecl -> Bool matchesModName top (ModDecl i _ _ _ _) = top == getIdentifier i +-- | Removes half the modules randomly, until it reaches a minimal amount of +-- modules. This is done by doing a binary search on the list of modules and +-- removing the instantiations from the main module body. +halveModules :: Replace SourceInfo +halveModules srcInfo@(SourceInfo top _) = + cleanModInst . addMod main <$> combine (infoSrc . _Wrapped) repl srcInfo + where + repl = halve . filter (not . matchesModName top) + main = srcInfo ^. mainModule + +-- | Split a module declaration in half by trying to remove assign +-- statements. This is only done in the main module of the source. +halveAssigns :: Replace SourceInfo +halveAssigns = combine mainModule halveModAssign + +-- | Checks if a module item is needed in the module declaration. +relevantModItem :: ModDecl -> ModItem -> Bool +relevantModItem (ModDecl _ out _ _ _) (ModCA (ContAssign i _)) = i `elem` fmap _portName out +relevantModItem _ (Decl _ _ _) = True +relevantModItem _ _ = False + +isAssign :: Statement -> Bool +isAssign (BlockAssign _) = True +isAssign (NonBlockAssign _) = True +isAssign _ = False + +lValName :: LVal -> [Identifier] +lValName (RegId i) = [i] +lValName (RegExpr i _) = [i] +lValName (RegSize i _) = [i] +lValName (RegConcat e) = catMaybes . fmap getId . concat $ universe <$> e + where + getId (Id i) = Just i + getId _ = Nothing + +portToId :: Port -> Identifier +portToId (Port _ _ _ i) = i + +paramToId :: Parameter -> Identifier +paramToId (Parameter i _) = i + +findActiveWires :: ModDecl -> [Identifier] +findActiveWires m@(ModDecl _ i o _ p) = nub $ assignWires <> assignStat <> fmap portToId i <> fmap portToId o <> fmap paramToId p + where + assignWires = m ^.. modItems . traverse . modContAssign . contAssignNetLVal + assignStat = concat . fmap lValName $ (allStat ^.. traverse . stmntBA . assignReg) + <> (allStat ^.. traverse . stmntNBA . assignReg) + allStat = filter isAssign . concat $ fmap universe stat + stat = (m ^.. modItems . traverse . _Initial) <> (m ^.. modItems . traverse . _Always) + +-- | Reducer for module items. It does a binary search on all the module items, +-- except assignments to outputs and input-output declarations. +halveModItems :: Replace SourceInfo +halveModItems srcInfo = fmap addRelevant src + where + repl = halve . filter (not . relevantModItem main) + relevant = filter (relevantModItem main) $ main ^. modItems + main = srcInfo ^. mainModule + src = combine (mainModule . modItems) repl srcInfo + addRelevant = mainModule . modItems %~ (relevant ++) + +-- | Reduce expressions by splitting them in half and keeping the half that +-- succeeds. +halveExpr :: Replace SourceInfo +halveExpr = combine contexpr $ traverse halveModExpr + where + contexpr :: Lens' SourceInfo [ModItem] + contexpr = mainModule . modItems + -- | Reduction using custom reduction strategies. reduce_ - :: (SourceInfo -> Replacement SourceInfo) + :: Replace SourceInfo -> (SourceInfo -> IO Bool) -> SourceInfo -> IO SourceInfo @@ -297,9 +269,9 @@ reduce_ repl eval src = do replAnswer <- sequenceA $ evalIfNotEmpty <$> replacement case (replacement, replAnswer) of (Single s, Single True ) -> runIf s - (Dual _ l, Dual False True ) -> runIf l - (Dual r _, Dual True False ) -> runIf r - (Dual r l, Dual True True) -> do + (Dual _ r, Dual False True ) -> runIf r + (Dual l _, Dual True False ) -> runIf l + (Dual l r, Dual True True) -> do lreduced <- runIf l rreduced <- runIf r if _infoSrc lreduced < _infoSrc rreduced diff --git a/test/Reduce.hs b/test/Reduce.hs index 4edfdc0..17bbfbc 100644 --- a/test/Reduce.hs +++ b/test/Reduce.hs @@ -13,38 +13,145 @@ Test reduction. {-# LANGUAGE QuasiQuotes #-} module Reduce - (reducerTests) + (reduceUnitTests) where ---import Data.Either (fromRight) ---import Data.Text (unpack) +import Data.List ((\\)) import Test.Tasty ----import Text.Shakespeare.Text (st) ---import VeriFuzz - -reducerTests :: TestTree -reducerTests = testGroup "Reducer tests" - [ moduleReducer ] - -moduleReducer :: TestTree -moduleReducer = testGroup "Module reducer" - [ ] - ---reduceOneModule :: TestTree ---reduceOneModule = undefined --- ----- brittany-disable-next-binding ---moduleIn :: SourceInfo ---moduleIn = SourceInfo "top" . fromRight (Verilog []) . parseVerilog "" $ unpack [st| ---module m(x, y); ---input x; ---output y; ---endmodule --- ---module top(x, y); ---input x; ---output y; ---m m1(x, y) ---endmodule --- |] --- +import Test.Tasty.HUnit +import VeriFuzz +import VeriFuzz.Reduce +import VeriFuzz.Verilog.Quote + +reduceUnitTests :: TestTree +reduceUnitTests = testGroup "Reducer tests" + [ moduleReducerTest + , modItemReduceTest + , activeWireTest + ] + +activeWireTest :: TestTree +activeWireTest = testCase "Active wires" $ do + findActiveWires verilog1 \\ ["x", "y", "z", "w"] @?= [] + findActiveWires verilog2 \\ ["x", "y", "z"] @?= [] + where + verilog1 = head $ getVerilog [verilog| +module top(y, x); + input x; + output y; + wire z; + wire w; + assign z = 0; + assign w = 2; + assign y = w + z; +endmodule +|] + verilog2 = head $ getVerilog [verilog| +module top(y, x); + input x; + output y; + wire z; + wire w; + assign z = 0; +endmodule +|] + +modItemReduceTest :: TestTree +modItemReduceTest = testCase "Module items" $ do + halveModItems srcInfo1 @?= golden1 + where + srcInfo1 = SourceInfo "top" [verilog| +module top(y, x); + input x; + output y; + wire z; + wire w; + assign z = x; + assign w = z; + assign y = w; +endmodule +|] + golden1 = Dual (SourceInfo "top" [verilog| +module top(y, x); + input x; + output y; + wire z; + wire w; + assign z = x; + assign y = w; +endmodule +|]) $ SourceInfo "top" [verilog| +module top(y, x); + input x; + output y; + wire z; + wire w; + assign w = 1'b0; + assign y = w; +endmodule +|] + +moduleReducerTest :: TestTree +moduleReducerTest = testCase "Module reducer" $ do + halveModules srcInfo1 @?= golden1 + halveModules srcInfo2 @?= golden2 + where + srcInfo1 = SourceInfo "top" [verilog| +module top(y, x); + output wire [4:0] y; + input wire [4:0] x; + m m(y, x); +endmodule + +module m(y, x); + output wire [4:0] y; + input wire [4:0] x; +endmodule +|] + golden1 = Single $ SourceInfo "top" [verilog| +module top(y, x); + output wire [4:0] y; + input wire [4:0] x; +endmodule +|] + srcInfo2 = SourceInfo "top" [verilog| +module top(y, x); + output wire [4:0] y; + input wire [4:0] x; + m m(y, x); + m2 m2(y, x); +endmodule + +module m(y, x); + output wire [4:0] y; + input wire [4:0] x; +endmodule + +module m2(y, x); + output wire [4:0] y; + input wire [4:0] x; +endmodule +|] + golden2 = Dual (SourceInfo "top" [verilog| +module top(y, x); + output wire [4:0] y; + input wire [4:0] x; + m m(y, x); +endmodule + +module m(y, x); + output wire [4:0] y; + input wire [4:0] x; +endmodule +|]) $ SourceInfo "top" [verilog| +module top(y, x); + output wire [4:0] y; + input wire [4:0] x; + m2 m2(y, x); +endmodule + +module m2(y, x); + output wire [4:0] y; + input wire [4:0] x; +endmodule +|] -- cgit