From 472aedf5daeb1cb0d095a63eacf259b798f56586 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 16 Mar 2020 13:12:30 +0000 Subject: WIP changes to the AST types --- .travis.yml | 24 ++++---- src/Verismith.hs | 8 +-- src/Verismith/Circuit.hs | 2 +- src/Verismith/Circuit/Gen.hs | 8 +-- src/Verismith/Fuzz.hs | 18 +++--- src/Verismith/Generate.hs | 78 ++++++++++++------------- src/Verismith/Reduce.hs | 117 ++++++++++++++++++------------------- src/Verismith/Tool/Icarus.hs | 18 +++--- src/Verismith/Tool/Identity.hs | 2 +- src/Verismith/Tool/Internal.hs | 10 ++-- src/Verismith/Tool/Quartus.hs | 2 +- src/Verismith/Tool/QuartusLight.hs | 2 +- src/Verismith/Tool/Template.hs | 6 +- src/Verismith/Tool/Vivado.hs | 2 +- src/Verismith/Tool/XST.hs | 2 +- src/Verismith/Tool/Yosys.hs | 6 +- src/Verismith/Verilog/AST.hs | 4 +- src/Verismith/Verilog/CodeGen.hs | 30 +++++----- src/Verismith/Verilog/Internal.hs | 18 +++--- src/Verismith/Verilog/Mutate.hs | 42 ++++++------- src/Verismith/Verilog/Parser.hs | 44 +++++++------- src/Verismith/Verilog/Quote.hs | 3 +- test/Parser.hs | 2 +- 23 files changed, 224 insertions(+), 224 deletions(-) diff --git a/.travis.yml b/.travis.yml index 8b9190b..3c38a68 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,19 +1,21 @@ -language: nix # automatically runs nix-build - +language: nix git: - depth: 3 # not 1 to build commits in the queue - + depth: 3 jobs: include: - - name: "Cabal build" + - name: Cabal build env: NIX=0 - - name: "Nix build" + - name: Nix build env: NIX=1 - cache: directories: - - $HOME/.cabal - + - "$HOME/.cabal" +deploy: + provider: hackage + username: ymherklotz + password: + secure: qzJICih8GysNUBsVvtdJ8UE1HeUGWPVPpu5OkgYzPC2zJSUPWuq+OJ1xecUTomKSOzvCcaDuGyKj9hDZmHX0euPOBLYFna1wLV9q9RIOL7dKJjX7UKAfLgrUgffzHOIkvENKcG9/z2cHnyaJ1niVVzEYsUpoMnkPxveNiT4AfrFQc7ib3JaxW81+vCHW1E/BVvyBEy5etzu1QE/UYLcSzjLSHCm7QYQ/r/78ubhNwTIDW684AQZpqlUEE+3oRLJ2aPlR2N4nKvTJX6DbokNdXJnWV+kqSfjCo00z3dGPUmXMCXag/UctIg0rN72qi6leeswTdKo00C+0CL6kDjB+kStCsAsfj9AiTLZw65lL2XkKUU9iYLqAEyBQU/RAGJs/1aUMMWHw9GQOK5uGgJMrAXR5gh8FsRIn6PUDzBTZg0XtIwKkm/OF6DSrnWWv8qWvlZYyMNk2bQP0LHqsPX/aRHNY9CSryOkdBUj9MpfkJNT2SfXjQBYACWe/Nxsg2ikJQuFsFwwxGtMRB3WAZBK9XPjEWmlYjvCEaXYCug1rArQ8VSTMNSFPCz2/LEHq7cDrRve1QospooPBdo5qWN7Y4OxUnKeseQ6lS2dWfDOp3klduERSFcrDtzHfxleuK6U30D5AWTBwIEk6DwYmdpplbjxurINfXYxsrD7lmquc7Xs= + on: + tags: true before_script: if [[ $NIX -eq 0 ]]; then nix-env -i cabal-install ghc; fi - -script: ./scripts/build.sh +script: "./scripts/build.sh" diff --git a/src/Verismith.hs b/src/Verismith.hs index 76ce303..3aa6d81 100644 --- a/src/Verismith.hs +++ b/src/Verismith.hs @@ -98,7 +98,7 @@ getConfig :: Maybe FilePath -> IO Config getConfig s = maybe (return defaultConfig) parseConfigFile $ T.unpack . toTextIgnore <$> s -getGenerator :: Config -> Text -> Maybe FilePath -> IO (Gen SourceInfo) +getGenerator :: Config -> Text -> Maybe FilePath -> IO (Gen (SourceInfo ann)) getGenerator config top s = maybe (return $ proceduralSrc top config) (fmap return . parseSourceInfoFile top) $ toTextIgnore <$> s @@ -231,7 +231,7 @@ defaultMain = do optsparsed <- execParser opts handleOpts optsparsed -makeSrcInfo :: ModDecl -> SourceInfo +makeSrcInfo :: (ModDecl ann) -> (SourceInfo ann) makeSrcInfo m = SourceInfo (getIdentifier $ m ^. modId) (Verilog [m]) -- | Draw a randomly generated DAG to a dot file and compile it to a png so it @@ -280,7 +280,7 @@ onFailure t _ = do chdir ".." $ cp_r (fromText t) $ fromText (t <> "_failed") return $ Fail EmptyFail -checkEquivalence :: SourceInfo -> Text -> IO Bool +checkEquivalence :: (SourceInfo ann) -> Text -> IO Bool checkEquivalence src dir = shellyFailDir $ do mkdir_p (fromText dir) curr <- toTextIgnore <$> pwd @@ -330,6 +330,6 @@ runEquivalence seed gm t d k i = do when (i < 5 && isNothing seed) (runEquivalence seed gm t d k $ i + 1) where n = t <> "_" <> T.pack (show i) -runReduce :: SourceInfo -> IO SourceInfo +runReduce :: (SourceInfo ann) -> IO (SourceInfo ann) runReduce s = shelly $ reduce "reduce.v" (\s' -> not <$> liftIO (checkEquivalence s' "reduce")) s diff --git a/src/Verismith/Circuit.hs b/src/Verismith/Circuit.hs index 9ca1de7..cda2f4f 100644 --- a/src/Verismith/Circuit.hs +++ b/src/Verismith/Circuit.hs @@ -34,7 +34,7 @@ import Verismith.Circuit.Random import Verismith.Verilog.AST import Verismith.Verilog.Mutate -fromGraph :: Gen ModDecl +fromGraph :: Gen (ModDecl ann) fromGraph = do gr <- rDupsCirc <$> Hog.resize 100 randomDAG return diff --git a/src/Verismith/Circuit/Gen.hs b/src/Verismith/Circuit/Gen.hs index c5cb697..07b6c06 100644 --- a/src/Verismith/Circuit/Gen.hs +++ b/src/Verismith/Circuit/Gen.hs @@ -53,20 +53,20 @@ genAssignExpr g (n : ns) = BinOp wire oper <$> genAssignExpr g ns -- | Generate the continuous assignment AST for a particular node. If it does -- not have any nodes that link to it then return 'Nothing', as that means that -- the assignment will just be empty. -genContAssignAST :: Circuit -> LNode Gate -> Maybe ModItem +genContAssignAST :: Circuit -> LNode Gate -> Maybe (ModItem ann) genContAssignAST c (n, g) = ModCA . ContAssign name <$> genAssignExpr g nodes where gr = getCircuit c nodes = G.pre gr n name = frNode n -genAssignAST :: Circuit -> [ModItem] +genAssignAST :: Circuit -> [ModItem ann] genAssignAST c = catMaybes $ genContAssignAST c <$> nodes where gr = getCircuit c nodes = G.labNodes gr -genModuleDeclAST :: Circuit -> ModDecl +genModuleDeclAST :: Circuit -> (ModDecl ann) genModuleDeclAST c = ModDecl i output ports (combineAssigns yPort a) [] where i = Identifier "gen_module" @@ -75,5 +75,5 @@ genModuleDeclAST c = ModDecl i output ports (combineAssigns yPort a) [] a = genAssignAST c yPort = Port Wire False 90 "y" -generateAST :: Circuit -> Verilog +generateAST :: Circuit -> (Verilog ann) generateAST c = Verilog [genModuleDeclAST c] diff --git a/src/Verismith/Fuzz.hs b/src/Verismith/Fuzz.hs index 50d6ae7..54104b6 100644 --- a/src/Verismith/Fuzz.hs +++ b/src/Verismith/Fuzz.hs @@ -205,7 +205,7 @@ timeit a = do end <- liftIO getCurrentTime return (diffUTCTime end start, result) -synthesis :: (MonadBaseControl IO m, MonadSh m) => SourceInfo -> Fuzz m () +synthesis :: (MonadBaseControl IO m, MonadSh m) => (SourceInfo ann) -> Fuzz m () synthesis src = do synth <- synthesisers resTimes <- liftSh $ mapM exec synth @@ -267,7 +267,7 @@ toolRun t m = do logT $ "Finished " <> t <> " " <> showT s return s -equivalence :: (MonadBaseControl IO m, MonadSh m) => SourceInfo -> Fuzz m () +equivalence :: (MonadBaseControl IO m, MonadSh m) => (SourceInfo ann) -> Fuzz m () equivalence src = do doCrossCheck <- fmap _fuzzOptsCrossCheck askOpts datadir <- fmap _fuzzDataDir askOpts @@ -303,7 +303,7 @@ equivalence src = do runEquiv checker datadir a b src where dir = fromText $ "equiv_" <> toText a <> "_" <> toText b -simulation :: (MonadIO m, MonadSh m) => SourceInfo -> Fuzz m () +simulation :: (MonadIO m, MonadSh m) => (SourceInfo ann) -> Fuzz m () simulation src = do datadir <- fmap _fuzzDataDir askOpts synth <- passedSynthesis @@ -378,7 +378,7 @@ passEquiv = filter withIdentity . _fuzzSynthResults <$> get withIdentity _ = False -- | Always reduces with respect to 'Identity'. -reduction :: (MonadSh m) => SourceInfo -> Fuzz m () +reduction :: (MonadSh m) => (SourceInfo ann) -> Fuzz m () reduction src = do datadir <- fmap _fuzzDataDir askOpts checker <- fmap _fuzzOptsChecker askOpts @@ -416,8 +416,8 @@ getTime = maybe 0 fst generateSample :: (MonadIO m, MonadSh m) - => Fuzz m (Seed, SourceInfo) - -> Fuzz m (Seed, SourceInfo) + => Fuzz m (Seed, (SourceInfo ann)) + -> Fuzz m (Seed, (SourceInfo ann)) generateSample f = do logT "Sampling Verilog from generator" (t, v@(s, _)) <- timeit f @@ -465,7 +465,7 @@ medianFreqs l = zip hat (return <$> l) hat = set_ <$> [1 .. length l] set_ n = if n == h then 1 else 0 -fuzz :: MonadFuzz m => Gen SourceInfo -> Fuzz m FuzzReport +fuzz :: MonadFuzz m => Gen (SourceInfo ann) -> Fuzz m FuzzReport fuzz gen = do conf <- askConfig opts <- askOpts @@ -507,7 +507,7 @@ fuzz gen = do (getTime redResult) return report -fuzzInDir :: MonadFuzz m => Gen SourceInfo -> Fuzz m FuzzReport +fuzzInDir :: MonadFuzz m => Gen (SourceInfo ann) -> Fuzz m FuzzReport fuzzInDir src = do fuzzOpts <- askOpts let fp = fromMaybe "fuzz" $ _fuzzOptsOutput fuzzOpts @@ -522,7 +522,7 @@ fuzzInDir src = do fuzzMultiple :: MonadFuzz m - => Gen SourceInfo + => Gen (SourceInfo ann) -> Fuzz m [FuzzReport] fuzzMultiple src = do fuzzOpts <- askOpts diff --git a/src/Verismith/Generate.hs b/src/Verismith/Generate.hs index c77016b..4d51d21 100644 --- a/src/Verismith/Generate.hs +++ b/src/Verismith/Generate.hs @@ -83,18 +83,18 @@ import Verismith.Verilog.Eval import Verismith.Verilog.Internal import Verismith.Verilog.Mutate -data Context = Context { _variables :: [Port] - , _parameters :: [Parameter] - , _modules :: [ModDecl] - , _nameCounter :: {-# UNPACK #-} !Int - , _stmntDepth :: {-# UNPACK #-} !Int - , _modDepth :: {-# UNPACK #-} !Int - , _determinism :: !Bool - } +data Context a = Context { _variables :: [Port] + , _parameters :: [Parameter] + , _modules :: [ModDecl a] + , _nameCounter :: {-# UNPACK #-} !Int + , _stmntDepth :: {-# UNPACK #-} !Int + , _modDepth :: {-# UNPACK #-} !Int + , _determinism :: !Bool + } makeLenses ''Context -type StateGen = ReaderT Config (GenT (State Context)) +type StateGen a = ReaderT Config (GenT (State (Context a))) toId :: Int -> Identifier toId = Identifier . ("w" <>) . T.pack . show @@ -107,7 +107,7 @@ toPort ident = do sumSize :: [Port] -> Range sumSize ps = sum $ ps ^.. traverse . portSize -random :: (MonadGen m) => [Port] -> (Expr -> ContAssign) -> m ModItem +random :: (MonadGen m) => [Port] -> (Expr -> ContAssign) -> m (ModItem ann) random ctx fun = do expr <- Hog.sized (exprWithContext (ProbExpr 1 1 0 1 1 1 1 0 1 1) [] ctx) return . ModCA $ fun expr @@ -115,12 +115,12 @@ random ctx fun = do --randomAssigns :: [Identifier] -> [Gen ModItem] --randomAssigns ids = random ids . ContAssign <$> ids -randomOrdAssigns :: (MonadGen m) => [Port] -> [Port] -> [m ModItem] +randomOrdAssigns :: (MonadGen m) => [Port] -> [Port] -> [m (ModItem ann)] randomOrdAssigns inp ids = snd $ foldr generate (inp, []) ids where generate cid (i, o) = (cid : i, random i (ContAssign (_portName cid)) : o) -randomMod :: (MonadGen m) => Int -> Int -> m ModDecl +randomMod :: (MonadGen m) => Int -> Int -> m (ModDecl ann) randomMod inps total = do ident <- sequence $ toPort <$> ids x <- sequence $ randomOrdAssigns (start ident) (end ident) @@ -148,7 +148,7 @@ probability :: Config -> Probability probability c = c ^. configProbability -- | Gets the current probabilities from the 'State'. -askProbability :: StateGen Probability +askProbability :: StateGen ann Probability askProbability = asks probability -- | Generates a random large number, which can also be negative. @@ -301,21 +301,21 @@ exprWithContext prob ps l n -- | Runs a 'StateGen' for a random number of times, limited by an 'Int' that is -- passed to it. -someI :: Int -> StateGen a -> StateGen [a] +someI :: Int -> StateGen ann a -> StateGen ann [a] someI m f = do amount <- Hog.int (Hog.linear 1 m) replicateM amount f -- | Make a new name with a prefix and the current nameCounter. The nameCounter -- is then increased so that the label is unique. -makeIdentifier :: Text -> StateGen Identifier +makeIdentifier :: Text -> StateGen ann Identifier makeIdentifier prefix = do context <- get let ident = Identifier $ prefix <> showT (context ^. nameCounter) nameCounter += 1 return ident -getPort' :: PortType -> Identifier -> [Port] -> StateGen Port +getPort' :: PortType -> Identifier -> [Port] -> StateGen ann Port getPort' pt i c = case filter portId c of x : _ -> return x [] -> newPort i pt @@ -326,7 +326,7 @@ getPort' pt i c = case filter portId c of -- 'newPort'. This is used subsequently in all the functions to create a port, -- in case a port with the same name was already created. This could be because -- the generation is currently in the other branch of an if-statement. -nextPort :: Maybe Text -> PortType -> StateGen Port +nextPort :: Maybe Text -> PortType -> StateGen ann Port nextPort i pt = do context <- get ident <- makeIdentifier $ fromMaybe (T.toLower $ showT pt) i @@ -334,14 +334,14 @@ nextPort i pt = do -- | Creates a new port based on the current name counter and adds it to the -- current context. -newPort :: Identifier -> PortType -> StateGen Port +newPort :: Identifier -> PortType -> StateGen ann Port newPort ident pt = do p <- Port pt <$> Hog.bool <*> range <*> pure ident variables %= (p :) return p -- | Generates an expression from variables that are currently in scope. -scopedExpr :: StateGen Expr +scopedExpr :: StateGen ann Expr scopedExpr = do context <- get prob <- askProbability @@ -351,21 +351,21 @@ scopedExpr = do -- | Generates a random continuous assignment and assigns it to a random wire -- that is created. -contAssign :: StateGen ContAssign +contAssign :: StateGen ann ContAssign contAssign = do expr <- scopedExpr p <- nextPort Nothing Wire return $ ContAssign (p ^. portName) expr -- | Generate a random assignment and assign it to a random 'Reg'. -assignment :: StateGen Assign +assignment :: StateGen ann Assign assignment = do expr <- scopedExpr lval <- lvalFromPort <$> nextPort Nothing Reg return $ Assign lval Nothing expr -- | Generate a random 'Statement' safely, by also increasing the depth counter. -seqBlock :: StateGen Statement +seqBlock :: StateGen ann (Statement ann) seqBlock = do stmntDepth -= 1 tstat <- SeqBlock <$> someI 20 statement @@ -376,7 +376,7 @@ seqBlock = do -- branches so that port names can be reused. This is safe because if a 'Port' -- is not reused, it is left at 0, as all the 'Reg' are initialised to 0 at the -- start. -conditional :: StateGen Statement +conditional :: StateGen ann (Statement ann) conditional = do expr <- scopedExpr nc <- _nameCounter <$> get @@ -390,7 +390,7 @@ conditional = do -- | Generate a random for loop by creating a new variable name for the counter -- and then generating random statements in the body. -forLoop :: StateGen Statement +forLoop :: StateGen ann (Statement ann) forLoop = do num <- Hog.int (Hog.linear 0 20) var <- lvalFromPort <$> nextPort (Just "forvar") Reg @@ -401,7 +401,7 @@ forLoop = do where varId v = Id (v ^. regId) -- | Choose a 'Statement' to generate. -statement :: StateGen Statement +statement :: StateGen ann (Statement ann) statement = do prob <- askProbability cont <- get @@ -415,7 +415,7 @@ statement = do where onDepth c n = if c ^. stmntDepth > 0 then n else 0 -- | Generate a sequential always block which is dependent on the clock. -alwaysSeq :: StateGen ModItem +alwaysSeq :: StateGen ann (ModItem ann) alwaysSeq = Always . EventCtrl (EPosEdge "clk") . Just <$> seqBlock -- | Should resize a port that connects to a module port if the latter is @@ -436,7 +436,7 @@ resizePort ps i ra = foldl' func [] -- counted and is assumed to be there, this should be made nicer by filtering -- out the clock instead. I think that in general there should be a special -- representation for the clock. -instantiate :: ModDecl -> StateGen ModItem +instantiate :: (ModDecl ann) -> StateGen ann (ModItem ann) instantiate (ModDecl i outP inP _ _) = do context <- get outs <- replicateM (length outP) (nextPort Nothing Wire) @@ -480,7 +480,7 @@ instantiate (ModDecl i outP inP _ _) = do -- -- Another different way to handle this would be to have a probability of taking -- a module from a context or generating a new one. -modInst :: StateGen ModItem +modInst :: StateGen ann (ModItem ann) modInst = do prob <- ask context <- get @@ -505,7 +505,7 @@ modInst = do else Hog.element (context ^. modules) >>= instantiate -- | Generate a random module item. -modItem :: StateGen ModItem +modItem :: StateGen ann (ModItem ann) modItem = do conf <- ask let prob = conf ^. configProbability @@ -523,12 +523,12 @@ modItem = do -- | Either return the 'Identifier' that was passed to it, or generate a new -- 'Identifier' based on the current 'nameCounter'. -moduleName :: Maybe Identifier -> StateGen Identifier +moduleName :: Maybe Identifier -> StateGen ann Identifier moduleName (Just t) = return t moduleName Nothing = makeIdentifier "module" -- | Generate a random 'ConstExpr' by using the current context of 'Parameters'. -constExpr :: StateGen ConstExpr +constExpr :: StateGen ann ConstExpr constExpr = do prob <- askProbability context <- get @@ -538,7 +538,7 @@ constExpr = do -- | Generate a random 'Parameter' and assign it to a constant expression which -- it will be initialised to. The assumption is that this constant expression -- should always be able to be evaluated with the current context of parameters. -parameter :: StateGen Parameter +parameter :: StateGen ann Parameter parameter = do ident <- makeIdentifier "param" cexpr <- constExpr @@ -566,7 +566,7 @@ identElem p = elem (p ^. portName) . toListOf (traverse . portName) -- is set to @y@. The size of @y@ is the total combination of all the locally -- defined wires, so that it correctly reflects the internal state of the -- module. -moduleDef :: Maybe Identifier -> StateGen ModDecl +moduleDef :: Maybe Identifier -> StateGen ann (ModDecl ann) moduleDef top = do name <- moduleName top portList <- Hog.list (Hog.linear 4 10) $ nextPort Nothing Wire @@ -594,7 +594,7 @@ moduleDef top = do -- | Procedural generation method for random Verilog. Uses internal 'Reader' and -- 'State' to keep track of the current Verilog code structure. -procedural :: Text -> Config -> Gen Verilog +procedural :: Text -> Config -> Gen (Verilog ann) procedural top config = do (mainMod, st) <- Hog.resize num $ runStateT (Hog.distributeT (runReaderT (moduleDef (Just $ Identifier top)) config)) @@ -609,14 +609,14 @@ procedural top config = do -- | Samples the 'Gen' directly to generate random 'Verilog' using the 'Text' as -- the name of the main module and the configuration 'Config' to influence the -- generation. -proceduralIO :: Text -> Config -> IO Verilog +proceduralIO :: Text -> Config -> IO (Verilog a) proceduralIO t = Hog.sample . procedural t --- | Given a 'Text' and a 'Config' will generate a 'SourceInfo' which has the +-- | Given a 'Text' and a 'Config' will generate a '(SourceInfo ann)' which has the -- top module set to the right name. -proceduralSrc :: Text -> Config -> Gen SourceInfo +proceduralSrc :: Text -> Config -> Gen (SourceInfo ann) proceduralSrc t c = SourceInfo t <$> procedural t c --- | Sampled and wrapped into a 'SourceInfo' with the given top module name. -proceduralSrcIO :: Text -> Config -> IO SourceInfo +-- | Sampled and wrapped into a '(SourceInfo ann)' with the given top module name. +proceduralSrcIO :: Text -> Config -> IO (SourceInfo ann) proceduralSrcIO t c = SourceInfo t <$> proceduralIO t c diff --git a/src/Verismith/Reduce.hs b/src/Verismith/Reduce.hs index d16ac8b..1ee36a6 100644 --- a/src/Verismith/Reduce.hs +++ b/src/Verismith/Reduce.hs @@ -133,7 +133,7 @@ halveNonEmpty l = case NonEmpty.splitAt (length l `div` 2) l of -- | When given a Lens and a function that works on a lower replacement, it will -- go down, apply the replacement, and return a replacement of the original -- module. -combine :: Lens' a b -> Replace b -> Replace a +combine :: Functor f => ((b -> f b) -> a -> f a) -> Replace b -> Replace a combine l f i = modify <$> f (i ^. l) where modify res = i & l .~ res -- | Deletes Id 'Expr' if they are not part of the current scope, and replaces @@ -148,13 +148,13 @@ filterExpr _ e = e -- | Checks if a declaration is part of the current scope. If not, it returns -- 'False', otherwise 'True', as it should be kept. ---filterDecl :: [Identifier] -> ModItem -> Bool +--filterDecl :: [Identifier] -> (ModItem ann) -> Bool --filterDecl ids (Decl Nothing (Port _ _ _ i) _) = i `elem` ids --filterDecl _ _ = True -- | Checks if a continuous assignment is in the current scope, if not, it -- returns 'False'. -filterAssigns :: [Port] -> ModItem -> Bool +filterAssigns :: [Port] -> (ModItem ann) -> Bool filterAssigns out (ModCA (ContAssign i _)) = elem i $ out ^.. traverse . portName filterAssigns _ _ = True @@ -167,7 +167,7 @@ takeReplace (Single a) = a takeReplace (Dual a _) = a takeReplace None = mempty -removeConstInConcat :: Replace SourceInfo +removeConstInConcat :: Replace (SourceInfo ann) removeConstInConcat = Single . mutExpr replace where replace :: Expr -> Expr @@ -177,18 +177,18 @@ removeConstInConcat = Single . mutExpr replace notConstant (Number _) = False notConstant _ = True -cleanUndefined :: [Identifier] -> [ModItem] -> [ModItem] +cleanUndefined :: [Identifier] -> [ModItem ann] -> [ModItem ann] cleanUndefined ids mis = clean usedWires mis where usedWires = mis ^.. traverse . modContAssign . contAssignNetLVal <> ids -halveModAssign :: Replace ModDecl +halveModAssign :: Replace (ModDecl ann) halveModAssign m = cleanMod m $ modify <$> assigns (m ^. modItems) where assigns = halve . filter (filterAssigns $ m ^. modOutPorts) modify l = m & modItems .~ l -cleanMod :: ModDecl -> Replacement ModDecl -> Replacement ModDecl +cleanMod :: (ModDecl ann) -> Replacement (ModDecl ann) -> Replacement (ModDecl ann) cleanMod m newm = modify . change <$> newm where mis = m ^. modItems @@ -208,12 +208,12 @@ halveIndExpr (UnOp _ e ) = Single e halveIndExpr (Appl _ e ) = Single e halveIndExpr e = Single e -halveModExpr :: Replace ModItem +halveModExpr :: Replace (ModItem ann) halveModExpr (ModCA ca) = ModCA <$> combine contAssignExpr halveIndExpr ca halveModExpr a = Single a -- | Remove all the undefined mod instances. -cleanModInst :: SourceInfo -> SourceInfo +cleanModInst :: (SourceInfo ann) -> (SourceInfo ann) cleanModInst srcInfo = srcInfo & infoSrc . _Wrapped .~ cleaned where validInst = srcInfo ^.. infoSrc . _Wrapped . traverse . modId @@ -221,32 +221,32 @@ cleanModInst srcInfo = srcInfo & infoSrc . _Wrapped .~ cleaned -- | Clean all the undefined module instances in a specific module using a -- context. -cleanModInst' :: [Identifier] -> ModDecl -> ModDecl +cleanModInst' :: [Identifier] -> (ModDecl ann) -> (ModDecl ann) cleanModInst' ids m = m & modItems .~ newModItem where newModItem = filter (validModInst ids) $ m ^.. modItems . traverse -- | Check if a mod instance is in the current context. -validModInst :: [Identifier] -> ModItem -> Bool +validModInst :: [Identifier] -> (ModItem ann) -> Bool validModInst ids (ModInst i _ _) = i `elem` ids validModInst _ _ = True --- | Adds a 'ModDecl' to a 'SourceInfo'. -addMod :: ModDecl -> SourceInfo -> SourceInfo +-- | Adds a '(ModDecl ann)' to a '(SourceInfo ann)'. +addMod :: (ModDecl ann) -> (SourceInfo ann) -> (SourceInfo ann) addMod m srcInfo = srcInfo & infoSrc . _Wrapped %~ (m :) -- | Split a module declaration in half by trying to remove assign -- statements. This is only done in the main module of the source. -halveAssigns :: Replace SourceInfo +halveAssigns :: Replace (SourceInfo ann) halveAssigns = combine mainModule halveModAssign -- | Checks if a module item is needed in the module declaration. -relevantModItem :: ModDecl -> ModItem -> Bool +relevantModItem :: (ModDecl ann) -> (ModItem ann) -> Bool relevantModItem (ModDecl _ out _ _ _) (ModCA (ContAssign i _)) = i `elem` fmap _portName out relevantModItem _ Decl{} = True relevantModItem _ _ = False -isAssign :: Statement -> Bool +isAssign :: (Statement ann) -> Bool isAssign (BlockAssign _) = True isAssign (NonBlockAssign _) = True isAssign _ = False @@ -289,10 +289,10 @@ portToId (Port _ _ _ i) = i paramToId :: Parameter -> Identifier paramToId (Parameter i _) = i -isModule :: Identifier -> ModDecl -> Bool +isModule :: Identifier -> (ModDecl ann) -> Bool isModule i (ModDecl n _ _ _ _) = i == n -modInstActive :: [ModDecl] -> ModItem -> [Identifier] +modInstActive :: [(ModDecl ann)] -> (ModItem ann) -> [Identifier] modInstActive decl (ModInst n _ i) = case m of Nothing -> [] Just m' -> concat $ calcActive m' <$> zip i [0 ..] @@ -305,7 +305,7 @@ modInstActive decl (ModInst n _ i) = case m of | otherwise = [] modInstActive _ _ = [] -fixModInst :: SourceInfo -> ModItem -> ModItem +fixModInst :: (SourceInfo ann) -> (ModItem ann) -> (ModItem ann) fixModInst (SourceInfo _ (Verilog decl)) (ModInst n g i) = case m of Nothing -> error "Moditem not found" Just m' -> ModInst n g . mapMaybe (fixModInst' m') $ zip i [0 ..] @@ -319,7 +319,7 @@ fixModInst (SourceInfo _ (Verilog decl)) (ModInst n g i) = case m of | otherwise = Nothing fixModInst _ a = a -findActiveWires :: Identifier -> SourceInfo -> [Identifier] +findActiveWires :: Identifier -> (SourceInfo ann) -> [Identifier] findActiveWires t src = nub $ assignWires @@ -343,19 +343,19 @@ findActiveWires t src = m@(ModDecl _ o i _ p) = src ^. aModule t -- | Clean a specific module. Have to be carful that the module is in the --- 'SourceInfo', otherwise it will crash. -cleanSourceInfo :: Identifier -> SourceInfo -> SourceInfo +-- '(SourceInfo ann)', otherwise it will crash. +cleanSourceInfo :: Identifier -> (SourceInfo ann) -> (SourceInfo ann) cleanSourceInfo t src = src & aModule t %~ clean (findActiveWires t src) -cleanSourceInfoAll :: SourceInfo -> SourceInfo +cleanSourceInfoAll :: (SourceInfo ann) -> (SourceInfo ann) cleanSourceInfoAll src = foldr cleanSourceInfo src allMods where allMods = src ^.. infoSrc . _Wrapped . traverse . modId -- | Returns true if the text matches the name of a module. -matchesModName :: Identifier -> ModDecl -> Bool +matchesModName :: Identifier -> (ModDecl ann) -> Bool matchesModName top (ModDecl i _ _ _ _) = top == i -halveStatement :: Replace Statement +halveStatement :: Replace (Statement ann) halveStatement (SeqBlock [s]) = halveStatement s halveStatement (SeqBlock s) = SeqBlock <$> halve s halveStatement (CondStmnt _ (Just s1) (Just s2)) = Dual s1 s2 @@ -365,14 +365,14 @@ halveStatement (EventCtrl e (Just s)) = EventCtrl e . Just <$> halveStatement s halveStatement (TimeCtrl e (Just s)) = TimeCtrl e . Just <$> halveStatement s halveStatement a = Single a -halveAlways :: Replace ModItem +halveAlways :: Replace (ModItem ann) halveAlways (Always s) = Always <$> halveStatement s halveAlways a = Single a -- | Removes half the modules randomly, until it reaches a minimal amount of -- modules. This is done by doing a binary search on the list of modules and -- removing the instantiations from the main module body. -halveModules :: Replace SourceInfo +halveModules :: Replace (SourceInfo ann) halveModules srcInfo@(SourceInfo top _) = cleanSourceInfoAll . cleanModInst @@ -382,14 +382,14 @@ halveModules srcInfo@(SourceInfo top _) = repl = halve . filter (not . matchesModName (Identifier top)) main = srcInfo ^. mainModule -moduleBot :: SourceInfo -> Bool +moduleBot :: (SourceInfo ann) -> Bool moduleBot (SourceInfo _ (Verilog [] )) = True moduleBot (SourceInfo _ (Verilog [_])) = True moduleBot (SourceInfo _ (Verilog _ )) = False -- | Reducer for module items. It does a binary search on all the module items, -- except assignments to outputs and input-output declarations. -halveModItems :: Identifier -> Replace SourceInfo +halveModItems :: Identifier -> Replace (SourceInfo ann) halveModItems t srcInfo = cleanSourceInfo t . addRelevant <$> src where repl = halve . filter (not . relevantModItem main) @@ -398,7 +398,7 @@ halveModItems t srcInfo = cleanSourceInfo t . addRelevant <$> src src = combine (aModule t . modItems) repl srcInfo addRelevant = aModule t . modItems %~ (relevant ++) -modItemBot :: Identifier -> SourceInfo -> Bool +modItemBot :: Identifier -> (SourceInfo ann) -> Bool modItemBot t srcInfo | length modItemsNoDecl > 2 = False | otherwise = True where @@ -407,18 +407,15 @@ modItemBot t srcInfo | length modItemsNoDecl > 2 = False noDecl Decl{} = False noDecl _ = True -halveStatements :: Identifier -> Replace SourceInfo +halveStatements :: Identifier -> Replace (SourceInfo ann) halveStatements t m = cleanSourceInfo t <$> combine (aModule t . modItems) halves m where halves = traverse halveAlways -- | Reduce expressions by splitting them in half and keeping the half that -- succeeds. -halveExpr :: Identifier -> Replace SourceInfo -halveExpr t = combine contexpr $ traverse halveModExpr - where - contexpr :: Lens' SourceInfo [ModItem] - contexpr = aModule t . modItems +halveExpr :: Identifier -> Replace (SourceInfo ann) +halveExpr t = combine (aModule t . modItems) $ traverse halveModExpr toIds :: [Expr] -> [Identifier] toIds = nub . mapMaybe exprId . concatMap universe @@ -429,7 +426,7 @@ toIdsConst = toIds . fmap constToExpr toIdsEvent :: [Event] -> [Identifier] toIdsEvent = nub . mapMaybe eventId . concatMap universe -allStatIds' :: Statement -> [Identifier] +allStatIds' :: (Statement ann) -> [Identifier] allStatIds' s = nub $ assignIds <> otherExpr <> eventProcessedIds where assignIds = @@ -441,13 +438,13 @@ allStatIds' s = nub $ assignIds <> otherExpr <> eventProcessedIds otherExpr = toIds $ (s ^.. forExpr) <> (s ^.. stmntCondExpr) eventProcessedIds = toIdsEvent $ s ^.. statEvent -allStatIds :: Statement -> [Identifier] +allStatIds :: (Statement ann) -> [Identifier] allStatIds s = nub . concat $ allStatIds' <$> universe s fromRange :: Range -> [ConstExpr] fromRange r = [rangeMSB r, rangeLSB r] -allExprIds :: ModDecl -> [Identifier] +allExprIds :: (ModDecl ann) -> [Identifier] allExprIds m = nub $ contAssignIds @@ -486,7 +483,7 @@ allExprIds m = . localParamValue ) -isUsedDecl :: [Identifier] -> ModItem -> Bool +isUsedDecl :: [Identifier] -> (ModItem ann) -> Bool isUsedDecl ids (Decl _ (Port _ _ _ i) _) = i `elem` ids isUsedDecl _ _ = True @@ -496,7 +493,7 @@ isUsedParam ids (Parameter i _) = i `elem` ids isUsedPort :: [Identifier] -> Port -> Bool isUsedPort ids (Port _ _ _ i) = i `elem` ids -removeDecl :: SourceInfo -> SourceInfo +removeDecl :: (SourceInfo ann) -> (SourceInfo ann) removeDecl src = foldr fix removed allMods where removeDecl' t src' = @@ -511,19 +508,19 @@ removeDecl src = foldr fix removed allMods fix t a = a & aModule t . modItems %~ fmap (fixModInst a) removed = foldr removeDecl' src allMods -defaultBot :: SourceInfo -> Bool +defaultBot :: (SourceInfo ann) -> Bool defaultBot = const False -- | Reduction using custom reduction strategies. reduce_ - :: MonadSh m + :: (MonadSh m, Eq ann) => Shelly.FilePath -> Text - -> Replace SourceInfo - -> (SourceInfo -> Bool) - -> (SourceInfo -> m Bool) - -> SourceInfo - -> m SourceInfo + -> Replace (SourceInfo ann) + -> ((SourceInfo ann) -> Bool) + -> ((SourceInfo ann) -> m Bool) + -> (SourceInfo ann) + -> m (SourceInfo ann) reduce_ out title repl bot eval src = do writefile out $ genSource src liftSh @@ -563,11 +560,11 @@ reduce_ out title repl bot eval src = do -- | Reduce an input to a minimal representation. It follows the reduction -- strategy mentioned above. reduce - :: MonadSh m + :: (MonadSh m, Eq ann) => Shelly.FilePath -- ^ Filepath for temporary file. - -> (SourceInfo -> m Bool) -- ^ Failed or not. - -> SourceInfo -- ^ Input verilog source to be reduced. - -> m SourceInfo -- ^ Reduced output. + -> ((SourceInfo ann) -> m Bool) -- ^ Failed or not. + -> (SourceInfo ann) -- ^ Input verilog source to be reduced. + -> m (SourceInfo ann) -- ^ Reduced output. reduce fp eval src = fmap removeDecl $ red "Modules" moduleBot halveModules src @@ -585,7 +582,7 @@ reduce fp eval src = (src' ^.. infoSrc . _Wrapped . traverse . modId) runScript - :: MonadSh m => Shelly.FilePath -> Shelly.FilePath -> SourceInfo -> m Bool + :: (MonadSh m, Eq ann) => Shelly.FilePath -> Shelly.FilePath -> (SourceInfo ann) -> m Bool runScript fp file src = do e <- liftSh $ do Shelly.writefile file $ genSource src @@ -602,18 +599,18 @@ reduceWithScript -> m () reduceWithScript top script file = do liftSh . Shelly.cp file $ file <.> "original" - srcInfo <- liftIO . parseSourceInfoFile top $ Shelly.toTextIgnore file + (srcInfo :: SourceInfo ()) <- liftIO . parseSourceInfoFile top $ Shelly.toTextIgnore file void $ reduce (fromText "reduce_script.v") (runScript script file) srcInfo --- | Reduce a 'SourceInfo' using two 'Synthesiser' that are passed to it. +-- | Reduce a '(SourceInfo ann)' using two 'Synthesiser' that are passed to it. reduceSynth - :: (Synthesiser a, Synthesiser b, MonadSh m) + :: (Synthesiser a, Synthesiser b, MonadSh m, Eq ann) => Maybe Text -> Shelly.FilePath -> a -> b - -> SourceInfo - -> m SourceInfo + -> (SourceInfo ann) + -> m (SourceInfo ann) reduceSynth mt datadir a b = reduce (fromText $ "reduce_" <> toText a <> "_" <> toText b <> ".v") synth where synth src' = liftSh $ do @@ -625,7 +622,7 @@ reduceSynth mt datadir a b = reduce (fromText $ "reduce_" <> toText a <> "_" <> Fail (EquivFail _) -> True _ -> False -reduceSynthesis :: (Synthesiser a, MonadSh m) => a -> SourceInfo -> m SourceInfo +reduceSynthesis :: (Synthesiser a, MonadSh m, Eq ann) => a -> (SourceInfo ann) -> m (SourceInfo ann) reduceSynthesis a = reduce (fromText $ "reduce_" <> toText a <> ".v") synth where synth src = liftSh $ do @@ -642,7 +639,7 @@ runInTmp a = Shelly.withTmpDir $ (\f -> do Shelly.cd dir return r) -reduceSimIc :: (Synthesiser a, MonadSh m) => Shelly.FilePath -> [ByteString] -> a -> SourceInfo -> m SourceInfo +reduceSimIc :: (Synthesiser a, MonadSh m, Eq ann) => Shelly.FilePath -> [ByteString] -> a -> (SourceInfo ann) -> m (SourceInfo ann) reduceSimIc fp bs a = reduce (fromText $ "reduce_sim_" <> toText a <> ".v") synth where synth src = liftSh . runInTmp $ do diff --git a/src/Verismith/Tool/Icarus.hs b/src/Verismith/Tool/Icarus.hs index 4eb5a70..0fb2146 100644 --- a/src/Verismith/Tool/Icarus.hs +++ b/src/Verismith/Tool/Icarus.hs @@ -71,7 +71,7 @@ instance NFData Icarus where defaultIcarus :: Icarus defaultIcarus = Icarus "iverilog" "vvp" -addDisplay :: [Statement] -> [Statement] +addDisplay :: [Statement ann] -> [Statement ann] addDisplay s = concat $ transpose [ s , replicate l $ TimeCtrl 1 Nothing @@ -79,7 +79,7 @@ addDisplay s = concat $ transpose ] where l = length s -assignFunc :: [Port] -> ByteString -> Statement +assignFunc :: [Port] -> ByteString -> Statement ann assignFunc inp bs = NonBlockAssign . Assign conc Nothing @@ -103,7 +103,7 @@ mask = T.replace "x" "0" callback :: ByteString -> Text -> ByteString callback b t = b <> convert (mask t) -runSimIcarus :: Icarus -> SourceInfo -> [ByteString] -> ResultSh ByteString +runSimIcarus :: Icarus -> (SourceInfo ann) -> [ByteString] -> ResultSh ByteString runSimIcarus sim rinfo bss = do let tb = ModDecl "main" @@ -134,7 +134,7 @@ runSimIcarusWithFile sim f _ = annotate (SimFail mempty) . liftSh $ do fromBytes :: ByteString -> Integer fromBytes = B.foldl' f 0 where f a b = a `shiftL` 8 .|. fromIntegral b -tbModule :: [ByteString] -> ModDecl -> Verilog +tbModule :: [ByteString] -> (ModDecl ann) -> (Verilog ann) tbModule bss top = Verilog [ instantiateMod top $ ModDecl "testbench" [] [] [ Initial @@ -154,16 +154,16 @@ tbModule bss top = where inConcat = (RegConcat . filter (/= (Id "clk")) $ (Id . fromPort <$> (top ^. modInPorts))) -counterTestBench :: CounterEg -> ModDecl -> Verilog +counterTestBench :: CounterEg -> (ModDecl ann) -> (Verilog ann) counterTestBench (CounterEg _ states) m = tbModule filtered m where filtered = convert . fold . fmap snd . filter ((/= "clk") . fst) <$> states -runSimIc' :: (Synthesiser b) => ([ByteString] -> ModDecl -> Verilog) +runSimIc' :: (Synthesiser b) => ([ByteString] -> (ModDecl ann) -> (Verilog ann)) -> FilePath -> Icarus -> b - -> SourceInfo + -> (SourceInfo ann) -> [ByteString] -> Maybe ByteString -> ResultSh ByteString @@ -198,7 +198,7 @@ runSimIc :: (Synthesiser b) => FilePath -- ^ Data directory. -> Icarus -- ^ Icarus simulator. -> b -- ^ Synthesis tool to be tested. - -> SourceInfo -- ^ Original generated program to test. + -> (SourceInfo ann) -- ^ Original generated program to test. -> [ByteString] -- ^ Test vectors to be passed as inputs to the generated Verilog. -> Maybe ByteString -- ^ What the correct output should be. If -- 'Nothing' is passed, then just return 'Pass @@ -207,5 +207,5 @@ runSimIc :: (Synthesiser b) runSimIc = runSimIc' tbModule runSimIcEC :: (Synthesiser b) => FilePath -> Icarus -> b - -> SourceInfo -> CounterEg -> Maybe ByteString -> ResultSh ByteString + -> (SourceInfo ann) -> CounterEg -> Maybe ByteString -> ResultSh ByteString runSimIcEC a b c d e = runSimIc' (const $ counterTestBench e) a b c d [] diff --git a/src/Verismith/Tool/Identity.hs b/src/Verismith/Tool/Identity.hs index 93b05d5..9e436f3 100644 --- a/src/Verismith/Tool/Identity.hs +++ b/src/Verismith/Tool/Identity.hs @@ -44,7 +44,7 @@ instance Synthesiser Identity where instance NFData Identity where rnf = rwhnf -runSynthIdentity :: Identity -> SourceInfo -> ResultSh () +runSynthIdentity :: Identity -> (SourceInfo ann) -> ResultSh () runSynthIdentity (Identity _ out) = writefile out . genSource defaultIdentity :: Identity diff --git a/src/Verismith/Tool/Internal.hs b/src/Verismith/Tool/Internal.hs index 3336729..77ec4c9 100644 --- a/src/Verismith/Tool/Internal.hs +++ b/src/Verismith/Tool/Internal.hs @@ -66,7 +66,7 @@ class Tool a where -- | Simulation type class. class Tool a => Simulator a where runSim :: a -- ^ Simulator instance - -> SourceInfo -- ^ Run information + -> SourceInfo ann -- ^ Run information -> [ByteString] -- ^ Inputs to simulate -> ResultSh ByteString -- ^ Returns the value of the hash at the output of the testbench. runSimWithFile :: a @@ -100,12 +100,12 @@ instance Monoid Failed where -- | Synthesiser type class. class Tool a => Synthesiser a where runSynth :: a -- ^ Synthesiser tool instance - -> SourceInfo -- ^ Run information + -> SourceInfo ann -- ^ Run information -> ResultSh () -- ^ does not return any values synthOutput :: a -> FilePath setSynthOutput :: a -> FilePath -> a -renameSource :: (Synthesiser a) => a -> SourceInfo -> SourceInfo +renameSource :: (Synthesiser a) => a -> SourceInfo ann -> SourceInfo ann renameSource a src = src & infoSrc . _Wrapped . traverse . modId . _Wrapped %~ (<> toText a) @@ -129,7 +129,7 @@ checkPresent fp t = do -- | Checks what modules are present in the synthesised output, as some modules -- may have been inlined. This could be improved if the parser worked properly. -checkPresentModules :: FilePath -> SourceInfo -> Sh [Text] +checkPresentModules :: FilePath -> SourceInfo ann -> Sh [Text] checkPresentModules fp (SourceInfo _ src) = do vals <- forM (src ^.. _Wrapped . traverse . modId . _Wrapped) $ checkPresent fp @@ -146,7 +146,7 @@ replace fp t1 t2 = do -- course, so instead this just searches and replaces all the module names. This -- should find all the instantiations and definitions. This could again be made -- much simpler if the parser works. -replaceMods :: FilePath -> Text -> SourceInfo -> Sh () +replaceMods :: FilePath -> Text -> SourceInfo ann -> Sh () replaceMods fp t (SourceInfo _ src) = void . forM (src ^.. _Wrapped . traverse . modId . _Wrapped) diff --git a/src/Verismith/Tool/Quartus.hs b/src/Verismith/Tool/Quartus.hs index 128ad70..fd999ee 100644 --- a/src/Verismith/Tool/Quartus.hs +++ b/src/Verismith/Tool/Quartus.hs @@ -49,7 +49,7 @@ instance NFData Quartus where defaultQuartus :: Quartus defaultQuartus = Quartus Nothing "quartus" "syn_quartus.v" -runSynthQuartus :: Quartus -> SourceInfo -> ResultSh () +runSynthQuartus :: Quartus -> (SourceInfo ann) -> ResultSh () runSynthQuartus sim (SourceInfo top src) = do dir <- liftSh pwd let ex = execute_ SynthFail dir "quartus" diff --git a/src/Verismith/Tool/QuartusLight.hs b/src/Verismith/Tool/QuartusLight.hs index 17f8570..881ef8e 100644 --- a/src/Verismith/Tool/QuartusLight.hs +++ b/src/Verismith/Tool/QuartusLight.hs @@ -49,7 +49,7 @@ instance NFData QuartusLight where defaultQuartusLight :: QuartusLight defaultQuartusLight = QuartusLight Nothing "quartus" "syn_quartus.v" -runSynthQuartusLight :: QuartusLight -> SourceInfo -> ResultSh () +runSynthQuartusLight :: QuartusLight -> (SourceInfo ann) -> ResultSh () runSynthQuartusLight sim (SourceInfo top src) = do dir <- liftSh pwd let ex = execute_ SynthFail dir "quartus" diff --git a/src/Verismith/Tool/Template.hs b/src/Verismith/Tool/Template.hs index ffa7240..ad9860c 100644 --- a/src/Verismith/Tool/Template.hs +++ b/src/Verismith/Tool/Template.hs @@ -61,7 +61,7 @@ write_verilog #{outputText a} yosysSynthConfigStd :: Synthesiser a => a -> FilePath -> Text yosysSynthConfigStd = yosysSynthConfig "synth" -yosysSatConfig :: (Synthesiser a, Synthesiser b) => a -> b -> SourceInfo -> Text +yosysSatConfig :: (Synthesiser a, Synthesiser b) => a -> b -> (SourceInfo ann) -> Text yosysSatConfig sim1 sim2 (SourceInfo top src) = [st|read_verilog #{outputText sim1} #{rename "_1" mis} read_verilog syn_#{outputText sim2}.v @@ -137,7 +137,7 @@ synth_design -part xc7k70t -top #{top} write_verilog -force #{outf} |] -sbyConfig :: (Synthesiser a, Synthesiser b) => Maybe Text -> FilePath -> a -> b -> SourceInfo -> Text +sbyConfig :: (Synthesiser a, Synthesiser b) => Maybe Text -> FilePath -> a -> b -> (SourceInfo ann) -> Text sbyConfig mt datadir sim1 sim2 (SourceInfo top _) = [st|[options] multiclock on mode prove @@ -169,7 +169,7 @@ top.v <$> deps readL = T.intercalate "\n" $ mappend "read -formal " <$> deps -icarusTestbench :: (Synthesiser a) => FilePath -> Verilog -> a -> Text +icarusTestbench :: (Synthesiser a) => FilePath -> (Verilog ann) -> a -> Text icarusTestbench datadir t synth1 = [st| `include "#{ddir}/data/cells_cmos.v" `include "#{ddir}/data/cells_cyclone_v.v" diff --git a/src/Verismith/Tool/Vivado.hs b/src/Verismith/Tool/Vivado.hs index 272311e..e3d2538 100644 --- a/src/Verismith/Tool/Vivado.hs +++ b/src/Verismith/Tool/Vivado.hs @@ -49,7 +49,7 @@ instance NFData Vivado where defaultVivado :: Vivado defaultVivado = Vivado Nothing "vivado" "syn_vivado.v" -runSynthVivado :: Vivado -> SourceInfo -> ResultSh () +runSynthVivado :: Vivado -> (SourceInfo ann) -> ResultSh () runSynthVivado sim (SourceInfo top src) = do dir <- liftSh pwd liftSh $ do diff --git a/src/Verismith/Tool/XST.hs b/src/Verismith/Tool/XST.hs index 5bc1438..4a4921c 100644 --- a/src/Verismith/Tool/XST.hs +++ b/src/Verismith/Tool/XST.hs @@ -52,7 +52,7 @@ instance NFData XST where defaultXST :: XST defaultXST = XST Nothing "xst" "syn_xst.v" -runSynthXST :: XST -> SourceInfo -> ResultSh () +runSynthXST :: XST -> (SourceInfo ann) -> ResultSh () runSynthXST sim (SourceInfo top src) = do dir <- liftSh pwd let exec n = execute_ diff --git a/src/Verismith/Tool/Yosys.hs b/src/Verismith/Tool/Yosys.hs index c87e697..3632f37 100644 --- a/src/Verismith/Tool/Yosys.hs +++ b/src/Verismith/Tool/Yosys.hs @@ -64,7 +64,7 @@ defaultYosys = Yosys Nothing "yosys" "syn_yosys.v" yosysPath :: Yosys -> FilePath yosysPath sim = maybe (S.fromText "yosys") ( S.fromText "yosys") $ yosysBin sim -runSynthYosys :: Yosys -> SourceInfo -> ResultSh () +runSynthYosys :: Yosys -> (SourceInfo ann) -> ResultSh () runSynthYosys sim (SourceInfo _ src) = do dir <- liftSh $ do dir' <- S.pwd @@ -88,7 +88,7 @@ runEquivYosys => Yosys -> a -> b - -> SourceInfo + -> (SourceInfo ann) -> ResultSh () runEquivYosys yosys sim1 sim2 srcInfo = do liftSh $ do @@ -105,7 +105,7 @@ runEquivYosys yosys sim1 sim2 srcInfo = do where checkFile = S.fromText [st|test.#{toText sim1}.#{toText sim2}.ys|] runEquiv - :: (Synthesiser a, Synthesiser b) => Maybe Text -> FilePath -> a -> b -> SourceInfo -> ResultSh () + :: (Synthesiser a, Synthesiser b) => Maybe Text -> FilePath -> a -> b -> (SourceInfo ann) -> ResultSh () runEquiv mt datadir sim1 sim2 srcInfo = do dir <- liftSh S.pwd liftSh $ do diff --git a/src/Verismith/Verilog/AST.hs b/src/Verismith/Verilog/AST.hs index 9a71022..74c3cfb 100644 --- a/src/Verismith/Verilog/AST.hs +++ b/src/Verismith/Verilog/AST.hs @@ -364,7 +364,7 @@ instance Num Range where -- cumbersome than useful, as a lot of ports can be declared without input and -- output port. -- --- This is now implemented inside 'ModDecl' itself, which uses a list of output +-- This is now implemented inside '(ModDecl ann)' itself, which uses a list of output -- and input ports. data Port = Port { _portType :: !PortType @@ -547,7 +547,7 @@ traverseModConn :: (Applicative f) => (Expr -> f Expr) -> ModConn -> f ModConn traverseModConn f (ModConn e ) = ModConn <$> f e traverseModConn f (ModConnNamed a e) = ModConnNamed a <$> f e -traverseModItem :: (Applicative f) => (Expr -> f Expr) -> ModItem a -> f (ModItem a) +traverseModItem :: (Applicative f) => (Expr -> f Expr) -> (ModItem ann) -> f (ModItem ann) traverseModItem f (ModCA (ContAssign a e)) = ModCA . ContAssign a <$> f e traverseModItem f (ModInst a b e) = ModInst a b <$> sequenceA (traverseModConn f <$> e) diff --git a/src/Verismith/Verilog/CodeGen.hs b/src/Verismith/Verilog/CodeGen.hs index 8dd8f28..f8fce80 100644 --- a/src/Verismith/Verilog/CodeGen.hs +++ b/src/Verismith/Verilog/CodeGen.hs @@ -38,17 +38,17 @@ import Verismith.Verilog.BitVec class Source a where genSource :: a -> Text --- | Map a 'Maybe Statement' to 'Text'. If it is 'Just statement', the generated +-- | Map a 'Maybe (Statement ann)' to 'Text'. If it is 'Just statement', the generated -- statements are returned. If it is 'Nothing', then @;\n@ is returned. -defMap :: Maybe Statement -> Doc a +defMap :: Maybe (Statement ann) -> Doc a defMap = maybe semi statement --- | Convert the 'Verilog' type to 'Text' so that it can be rendered. -verilogSrc :: Verilog -> Doc a +-- | Convert the 'Verilog ann' type to 'Text' so that it can be rendered. +verilogSrc :: (Verilog ann) -> Doc a verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules --- | Generate the 'ModDecl' for a module and convert it to 'Text'. -moduleDecl :: ModDecl -> Doc a +-- | Generate the 'ModDecl ann' for a module and convert it to 'Text'. +moduleDecl :: ModDecl ann -> Doc a moduleDecl (ModDecl i outP inP items ps) = vsep [ sep ["module" <+> identifier i, params ps, ports <> semi] , indent 2 modI @@ -110,8 +110,8 @@ portDir PortIn = "input" portDir PortOut = "output" portDir PortInOut = "inout" --- | Generate a 'ModItem'. -moduleItem :: ModItem -> Doc a +-- | Generate a '(ModItem ann)'. +moduleItem :: (ModItem ann) -> Doc a moduleItem (ModCA ca ) = contAssign ca moduleItem (ModInst i name conn) = (<> semi) $ hsep [ identifier i @@ -248,11 +248,11 @@ caseType CaseStandard = "case" caseType CaseX = "casex" caseType CaseZ = "casez" -casePair :: CasePair -> Doc a +casePair :: (CasePair ann) -> Doc a casePair (CasePair e s) = vsep [hsep [expr e, colon], indent 2 $ statement s] -statement :: Statement -> Doc a +statement :: Statement ann -> Doc a statement (TimeCtrl d stat) = hsep [delay d, defMap stat] statement (EventCtrl e stat) = hsep [event e, defMap stat] statement (SeqBlock s) = @@ -302,7 +302,7 @@ instance Source Identifier where instance Source Task where genSource = showT . task -instance Source Statement where +instance Source (Statement ann) where genSource = showT . statement instance Source PortType where @@ -329,7 +329,7 @@ instance Source Expr where instance Source ContAssign where genSource = showT . contAssign -instance Source ModItem where +instance Source (ModItem ann) where genSource = showT . moduleItem instance Source PortDir where @@ -338,13 +338,13 @@ instance Source PortDir where instance Source Port where genSource = showT . port -instance Source ModDecl where +instance Source (ModDecl ann) where genSource = showT . moduleDecl -instance Source Verilog where +instance Source (Verilog ann) where genSource = showT . verilogSrc -instance Source SourceInfo where +instance Source (SourceInfo ann) where genSource (SourceInfo _ src) = genSource src newtype GenVerilog a = GenVerilog { unGenVerilog :: a } diff --git a/src/Verismith/Verilog/Internal.hs b/src/Verismith/Verilog/Internal.hs index 0644d95..0ebc626 100644 --- a/src/Verismith/Verilog/Internal.hs +++ b/src/Verismith/Verilog/Internal.hs @@ -32,28 +32,28 @@ import Control.Lens import Data.Text (Text) import Verismith.Verilog.AST -regDecl :: Identifier -> ModItem +regDecl :: Identifier -> (ModItem ann) regDecl i = Decl Nothing (Port Reg False (Range 1 0) i) Nothing -wireDecl :: Identifier -> ModItem +wireDecl :: Identifier -> (ModItem ann) wireDecl i = Decl Nothing (Port Wire False (Range 1 0) i) Nothing -- | Create an empty module. -emptyMod :: ModDecl +emptyMod :: (ModDecl ann) emptyMod = ModDecl "" [] [] [] [] -- | Set a module name for a module declaration. -setModName :: Text -> ModDecl -> ModDecl +setModName :: Text -> (ModDecl ann) -> (ModDecl ann) setModName str = modId .~ Identifier str -- | Add a input port to the module declaration. -addModPort :: Port -> ModDecl -> ModDecl +addModPort :: Port -> (ModDecl ann) -> (ModDecl ann) addModPort port = modInPorts %~ (:) port -addModDecl :: ModDecl -> Verilog -> Verilog +addModDecl :: (ModDecl ann) -> (Verilog ann) -> (Verilog ann) addModDecl desc = _Wrapped %~ (:) desc -testBench :: ModDecl +testBench :: (ModDecl ann) testBench = ModDecl "main" [] @@ -71,7 +71,7 @@ testBench = ModDecl ] [] -addTestBench :: Verilog -> Verilog +addTestBench :: (Verilog ann) -> (Verilog ann) addTestBench = addModDecl testBench defaultPort :: Identifier -> Port @@ -80,7 +80,7 @@ defaultPort = Port Wire False (Range 1 0) portToExpr :: Port -> Expr portToExpr (Port _ _ _ i) = Id i -modName :: ModDecl -> Text +modName :: (ModDecl ann) -> Text modName = getIdentifier . view modId yPort :: Identifier -> Port diff --git a/src/Verismith/Verilog/Mutate.hs b/src/Verismith/Verilog/Mutate.hs index e80437f..260d759 100644 --- a/src/Verismith/Verilog/Mutate.hs +++ b/src/Verismith/Verilog/Mutate.hs @@ -106,7 +106,7 @@ instance Mutate Assign where instance Mutate ContAssign where mutExpr f (ContAssign a e) = ContAssign a $ f e -instance Mutate Statement where +instance Mutate (Statement ann) where mutExpr f (TimeCtrl d s) = TimeCtrl d $ mutExpr f <$> s mutExpr f (EventCtrl e s) = EventCtrl e $ mutExpr f <$> s mutExpr f (SeqBlock s) = SeqBlock $ mutExpr f <$> s @@ -123,7 +123,7 @@ instance Mutate Parameter where instance Mutate LocalParam where mutExpr _ = id -instance Mutate ModItem where +instance Mutate (ModItem ann) where mutExpr f (ModCA (ContAssign a e)) = ModCA . ContAssign a $ f e mutExpr f (ModInst a b conns) = ModInst a b $ mutExpr f conns mutExpr f (Initial s) = Initial $ mutExpr f s @@ -132,13 +132,13 @@ instance Mutate ModItem where mutExpr _ p@ParamDecl{} = p mutExpr _ l@LocalParamDecl{} = l -instance Mutate ModDecl where +instance Mutate (ModDecl ann) where mutExpr f (ModDecl a b c d e) = ModDecl (mutExpr f a) (mutExpr f b) (mutExpr f c) (mutExpr f d) (mutExpr f e) -instance Mutate Verilog where +instance Mutate (Verilog ann) where mutExpr f (Verilog a) = Verilog $ mutExpr f a -instance Mutate SourceInfo where +instance Mutate (SourceInfo ann) where mutExpr f (SourceInfo a b) = SourceInfo a $ mutExpr f b instance Mutate a => Mutate [a] where @@ -150,8 +150,8 @@ instance Mutate a => Mutate (Maybe a) where instance Mutate a => Mutate (GenVerilog a) where mutExpr f (GenVerilog a) = GenVerilog $ mutExpr f a --- | Return if the 'Identifier' is in a 'ModDecl'. -inPort :: Identifier -> ModDecl -> Bool +-- | Return if the 'Identifier' is in a '(ModDecl ann)'. +inPort :: Identifier -> (ModDecl ann) -> Bool inPort i m = inInput where inInput = @@ -159,7 +159,7 @@ inPort i m = inInput -- | Find the last assignment of a specific wire/reg to an expression, and -- returns that expression. -findAssign :: Identifier -> [ModItem] -> Maybe Expr +findAssign :: Identifier -> [ModItem ann] -> Maybe Expr findAssign i items = safe last . catMaybes $ isAssign <$> items where isAssign (ModCA (ContAssign val expr)) | val == i = Just expr @@ -184,7 +184,7 @@ replace = (transform .) . idTrans -- This could be improved by instead of only using the last assignment to the -- wire that one finds, to use the assignment to the wire before the current -- expression. This would require a different approach though. -nestId :: Identifier -> ModDecl -> ModDecl +nestId :: Identifier -> (ModDecl ann) -> (ModDecl ann) nestId i m | not $ inPort i m = let expr = fromMaybe def . findAssign i $ m ^. modItems @@ -196,15 +196,15 @@ nestId i m def = Id i -- | Replaces an identifier by a expression in all the module declaration. -nestSource :: Identifier -> Verilog -> Verilog +nestSource :: Identifier -> (Verilog ann) -> (Verilog ann) nestSource i src = src & getModule %~ nestId i -- | Nest variables in the format @w[0-9]*@ up to a certain number. -nestUpTo :: Int -> Verilog -> Verilog +nestUpTo :: Int -> (Verilog ann) -> (Verilog ann) nestUpTo i src = foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] -allVars :: ModDecl -> [Identifier] +allVars :: (ModDecl ann) -> [Identifier] allVars m = (m ^.. modOutPorts . traverse . portName) <> (m ^.. modInPorts . traverse . portName) @@ -226,7 +226,7 @@ allVars m = -- endmodule -- -- -instantiateMod :: ModDecl -> ModDecl -> ModDecl +instantiateMod :: (ModDecl ann) -> (ModDecl ann) -> (ModDecl ann) instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) where out = Decl Nothing <$> m ^. modOutPorts <*> pure Nothing @@ -252,7 +252,7 @@ instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) -- >>> GenVerilog $ instantiateMod_ m -- m m(y, x); -- -instantiateMod_ :: ModDecl -> ModItem +instantiateMod_ :: (ModDecl ann) -> (ModItem ann) instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns where conns = @@ -267,7 +267,7 @@ instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns -- >>> GenVerilog $ instantiateModSpec_ "_" m -- m m(.y(y), .x(x)); -- -instantiateModSpec_ :: Text -> ModDecl -> ModItem +instantiateModSpec_ :: Text -> (ModDecl ann) -> (ModItem ann) instantiateModSpec_ outChar m = ModInst (m ^. modId) (m ^. modId) conns where conns = zipWith ModConnNamed ids (Id <$> instIds) @@ -288,7 +288,7 @@ filterChar t ids = -- endmodule -- -- -initMod :: ModDecl -> ModDecl +initMod :: (ModDecl ann) -> (ModDecl ann) initMod m = m & modItems %~ ((out ++ inp) ++) where out = Decl (Just PortOut) <$> (m ^. modOutPorts) <*> pure Nothing @@ -301,7 +301,7 @@ makeIdFrom a i = (i <>) . Identifier . ("_" <>) $ showT a -- | Make top level module for equivalence verification. Also takes in how many -- modules to instantiate. -makeTop :: Int -> ModDecl -> ModDecl +makeTop :: Int -> (ModDecl ann) -> (ModDecl ann) makeTop i m = ModDecl (m ^. modId) ys (m ^. modInPorts) modIt [] where ys = yPort . flip makeIdFrom "y" <$> [1 .. i] @@ -311,7 +311,7 @@ makeTop i m = ModDecl (m ^. modId) ys (m ^. modInPorts) modIt [] -- | Make a top module with an assert that requires @y_1@ to always be equal to -- @y_2@, which can then be proven using a formal verification tool. -makeTopAssert :: ModDecl -> ModDecl +makeTopAssert :: (ModDecl ann) -> (ModDecl ann) makeTopAssert = (modItems %~ (++ [assert])) . makeTop 2 where assert = Always . EventCtrl e . Just $ SeqBlock @@ -320,7 +320,7 @@ makeTopAssert = (modItems %~ (++ [assert])) . makeTop 2 -- | Provide declarations for all the ports that are passed to it. If they are -- registers, it should assign them to 0. -declareMod :: [Port] -> ModDecl -> ModDecl +declareMod :: [Port] -> (ModDecl ann) -> (ModDecl ann) declareMod ports = initMod . (modItems %~ (fmap decl ports ++)) where decl p@(Port Reg _ _ _) = Decl Nothing p (Just 0) @@ -374,7 +374,7 @@ removeId i = transform trans | otherwise = Id ident trans e = e -combineAssigns :: Port -> [ModItem] -> [ModItem] +combineAssigns :: Port -> [ModItem ann] -> [ModItem ann] combineAssigns p a = a <> [ ModCA @@ -386,7 +386,7 @@ combineAssigns p a = ] where assigns = a ^.. traverse . modContAssign . contAssignNetLVal -combineAssigns_ :: Bool -> Port -> [Port] -> ModItem +combineAssigns_ :: Bool -> Port -> [Port] -> (ModItem ann) combineAssigns_ comb p ps = ModCA . ContAssign (p ^. portName) diff --git a/src/Verismith/Verilog/Parser.hs b/src/Verismith/Verilog/Parser.hs index a6eaf24..70dc973 100644 --- a/src/Verismith/Verilog/Parser.hs +++ b/src/Verismith/Verilog/Parser.hs @@ -283,7 +283,7 @@ strId = satisfy' matchId identifier :: Parser Identifier identifier = Identifier . T.pack <$> strId -parseNetDecl :: Maybe PortDir -> Parser ModItem +parseNetDecl :: Maybe PortDir -> Parser (ModItem ann) parseNetDecl pd = do t <- option Wire type_ sign <- option False (tok KWSigned $> True) @@ -303,10 +303,10 @@ parsePortDir = <|> tok KWInout $> PortInOut -parseDecl :: Parser ModItem +parseDecl :: Parser (ModItem ann) parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing -parseConditional :: Parser Statement +parseConditional :: Parser (Statement ann) parseConditional = do expr <- tok' KWIf *> parens parseExpr true <- maybeEmptyStatement @@ -336,7 +336,7 @@ parseAssign t = do expr <- parseExpr return $ Assign lval delay expr -parseLoop :: Parser Statement +parseLoop :: Parser (Statement ann) parseLoop = do a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq expr <- tok' SymSemi *> parseExpr @@ -373,37 +373,37 @@ parseEvent' = <|> try (fmap EId identifier) <|> try (fmap EExpr parseExpr) -parseEventCtrl :: Parser Statement +parseEventCtrl :: Parser (Statement ann) parseEventCtrl = do event <- parseEvent statement <- option Nothing maybeEmptyStatement return $ EventCtrl event statement -parseDelayCtrl :: Parser Statement +parseDelayCtrl :: Parser (Statement ann) parseDelayCtrl = do delay <- parseDelay statement <- option Nothing maybeEmptyStatement return $ TimeCtrl delay statement -parseBlocking :: Parser Statement +parseBlocking :: Parser (Statement ann) parseBlocking = do a <- parseAssign SymEq tok' SymSemi return $ BlockAssign a -parseNonBlocking :: Parser Statement +parseNonBlocking :: Parser (Statement ann) parseNonBlocking = do a <- parseAssign SymLtEq tok' SymSemi return $ NonBlockAssign a -parseSeq :: Parser Statement +parseSeq :: Parser (Statement ann) parseSeq = do seq' <- tok' KWBegin *> many parseStatement tok' KWEnd return $ SeqBlock seq' -parseStatement :: Parser Statement +parseStatement :: Parser (Statement ann) parseStatement = parseSeq <|> parseConditional @@ -413,14 +413,14 @@ parseStatement = <|> try parseBlocking <|> parseNonBlocking -maybeEmptyStatement :: Parser (Maybe Statement) +maybeEmptyStatement :: Parser (Maybe (Statement ann)) maybeEmptyStatement = (tok' SymSemi >> return Nothing) <|> (Just <$> parseStatement) -parseAlways :: Parser ModItem +parseAlways :: Parser (ModItem ann) parseAlways = tok' KWAlways *> (Always <$> parseStatement) -parseInitial :: Parser ModItem +parseInitial :: Parser (ModItem ann) parseInitial = tok' KWInitial *> (Initial <$> parseStatement) namedModConn :: Parser ModConn @@ -432,7 +432,7 @@ namedModConn = do parseModConn :: Parser ModConn parseModConn = try (fmap ModConn parseExpr) <|> namedModConn -parseModInst :: Parser ModItem +parseModInst :: Parser (ModItem ann) parseModInst = do m <- identifier name <- identifier @@ -440,7 +440,7 @@ parseModInst = do tok' SymSemi return $ ModInst m name modconns -parseModItem :: Parser ModItem +parseModItem :: Parser (ModItem ann) parseModItem = try (ModCA <$> parseContAssign) <|> try parseDecl @@ -451,11 +451,11 @@ parseModItem = parseModList :: Parser [Identifier] parseModList = list <|> return [] where list = parens $ commaSep identifier -filterDecl :: PortDir -> ModItem -> Bool +filterDecl :: PortDir -> (ModItem ann) -> Bool filterDecl p (Decl (Just p') _ _) = p == p' filterDecl _ _ = False -modPorts :: PortDir -> [ModItem] -> [Port] +modPorts :: PortDir -> [ModItem ann] -> [Port] modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort parseParam :: Parser Parameter @@ -467,7 +467,7 @@ parseParam = do parseParams :: Parser [Parameter] parseParams = tok' SymPound *> parens (commaSep parseParam) -parseModDecl :: Parser ModDecl +parseModDecl :: Parser (ModDecl ann) parseModDecl = do name <- tok KWModule *> identifier paramList <- option [] $ try parseParams @@ -483,7 +483,7 @@ parseModDecl = do -- | Parses a 'String' into 'Verilog' by skipping any beginning whitespace -- and then parsing multiple Verilog source. -parseVerilogSrc :: Parser Verilog +parseVerilogSrc :: Parser (Verilog ann) parseVerilogSrc = Verilog <$> many parseModDecl -- | Parse a 'String' containing verilog code. The parser currently only supports @@ -491,7 +491,7 @@ parseVerilogSrc = Verilog <$> many parseModDecl parseVerilog :: Text -- ^ Name of parsed object. -> Text -- ^ Content to be parsed. - -> Either Text Verilog -- ^ Returns 'String' with error + -> Either Text (Verilog ann) -- ^ Returns 'String' with error -- message if parse fails. parseVerilog s = bimap showT id @@ -500,12 +500,12 @@ parseVerilog s = . preprocess [] (T.unpack s) . T.unpack -parseVerilogFile :: Text -> IO Verilog +parseVerilogFile :: Text -> IO (Verilog ann) parseVerilogFile file = do src <- T.readFile $ T.unpack file case parseVerilog file src of Left s -> error $ T.unpack s Right r -> return r -parseSourceInfoFile :: Text -> Text -> IO SourceInfo +parseSourceInfoFile :: Text -> Text -> IO (SourceInfo ann) parseSourceInfoFile top = fmap (SourceInfo top) . parseVerilogFile diff --git a/src/Verismith/Verilog/Quote.hs b/src/Verismith/Verilog/Quote.hs index 879b8fd..5e1e5dc 100644 --- a/src/Verismith/Verilog/Quote.hs +++ b/src/Verismith/Verilog/Quote.hs @@ -23,6 +23,7 @@ import qualified Language.Haskell.TH as TH import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax import Verismith.Verilog.Parser +import Verismith.Verilog.AST (Verilog) liftDataWithText :: Data a => a -> Q Exp liftDataWithText = dataToExpQ $ fmap liftText . cast @@ -47,4 +48,4 @@ quoteVerilog s = do v <- case parseVerilog pos (T.pack s) of Right e -> return e Left e -> fail $ show e - liftDataWithText v + liftDataWithText (v :: Verilog ()) diff --git a/test/Parser.hs b/test/Parser.hs index 2de7114..2a83243 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -34,7 +34,7 @@ import Verismith.Verilog.Preprocess (uncomment) smallConfig :: Config smallConfig = defaultConfig & configProperty . propSize .~ 5 -randomMod' :: Gen ModDecl +randomMod' :: Gen (ModDecl ann) randomMod' = Hog.resize 20 (randomMod 3 10) parserInputMod :: Property -- cgit