From 76e9b994258d9af87868ba9f420db4ee1c29de67 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 13 May 2019 20:50:01 +0100 Subject: Format with brittany --- src/VeriFuzz.hs | 91 +++++++++-------- src/VeriFuzz/Config.hs | 71 ++++++------- src/VeriFuzz/Fuzz.hs | 51 +++++----- src/VeriFuzz/Reduce.hs | 215 ++++++++++++++++++++-------------------- src/VeriFuzz/Report.hs | 36 ++++--- src/VeriFuzz/Sim/Yosys.hs | 15 +-- src/VeriFuzz/Verilog/AST.hs | 24 +++-- src/VeriFuzz/Verilog/CodeGen.hs | 117 ++++++++++++---------- src/VeriFuzz/Verilog/Gen.hs | 14 ++- src/VeriFuzz/Verilog/Parser.hs | 117 ++++++++++++---------- src/VeriFuzz/Verilog/Quote.hs | 13 +-- 11 files changed, 403 insertions(+), 361 deletions(-) (limited to 'src') diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs index c448c0b..b7d46d1 100644 --- a/src/VeriFuzz.hs +++ b/src/VeriFuzz.hs @@ -180,11 +180,12 @@ reduceOpts = <> showDefault <> value "top" ) - <*> (strOption + <*> ( strOption $ long "script" <> short 's' <> metavar "SCRIPT" - <> help "Script that determines if the current file is interesting, which is determined by the script returning 0." + <> help + "Script that determines if the current file is interesting, which is determined by the script returning 0." ) configOpts :: Parser Opts @@ -204,8 +205,11 @@ configOpts = <> metavar "FILE" <> help "Config file for the current fuzz run." ) - <*> (switch $ long "randomise" <> short 'r' <> help - "Randomise the given default config, or the default config by randomly switchin on and off options." + <*> ( switch + $ long "randomise" + <> short 'r' + <> help + "Randomise the given default config, or the default config by randomly switchin on and off options." ) argparse :: Parser Opts @@ -278,7 +282,8 @@ opts = info ) getConfig :: Maybe FilePath -> IO Config -getConfig s = maybe (return defaultConfig) parseConfigFile $ T.unpack . toTextIgnore <$> s +getConfig s = + maybe (return defaultConfig) parseConfigFile $ T.unpack . toTextIgnore <$> s -- | Randomly remove an option by setting it to 0. randDelete :: Int -> IO Int @@ -288,58 +293,65 @@ randDelete i = do randomise :: Config -> IO Config randomise config@(Config a _ c d e) = do - mia <- randDelete $ cm ^. probModItemAssign + mia <- randDelete $ cm ^. probModItemAssign misa <- return $ cm ^. probModItemSeqAlways mica <- randDelete $ cm ^. probModItemCombAlways - mii <- randDelete $ cm ^. probModItemInst - ssb <- randDelete $ cs ^. probStmntBlock + mii <- randDelete $ cm ^. probModItemInst + ssb <- randDelete $ cs ^. probStmntBlock ssnb <- randDelete $ cs ^. probStmntNonBlock - ssc <- randDelete $ cs ^. probStmntCond - ssf <- randDelete $ cs ^. probStmntFor - en <- return $ ce ^. probExprNum - ei <- randDelete $ ce ^. probExprId - ers <- randDelete $ ce ^. probExprRangeSelect - euo <- randDelete $ ce ^. probExprUnOp - ebo <- randDelete $ ce ^. probExprBinOp - ec <- randDelete $ ce ^. probExprCond - eco <- randDelete $ ce ^. probExprConcat + ssc <- randDelete $ cs ^. probStmntCond + ssf <- randDelete $ cs ^. probStmntFor + en <- return $ ce ^. probExprNum + ei <- randDelete $ ce ^. probExprId + ers <- randDelete $ ce ^. probExprRangeSelect + euo <- randDelete $ ce ^. probExprUnOp + ebo <- randDelete $ ce ^. probExprBinOp + ec <- randDelete $ ce ^. probExprCond + eco <- randDelete $ ce ^. probExprConcat estr <- randDelete $ ce ^. probExprStr esgn <- randDelete $ ce ^. probExprSigned - eus <- randDelete $ ce ^. probExprUnsigned - return $ Config a (Probability - (ProbModItem mia misa mica mii) - (ProbStatement ssb ssnb ssc ssf) - (ProbExpr en ei ers euo ebo ec eco estr esgn eus)) c d e - where - cm = config ^. configProbability . probModItem - cs = config ^. configProbability . probStmnt - ce = config ^. configProbability . probExpr + eus <- randDelete $ ce ^. probExprUnsigned + return $ Config + a + (Probability (ProbModItem mia misa mica mii) + (ProbStatement ssb ssnb ssc ssf) + (ProbExpr en ei ers euo ebo ec eco estr esgn eus) + ) + c + d + e + where + cm = config ^. configProbability . probModItem + cs = config ^. configProbability . probStmnt + ce = config ^. configProbability . probExpr handleOpts :: Opts -> IO () handleOpts (Fuzz _ configF _ _ n) = do config <- getConfig configF - _ <- runFuzz config - defaultYosys - (fuzzMultiple n Nothing (proceduralSrc "top" config)) + _ <- runFuzz config + defaultYosys + (fuzzMultiple n Nothing (proceduralSrc "top" config)) return () handleOpts (Generate f c) = do config <- getConfig c source <- proceduralIO "top" config - maybe (T.putStrLn $ genSource source) - (flip T.writeFile $ genSource source) - $ T.unpack . toTextIgnore <$> f + maybe (T.putStrLn $ genSource source) (flip T.writeFile $ genSource source) + $ T.unpack + . toTextIgnore + <$> f handleOpts (Parse f) = 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 -handleOpts (Reduce f t s) = shelly $ reduceWithScript t s f +handleOpts (Reduce f t s) = shelly $ reduceWithScript t s f handleOpts (ConfigOpt c conf r) = do config <- if r then getConfig conf >>= randomise else getConfig conf - maybe (T.putStrLn . encodeConfig $ config) - (`encodeConfigFile` config) - $ T.unpack . toTextIgnore <$> c + maybe (T.putStrLn . encodeConfig $ config) (`encodeConfigFile` config) + $ T.unpack + . toTextIgnore + <$> c defaultMain :: IO () defaultMain = do @@ -415,9 +427,7 @@ checkEquivalence src dir = shellyFailDir $ do setenv "VERIFUZZ_ROOT" curr cd (fromText dir) catch_sh - ( (runResultT $ runEquiv defaultYosys defaultVivado src) - >> return True - ) + ((runResultT $ runEquiv defaultYosys defaultVivado src) >> return True) ((\_ -> return False) :: RunFailed -> Sh Bool) -- | Run a fuzz run and check if all of the simulators passed by checking if the @@ -459,4 +469,5 @@ runEquivalence seed gm t d k i = do where n = t <> "_" <> T.pack (show i) runReduce :: SourceInfo -> IO SourceInfo -runReduce s = shelly $ reduce (\s' -> not <$> liftIO (checkEquivalence s' "reduce")) s +runReduce s = + shelly $ reduce (\s' -> not <$> liftIO (checkEquivalence s' "reduce")) s diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs index 04b2d78..9295f71 100644 --- a/src/VeriFuzz/Config.hs +++ b/src/VeriFuzz/Config.hs @@ -237,48 +237,39 @@ defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional fromXST :: XST -> SynthDescription fromXST (XST a b c) = - SynthDescription - "xst" - (toTextIgnore <$> a) - (Just b) - (Just $ toTextIgnore c) + SynthDescription "xst" (toTextIgnore <$> a) (Just b) (Just $ toTextIgnore c) fromYosys :: Yosys -> SynthDescription -fromYosys (Yosys a b c) = - SynthDescription - "yosys" - (toTextIgnore <$> a) - (Just b) - (Just $ toTextIgnore c) +fromYosys (Yosys a b c) = SynthDescription "yosys" + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) fromVivado :: Vivado -> SynthDescription -fromVivado (Vivado a b c) = - SynthDescription - "vivado" - (toTextIgnore <$> a) - (Just b) - (Just $ toTextIgnore c) +fromVivado (Vivado a b c) = SynthDescription "vivado" + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) fromQuartus :: Quartus -> SynthDescription -fromQuartus (Quartus a b c) = - SynthDescription - "quartus" - (toTextIgnore <$> a) - (Just b) - (Just $ toTextIgnore c) +fromQuartus (Quartus a b c) = SynthDescription "quartus" + (toTextIgnore <$> a) + (Just b) + (Just $ toTextIgnore c) defaultConfig :: Config -defaultConfig = Config (Info (pack $(gitHash)) (pack $ showVersion version)) - (Probability defModItem defStmnt defExpr) - (ConfProperty 20 Nothing 3 2 5) - [] - [fromYosys defaultYosys, fromVivado defaultVivado] +defaultConfig = Config + (Info (pack $(gitHash)) (pack $ showVersion version)) + (Probability defModItem defStmnt defExpr) + (ConfProperty 20 Nothing 3 2 5) + [] + [fromYosys defaultYosys, fromVivado defaultVivado] where defModItem = ProbModItem 5 -- Assign - 1 -- Sequential Always - 1 -- Combinational Always - 1 -- Instantiation + 1 -- Sequential Always + 1 -- Combinational Always + 1 -- Instantiation defStmnt = ProbStatement 0 -- Blocking assignment 3 -- Non-blocking assignment @@ -405,17 +396,21 @@ synthesiser = .= synthOut infoCodec :: TomlCodec Info -infoCodec = Info - <$> defaultValue (defaultConfig ^. configInfo . infoCommit) (Toml.text "commit") - .= _infoCommit - <*> defaultValue (defaultConfig ^. configInfo . infoVersion) (Toml.text "version") - .= _infoVersion +infoCodec = + Info + <$> defaultValue (defaultConfig ^. configInfo . infoCommit) + (Toml.text "commit") + .= _infoCommit + <*> defaultValue (defaultConfig ^. configInfo . infoVersion) + (Toml.text "version") + .= _infoVersion configCodec :: TomlCodec Config configCodec = Config - <$> defaultValue (defaultConfig ^. configInfo) (Toml.table infoCodec "info") - .= _configInfo + <$> defaultValue (defaultConfig ^. configInfo) + (Toml.table infoCodec "info") + .= _configInfo <*> defaultValue (defaultConfig ^. configProbability) (Toml.table probCodec "probability") .= _configProbability diff --git a/src/VeriFuzz/Fuzz.hs b/src/VeriFuzz/Fuzz.hs index 825017a..f9ac5e1 100644 --- a/src/VeriFuzz/Fuzz.hs +++ b/src/VeriFuzz/Fuzz.hs @@ -76,9 +76,13 @@ runFuzz conf yos m = shelly $ runFuzz' conf yos m runFuzz' :: Monad m => Config -> Yosys -> (Config -> Fuzz m b) -> m b runFuzz' conf yos m = runReaderT (evalStateT (m conf) (FuzzReport [] [] [])) - (FuzzEnv (force $ defaultIdentitySynth : (descriptionToSynth <$> conf ^. configSynthesisers)) - (force $ descriptionToSim <$> conf ^. configSimulators) - yos + (FuzzEnv + ( force + $ defaultIdentitySynth + : (descriptionToSynth <$> conf ^. configSynthesisers) + ) + (force $ descriptionToSim <$> conf ^. configSimulators) + yos ) synthesisers :: Monad m => Fuzz m [SynthTool] @@ -140,8 +144,7 @@ pop f a = do finally (liftSh (cd f) >> a) . liftSh $ cd dir applyList :: [a -> b] -> [a] -> [b] -applyList a b = apply' <$> zip a b - where apply' (a', b') = a' b' +applyList a b = apply' <$> zip a b where apply' (a', b') = a' b' toSynthResult :: [(SynthTool, SynthTool)] -> [Result Failed ()] -> [SynthResult] toSynthResult a b = flip applyList b $ uncurry SynthResult <$> a @@ -170,26 +173,25 @@ equivalence src = do failEquivWithIdentity :: (MonadSh m) => Fuzz m [SynthResult] failEquivWithIdentity = filter withIdentity . _synthResults <$> get - where - withIdentity (SynthResult (IdentitySynth _) _ (Fail EquivFail)) = True - withIdentity (SynthResult _ (IdentitySynth _) (Fail EquivFail)) = True - withIdentity _ = False + where + withIdentity (SynthResult (IdentitySynth _) _ (Fail EquivFail)) = True + withIdentity (SynthResult _ (IdentitySynth _) (Fail EquivFail)) = True + withIdentity _ = False -- | Always reduces with respect to 'Identity'. reduction :: (MonadSh m) => SourceInfo -> Fuzz m () reduction src = do fails <- failEquivWithIdentity - _ <- liftSh $ mapM red fails + _ <- liftSh $ mapM red fails return () - where - red (SynthResult a b _) = do - make dir - pop dir $ do - s <- reduceSynth a b src - writefile (fromText ".." dir <.> "v") $ genSource s - return s - where - dir = fromText $ "reduce_" <> toText a <> "_" <> toText b + where + red (SynthResult a b _) = do + make dir + pop dir $ do + s <- reduceSynth a b src + writefile (fromText ".." dir <.> "v") $ genSource s + return s + where dir = fromText $ "reduce_" <> toText a <> "_" <> toText b fuzz :: MonadFuzz m => Gen SourceInfo -> Config -> Fuzz m FuzzReport fuzz gen conf = do @@ -204,12 +206,13 @@ fuzz gen conf = do synthesis src equivalence src reduction src - report <- get + report <- get currdir <- liftSh pwd liftSh . writefile "index.html" $ printResultReport (bname currdir) report return report - where seed = conf ^. configProperty . propSeed - bname = T.pack . takeBaseName . T.unpack . toTextIgnore + where + seed = conf ^. configProperty . propSeed + bname = T.pack . takeBaseName . T.unpack . toTextIgnore fuzzInDir :: MonadFuzz m => FilePath -> Gen SourceInfo -> Config -> Fuzz m FuzzReport @@ -260,8 +263,6 @@ sampleSeed s gen = of Nothing -> loop (n - 1) Just x -> do - liftSh - . logT - $ showT seed + liftSh . logT $ showT seed return (seed, Hog.nodeValue x) in loop (100 :: Int) diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 4c297b4..7fddf10 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -111,10 +111,10 @@ halve l = Dual a b where (a, b) = splitAt (length l `div` 2) l halveNonEmpty :: Replace (NonEmpty a) halveNonEmpty l = case NonEmpty.splitAt (length l `div` 2) l of - ([], []) -> None - ([], a:b) -> Single $ a :| b - (a:b, []) -> Single $ a :| b - (a:b, c:d) -> Dual (a :| b) $ c :| d + ([] , [] ) -> None + ([] , a : b) -> Single $ a :| b + (a : b, [] ) -> Single $ a :| b + (a : b, c : d) -> Dual (a :| b) $ c :| d -- | 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 @@ -182,21 +182,20 @@ halveModExpr a = Single a -- | Remove all the undefined mod instances. cleanModInst :: SourceInfo -> SourceInfo cleanModInst srcInfo = srcInfo & infoSrc . _Wrapped .~ cleaned - where - validInst = srcInfo ^.. infoSrc . _Wrapped . traverse . modId - cleaned = cleanModInst' validInst <$> srcInfo ^. infoSrc . _Wrapped + where + validInst = srcInfo ^.. infoSrc . _Wrapped . traverse . modId + cleaned = cleanModInst' validInst <$> srcInfo ^. infoSrc . _Wrapped -- | Clean all the undefined module instances in a specific module using a -- context. cleanModInst' :: [Identifier] -> ModDecl -> ModDecl cleanModInst' ids m = m & modItems .~ newModItem - where - newModItem = filter (validModInst ids) $ m ^.. modItems . traverse + where newModItem = filter (validModInst ids) $ m ^.. modItems . traverse -- | Check if a mod instance is in the current context. validModInst :: [Identifier] -> ModItem -> Bool validModInst ids (ModInst i _ _) = i `elem` ids -validModInst _ _ = True +validModInst _ _ = True -- | Adds a 'ModDecl' to a 'SourceInfo'. addMod :: ModDecl -> SourceInfo -> SourceInfo @@ -212,21 +211,21 @@ relevantModItem :: ModDecl -> ModItem -> Bool relevantModItem (ModDecl _ out _ _ _) (ModCA (ContAssign i _)) = i `elem` fmap _portName out relevantModItem _ Decl{} = True -relevantModItem _ _ = False +relevantModItem _ _ = False isAssign :: Statement -> Bool -isAssign (BlockAssign _) = True +isAssign (BlockAssign _) = True isAssign (NonBlockAssign _) = True isAssign _ = False lValName :: LVal -> [Identifier] -lValName (RegId i) = [i] +lValName (RegId i ) = [i] lValName (RegExpr i _) = [i] lValName (RegSize i _) = [i] lValName (RegConcat e) = mapMaybe getId . concat $ universe <$> e - where - getId (Id i) = Just i - getId _ = Nothing + where + getId (Id i) = Just i + getId _ = Nothing portToId :: Port -> Identifier portToId (Port _ _ _ i) = i @@ -236,38 +235,36 @@ paramToId (Parameter i _) = i findActiveWires :: ModDecl -> [Identifier] findActiveWires m@(ModDecl _ i o _ p) = - nub $ assignWires - <> assignStat - <> fmap portToId i - <> fmap portToId o - <> fmap paramToId p - where - assignWires = - m ^.. modItems . traverse - . modContAssign . contAssignNetLVal - assignStat = - concatMap lValName - $ (allStat ^.. traverse . stmntBA . assignReg) + nub + $ assignWires + <> assignStat + <> fmap portToId i + <> fmap portToId o + <> fmap paramToId p + where + assignWires = m ^.. modItems . traverse . modContAssign . contAssignNetLVal + assignStat = + concatMap lValName + $ (allStat ^.. traverse . stmntBA . assignReg) <> (allStat ^.. traverse . stmntNBA . assignReg) - allStat = filter isAssign . concat $ fmap universe stat - stat = - (m ^.. modItems . traverse . _Initial) + allStat = filter isAssign . concat $ fmap universe stat + stat = + (m ^.. modItems . traverse . _Initial) <> (m ^.. modItems . traverse . _Always) cleanSourceInfo :: SourceInfo -> SourceInfo cleanSourceInfo src = clean active src - where - active = findActiveWires (src ^. mainModule) + where active = findActiveWires (src ^. mainModule) -- | Returns true if the text matches the name of a module. matchesModName :: Text -> ModDecl -> Bool matchesModName top (ModDecl i _ _ _ _) = top == getIdentifier i halveStatement :: Replace Statement -halveStatement (SeqBlock s) = SeqBlock <$> halve s +halveStatement (SeqBlock s) = SeqBlock <$> halve s halveStatement (CondStmnt _ (Just s1) (Just s2)) = Dual s1 s2 -halveStatement (CondStmnt _ (Just s1) Nothing) = Single s1 -halveStatement (CondStmnt _ Nothing (Just s1)) = Single s1 +halveStatement (CondStmnt _ (Just s1) Nothing) = Single s1 +halveStatement (CondStmnt _ Nothing (Just s1)) = Single s1 halveStatement (EventCtrl e (Just s)) = EventCtrl e . Just <$> halveStatement s halveStatement (TimeCtrl e (Just s)) = TimeCtrl e . Just <$> halveStatement s halveStatement a = Single a @@ -282,40 +279,39 @@ halveAlways a = Single a halveModules :: Replace SourceInfo halveModules srcInfo@(SourceInfo top _) = cleanModInst . addMod main <$> combine (infoSrc . _Wrapped) repl srcInfo - where - repl = halve . filter (not . matchesModName top) - main = srcInfo ^. mainModule + where + repl = halve . filter (not . matchesModName top) + main = srcInfo ^. mainModule moduleBot :: SourceInfo -> Bool -moduleBot (SourceInfo _ (Verilog [])) = True +moduleBot (SourceInfo _ (Verilog [] )) = True moduleBot (SourceInfo _ (Verilog [_])) = True -moduleBot (SourceInfo _ (Verilog _)) = False +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 :: Replace SourceInfo halveModItems srcInfo = cleanSourceInfo . addRelevant <$> src - where - repl = halve . filter (not . relevantModItem main) - relevant = filter (relevantModItem main) $ main ^. modItems - main = srcInfo ^. mainModule - src = combine (mainModule . modItems) repl srcInfo - addRelevant = mainModule . modItems %~ (relevant ++) + where + repl = halve . filter (not . relevantModItem main) + relevant = filter (relevantModItem main) $ main ^. modItems + main = srcInfo ^. mainModule + src = combine (mainModule . modItems) repl srcInfo + addRelevant = mainModule . modItems %~ (relevant ++) modItemBot :: SourceInfo -> Bool -modItemBot srcInfo - | length modItemsNoDecl > 2 = False - | otherwise = True - where - modItemsNoDecl = filter noDecl $ srcInfo ^.. mainModule . modItems . traverse - noDecl Decl{} = False - noDecl _ = True +modItemBot srcInfo | length modItemsNoDecl > 2 = False + | otherwise = True + where + modItemsNoDecl = + filter noDecl $ srcInfo ^.. mainModule . modItems . traverse + noDecl Decl{} = False + noDecl _ = True halveStatements :: Replace SourceInfo halveStatements m = cleanSourceInfo <$> combine (mainModule . modItems) halves m - where - halves = traverse halveAlways + where halves = traverse halveAlways -- | Reduce expressions by splitting them in half and keeping the half that -- succeeds. @@ -329,15 +325,18 @@ defaultBot :: SourceInfo -> Bool defaultBot = const False -- | Reduction using custom reduction strategies. -reduce_ :: MonadSh m - => Text - -> Replace SourceInfo - -> (SourceInfo -> Bool) - -> (SourceInfo -> m Bool) - -> SourceInfo - -> m SourceInfo +reduce_ + :: MonadSh m + => Text + -> Replace SourceInfo + -> (SourceInfo -> Bool) + -> (SourceInfo -> m Bool) + -> SourceInfo + -> m SourceInfo reduce_ title repl bot eval src = do - liftSh . Shelly.echo $ "Reducing " + liftSh + . Shelly.echo + $ "Reducing " <> title <> " (Modules: " <> showT (length . getVerilog $ _infoSrc src) @@ -348,43 +347,43 @@ reduce_ title repl bot eval src = do <> ")" replAnswer <- sequenceA $ evalIfNotEmpty <$> replacement case (replacement, replAnswer) of - (Single s, Single True ) -> runIf s - (Dual _ r, Dual False True ) -> runIf r - (Dual l _, Dual True False ) -> runIf l - (Dual l r, Dual True True) -> check l r - _ -> return src + (Single s, Single True ) -> runIf s + (Dual _ r, Dual False True) -> runIf r + (Dual l _, Dual True False) -> runIf l + (Dual l r, Dual True True ) -> check l r + _ -> return src where replacement = repl src - runIf s = if s /= src && not (bot s) then reduce_ title repl bot eval s else return s + runIf s = if s /= src && not (bot s) + then reduce_ title repl bot eval s + else return s evalIfNotEmpty = eval check l r | bot l = return l | bot r = return r | otherwise = do - lreduced <- runIf l - rreduced <- runIf r - if _infoSrc lreduced < _infoSrc rreduced - then return lreduced - else return rreduced + lreduced <- runIf l + rreduced <- runIf r + if _infoSrc lreduced < _infoSrc rreduced + then return lreduced + else return rreduced -- | Reduce an input to a minimal representation. It follows the reduction -- strategy mentioned above. -reduce :: MonadSh m - => (SourceInfo -> m Bool) -- ^ Failed or not. - -> SourceInfo -- ^ Input verilog source to be reduced. - -> m SourceInfo -- ^ Reduced output. +reduce + :: MonadSh m + => (SourceInfo -> m Bool) -- ^ Failed or not. + -> SourceInfo -- ^ Input verilog source to be reduced. + -> m SourceInfo -- ^ Reduced output. reduce eval src = red "Modules" moduleBot halveModules src - >>= red "Module Items" modItemBot halveModItems - >>= red "Statements" defaultBot halveStatements - >>= red "Expressions" defaultBot halveExpr + >>= red "Module Items" modItemBot halveModItems + >>= red "Statements" defaultBot halveStatements + >>= red "Expressions" defaultBot halveExpr where red s bot a = reduce_ s a bot eval -runScript :: MonadSh m - => Shelly.FilePath - -> Shelly.FilePath - -> SourceInfo - -> m Bool +runScript + :: MonadSh m => Shelly.FilePath -> Shelly.FilePath -> SourceInfo -> m Bool runScript fp file src = do e <- liftSh $ do Shelly.writefile file $ genSource src @@ -393,30 +392,32 @@ runScript fp file src = do return $ e == 0 -- | Reduce using a script that is passed to it -reduceWithScript :: (MonadSh m, MonadIO m) - => Text - -> Shelly.FilePath - -> Shelly.FilePath - -> m () +reduceWithScript + :: (MonadSh m, MonadIO m) + => Text + -> Shelly.FilePath + -> Shelly.FilePath + -> m () reduceWithScript top script file = do liftSh . Shelly.cp file $ file <.> "original" srcInfo <- liftIO . parseSourceInfoFile top $ Shelly.toTextIgnore file void $ reduce (runScript script file) srcInfo -- | Reduce a 'SourceInfo' using two 'Synthesiser' that are passed to it. -reduceSynth :: (Synthesiser a, Synthesiser b, MonadSh m) - => a - -> b - -> SourceInfo - -> m SourceInfo +reduceSynth + :: (Synthesiser a, Synthesiser b, MonadSh m) + => a + -> b + -> SourceInfo + -> m SourceInfo reduceSynth a b = reduce synth - where - synth src' = liftSh $ do - r <- runResultT $ do - runSynth a src' - runSynth b src' - runEquiv a b src' - return $ case r of - Fail EquivFail -> True - Fail _ -> False - Pass _ -> False + where + synth src' = liftSh $ do + r <- runResultT $ do + runSynth a src' + runSynth b src' + runEquiv a b src' + return $ case r of + Fail EquivFail -> True + Fail _ -> False + Pass _ -> False diff --git a/src/VeriFuzz/Report.hs b/src/VeriFuzz/Report.hs index f2d5ce4..5882144 100644 --- a/src/VeriFuzz/Report.hs +++ b/src/VeriFuzz/Report.hs @@ -199,7 +199,8 @@ descriptionToSynth (SynthDescription "xst" bin desc out) = $ maybe (xstOutput defaultXST) fromText out descriptionToSynth (SynthDescription "quartus" bin desc out) = QuartusSynth - . Quartus (fromText <$> bin) (fromMaybe (quartusDesc defaultQuartus) $ desc) + . Quartus (fromText <$> bin) + (fromMaybe (quartusDesc defaultQuartus) $ desc) $ maybe (quartusOutput defaultQuartus) fromText out descriptionToSynth (SynthDescription "identity" _ desc out) = IdentitySynth @@ -209,12 +210,12 @@ descriptionToSynth s = error $ "Could not find implementation for synthesiser '" <> show s <> "'" status :: Result Failed () -> Html -status (Pass _) = "Passed" -status (Fail EmptyFail) = "Failed" -status (Fail EquivFail) = "Equivalence failed" -status (Fail SimFail) = "Simulation failed" -status (Fail SynthFail) = "Synthesis failed" -status (Fail EquivError) = "Equivalence error" +status (Pass _ ) = "Passed" +status (Fail EmptyFail ) = "Failed" +status (Fail EquivFail ) = "Equivalence failed" +status (Fail SimFail ) = "Simulation failed" +status (Fail SynthFail ) = "Synthesis failed" +status (Fail EquivError ) = "Equivalence error" status (Fail TimeoutError) = "Time out" synthStatusHtml :: SynthStatus -> Html @@ -234,14 +235,23 @@ resultReport name (FuzzReport synth _ stat) = H.docTypeHtml $ do H.body $ do H.h1 $ "Fuzz Report - " <> H.toHtml name H.h2 "Synthesis Failure" - H.table . H.toHtml $ - (H.tr . H.toHtml $ - [H.th "Synthesis tool", H.th "Synthesis Status"]) + H.table + . H.toHtml + $ ( H.tr + . H.toHtml + $ [H.th "Synthesis tool", H.th "Synthesis Status"] + ) : fmap synthStatusHtml stat H.h2 "Equivalence Check Status" - H.table . H.toHtml $ - (H.tr . H.toHtml $ - [H.th "First tool", H.th "Second tool", H.th "Equivalence Status"]) + H.table + . H.toHtml + $ ( H.tr + . H.toHtml + $ [ H.th "First tool" + , H.th "Second tool" + , H.th "Equivalence Status" + ] + ) : fmap synthResultHtml synth printResultReport :: Text -> FuzzReport -> Text diff --git a/src/VeriFuzz/Sim/Yosys.hs b/src/VeriFuzz/Sim/Yosys.hs index 8552d89..3081a65 100644 --- a/src/VeriFuzz/Sim/Yosys.hs +++ b/src/VeriFuzz/Sim/Yosys.hs @@ -99,15 +99,10 @@ runEquivYosys yosys sim1 sim2 srcInfo = do logger "Yosys: equivalence check" run_ (yosysPath yosys) [toTextIgnore checkFile] logger "Yosys: equivalence done" - where - checkFile = - fromText [st|test.#{toText sim1}.#{toText sim2}.ys|] + where checkFile = fromText [st|test.#{toText sim1}.#{toText sim2}.ys|] -runEquiv :: (Synthesiser a, Synthesiser b) - => a - -> b - -> SourceInfo - -> ResultSh () +runEquiv + :: (Synthesiser a, Synthesiser b) => a -> b -> SourceInfo -> ResultSh () runEquiv sim1 sim2 srcInfo = do dir <- liftSh pwd liftSh $ do @@ -129,5 +124,5 @@ runEquiv sim1 sim2 srcInfo = do 2 -> ResultT . return $ Fail EquivFail 124 -> ResultT . return $ Fail TimeoutError _ -> ResultT . return $ Fail EquivError - where - exe dir name e = void . errExit False . logCommand dir name . timeout e + where + exe dir name e = void . errExit False . logCommand dir name . timeout e diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs index 1957cb5..52155db 100644 --- a/src/VeriFuzz/Verilog/AST.hs +++ b/src/VeriFuzz/Verilog/AST.hs @@ -270,23 +270,25 @@ data ConstExpr = ConstNum { _constNum :: {-# UNPACK #-} !BitVec } deriving (Eq, Show, Ord, Data) constToExpr :: ConstExpr -> Expr -constToExpr (ConstNum a) = Number a -constToExpr (ParamId a) = Id a -constToExpr (ConstConcat a) = Concat $ fmap constToExpr a -constToExpr (ConstUnOp a b) = UnOp a $ constToExpr b +constToExpr (ConstNum a ) = Number a +constToExpr (ParamId a ) = Id a +constToExpr (ConstConcat a ) = Concat $ fmap constToExpr a +constToExpr (ConstUnOp a b ) = UnOp a $ constToExpr b constToExpr (ConstBinOp a b c) = BinOp (constToExpr a) b $ constToExpr c -constToExpr (ConstCond a b c) = Cond (constToExpr a) (constToExpr b) $ constToExpr c +constToExpr (ConstCond a b c) = + Cond (constToExpr a) (constToExpr b) $ constToExpr c constToExpr (ConstStr a) = Str a exprToConst :: Expr -> ConstExpr -exprToConst (Number a) = ConstNum a -exprToConst (Id a) = ParamId a -exprToConst (Concat a) = ConstConcat $ fmap exprToConst a -exprToConst (UnOp a b) = ConstUnOp a $ exprToConst b +exprToConst (Number a ) = ConstNum a +exprToConst (Id a ) = ParamId a +exprToConst (Concat a ) = ConstConcat $ fmap exprToConst a +exprToConst (UnOp a b ) = ConstUnOp a $ exprToConst b exprToConst (BinOp a b c) = ConstBinOp (exprToConst a) b $ exprToConst c -exprToConst (Cond a b c) = ConstCond (exprToConst a) (exprToConst b) $ exprToConst c +exprToConst (Cond a b c) = + ConstCond (exprToConst a) (exprToConst b) $ exprToConst c exprToConst (Str a) = ConstStr a -exprToConst _ = error "Not a constant expression" +exprToConst _ = error "Not a constant expression" instance Num ConstExpr where a + b = ConstBinOp a BinPlus b diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs index 3ff39d9..a0ec0cc 100644 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -49,15 +49,15 @@ verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules -- | Generate the 'ModDecl' for a module and convert it to 'Text'. moduleDecl :: ModDecl -> Doc a -moduleDecl (ModDecl i outP inP items ps) = - vsep +moduleDecl (ModDecl i outP inP items ps) = vsep [ sep ["module" <+> identifier i, params ps, ports <> semi] , indent 2 modI , "endmodule" ] where - ports | null outP && null inP = "" - | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn + ports + | null outP && null inP = "" + | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn modI = vsep $ moduleItem <$> items outIn = outP ++ inP params [] = "" @@ -73,11 +73,13 @@ localParamList ps = tupled . toList $ localParam <$> ps -- | Generates the assignment for a 'Parameter'. parameter :: Parameter -> Doc a -parameter (Parameter name val) = hsep ["parameter", identifier name, "=", constExpr val] +parameter (Parameter name val) = + hsep ["parameter", identifier name, "=", constExpr val] -- | Generates the assignment for a 'LocalParam'. localParam :: LocalParam -> Doc a -localParam (LocalParam name val) = hsep ["localparameter", identifier name, "=", constExpr val] +localParam (LocalParam name val) = + hsep ["localparameter", identifier name, "=", constExpr val] identifier :: Identifier -> Doc a identifier (Identifier i) = pretty i @@ -109,13 +111,17 @@ portDir PortInOut = "inout" -- | Generate a 'ModItem'. moduleItem :: ModItem -> Doc a -moduleItem (ModCA ca) = contAssign ca -moduleItem (ModInst i name conn) = - hsep [identifier i, identifier name, parens . hsep $ punctuate comma (mConn <$> conn), semi] -moduleItem (Initial stat) = nest 2 $ vsep ["initial", statement stat] -moduleItem (Always stat) = nest 2 $ vsep ["always", statement stat] -moduleItem (Decl dir p ini) = - hsep [maybe mempty makePort dir, port p, maybe mempty makeIni ini, semi] +moduleItem (ModCA ca ) = contAssign ca +moduleItem (ModInst i name conn) = hsep + [ identifier i + , identifier name + , parens . hsep $ punctuate comma (mConn <$> conn) + , semi + ] +moduleItem (Initial stat ) = nest 2 $ vsep ["initial", statement stat] +moduleItem (Always stat ) = nest 2 $ vsep ["always", statement stat] +moduleItem (Decl dir p ini) = hsep + [maybe mempty makePort dir, port p, maybe mempty makeIni ini, semi] where makePort = portDir makeIni = ("=" <+>) . constExpr @@ -133,29 +139,30 @@ contAssign (ContAssign val e) = -- | Generate 'Expr' to 'Text'. expr :: Expr -> Doc a -expr (BinOp eRhs bin eLhs) = - parens $ hsep [expr eRhs, binaryOp bin, expr eLhs] -expr (Number b ) = showNum b -expr (Id i ) = identifier i -expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e] -expr (RangeSelect i r ) = hcat [identifier i, range r] -expr (Concat c ) = braces . nest 4 . sep . punctuate comma $ toList (expr <$> c) -expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e] -expr (Cond l t f) = parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]] +expr (BinOp eRhs bin eLhs) = parens $ hsep [expr eRhs, binaryOp bin, expr eLhs] +expr (Number b ) = showNum b +expr (Id i ) = identifier i +expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e] +expr (RangeSelect i r ) = hcat [identifier i, range r] +expr (Concat c) = braces . nest 4 . sep . punctuate comma $ toList (expr <$> c) +expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e] +expr (Cond l t f) = + parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]] expr (Appl f e) = hcat [identifier f, parens $ expr e] -expr (Str t ) = dquotes $ pretty t +expr (Str t ) = dquotes $ pretty t showNum :: BitVec -> Doc a -showNum (BitVec s n) = - parens $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")] +showNum (BitVec s n) = parens + $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")] where minus | signum n >= 0 = mempty | otherwise = "-" constExpr :: ConstExpr -> Doc a -constExpr (ConstNum b) = showNum b -constExpr (ParamId i) = identifier i -constExpr (ConstConcat c) = braces . hsep . punctuate comma $ toList (constExpr <$> c) +constExpr (ConstNum b) = showNum b +constExpr (ParamId i) = identifier i +constExpr (ConstConcat c) = + braces . hsep . punctuate comma $ toList (constExpr <$> c) constExpr (ConstUnOp u e) = parens $ hcat [unaryOp u, constExpr e] constExpr (ConstBinOp eRhs bin eLhs) = parens $ hsep [constExpr eRhs, binaryOp bin, constExpr eLhs] @@ -234,33 +241,41 @@ pType Wire = "wire" pType Reg = "reg" genAssign :: Text -> Assign -> Doc a -genAssign op (Assign r d e) = hsep [lVal r, pretty op, maybe mempty delay d, expr e] +genAssign op (Assign r d e) = + hsep [lVal r, pretty op, maybe mempty delay d, expr e] statement :: Statement -> Doc a -statement (TimeCtrl d stat ) = hsep [delay d, defMap stat] -statement (EventCtrl e stat ) = hsep [event e, defMap stat] -statement (SeqBlock s) = vsep ["begin", indent 2 . vsep $ statement <$> s, "end"] -statement (BlockAssign a ) = hcat [genAssign "=" a, semi] -statement (NonBlockAssign a ) = hcat [genAssign "<=" a, semi] -statement (TaskEnable t ) = hcat [task t, semi] -statement (SysTaskEnable t ) = hcat ["$", task t, semi] -statement (CondStmnt e t Nothing) = vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t] -statement (CondStmnt e t f) = - vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t, "else", indent 2 $ defMap f] -statement (ForLoop a e incr stmnt) = - vsep [ hsep - [ "for" - , parens . hsep $ punctuate semi - [ genAssign "=" a - , expr e - , genAssign "=" incr - ] - ] - , indent 2 $ statement stmnt] +statement (TimeCtrl d stat) = hsep [delay d, defMap stat] +statement (EventCtrl e stat) = hsep [event e, defMap stat] +statement (SeqBlock s) = + vsep ["begin", indent 2 . vsep $ statement <$> s, "end"] +statement (BlockAssign a) = hcat [genAssign "=" a, semi] +statement (NonBlockAssign a) = hcat [genAssign "<=" a, semi] +statement (TaskEnable t) = hcat [task t, semi] +statement (SysTaskEnable t) = hcat ["$", task t, semi] +statement (CondStmnt e t Nothing) = + vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t] +statement (CondStmnt e t f) = vsep + [ hsep ["if", parens $ expr e] + , indent 2 $ defMap t + , "else" + , indent 2 $ defMap f + ] +statement (ForLoop a e incr stmnt) = vsep + [ hsep + [ "for" + , parens . hsep $ punctuate + semi + [genAssign "=" a, expr e, genAssign "=" incr] + ] + , indent 2 $ statement stmnt + ] task :: Task -> Doc a -task (Task i e) | null e = identifier i - | otherwise = hsep [identifier i, parens . hsep $ punctuate comma (expr <$> e)] +task (Task i e) + | null e = identifier i + | otherwise = hsep + [identifier i, parens . hsep $ punctuate comma (expr <$> e)] -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. render :: (Source a) => a -> IO () diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs index 630e3c0..0cff33a 100644 --- a/src/VeriFuzz/Verilog/Gen.hs +++ b/src/VeriFuzz/Verilog/Gen.hs @@ -174,7 +174,9 @@ constExprWithContext ps prob size , ( prob ^. probExprCond , ConstCond <$> subexpr 2 <*> subexpr 2 <*> subexpr 2 ) - , (prob ^. probExprConcat, ConstConcat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2)) + , ( prob ^. probExprConcat + , ConstConcat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2) + ) ] | otherwise = constExprWithContext ps prob 0 where subexpr y = constExprWithContext ps prob $ size `div` y @@ -184,8 +186,10 @@ exprSafeList prob = [(prob ^. probExprNum, Number <$> genBitVec)] exprRecList :: ProbExpr -> (Hog.Size -> Gen Expr) -> [(Int, Gen Expr)] exprRecList prob subexpr = - [ (prob ^. probExprNum , Number <$> genBitVec) - , (prob ^. probExprConcat , Concat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2)) + [ (prob ^. probExprNum, Number <$> genBitVec) + , ( prob ^. probExprConcat + , Concat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2) + ) , (prob ^. probExprUnOp , UnOp <$> unOp <*> subexpr 2) , (prob ^. probExprStr, Str <$> Hog.text (Hog.linear 0 100) Hog.alphaNum) , (prob ^. probExprBinOp , BinOp <$> subexpr 2 <*> binOp <*> subexpr 2) @@ -344,7 +348,7 @@ statement = do alwaysSeq :: StateGen ModItem alwaysSeq = do - stat <- seqBlock + stat <- seqBlock return $ Always (EventCtrl (EPosEdge "clk") (Just stat)) instantiate :: ModDecl -> StateGen ModItem @@ -414,7 +418,7 @@ modItem = do context <- get let defProb i = prob ^. probModItem . i Hog.frequency - [ (defProb probModItemAssign, ModCA <$> contAssign) + [ (defProb probModItemAssign , ModCA <$> contAssign) , (defProb probModItemSeqAlways, alwaysSeq) , ( if context ^. modDepth > 0 then defProb probModItemInst else 0 , modInst diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs index b7840ff..68d0ef3 100644 --- a/src/VeriFuzz/Verilog/Parser.hs +++ b/src/VeriFuzz/Verilog/Parser.hs @@ -113,13 +113,13 @@ parseVar = Id <$> identifier parseVecSelect :: Parser Expr parseVecSelect = do - i <- identifier + i <- identifier expr <- brackets parseExpr return $ VecSelect i expr parseRangeSelect :: Parser Expr parseRangeSelect = do - i <- identifier + i <- identifier range <- parseRange return $ RangeSelect i range @@ -136,8 +136,8 @@ parseFun = do return $ Appl (Identifier $ T.pack f) expr parserNonEmpty :: [a] -> Parser (NonEmpty a) -parserNonEmpty (a:b) = return $ a :| b -parserNonEmpty [] = fail "Concatenation cannot be empty." +parserNonEmpty (a : b) = return $ a :| b +parserNonEmpty [] = fail "Concatenation cannot be empty." parseTerm :: Parser Expr parseTerm = @@ -289,7 +289,7 @@ parseNetDecl pd = do sign <- option False (tok KWSigned $> True) range <- option 1 parseRange name <- identifier - i <- option Nothing (fmap Just (tok' SymEq *> parseConstExpr)) + i <- option Nothing (fmap Just (tok' SymEq *> parseConstExpr)) tok' SymSemi return $ Decl pd (Port t sign range name) i where type_ = tok KWWire $> Wire <|> tok KWReg $> Reg @@ -308,24 +308,22 @@ parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing parseConditional :: Parser Statement parseConditional = do - expr <- tok' KWIf *> parens parseExpr - true <- maybeEmptyStatement + expr <- tok' KWIf *> parens parseExpr + true <- maybeEmptyStatement false <- option Nothing (tok' KWElse *> maybeEmptyStatement) return $ CondStmnt expr true false parseLVal :: Parser LVal -parseLVal = - fmap RegConcat (braces $ commaSep parseExpr) - <|> ident - where - ident = do - i <- identifier - (try (ex i) <|> try (sz i) <|> return (RegId i)) - ex i = do - e <- tok' SymBrackL *> parseExpr - tok' SymBrackR - return $ RegExpr i e - sz i = RegSize i <$> parseRange +parseLVal = fmap RegConcat (braces $ commaSep parseExpr) <|> ident + where + ident = do + i <- identifier + (try (ex i) <|> try (sz i) <|> return (RegId i)) + ex i = do + e <- tok' SymBrackL *> parseExpr + tok' SymBrackR + return $ RegExpr i e + sz i = RegSize i <$> parseRange parseDelay :: Parser Delay parseDelay = Delay . toInt' <$> (tok' SymPound *> number) @@ -335,12 +333,12 @@ parseAssign t = do lval <- parseLVal tok' t delay <- option Nothing (fmap Just parseDelay) - expr <- parseExpr + expr <- parseExpr return $ Assign lval delay expr parseLoop :: Parser Statement parseLoop = do - a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq + a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq expr <- tok' SymSemi *> parseExpr incr <- tok' SymSemi *> parseAssign SymEq tok' SymParenR @@ -353,29 +351,37 @@ eventList t = do if null l then fail "Could not parse list" else return l parseEvent :: Parser Event -parseEvent = tok' SymAtAster $> EAll - <|> try (tok' SymAt *> tok' SymParenLAsterParenR $> EAll) - <|> try (tok' SymAt *> tok' SymParenL *> tok' SymAster *> tok' SymParenR $> EAll) - <|> try (tok' SymAt *> parens parseEvent') - <|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr)) - <|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma)) +parseEvent = + tok' SymAtAster + $> EAll + <|> try (tok' SymAt *> tok' SymParenLAsterParenR $> EAll) + <|> try + ( tok' SymAt + *> tok' SymParenL + *> tok' SymAster + *> tok' SymParenR + $> EAll + ) + <|> try (tok' SymAt *> parens parseEvent') + <|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr)) + <|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma)) parseEvent' :: Parser Event parseEvent' = try (tok' KWPosedge *> fmap EPosEdge identifier) - <|> try (tok' KWNegedge *> fmap ENegEdge identifier) - <|> try (fmap EId identifier) - <|> try (fmap EExpr parseExpr) + <|> try (tok' KWNegedge *> fmap ENegEdge identifier) + <|> try (fmap EId identifier) + <|> try (fmap EExpr parseExpr) parseEventCtrl :: Parser Statement parseEventCtrl = do - event <- parseEvent + event <- parseEvent statement <- option Nothing maybeEmptyStatement return $ EventCtrl event statement parseDelayCtrl :: Parser Statement parseDelayCtrl = do - delay <- parseDelay + delay <- parseDelay statement <- option Nothing maybeEmptyStatement return $ TimeCtrl delay statement @@ -400,17 +406,16 @@ parseSeq = do parseStatement :: Parser Statement parseStatement = parseSeq - <|> parseConditional - <|> parseLoop - <|> parseEventCtrl - <|> parseDelayCtrl - <|> try parseBlocking - <|> parseNonBlocking + <|> parseConditional + <|> parseLoop + <|> parseEventCtrl + <|> parseDelayCtrl + <|> try parseBlocking + <|> parseNonBlocking maybeEmptyStatement :: Parser (Maybe Statement) maybeEmptyStatement = - (tok' SymSemi >> return Nothing) - <|> (Just <$> parseStatement) + (tok' SymSemi >> return Nothing) <|> (Just <$> parseStatement) parseAlways :: Parser ModItem parseAlways = tok' KWAlways *> (Always <$> parseStatement) @@ -421,18 +426,16 @@ parseInitial = tok' KWInitial *> (Initial <$> parseStatement) namedModConn :: Parser ModConn namedModConn = do target <- tok' SymDot *> identifier - expr <- parens parseExpr + expr <- parens parseExpr return $ ModConnNamed target expr parseModConn :: Parser ModConn -parseModConn = - try (fmap ModConn parseExpr) - <|> namedModConn +parseModConn = try (fmap ModConn parseExpr) <|> namedModConn parseModInst :: Parser ModItem parseModInst = do - m <- identifier - name <- identifier + m <- identifier + name <- identifier modconns <- parens (commaSep parseModConn) tok' SymSemi return $ ModInst m name modconns @@ -440,10 +443,10 @@ parseModInst = do parseModItem :: Parser ModItem parseModItem = try (ModCA <$> parseContAssign) - <|> try parseDecl - <|> parseAlways - <|> parseInitial - <|> parseModInst + <|> try parseDecl + <|> parseAlways + <|> parseInitial + <|> parseModInst parseModList :: Parser [Identifier] parseModList = list <|> return [] where list = parens $ commaSep identifier @@ -457,7 +460,7 @@ modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort parseParam :: Parser Parameter parseParam = do - i <- tok' KWParameter *> identifier + i <- tok' KWParameter *> identifier expr <- tok' SymEq *> parseConstExpr return $ Parameter i expr @@ -466,9 +469,9 @@ parseParams = tok' SymPound *> parens (commaSep parseParam) parseModDecl :: Parser ModDecl parseModDecl = do - name <- tok KWModule *> identifier + name <- tok KWModule *> identifier paramList <- option [] $ try parseParams - _ <- fmap defaultPort <$> parseModList + _ <- fmap defaultPort <$> parseModList tok' SymSemi modItem <- option [] . try $ many1 parseModItem tok' KWEndmodule @@ -491,13 +494,17 @@ parseVerilog -> Either Text Verilog -- ^ Returns 'String' with error -- message if parse fails. parseVerilog s = - bimap showT id . parse parseVerilogSrc (T.unpack s) . alexScanTokens . preprocess [] (T.unpack s) . T.unpack + bimap showT id + . parse parseVerilogSrc (T.unpack s) + . alexScanTokens + . preprocess [] (T.unpack s) + . T.unpack parseVerilogFile :: Text -> IO Verilog parseVerilogFile file = do src <- T.readFile $ T.unpack file case parseVerilog file src of - Left s -> error $ T.unpack s + Left s -> error $ T.unpack s Right r -> return r parseSourceInfoFile :: Text -> Text -> IO SourceInfo diff --git a/src/VeriFuzz/Verilog/Quote.hs b/src/VeriFuzz/Verilog/Quote.hs index b252af2..362cf06 100644 --- a/src/VeriFuzz/Verilog/Quote.hs +++ b/src/VeriFuzz/Verilog/Quote.hs @@ -33,11 +33,12 @@ liftText txt = AppE (VarE 'T.pack) <$> lift (T.unpack txt) -- | Quasiquoter for verilog, so that verilog can be written inline and be -- parsed to an AST at compile time. verilog :: QuasiQuoter -verilog = QuasiQuoter { quoteExp = quoteVerilog - , quotePat = undefined - , quoteType = undefined - , quoteDec = undefined - } +verilog = QuasiQuoter + { quoteExp = quoteVerilog + , quotePat = undefined + , quoteType = undefined + , quoteDec = undefined + } quoteVerilog :: String -> TH.Q TH.Exp quoteVerilog s = do @@ -45,5 +46,5 @@ quoteVerilog s = do let pos = T.pack $ TH.loc_filename loc v <- case parseVerilog pos (T.pack s) of Right e -> return e - Left e -> fail $ show e + Left e -> fail $ show e liftDataWithText v -- cgit