Small style changes and add mutation infrastructure + bug fix

src/Verismith.hs

@@ -248,7 +248,10 @@ handleOpts (Parse f o s popts) = do
   if null warns || not s
     then pure ()
     else error "Input file does not comply strictly with the Verilog 2005 standard"
-  maybe L.putStr L.writeFile o $ V2.genSource (Just 80) popts ast
+  ast' <- case V2.resolveInsts ast of
+    Left err -> error err
+    Right x -> pure x
+  maybe L.putStr L.writeFile o $ V2.genSource (Just 80) popts ast'
 handleOpts (ShuffleOpt f t o nshuffle nrename noequiv equivdir checker) = do
   datadir <- getDataDir
   verilogSrc <- T.readFile file

src/Verismith/Config.hs

@@ -415,6 +415,7 @@ data GarbageModuleOpts = GarbageModuleOpts
     _gmoOptionalPort :: !Double,
     _gmoItems :: !NumberProbability,
     _gmoItem :: !CategoricalProbability,
+    _gmoMacro :: !Double,
     _gmoTimeScale :: !Double,
     _gmoTimeMagnitude :: !CategoricalProbability,
     _gmoCell :: !Double,
@@ -615,6 +616,7 @@ defGarbageOpts =
           _gmoOptionalPort = 0.5,
           _gmoItems = NPPoisson 0 3,
           _gmoItem = CPDiscrete [6, 2, 2, 3, 2, 1, 1, 1],
+          _gmoMacro = 0.5,
           _gmoTimeScale = 0.5,
           _gmoTimeMagnitude = uniformCP,
           _gmoCell = 0.5,
@@ -1156,6 +1158,7 @@ garbageModuleCodec =
     <*> dfield _gmoOptionalPort "port_optional"
     <*> tfield _gmoItems "items" numProbCodec
     <*> tfield _gmoItem "item" catProbCodec
+    <*> dfield _gmoMacro "macromodule"
     <*> dfield _gmoTimeScale "timescale_optional"
     <*> tfield _gmoTimeMagnitude "timescale_magnitude" catProbCodec
     <*> dfield _gmoCell "cell"

src/Verismith/Verilog2005.hs

@@ -13,7 +13,8 @@ module Verismith.Verilog2005
     NumberProbability,
     CategoricalProbability,
     Verilog2005 (..),
-    PrintingOpts (..)
+    PrintingOpts (..),
+    resolveInsts
   )
 where
 
@@ -22,3 +23,4 @@ import Verismith.Verilog2005.AST
 import Verismith.Verilog2005.Generator
 import Verismith.Verilog2005.Parser
 import Verismith.Verilog2005.PrettyPrinter
+import Verismith.Verilog2005.Utils

src/Verismith/Verilog2005/AST.hs

@@ -1,5 +1,5 @@
 -- Module      : Verismith.Verilog2005.AST
--- Description : Partial Verilog 2005 AST.
+-- Description : Verilog 2005 AST.
 -- Copyright   : (c) 2023 Quentin Corradi
 -- License     : GPL-3
 -- Maintainer  : q [dot] corradi22 [at] imperial [dot] ac [dot] uk
@@ -190,6 +190,13 @@ data Identified t = Identified {_identIdent :: !Identifier, _identData :: !t}
 instance Functor Identified where
   fmap f (Identified i x) = Identified i $ f x
 
+instance Foldable Identified where
+  foldr f acc (Identified i x) = f x acc
+
+instance Traversable Identified where
+  traverse f (Identified i x) = Identified i <$> f x
+  sequenceA (Identified i x) = Identified i <$> x
+
 showHelper :: (Int -> a -> ShowS) -> Identified a -> ShowS
 showHelper fp (Identified i x) = showString "Identified " . shows i . showChar ' ' . fp 0 x
 
@@ -420,7 +427,6 @@ data NumIdent
   | NINumber !Natural
   deriving (Show, Eq, Data, Generic)
 
--- TODO? Base and 1 can be expressed as 3, not 2 though, option delay means delay 0
 -- | Delay3
 data Delay3
   = D3Base !NumIdent
@@ -650,7 +656,7 @@ data FunctionStatement
   | FSBlock
       { _fsbHeader :: !(Maybe (Identifier, [AttrIded StdBlockDecl])),
         _fsbPar_seq :: !Bool,
-        _fsbStmt :: ![AttrFStmt]
+        _fsbBody :: ![AttrFStmt]
       }
   deriving (Show, Eq, Data, Generic)
 
@@ -696,7 +702,7 @@ data Statement
   | SBlock
       { _sbHeader :: !(Maybe (Identifier, [AttrIded StdBlockDecl])),
         _sbPar_seq :: !Bool,
-        _sbStmt :: ![AttrStmt]
+        _sbBody :: ![AttrStmt]
       }
   | SSysTaskEnable
       { _ssteIdent :: !ByteString,
@@ -1189,9 +1195,9 @@ data ModuleItem
 type GenerateBlock = Identified [Attributed ModGenBlockedItem]
 
 -- | Module block
--- TODO: remember whether the module is a module or macromodule because implementation dependent
 data ModuleBlock = ModuleBlock
   { _mbAttr :: !Attributes,
+    _mbMacro :: !Bool,
     _mbIdent :: !Identifier,
     _mbPortInter :: ![Identified [Identified (Maybe CRangeExpr)]],
     _mbBody :: ![ModuleItem],

src/Verismith/Verilog2005/Generator.hs

@@ -18,6 +18,7 @@ where
 
 import Control.Applicative (liftA2, liftA3)
 import Data.Functor.Compose
+import Data.Bifunctor (second)
 import Control.Lens hiding ((<.>))
 import Control.Monad (join, replicateM)
 import Control.Monad.Reader
@@ -79,7 +80,7 @@ attenuateNum d p =
           then NPDiscrete [(1, off)]
           else NPPoisson off $ p * d
       NPDiscrete l -> NPDiscrete $ if d == 0 then [NE.head l] else NE.map (uncurry mkdistrfor) l
-      NPLinearComb l -> NPLinearComb $ NE.map (\(p, np) -> (p, attenuateNum d np)) l
+      NPLinearComb l -> NPLinearComb $ NE.map (second $ attenuateNum d) l
   where
     mkdistrfor bw n = (bw * d ** fromIntegral n, n)
 
@@ -936,6 +937,7 @@ garbageModuleBlock ts = do
           garbageIdentified $ sampleMaybe (m _gmoPortRange) garbageCRangeExpr
     else (\i -> Identified i [Identified i Nothing]) <$> garbageIdent
   ModuleBlock <$> garbageAttributes
+    <*> sampleBernoulli (m _gmoMacro)
     <*> garbageIdent
     <*> pure header
     <*> sampleN

src/Verismith/Verilog2005/Lexer.x

@@ -25,9 +25,11 @@ import Numeric.Natural
 import GHC.Natural
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (mapMaybe)
+import Data.Bifunctor (second)
 import Text.Printf (printf)
 import Control.Monad.State.Strict
 import Control.Monad.Except
+import Control.Monad
 import Control.Exception
 import qualified Data.ByteString as SBS
 import qualified Data.ByteString.Lazy as LBS
@@ -281,7 +283,7 @@ to :: (SBS.ByteString -> Token) -> AlexAction
 to f p = mkPos p . f
 
 toa :: (SBS.ByteString -> Alex Token) -> AlexAction
-toa f p s = f s >>= mkPos p
+toa f p = f >=> mkPos p
 
 sc :: Int -> Alex ()
 sc n = modify' $ \s -> s { _asStartCode = n }
@@ -384,18 +386,16 @@ tableEdge s =
 cdcident :: AlexAction
 cdcident p s = case HashMap.lookup (SBS.tail s) cdMap of
   Just a -> a p
-  Nothing -> do
-    defs <- gets _asDefines
-    case HashMap.lookup s defs of
-      Nothing ->
-        alexError p $
-          printf "Compiler directive %s not declared nor supported, preprocess input file" $
-            show s
-      Just i ->
-        alexError p $
-          printf
-            "User defined compiler directive replacement in not implemented, %s was encountered"
-            (show s)
+  Nothing -> gets _asDefines >>= \defs -> case HashMap.lookup s defs of
+    Nothing ->
+      alexError p $
+        printf "Compiler directive %s not declared nor supported, preprocess input file" $
+          show s
+    Just i ->
+      alexError p $
+        printf
+          "User defined compiler directive replacement in not implemented, %s was encountered"
+          (show s)
 
 kwident :: SBS.ByteString -> Alex Token
 kwident s = case SBS.stripPrefix "PATHPULSE$" s of
@@ -443,11 +443,11 @@ cdMap = HashMap.fromList $
   : ("undefineall", \_ -> modify' (\s -> s { _asDefines = HashMap.empty }) >> scan)
   : ("__LINE__", \p -> mkPos p $ LitString $ packChars $ show $ _posLine p)
   : ("__FILE__", \p -> mkPos p $ LitString $ makeString $ show $ _posSource p)
-  : map (\(x, y) -> (x, \p -> y >>= mkPos p))
-    ( ("timescale", sc ts0 >> return CDTimescale)
-      : ("resetall", modify' (\s -> s { _asDefines = HashMap.empty }) >> return CDResetall)
-      -- , ("pragma", >> return CDPragma) -- TODO: Another layer of hell
-      : map (\(x, y) -> (x, return y))
+  : map (second (\y p -> y >>= mkPos p))
+    ( ("timescale", sc ts0 *> pure CDTimescale)
+      : ("resetall", modify' (\s -> s { _asDefines = HashMap.empty }) *> pure CDResetall)
+      -- , ("pragma", *> pure CDPragma) -- TODO: Another layer of hell
+      : map (second pure)
         [ ("celldefine", CDCelldefine)
         , ("default_nettype", CDDefaultnettype)
         -- , ("default_decay_time", CDUnknown)
@@ -485,7 +485,7 @@ linecompdir _ = do
   l <- scan
   f <- scan
   c <- scan
-  case l >>= \ll -> f >>= \ff -> c >>= \cc -> pure (ll, ff, cc) of
+  case (,,) <$> l <*> f <*> c of
     Nothing -> return Nothing
     Just (PosToken _ (LitDecimal l), PosToken _ (LitString s), PosToken _ (LitDecimal n))
       | n < 3 -> do
@@ -568,15 +568,15 @@ kwV1995 =
     ("default", pure KWDefault),
     ("defparam", pure KWDefparam),
     ("disable", pure KWDisable),
-    ("edge", sc edge >> pure KWEdge),
+    ("edge", sc edge *> pure KWEdge),
     ("else", pure KWElse),
     ("end", pure KWEnd),
     ("endcase", pure KWEndcase),
     ("endfunction", pure KWEndfunction),
     ("endmodule", pure KWEndmodule),
     ("endprimitive", pure KWEndprimitive),
     ("endspecify", pure KWEndspecify),
-    ("endtable", sc 0 >> pure KWEndtable),
+    ("endtable", sc 0 *> pure KWEndtable),
     ("endtask", pure KWEndtask),
     ("event", pure KWEvent),
     ("for", pure KWFor),
@@ -633,7 +633,7 @@ kwV1995 =
     ("strong1", pure KWStrong1),
     ("supply0", pure KWSupply0),
     ("supply1", pure KWSupply1),
-    ("table", sc table >> pure KWTable),
+    ("table", sc table *> pure KWTable),
     ("task", pure KWTask),
     ("time", pure KWTime),
     ("tran", pure KWTran),