From dd5b03431de62189edd2087f997c99b3fd004a07 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 7 Mar 2019 15:39:19 -0500 Subject: [PATCH] allow block item declarations for un-named blocks --- src/Convert/Traverse.hs | 17 +++++++---------- src/Language/SystemVerilog/AST.hs | 12 +++++------- src/Language/SystemVerilog/Parser/Parse.y | 4 ++-- src/Language/SystemVerilog/Parser/ParseDecl.hs | 7 ++++--- 4 files changed, 18 insertions(+), 22 deletions(-) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index c51a351..dede47c 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -130,7 +130,8 @@ traverseNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt traverseNestedStmtsM mapper = fullMapper where fullMapper stmt = mapper stmt >>= cs - cs (Block decls stmts) = mapM fullMapper stmts >>= return . Block decls + cs (Block name decls stmts) = + mapM fullMapper stmts >>= return . Block name decls cs (Case u kw expr cases def) = do caseStmts <- mapM fullMapper $ map snd cases let cases' = zip (map fst cases) caseStmts @@ -250,13 +251,9 @@ traverseExprsM mapper = moduleItemMapper exprs' <- mapM exprMapper exprs return (exprs', stmt) stmtMapper = traverseNestedStmtsM flatStmtMapper - flatStmtMapper (Block header stmts) = do - if header == Nothing - then return $ Block Nothing stmts - else do - let Just (name, decls) = header - decls' <- mapM declMapper decls - return $ Block (Just (name, decls')) stmts + flatStmtMapper (Block name decls stmts) = do + decls' <- mapM declMapper decls + return $ Block name decls' stmts flatStmtMapper (Case u kw e cases def) = do e' <- exprMapper e cases' <- mapM caseMapper cases @@ -368,9 +365,9 @@ traverseDeclsM mapper item = do decls' <- mapM mapper decls return $ MIPackageItem $ Task l x decls' s miMapperA other = return other - miMapperB (Block (Just (name, decls)) stmts) = do + miMapperB (Block name decls stmts) = do decls' <- mapM mapper decls - return $ Block (Just (name, decls')) stmts + return $ Block name decls' stmts miMapperB other = return other traverseDecls :: Mapper Decl -> Mapper ModuleItem diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index 437a39e..c3663e7 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/src/Language/SystemVerilog/AST.hs @@ -419,7 +419,7 @@ instance Show CaseKW where show CaseX = "casex" data Stmt - = Block (Maybe (Identifier, [Decl])) [Stmt] + = Block (Maybe Identifier) [Decl] [Stmt] | Case Bool CaseKW Expr [Case] (Maybe Stmt) | For (Identifier, Expr) Expr (Identifier, Expr) Stmt | AsgnBlk LHS Expr @@ -439,14 +439,12 @@ commas :: [String] -> String commas = intercalate ", " instance Show Stmt where - show (Block header stmts) = - printf "begin%s\n%s\nend" extra (block stmts) + show (Block name decls stmts) = + printf "begin%s\n%s\n%s\nend" header (block decls) (block stmts) where + header = maybe "" (" : " ++) name block :: Show t => [t] -> String block = indent . unlines' . map show - extra = case header of - Nothing -> "" - Just (x, i) -> printf " : %s\n%s" x (block i) show (Case u kw e cs def) = printf "%s%s (%s)\n%s%s\nendcase" uniqStr (show kw) (show e) (indent $ unlines' $ map showCase cs) defStr where @@ -469,7 +467,7 @@ instance Show Stmt where where rest = case s of Null -> ";" - Block _ _ -> " " ++ (show s) + Block _ _ _ -> " " ++ (show s) _ -> "\n" ++ (indent $ show s) show (Null ) = ";" diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index bd8ad29..4e46133 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -411,8 +411,8 @@ Stmt :: { Stmt } | Identifier ";" { Subroutine $1 [] } StmtNonAsgn :: { Stmt } : ";" { Null } - | "begin" Stmts "end" { Block Nothing $2 } - | "begin" ":" Identifier DeclsAndStmts "end" { Block (Just ($3, fst $4)) (snd $4) } + | "begin" DeclsAndStmts "end" { Block Nothing (fst $2) (snd $2) } + | "begin" ":" Identifier DeclsAndStmts "end" { Block (Just $3) (fst $4) (snd $4) } | "if" "(" Expr ")" Stmt "else" Stmt { If $3 $5 $7 } | "if" "(" Expr ")" Stmt %prec NoElse { If $3 $5 Null } | "for" "(" Identifier "=" Expr ";" Expr ";" Identifier "=" Expr ")" Stmt { For ($3, $5) $7 ($9, $11) $13 } diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index 81f6772..4cfa3d3 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -155,8 +155,9 @@ parseDTsAsDeclOrAsgn tokens = _ -> error $ "invalid block item decl or stmt: " ++ (show tokens) Just lhs = foldl takeLHSStep Nothing $ init tokens isAsgnToken :: DeclToken -> Bool - isAsgnToken (DTBit _) = True - isAsgnToken (DTConcat _) = True + isAsgnToken (DTBit _) = True + isAsgnToken (DTConcat _) = True + isAsgnToken (DTAsgnNBlk _) = True isAsgnToken _ = False takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS @@ -267,7 +268,7 @@ takeComma _ = error "take comma encountered neither comma nor end of tokens" takeIdent :: [DeclToken] -> (Identifier, [DeclToken]) takeIdent (DTIdent x : rest) = (x, rest) -takeIdent _ = error "takeIdent didn't find identifier" +takeIdent tokens = error $ "takeIdent didn't find identifier: " ++ show tokens isIdent :: DeclToken -> Bool