From dbdea9bc47513b3643c981043c806647fdcf89b4 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 5 Nov 2019 10:17:31 +0000 Subject: Add reduction pass to remove constants from concat --- src/Verismith.hs | 13 ++++++++++--- src/Verismith/OptParser.hs | 25 ++++++++++++++++++++++--- src/Verismith/Reduce.hs | 20 +++++++++++++++++++- src/Verismith/Verilog/AST.hs | 6 ++++++ test/Reduce.hs | 39 +++++++++++++++++++++++++++++++-------- 5 files changed, 88 insertions(+), 15 deletions(-) diff --git a/src/Verismith.hs b/src/Verismith.hs index 45977fe..19237ae 100644 --- a/src/Verismith.hs +++ b/src/Verismith.hs @@ -148,12 +148,19 @@ handleOpts (Generate f c) = do $ T.unpack . toTextIgnore <$> f -handleOpts (Parse f) = do +handleOpts (Parse f t o rc) = do verilogSrc <- T.readFile file case parseVerilog (T.pack file) verilogSrc of Left l -> print l - Right v -> print $ GenVerilog v - where file = T.unpack . toTextIgnore $ f + Right v -> + case (o, GenVerilog + . mapply rc (takeReplace . removeConstInConcat) + $ SourceInfo t v) of + (Nothing, a) -> print a + (Just o', a) -> writeFile (T.unpack $ toTextIgnore o') $ show a + where + file = T.unpack . toTextIgnore $ f + mapply i f = if i then f else id handleOpts (Reduce f t _ ls' False) = do src <- parseSourceInfoFile t (toTextIgnore f) datadir <- getDataDir diff --git a/src/Verismith/OptParser.hs b/src/Verismith/OptParser.hs index 57ad2bd..2ccfe31 100644 --- a/src/Verismith/OptParser.hs +++ b/src/Verismith/OptParser.hs @@ -38,7 +38,10 @@ data Opts = Fuzz { fuzzOutput :: {-# UNPACK #-} !Text | Generate { generateFilename :: !(Maybe FilePath) , generateConfigFile :: !(Maybe FilePath) } - | Parse { parseFilename :: {-# UNPACK #-} !FilePath + | Parse { parseFilename :: {-# UNPACK #-} !FilePath + , parseTop :: {-# UNPACK #-} !Text + , parseOutput :: !(Maybe FilePath) + , parseRemoveConstInConcat :: !Bool } | Reduce { reduceFilename :: {-# UNPACK #-} !FilePath , reduceTop :: {-# UNPACK #-} !Text @@ -145,8 +148,24 @@ genOpts = ) parseOpts :: Parser Opts -parseOpts = Parse . fromText . T.pack <$> Opt.strArgument - (Opt.metavar "FILE" <> Opt.help "Verilog input file.") +parseOpts = Parse + <$> (fromText . T.pack <$> Opt.strArgument + (Opt.metavar "FILE" <> Opt.help "Verilog input file.")) + <*> textOption ( Opt.short 't' + <> Opt.long "top" + <> Opt.metavar "TOP" + <> Opt.help "Name of top level module." + <> Opt.showDefault + <> Opt.value "top" + ) + <*> ( Opt.optional + . Opt.strOption + $ Opt.long "output" + <> Opt.short 'o' + <> Opt.metavar "FILE" + <> Opt.help "Output file to write the parsed file to.") + <*> (Opt.switch $ Opt.long "remove-const-in-concat" <> Opt.help + "Remove constants in concatenation to simplify the Verilog.") reduceOpts :: Parser Opts reduceOpts = diff --git a/src/Verismith/Reduce.hs b/src/Verismith/Reduce.hs index a7ec3f8..cff61ed 100644 --- a/src/Verismith/Reduce.hs +++ b/src/Verismith/Reduce.hs @@ -31,6 +31,8 @@ module Verismith.Reduce , cleanSourceInfo , cleanSourceInfoAll , removeDecl + , removeConstInConcat + , takeReplace , filterExpr ) where @@ -156,6 +158,21 @@ filterAssigns _ _ = True clean :: (Mutate a) => [Identifier] -> a -> a clean ids = mutExpr (transform $ filterExpr ids) +takeReplace :: (Monoid a) => Replacement a -> a +takeReplace (Single a) = a +takeReplace (Dual a _) = a +takeReplace None = mempty + +removeConstInConcat :: Replace SourceInfo +removeConstInConcat = Single . mutExpr replace + where + replace :: Expr -> Expr + replace (Concat expr) = maybe (Number 0) Concat . NonEmpty.nonEmpty + $ NonEmpty.filter notConstant expr + replace e = e + notConstant (Number _) = False + notConstant _ = True + cleanUndefined :: [Identifier] -> [ModItem] -> [ModItem] cleanUndefined ids mis = clean usedWires mis where @@ -547,9 +564,10 @@ reduce reduce eval src = fmap removeDecl $ red "Modules" moduleBot halveModules src - >>= redAll "Module Items" modItemBot halveModItems + >>= redAll "Module items" modItemBot halveModItems >>= redAll "Statements" (const defaultBot) halveStatements -- >>= redAll "Expressions" (const defaultBot) halveExpr + >>= red "Remove constants in concat" defaultBot removeConstInConcat where red s bot a = reduce_ s a bot eval red' s bot a t = reduce_ s (a t) (bot t) eval diff --git a/src/Verismith/Verilog/AST.hs b/src/Verismith/Verilog/AST.hs index 699d87a..fbe4347 100644 --- a/src/Verismith/Verilog/AST.hs +++ b/src/Verismith/Verilog/AST.hs @@ -524,6 +524,12 @@ data SourceInfo = SourceInfo { _infoTop :: {-# UNPACK #-} !Text } deriving (Eq, Show, Ord, Data, Generic, NFData) +instance Semigroup SourceInfo where + (SourceInfo t v) <> (SourceInfo _ v2) = SourceInfo t $ v <> v2 + +instance Monoid SourceInfo where + mempty = SourceInfo mempty mempty + $(makeLenses ''Expr) $(makeLenses ''ConstExpr) $(makeLenses ''Task) diff --git a/test/Reduce.hs b/test/Reduce.hs index fcc10aa..37ef576 100644 --- a/test/Reduce.hs +++ b/test/Reduce.hs @@ -36,7 +36,37 @@ reduceUnitTests = testGroup , removeDeclTest ] --- brittany-disable-next-binding +removeConstInConcatTest :: TestTree +removeConstInConcatTest = testCase "Remove const in concat" $ do + GenVerilog (removeDecl srcInfo1) @?= golden1 + where + srcInfo1 = SourceInfo "top" [verilog| +module top; + wire a; + reg b; + + assign a = {1'b0, 1'b0, 1'b0, (1'b0), b, (1'b0), (1'b0)}; + + always @(posedge clk) begin + if (a) + b <= 1 + 5 + {1'b0, 1'b1, 5'h20, b, 2'b0}; + end +endmodule +|] + golden1 = GenVerilog $ SourceInfo "top" [verilog| +module top; + wire a; + reg b; + + assign a = {b}; + + always @(posedge clk) begin + if (a) + b <= 1 + 5 + {b}; + end +endmodule +|] + removeDeclTest :: TestTree removeDeclTest = testCase "Remove declarations" $ do GenVerilog (removeDecl srcInfo1) @?= golden1 @@ -95,7 +125,6 @@ module top; endmodule |] --- brittany-disable-next-binding cleanAllTest :: TestTree cleanAllTest = testCase "Clean all" $ do GenVerilog (cleanSourceInfoAll srcInfo1) @?= golden1 @@ -157,7 +186,6 @@ module mod2; endmodule |] --- brittany-disable-next-binding cleanTest :: TestTree cleanTest = testCase "Clean expression" $ do clean ["wire1", "wire2"] srcInfo1 @?= golden1 @@ -197,7 +225,6 @@ endmodule |] --- brittany-disable-next-binding activeWireTest :: TestTree activeWireTest = testCase "Active wires" $ do findActiveWires "top" verilog1 \\ ["x", "y", "z", "w"] @?= [] @@ -271,7 +298,6 @@ module m2(y, z, x); endmodule |] --- brittany-disable-next-binding halveStatementsTest :: TestTree halveStatementsTest = testCase "Statements" $ do GenVerilog <$> halveStatements "top" srcInfo1 @?= golden1 @@ -336,7 +362,6 @@ module top(clk, y, x); endmodule |]) --- brittany-disable-next-binding modItemReduceTest :: TestTree modItemReduceTest = testCase "Module items" $ do GenVerilog <$> halveModItems "top" srcInfo1 @?= golden1 @@ -372,7 +397,6 @@ module top(y, x); endmodule |]) --- brittany-disable-next-binding statementReducerTest :: TestTree statementReducerTest = testCase "Statement reducer" $ do GenVerilog <$> halveStatements "top" srcInfo1 @?= fmap GenVerilog golden1 @@ -460,7 +484,6 @@ module top(y, x); endmodule |] --- brittany-disable-next-binding moduleReducerTest :: TestTree moduleReducerTest = testCase "Module reducer" $ do halveModules srcInfo1 @?= golden1 -- cgit