From 77702d5492ba19b6e3e0dda9e9460a8bb67a8e3f Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Thu, 9 May 2019 23:18:10 +0100 Subject: Add new pretty printer with indentation --- .travis.yml | 2 +- Setup.hs | 2 +- src/VeriFuzz.hs | 2 +- src/VeriFuzz/Config.hs | 24 +-- src/VeriFuzz/Verilog/CodeGen.hs | 322 ++++++++++++++++++++-------------------- src/VeriFuzz/Verilog/Gen.hs | 14 +- test/Doctest.hs | 5 +- test/Property.hs | 29 +--- verifuzz.cabal | 10 +- 9 files changed, 191 insertions(+), 219 deletions(-) diff --git a/.travis.yml b/.travis.yml index fa96327..05e684a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -22,4 +22,4 @@ addons: - ghc-8.6.4 script: - - stack --no-terminal --skip-ghc-check test --pedantic + - stack --no-terminal --skip-ghc-check test --pedantic --fast diff --git a/Setup.hs b/Setup.hs index f7c5518..bdfe8ae 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,4 @@ import Distribution.Extra.Doctest main :: IO () -main = defaultMainWithDoctests "verifuzz-doctest" +main = defaultMainWithDoctests "doctest" diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs index 6667827..f66e18c 100644 --- a/src/VeriFuzz.hs +++ b/src/VeriFuzz.hs @@ -166,4 +166,4 @@ runEquivalence seed gm t d k i = do where n = t <> "_" <> T.pack (show i) runReduce :: SourceInfo -> IO SourceInfo -runReduce s = reduce (\s -> not <$> checkEquivalence s "reduce") s +runReduce s = reduce (\s' -> not <$> checkEquivalence s' "reduce") s diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs index 46cc721..1ce7b11 100644 --- a/src/VeriFuzz/Config.hs +++ b/src/VeriFuzz/Config.hs @@ -25,8 +25,8 @@ module VeriFuzz.Config , ProbModItem(..) -- *** Statement , ProbStatement(..) - -- ** Property - , Property(..) + -- ** ConfProperty + , ConfProperty(..) -- ** Simulator Description , SimDescription(..) -- ** Synthesiser Description @@ -189,11 +189,11 @@ data Probability = Probability { _probModItem :: {-# UNPACK #-} !ProbModItem } deriving (Eq, Show) -data Property = Property { _propSize :: {-# UNPACK #-} !Int - , _propSeed :: !(Maybe Seed) - , _propStmntDepth :: {-# UNPACK #-} !Int - , _propModDepth :: {-# UNPACK #-} !Int - , _propMaxModules :: {-# UNPACK #-} !Int +data ConfProperty = ConfProperty { _propSize :: {-# UNPACK #-} !Int + , _propSeed :: !(Maybe Seed) + , _propStmntDepth :: {-# UNPACK #-} !Int + , _propModDepth :: {-# UNPACK #-} !Int + , _propMaxModules :: {-# UNPACK #-} !Int } deriving (Eq, Show) @@ -214,7 +214,7 @@ data SynthDescription = SynthDescription { synthName :: {-# UNPACK #-} !Text data Config = Config { _configInfo :: Info , _configProbability :: {-# UNPACK #-} !Probability - , _configProperty :: {-# UNPACK #-} !Property + , _configProperty :: {-# UNPACK #-} !ConfProperty , _configSimulators :: [SimDescription] , _configSynthesisers :: [SynthDescription] } @@ -224,7 +224,7 @@ $(makeLenses ''ProbExpr) $(makeLenses ''ProbModItem) $(makeLenses ''ProbStatement) $(makeLenses ''Probability) -$(makeLenses ''Property) +$(makeLenses ''ConfProperty) $(makeLenses ''Info) $(makeLenses ''Config) @@ -270,7 +270,7 @@ fromQuartus (Quartus a b c) = defaultConfig :: Config defaultConfig = Config (Info (pack $(gitHash)) (pack $ showVersion version)) (Probability defModItem defStmnt defExpr) - (Property 20 Nothing 3 2 5) + (ConfProperty 20 Nothing 3 2 5) [] [fromYosys defaultYosys, fromVivado defaultVivado] where @@ -370,9 +370,9 @@ probCodec = .= _probExpr where defProb i = defaultConfig ^. configProbability . i -propCodec :: TomlCodec Property +propCodec :: TomlCodec ConfProperty propCodec = - Property + ConfProperty <$> defaultValue (defProp propSize) (Toml.int "size") .= _propSize <*> Toml.dioptional (Toml.read "seed") diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs index 2531519..efacd3c 100644 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -21,13 +21,12 @@ module VeriFuzz.Verilog.CodeGen ) where -import Data.Foldable (fold) -import Data.List.NonEmpty (NonEmpty (..), toList) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Numeric (showHex) -import VeriFuzz.Internal +import Data.List.NonEmpty (NonEmpty (..), toList) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Prettyprint.Doc +import Numeric (showHex) +import VeriFuzz.Internal hiding (comma) import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.BitVec @@ -39,161 +38,159 @@ class Source a where -- | Map a 'Maybe Statement' to 'Text'. If it is 'Just statement', the generated -- statements are returned. If it is 'Nothing', then @;\n@ is returned. -defMap :: Maybe Statement -> Text -defMap = maybe ";\n" statement +defMap :: Maybe Statement -> Doc a +defMap = maybe semi statement -- | Convert the 'Verilog' type to 'Text' so that it can be rendered. -verilogSrc :: Verilog -> Text -verilogSrc (Verilog modules) = fold $ moduleDecl <$> modules +verilogSrc :: Verilog -> Doc a +verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules -- | Generate the 'ModDecl' for a module and convert it to 'Text'. -moduleDecl :: ModDecl -> Text +moduleDecl :: ModDecl -> Doc a moduleDecl (ModDecl i outP inP items ps) = - "module " - <> identifier i - <> params ps - <> ports - <> ";\n" - <> modI - <> "endmodule\n\n" + vsep + [ sep ["module" <+> identifier i, params ps, ports <> semi] + , indent 2 modI + , "endmodule" + ] where ports | null outP && null inP = "" - | otherwise = "(" <> comma (modPort <$> outIn) <> ")" - modI = fold $ moduleItem <$> items + | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn + modI = vsep $ moduleItem <$> items outIn = outP ++ inP params [] = "" - params (p : pps) = "\n#(\n" <> paramList (p :| pps) <> "\n)\n" + params (p : pps) = hcat ["#", paramList (p :| pps)] -- | Generates a parameter list. Can only be called with a 'NonEmpty' list. -paramList :: NonEmpty Parameter -> Text -paramList ps = "parameter " <> (commaNL . toList $ parameter <$> ps) +paramList :: NonEmpty Parameter -> Doc a +paramList ps = tupled . toList $ parameter <$> ps -- | Generates a localparam list. Can only be called with a 'NonEmpty' list. -localParamList :: NonEmpty LocalParam -> Text -localParamList ps = "localparam " <> (commaNL . toList $ localParam <$> ps) +localParamList :: NonEmpty LocalParam -> Doc a +localParamList ps = tupled . toList $ localParam <$> ps -- | Generates the assignment for a 'Parameter'. -parameter :: Parameter -> Text -parameter (Parameter name val) = identifier name <> " = " <> constExpr val +parameter :: Parameter -> Doc a +parameter (Parameter name val) = hsep ["parameter", identifier name, "=", constExpr val] -- | Generates the assignment for a 'LocalParam'. -localParam :: LocalParam -> Text -localParam (LocalParam name val) = identifier name <> " = " <> constExpr val +localParam :: LocalParam -> Doc a +localParam (LocalParam name val) = hsep ["localparameter", identifier name, "=", constExpr val] -identifier :: Identifier -> Text -identifier (Identifier i) = i +identifier :: Identifier -> Doc a +identifier (Identifier i) = pretty i -- | Conversts 'Port' to 'Text' for the module list, which means it only -- generates a list of identifiers. -modPort :: Port -> Text -modPort (Port _ _ _ (Identifier i)) = i +modPort :: Port -> Doc a +modPort (Port _ _ _ i) = identifier i -- | Generate the 'Port' description. -port :: Port -> Text -port (Port tp sgn r (Identifier name)) = t <> sign <> range r <> name +port :: Port -> Doc a +port (Port tp sgn r name) = hsep [t, sign, range r, identifier name] where - t = flip mappend " " $ pType tp + t = pType tp sign = signed sgn -range :: Range -> Text -range (Range msb lsb) = "[" <> constExpr msb <> ":" <> constExpr lsb <> "] " +range :: Range -> Doc a +range (Range msb lsb) = brackets $ hcat [constExpr msb, colon, constExpr lsb] -signed :: Bool -> Text -signed True = "signed " -signed _ = "" +signed :: Bool -> Doc a +signed True = "signed" +signed _ = mempty -- | Convert the 'PortDir' type to 'Text'. -portDir :: PortDir -> Text +portDir :: PortDir -> Doc a portDir PortIn = "input" portDir PortOut = "output" portDir PortInOut = "inout" -- | Generate a 'ModItem'. -moduleItem :: ModItem -> Text +moduleItem :: ModItem -> Doc a moduleItem (ModCA ca) = contAssign ca -moduleItem (ModInst (Identifier i) (Identifier name) conn) = - i <> " " <> name <> "(" <> comma (mConn <$> conn) <> ")" <> ";\n" -moduleItem (Initial stat) = "initial " <> statement stat -moduleItem (Always stat) = "always " <> statement stat +moduleItem (ModInst i name conn) = + hsep [identifier i, identifier name, parens . hsep $ punctuate comma (mConn <$> conn), semi] +moduleItem (Initial stat) = nest 2 $ vsep ["initial", statement stat] +moduleItem (Always stat) = nest 2 $ vsep ["always", statement stat] moduleItem (Decl dir p ini) = - maybe "" makePort dir <> port p <> maybe "" makeIni ini <> ";\n" + hsep [maybe mempty makePort dir, port p, maybe mempty makeIni ini, semi] where - makePort = (<> " ") . portDir - makeIni = (" = " <>) . constExpr -moduleItem (ParamDecl p) = paramList p <> ";\n" -moduleItem (LocalParamDecl p) = localParamList p <> ";\n" + makePort = portDir + makeIni = ("=" <+>) . constExpr +moduleItem (ParamDecl p) = hcat [paramList p, semi] +moduleItem (LocalParamDecl p) = hcat [localParamList p, semi] -mConn :: ModConn -> Text +mConn :: ModConn -> Doc a mConn (ModConn c ) = expr c -mConn (ModConnNamed n c) = "." <> getIdentifier n <> "(" <> expr c <> ")" +mConn (ModConnNamed n c) = hcat [dot, identifier n, parens $ expr c] -- | Generate continuous assignment -contAssign :: ContAssign -> Text +contAssign :: ContAssign -> Doc a contAssign (ContAssign val e) = - "assign " <> getIdentifier val <> " = " <> expr e <> ";\n" + hsep ["assign", identifier val, "=", align $ expr e, semi] -- | Generate 'Expr' to 'Text'. -expr :: Expr -> Text +expr :: Expr -> Doc a expr (BinOp eRhs bin eLhs) = - "(" <> expr eRhs <> binaryOp bin <> expr eLhs <> ")" + parens $ hsep [expr eRhs, binaryOp bin, expr eLhs] expr (Number b ) = showNum b -expr (Id i ) = getIdentifier i -expr (VecSelect i e ) = getIdentifier i <> "[" <> expr e <> "]" -expr (RangeSelect i r ) = getIdentifier i <> range r -expr (Concat c ) = "{" <> comma (expr <$> c) <> "}" -expr (UnOp u e ) = "(" <> unaryOp u <> expr e <> ")" -expr (Cond l t f) = "(" <> expr l <> " ? " <> expr t <> " : " <> expr f <> ")" -expr (Appl (Identifier f) e) = f <> "(" <> expr e <> ")" -expr (Str t ) = "\"" <> t <> "\"" - -showNum :: BitVec -> Text +expr (Id i ) = identifier i +expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e] +expr (RangeSelect i r ) = hcat [identifier i, range r] +expr (Concat c ) = braces . nest 4 . sep $ punctuate comma (expr <$> c) +expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e] +expr (Cond l t f) = parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]] +expr (Appl f e) = hcat [identifier f, parens $ expr e] +expr (Str t ) = dquotes $ pretty t + +showNum :: BitVec -> Doc a showNum (BitVec s n) = - "(" <> minus <> showT s <> "'h" <> T.pack (showHex (abs n) "") <> ")" + parens $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")] where - minus | signum n >= 0 = "" + minus | signum n >= 0 = mempty | otherwise = "-" -constExpr :: ConstExpr -> Text +constExpr :: ConstExpr -> Doc a constExpr (ConstNum b) = showNum b constExpr (ParamId i) = identifier i -constExpr (ConstConcat c) = "{" <> comma (constExpr <$> c) <> "}" -constExpr (ConstUnOp u e) = "(" <> unaryOp u <> constExpr e <> ")" +constExpr (ConstConcat c) = braces . hsep $ punctuate comma (constExpr <$> c) +constExpr (ConstUnOp u e) = parens $ hcat [unaryOp u, constExpr e] constExpr (ConstBinOp eRhs bin eLhs) = - "(" <> constExpr eRhs <> binaryOp bin <> constExpr eLhs <> ")" + parens $ hsep [constExpr eRhs, binaryOp bin, constExpr eLhs] constExpr (ConstCond l t f) = - "(" <> constExpr l <> " ? " <> constExpr t <> " : " <> constExpr f <> ")" -constExpr (ConstStr t) = "\"" <> t <> "\"" + parens $ hsep [constExpr l, "?", constExpr t, colon, constExpr f] +constExpr (ConstStr t) = dquotes $ pretty t -- | Convert 'BinaryOperator' to 'Text'. -binaryOp :: BinaryOperator -> Text -binaryOp BinPlus = " + " -binaryOp BinMinus = " - " -binaryOp BinTimes = " * " -binaryOp BinDiv = " / " -binaryOp BinMod = " % " -binaryOp BinEq = " == " -binaryOp BinNEq = " != " -binaryOp BinCEq = " === " -binaryOp BinCNEq = " !== " -binaryOp BinLAnd = " && " -binaryOp BinLOr = " || " -binaryOp BinLT = " < " -binaryOp BinLEq = " <= " -binaryOp BinGT = " > " -binaryOp BinGEq = " >= " -binaryOp BinAnd = " & " -binaryOp BinOr = " | " -binaryOp BinXor = " ^ " -binaryOp BinXNor = " ^~ " -binaryOp BinXNorInv = " ~^ " -binaryOp BinPower = " ** " -binaryOp BinLSL = " << " -binaryOp BinLSR = " >> " -binaryOp BinASL = " <<< " -binaryOp BinASR = " >>> " +binaryOp :: BinaryOperator -> Doc a +binaryOp BinPlus = "+" +binaryOp BinMinus = "-" +binaryOp BinTimes = "*" +binaryOp BinDiv = "/" +binaryOp BinMod = "%" +binaryOp BinEq = "==" +binaryOp BinNEq = "!=" +binaryOp BinCEq = "===" +binaryOp BinCNEq = "!==" +binaryOp BinLAnd = "&&" +binaryOp BinLOr = "||" +binaryOp BinLT = "<" +binaryOp BinLEq = "<=" +binaryOp BinGT = ">" +binaryOp BinGEq = ">=" +binaryOp BinAnd = "&" +binaryOp BinOr = "|" +binaryOp BinXor = "^" +binaryOp BinXNor = "^~" +binaryOp BinXNorInv = "~^" +binaryOp BinPower = "**" +binaryOp BinLSL = "<<" +binaryOp BinLSR = ">>" +binaryOp BinASL = "<<<" +binaryOp BinASR = ">>>" -- | Convert 'UnaryOperator' to 'Text'. -unaryOp :: UnaryOperator -> Text +unaryOp :: UnaryOperator -> Doc a unaryOp UnPlus = "+" unaryOp UnMinus = "-" unaryOp UnLNot = "!" @@ -206,115 +203,116 @@ unaryOp UnXor = "^" unaryOp UnNxor = "~^" unaryOp UnNxorInv = "^~" -event :: Event -> Text -event a = "@(" <> eventRec a <> ")" +event :: Event -> Doc a +event a = hcat ["@", parens $ eventRec a] -- | Generate verilog code for an 'Event'. -eventRec :: Event -> Text -eventRec (EId i) = getIdentifier i +eventRec :: Event -> Doc a +eventRec (EId i) = identifier i eventRec (EExpr e) = expr e eventRec EAll = "*" -eventRec (EPosEdge i) = "posedge " <> getIdentifier i -eventRec (ENegEdge i) = "negedge " <> getIdentifier i -eventRec (EOr a b ) = eventRec a <> " or " <> eventRec b -eventRec (EComb a b ) = eventRec a <> ", " <> eventRec b +eventRec (EPosEdge i) = hsep ["posedge", identifier i] +eventRec (ENegEdge i) = hsep ["negedge", identifier i] +eventRec (EOr a b ) = hsep [eventRec a, "or", eventRec b] +eventRec (EComb a b ) = hsep $ punctuate comma [eventRec a, eventRec b] -- | Generates verilog code for a 'Delay'. -delay :: Delay -> Text -delay (Delay i) = "#" <> showT i +delay :: Delay -> Doc a +delay (Delay i) = "#" <> pretty i -- | Generate the verilog code for an 'LVal'. -lVal :: LVal -> Text -lVal (RegId i ) = getIdentifier i -lVal (RegExpr i e) = getIdentifier i <> " [" <> expr e <> "]" -lVal (RegSize i r) = getIdentifier i <> " " <> range r -lVal (RegConcat e) = "{" <> comma (expr <$> e) <> "}" +lVal :: LVal -> Doc a +lVal (RegId i ) = identifier i +lVal (RegExpr i e) = hsep [identifier i, expr e] +lVal (RegSize i r) = hsep [identifier i, range r] +lVal (RegConcat e) = braces . hsep $ punctuate comma (expr <$> e) -pType :: PortType -> Text +pType :: PortType -> Doc a pType Wire = "wire" pType Reg = "reg" -genAssign :: Text -> Assign -> Text -genAssign op (Assign r d e) = lVal r <> op <> maybe "" delay d <> expr e - -statement :: Statement -> Text -statement (TimeCtrl d stat ) = delay d <> " " <> defMap stat -statement (EventCtrl e stat ) = event e <> " " <> defMap stat -statement (SeqBlock s) = "begin\n" <> fold (statement <$> s) <> "end\n" -statement (BlockAssign a ) = genAssign " = " a <> ";\n" -statement (NonBlockAssign a ) = genAssign " <= " a <> ";\n" -statement (TaskEnable t ) = task t <> ";\n" -statement (SysTaskEnable t ) = "$" <> task t <> ";\n" -statement (CondStmnt e t Nothing) = "if(" <> expr e <> ")\n" <> defMap t +genAssign :: Text -> Assign -> Doc a +genAssign op (Assign r d e) = hsep [lVal r, pretty op, maybe mempty delay d, expr e] + +statement :: Statement -> Doc a +statement (TimeCtrl d stat ) = hsep [delay d, defMap stat] +statement (EventCtrl e stat ) = hsep [event e, defMap stat] +statement (SeqBlock s) = vsep ["begin", indent 2 . vsep $ statement <$> s, "end"] +statement (BlockAssign a ) = hcat [genAssign "=" a, semi] +statement (NonBlockAssign a ) = hcat [genAssign "<=" a, semi] +statement (TaskEnable t ) = hcat [task t, semi] +statement (SysTaskEnable t ) = hcat ["$", task t, semi] +statement (CondStmnt e t Nothing) = vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t] statement (CondStmnt e t f) = - "if(" <> expr e <> ")\n" <> defMap t <> "else\n" <> defMap f + vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t, "else", indent 2 $ defMap f] statement (ForLoop a e incr stmnt) = - "for(" - <> genAssign " = " a - <> "; " - <> expr e - <> "; " - <> genAssign " = " incr - <> ")\n" - <> statement stmnt - -task :: Task -> Text -task (Task (Identifier i) e) | null e = i - | otherwise = i <> "(" <> comma (expr <$> e) <> ")" + vsep [ hsep + [ "for" + , parens . hsep $ punctuate semi + [ genAssign "=" a + , expr e + , genAssign "=" incr + ] + ] + , indent 2 $ statement stmnt] + +task :: Task -> Doc a +task (Task i e) | null e = identifier i + | otherwise = hsep [identifier i, parens . hsep $ punctuate comma (expr <$> e)] -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. render :: (Source a) => a -> IO () -render = T.putStrLn . genSource +render = print . genSource -- Instances instance Source Identifier where - genSource = getIdentifier + genSource = showT . identifier instance Source Task where - genSource = task + genSource = showT . task instance Source Statement where - genSource = statement + genSource = showT . statement instance Source PortType where - genSource = pType + genSource = showT . pType instance Source ConstExpr where - genSource = constExpr + genSource = showT . constExpr instance Source LVal where - genSource = lVal + genSource = showT . lVal instance Source Delay where - genSource = delay + genSource = showT . delay instance Source Event where - genSource = event + genSource = showT . event instance Source UnaryOperator where - genSource = unaryOp + genSource = showT . unaryOp instance Source Expr where - genSource = expr + genSource = showT . expr instance Source ContAssign where - genSource = contAssign + genSource = showT . contAssign instance Source ModItem where - genSource = moduleItem + genSource = showT . moduleItem instance Source PortDir where - genSource = portDir + genSource = showT . portDir instance Source Port where - genSource = port + genSource = showT . port instance Source ModDecl where - genSource = moduleDecl + genSource = showT . moduleDecl instance Source Verilog where - genSource = verilogSrc + genSource = showT . verilogSrc instance Source SourceInfo where genSource (SourceInfo _ src) = genSource src diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs index feb2be5..9a5b71d 100644 --- a/src/VeriFuzz/Verilog/Gen.hs +++ b/src/VeriFuzz/Verilog/Gen.hs @@ -98,12 +98,6 @@ randomMod inps total = do gen :: Gen a -> StateGen a gen = lift . lift -listOf1 :: Gen a -> Gen [a] -listOf1 a = Hog.list (Hog.linear 1 100) a - ---listOf :: Gen a -> Gen [a] ---listOf = Hog.list (Hog.linear 0 100) - largeNum :: Gen Int largeNum = Hog.int Hog.linearBounded @@ -178,9 +172,9 @@ constExprWithContext ps prob size , ConstBinOp <$> subexpr 2 <*> binOp <*> subexpr 2 ) , ( prob ^. probExprCond - , ConstCond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 + , ConstCond <$> subexpr 2 <*> subexpr 2 <*> subexpr 2 ) - , (prob ^. probExprConcat, ConstConcat <$> listOf1 (subexpr 8)) + , (prob ^. probExprConcat, ConstConcat <$> Hog.list (Hog.linear 1 10) (subexpr 2)) ] | otherwise = constExprWithContext ps prob 0 where subexpr y = constExprWithContext ps prob $ size `div` y @@ -191,11 +185,11 @@ exprSafeList prob = [(prob ^. probExprNum, Number <$> genBitVec)] exprRecList :: ProbExpr -> (Hog.Size -> Gen Expr) -> [(Int, Gen Expr)] exprRecList prob subexpr = [ (prob ^. probExprNum , Number <$> genBitVec) - , (prob ^. probExprConcat , Concat <$> listOf1 (subexpr 8)) + , (prob ^. probExprConcat , Concat <$> Hog.list (Hog.linear 1 10) (subexpr 2)) , (prob ^. probExprUnOp , UnOp <$> unOp <*> subexpr 2) , (prob ^. probExprStr, Str <$> Hog.text (Hog.linear 0 100) Hog.alphaNum) , (prob ^. probExprBinOp , BinOp <$> subexpr 2 <*> binOp <*> subexpr 2) - , (prob ^. probExprCond , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3) + , (prob ^. probExprCond , Cond <$> subexpr 2 <*> subexpr 2 <*> subexpr 2) , (prob ^. probExprSigned , Appl <$> pure "$signed" <*> subexpr 2) , (prob ^. probExprUnsigned, Appl <$> pure "$unsigned" <*> subexpr 2) ] diff --git a/test/Doctest.hs b/test/Doctest.hs index 44fecac..1b899c3 100644 --- a/test/Doctest.hs +++ b/test/Doctest.hs @@ -1,11 +1,8 @@ module Main where import Build_doctests (flags, module_sources, pkgs) -import Data.Foldable (traverse_) import Test.DocTest (doctest) main :: IO () -main = do - traverse_ putStrLn args -- optionally print arguments - doctest args +main = doctest args where args = flags ++ pkgs ++ module_sources diff --git a/test/Property.hs b/test/Property.hs index fe802c9..7b1771c 100644 --- a/test/Property.hs +++ b/test/Property.hs @@ -20,17 +20,15 @@ import Hedgehog.Function (Arg, Vary) import qualified Hedgehog.Function as Hog import qualified Hedgehog.Gen as Hog import qualified Hedgehog.Range as Hog +import Parser (parserTests) import Test.Tasty import Test.Tasty.Hedgehog import Text.Parsec -import VeriFuzz hiding (Property) +import VeriFuzz import VeriFuzz.Result import VeriFuzz.Verilog.Lex import VeriFuzz.Verilog.Parser -randomMod' :: Gen ModDecl -randomMod' = Hog.resize 20 (randomMod 3 10) - randomDAG' :: Gen Circuit randomDAG' = Hog.resize 30 randomDAG @@ -40,26 +38,6 @@ simpleGraph = Hog.property $ do Hog.assert $ simp xs where simp = G.isSimple . getCircuit -parserInput :: Property -parserInput = Hog.property $ do - v <- Hog.forAll randomMod' - Hog.assert . isRight $ parse parseModDecl - "input_test.v" - (alexScanTokens $ str v) - where str = show . GenVerilog - -parserIdempotent :: Property -parserIdempotent = Hog.property $ do - v <- Hog.forAll randomMod' - let sv = vshow v - p sv === (p . p) sv - where - vshow = show . GenVerilog - p sv = - either (\x -> show x <> "\n" <> sv) vshow - . parse parseModDecl "idempotent_test.v" - $ alexScanTokens sv - type GenFunctor f a b c = ( Functor f , Show (f a) @@ -99,7 +77,6 @@ propertyTests :: TestTree propertyTests = testGroup "Property Tests" [ testProperty "simple graph generation check" simpleGraph --- , testProperty "parser input" parserInput --- , testProperty "parser idempotence" parserIdempotent , testProperty "fmap for Result" propertyResultInterrupted + , parserTests ] diff --git a/verifuzz.cabal b/verifuzz.cabal index d52dc7d..9a6b4d8 100644 --- a/verifuzz.cabal +++ b/verifuzz.cabal @@ -78,6 +78,7 @@ library , transformers >=0.5 && <0.6 , transformers-base >=0.4.5 && <0.5 , tomland >=1.0 && <1.1 + , prettyprinter >=1.2.1 && <1.3 , array >=0.5 && <0.6 , recursion-schemes >=5.1 && <5.2 , prettyprinter >= 1.2.1 && < 1.3 @@ -101,13 +102,15 @@ executable verifuzz , optparse-applicative >=0.14 && <0.15 default-extensions: OverloadedStrings -test-suite verifuzz-test +test-suite test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs other-modules: Unit , Property + , Reduce + , Parser build-depends: base >=4 && <5 , verifuzz , fgl >=5.7 && <5.8 @@ -117,16 +120,19 @@ test-suite verifuzz-test , hedgehog >=0.6 && <0.7 , hedgehog-fn >=0.6 && <0.7 , lens >=4.17 && <4.18 + , shakespeare >=2 && <2.1 , text >=1.2 && <1.3 , parsec >= 3.1 && < 3.2 default-extensions: OverloadedStrings -test-suite verifuzz-doctest +test-suite doctest default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Doctest.hs + other-modules: Build_doctests build-depends: base >=4.7 && <5 , doctest >=0.16 && <0.17 + , Glob >=0.9.3 && <0.11 , verifuzz default-extensions: OverloadedStrings -- cgit