allow block item declarations for un-named blocks

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
+    flatStmtMapper (Block name decls stmts) = do
-        if header == Nothing
+        decls' <- mapM declMapper decls
-            then return $ Block Nothing stmts
+        return $ Block name decls' stmts
-            else do
-                let Just (name, decls) = header
-                decls' <- mapM declMapper decls
-                return $ Block (Just (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

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) =
+  show (Block name decls stmts) =
-    printf "begin%s\n%s\nend" extra (block 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       ) = ";"
 

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"                DeclsAndStmts "end" { Block Nothing   (fst $2) (snd $2) }
-  | "begin" ":" Identifier DeclsAndStmts "end" { Block (Just ($3, fst $4)) (snd $4) }
+  | "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 }

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 (DTBit      _) = True
-        isAsgnToken (DTConcat _) = 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