From 0ea6e208f2c3c41922f8334174fc8e81a21d67f4 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Grave Date: Sun, 17 Feb 2019 11:41:38 +0000 Subject: Brittany formatting --- src/VeriFuzz/AST.hs | 48 +++++------- src/VeriFuzz/ASTGen.hs | 13 ++-- src/VeriFuzz/Circuit.hs | 3 +- src/VeriFuzz/CodeGen.hs | 27 +++---- src/VeriFuzz/Gen.hs | 30 ++++---- src/VeriFuzz/General.hs | 15 ++-- src/VeriFuzz/Icarus.hs | 28 ++++--- src/VeriFuzz/Internal.hs | 3 +- src/VeriFuzz/Lexer.hs | 195 +++++++++++++++++++++++++++++++++++++++++------ src/VeriFuzz/Mutate.hs | 35 ++++----- src/VeriFuzz/Parser.hs | 133 ++++++++++++++++---------------- src/VeriFuzz/Random.hs | 6 +- src/VeriFuzz/Reduce.hs | 7 +- src/VeriFuzz/XST.hs | 6 +- src/VeriFuzz/Yosys.hs | 5 +- 15 files changed, 336 insertions(+), 218 deletions(-) (limited to 'src/VeriFuzz') diff --git a/src/VeriFuzz/AST.hs b/src/VeriFuzz/AST.hs index 34d9327..63b8c34 100644 --- a/src/VeriFuzz/AST.hs +++ b/src/VeriFuzz/AST.hs @@ -73,7 +73,7 @@ module VeriFuzz.AST , traverseExpr , ConstExpr(..) , constNum - , Function (..) + , Function(..) -- * Assignment , Assign(..) , assignReg @@ -307,9 +307,7 @@ instance Plated Expr where exprSafeList :: [QC.Gen Expr] exprSafeList = - [ Number <$> positiveArb <*> QC.arbitrary - -- , Str <$> QC.arbitrary - ] + [Number <$> positiveArb <*> QC.arbitrary] exprRecList :: (Int -> QC.Gen Expr) -> [QC.Gen Expr] exprRecList subexpr = @@ -325,34 +323,31 @@ exprRecList subexpr = ] 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 +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) exprWithContext :: [Identifier] -> Int -> QC.Gen Expr -exprWithContext [] n - | n == 0 = QC.oneof exprSafeList - | n > 0 = QC.oneof $ exprRecList subexpr - | otherwise = exprWithContext [] 0 +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 arbitrary = QC.sized expr traverseExpr :: (Applicative f) => (Expr -> f Expr) -> Expr -> f Expr -traverseExpr f (Concat e ) = Concat <$> sequenceA (f <$> e) -traverseExpr f (UnOp u e ) = UnOp u <$> f e -traverseExpr f (BinOp l o r) = BinOp <$> f l <*> pure o <*> f r -traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r -traverseExpr f (Func fn e ) = Func fn <$> f e -traverseExpr _ e = pure e +traverseExpr f (Concat e ) = Concat <$> sequenceA (f <$> e) +traverseExpr f (UnOp u e ) = UnOp u <$> f e +traverseExpr f (BinOp l o r) = BinOp <$> f l <*> pure o <*> f r +traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r +traverseExpr f (Func fn e ) = Func fn <$> f e +traverseExpr _ e = pure e makeLenses ''Expr @@ -556,19 +551,18 @@ data ModDecl = ModDecl { _modId :: Identifier } deriving (Eq, Show, Data) traverseModConn :: (Applicative f) => (Expr -> f Expr) -> ModConn -> f ModConn -traverseModConn f (ModConn e) = ModConn <$> f e +traverseModConn f (ModConn e ) = ModConn <$> f e 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/ASTGen.hs b/src/VeriFuzz/ASTGen.hs index ff948c3..ab097e4 100644 --- a/src/VeriFuzz/ASTGen.hs +++ b/src/VeriFuzz/ASTGen.hs @@ -12,7 +12,8 @@ Generates the AST from the graph directly. module VeriFuzz.ASTGen ( generateAST - ) where + ) +where import Control.Lens ((^..)) import Data.Foldable (fold) @@ -69,11 +70,11 @@ genAssignAST c = catMaybes $ genContAssignAST c <$> nodes 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] + 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 diff --git a/src/VeriFuzz/Circuit.hs b/src/VeriFuzz/Circuit.hs index 7091fb3..dac3d51 100644 --- a/src/VeriFuzz/Circuit.hs +++ b/src/VeriFuzz/Circuit.hs @@ -15,7 +15,8 @@ module VeriFuzz.Circuit Gate(..) , Circuit(..) , CNode(..) - ) where + ) +where import Data.Graph.Inductive (Gr, LNode) import System.Random diff --git a/src/VeriFuzz/CodeGen.hs b/src/VeriFuzz/CodeGen.hs index 99b52f6..4ff2a93 100644 --- a/src/VeriFuzz/CodeGen.hs +++ b/src/VeriFuzz/CodeGen.hs @@ -18,7 +18,8 @@ module VeriFuzz.CodeGen GenVerilog(..) , genSource , render - ) where + ) +where import Control.Lens (view, (^.)) import Data.Foldable (fold) @@ -97,10 +98,8 @@ 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 @@ -117,14 +116,16 @@ 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) "") <> ")" - 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 (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 <> "\"" -- | Convert 'BinaryOperator' to 'Text'. genBinaryOperator :: BinaryOperator -> Text diff --git a/src/VeriFuzz/Gen.hs b/src/VeriFuzz/Gen.hs index 6eb8723..724b00d 100644 --- a/src/VeriFuzz/Gen.hs +++ b/src/VeriFuzz/Gen.hs @@ -24,7 +24,7 @@ import VeriFuzz.Mutate import VeriFuzz.Random toId :: Int -> Identifier -toId = Identifier . ("w"<>) . T.pack . show +toId = Identifier . ("w" <>) . T.pack . show toPort :: Identifier -> Gen Port toPort ident = do @@ -32,8 +32,7 @@ toPort ident = do return $ wire i ident sumSize :: [Port] -> Int -sumSize ports = - sum $ ports ^.. traverse . portSize +sumSize ports = sum $ ports ^.. traverse . portSize random :: [Identifier] -> (Expr -> ContAssign) -> Gen ModItem random ctx fun = do @@ -44,29 +43,28 @@ 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) +randomOrdAssigns inp ids = snd $ foldr gen (inp, []) ids + 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 + x <- sequence $ randomOrdAssigns start end + ident <- sequence $ toPort <$> ids let inputs_ = take inps ident - let other = drop inps ident + let other = drop inps ident let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids - let yport = [wire (sumSize other) "y"] + 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 + 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 + return + $ initMod . head $ nestUpTo 5 (generateAST gr) ^.. getVerilogSrc diff --git a/src/VeriFuzz/General.hs b/src/VeriFuzz/General.hs index e99b117..6a09db5 100644 --- a/src/VeriFuzz/General.hs +++ b/src/VeriFuzz/General.hs @@ -63,19 +63,16 @@ bsToI = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0 {-# INLINE bsToI #-} noPrint :: Sh a -> Sh a -noPrint = - print_stdout False . print_stderr False +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 + 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 +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 c8bfccd..45e932f 100644 --- a/src/VeriFuzz/Icarus.hs +++ b/src/VeriFuzz/Icarus.hs @@ -52,31 +52,27 @@ 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"]] + [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) +assignFunc inp bs = NonBlockAssign . Assign conc Nothing . Number (B.length bs * 8) $ bsToI bs + 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 + . (encode :: Integer -> L.ByteString) + . maybe 0 fst + . listToMaybe + . readInt 2 (`elem` ("01" :: String)) digitToInt + . T.unpack mask :: Text -> Text mask = T.replace "x" "0" callback :: ByteString -> Text -> ByteString -callback b t = - b <> convert (mask t) +callback b t = b <> convert (mask t) runSimIcarus :: Icarus -> ModDecl -> [ByteString] -> Sh ByteString runSimIcarus sim m bss = do @@ -99,5 +95,7 @@ runSimIcarusWithFile sim f _ = do 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"]) + 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 3c339b5..4a04c7d 100644 --- a/src/VeriFuzz/Internal.hs +++ b/src/VeriFuzz/Internal.hs @@ -19,7 +19,8 @@ module VeriFuzz.Internal , module VeriFuzz.Internal.Circuit , module VeriFuzz.Internal.Simulator , module VeriFuzz.Internal.AST - ) where + ) +where import Data.Text (Text) import qualified Data.Text as T diff --git a/src/VeriFuzz/Lexer.hs b/src/VeriFuzz/Lexer.hs index f06656b..9e9f35e 100644 --- a/src/VeriFuzz/Lexer.hs +++ b/src/VeriFuzz/Lexer.hs @@ -40,7 +40,8 @@ module VeriFuzz.Lexer , semiSep1 , commaSep , commaSep1 - ) where + ) +where import Data.Char (digitToInt) import Text.Parsec @@ -53,9 +54,17 @@ type Lexer = P.TokenParser () type Parser = Parsec String () verilogDef :: VerilogDef -verilogDef = P.LanguageDef "/*" "*/" "//" False letter (alphaNum <|> char '_') - (oneOf ":!#%&*+./<=>?@\\^|-~") (oneOf ":!#%&*+./<=>?@\\^|-~") - reserved' reservedOp' True +verilogDef = P.LanguageDef "/*" + "*/" + "//" + False + letter + (alphaNum <|> char '_') + (oneOf ":!#%&*+./<=>?@\\^|-~") + (oneOf ":!#%&*+./<=>?@\\^|-~") + reserved' + reservedOp' + True lexer :: Lexer lexer = P.makeTokenParser verilogDef @@ -96,7 +105,7 @@ 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 + let n = foldl (\x d -> base * x + toInteger (digitToInt d)) 0 digits seq n (return n) hexadecimal :: Parser Integer @@ -151,26 +160,162 @@ commaSep1 :: Parser a -> Parser [a] commaSep1 = P.commaSep1 lexer reservedOp' :: [String] -reservedOp' = [ "!", "~", "~&", "~|", "+", "-", "*", "/", "%", "==", "!=", "===", "!==" - , "&&", "||", "<", "<=", ">", ">=", "&", "|", "^", "^~", "~^", "**", "<<" - , ">>", "<<<", ">>>" - ] +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" - ] +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" + ] diff --git a/src/VeriFuzz/Mutate.hs b/src/VeriFuzz/Mutate.hs index 92910ea..110685e 100644 --- a/src/VeriFuzz/Mutate.hs +++ b/src/VeriFuzz/Mutate.hs @@ -23,17 +23,15 @@ 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 (ModCA (ContAssign val expr)) | val == i = Just expr + | otherwise = Nothing isAssign _ = Nothing -- | Transforms an expression by replacing an Identifier with an @@ -73,9 +71,7 @@ nestUpTo :: Int -> VerilogSrc -> VerilogSrc 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 @@ -126,9 +122,8 @@ 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 + conns = zipWith ModConnNamed ids (Id <$> instIds) + ids = filterChar outChar (name modOutPorts) <> name modInPorts instIds = name modOutPorts <> name modInPorts name v = m ^.. v . traverse . portName @@ -171,14 +166,12 @@ 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" + e = EPosEdge "clk" addClk = (defaultPort "clk" :) -- | Provide declarations for all the ports that are passed to it. declareMod :: [Port] -> ModDecl -> ModDecl -declareMod ports = modItems %~ (decl++) - where - decl = Decl Nothing <$> ports +declareMod ports = modItems %~ (decl ++) where decl = Decl Nothing <$> ports -- | Simplify an 'Expr' by using constants to remove 'BinaryOperator' and -- simplify expressions. To make this work effectively, it should be run until @@ -222,10 +215,8 @@ simplify e = e -- >>> GenVerilog . removeId ["x"] $ Id "x" + Id "y" -- (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 +removeId i = transform trans + 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 fa44202..0232b50 100644 --- a/src/VeriFuzz/Parser.hs +++ b/src/VeriFuzz/Parser.hs @@ -19,7 +19,8 @@ module VeriFuzz.Parser , parseModDecl , parseContAssign , parseExpr - ) where + ) +where import Data.Functor (($>)) import Data.Functor.Identity (Identity) @@ -36,13 +37,10 @@ type Parser = Parsec String () type ParseOperator = Operator String () Identity sBinOp :: BinaryOperator -> Expr -> Expr -> Expr -sBinOp = sOp BinOp - where - sOp f b a = f a b +sBinOp = sOp BinOp where sOp f b a = f a b parseExpr' :: Parser Expr -parseExpr' = buildExpressionParser parseTable parseTerm - "expr" +parseExpr' = buildExpressionParser parseTable parseTerm "expr" matchHex :: Char -> Bool matchHex c = c == 'h' || c == 'H' @@ -61,42 +59,43 @@ matchOct c = c == 'o' || c == 'O' parseNum :: Parser Expr parseNum = do size <- fromIntegral <$> decimal - _ <- string "'" + _ <- string "'" matchNum size - where - matchNum size = (satisfy matchHex >> Number size <$> hexadecimal) - <|> (satisfy matchDec >> Number size <$> decimal) - <|> (satisfy matchOct >> Number size <$> octal) + where + matchNum size = + (satisfy matchHex >> Number size <$> hexadecimal) + <|> (satisfy matchDec >> Number size <$> decimal) + <|> (satisfy matchOct >> Number size <$> octal) 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 - f <- spaces *> reservedOp "$" *> parseFunction + f <- spaces *> reservedOp "$" *> parseFunction expr <- string "(" *> spaces *> parseExpr - _ <- spaces *> string ")" *> spaces + _ <- spaces *> string ")" *> spaces return $ Func f expr parseTerm :: Parser Expr -parseTerm = parens parseExpr - <|> (Concat <$> aroundList (string "{") (string "}") parseExpr) - <|> parseFun - <|> lexeme parseNum - <|> parseVar - "simple expr" +parseTerm = + 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 "?" + _ <- spaces *> reservedOp "?" expr <- spaces *> parseExpr - _ <- spaces *> reservedOp ":" + _ <- spaces *> reservedOp ":" Cond e expr <$> parseExpr parseExpr :: Parser Expr @@ -108,31 +107,39 @@ parseExpr = do -- 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 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 + , [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 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 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 "|" (sBinOp BinOr) AssocLeft] + , [binary "&&" (sBinOp BinLAnd) AssocLeft] + , [binary "||" (sBinOp BinLOr) AssocLeft] ] binary :: String -> (a -> a -> a) -> Assoc -> ParseOperator a @@ -149,9 +156,9 @@ aroundList a b c = lexeme $ do parseContAssign :: Parser ContAssign parseContAssign = do - var <- reserved "assign" *> ident + var <- reserved "assign" *> ident expr <- reservedOp "=" *> parseExpr - _ <- symbol ";" + _ <- symbol ";" return $ ContAssign var expr -- | Parse a range and return the total size. As it is inclusive, 1 has to be @@ -160,7 +167,7 @@ parseRange :: Parser Int parseRange = do rangeH <- symbol "[" *> decimal rangeL <- symbol ":" *> decimal - _ <- symbol "]" + _ <- symbol "]" return . fromIntegral $ rangeH - rangeL + 1 ident :: Parser Identifier @@ -168,44 +175,34 @@ ident = Identifier . T.pack <$> identifier parseNetDecl :: Maybe PortDir -> Parser ModItem parseNetDecl pd = do - t <- option Wire type_ - sign <- option False (reserved "signed" $> True) + t <- option Wire type_ + sign <- option False (reserved "signed" $> True) range <- option 1 parseRange - name <- ident - _ <- symbol ";" + name <- ident + _ <- symbol ";" return . Decl pd . Port t sign range $ name - where - type_ = reserved "wire" $> Wire - <|> reserved "reg" $> Reg + 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 +parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing parseModItem :: Parser ModItem -parseModItem = - (ModCA <$> parseContAssign) - <|> parseDecl +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 - name <- reserved "module" *> ident - modL <- fmap defaultPort <$> parseModList - _ <- symbol ";" + name <- reserved "module" *> ident + modL <- fmap defaultPort <$> parseModList + _ <- symbol ";" modItem <- lexeme $ option [] . try $ many1 parseModItem - _ <- reserved "endmodule" + _ <- reserved "endmodule" return $ ModDecl name [] modL modItem parseDescription :: Parser Description diff --git a/src/VeriFuzz/Random.hs b/src/VeriFuzz/Random.hs index 9cfb570..e5d2c68 100644 --- a/src/VeriFuzz/Random.hs +++ b/src/VeriFuzz/Random.hs @@ -21,8 +21,7 @@ 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 @@ -40,8 +39,7 @@ arbitraryEdge n = do 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 + 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 diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index e393e51..47cdcac 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -19,10 +19,7 @@ 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) +halveModDecl m = (m & modItems %~ fst . halve, m & modItems %~ snd . halve) diff --git a/src/VeriFuzz/XST.hs b/src/VeriFuzz/XST.hs index 7e27120..337294a 100644 --- a/src/VeriFuzz/XST.hs +++ b/src/VeriFuzz/XST.hs @@ -34,8 +34,7 @@ instance Synthesize Xst where runSynth = runSynthXst defaultXst :: Xst -defaultXst = - Xst "xst" "netgen" +defaultXst = Xst "xst" "netgen" runSynthXst :: Xst -> ModDecl -> FilePath -> Sh () runSynthXst sim m outf = do @@ -46,7 +45,8 @@ runSynthXst sim m outf = do echoP "XST: run" _ <- logger dir "xst" $ timeout (xstPath sim) ["-ifn", toTextIgnore xstFile] echoP "XST: netgen" - _ <- logger dir "netgen" $ run (netgenPath sim) + _ <- 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] diff --git a/src/VeriFuzz/Yosys.hs b/src/VeriFuzz/Yosys.hs index b11003e..9d3a298 100644 --- a/src/VeriFuzz/Yosys.hs +++ b/src/VeriFuzz/Yosys.hs @@ -69,13 +69,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 _ sim1 sim2 m = do root <- rootPath - dir <- pwd + dir <- pwd echoP "SymbiYosys: setup" writefile "top.v" . genSource . initMod $ makeTopAssert m writefile "test.sby" $ sbyConfig root sim1 sim2 m -- cgit