Add reduction pass to remove constants from concat

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