Add distance to commandline

4 files changed, 87 insertions, 54 deletions

diff --git a/src/Verismith.hs b/src/Verismith.hs
index c9d3e78..9dc3475 100644
--- a/src/Verismith.hs
+++ b/src/Verismith.hs
@@ -70,6 +70,7 @@ import           Verismith.Tool
 import           Verismith.Tool.Internal
 import           Verismith.Verilog
 import           Verismith.Verilog.Parser (parseSourceInfoFile)
+import Verismith.Verilog.Distance
 import Verismith.Utils (generateByteString)
 
 toFP :: String -> FilePath
@@ -216,6 +217,11 @@ handleOpts (ConfigOpt c conf r) = do
         $   T.unpack
         .   toTextIgnore
         <$> c
+handleOpts (DistanceOpt v1 v2) = do
+  src1 <- parseSourceInfoFile (T.pack v1) (toTextIgnore v1)
+  src2 <- parseSourceInfoFile (T.pack v2) (toTextIgnore v2)
+  let d = distance src1 src2
+  putStrLn ("Distance: " <> show d)
 
 defaultMain :: IO ()
 defaultMain = do
diff --git a/src/Verismith/OptParser.hs b/src/Verismith/OptParser.hs
index 592f9e9..19eb640 100644
--- a/src/Verismith/OptParser.hs
+++ b/src/Verismith/OptParser.hs
@@ -55,6 +55,9 @@ data Opts = Fuzz { fuzzOutput          :: Text
                       , configOptConfigFile  :: !(Maybe FilePath)
                       , configOptDoRandomise :: !Bool
                       }
+          | DistanceOpt { distanceOptVerilogA :: !FilePath
+                        , distanceOptVerilogB :: !FilePath
+                        }
 
 textOption :: Mod OptionFields String -> Parser Text
 textOption = fmap T.pack . Opt.strOption
@@ -234,61 +237,63 @@ configOpts =
                    "Randomise the given default config, or the default config by randomly switchin on and off options."
             )
 
+distanceOpts :: Parser Opts
+distanceOpts =
+  DistanceOpt
+  <$> (fromText . T.pack <$> Opt.strArgument
+        (Opt.metavar "FILE" <> Opt.help "First verilog file."))
+  <*> (fromText . T.pack <$> Opt.strArgument
+        (Opt.metavar "FILE" <> Opt.help "Second verilog file."))
+
 argparse :: Parser Opts
 argparse =
     Opt.hsubparser
-            (  Opt.command
-                    "fuzz"
-                    (Opt.info
-                        fuzzOpts
-                        (Opt.progDesc
-                            "Run fuzzing on the specified simulators and synthesisers."
-                        )
-                    )
-            <> Opt.metavar "fuzz"
-            )
+            (Opt.command
+              "fuzz"
+              (Opt.info
+                fuzzOpts
+                (Opt.progDesc
+                  "Run fuzzing on the specified simulators and synthesisers."))
+              <> Opt.metavar "fuzz")
         <|> Opt.hsubparser
-                (  Opt.command
-                        "generate"
-                        (Opt.info
-                            genOpts
-                            (Opt.progDesc "Generate a random Verilog program.")
-                        )
-                <> Opt.metavar "generate"
-                )
+                (Opt.command
+                  "generate"
+                  (Opt.info
+                    genOpts
+                    (Opt.progDesc "Generate a random Verilog program."))
+                  <> Opt.metavar "generate")
         <|> Opt.hsubparser
-                (  Opt.command
+                (Opt.command
                         "parse"
                         (Opt.info
-                            parseOpts
-                            (Opt.progDesc
-                                "Parse a verilog file and output a pretty printed version."
-                            )
-                        )
-                <> Opt.metavar "parse"
-                )
+                          parseOpts
+                          (Opt.progDesc
+                            "Parse a verilog file and output a pretty printed version."))
+                  <> Opt.metavar "parse")
         <|> Opt.hsubparser
-                (  Opt.command
-                        "reduce"
-                        (Opt.info
-                            reduceOpts
-                            (Opt.progDesc
-                                "Reduce a Verilog file by rerunning the fuzzer on the file."
-                            )
-                        )
-                <> Opt.metavar "reduce"
-                )
+                (Opt.command
+                 "reduce"
+                  (Opt.info
+                    reduceOpts
+                    (Opt.progDesc
+                      "Reduce a Verilog file by rerunning the fuzzer on the file."))
+                  <> Opt.metavar "reduce")
         <|> Opt.hsubparser
-                (  Opt.command
-                        "config"
-                        (Opt.info
-                            configOpts
-                            (Opt.progDesc
-                                "Print the current configuration of the fuzzer."
-                            )
-                        )
-                <> Opt.metavar "config"
-                )
+                (Opt.command
+                  "config"
+                  (Opt.info
+                    configOpts
+                    (Opt.progDesc
+                      "Print the current configuration of the fuzzer."))
+                  <> Opt.metavar "config")
+         <|> Opt.hsubparser
+                (Opt.command
+                  "distance"
+                  (Opt.info
+                    distanceOpts
+                    (Opt.progDesc
+                      "Calculate the distance between two different pieces of Verilog."))
+                  <> Opt.metavar "distance")
 
 version :: Parser (a -> a)
 version = Opt.infoOption versionInfo $ mconcat
@@ -297,8 +302,7 @@ version = Opt.infoOption versionInfo $ mconcat
 opts :: ParserInfo Opts
 opts = Opt.info
     (argparse <**> Opt.helper <**> version)
-    (  Opt.fullDesc
+    (Opt.fullDesc
     <> Opt.progDesc "Fuzz different simulators and synthesisers."
     <> Opt.header
-           "Verismith - A hardware simulator and synthesiser Verilog fuzzer."
-    )
+           "Verismith - A hardware simulator and synthesiser Verilog fuzzer.")
diff --git a/src/Verismith/Verilog/Distance.hs b/src/Verismith/Verilog/Distance.hs
index 6ec9482..3559a6a 100644
--- a/src/Verismith/Verilog/Distance.hs
+++ b/src/Verismith/Verilog/Distance.hs
@@ -126,11 +126,25 @@ instance Distance PortType where
 instance Distance PortDir where
   distance = eqDistance
 
+instance Distance (Statement a) where
+  distance (TimeCtrl _ s1) s2 = 1 + distance s1 (Just s2)
+  distance (EventCtrl _ s1) s2 = 1 + distance s1 (Just s2)
+  distance (SeqBlock s1) (SeqBlock s2) = distance s1 s2
+  distance (CondStmnt _ st1 sf1) (CondStmnt _ st2 sf2) = distance st1 st2 + distance sf1 sf2
+  distance (ForLoop _ _ _ s1) (ForLoop _ _ _ s2) = distance s1 s2
+  distance (StmntAnn _ s1) s2 = distance s1 s2
+  distance (BlockAssign _) (BlockAssign _) = 0
+  distance (NonBlockAssign _) (NonBlockAssign _) = 0
+  distance (TaskEnable _) (TaskEnable _) = 0
+  distance (SysTaskEnable _) (SysTaskEnable _) = 0
+  distance (StmntCase _ _ _ _) (StmntCase _ _ _ _) = 0
+  distance _ _ = 1
+
 instance Distance (ModItem a) where
   distance (ModCA _) (ModCA _) = 0
   distance (ModInst _ _ _) (ModInst _ _ _) = 0
   distance (Initial _) (Initial _) = 0
-  distance (Always _) (Always _) = 0
+  distance (Always s1) (Always s2) = distance s1 s2
   distance (Decl _ _ _) (Decl _ _ _) = 0
   distance (ParamDecl _) (ParamDecl _) = 0
   distance (LocalParamDecl _) (LocalParamDecl _) = 0
diff --git a/test/Distance.hs b/test/Distance.hs
index 430d215..a59b401 100644
--- a/test/Distance.hs
+++ b/test/Distance.hs
@@ -3,7 +3,7 @@ module Distance
   )
 where
 
-import Hedgehog (Property)
+import Hedgehog (Property, (===))
 import qualified Hedgehog as Hog
 import qualified Hedgehog.Gen as Hog
 import qualified Hedgehog.Range as Hog
@@ -13,9 +13,18 @@ import Test.Tasty.Hedgehog
 
 distanceLess :: Property
 distanceLess = Hog.property $ do
-  x <- Hog.forAll (Hog.list (Hog.linear 0 10) Hog.alpha)
-  y <- Hog.forAll (Hog.list (Hog.linear 0 10) Hog.alpha)
+  x <- Hog.forAll (Hog.list (Hog.linear 0 15) Hog.alpha)
+  y <- Hog.forAll (Hog.list (Hog.linear 0 15) Hog.alpha)
   Hog.assert $ udistance x y <= distance x y
 
+distanceEq :: Property
+distanceEq = Hog.property $ do
+  x <- Hog.forAll (Hog.list (Hog.linear 0 15) Hog.alpha)
+  distance x x === 0
+  udistance x x === 0
+
 distanceTests :: TestTree
-distanceTests = testProperty "Unordered distance <= distance" distanceLess
+distanceTests = testGroup "Distance tests"
+  [ testProperty "Unordered distance <= distance" distanceLess
+  , testProperty "distance x x === 0" distanceEq
+  ]