add bugpoint mode

This mode reduces the size of test cases that encounter conversion
errors or produce incorrect output. The logic developed slowly over the
past three years. It is in a state that I find useful when fielding bug
reports, but has some room for improvement in terms of constraints and
filtering.

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 * Added parsing support for `not`, `strong`, `weak`, `nexttime`, and
   `s_nexttime` in assertion property expressions
+* Added `--bugpoint` utility for minimizing test cases for issue submission
 
 ### Bug Fixes
 

README.md

@@ -116,6 +116,9 @@ Other:
                             number literals (e.g., 'h1_ffff_ffff, 4294967296)
      --dump-prefix=PATH     Create intermediate output files with the given
                             path prefix; used for internal debugging
+     --bugpoint=SUBSTR      Reduce the input by pruning modules, wires, etc.,
+                            that aren't needed to produce the given output or
+                            error substring when converted
      --help                 Display this help message
      --version              Print version information
      --numeric-version      Print just the version number

src/Bugpoint.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Utility for reducing test cases that cause conversion errors or otherwise
+ - produce unexpected output.
+ -}
+
+module Bugpoint (runBugpoint) where
+
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
+
+import Control.Exception (catches, ErrorCall(..), Handler(..), PatternMatchFail(..))
+import Control.Monad (when, (>=>))
+import Data.Functor ((<&>))
+import Data.List (isInfixOf)
+
+import qualified Convert.RemoveComments
+import Language.SystemVerilog.AST
+
+runBugpoint :: [String] -> ([AST] -> IO [AST]) -> [AST] -> IO [AST]
+runBugpoint expected converter =
+    fmap pure . runBugpoint' expected converter' . concat
+    where
+        converter' :: AST -> IO AST
+        converter' = fmap concat . converter . pure
+
+runBugpoint' :: [String] -> (AST -> IO AST) -> AST -> IO AST
+runBugpoint' expected converter ast = do
+    ast' <- runBugpointPass expected converter ast
+    if ast == ast'
+        then out "done minimizing" >> return ast
+        else runBugpoint' expected converter ast'
+
+out :: String -> IO ()
+out = hPutStrLn stderr . ("bugpoint: " ++)
+
+-- run the given converter and return the conversion failure if any or the
+-- converted output otherwise
+extractConversionResult :: (AST -> IO AST) -> AST -> IO String
+extractConversionResult converter asts =
+    catches runner
+        [ Handler handleErrorCall
+        , Handler handlePatternMatchFail
+        ]
+    where
+        runner = converter asts <&> show
+        handleErrorCall (ErrorCall str) = return str
+        handlePatternMatchFail (PatternMatchFail str) = return str
+
+runBugpointPass :: [String] -> (AST -> IO AST) -> AST -> IO AST
+runBugpointPass expected converter ast = do
+    out $ "beginning pass with " ++ (show $ length $ show ast) ++ " characters"
+    matches <- oracle ast
+    when (not matches) $
+        out ("doesn't match expected strings: " ++ show expected) >> exitFailure
+    let ast' = concat $ Convert.RemoveComments.convert [ast]
+    matches' <- oracle ast'
+    minimizeContainer oracle minimizeDescription "<design>" id $
+        if matches' then ast' else ast
+    where
+        oracle :: AST -> IO Bool
+        oracle = fmap check . extractConversionResult converter
+        check :: String -> Bool
+        check = flip all expected . flip isInfixOf
+
+type Oracle t = t -> IO Bool
+type Minimizer t = Oracle t -> t -> IO t
+
+-- given a subsequence-verifying oracle, a strategy for minimizing within
+-- elements of the sequence, a name for debugging, a constructor for the
+-- container, and the elements within the container, produce a minimized version
+-- of the container
+minimizeContainer :: forall a b. (Show a, Show b)
+    => Oracle a -> Minimizer b -> String -> ([b] -> a) -> [b] -> IO a
+minimizeContainer oracle minimizer name constructor =
+    stepFilter 0 [] >=>
+    stepRecurse [] >=>
+    return . constructor
+    where
+        oracle' :: Oracle [b]
+        oracle' = oracle . constructor
+
+        stepFilter :: Int -> [b] -> [b] -> IO [b]
+        stepFilter 0 [] pending = stepFilter (length pending) [] pending
+        stepFilter 1 need [] = return need
+        stepFilter width need [] =
+            stepFilter (max 1 $ width `div` 4) [] need
+        stepFilter width need pending = do
+            matches <- oracle' $ need ++ rest
+            if matches
+                then out msg >> stepFilter width need rest
+                else stepFilter width (need ++ curr) rest
+            where
+                (curr, rest) = splitAt width pending
+                msg = "removed " ++ show (length curr) ++ " items from " ++ name
+
+        stepRecurse :: [b] -> [b] -> IO [b]
+        stepRecurse before [] = return before
+        stepRecurse before (isolated : after) = do
+            isolated' <- minimizer oracleRecurse isolated
+            stepRecurse (before ++ [isolated']) after
+            where oracleRecurse = (oracle' $) . (before ++) . (: after)
+
+minimizeDescription :: Minimizer Description
+minimizeDescription oracle (Package lifetime name items) =
+    minimizeContainer oracle (const return) name constructor items
+    where constructor = Package lifetime name
+minimizeDescription oracle (Part att ext kw lif name ports items) =
+    minimizeContainer oracle minimizeModuleItem name constructor items
+    where constructor = Part att ext kw lif name ports
+minimizeDescription _ other = return other
+
+minimizeModuleItem :: Minimizer ModuleItem
+minimizeModuleItem oracle (Generate items) =
+    minimizeContainer oracle minimizeGenItem "<generate>" Generate items
+minimizeModuleItem _ item = return item
+
+minimizeGenItem :: Minimizer GenItem
+minimizeGenItem _ GenNull = return GenNull
+minimizeGenItem oracle item = do
+    matches <- oracle GenNull
+    if matches
+        then out "removed generate item" >> return GenNull
+        else minimizeGenItem' oracle item
+
+minimizeGenItem' :: Minimizer GenItem
+minimizeGenItem' oracle (GenModuleItem item) =
+    minimizeModuleItem (oracle . GenModuleItem) item <&> GenModuleItem
+minimizeGenItem' oracle (GenIf c t f) = do
+    t' <- minimizeGenItem (oracle . flip (GenIf c) f) t
+    f' <- minimizeGenItem (oracle . GenIf c t') f
+    return $ GenIf c t' f'
+minimizeGenItem' _ (GenBlock _ []) = return GenNull
+minimizeGenItem' oracle (GenBlock name items) =
+    minimizeContainer oracle minimizeGenItem' name constructor items
+    where constructor = GenBlock name
+minimizeGenItem' oracle (GenFor a b c item) =
+    minimizeGenItem (oracle . constructor) item <&> constructor
+    where constructor = GenFor a b c
+minimizeGenItem' oracle (GenCase expr cases) =
+    minimizeContainer oracle minimizeGenCase "<case>" constructor cases
+    where constructor = GenCase expr
+minimizeGenItem' _ GenNull = return GenNull
+
+minimizeGenCase :: Minimizer GenCase
+minimizeGenCase oracle (exprs, item) =
+    minimizeGenItem' (oracle . constructor) item <&> constructor
+    where constructor = (exprs,)

src/Job.hs

@@ -53,6 +53,7 @@ data Job = Job
     , top :: [String]
     , oversizedNumbers :: Bool
     , dumpPrefix :: FilePath
+    , bugpoint :: [String]
     } deriving (Typeable, Data)
 
 version :: String
@@ -101,6 +102,10 @@ defaultJob = Job
     , dumpPrefix = def &= name "dump-prefix" &= explicit &= typ "PATH"
         &= help ("Create intermediate output files with the given path prefix;"
             ++ " used for internal debugging")
+    , bugpoint = nam_ "bugpoint" &= typ "SUBSTR"
+        &= help ("Reduce the input by pruning modules, wires, etc., that"
+            ++ " aren't needed to produce the given output or error substring"
+            ++ " when converted")
     }
     &= program "sv2v"
     &= summary ("sv2v " ++ version)

src/sv2v.hs

@@ -12,6 +12,7 @@ import Control.Monad (when, zipWithM_)
 import Control.Monad.Except (runExceptT)
 import Data.List (nub)
 
+import Bugpoint (runBugpoint)
 import Convert (convert)
 import Job (readJob, Job(..), Write(..))
 import Language.SystemVerilog.AST
@@ -107,6 +108,8 @@ main = do
             asts' <-
                 if passThrough job then
                     return asts
+                else if bugpoint job /= [] then
+                    runBugpoint (bugpoint job) converter asts
                 else
                     converter asts
             emptyWarnings (concat asts) (concat asts')

sv2v.cabal

@@ -115,6 +115,7 @@ executable sv2v
     Convert.Unsigned
     Convert.Wildcard
     -- sv2v CLI modules
+    Bugpoint
     Job
     Split
     Paths_sv2v

test/README.md

@@ -68,6 +68,7 @@ The remaining test suites have a custom `run.sh` that defines a list of test
 procedures that may not correspond directly to the other files in the folder.
 Many of these suites test a particular feature of the sv2v CLI.
 
+* `bugpoint` tests `--bugpoint`
 * `define` tests `-D`/`--define`
 * `dump` tests `--dump-prefix`
 * `help` ensures the `--help` output in the README is up to date

test/bugpoint/after.sv

+package P;
+    localparam A = 4;
+endpackage
+module top;
+    generate
+        if (1) generate
+            logic [P::A - 1:0] w;
+        endgenerate
+    endgenerate
+    generate
+        case (1)
+            1: generate
+                genvar i;
+                for (i = 0; i < 1; i += 1) generate
+                    assign y = $bits(genblk1.w);
+                endgenerate
+            endgenerate
+        endcase
+    endgenerate
+    assign z = y;
+endmodule

test/bugpoint/before.sv

+`default_nettype none
+
+package P;
+    localparam A = 4;
+    localparam B = 5;
+endpackage
+
+`default_nettype wire
+
+module top;
+    if (1) logic [P::A-1:0] w;
+    assign x = 0;
+    case (1)
+    1:
+        for (genvar i = 0; i < 1; i++)
+            assign y = $bits(genblk1.w);
+    endcase
+    assign z = y;
+endmodule
+
+module extra;
+    assign a = 0;
+endmodule

test/bugpoint/run.sh

+#!/bin/bash
+
+test_basic() {
+    out=$SHUNIT_TMPDIR/out.v
+    runAndCapture --bugpoint="y = 4" --bugpoint="z = y" \
+         --top top before.sv -w $out
+    assertTrue "bugpoint conversion should succeed" $result
+    assertNull "stdout should be empty" "$stdout"
+    assertNotNull "stderr should not be empty" "$stderr"
+
+    sed -i.bak -E 's/\t/    /g' $out
+    echo >> $out
+    diff --unified after.sv $out
+    assertTrue "minimized output doesn't match" $?
+}
+
+source ../lib/functions.sh
+
+. shunit2