From 76e9b994258d9af87868ba9f420db4ee1c29de67 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 13 May 2019 20:50:01 +0100 Subject: Format with brittany --- src/VeriFuzz/Verilog/AST.hs | 24 +++++---- src/VeriFuzz/Verilog/CodeGen.hs | 117 ++++++++++++++++++++++------------------ src/VeriFuzz/Verilog/Gen.hs | 14 +++-- src/VeriFuzz/Verilog/Parser.hs | 117 +++++++++++++++++++++------------------- src/VeriFuzz/Verilog/Quote.hs | 13 ++--- 5 files changed, 157 insertions(+), 128 deletions(-) (limited to 'src/VeriFuzz/Verilog') diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs index 1957cb5..52155db 100644 --- a/src/VeriFuzz/Verilog/AST.hs +++ b/src/VeriFuzz/Verilog/AST.hs @@ -270,23 +270,25 @@ data ConstExpr = ConstNum { _constNum :: {-# UNPACK #-} !BitVec } deriving (Eq, Show, Ord, Data) constToExpr :: ConstExpr -> Expr -constToExpr (ConstNum a) = Number a -constToExpr (ParamId a) = Id a -constToExpr (ConstConcat a) = Concat $ fmap constToExpr a -constToExpr (ConstUnOp a b) = UnOp a $ constToExpr b +constToExpr (ConstNum a ) = Number a +constToExpr (ParamId a ) = Id a +constToExpr (ConstConcat a ) = Concat $ fmap constToExpr a +constToExpr (ConstUnOp a b ) = UnOp a $ constToExpr b constToExpr (ConstBinOp a b c) = BinOp (constToExpr a) b $ constToExpr c -constToExpr (ConstCond a b c) = Cond (constToExpr a) (constToExpr b) $ constToExpr c +constToExpr (ConstCond a b c) = + Cond (constToExpr a) (constToExpr b) $ constToExpr c constToExpr (ConstStr a) = Str a exprToConst :: Expr -> ConstExpr -exprToConst (Number a) = ConstNum a -exprToConst (Id a) = ParamId a -exprToConst (Concat a) = ConstConcat $ fmap exprToConst a -exprToConst (UnOp a b) = ConstUnOp a $ exprToConst b +exprToConst (Number a ) = ConstNum a +exprToConst (Id a ) = ParamId a +exprToConst (Concat a ) = ConstConcat $ fmap exprToConst a +exprToConst (UnOp a b ) = ConstUnOp a $ exprToConst b exprToConst (BinOp a b c) = ConstBinOp (exprToConst a) b $ exprToConst c -exprToConst (Cond a b c) = ConstCond (exprToConst a) (exprToConst b) $ exprToConst c +exprToConst (Cond a b c) = + ConstCond (exprToConst a) (exprToConst b) $ exprToConst c exprToConst (Str a) = ConstStr a -exprToConst _ = error "Not a constant expression" +exprToConst _ = error "Not a constant expression" instance Num ConstExpr where a + b = ConstBinOp a BinPlus b diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs index 3ff39d9..a0ec0cc 100644 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -49,15 +49,15 @@ verilogSrc (Verilog modules) = vsep . punctuate line $ moduleDecl <$> modules -- | Generate the 'ModDecl' for a module and convert it to 'Text'. moduleDecl :: ModDecl -> Doc a -moduleDecl (ModDecl i outP inP items ps) = - vsep +moduleDecl (ModDecl i outP inP items ps) = vsep [ sep ["module" <+> identifier i, params ps, ports <> semi] , indent 2 modI , "endmodule" ] where - ports | null outP && null inP = "" - | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn + ports + | null outP && null inP = "" + | otherwise = parens . align . sep . punctuate comma $ modPort <$> outIn modI = vsep $ moduleItem <$> items outIn = outP ++ inP params [] = "" @@ -73,11 +73,13 @@ localParamList ps = tupled . toList $ localParam <$> ps -- | Generates the assignment for a 'Parameter'. parameter :: Parameter -> Doc a -parameter (Parameter name val) = hsep ["parameter", identifier name, "=", constExpr val] +parameter (Parameter name val) = + hsep ["parameter", identifier name, "=", constExpr val] -- | Generates the assignment for a 'LocalParam'. localParam :: LocalParam -> Doc a -localParam (LocalParam name val) = hsep ["localparameter", identifier name, "=", constExpr val] +localParam (LocalParam name val) = + hsep ["localparameter", identifier name, "=", constExpr val] identifier :: Identifier -> Doc a identifier (Identifier i) = pretty i @@ -109,13 +111,17 @@ portDir PortInOut = "inout" -- | Generate a 'ModItem'. moduleItem :: ModItem -> Doc a -moduleItem (ModCA ca) = contAssign ca -moduleItem (ModInst i name conn) = - hsep [identifier i, identifier name, parens . hsep $ punctuate comma (mConn <$> conn), semi] -moduleItem (Initial stat) = nest 2 $ vsep ["initial", statement stat] -moduleItem (Always stat) = nest 2 $ vsep ["always", statement stat] -moduleItem (Decl dir p ini) = - hsep [maybe mempty makePort dir, port p, maybe mempty makeIni ini, semi] +moduleItem (ModCA ca ) = contAssign ca +moduleItem (ModInst i name conn) = hsep + [ identifier i + , identifier name + , parens . hsep $ punctuate comma (mConn <$> conn) + , semi + ] +moduleItem (Initial stat ) = nest 2 $ vsep ["initial", statement stat] +moduleItem (Always stat ) = nest 2 $ vsep ["always", statement stat] +moduleItem (Decl dir p ini) = hsep + [maybe mempty makePort dir, port p, maybe mempty makeIni ini, semi] where makePort = portDir makeIni = ("=" <+>) . constExpr @@ -133,29 +139,30 @@ contAssign (ContAssign val e) = -- | Generate 'Expr' to 'Text'. expr :: Expr -> Doc a -expr (BinOp eRhs bin eLhs) = - parens $ hsep [expr eRhs, binaryOp bin, expr eLhs] -expr (Number b ) = showNum b -expr (Id i ) = identifier i -expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e] -expr (RangeSelect i r ) = hcat [identifier i, range r] -expr (Concat c ) = braces . nest 4 . sep . punctuate comma $ toList (expr <$> c) -expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e] -expr (Cond l t f) = parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]] +expr (BinOp eRhs bin eLhs) = parens $ hsep [expr eRhs, binaryOp bin, expr eLhs] +expr (Number b ) = showNum b +expr (Id i ) = identifier i +expr (VecSelect i e ) = hcat [identifier i, brackets $ expr e] +expr (RangeSelect i r ) = hcat [identifier i, range r] +expr (Concat c) = braces . nest 4 . sep . punctuate comma $ toList (expr <$> c) +expr (UnOp u e ) = parens $ hcat [unaryOp u, expr e] +expr (Cond l t f) = + parens . nest 4 $ sep [expr l <+> "?", hsep [expr t, colon, expr f]] expr (Appl f e) = hcat [identifier f, parens $ expr e] -expr (Str t ) = dquotes $ pretty t +expr (Str t ) = dquotes $ pretty t showNum :: BitVec -> Doc a -showNum (BitVec s n) = - parens $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")] +showNum (BitVec s n) = parens + $ hcat [minus, pretty $ showT s, "'h", pretty $ T.pack (showHex (abs n) "")] where minus | signum n >= 0 = mempty | otherwise = "-" constExpr :: ConstExpr -> Doc a -constExpr (ConstNum b) = showNum b -constExpr (ParamId i) = identifier i -constExpr (ConstConcat c) = braces . hsep . punctuate comma $ toList (constExpr <$> c) +constExpr (ConstNum b) = showNum b +constExpr (ParamId i) = identifier i +constExpr (ConstConcat c) = + braces . hsep . punctuate comma $ toList (constExpr <$> c) constExpr (ConstUnOp u e) = parens $ hcat [unaryOp u, constExpr e] constExpr (ConstBinOp eRhs bin eLhs) = parens $ hsep [constExpr eRhs, binaryOp bin, constExpr eLhs] @@ -234,33 +241,41 @@ pType Wire = "wire" pType Reg = "reg" genAssign :: Text -> Assign -> Doc a -genAssign op (Assign r d e) = hsep [lVal r, pretty op, maybe mempty delay d, expr e] +genAssign op (Assign r d e) = + hsep [lVal r, pretty op, maybe mempty delay d, expr e] statement :: Statement -> Doc a -statement (TimeCtrl d stat ) = hsep [delay d, defMap stat] -statement (EventCtrl e stat ) = hsep [event e, defMap stat] -statement (SeqBlock s) = vsep ["begin", indent 2 . vsep $ statement <$> s, "end"] -statement (BlockAssign a ) = hcat [genAssign "=" a, semi] -statement (NonBlockAssign a ) = hcat [genAssign "<=" a, semi] -statement (TaskEnable t ) = hcat [task t, semi] -statement (SysTaskEnable t ) = hcat ["$", task t, semi] -statement (CondStmnt e t Nothing) = vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t] -statement (CondStmnt e t f) = - vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t, "else", indent 2 $ defMap f] -statement (ForLoop a e incr stmnt) = - vsep [ hsep - [ "for" - , parens . hsep $ punctuate semi - [ genAssign "=" a - , expr e - , genAssign "=" incr - ] - ] - , indent 2 $ statement stmnt] +statement (TimeCtrl d stat) = hsep [delay d, defMap stat] +statement (EventCtrl e stat) = hsep [event e, defMap stat] +statement (SeqBlock s) = + vsep ["begin", indent 2 . vsep $ statement <$> s, "end"] +statement (BlockAssign a) = hcat [genAssign "=" a, semi] +statement (NonBlockAssign a) = hcat [genAssign "<=" a, semi] +statement (TaskEnable t) = hcat [task t, semi] +statement (SysTaskEnable t) = hcat ["$", task t, semi] +statement (CondStmnt e t Nothing) = + vsep [hsep ["if", parens $ expr e], indent 2 $ defMap t] +statement (CondStmnt e t f) = vsep + [ hsep ["if", parens $ expr e] + , indent 2 $ defMap t + , "else" + , indent 2 $ defMap f + ] +statement (ForLoop a e incr stmnt) = vsep + [ hsep + [ "for" + , parens . hsep $ punctuate + semi + [genAssign "=" a, expr e, genAssign "=" incr] + ] + , indent 2 $ statement stmnt + ] task :: Task -> Doc a -task (Task i e) | null e = identifier i - | otherwise = hsep [identifier i, parens . hsep $ punctuate comma (expr <$> e)] +task (Task i e) + | null e = identifier i + | otherwise = hsep + [identifier i, parens . hsep $ punctuate comma (expr <$> e)] -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. render :: (Source a) => a -> IO () diff --git a/src/VeriFuzz/Verilog/Gen.hs b/src/VeriFuzz/Verilog/Gen.hs index 630e3c0..0cff33a 100644 --- a/src/VeriFuzz/Verilog/Gen.hs +++ b/src/VeriFuzz/Verilog/Gen.hs @@ -174,7 +174,9 @@ constExprWithContext ps prob size , ( prob ^. probExprCond , ConstCond <$> subexpr 2 <*> subexpr 2 <*> subexpr 2 ) - , (prob ^. probExprConcat, ConstConcat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2)) + , ( prob ^. probExprConcat + , ConstConcat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2) + ) ] | otherwise = constExprWithContext ps prob 0 where subexpr y = constExprWithContext ps prob $ size `div` y @@ -184,8 +186,10 @@ exprSafeList prob = [(prob ^. probExprNum, Number <$> genBitVec)] exprRecList :: ProbExpr -> (Hog.Size -> Gen Expr) -> [(Int, Gen Expr)] exprRecList prob subexpr = - [ (prob ^. probExprNum , Number <$> genBitVec) - , (prob ^. probExprConcat , Concat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2)) + [ (prob ^. probExprNum, Number <$> genBitVec) + , ( prob ^. probExprConcat + , Concat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2) + ) , (prob ^. probExprUnOp , UnOp <$> unOp <*> subexpr 2) , (prob ^. probExprStr, Str <$> Hog.text (Hog.linear 0 100) Hog.alphaNum) , (prob ^. probExprBinOp , BinOp <$> subexpr 2 <*> binOp <*> subexpr 2) @@ -344,7 +348,7 @@ statement = do alwaysSeq :: StateGen ModItem alwaysSeq = do - stat <- seqBlock + stat <- seqBlock return $ Always (EventCtrl (EPosEdge "clk") (Just stat)) instantiate :: ModDecl -> StateGen ModItem @@ -414,7 +418,7 @@ modItem = do context <- get let defProb i = prob ^. probModItem . i Hog.frequency - [ (defProb probModItemAssign, ModCA <$> contAssign) + [ (defProb probModItemAssign , ModCA <$> contAssign) , (defProb probModItemSeqAlways, alwaysSeq) , ( if context ^. modDepth > 0 then defProb probModItemInst else 0 , modInst diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs index b7840ff..68d0ef3 100644 --- a/src/VeriFuzz/Verilog/Parser.hs +++ b/src/VeriFuzz/Verilog/Parser.hs @@ -113,13 +113,13 @@ parseVar = Id <$> identifier parseVecSelect :: Parser Expr parseVecSelect = do - i <- identifier + i <- identifier expr <- brackets parseExpr return $ VecSelect i expr parseRangeSelect :: Parser Expr parseRangeSelect = do - i <- identifier + i <- identifier range <- parseRange return $ RangeSelect i range @@ -136,8 +136,8 @@ parseFun = do return $ Appl (Identifier $ T.pack f) expr parserNonEmpty :: [a] -> Parser (NonEmpty a) -parserNonEmpty (a:b) = return $ a :| b -parserNonEmpty [] = fail "Concatenation cannot be empty." +parserNonEmpty (a : b) = return $ a :| b +parserNonEmpty [] = fail "Concatenation cannot be empty." parseTerm :: Parser Expr parseTerm = @@ -289,7 +289,7 @@ parseNetDecl pd = do sign <- option False (tok KWSigned $> True) range <- option 1 parseRange name <- identifier - i <- option Nothing (fmap Just (tok' SymEq *> parseConstExpr)) + i <- option Nothing (fmap Just (tok' SymEq *> parseConstExpr)) tok' SymSemi return $ Decl pd (Port t sign range name) i where type_ = tok KWWire $> Wire <|> tok KWReg $> Reg @@ -308,24 +308,22 @@ parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing parseConditional :: Parser Statement parseConditional = do - expr <- tok' KWIf *> parens parseExpr - true <- maybeEmptyStatement + expr <- tok' KWIf *> parens parseExpr + true <- maybeEmptyStatement false <- option Nothing (tok' KWElse *> maybeEmptyStatement) return $ CondStmnt expr true false parseLVal :: Parser LVal -parseLVal = - fmap RegConcat (braces $ commaSep parseExpr) - <|> ident - where - ident = do - i <- identifier - (try (ex i) <|> try (sz i) <|> return (RegId i)) - ex i = do - e <- tok' SymBrackL *> parseExpr - tok' SymBrackR - return $ RegExpr i e - sz i = RegSize i <$> parseRange +parseLVal = fmap RegConcat (braces $ commaSep parseExpr) <|> ident + where + ident = do + i <- identifier + (try (ex i) <|> try (sz i) <|> return (RegId i)) + ex i = do + e <- tok' SymBrackL *> parseExpr + tok' SymBrackR + return $ RegExpr i e + sz i = RegSize i <$> parseRange parseDelay :: Parser Delay parseDelay = Delay . toInt' <$> (tok' SymPound *> number) @@ -335,12 +333,12 @@ parseAssign t = do lval <- parseLVal tok' t delay <- option Nothing (fmap Just parseDelay) - expr <- parseExpr + expr <- parseExpr return $ Assign lval delay expr parseLoop :: Parser Statement parseLoop = do - a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq + a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq expr <- tok' SymSemi *> parseExpr incr <- tok' SymSemi *> parseAssign SymEq tok' SymParenR @@ -353,29 +351,37 @@ eventList t = do if null l then fail "Could not parse list" else return l parseEvent :: Parser Event -parseEvent = tok' SymAtAster $> EAll - <|> try (tok' SymAt *> tok' SymParenLAsterParenR $> EAll) - <|> try (tok' SymAt *> tok' SymParenL *> tok' SymAster *> tok' SymParenR $> EAll) - <|> try (tok' SymAt *> parens parseEvent') - <|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr)) - <|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma)) +parseEvent = + tok' SymAtAster + $> EAll + <|> try (tok' SymAt *> tok' SymParenLAsterParenR $> EAll) + <|> try + ( tok' SymAt + *> tok' SymParenL + *> tok' SymAster + *> tok' SymParenR + $> EAll + ) + <|> try (tok' SymAt *> parens parseEvent') + <|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr)) + <|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma)) parseEvent' :: Parser Event parseEvent' = try (tok' KWPosedge *> fmap EPosEdge identifier) - <|> try (tok' KWNegedge *> fmap ENegEdge identifier) - <|> try (fmap EId identifier) - <|> try (fmap EExpr parseExpr) + <|> try (tok' KWNegedge *> fmap ENegEdge identifier) + <|> try (fmap EId identifier) + <|> try (fmap EExpr parseExpr) parseEventCtrl :: Parser Statement parseEventCtrl = do - event <- parseEvent + event <- parseEvent statement <- option Nothing maybeEmptyStatement return $ EventCtrl event statement parseDelayCtrl :: Parser Statement parseDelayCtrl = do - delay <- parseDelay + delay <- parseDelay statement <- option Nothing maybeEmptyStatement return $ TimeCtrl delay statement @@ -400,17 +406,16 @@ parseSeq = do parseStatement :: Parser Statement parseStatement = parseSeq - <|> parseConditional - <|> parseLoop - <|> parseEventCtrl - <|> parseDelayCtrl - <|> try parseBlocking - <|> parseNonBlocking + <|> parseConditional + <|> parseLoop + <|> parseEventCtrl + <|> parseDelayCtrl + <|> try parseBlocking + <|> parseNonBlocking maybeEmptyStatement :: Parser (Maybe Statement) maybeEmptyStatement = - (tok' SymSemi >> return Nothing) - <|> (Just <$> parseStatement) + (tok' SymSemi >> return Nothing) <|> (Just <$> parseStatement) parseAlways :: Parser ModItem parseAlways = tok' KWAlways *> (Always <$> parseStatement) @@ -421,18 +426,16 @@ parseInitial = tok' KWInitial *> (Initial <$> parseStatement) namedModConn :: Parser ModConn namedModConn = do target <- tok' SymDot *> identifier - expr <- parens parseExpr + expr <- parens parseExpr return $ ModConnNamed target expr parseModConn :: Parser ModConn -parseModConn = - try (fmap ModConn parseExpr) - <|> namedModConn +parseModConn = try (fmap ModConn parseExpr) <|> namedModConn parseModInst :: Parser ModItem parseModInst = do - m <- identifier - name <- identifier + m <- identifier + name <- identifier modconns <- parens (commaSep parseModConn) tok' SymSemi return $ ModInst m name modconns @@ -440,10 +443,10 @@ parseModInst = do parseModItem :: Parser ModItem parseModItem = try (ModCA <$> parseContAssign) - <|> try parseDecl - <|> parseAlways - <|> parseInitial - <|> parseModInst + <|> try parseDecl + <|> parseAlways + <|> parseInitial + <|> parseModInst parseModList :: Parser [Identifier] parseModList = list <|> return [] where list = parens $ commaSep identifier @@ -457,7 +460,7 @@ modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort parseParam :: Parser Parameter parseParam = do - i <- tok' KWParameter *> identifier + i <- tok' KWParameter *> identifier expr <- tok' SymEq *> parseConstExpr return $ Parameter i expr @@ -466,9 +469,9 @@ parseParams = tok' SymPound *> parens (commaSep parseParam) parseModDecl :: Parser ModDecl parseModDecl = do - name <- tok KWModule *> identifier + name <- tok KWModule *> identifier paramList <- option [] $ try parseParams - _ <- fmap defaultPort <$> parseModList + _ <- fmap defaultPort <$> parseModList tok' SymSemi modItem <- option [] . try $ many1 parseModItem tok' KWEndmodule @@ -491,13 +494,17 @@ parseVerilog -> Either Text Verilog -- ^ Returns 'String' with error -- message if parse fails. parseVerilog s = - bimap showT id . parse parseVerilogSrc (T.unpack s) . alexScanTokens . preprocess [] (T.unpack s) . T.unpack + bimap showT id + . parse parseVerilogSrc (T.unpack s) + . alexScanTokens + . preprocess [] (T.unpack s) + . T.unpack parseVerilogFile :: Text -> IO Verilog parseVerilogFile file = do src <- T.readFile $ T.unpack file case parseVerilog file src of - Left s -> error $ T.unpack s + Left s -> error $ T.unpack s Right r -> return r parseSourceInfoFile :: Text -> Text -> IO SourceInfo diff --git a/src/VeriFuzz/Verilog/Quote.hs b/src/VeriFuzz/Verilog/Quote.hs index b252af2..362cf06 100644 --- a/src/VeriFuzz/Verilog/Quote.hs +++ b/src/VeriFuzz/Verilog/Quote.hs @@ -33,11 +33,12 @@ liftText txt = AppE (VarE 'T.pack) <$> lift (T.unpack txt) -- | Quasiquoter for verilog, so that verilog can be written inline and be -- parsed to an AST at compile time. verilog :: QuasiQuoter -verilog = QuasiQuoter { quoteExp = quoteVerilog - , quotePat = undefined - , quoteType = undefined - , quoteDec = undefined - } +verilog = QuasiQuoter + { quoteExp = quoteVerilog + , quotePat = undefined + , quoteType = undefined + , quoteDec = undefined + } quoteVerilog :: String -> TH.Q TH.Exp quoteVerilog s = do @@ -45,5 +46,5 @@ quoteVerilog s = do let pos = T.pack $ TH.loc_filename loc v <- case parseVerilog pos (T.pack s) of Right e -> return e - Left e -> fail $ show e + Left e -> fail $ show e liftDataWithText v -- cgit