From 928a54419aeac611555b3c15493db00010cbb46e Mon Sep 17 00:00:00 2001 From: Yann Herklotz Grave Date: Sun, 17 Feb 2019 12:37:46 +0000 Subject: Indent by 4 --- app/Main.hs | 158 +++++++++--------- src/VeriFuzz.hs | 118 +++++++------- src/VeriFuzz/AST.hs | 233 ++++++++++++++------------- src/VeriFuzz/ASTGen.hs | 38 ++--- src/VeriFuzz/Circuit.hs | 10 +- src/VeriFuzz/CodeGen.hs | 58 +++---- src/VeriFuzz/Env.hs | 4 +- src/VeriFuzz/Gen.hs | 48 +++--- src/VeriFuzz/General.hs | 16 +- src/VeriFuzz/Icarus.hs | 61 +++---- src/VeriFuzz/Internal.hs | 16 +- src/VeriFuzz/Internal/AST.hs | 22 +-- src/VeriFuzz/Lexer.hs | 374 +++++++++++++++++++++---------------------- src/VeriFuzz/Mutate.hs | 92 +++++------ src/VeriFuzz/Parser.hs | 180 ++++++++++----------- src/VeriFuzz/Random.hs | 22 +-- src/VeriFuzz/XST.hs | 34 ++-- src/VeriFuzz/Yosys.hs | 67 ++++---- test/Property.hs | 30 ++-- test/Unit.hs | 125 ++++++++------- 20 files changed, 861 insertions(+), 845 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 1249c41..de6af9a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -28,121 +28,133 @@ data Opts = Fuzz { fuzzOutput :: Text myForkIO :: IO () -> IO (MVar ()) myForkIO io = do - mvar <- newEmptyMVar - _ <- forkFinally io (\_ -> putMVar mvar ()) - return mvar + mvar <- newEmptyMVar + _ <- forkFinally io (\_ -> putMVar mvar ()) + return mvar textOption :: Mod OptionFields String -> Parser Text textOption = fmap T.pack . strOption optReader :: (String -> Maybe a) -> ReadM a -optReader f = eitherReader $ \arg -> - case f arg of +optReader f = eitherReader $ \arg -> case f arg of Just a -> Right a Nothing -> Left $ "Cannot parse option: " <> arg parseSynth :: String -> Maybe Tool -parseSynth val - | val == "yosys" = Just Yosys - | val == "xst"= Just XST - | otherwise = Nothing +parseSynth val | val == "yosys" = Just Yosys + | val == "xst" = Just XST + | otherwise = Nothing parseSim :: String -> Maybe Tool -parseSim val - | val == "icarus" = Just Icarus - | otherwise = Nothing +parseSim val | val == "icarus" = Just Icarus + | otherwise = Nothing fuzzOpts :: Parser Opts -fuzzOpts = Fuzz - <$> textOption - ( long "output" +fuzzOpts = Fuzz <$> textOption + ( long "output" <> short 'o' <> metavar "DIR" <> help "Output directory that the fuzz run takes place in." <> showDefault <> value "output" - ) + ) rerunOpts :: Parser Opts -rerunOpts = Rerun - <$> ( option (optReader parseSynth) - ( long "synth" - <> metavar "SYNTH" - <> help "Rerun using a synthesiser (yosys|xst)." - <> showDefault - <> value Yosys - ) - <|> option (optReader parseSim) - ( long "sim" - <> metavar "SIM" - <> help "Rerun using a simulator (icarus)." - <> showDefault - <> value Icarus - ) - ) +rerunOpts = + Rerun + <$> ( option + (optReader parseSynth) + ( long "synth" + <> metavar "SYNTH" + <> help "Rerun using a synthesiser (yosys|xst)." + <> showDefault + <> value Yosys + ) + <|> option + (optReader parseSim) + ( long "sim" + <> metavar "SIM" + <> help "Rerun using a simulator (icarus)." + <> showDefault + <> value Icarus + ) + ) genOpts :: Parser Opts genOpts = Generate . S.fromText <$> textOption - ( long "output" + ( long "output" <> short 'o' <> metavar "FILE" <> help "Verilog output file." <> showDefault <> value "main.v" - ) + ) parseOpts :: Parser Opts -parseOpts = Parse . S.fromText . T.pack <$> strArgument - ( metavar "FILE" - <> help "Verilog input file." - ) +parseOpts = + Parse . S.fromText . T.pack <$> strArgument (metavar "FILE" <> help "Verilog input file.") argparse :: Parser Opts argparse = - hsubparser (command "fuzz" - (info fuzzOpts - (progDesc "Run fuzzing on the specified simulators and synthesisers.")) - <> metavar "fuzz") - <|> hsubparser (command "rerun" - (info rerunOpts - (progDesc "Rerun a Verilog file with a simulator or a synthesiser.")) - <> metavar "rerun") - <|> hsubparser (command "generate" - (info genOpts - (progDesc "Generate a random Verilog program.")) - <> metavar "generate") - <|> hsubparser (command "parse" - (info parseOpts - (progDesc "Parse a verilog file and output a pretty printed version.")) - <> metavar "parse") + hsubparser + ( command + "fuzz" + (info fuzzOpts + (progDesc "Run fuzzing on the specified simulators and synthesisers.") + ) + <> metavar "fuzz" + ) + <|> hsubparser + ( command + "rerun" + (info + rerunOpts + (progDesc "Rerun a Verilog file with a simulator or a synthesiser.") + ) + <> metavar "rerun" + ) + <|> hsubparser + ( command "generate" (info genOpts (progDesc "Generate a random Verilog program.")) + <> metavar "generate" + ) + <|> hsubparser + ( command + "parse" + (info + parseOpts + (progDesc "Parse a verilog file and output a pretty printed version.") + ) + <> metavar "parse" + ) opts :: ParserInfo Opts -opts = info (argparse <**> helper) - ( fullDesc - <> progDesc "Fuzz different simulators and synthesisers." - <> header "VeriFuzz - A hardware simulator and synthesiser Verilog fuzzer." ) +opts = info + (argparse <**> helper) + (fullDesc <> progDesc "Fuzz different simulators and synthesisers." <> header + "VeriFuzz - A hardware simulator and synthesiser Verilog fuzzer." + ) handleOpts :: Opts -> IO () handleOpts (Fuzz _) = do - num <- getNumCapabilities - vars <- sequence $ (\x -> myForkIO $ - V.runEquivalence (V.randomMod 10 100) - ("test_" <> T.pack (show x)) 0) <$> [1..num] - sequence_ $ takeMVar <$> vars + num <- getNumCapabilities + vars <- + sequence + $ (\x -> myForkIO $ V.runEquivalence (V.randomMod 10 100) ("test_" <> T.pack (show x)) 0) + <$> [1 .. num] + sequence_ $ takeMVar <$> vars handleOpts (Generate f) = do - g <- QC.generate $ V.randomMod 50 1000 - S.shelly . S.writefile f $ V.genSource g + g <- QC.generate $ V.randomMod 50 1000 + S.shelly . S.writefile f $ V.genSource g handleOpts (Parse f) = do - verilogSrc <- readFile file - case V.parseVerilog file verilogSrc of - Left l -> print l - Right v -> print $ V.GenVerilog v - where - file = T.unpack . S.toTextIgnore $ f + verilogSrc <- readFile file + case V.parseVerilog file verilogSrc of + Left l -> print l + Right v -> print $ V.GenVerilog v + where file = T.unpack . S.toTextIgnore $ f handleOpts (Rerun _) = undefined main :: IO () --main = sample (arbitrary :: Gen (Circuit Input)) main = do - optsparsed <- execParser opts - handleOpts optsparsed + optsparsed <- execParser opts + handleOpts optsparsed diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs index c2c1d70..e1e8d1e 100644 --- a/src/VeriFuzz.hs +++ b/src/VeriFuzz.hs @@ -9,24 +9,24 @@ Portability : POSIX -} module VeriFuzz - ( runEquivalence - , runSimulation - , draw - , module VeriFuzz.AST - , module VeriFuzz.ASTGen - , module VeriFuzz.Circuit - , module VeriFuzz.CodeGen - , module VeriFuzz.Env - , module VeriFuzz.Gen - , module VeriFuzz.General - , module VeriFuzz.Icarus - , module VeriFuzz.Internal - , module VeriFuzz.Mutate - , module VeriFuzz.Parser - , module VeriFuzz.Random - , module VeriFuzz.XST - , module VeriFuzz.Yosys - ) + ( runEquivalence + , runSimulation + , draw + , module VeriFuzz.AST + , module VeriFuzz.ASTGen + , module VeriFuzz.Circuit + , module VeriFuzz.CodeGen + , module VeriFuzz.Env + , module VeriFuzz.Gen + , module VeriFuzz.General + , module VeriFuzz.Icarus + , module VeriFuzz.Internal + , module VeriFuzz.Mutate + , module VeriFuzz.Parser + , module VeriFuzz.Random + , module VeriFuzz.XST + , module VeriFuzz.Yosys + ) where import qualified Crypto.Random.DRBG as C @@ -61,19 +61,19 @@ import VeriFuzz.Yosys genRand :: C.CtrDRBG -> Int -> [ByteString] -> [ByteString] genRand gen n bytes | n == 0 = ranBytes : bytes | otherwise = genRand newGen (n - 1) $ ranBytes : bytes - where Right (ranBytes, newGen) = C.genBytes 32 gen + where Right (ranBytes, newGen) = C.genBytes 32 gen genRandom :: Int -> IO [ByteString] genRandom n = do - gen <- C.newGenIO :: IO C.CtrDRBG - return $ genRand gen n [] + gen <- C.newGenIO :: IO C.CtrDRBG + return $ genRand gen n [] draw :: IO () draw = do - gr <- QC.generate $ rDups <$> QC.resize 10 (randomDAG :: QC.Gen (G.Gr Gate ())) - let dot = G.showDot . G.fglToDotString $ G.nemap show (const "") gr - writeFile "file.dot" dot - shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] + gr <- QC.generate $ rDups <$> QC.resize 10 (randomDAG :: QC.Gen (G.Gr Gate ())) + let dot = G.showDot . G.fglToDotString $ G.nemap show (const "") gr + writeFile "file.dot" dot + shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] showBS :: ByteString -> Text showBS = decodeUtf8 . L.toStrict . toLazyByteString . byteStringHex @@ -86,42 +86,44 @@ runSimulation = do -- shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] -- let circ = -- head $ (nestUpTo 30 . generateAST $ Circuit gr) ^.. getVerilogSrc . traverse . getDescription - rand <- genRandom 20 - rand2 <- QC.generate (randomMod 10 100) - val <- shelly $ runSim defaultIcarus rand2 rand - T.putStrLn $ showBS val + rand <- genRandom 20 + rand2 <- QC.generate (randomMod 10 100) + val <- shelly $ runSim defaultIcarus rand2 rand + T.putStrLn $ showBS val onFailure :: Text -> RunFailed -> Sh () onFailure t _ = do - ex <- lastExitCode - case ex of - 124 -> do - echoP "Test TIMEOUT" - chdir ".." $ cp_r (fromText t) $ fromText (t <> "_timeout") - _ -> do - echoP "Test FAIL" - chdir ".." $ cp_r (fromText t) $ fromText (t <> "_failed") + ex <- lastExitCode + case ex of + 124 -> do + echoP "Test TIMEOUT" + chdir ".." $ cp_r (fromText t) $ fromText (t <> "_timeout") + _ -> do + echoP "Test FAIL" + chdir ".." $ cp_r (fromText t) $ fromText (t <> "_failed") runEquivalence :: Gen ModDecl -> Text -> Int -> IO () runEquivalence gm t i = do - m <- QC.generate gm - rand <- genRandom 20 - shellyFailDir $ do - mkdir_p (fromText "output" fromText n) - curr <- toTextIgnore <$> pwd - setenv "VERIFUZZ_ROOT" curr - cd (fromText "output" fromText n) - catch_sh (runEquiv defaultYosys defaultYosys (Just defaultXst) m >> echoP "Test OK") - $ onFailure n - catch_sh (runSim (Icarus "iverilog" "vvp") m rand >>= (\b -> echoP ("RTL Sim: " <> showBS b))) - $ onFailure n --- catch_sh (runSimWithFile (Icarus "iverilog" "vvp") "syn_yosys.v" rand --- >>= (\b -> echoP ("Yosys Sim: " <> showBS b))) $ --- onFailure n --- catch_sh (runSimWithFile (Icarus "iverilog" "vvp") "syn_xst.v" rand --- >>= (\b -> echoP ("XST Sim: " <> showBS b))) $ --- onFailure n - cd ".." - rm_rf $ fromText n - when (i < 5) (runEquivalence gm t $ i + 1) - where n = t <> "_" <> T.pack (show i) + m <- QC.generate gm + rand <- genRandom 20 + shellyFailDir $ do + mkdir_p (fromText "output" fromText n) + curr <- toTextIgnore <$> pwd + setenv "VERIFUZZ_ROOT" curr + cd (fromText "output" fromText n) + catch_sh (runEquiv defaultYosys defaultYosys (Just defaultXst) m >> echoP "Test OK") + $ onFailure n + catch_sh + (runSim (Icarus "iverilog" "vvp") m rand >>= (\b -> echoP ("RTL Sim: " <> showBS b)) + ) + $ onFailure n + -- catch_sh (runSimWithFile (Icarus "iverilog" "vvp") "syn_yosys.v" rand + -- >>= (\b -> echoP ("Yosys Sim: " <> showBS b))) $ + -- onFailure n + -- catch_sh (runSimWithFile (Icarus "iverilog" "vvp") "syn_xst.v" rand + -- >>= (\b -> echoP ("XST Sim: " <> showBS b))) $ + -- onFailure n + cd ".." + rm_rf $ fromText n + when (i < 5) (runEquivalence gm t $ i + 1) + where n = t <> "_" <> T.pack (show i) diff --git a/src/VeriFuzz/AST.hs b/src/VeriFuzz/AST.hs index 63b8c34..cd16235 100644 --- a/src/VeriFuzz/AST.hs +++ b/src/VeriFuzz/AST.hs @@ -15,104 +15,104 @@ Defines the types to build a Verilog AST. {-# LANGUAGE TemplateHaskell #-} module VeriFuzz.AST - ( -- * Top level types - VerilogSrc(..) - , getVerilogSrc - , Description(..) - , getDescription + ( -- * Top level types + VerilogSrc(..) + , getVerilogSrc + , Description(..) + , getDescription -- * Primitives -- ** Identifier - , Identifier(..) - , getIdentifier + , Identifier(..) + , getIdentifier -- ** Control - , Delay(..) - , getDelay - , Event(..) + , Delay(..) + , getDelay + , Event(..) -- ** Operators - , BinaryOperator(..) - , UnaryOperator(..) + , BinaryOperator(..) + , UnaryOperator(..) -- ** Task - , Task(..) - , taskName - , taskExpr + , Task(..) + , taskName + , taskExpr -- ** Left hand side value - , LVal(..) - , regId - , regExprId - , regExpr - , regSizeId - , regSizeMSB - , regSizeLSB - , regConc + , LVal(..) + , regId + , regExprId + , regExpr + , regSizeId + , regSizeMSB + , regSizeLSB + , regConc -- ** Ports - , PortDir(..) - , PortType(..) - , Port(..) - , portType - , portSigned - , portSize - , portName + , PortDir(..) + , PortType(..) + , Port(..) + , portType + , portSigned + , portSize + , portName -- * Expression - , Expr(..) - , exprSize - , exprVal - , exprId - , exprConcat - , exprUnOp - , exprPrim - , exprLhs - , exprBinOp - , exprRhs - , exprCond - , exprTrue - , exprFalse - , exprFunc - , exprBody - , exprStr - , exprWithContext - , traverseExpr - , ConstExpr(..) - , constNum - , Function(..) + , Expr(..) + , exprSize + , exprVal + , exprId + , exprConcat + , exprUnOp + , exprPrim + , exprLhs + , exprBinOp + , exprRhs + , exprCond + , exprTrue + , exprFalse + , exprFunc + , exprBody + , exprStr + , exprWithContext + , traverseExpr + , ConstExpr(..) + , constNum + , Function(..) -- * Assignment - , Assign(..) - , assignReg - , assignDelay - , assignExpr - , ContAssign(..) - , contAssignNetLVal - , contAssignExpr + , Assign(..) + , assignReg + , assignDelay + , assignExpr + , ContAssign(..) + , contAssignNetLVal + , contAssignExpr -- * Statment - , Stmnt(..) - , statDelay - , statDStat - , statEvent - , statEStat - , statements - , stmntBA - , stmntNBA - , stmntCA - , stmntTask - , stmntSysTask + , Stmnt(..) + , statDelay + , statDStat + , statEvent + , statEStat + , statements + , stmntBA + , stmntNBA + , stmntCA + , stmntTask + , stmntSysTask -- * Module - , ModDecl(..) - , modId - , modOutPorts - , modInPorts - , modItems - , ModItem(..) - , modContAssign - , modInstId - , modInstName - , modInstConns - , traverseModItem - , declDir - , declPort - , ModConn(..) - , modConn - , modConnName - , modExpr - ) + , ModDecl(..) + , modId + , modOutPorts + , modInPorts + , modItems + , ModItem(..) + , modContAssign + , modInstId + , modInstName + , modInstConns + , traverseModItem + , declDir + , declPort + , ModConn(..) + , modConn + , modConnName + , modExpr + ) where import Control.Lens @@ -306,37 +306,36 @@ instance Plated Expr where plate = uniplate exprSafeList :: [QC.Gen Expr] -exprSafeList = - [Number <$> positiveArb <*> QC.arbitrary] +exprSafeList = [Number <$> positiveArb <*> QC.arbitrary] exprRecList :: (Int -> QC.Gen Expr) -> [QC.Gen Expr] exprRecList subexpr = - [ Number <$> positiveArb <*> QC.arbitrary - , Concat <$> QC.listOf1 (subexpr 8) - , UnOp - <$> QC.arbitrary - <*> subexpr 2 + [ Number <$> positiveArb <*> QC.arbitrary + , Concat <$> QC.listOf1 (subexpr 8) + , UnOp + <$> QC.arbitrary + <*> subexpr 2 -- , Str <$> QC.arbitrary - , BinOp <$> subexpr 2 <*> QC.arbitrary <*> subexpr 2 - , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 - , Func <$> QC.arbitrary <*> subexpr 2 - ] + , BinOp <$> subexpr 2 <*> QC.arbitrary <*> subexpr 2 + , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 + , Func <$> QC.arbitrary <*> subexpr 2 + ] expr :: Int -> QC.Gen Expr expr n | n == 0 = QC.oneof $ (Id <$> QC.arbitrary) : exprSafeList | n > 0 = QC.oneof $ (Id <$> QC.arbitrary) : exprRecList subexpr | otherwise = expr 0 - where subexpr y = expr (n `div` y) + where subexpr y = expr (n `div` y) exprWithContext :: [Identifier] -> Int -> QC.Gen Expr exprWithContext [] n | n == 0 = QC.oneof exprSafeList | n > 0 = QC.oneof $ exprRecList subexpr | otherwise = exprWithContext [] 0 - where subexpr y = exprWithContext [] (n `div` y) + where subexpr y = exprWithContext [] (n `div` y) exprWithContext l n | n == 0 = QC.oneof $ (Id <$> QC.elements l) : exprSafeList | n > 0 = QC.oneof $ (Id <$> QC.elements l) : exprRecList subexpr | otherwise = exprWithContext l 0 - where subexpr y = exprWithContext l (n `div` y) + where subexpr y = exprWithContext l (n `div` y) instance QC.Arbitrary Expr where arbitrary = QC.sized expr @@ -498,24 +497,24 @@ instance Monoid Stmnt where statement :: Int -> QC.Gen Stmnt statement n - | n == 0 = QC.oneof - [ BlockAssign <$> QC.arbitrary - , NonBlockAssign <$> QC.arbitrary + | n == 0 = QC.oneof + [ BlockAssign <$> QC.arbitrary + , NonBlockAssign <$> QC.arbitrary -- , StatCA <$> QC.arbitrary - , TaskEnable <$> QC.arbitrary - , SysTaskEnable <$> QC.arbitrary - ] - | n > 0 = QC.oneof - [ TimeCtrl <$> QC.arbitrary <*> (Just <$> substat 2) - , SeqBlock <$> QC.listOf1 (substat 4) - , BlockAssign <$> QC.arbitrary - , NonBlockAssign <$> QC.arbitrary + , TaskEnable <$> QC.arbitrary + , SysTaskEnable <$> QC.arbitrary + ] + | n > 0 = QC.oneof + [ TimeCtrl <$> QC.arbitrary <*> (Just <$> substat 2) + , SeqBlock <$> QC.listOf1 (substat 4) + , BlockAssign <$> QC.arbitrary + , NonBlockAssign <$> QC.arbitrary -- , StatCA <$> QC.arbitrary - , TaskEnable <$> QC.arbitrary - , SysTaskEnable <$> QC.arbitrary - ] - | otherwise = statement 0 - where substat y = statement (n `div` y) + , TaskEnable <$> QC.arbitrary + , SysTaskEnable <$> QC.arbitrary + ] + | otherwise = statement 0 + where substat y = statement (n `div` y) instance QC.Arbitrary Stmnt where arbitrary = QC.sized statement diff --git a/src/VeriFuzz/ASTGen.hs b/src/VeriFuzz/ASTGen.hs index ab097e4..0321e25 100644 --- a/src/VeriFuzz/ASTGen.hs +++ b/src/VeriFuzz/ASTGen.hs @@ -11,8 +11,8 @@ Generates the AST from the graph directly. -} module VeriFuzz.ASTGen - ( generateAST - ) + ( generateAST + ) where import Control.Lens ((^..)) @@ -47,35 +47,35 @@ genAssignExpr :: Gate -> [Node] -> Maybe Expr genAssignExpr _ [] = Nothing genAssignExpr _ [n ] = Just . Id $ frNode n genAssignExpr g (n : ns) = BinOp wire op <$> genAssignExpr g ns - where - wire = Id $ frNode n - op = fromGate g + where + wire = Id $ frNode n + op = fromGate g -- | 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 c (n, g) = ModCA . ContAssign name <$> genAssignExpr g nodes - where - gr = getCircuit c - nodes = G.pre gr n - name = frNode n + where + gr = getCircuit c + nodes = G.pre gr n + name = frNode n genAssignAST :: Circuit -> [ModItem] genAssignAST c = catMaybes $ genContAssignAST c <$> nodes - where - gr = getCircuit c - nodes = G.labNodes gr + where + gr = getCircuit c + nodes = G.labNodes gr genModuleDeclAST :: Circuit -> ModDecl genModuleDeclAST c = ModDecl i output ports items - where - i = Identifier "gen_module" - ports = genPortsAST inputsC c - output = [Port Wire False 90 "y"] - a = genAssignAST c - items = a ++ [ModCA . ContAssign "y" . fold $ Id <$> assigns] - assigns = a ^.. traverse . modContAssign . contAssignNetLVal + where + i = Identifier "gen_module" + ports = genPortsAST inputsC c + output = [Port Wire False 90 "y"] + a = genAssignAST c + items = a ++ [ModCA . ContAssign "y" . fold $ Id <$> assigns] + assigns = a ^.. traverse . modContAssign . contAssignNetLVal generateAST :: Circuit -> VerilogSrc generateAST c = VerilogSrc [Description $ genModuleDeclAST c] diff --git a/src/VeriFuzz/Circuit.hs b/src/VeriFuzz/Circuit.hs index dac3d51..4d3fac1 100644 --- a/src/VeriFuzz/Circuit.hs +++ b/src/VeriFuzz/Circuit.hs @@ -11,11 +11,11 @@ Definition of the circuit graph. -} module VeriFuzz.Circuit - ( -- * Circuit - Gate(..) - , Circuit(..) - , CNode(..) - ) + ( -- * Circuit + Gate(..) + , Circuit(..) + , CNode(..) + ) where import Data.Graph.Inductive (Gr, LNode) diff --git a/src/VeriFuzz/CodeGen.hs b/src/VeriFuzz/CodeGen.hs index 4ff2a93..f337b99 100644 --- a/src/VeriFuzz/CodeGen.hs +++ b/src/VeriFuzz/CodeGen.hs @@ -14,11 +14,11 @@ This module generates the code from the Verilog AST defined in {-# LANGUAGE FlexibleInstances #-} module VeriFuzz.CodeGen - ( -- * Code Generation - GenVerilog(..) - , genSource - , render - ) + ( -- * Code Generation + GenVerilog(..) + , genSource + , render + ) where import Control.Lens (view, (^.)) @@ -53,14 +53,14 @@ genDescription desc = genModuleDecl $ desc ^. getDescription -- | Generate the 'ModDecl' for a module and convert it to 'Text'. genModuleDecl :: ModDecl -> Text genModuleDecl m = - "module " <> m ^. modId . getIdentifier <> ports <> ";\n" <> modI <> "endmodule\n" - where - ports | noIn && noOut = "" - | otherwise = "(" <> comma (genModPort <$> outIn) <> ")" - modI = fold $ genModuleItem <$> m ^. modItems - noOut = null $ m ^. modOutPorts - noIn = null $ m ^. modInPorts - outIn = (m ^. modOutPorts) ++ (m ^. modInPorts) + "module " <> m ^. modId . getIdentifier <> ports <> ";\n" <> modI <> "endmodule\n" + where + ports | noIn && noOut = "" + | otherwise = "(" <> comma (genModPort <$> outIn) <> ")" + modI = fold $ genModuleItem <$> m ^. modItems + noOut = null $ m ^. modOutPorts + noIn = null $ m ^. modInPorts + outIn = (m ^. modOutPorts) ++ (m ^. modInPorts) -- | Conversts 'Port' to 'Text' for the module list, which means it only -- generates a list of identifiers. @@ -70,12 +70,12 @@ genModPort port = port ^. portName . getIdentifier -- | Generate the 'Port' description. genPort :: Port -> Text genPort port = t <> sign <> size <> name - where - t = flip mappend " " . genPortType $ port ^. portType - size | port ^. portSize > 1 = "[" <> showT (port ^. portSize - 1) <> ":0] " - | otherwise = "" - name = port ^. portName . getIdentifier - sign = genSigned $ port ^. portSigned + where + t = flip mappend " " . genPortType $ port ^. portType + size | port ^. portSize > 1 = "[" <> showT (port ^. portSize - 1) <> ":0] " + | otherwise = "" + name = port ^. portName . getIdentifier + sign = genSigned $ port ^. portSigned genSigned :: Bool -> Text genSigned True = "signed " @@ -91,11 +91,11 @@ genPortDir PortInOut = "inout" genModuleItem :: ModItem -> Text genModuleItem (ModCA ca) = genContAssign ca genModuleItem (ModInst (Identifier i) (Identifier name) conn) = - i <> " " <> name <> "(" <> comma (genModConn <$> conn) <> ")" <> ";\n" + i <> " " <> name <> "(" <> comma (genModConn <$> conn) <> ")" <> ";\n" genModuleItem (Initial stat ) = "initial " <> genStmnt stat genModuleItem (Always stat ) = "always " <> genStmnt stat genModuleItem (Decl dir port) = maybe "" makePort dir <> genPort port <> ";\n" - where makePort = (<> " ") . genPortDir + where makePort = (<> " ") . genPortDir genModConn :: ModConn -> Text genModConn (ModConn c ) = genExpr c @@ -104,9 +104,9 @@ genModConn (ModConnNamed n c) = "." <> n ^. getIdentifier <> "(" <> genExpr c <> -- | Generate continuous assignment genContAssign :: ContAssign -> Text genContAssign (ContAssign val e) = "assign " <> name <> " = " <> expr <> ";\n" - where - name = val ^. getIdentifier - expr = genExpr e + where + name = val ^. getIdentifier + expr = genExpr e -- | Generate 'Function' to 'Text' genFunc :: Function -> Text @@ -117,9 +117,9 @@ genFunc UnSignedFunc = "$unsigned" genExpr :: Expr -> Text genExpr (BinOp eRhs bin eLhs) = "(" <> genExpr eRhs <> genBinaryOperator bin <> genExpr eLhs <> ")" genExpr (Number s n) = "(" <> minus <> showT s <> "'h" <> T.pack (showHex (abs n) "") <> ")" - where - minus | signum n >= 0 = "" - | otherwise = "-" + where + minus | signum n >= 0 = "" + | otherwise = "-" genExpr (Id i ) = i ^. getIdentifier genExpr (Concat c ) = "{" <> comma (genExpr <$> c) <> "}" genExpr (UnOp u e ) = "(" <> genUnaryOperator u <> genExpr e <> ")" @@ -186,7 +186,7 @@ genLVal :: LVal -> Text genLVal (RegId i ) = i ^. getIdentifier genLVal (RegExpr i expr) = i ^. getIdentifier <> " [" <> genExpr expr <> "]" genLVal (RegSize i msb lsb) = - i ^. getIdentifier <> " [" <> genConstExpr msb <> ":" <> genConstExpr lsb <> "]" + i ^. getIdentifier <> " [" <> genConstExpr msb <> ":" <> genConstExpr lsb <> "]" genLVal (RegConcat e) = "{" <> comma (genExpr <$> e) <> "}" genConstExpr :: ConstExpr -> Text @@ -212,7 +212,7 @@ genStmnt (SysTaskEnable task) = "$" <> genTask task <> ";\n" genTask :: Task -> Text genTask (Task name expr) | null expr = i | otherwise = i <> "(" <> comma (genExpr <$> expr) <> ")" - where i = name ^. getIdentifier + where i = name ^. getIdentifier -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. render :: (Source a) => a -> IO () diff --git a/src/VeriFuzz/Env.hs b/src/VeriFuzz/Env.hs index 0bbd290..c50be25 100644 --- a/src/VeriFuzz/Env.hs +++ b/src/VeriFuzz/Env.hs @@ -29,5 +29,5 @@ type SimEnv = ReaderT SimMatrix IO runAll :: SimEnv () runAll = do - _ <- asks xst - shelly $ run_ "echo" ["Hello World"] + _ <- asks xst + shelly $ run_ "echo" ["Hello World"] diff --git a/src/VeriFuzz/Gen.hs b/src/VeriFuzz/Gen.hs index 724b00d..3413ee6 100644 --- a/src/VeriFuzz/Gen.hs +++ b/src/VeriFuzz/Gen.hs @@ -28,45 +28,45 @@ toId = Identifier . ("w" <>) . T.pack . show toPort :: Identifier -> Gen Port toPort ident = do - i <- abs <$> QC.arbitrary - return $ wire i ident + i <- abs <$> QC.arbitrary + return $ wire i ident sumSize :: [Port] -> Int sumSize ports = sum $ ports ^.. traverse . portSize random :: [Identifier] -> (Expr -> ContAssign) -> Gen ModItem random ctx fun = do - expr <- QC.sized (exprWithContext ctx) - return . ModCA $ fun expr + expr <- QC.sized (exprWithContext ctx) + return . ModCA $ fun expr randomAssigns :: [Identifier] -> [Gen ModItem] randomAssigns ids = random ids . ContAssign <$> ids randomOrdAssigns :: [Identifier] -> [Identifier] -> [Gen ModItem] randomOrdAssigns inp ids = snd $ foldr gen (inp, []) ids - where gen cid (i, o) = (cid : i, random i (ContAssign cid) : o) + where gen cid (i, o) = (cid : i, random i (ContAssign cid) : o) randomMod :: Int -> Int -> Gen ModDecl randomMod inps total = do - x <- sequence $ randomOrdAssigns start end - ident <- sequence $ toPort <$> ids - let inputs_ = take inps ident - let other = drop inps ident - let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids - let yport = [wire (sumSize other) "y"] - return . initMod . declareMod other . ModDecl "test_module" yport inputs_ $ x ++ [y] - where - ids = toId <$> [1 .. total] - end = drop inps ids - start = take inps ids + x <- sequence $ randomOrdAssigns start end + ident <- sequence $ toPort <$> ids + let inputs_ = take inps ident + let other = drop inps ident + let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids + let yport = [wire (sumSize other) "y"] + return . initMod . declareMod other . ModDecl "test_module" yport inputs_ $ x ++ [y] + where + ids = toId <$> [1 .. total] + end = drop inps ids + start = take inps ids fromGraph :: Gen ModDecl fromGraph = do - gr <- rDupsCirc <$> QC.resize 100 randomCircuit - return - $ initMod - . head - $ nestUpTo 5 (generateAST gr) - ^.. getVerilogSrc - . traverse - . getDescription + gr <- rDupsCirc <$> QC.resize 100 randomCircuit + return + $ initMod + . head + $ nestUpTo 5 (generateAST gr) + ^.. getVerilogSrc + . traverse + . getDescription diff --git a/src/VeriFuzz/General.hs b/src/VeriFuzz/General.hs index 6a09db5..ee230e5 100644 --- a/src/VeriFuzz/General.hs +++ b/src/VeriFuzz/General.hs @@ -46,8 +46,8 @@ class (Simulator a) => Synthesize a where rootPath :: Sh FilePath rootPath = do - current <- pwd - maybe current fromText <$> get_env "VERIFUZZ_ROOT" + current <- pwd + maybe current fromText <$> get_env "VERIFUZZ_ROOT" timeout :: FilePath -> [Text] -> Sh Text timeout = command1 "timeout" ["300"] . toTextIgnore @@ -67,12 +67,12 @@ noPrint = print_stdout False . print_stderr False echoP :: Text -> Sh () echoP t = do - fn <- pwd - echo $ bname fn <> " - " <> t - where bname = T.pack . takeBaseName . T.unpack . toTextIgnore + fn <- pwd + echo $ bname fn <> " - " <> t + where bname = T.pack . takeBaseName . T.unpack . toTextIgnore logger :: FilePath -> Text -> Sh a -> Sh a logger fp name = log_stderr_with (l "_log.stderr.txt") . log_stdout_with (l "_log.txt") - where - l s t = appendFile (file s) (T.unpack t) >> appendFile (file s) "\n" - file s = T.unpack (toTextIgnore $ fp fromText name) <> s + where + l s t = appendFile (file s) (T.unpack t) >> appendFile (file s) "\n" + file s = T.unpack (toTextIgnore $ fp fromText name) <> s diff --git a/src/VeriFuzz/Icarus.hs b/src/VeriFuzz/Icarus.hs index 45e932f..f848958 100644 --- a/src/VeriFuzz/Icarus.hs +++ b/src/VeriFuzz/Icarus.hs @@ -52,21 +52,24 @@ defaultIcarus = Icarus "iverilog" "vvp" addDisplay :: [Stmnt] -> [Stmnt] addDisplay s = concat $ transpose - [s, replicate l $ TimeCtrl 1 Nothing, replicate l . SysTaskEnable $ Task "display" ["%b", Id "y"]] - where l = length s + [ s + , replicate l $ TimeCtrl 1 Nothing + , replicate l . SysTaskEnable $ Task "display" ["%b", Id "y"] + ] + where l = length s assignFunc :: [Port] -> ByteString -> Stmnt assignFunc inp bs = NonBlockAssign . Assign conc Nothing . Number (B.length bs * 8) $ bsToI bs - where conc = RegConcat (portToExpr <$> inp) + where conc = RegConcat (portToExpr <$> inp) convert :: Text -> ByteString convert = - toStrict - . (encode :: Integer -> L.ByteString) - . maybe 0 fst - . listToMaybe - . readInt 2 (`elem` ("01" :: String)) digitToInt - . T.unpack + toStrict + . (encode :: Integer -> L.ByteString) + . maybe 0 fst + . listToMaybe + . readInt 2 (`elem` ("01" :: String)) digitToInt + . T.unpack mask :: Text -> Text mask = T.replace "x" "0" @@ -76,26 +79,26 @@ callback b t = b <> convert (mask t) runSimIcarus :: Icarus -> ModDecl -> [ByteString] -> Sh ByteString runSimIcarus sim m bss = do - let tb = ModDecl - "main" - [] - [] - [ Initial - $ fold (addDisplay $ assignFunc (m ^. modInPorts) <$> bss) - <> (SysTaskEnable $ Task "finish" []) - ] - let newtb = instantiateMod m tb - let modWithTb = VerilogSrc $ Description <$> [newtb, m] - writefile "main.v" $ genSource modWithTb - runSimWithFile sim "main.v" bss + let tb = ModDecl + "main" + [] + [] + [ Initial + $ fold (addDisplay $ assignFunc (m ^. modInPorts) <$> bss) + <> (SysTaskEnable $ Task "finish" []) + ] + let newtb = instantiateMod m tb + let modWithTb = VerilogSrc $ Description <$> [newtb, m] + writefile "main.v" $ genSource modWithTb + runSimWithFile sim "main.v" bss runSimIcarusWithFile :: Icarus -> FilePath -> [ByteString] -> Sh ByteString runSimIcarusWithFile sim f _ = do - dir <- pwd - echoP "Icarus: Compile" - _ <- logger dir "icarus" $ run (icarusPath sim) ["-o", "main", toTextIgnore f] - echoP "Icarus: Run" - B.take 8 . BA.convert . (hash :: ByteString -> Digest SHA256) <$> logger - dir - "vvp" - (runFoldLines (mempty :: ByteString) callback (vvpPath sim) ["main"]) + dir <- pwd + echoP "Icarus: Compile" + _ <- logger dir "icarus" $ run (icarusPath sim) ["-o", "main", toTextIgnore f] + echoP "Icarus: Run" + B.take 8 . BA.convert . (hash :: ByteString -> Digest SHA256) <$> logger + dir + "vvp" + (runFoldLines (mempty :: ByteString) callback (vvpPath sim) ["main"]) diff --git a/src/VeriFuzz/Internal.hs b/src/VeriFuzz/Internal.hs index 4a04c7d..76b2ac7 100644 --- a/src/VeriFuzz/Internal.hs +++ b/src/VeriFuzz/Internal.hs @@ -11,15 +11,15 @@ Shared high level code used in the other modules internally. -} module VeriFuzz.Internal - ( -- * Useful functions - safe - , showT - , comma + ( -- * Useful functions + safe + , showT + , comma -- * Module Specific Internals - , module VeriFuzz.Internal.Circuit - , module VeriFuzz.Internal.Simulator - , module VeriFuzz.Internal.AST - ) + , module VeriFuzz.Internal.Circuit + , module VeriFuzz.Internal.Simulator + , module VeriFuzz.Internal.AST + ) where import Data.Text (Text) diff --git a/src/VeriFuzz/Internal/AST.hs b/src/VeriFuzz/Internal/AST.hs index 95f3bfc..7866f61 100644 --- a/src/VeriFuzz/Internal/AST.hs +++ b/src/VeriFuzz/Internal/AST.hs @@ -39,16 +39,16 @@ addDescription desc = getVerilogSrc %~ (:) desc testBench :: ModDecl testBench = ModDecl - "main" - [] - [] - [ regDecl "a" - , regDecl "b" - , wireDecl "c" - , ModInst "and" "and_gate" [ModConn $ Id "c", ModConn $ Id "a", ModConn $ Id "b"] - , Initial $ SeqBlock - [ BlockAssign . Assign (RegId "a") Nothing $ Number 1 1 - , BlockAssign . Assign (RegId "b") Nothing $ Number 1 1 + "main" + [] + [] + [ regDecl "a" + , regDecl "b" + , wireDecl "c" + , ModInst "and" "and_gate" [ModConn $ Id "c", ModConn $ Id "a", ModConn $ Id "b"] + , Initial $ SeqBlock + [ BlockAssign . Assign (RegId "a") Nothing $ Number 1 1 + , BlockAssign . Assign (RegId "b") Nothing $ Number 1 1 -- , TimeCtrl (Delay 1) . Just . SysTaskEnable $ Task "display" -- [ Str "%d & %d = %d" -- , PrimExpr $ PrimId "a" @@ -56,8 +56,8 @@ testBench = ModDecl -- , PrimExpr $ PrimId "c" -- ] -- , SysTaskEnable $ Task "finish" [] + ] ] - ] addTestBench :: VerilogSrc -> VerilogSrc addTestBench = addDescription $ Description testBench diff --git a/src/VeriFuzz/Lexer.hs b/src/VeriFuzz/Lexer.hs index 9e9f35e..fe71abb 100644 --- a/src/VeriFuzz/Lexer.hs +++ b/src/VeriFuzz/Lexer.hs @@ -11,36 +11,36 @@ Lexer for Verilog. -} module VeriFuzz.Lexer - ( lexer - , identifier - , reserved - , operator - , reservedOp - , charLiteral - , stringLiteral - , natural - , integer - , float - , naturalOrFloat - , decimal - , hexadecimal - , octal - , symbol - , lexeme - , whiteSpace - , parens - , braces - , angles - , brackets - , squares - , comma - , colon - , dot - , semiSep - , semiSep1 - , commaSep - , commaSep1 - ) + ( lexer + , identifier + , reserved + , operator + , reservedOp + , charLiteral + , stringLiteral + , natural + , integer + , float + , naturalOrFloat + , decimal + , hexadecimal + , octal + , symbol + , lexeme + , whiteSpace + , parens + , braces + , angles + , brackets + , squares + , comma + , colon + , dot + , semiSep + , semiSep1 + , commaSep + , commaSep1 + ) where import Data.Char (digitToInt) @@ -104,9 +104,9 @@ decimal = P.decimal lexer number :: Integer -> Parser Char -> Parser Integer number base baseDigit = do - digits <- many1 baseDigit - let n = foldl (\x d -> base * x + toInteger (digitToInt d)) 0 digits - seq n (return n) + digits <- many1 baseDigit + let n = foldl (\x d -> base * x + toInteger (digitToInt d)) 0 digits + seq n (return n) hexadecimal :: Parser Integer hexadecimal = number 16 hexDigit @@ -161,161 +161,161 @@ commaSep1 = P.commaSep1 lexer reservedOp' :: [String] reservedOp' = - [ "!" - , "~" - , "~&" - , "~|" - , "+" - , "-" - , "*" - , "/" - , "%" - , "==" - , "!=" - , "===" - , "!==" - , "&&" - , "||" - , "<" - , "<=" - , ">" - , ">=" - , "&" - , "|" - , "^" - , "^~" - , "~^" - , "**" - , "<<" - , ">>" - , "<<<" - , ">>>" - ] + [ "!" + , "~" + , "~&" + , "~|" + , "+" + , "-" + , "*" + , "/" + , "%" + , "==" + , "!=" + , "===" + , "!==" + , "&&" + , "||" + , "<" + , "<=" + , ">" + , ">=" + , "&" + , "|" + , "^" + , "^~" + , "~^" + , "**" + , "<<" + , ">>" + , "<<<" + , ">>>" + ] reserved' :: [String] reserved' = - [ "always" - , "and" - , "assign" - , "automatic" - , "begin" - , "buf" - , "bufif0" - , "bufif1" - , "case" - , "casex" - , "casez" - , "cell" - , "cmos" - , "config" - , "deassign" - , "default" - , "defparam" - , "design" - , "disable" - , "edge" - , "else" - , "end" - , "endcase" - , "endconfig" - , "endfunction" - , "endgenerate" - , "endmodule" - , "endprimitive" - , "endspecify" - , "endtable" - , "endtask" - , "event" - , "for" - , "force" - , "forever" - , "fork" - , "function" - , "generate" - , "genvar" - , "highz0" - , "highz1" - , "if" - , "ifnone" - , "incdir" - , "include" - , "initial" - , "inout" - , "input" - , "instance" - , "integer" - , "join" - , "large" - , "liblist" - , "library" - , "localparam" - , "macromodule" - , "medium" - , "module" - , "nand" - , "negedge" - , "nmos" - , "nor" - , "noshowcancelled" - , "not" - , "notif0" - , "notif1" - , "or" - , "output" - , "parameter" - , "pmos" - , "posedge" - , "primitive" - , "pull0" - , "pull1" - , "pulldown" - , "pullup" - , "pulsestyle_onevent" - , "pulsestyle_ondetect" - , "remos" - , "real" - , "realtime" - , "reg" - , "release" - , "repeat" - , "rnmos" - , "rpmos" - , "rtran" - , "rtranif0" - , "rtranif1" - , "scalared" - , "showcancelled" - , "signed" - , "small" - , "specify" - , "specparam" - , "strong0" - , "strong1" - , "supply0" - , "supply1" - , "table" - , "task" - , "time" - , "tran" - , "tranif0" - , "tranif1" - , "tri" - , "tri0" - , "tri1" - , "triand" - , "trior" - , "trireg" - , "unsigned" - , "use" - , "vectored" - , "wait" - , "wand" - , "weak0" - , "weak1" - , "while" - , "wire" - , "wor" - , "xnor" - , "xor" - ] + [ "always" + , "and" + , "assign" + , "automatic" + , "begin" + , "buf" + , "bufif0" + , "bufif1" + , "case" + , "casex" + , "casez" + , "cell" + , "cmos" + , "config" + , "deassign" + , "default" + , "defparam" + , "design" + , "disable" + , "edge" + , "else" + , "end" + , "endcase" + , "endconfig" + , "endfunction" + , "endgenerate" + , "endmodule" + , "endprimitive" + , "endspecify" + , "endtable" + , "endtask" + , "event" + , "for" + , "force" + , "forever" + , "fork" + , "function" + , "generate" + , "genvar" + , "highz0" + , "highz1" + , "if" + , "ifnone" + , "incdir" + , "include" + , "initial" + , "inout" + , "input" + , "instance" + , "integer" + , "join" + , "large" + , "liblist" + , "library" + , "localparam" + , "macromodule" + , "medium" + , "module" + , "nand" + , "negedge" + , "nmos" + , "nor" + , "noshowcancelled" + , "not" + , "notif0" + , "notif1" + , "or" + , "output" + , "parameter" + , "pmos" + , "posedge" + , "primitive" + , "pull0" + , "pull1" + , "pulldown" + , "pullup" + , "pulsestyle_onevent" + , "pulsestyle_ondetect" + , "remos" + , "real" + , "realtime" + , "reg" + , "release" + , "repeat" + , "rnmos" + , "rpmos" + , "rtran" + , "rtranif0" + , "rtranif1" + , "scalared" + , "showcancelled" + , "signed" + , "small" + , "specify" + , "specparam" + , "strong0" + , "strong1" + , "supply0" + , "supply1" + , "table" + , "task" + , "time" + , "tran" + , "tranif0" + , "tranif1" + , "tri" + , "tri0" + , "tri1" + , "triand" + , "trior" + , "trireg" + , "unsigned" + , "use" + , "vectored" + , "wait" + , "wand" + , "weak0" + , "weak1" + , "while" + , "wire" + , "wor" + , "xnor" + , "xor" + ] diff --git a/src/VeriFuzz/Mutate.hs b/src/VeriFuzz/Mutate.hs index 110685e..7092cbf 100644 --- a/src/VeriFuzz/Mutate.hs +++ b/src/VeriFuzz/Mutate.hs @@ -23,16 +23,16 @@ import VeriFuzz.Internal -- | Return if the 'Identifier' is in a 'ModDecl'. inPort :: Identifier -> ModDecl -> Bool inPort i m = inInput - where inInput = any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts + where inInput = any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts -- | Find the last assignment of a specific wire/reg to an expression, and -- returns that expression. findAssign :: Identifier -> [ModItem] -> Maybe Expr findAssign i items = safe last . catMaybes $ isAssign <$> items - where - isAssign (ModCA (ContAssign val expr)) | val == i = Just expr - | otherwise = Nothing - isAssign _ = Nothing + where + isAssign (ModCA (ContAssign val expr)) | val == i = Just expr + | otherwise = Nothing + isAssign _ = Nothing -- | Transforms an expression by replacing an Identifier with an -- expression. This is used inside 'transformOf' and 'traverseExpr' to replace @@ -54,13 +54,13 @@ replace = (transformOf traverseExpr .) . idTrans -- expression. This would require a different approach though. nestId :: Identifier -> ModDecl -> ModDecl nestId i m - | not $ inPort i m - = let expr = fromMaybe def . findAssign i $ m ^. modItems in m & get %~ replace i expr - | otherwise - = m - where - get = modItems . traverse . modContAssign . contAssignExpr - def = Id i + | not $ inPort i m + = let expr = fromMaybe def . findAssign i $ m ^. modItems in m & get %~ replace i expr + | otherwise + = m + where + get = modItems . traverse . modContAssign . contAssignExpr + def = Id i -- | Replaces an identifier by a expression in all the module declaration. nestSource :: Identifier -> VerilogSrc -> VerilogSrc @@ -91,12 +91,12 @@ allVars m = (m ^.. modOutPorts . traverse . portName) <> (m ^.. modInPorts . tra -- instantiateMod :: ModDecl -> ModDecl -> ModDecl instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) - where - out = Decl Nothing <$> m ^. modOutPorts - regIn = Decl Nothing <$> (m ^. modInPorts & traverse . portType .~ Reg) - inst = ModInst (m ^. modId) (m ^. modId <> (Identifier . showT $ count + 1)) conns - count = length . filter (== m ^. modId) $ main ^.. modItems . traverse . modInstId - conns = ModConn . Id <$> allVars m + where + out = Decl Nothing <$> m ^. modOutPorts + regIn = Decl Nothing <$> (m ^. modInPorts & traverse . portType .~ Reg) + inst = ModInst (m ^. modId) (m ^. modId <> (Identifier . showT $ count + 1)) conns + count = length . filter (== m ^. modId) $ main ^.. modItems . traverse . modInstId + conns = ModConn . Id <$> allVars m -- | Instantiate without adding wire declarations. It also does not count the -- current instantiations of the same module. @@ -106,12 +106,12 @@ instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) -- instantiateMod_ :: ModDecl -> ModItem instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns - where - conns = - ModConn - . Id - <$> (m ^.. modOutPorts . traverse . portName) - ++ (m ^.. modInPorts . traverse . portName) + where + conns = + ModConn + . Id + <$> (m ^.. modOutPorts . traverse . portName) + ++ (m ^.. modInPorts . traverse . portName) -- | Instantiate without adding wire declarations. It also does not count the -- current instantiations of the same module. @@ -121,15 +121,15 @@ instantiateMod_ m = ModInst (m ^. modId) (m ^. modId) conns -- instantiateModSpec_ :: Text -> ModDecl -> ModItem instantiateModSpec_ outChar m = ModInst (m ^. modId) (m ^. modId) conns - where - conns = zipWith ModConnNamed ids (Id <$> instIds) - ids = filterChar outChar (name modOutPorts) <> name modInPorts - instIds = name modOutPorts <> name modInPorts - name v = m ^.. v . traverse . portName + where + conns = zipWith ModConnNamed ids (Id <$> instIds) + ids = filterChar outChar (name modOutPorts) <> name modInPorts + instIds = name modOutPorts <> name modInPorts + name v = m ^.. v . traverse . portName filterChar :: Text -> [Identifier] -> [Identifier] filterChar t ids = - ids & traverse . getIdentifier %~ (\x -> fromMaybe x . safe head $ T.splitOn t x) + ids & traverse . getIdentifier %~ (\x -> fromMaybe x . safe head $ T.splitOn t x) -- | Initialise all the inputs and outputs to a module. -- @@ -141,9 +141,9 @@ filterChar t ids = -- initMod :: ModDecl -> ModDecl initMod m = m & modItems %~ ((out ++ inp) ++) - where - out = Decl (Just PortOut) <$> (m ^. modOutPorts) - inp = Decl (Just PortIn) <$> (m ^. modInPorts) + where + out = Decl (Just PortOut) <$> (m ^. modOutPorts) + inp = Decl (Just PortIn) <$> (m ^. modInPorts) -- | Make an 'Identifier' from and existing Identifier and an object with a -- 'Show' instance to make it unique. @@ -154,20 +154,20 @@ makeIdFrom a i = (i <>) . Identifier . ("_" <>) $ showT a -- modules to instantiate. makeTop :: Int -> ModDecl -> ModDecl makeTop i m = ModDecl (m ^. modId) ys (m ^. modInPorts) modIt - where - ys = yPort . flip makeIdFrom "y" <$> [1 .. i] - modIt = instantiateModSpec_ "_" . modN <$> [1 .. i] - modN n = m & modId %~ makeIdFrom n & modOutPorts .~ [yPort (makeIdFrom n "y")] + where + ys = yPort . flip makeIdFrom "y" <$> [1 .. i] + modIt = instantiateModSpec_ "_" . modN <$> [1 .. i] + modN n = m & modId %~ makeIdFrom n & modOutPorts .~ [yPort (makeIdFrom n "y")] -- | 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 = (modItems %~ (++ [assert])) . (modInPorts %~ addClk) . makeTop 2 - where - assert = Always . EventCtrl e . Just $ SeqBlock - [TaskEnable $ Task "assert" [BinOp (Id "y_1") BinEq (Id "y_2")]] - e = EPosEdge "clk" - addClk = (defaultPort "clk" :) + where + assert = Always . EventCtrl e . Just $ SeqBlock + [TaskEnable $ Task "assert" [BinOp (Id "y_1") BinEq (Id "y_2")]] + e = EPosEdge "clk" + addClk = (defaultPort "clk" :) -- | Provide declarations for all the ports that are passed to it. declareMod :: [Port] -> ModDecl -> ModDecl @@ -216,7 +216,7 @@ simplify e = e -- (x + (1'h0)) removeId :: [Identifier] -> Expr -> Expr removeId i = transform trans - where - trans (Id ident) | ident `notElem` i = Number 1 0 - | otherwise = Id ident - trans e = e + where + trans (Id ident) | ident `notElem` i = Number 1 0 + | otherwise = Id ident + trans e = e diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs index 0232b50..ca7af22 100644 --- a/src/VeriFuzz/Parser.hs +++ b/src/VeriFuzz/Parser.hs @@ -12,14 +12,14 @@ whole Verilog syntax, as the AST does not support it either. -} module VeriFuzz.Parser - ( -- * Parsers - parseVerilog - , parseVerilogSrc - , parseDescription - , parseModDecl - , parseContAssign - , parseExpr - ) + ( -- * Parsers + parseVerilog + , parseVerilogSrc + , parseDescription + , parseModDecl + , parseContAssign + , parseExpr + ) where import Data.Functor (($>)) @@ -58,14 +58,14 @@ matchOct c = c == 'o' || c == 'O' -- binary are not supported yet. parseNum :: Parser Expr parseNum = do - size <- fromIntegral <$> decimal - _ <- string "'" - matchNum size - where - matchNum size = - (satisfy matchHex >> Number size <$> hexadecimal) - <|> (satisfy matchDec >> Number size <$> decimal) - <|> (satisfy matchOct >> Number size <$> octal) + size <- fromIntegral <$> decimal + _ <- string "'" + matchNum size + where + matchNum size = + (satisfy matchHex >> Number size <$> hexadecimal) + <|> (satisfy matchDec >> Number size <$> decimal) + <|> (satisfy matchOct >> Number size <$> octal) parseVar :: Parser Expr parseVar = Id <$> ident @@ -75,72 +75,72 @@ parseFunction = reserved "unsigned" $> UnSignedFunc <|> reserved "signed" $> Sig parseFun :: Parser Expr parseFun = do - f <- spaces *> reservedOp "$" *> parseFunction - expr <- string "(" *> spaces *> parseExpr - _ <- spaces *> string ")" *> spaces - return $ Func f expr + f <- spaces *> reservedOp "$" *> parseFunction + expr <- string "(" *> spaces *> parseExpr + _ <- spaces *> string ")" *> spaces + return $ Func f expr parseTerm :: Parser Expr parseTerm = - parens parseExpr - <|> (Concat <$> aroundList (string "{") (string "}") parseExpr) - <|> parseFun - <|> lexeme parseNum - <|> parseVar - "simple expr" + parens parseExpr + <|> (Concat <$> aroundList (string "{") (string "}") parseExpr) + <|> parseFun + <|> lexeme parseNum + <|> parseVar + "simple expr" -- | Parses the ternary conditional operator. It will behave in a right -- associative way. parseCond :: Expr -> Parser Expr parseCond e = do - _ <- spaces *> reservedOp "?" - expr <- spaces *> parseExpr - _ <- spaces *> reservedOp ":" - Cond e expr <$> parseExpr + _ <- spaces *> reservedOp "?" + expr <- spaces *> parseExpr + _ <- spaces *> reservedOp ":" + Cond e expr <$> parseExpr parseExpr :: Parser Expr parseExpr = do - e <- parseExpr' - option e . try $ parseCond e + e <- parseExpr' + option e . try $ parseCond e -- | Table of binary and unary operators that encode the right precedence for -- each. parseTable :: [[ParseOperator Expr]] parseTable = - [ [prefix "!" (UnOp UnLNot), prefix "~" (UnOp UnNot)] - , [ prefix "&" (UnOp UnAnd) - , prefix "|" (UnOp UnOr) - , prefix "~&" (UnOp UnNand) - , prefix "~|" (UnOp UnNor) - , prefix "^" (UnOp UnXor) - , prefix "~^" (UnOp UnNxor) - , prefix "^~" (UnOp UnNxorInv) + [ [prefix "!" (UnOp UnLNot), prefix "~" (UnOp UnNot)] + , [ prefix "&" (UnOp UnAnd) + , prefix "|" (UnOp UnOr) + , prefix "~&" (UnOp UnNand) + , prefix "~|" (UnOp UnNor) + , prefix "^" (UnOp UnXor) + , prefix "~^" (UnOp UnNxor) + , prefix "^~" (UnOp UnNxorInv) + ] + , [prefix "+" (UnOp UnPlus), prefix "-" (UnOp UnMinus)] + , [binary "**" (sBinOp BinPower) AssocRight] + , [ binary "*" (sBinOp BinTimes) AssocLeft + , binary "/" (sBinOp BinDiv) AssocLeft + , binary "%" (sBinOp BinMod) AssocLeft + ] + , [binary "+" (sBinOp BinPlus) AssocLeft, binary "-" (sBinOp BinPlus) AssocLeft] + , [binary "<<" (sBinOp BinLSL) AssocLeft, binary ">>" (sBinOp BinLSR) AssocLeft] + , [binary "<<<" (sBinOp BinASL) AssocLeft, binary ">>>" (sBinOp BinASR) AssocLeft] + , [ binary "<" (sBinOp BinLT) AssocNone + , binary ">" (sBinOp BinGT) AssocNone + , binary "<=" (sBinOp BinLEq) AssocNone + , binary ">=" (sBinOp BinLEq) AssocNone + ] + , [binary "==" (sBinOp BinEq) AssocNone, binary "!=" (sBinOp BinNEq) AssocNone] + , [binary "===" (sBinOp BinEq) AssocNone, binary "!==" (sBinOp BinNEq) AssocNone] + , [binary "&" (sBinOp BinAnd) AssocLeft] + , [ binary "^" (sBinOp BinXor) AssocLeft + , binary "^~" (sBinOp BinXNor) AssocLeft + , binary "~^" (sBinOp BinXNorInv) AssocLeft + ] + , [binary "|" (sBinOp BinOr) AssocLeft] + , [binary "&&" (sBinOp BinLAnd) AssocLeft] + , [binary "||" (sBinOp BinLOr) AssocLeft] ] - , [prefix "+" (UnOp UnPlus), prefix "-" (UnOp UnMinus)] - , [binary "**" (sBinOp BinPower) AssocRight] - , [ binary "*" (sBinOp BinTimes) AssocLeft - , binary "/" (sBinOp BinDiv) AssocLeft - , binary "%" (sBinOp BinMod) AssocLeft - ] - , [binary "+" (sBinOp BinPlus) AssocLeft, binary "-" (sBinOp BinPlus) AssocLeft] - , [binary "<<" (sBinOp BinLSL) AssocLeft, binary ">>" (sBinOp BinLSR) AssocLeft] - , [binary "<<<" (sBinOp BinASL) AssocLeft, binary ">>>" (sBinOp BinASR) AssocLeft] - , [ binary "<" (sBinOp BinLT) AssocNone - , binary ">" (sBinOp BinGT) AssocNone - , binary "<=" (sBinOp BinLEq) AssocNone - , binary ">=" (sBinOp BinLEq) AssocNone - ] - , [binary "==" (sBinOp BinEq) AssocNone, binary "!=" (sBinOp BinNEq) AssocNone] - , [binary "===" (sBinOp BinEq) AssocNone, binary "!==" (sBinOp BinNEq) AssocNone] - , [binary "&" (sBinOp BinAnd) AssocLeft] - , [ binary "^" (sBinOp BinXor) AssocLeft - , binary "^~" (sBinOp BinXNor) AssocLeft - , binary "~^" (sBinOp BinXNorInv) AssocLeft - ] - , [binary "|" (sBinOp BinOr) AssocLeft] - , [binary "&&" (sBinOp BinLAnd) AssocLeft] - , [binary "||" (sBinOp BinLOr) AssocLeft] - ] binary :: String -> (a -> a -> a) -> Assoc -> ParseOperator a binary name fun = Infix ((reservedOp name "binary") >> return fun) @@ -150,42 +150,42 @@ prefix name fun = Prefix ((reservedOp name "prefix") >> return fun) aroundList :: Parser a -> Parser b -> Parser c -> Parser [c] aroundList a b c = lexeme $ do - l <- a *> spaces *> commaSep c - _ <- b - return l + l <- a *> spaces *> commaSep c + _ <- b + return l parseContAssign :: Parser ContAssign parseContAssign = do - var <- reserved "assign" *> ident - expr <- reservedOp "=" *> parseExpr - _ <- symbol ";" - return $ ContAssign var expr + var <- reserved "assign" *> ident + expr <- reservedOp "=" *> parseExpr + _ <- symbol ";" + return $ ContAssign var expr -- | Parse a range and return the total size. As it is inclusive, 1 has to be -- added to the difference. parseRange :: Parser Int parseRange = do - rangeH <- symbol "[" *> decimal - rangeL <- symbol ":" *> decimal - _ <- symbol "]" - return . fromIntegral $ rangeH - rangeL + 1 + rangeH <- symbol "[" *> decimal + rangeL <- symbol ":" *> decimal + _ <- symbol "]" + return . fromIntegral $ rangeH - rangeL + 1 ident :: Parser Identifier ident = Identifier . T.pack <$> identifier parseNetDecl :: Maybe PortDir -> Parser ModItem parseNetDecl pd = do - t <- option Wire type_ - sign <- option False (reserved "signed" $> True) - range <- option 1 parseRange - name <- ident - _ <- symbol ";" - return . Decl pd . Port t sign range $ name - where type_ = reserved "wire" $> Wire <|> reserved "reg" $> Reg + t <- option Wire type_ + sign <- option False (reserved "signed" $> True) + range <- option 1 parseRange + name <- ident + _ <- symbol ";" + return . Decl pd . Port t sign range $ name + where type_ = reserved "wire" $> Wire <|> reserved "reg" $> Reg parsePortDir :: Parser PortDir parsePortDir = - reserved "output" $> PortOut <|> reserved "input" $> PortIn <|> reserved "inout" $> PortInOut + reserved "output" $> PortOut <|> reserved "input" $> PortIn <|> reserved "inout" $> PortInOut parseDecl :: Parser ModItem parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing @@ -198,12 +198,12 @@ parseModList = list <|> spaces $> [] where list = aroundList (string "(") (strin parseModDecl :: Parser ModDecl parseModDecl = do - name <- reserved "module" *> ident - modL <- fmap defaultPort <$> parseModList - _ <- symbol ";" - modItem <- lexeme $ option [] . try $ many1 parseModItem - _ <- reserved "endmodule" - return $ ModDecl name [] modL modItem + name <- reserved "module" *> ident + modL <- fmap defaultPort <$> parseModList + _ <- symbol ";" + modItem <- lexeme $ option [] . try $ many1 parseModItem + _ <- reserved "endmodule" + return $ ModDecl name [] modL modItem parseDescription :: Parser Description parseDescription = Description <$> lexeme parseModDecl diff --git a/src/VeriFuzz/Random.hs b/src/VeriFuzz/Random.hs index e5d2c68..c471a04 100644 --- a/src/VeriFuzz/Random.hs +++ b/src/VeriFuzz/Random.hs @@ -35,22 +35,22 @@ rDupsCirc = Circuit . rDups . getCircuit -- `n` that is passed to it. arbitraryEdge :: (Arbitrary e) => Int -> Gen (LEdge e) arbitraryEdge n = do - x <- with $ \a -> a < n && a > 0 && a /= n - 1 - y <- with $ \a -> x < a && a < n && a > 0 - z <- QC.arbitrary - return (x, y, z) - where with = QC.suchThat $ QC.resize n QC.arbitrary + x <- with $ \a -> a < n && a > 0 && a /= n - 1 + y <- with $ \a -> x < a && a < n && a > 0 + z <- QC.arbitrary + return (x, y, z) + where with = QC.suchThat $ QC.resize n QC.arbitrary -- | Gen instance for a random acyclic DAG. randomDAG :: (Arbitrary l, Arbitrary e, Eq l, Eq e) => Gen (Gr l e) -- ^ The generated graph. It uses Arbitrary to -- generate random instances of each node randomDAG = do - list <- QC.infiniteListOf QC.arbitrary - l <- QC.infiniteListOf aE - QC.sized (\n -> return . G.mkGraph (nodes list n) $ take (10 * n) l) - where - nodes l n = zip [0 .. n] $ take n l - aE = QC.sized arbitraryEdge + list <- QC.infiniteListOf QC.arbitrary + l <- QC.infiniteListOf aE + QC.sized (\n -> return . G.mkGraph (nodes list n) $ take (10 * n) l) + where + nodes l n = zip [0 .. n] $ take n l + aE = QC.sized arbitraryEdge -- | Generate a random acyclic DAG with an IO instance. genRandomDAG :: (Arbitrary l, Arbitrary e, Eq l, Eq e) => IO (Gr l e) diff --git a/src/VeriFuzz/XST.hs b/src/VeriFuzz/XST.hs index 337294a..22720cd 100644 --- a/src/VeriFuzz/XST.hs +++ b/src/VeriFuzz/XST.hs @@ -38,20 +38,20 @@ defaultXst = Xst "xst" "netgen" runSynthXst :: Xst -> ModDecl -> FilePath -> Sh () runSynthXst sim m outf = do - dir <- pwd - writefile xstFile $ xstSynthConfig m - writefile prjFile [st|verilog work "rtl.v"|] - writefile "rtl.v" $ genSource m - echoP "XST: run" - _ <- logger dir "xst" $ timeout (xstPath sim) ["-ifn", toTextIgnore xstFile] - echoP "XST: netgen" - _ <- logger dir "netgen" $ run - (netgenPath sim) - ["-w", "-ofmt", "verilog", toTextIgnore $ modFile <.> "ngc", toTextIgnore outf] - echoP "XST: clean" - noPrint $ run_ "sed" ["-i", "/^`ifndef/,/^`endif/ d; s/ *Timestamp: .*//;", toTextIgnore outf] - echoP "XST: done" - where - modFile = fromText $ modName m - xstFile = modFile <.> "xst" - prjFile = modFile <.> "prj" + dir <- pwd + writefile xstFile $ xstSynthConfig m + writefile prjFile [st|verilog work "rtl.v"|] + writefile "rtl.v" $ genSource m + echoP "XST: run" + _ <- logger dir "xst" $ timeout (xstPath sim) ["-ifn", toTextIgnore xstFile] + echoP "XST: netgen" + _ <- logger dir "netgen" $ run + (netgenPath sim) + ["-w", "-ofmt", "verilog", toTextIgnore $ modFile <.> "ngc", toTextIgnore outf] + echoP "XST: clean" + noPrint $ run_ "sed" ["-i", "/^`ifndef/,/^`endif/ d; s/ *Timestamp: .*//;", toTextIgnore outf] + echoP "XST: done" + where + modFile = fromText $ modName m + xstFile = modFile <.> "xst" + prjFile = modFile <.> "prj" diff --git a/src/VeriFuzz/Yosys.hs b/src/VeriFuzz/Yosys.hs index 9d3a298..240cc8f 100644 --- a/src/VeriFuzz/Yosys.hs +++ b/src/VeriFuzz/Yosys.hs @@ -35,25 +35,26 @@ defaultYosys :: Yosys defaultYosys = Yosys "yosys" writeSimFile - :: Yosys -- ^ Simulator instance - -> ModDecl -- ^ Current module - -> FilePath -- ^ Output sim file - -> Sh () + :: Yosys -- ^ Simulator instance + -> ModDecl -- ^ Current module + -> FilePath -- ^ Output sim file + -> Sh () writeSimFile _ m file = do - writefile "rtl.v" $ genSource m - writefile file yosysSimConfig + writefile "rtl.v" $ genSource m + writefile file yosysSimConfig runSynthYosys :: Yosys -> ModDecl -> FilePath -> Sh () runSynthYosys sim m outf = do - dir <- pwd - writefile inpf $ genSource m - echoP "Yosys: synthesis" - _ <- logger dir "yosys" $ timeout (yosysPath sim) ["-b", "verilog -noattr", "-o", out, "-S", inp] - echoP "Yosys: synthesis done" - where - inpf = "rtl.v" - inp = toTextIgnore inpf - out = toTextIgnore outf + dir <- pwd + writefile inpf $ genSource m + echoP "Yosys: synthesis" + _ <- logger dir "yosys" + $ timeout (yosysPath sim) ["-b", "verilog -noattr", "-o", out, "-S", inp] + echoP "Yosys: synthesis done" + where + inpf = "rtl.v" + inp = toTextIgnore inpf + out = toTextIgnore outf -- ids = T.intercalate "," $ allVars m ^.. traverse . getIdentifier runMaybeSynth :: (Synthesize a) => Maybe a -> ModDecl -> Sh () @@ -62,24 +63,24 @@ runMaybeSynth Nothing m = writefile "syn_rtl.v" $ genSource m runEquivYosys :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () runEquivYosys yosys sim1 sim2 m = do - writefile "top.v" . genSource . initMod $ makeTop 2 m - writefile checkFile $ yosysSatConfig sim1 sim2 m - runSynth sim1 m $ fromText [st|syn_#{toText sim1}.v|] - runMaybeSynth sim2 m - echoP "Yosys: equivalence check" - run_ (yosysPath yosys) [toTextIgnore checkFile] - echoP "Yosys: equivalence done" - where checkFile = fromText [st|test.#{toText sim1}.#{maybe "rtl" toText sim2}.ys|] + writefile "top.v" . genSource . initMod $ makeTop 2 m + writefile checkFile $ yosysSatConfig sim1 sim2 m + runSynth sim1 m $ fromText [st|syn_#{toText sim1}.v|] + runMaybeSynth sim2 m + echoP "Yosys: equivalence check" + run_ (yosysPath yosys) [toTextIgnore checkFile] + echoP "Yosys: equivalence done" + where checkFile = fromText [st|test.#{toText sim1}.#{maybe "rtl" toText sim2}.ys|] runEquiv :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () runEquiv _ sim1 sim2 m = do - root <- rootPath - dir <- pwd - echoP "SymbiYosys: setup" - writefile "top.v" . genSource . initMod $ makeTopAssert m - writefile "test.sby" $ sbyConfig root sim1 sim2 m - runSynth sim1 m $ fromText [st|syn_#{toText sim1}.v|] - runMaybeSynth sim2 m - echoP "SymbiYosys: run" - _ <- logger dir "symbiyosys" $ run "sby" ["test.sby"] - echoP "SymbiYosys: done" + root <- rootPath + dir <- pwd + echoP "SymbiYosys: setup" + writefile "top.v" . genSource . initMod $ makeTopAssert m + writefile "test.sby" $ sbyConfig root sim1 sim2 m + runSynth sim1 m $ fromText [st|syn_#{toText sim1}.v|] + runMaybeSynth sim2 m + echoP "SymbiYosys: run" + _ <- logger dir "symbiyosys" $ run "sby" ["test.sby"] + echoP "SymbiYosys: done" diff --git a/test/Property.hs b/test/Property.hs index 0d1b154..8a32751 100644 --- a/test/Property.hs +++ b/test/Property.hs @@ -1,6 +1,6 @@ module Property - ( propertyTests - ) + ( propertyTests + ) where import Data.Either (fromRight, isRight) @@ -35,35 +35,29 @@ instance QC.Arbitrary AltTestGraph where simpleGraph :: TestTree simpleGraph = QC.testProperty "simple graph generation check" $ \graph -> simp graph - where simp = G.isSimple . getGraph + where simp = G.isSimple . getGraph simpleAltGraph :: TestTree simpleAltGraph = QC.testProperty "simple alternative graph generation check" $ \graph -> simp graph - where simp = G.isSimple . getAltGraph + where simp = G.isSimple . getAltGraph parserInput' :: ModDeclSub -> Bool -parserInput' (ModDeclSub v) = - isRight $ parse parseModDecl "input_test.v" str - where - str = show . GenVerilog $ v +parserInput' (ModDeclSub v) = isRight $ parse parseModDecl "input_test.v" str + where str = show . GenVerilog $ v parserIdempotent' :: ModDeclSub -> QC.Property -parserIdempotent' (ModDeclSub v) = - p sv === (p . p) sv +parserIdempotent' (ModDeclSub v) = p sv === (p . p) sv where vshow = show . GenVerilog sv = vshow v - p = vshow . fromRight (error "Failed idempotent test") - . parse parseModDecl "idempotent_test.v" + p = vshow . fromRight (error "Failed idempotent test") . parse parseModDecl "idempotent_test.v" parserInput :: TestTree -parserInput = QC.testProperty "parser input" $ - parserInput' +parserInput = QC.testProperty "parser input" $ parserInput' parserIdempotent :: TestTree -parserIdempotent = QC.testProperty "parser idempotence" $ - parserIdempotent' +parserIdempotent = QC.testProperty "parser idempotence" $ parserIdempotent' propertyTests :: TestTree -propertyTests = testGroup "Property Tests" [simpleGraph, simpleAltGraph - , parserInput, parserIdempotent] +propertyTests = + testGroup "Property Tests" [simpleGraph, simpleAltGraph, parserInput, parserIdempotent] diff --git a/test/Unit.hs b/test/Unit.hs index 404c899..d911d2f 100644 --- a/test/Unit.hs +++ b/test/Unit.hs @@ -1,6 +1,6 @@ module Unit - ( unitTests - ) + ( unitTests + ) where import Control.Lens @@ -10,75 +10,80 @@ import VeriFuzz unitTests :: TestTree unitTests = testGroup - "Unit tests" - [ testCase "Transformation of AST" $ assertEqual - "Successful transformation" - transformExpectedResult - (transform trans transformTestData) - ] + "Unit tests" + [ testCase "Transformation of AST" $ assertEqual "Successful transformation" + transformExpectedResult + (transform trans transformTestData) + ] transformTestData :: Expr transformTestData = BinOp - (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) BinAnd (BinOp (Id "id1") BinAnd (Id "id2"))) - BinAnd - (BinOp + (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) BinAnd (BinOp (Id "id1") BinAnd (Id "id2"))) + BinAnd (BinOp - (BinOp (Id "id1") BinAnd (Id "id2")) - BinAnd - (BinOp - (Id "id1") - BinAnd - (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) BinAnd (BinOp (Id "id1") BinAnd (Id "id2"))) - ) - ) - BinOr - (Concat - [ Concat - [ Concat [Id "id1", Id "id2", Id "id2"] - , Id "id2" - , Id "id2" - , Concat [Id "id2", Id "id2", Concat [Id "id1", Id "id2"]] - , Id "id2" - ] - , Id "id1" - , Id "id2" - ] + (BinOp + (BinOp (Id "id1") BinAnd (Id "id2")) + BinAnd + (BinOp + (Id "id1") + BinAnd + (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) + BinAnd + (BinOp (Id "id1") BinAnd (Id "id2")) + ) + ) + ) + BinOr + (Concat + [ Concat + [ Concat [Id "id1", Id "id2", Id "id2"] + , Id "id2" + , Id "id2" + , Concat [Id "id2", Id "id2", Concat [Id "id1", Id "id2"]] + , Id "id2" + ] + , Id "id1" + , Id "id2" + ] + ) ) - ) transformExpectedResult :: Expr transformExpectedResult = BinOp - (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) BinAnd (BinOp (Id "id1") BinAnd (Id "Replaced"))) - BinAnd - (BinOp + (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) + BinAnd + (BinOp (Id "id1") BinAnd (Id "Replaced")) + ) + BinAnd (BinOp - (BinOp (Id "id1") BinAnd (Id "Replaced")) - BinAnd - (BinOp - (Id "id1") - BinAnd - (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) - BinAnd - (BinOp (Id "id1") BinAnd (Id "Replaced")) + (BinOp + (BinOp (Id "id1") BinAnd (Id "Replaced")) + BinAnd + (BinOp + (Id "id1") + BinAnd + (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) + BinAnd + (BinOp (Id "id1") BinAnd (Id "Replaced")) + ) + ) + ) + BinOr + (Concat + [ Concat + [ Concat [Id "id1", Id "Replaced", Id "Replaced"] + , Id "Replaced" + , Id "Replaced" + , Concat [Id "Replaced", Id "Replaced", Concat [Id "id1", Id "Replaced"]] + , Id "Replaced" + ] + , Id "id1" + , Id "Replaced" + ] ) - ) - ) - BinOr - (Concat - [ Concat - [ Concat [Id "id1", Id "Replaced", Id "Replaced"] - , Id "Replaced" - , Id "Replaced" - , Concat [Id "Replaced", Id "Replaced", Concat [Id "id1", Id "Replaced"]] - , Id "Replaced" - ] - , Id "id1" - , Id "Replaced" - ] ) - ) trans :: Expr -> Expr trans e = case e of - Id i -> if i == Identifier "id2" then Id $ Identifier "Replaced" else Id i - _ -> e + Id i -> if i == Identifier "id2" then Id $ Identifier "Replaced" else Id i + _ -> e -- cgit