From 79f7d262ed0246ea6556478c611c0db59bb47191 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Grave Date: Mon, 25 Feb 2019 16:27:35 +0000 Subject: Reformat using brittany --- src/VeriFuzz/AST.hs | 15 ++++--- src/VeriFuzz/CodeGen.hs | 49 ++++++++++++++------- src/VeriFuzz/Gen.hs | 7 ++- src/VeriFuzz/General.hs | 3 +- src/VeriFuzz/Icarus.hs | 6 ++- src/VeriFuzz/Internal/AST.hs | 4 +- src/VeriFuzz/Internal/Circuit.hs | 8 +++- src/VeriFuzz/Mutate.hs | 37 ++++++++++++---- src/VeriFuzz/Parser.hs | 95 +++++++++++++++++++++++----------------- src/VeriFuzz/Random.hs | 3 +- src/VeriFuzz/Reduce.hs | 3 +- src/VeriFuzz/XST.hs | 14 +++++- src/VeriFuzz/Yosys.hs | 19 +++++--- 13 files changed, 178 insertions(+), 85 deletions(-) (limited to 'src/VeriFuzz') diff --git a/src/VeriFuzz/AST.hs b/src/VeriFuzz/AST.hs index cd16235..a37fc61 100644 --- a/src/VeriFuzz/AST.hs +++ b/src/VeriFuzz/AST.hs @@ -332,9 +332,10 @@ exprWithContext [] n | n == 0 = QC.oneof exprSafeList | n > 0 = QC.oneof $ exprRecList subexpr | otherwise = exprWithContext [] 0 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 +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) instance QC.Arbitrary Expr where @@ -555,13 +556,15 @@ traverseModConn f (ModConnNamed a e) = ModConnNamed a <$> f e traverseModItem :: (Applicative f) => (Expr -> f Expr) -> ModItem -> f ModItem traverseModItem f (ModCA (ContAssign a e)) = ModCA . ContAssign a <$> f e -traverseModItem f (ModInst a b e ) = ModInst a b <$> sequenceA (traverseModConn f <$> e) -traverseModItem _ e = pure e +traverseModItem f (ModInst a b e) = + ModInst a b <$> sequenceA (traverseModConn f <$> e) +traverseModItem _ e = pure e makeLenses ''ModDecl modPortGen :: QC.Gen Port -modPortGen = Port <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary +modPortGen = + Port <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary instance QC.Arbitrary ModDecl where arbitrary = ModDecl <$> QC.arbitrary <*> QC.arbitrary <*> QC.listOf1 modPortGen <*> QC.arbitrary diff --git a/src/VeriFuzz/CodeGen.hs b/src/VeriFuzz/CodeGen.hs index f337b99..88a92b6 100644 --- a/src/VeriFuzz/CodeGen.hs +++ b/src/VeriFuzz/CodeGen.hs @@ -53,7 +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" + "module " + <> m + ^. modId + . getIdentifier + <> ports + <> ";\n" + <> modI + <> "endmodule\n" where ports | noIn && noOut = "" | otherwise = "(" <> comma (genModPort <$> outIn) <> ")" @@ -98,8 +105,9 @@ genModuleItem (Decl dir port) = maybe "" makePort dir <> genPort port <> ";\n" where makePort = (<> " ") . genPortDir genModConn :: ModConn -> Text -genModConn (ModConn c ) = genExpr c -genModConn (ModConnNamed n c) = "." <> n ^. getIdentifier <> "(" <> genExpr c <> ")" +genModConn (ModConn c) = genExpr c +genModConn (ModConnNamed n c) = + "." <> n ^. getIdentifier <> "(" <> genExpr c <> ")" -- | Generate continuous assignment genContAssign :: ContAssign -> Text @@ -115,17 +123,20 @@ genFunc UnSignedFunc = "$unsigned" -- | Generate 'Expr' to 'Text'. 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) "") <> ")" +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 = "-" -genExpr (Id i ) = i ^. getIdentifier -genExpr (Concat c ) = "{" <> comma (genExpr <$> c) <> "}" -genExpr (UnOp u e ) = "(" <> genUnaryOperator u <> genExpr e <> ")" -genExpr (Cond l t f) = "(" <> genExpr l <> " ? " <> genExpr t <> " : " <> genExpr f <> ")" -genExpr (Func f e ) = genFunc f <> "(" <> genExpr e <> ")" -genExpr (Str t ) = "\"" <> t <> "\"" +genExpr (Id i) = i ^. getIdentifier +genExpr (Concat c) = "{" <> comma (genExpr <$> c) <> "}" +genExpr (UnOp u e) = "(" <> genUnaryOperator u <> genExpr e <> ")" +genExpr (Cond l t f) = + "(" <> genExpr l <> " ? " <> genExpr t <> " : " <> genExpr f <> ")" +genExpr (Func f e) = genFunc f <> "(" <> genExpr e <> ")" +genExpr (Str t ) = "\"" <> t <> "\"" -- | Convert 'BinaryOperator' to 'Text'. genBinaryOperator :: BinaryOperator -> Text @@ -186,7 +197,13 @@ 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 @@ -197,7 +214,8 @@ genPortType Wire = "wire" genPortType Reg = "reg" genAssign :: Text -> Assign -> Text -genAssign op (Assign r d e) = genLVal r <> op <> maybe "" genDelay d <> genExpr e +genAssign op (Assign r d e) = + genLVal r <> op <> maybe "" genDelay d <> genExpr e genStmnt :: Stmnt -> Text genStmnt (TimeCtrl d stat ) = genDelay d <> " " <> defMap stat @@ -210,8 +228,9 @@ genStmnt (TaskEnable task) = genTask task <> ";\n" genStmnt (SysTaskEnable task) = "$" <> genTask task <> ";\n" genTask :: Task -> Text -genTask (Task name expr) | null expr = i - | otherwise = i <> "(" <> comma (genExpr <$> expr) <> ")" +genTask (Task name expr) + | null expr = i + | otherwise = i <> "(" <> comma (genExpr <$> expr) <> ")" where i = name ^. getIdentifier -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. diff --git a/src/VeriFuzz/Gen.hs b/src/VeriFuzz/Gen.hs index 3413ee6..1e83888 100644 --- a/src/VeriFuzz/Gen.hs +++ b/src/VeriFuzz/Gen.hs @@ -54,7 +54,12 @@ randomMod inps total = do 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] + return + . initMod + . declareMod other + . ModDecl "test_module" yport inputs_ + $ x + ++ [y] where ids = toId <$> [1 .. total] end = drop inps ids diff --git a/src/VeriFuzz/General.hs b/src/VeriFuzz/General.hs index ee230e5..ecbb1da 100644 --- a/src/VeriFuzz/General.hs +++ b/src/VeriFuzz/General.hs @@ -72,7 +72,8 @@ echoP t = do 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") +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 diff --git a/src/VeriFuzz/Icarus.hs b/src/VeriFuzz/Icarus.hs index f848958..3d62c23 100644 --- a/src/VeriFuzz/Icarus.hs +++ b/src/VeriFuzz/Icarus.hs @@ -59,7 +59,8 @@ addDisplay s = concat $ transpose where l = length s assignFunc :: [Port] -> ByteString -> Stmnt -assignFunc inp bs = NonBlockAssign . Assign conc Nothing . Number (B.length bs * 8) $ bsToI bs +assignFunc inp bs = + NonBlockAssign . Assign conc Nothing . Number (B.length bs * 8) $ bsToI bs where conc = RegConcat (portToExpr <$> inp) convert :: Text -> ByteString @@ -96,7 +97,8 @@ 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] + _ <- logger dir "icarus" + $ run (icarusPath sim) ["-o", "main", toTextIgnore f] echoP "Icarus: Run" B.take 8 . BA.convert . (hash :: ByteString -> Digest SHA256) <$> logger dir diff --git a/src/VeriFuzz/Internal/AST.hs b/src/VeriFuzz/Internal/AST.hs index 7866f61..0130287 100644 --- a/src/VeriFuzz/Internal/AST.hs +++ b/src/VeriFuzz/Internal/AST.hs @@ -45,7 +45,9 @@ testBench = ModDecl [ regDecl "a" , regDecl "b" , wireDecl "c" - , ModInst "and" "and_gate" [ModConn $ Id "c", ModConn $ Id "a", ModConn $ Id "b"] + , 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 diff --git a/src/VeriFuzz/Internal/Circuit.hs b/src/VeriFuzz/Internal/Circuit.hs index 0634f01..d752c83 100644 --- a/src/VeriFuzz/Internal/Circuit.hs +++ b/src/VeriFuzz/Internal/Circuit.hs @@ -22,7 +22,13 @@ fromNode node = T.pack $ "w" <> show node filterGr :: (Graph gr) => gr n e -> (Node -> Bool) -> [Node] filterGr graph f = filter f $ G.nodes graph -only :: (Graph gr) => gr n e -> (gr n e -> Node -> Int) -> (gr n e -> Node -> Int) -> Node -> Bool +only + :: (Graph gr) + => gr n e + -> (gr n e -> Node -> Int) + -> (gr n e -> Node -> Int) + -> Node + -> Bool only graph fun1 fun2 n = fun1 graph n == 0 && fun2 graph n /= 0 inputs :: (Graph gr) => gr n e -> [Node] diff --git a/src/VeriFuzz/Mutate.hs b/src/VeriFuzz/Mutate.hs index 7092cbf..3052322 100644 --- a/src/VeriFuzz/Mutate.hs +++ b/src/VeriFuzz/Mutate.hs @@ -23,7 +23,9 @@ 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. @@ -55,7 +57,8 @@ replace = (transformOf traverseExpr .) . idTrans 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 + = let expr = fromMaybe def . findAssign i $ m ^. modItems + in m & get %~ replace i expr | otherwise = m where @@ -68,10 +71,13 @@ nestSource i src = src & getVerilogSrc . traverse . getDescription %~ nestId i -- | Nest variables in the format @w[0-9]*@ up to a certain number. nestUpTo :: Int -> VerilogSrc -> VerilogSrc -nestUpTo i src = foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] +nestUpTo i src = + foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] allVars :: ModDecl -> [Identifier] -allVars m = (m ^.. modOutPorts . traverse . portName) <> (m ^.. modInPorts . traverse . portName) +allVars m = + (m ^.. modOutPorts . traverse . portName) + <> (m ^.. modInPorts . traverse . portName) -- $setup -- >>> import VeriFuzz.CodeGen @@ -94,8 +100,16 @@ 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 + 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 @@ -129,7 +143,10 @@ instantiateModSpec_ outChar m = ModInst (m ^. modId) (m ^. modId) conns 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. -- @@ -157,12 +174,14 @@ 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")] + 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 +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")]] diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs index ca7af22..23329bb 100644 --- a/src/VeriFuzz/Parser.hs +++ b/src/VeriFuzz/Parser.hs @@ -71,7 +71,8 @@ parseVar :: Parser Expr parseVar = Id <$> ident parseFunction :: Parser Function -parseFunction = reserved "unsigned" $> UnSignedFunc <|> reserved "signed" $> SignedFunc +parseFunction = + reserved "unsigned" $> UnSignedFunc <|> reserved "signed" $> SignedFunc parseFun :: Parser Expr parseFun = do @@ -106,41 +107,51 @@ parseExpr = do -- | 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) +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 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) @@ -185,7 +196,12 @@ parseNetDecl pd = do 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 @@ -194,7 +210,8 @@ parseModItem :: Parser ModItem parseModItem = (ModCA <$> parseContAssign) <|> parseDecl parseModList :: Parser [Identifier] -parseModList = list <|> spaces $> [] where list = aroundList (string "(") (string ")") ident +parseModList = list <|> spaces $> [] + where list = aroundList (string "(") (string ")") ident parseModDecl :: Parser ModDecl parseModDecl = do @@ -209,7 +226,7 @@ parseDescription :: Parser Description parseDescription = Description <$> lexeme parseModDecl parseVerilogSrc :: Parser VerilogSrc -parseVerilogSrc = VerilogSrc <$> (whiteSpace *> (many parseDescription)) +parseVerilogSrc = VerilogSrc <$> (whiteSpace *> many parseDescription) parseVerilog :: String -> String -> Either ParseError VerilogSrc -parseVerilog f s = parse parseVerilogSrc f s +parseVerilog = parse parseVerilogSrc diff --git a/src/VeriFuzz/Random.hs b/src/VeriFuzz/Random.hs index c471a04..c937043 100644 --- a/src/VeriFuzz/Random.hs +++ b/src/VeriFuzz/Random.hs @@ -21,7 +21,8 @@ import qualified Test.QuickCheck as QC import VeriFuzz.Circuit dupFolder :: (Eq a, Eq b) => Context a b -> [Context a b] -> [Context a b] -dupFolder cont ns = unique cont : ns where unique (a, b, c, d) = (nub a, b, c, nub d) +dupFolder cont ns = unique cont : ns + where unique (a, b, c, d) = (nub a, b, c, nub d) -- | Remove duplicates. rDups :: (Eq a, Eq b) => Gr a b -> Gr a b diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 47cdcac..35eea4b 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -19,7 +19,8 @@ halve :: [a] -> ([a], [a]) halve l = splitAt (length l `div` 2) l removeUninitWires :: [ModItem] -> [ModItem] -removeUninitWires ms = ms where ids = ms ^.. traverse . modContAssign . contAssignNetLVal +removeUninitWires ms = ms + where ids = ms ^.. traverse . modContAssign . contAssignNetLVal halveModDecl :: ModDecl -> (ModDecl, ModDecl) halveModDecl m = (m & modItems %~ fst . halve, m & modItems %~ snd . halve) diff --git a/src/VeriFuzz/XST.hs b/src/VeriFuzz/XST.hs index 22720cd..e8e3a72 100644 --- a/src/VeriFuzz/XST.hs +++ b/src/VeriFuzz/XST.hs @@ -47,9 +47,19 @@ runSynthXst sim m outf = do echoP "XST: netgen" _ <- logger dir "netgen" $ run (netgenPath sim) - ["-w", "-ofmt", "verilog", toTextIgnore $ modFile <.> "ngc", toTextIgnore outf] + [ "-w" + , "-ofmt" + , "verilog" + , toTextIgnore $ modFile <.> "ngc" + , toTextIgnore outf + ] echoP "XST: clean" - noPrint $ run_ "sed" ["-i", "/^`ifndef/,/^`endif/ d; s/ *Timestamp: .*//;", toTextIgnore outf] + noPrint $ run_ + "sed" + [ "-i" + , "/^`ifndef/,/^`endif/ d; s/ *Timestamp: .*//;" + , toTextIgnore outf + ] echoP "XST: done" where modFile = fromText $ modName m diff --git a/src/VeriFuzz/Yosys.hs b/src/VeriFuzz/Yosys.hs index 240cc8f..fd5bb5b 100644 --- a/src/VeriFuzz/Yosys.hs +++ b/src/VeriFuzz/Yosys.hs @@ -49,7 +49,9 @@ runSynthYosys sim m outf = do writefile inpf $ genSource m echoP "Yosys: synthesis" _ <- logger dir "yosys" - $ timeout (yosysPath sim) ["-b", "verilog -noattr", "-o", out, "-S", inp] + $ timeout + (yosysPath sim) + ["-b", "verilog -noattr", "-o", out, "-S", inp] echoP "Yosys: synthesis done" where inpf = "rtl.v" @@ -58,10 +60,12 @@ runSynthYosys sim m outf = do -- ids = T.intercalate "," $ allVars m ^.. traverse . getIdentifier runMaybeSynth :: (Synthesize a) => Maybe a -> ModDecl -> Sh () -runMaybeSynth (Just sim) m = runSynth sim m $ fromText [st|syn_#{toText sim}.v|] -runMaybeSynth Nothing m = writefile "syn_rtl.v" $ genSource m +runMaybeSynth (Just sim) m = + runSynth sim m $ fromText [st|syn_#{toText sim}.v|] +runMaybeSynth Nothing m = writefile "syn_rtl.v" $ genSource m -runEquivYosys :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () +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 @@ -70,9 +74,12 @@ runEquivYosys yosys sim1 sim2 m = do 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|] + where + checkFile = + fromText [st|test.#{toText sim1}.#{maybe "rtl" toText sim2}.ys|] -runEquiv :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () +runEquiv + :: (Synthesize a, Synthesize b) => Yosys -> a -> Maybe b -> ModDecl -> Sh () runEquiv _ sim1 sim2 m = do root <- rootPath dir <- pwd -- cgit