support for statement labels and basic fork-join

src/Convert/BlockDecl.hs

@@ -20,8 +20,8 @@ convert =
     $ traverseStmts $ convertStmt
 
 convertStmt :: Stmt -> Stmt
-convertStmt (Block name decls stmts) =
-    Block name decls' stmts'
+convertStmt (Block Seq name decls stmts) =
+    Block Seq name decls' stmts'
     where
         splitDecls = map splitDecl decls
         decls' = map fst splitDecls

src/Convert/ForDecl.hs

@@ -11,8 +11,6 @@
 
 module Convert.ForDecl (convert) where
 
-import Data.Either (isLeft, isRight, lefts, rights)
-
 import Convert.Traverse
 import Language.SystemVerilog.AST
 
@@ -24,14 +22,14 @@ convert =
     )
 
 convertGenItem :: GenItem -> GenItem
-convertGenItem (GenFor (True, x, e) a b mbx c) =
-    GenBlock Nothing genItems
+convertGenItem (GenFor (True, x, e) a b bx c) =
+    GenBlock "" genItems
     where
-        x' = (maybe "" (++ "_") mbx) ++ x
+        x' = if null bx then x else bx ++ "_" ++ x
         Generate genItems =
             traverseNestedModuleItems converter $ Generate $
             [ GenModuleItem $ Genvar x'
-            , GenFor (False, x, e) a b mbx c
+            , GenFor (False, x, e) a b bx c
             ]
         converter =
             (traverseExprs $ traverseNestedExprs convertExpr) .
@@ -45,33 +43,28 @@ convertGenItem (GenFor (True, x, e) a b mbx c) =
 convertGenItem other = other
 
 convertStmt :: Stmt -> Stmt
-convertStmt (For [] cc asgns stmt) =
+convertStmt (For (Left []) cc asgns stmt) =
+    convertStmt $ For (Right []) cc asgns stmt
+convertStmt (For (Right []) cc asgns stmt) =
     convertStmt $ For inits cc asgns stmt
-    where inits = [Left $ dummyDecl (Just $ Number "0")]
-convertStmt (orig @ (For [Right _] _ _ _)) = orig
+    where inits = Left [dummyDecl (Just $ Number "0")]
+convertStmt (orig @ (For (Right [_]) _ _ _)) = orig
 
-convertStmt (orig @ (For (inits @ (Left _: _)) cc asgns stmt)) =
-    if not $ all isLeft inits
-    then error $ "for loop has mix of decls and asgns: " ++ show orig
-    else Block
-            Nothing
-            decls
-            (initAsgns ++ [For [Right (lhs, expr)] cc asgns stmt])
+convertStmt (For (Left inits) cc asgns stmt) =
+    Block Seq "" decls $
+        initAsgns ++
+        [For (Right [(lhs, expr)]) cc asgns stmt]
     where
-        splitDecls = map splitDecl $ lefts inits
+        splitDecls = map splitDecl inits
         decls = map fst splitDecls
         initAsgns = map asgnStmt $ init $ map snd splitDecls
         (lhs, expr) = snd $ last splitDecls
 
-convertStmt (orig @ (For inits cc asgns stmt)) =
-    if not $ all isRight inits
-    then error $ "for loop has mix of decls and asgns: " ++ show orig
-    else Block
-            Nothing
-            []
-            (initAsgns ++ [For [Right (lhs, expr)] cc asgns stmt])
+convertStmt (For (Right origPairs) cc asgns stmt) =
+    Block Seq "" [] $
+        initAsgns ++
+        [For (Right [(lhs, expr)]) cc asgns stmt]
     where
-        origPairs = rights inits
         (lhs, expr) = last origPairs
         initAsgns = map asgnStmt $ init origPairs
 

src/Convert/Foreach.hs

@@ -25,7 +25,7 @@ convertStmt (Foreach x idxs stmt) =
         toLoop :: (Int, Maybe Identifier) -> (Stmt -> Stmt)
         toLoop (_, Nothing) = id
         toLoop (d, Just i) =
-            For [Left idxDecl] (Just cmp) [incr]
+            For (Left [idxDecl]) cmp [incr]
             where
                 queryFn f = DimFn f (Right $ Ident x) (Number $ show d)
                 idxDecl = Variable Local (IntegerAtom TInteger Unspecified) i []

src/Convert/NamedBlock.hs

@@ -26,19 +26,19 @@ convert asts =
     where runner = mapM . traverseDescriptionsM . traverseModuleItemsM . traverseStmtsM
 
 collectStmtM :: Stmt -> State Idents Stmt
-collectStmtM (Block (Just x) decls stmts) = do
+collectStmtM (Block kw x decls stmts) = do
     modify $ Set.insert x
-    return $ Block (Just x) decls stmts
+    return $ Block kw x decls stmts
 collectStmtM other = return other
 
 traverseStmtM :: Stmt -> State Idents Stmt
-traverseStmtM (Block Nothing [] stmts) =
-    return $ Block Nothing [] stmts
-traverseStmtM (Block Nothing decls stmts) = do
+traverseStmtM (Block kw "" [] stmts) =
+    return $ Block kw "" [] stmts
+traverseStmtM (Block kw "" decls stmts) = do
     names <- get
     let x = uniqueBlockName names
     modify $ Set.insert x
-    return $ Block (Just x) decls stmts
+    return $ Block kw x decls stmts
 traverseStmtM other = return other
 
 uniqueBlockName :: Idents -> Identifier

src/Convert/StmtBlock.hs

@@ -27,4 +27,4 @@ convertPackageItem other = other
 
 stmtsToStmt :: [Stmt] -> Stmt
 stmtsToStmt [stmt] = stmt
-stmtsToStmt stmts = Block Nothing [] stmts
+stmtsToStmt stmts = Block Seq "" [] stmts

src/Convert/Stream.hs

@@ -29,7 +29,7 @@ convertDescription other = other
 
 streamerBlock :: Expr -> Expr -> (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
 streamerBlock chunk size asgn output input =
-    Block Nothing
+    Block Seq ""
     [ Variable Local t inp [] $ Just input
     , Variable Local t out [] Nothing
     , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nothing
@@ -50,14 +50,14 @@ streamerBlock chunk size asgn output input =
         idx = name ++ "_idx"
         bas = name ++ "_bas"
         -- main chunk loop
-        inits = [Right (LHSIdent idx, lo)]
-        cmp = Just $ BinOp Le (Ident idx) (BinOp Sub hi chunk)
+        inits = Right [(LHSIdent idx, lo)]
+        cmp = BinOp Le (Ident idx) (BinOp Sub hi chunk)
         incr = [(LHSIdent idx, AsgnOp Add, chunk)]
         lhs = LHSRange (LHSIdent out) IndexedMinus (BinOp Sub hi (Ident idx), chunk)
         expr = Range (Ident inp) IndexedPlus (Ident idx, chunk)
         stmt = AsgnBlk AsgnOpEq lhs expr
         -- final chunk loop
-        cmp2 = Just $ BinOp Lt (Ident idx) (BinOp Sub size (Ident bas))
+        cmp2 = BinOp Lt (Ident idx) (BinOp Sub size (Ident bas))
         incr2 = [(LHSIdent idx, AsgnOp Add, Number "1")]
         lhs2 = LHSBit (LHSIdent out) (Ident idx)
         expr2 = Bit (Ident inp) (BinOp Add (Ident idx) (Ident bas))

src/Convert/Traverse.hs

@@ -126,7 +126,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d
     let items'' = concatMap breakGenerate items'
     return $ Part attrs extern kw lifetime name ports items''
     where
-        fullMapper (Generate [GenBlock Nothing genItems]) =
+        fullMapper (Generate [GenBlock "" genItems]) =
             mapM fullGenItemMapper genItems >>= mapper . Generate
         fullMapper (Generate genItems) = do
             let genItems' = filter (/= GenNull) genItems
@@ -138,7 +138,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d
         genItemMapper (GenModuleItem moduleItem) = do
             moduleItem' <- fullMapper moduleItem
             return $ case moduleItem' of
-                Generate subItems -> GenBlock Nothing subItems
+                Generate subItems -> GenBlock "" subItems
                 _ -> GenModuleItem moduleItem'
         genItemMapper (GenIf (Number "1") s _) = return s
         genItemMapper (GenIf (Number "0") _ s) = return s
@@ -228,9 +228,9 @@ traverseSinglyNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt
 traverseSinglyNestedStmtsM fullMapper = cs
     where
         cs (StmtAttr a stmt) = fullMapper stmt >>= return . StmtAttr a
-        cs (Block Nothing [] []) = return Null
-        cs (Block name decls stmts) =
-            mapM fullMapper stmts >>= return . Block name decls
+        cs (Block _ "" [] []) = return Null
+        cs (Block kw name decls stmts) =
+            mapM fullMapper stmts >>= return . Block kw name decls
         cs (Case u kw expr cases def) = do
             caseStmts <- mapM fullMapper $ map snd cases
             let cases' = zip (map fst cases) caseStmts
@@ -373,16 +373,17 @@ traverseStmtLHSsM mapper = stmtMapper
         stmtMapper (AsgnBlk op lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk op lhs' expr
         stmtMapper (Asgn    mt lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn    mt lhs' expr
         stmtMapper (For inits me incrs stmt) = do
-            inits' <- mapM mapInit inits
+            inits' <- mapInits inits
             let (lhss, asgnOps, exprs) = unzip3 incrs
             lhss' <- mapM fullMapper lhss
             let incrs' = zip3 lhss' asgnOps exprs
             return $ For inits' me incrs' stmt
             where
-                mapInit (Left decl) = return $ Left decl
-                mapInit (Right (lhs, expr)) = do
-                    lhs' <- fullMapper lhs
-                    return $ Right (lhs', expr)
+                mapInits (Left decls) = return $ Left decls
+                mapInits (Right asgns) = do
+                    let (lhss, exprs) = unzip asgns
+                    lhss' <- mapM fullMapper lhss
+                    return $ Right $ zip lhss' exprs
         stmtMapper (Assertion a) =
             assertionMapper a >>= return . Assertion
         stmtMapper other = return other
@@ -664,9 +665,9 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     flatStmtMapper (StmtAttr attr stmt) =
         -- note: we exclude expressions in attributes from conversion
         return $ StmtAttr attr stmt
-    flatStmtMapper (Block name decls stmts) = do
+    flatStmtMapper (Block kw name decls stmts) = do
         decls' <- mapM declMapper decls
-        return $ Block name decls' stmts
+        return $ Block kw name decls' stmts
     flatStmtMapper (Case u kw e cases def) = do
         e' <- exprMapper e
         cases' <- mapM caseMapper cases
@@ -680,8 +681,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper
         expr' <- exprMapper expr
         return $ Asgn    mt lhs' expr'
     flatStmtMapper (For inits cc asgns stmt) = do
-        inits' <- mapM initMapper inits
-        cc' <- maybeExprMapper cc
+        inits' <- initsMapper inits
+        cc' <- exprMapper cc
         asgns' <- mapM asgnMapper asgns
         return $ For inits' cc' asgns' stmt
     flatStmtMapper (While   e stmt) =
@@ -709,8 +710,9 @@ traverseStmtExprsM exprMapper = flatStmtMapper
         return $ Assertion a''
     flatStmtMapper (Null) = return Null
 
-    initMapper (Left decl) = declMapper decl >>= return . Left
-    initMapper (Right (l, e)) = exprMapper e >>= \e' -> return $ Right (l, e')
+    initsMapper (Left decls) = mapM declMapper decls >>= return . Left
+    initsMapper (Right asgns) = mapM mapper asgns >>= return . Right
+        where mapper (l, e) = exprMapper e >>= return . (,) l
 
     asgnMapper (l, op, e) = exprMapper e >>= \e' -> return $ (l, op, e')
 
@@ -802,9 +804,9 @@ traverseDeclsM' strat mapper item = do
                     else return decls
             return $ MIPackageItem $ Task l x decls' stmts
         miMapper other = return other
-        stmtMapper (Block name decls stmts) = do
+        stmtMapper (Block kw name decls stmts) = do
             decls' <- mapM mapper decls
-            return $ Block name decls' stmts
+            return $ Block kw name decls' stmts
         stmtMapper other = return other
 
 traverseDecls' :: TFStrategy -> Mapper Decl -> Mapper ModuleItem
@@ -938,7 +940,7 @@ traverseSinglyNestedGenItemsM fullMapper = gim
             return $ GenModuleItem moduleItem
         gim (GenNull) = return GenNull
         flattenBlocks :: GenItem -> [GenItem]
-        flattenBlocks (GenBlock Nothing items) = items
+        flattenBlocks (GenBlock "" items) = items
         flattenBlocks other = [other]
 
 traverseAsgnsM' :: Monad m => TFStrategy -> MapperM m (LHS, Expr) -> MapperM m ModuleItem
@@ -1032,10 +1034,10 @@ traverseScopesM declMapper moduleItemMapper stmtMapper =
 
         nestedStmtMapper stmt =
             stmtMapper stmt >>= traverseSinglyNestedStmtsM fullStmtMapper
-        fullStmtMapper (Block name decls stmts) = do
+        fullStmtMapper (Block kw name decls stmts) = do
             prevState <- get
             decls' <- mapM declMapper decls
-            block <- nestedStmtMapper $ Block name decls' stmts
+            block <- nestedStmtMapper $ Block kw name decls' stmts
             put prevState
             return block
         fullStmtMapper other = nestedStmtMapper other

src/Language/SystemVerilog/AST/GenItem.hs

@@ -20,9 +20,9 @@ import Language.SystemVerilog.AST.Type (Identifier)
 import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)
 
 data GenItem
-    = GenBlock (Maybe Identifier) [GenItem]
+    = GenBlock Identifier [GenItem]
     | GenCase  Expr [GenCase] (Maybe GenItem)
-    | GenFor   (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) (Maybe Identifier) [GenItem]
+    | GenFor   (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) Identifier [GenItem]
     | GenIf    Expr GenItem GenItem
     | GenNull
     | GenModuleItem ModuleItem
@@ -30,9 +30,9 @@ data GenItem
 
 instance Show GenItem where
     showList i _ = unlines' $ map show i
-    show (GenBlock mx i)  =
+    show (GenBlock x i)  =
         printf "begin%s\n%s\nend"
-            (maybe "" (" : " ++) mx)
+            (if null x then "" else " : " ++ x)
             (indent $ unlines' $ map show i)
     show (GenCase e cs def) =
         printf "case (%s)\n%s%s\nendcase" (show e) bodyStr defStr
@@ -43,13 +43,13 @@ instance Show GenItem where
                 Just c -> printf "\n\tdefault: %s" (show c)
     show (GenIf e a GenNull) = printf "if (%s) %s"          (show e) (show a)
     show (GenIf e a b      ) = printf "if (%s) %s\nelse %s" (show e) (show a) (show b)
-    show (GenFor (new, x1, e1) c (x2, o2, e2) mx is) =
+    show (GenFor (new, x1, e1) c (x2, o2, e2) x is) =
         printf "for (%s%s = %s; %s; %s %s %s) %s"
             (if new then "genvar " else "")
             x1 (show e1)
             (show c)
             x2 (show o2) (show e2)
-            (show $ GenBlock mx is)
+            (show $ GenBlock x is)
     show (GenNull) = ";"
     show (GenModuleItem item) = show item
 

src/Language/SystemVerilog/AST/Stmt.hs

@@ -20,6 +20,7 @@ module Language.SystemVerilog.AST.Stmt
     , Assertion    (..)
     , PropertySpec (..)
     , UniquePriority (..)
+    , BlockKW (..)
     ) where
 
 import Text.Printf (printf)
@@ -29,14 +30,14 @@ import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Decl)
 import Language.SystemVerilog.AST.Expr (Expr, Args)
 import Language.SystemVerilog.AST.LHS (LHS)
-import Language.SystemVerilog.AST.Op (AsgnOp)
+import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq))
 import Language.SystemVerilog.AST.Type (Identifier)
 
 data Stmt
     = StmtAttr Attr Stmt
-    | Block   (Maybe Identifier) [Decl] [Stmt]
+    | Block   BlockKW Identifier [Decl] [Stmt]
     | Case    (Maybe UniquePriority) CaseKW Expr [Case] (Maybe Stmt)
-    | For     [Either Decl (LHS, Expr)] (Maybe Expr) [(LHS, AsgnOp, Expr)] Stmt
+    | For     (Either [Decl] [(LHS, Expr)]) Expr [(LHS, AsgnOp, Expr)] Stmt
     | AsgnBlk AsgnOp LHS Expr
     | Asgn    (Maybe Timing) LHS Expr
     | While   Expr Stmt
@@ -55,10 +56,10 @@ data Stmt
 
 instance Show Stmt where
     show (StmtAttr attr stmt) = printf "%s\n%s" (show attr) (show stmt)
-    show (Block name decls stmts) =
-        printf "begin%s\n%s\nend" header body
+    show (Block kw name decls stmts) =
+        printf "%s%s\n%s\n%s" (show kw) header body (blockEndToken kw)
         where
-            header = maybe "" (" : " ++) name
+            header = if null name then "" else " : " ++ name
             bodyLines = (map show decls) ++ (map show stmts)
             body = indent $ unlines' bodyLines
     show (Case u kw e cs def) =
@@ -68,16 +69,17 @@ instance Show Stmt where
             defStr = case def of
                 Nothing -> ""
                 Just c -> printf "\n\tdefault: %s" (show c)
-    show (For inits mc assigns stmt) =
+    show (For inits cond assigns stmt) =
         printf "for (%s; %s; %s)\n%s"
-            (commas $ map showInit inits)
-            (maybe "" show mc)
+            (showInits inits)
+            (show cond)
             (commas $ map showAssign assigns)
             (indent $ show stmt)
         where
-            showInit :: Either Decl (LHS, Expr) -> String
-            showInit (Left d) = init $ show d
-            showInit (Right (l, e)) = printf "%s = %s" (show l) (show e)
+            showInits :: Either [Decl] [(LHS, Expr)] -> String
+            showInits (Left decls) = commas $ map (init . show) decls
+            showInits (Right asgns) = commas $ map showInit asgns
+                where showInit (l, e) = showAssign (l, AsgnOpEq, e)
             showAssign :: (LHS, AsgnOp, Expr) -> String
             showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e)
     show (Subroutine ps x a) = printf "%s%s(%s);" (maybe "" (++ "::") ps) x (show a)
@@ -221,3 +223,16 @@ instance Show UniquePriority where
     show Unique   = "unique"
     show Unique0  = "unique0"
     show Priority = "priority"
+
+data BlockKW
+    = Seq
+    | Par
+    deriving Eq
+
+instance Show BlockKW where
+    show Seq = "begin"
+    show Par = "fork"
+
+blockEndToken :: BlockKW -> Identifier
+blockEndToken Seq = "end"
+blockEndToken Par = "join"

src/Language/SystemVerilog/Parser/Parse.y

@@ -518,6 +518,10 @@ PackageDeclaration :: { Description }
 Tag :: { Identifier }
   : ":" Identifier { $2 }
 
+StrTag :: { Identifier }
+  : {- empty -}    { "" }
+  | ":" Identifier { $2 }
+
 PackageImportDeclarations :: { [ModuleItem] }
   : PackageImportDeclaration PackageImportDeclarations { $1 ++ $2 }
   | {- empty -}                                        { [] }
@@ -700,7 +704,7 @@ SeqMatchItems :: { [SeqMatchItem] }
   | SeqMatchItems "," SeqMatchItem { $1 ++ [$3] }
 SeqMatchItem :: { SeqMatchItem }
   : ForStepAssignment   { Left $1 }
-  | Identifier "(" CallArgs ")" { Right ($1, $3) }
+  | Identifier CallArgs { Right ($1, $2) }
 
 ActionBlock :: { ActionBlock }
   : Stmt %prec NoElse { ActionBlockIf   $1 }
@@ -879,22 +883,31 @@ Stmts :: { [Stmt] }
   | Stmts Stmt  { $1 ++ [$2] }
 
 Stmt :: { Stmt }
-  : StmtNonAsgn         { $1 }
-  | LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
+  : StmtAsgn    { $1 }
+  | StmtNonAsgn { $1 }
+
+StmtAsgn :: { Stmt }
+  : LHS AsgnOp Expr ";"                        { AsgnBlk $2 $1 $3 }
+  | LHS IncOrDecOperator ";"                   { AsgnBlk (AsgnOp $2) $1 (Number "1") }
+  | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
   |                 Identifier ";" { Subroutine (Nothing) $1 (Args [] []) }
   | Identifier "::" Identifier ";" { Subroutine (Just $1) $3 (Args [] []) }
-  | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
-  | LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") }
 StmtNonAsgn :: { Stmt }
+  : StmtBlock(BlockKWSeq, "end" ) { $1 }
+  | StmtBlock(BlockKWPar, "join") { $1 }
+  |                StmtNonBlock   { $1 }
+  | Identifier ":" StmtNonBlock   { Block Seq $1 [] [$3] }
+StmtBlock(begin, end) :: { Stmt }
+  :                begin StrTag DeclsAndStmts end StrTag { uncurry (Block $1 $ combineTags $2 $5) $3 }
+  | Identifier ":" begin        DeclsAndStmts end StrTag { uncurry (Block $3 $ combineTags $1 $6) $4 }
+StmtNonBlock :: { Stmt }
   : ";" { Null }
-  | "begin" opt(Tag) DeclsAndStmts "end" opt(Tag) { Block (combineTags $2 $5) (fst $3) (snd $3) }
   | Unique "if" "(" Expr ")" Stmt "else" Stmt  { If $1 $4 $6 $8   }
   | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null }
-  | "for" "("            ";"  opt(Expr) ";" ForStep ")" Stmt { For []                           $4 $6 $8 }
-  | "for" "(" DeclTokens(";") opt(Expr) ";" ForStep ")" Stmt { For (parseDTsAsDeclsAndAsgns $3) $4 $6 $8 }
-  | Unique CaseKW "(" Expr ")" CasesWithDefault "endcase" { Case $1 $2 $4 (fst $6) (snd $6) }
-  |                 Identifier "(" CallArgs ")" ";" { Subroutine (Nothing) $1 $3 }
-  | Identifier "::" Identifier "(" CallArgs ")" ";" { Subroutine (Just $1) $3 $5 }
+  | "for" "(" ForInit ForCond ForStep ")" Stmt { For $3 $4 $5 $7 }
+  | Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 (fst $6) (snd $6) }
+  |                 Identifier CallArgs ";"    { Subroutine (Nothing) $1 $2 }
+  | Identifier "::" Identifier CallArgs ";"    { Subroutine (Just $1) $3 $4 }
   | TimingControl Stmt                         { Timing $1 $2 }
   | "return" Expr ";"                          { Return $2 }
   | "while"  "(" Expr ")" Stmt                 { While   $3 $5 }
@@ -907,12 +920,25 @@ StmtNonAsgn :: { Stmt }
   | ProceduralAssertionStatement               { Assertion $1 }
   | IncOrDecOperator LHS ";"                   { AsgnBlk (AsgnOp $1) $2 (Number "1") }
 
+BlockKWPar :: { BlockKW }
+  : "fork" { Par }
+BlockKWSeq :: { BlockKW }
+  : "begin" { Seq }
+
 Unique :: { Maybe UniquePriority }
   : {- empty -} { Nothing }
   | "unique"    { Just Unique   }
   | "unique0"   { Just Unique0  }
   | "priority"  { Just Priority }
 
+ForInit :: { Either [Decl] [(LHS, Expr)] }
+  :            ";"  { Right [] }
+  | DeclTokens(";") { parseDTsAsDeclsOrAsgns $1 }
+
+ForCond :: { Expr }
+  :      ";" { Number "1" }
+  | Expr ";" { $1 }
+
 ForStep :: { [(LHS, AsgnOp, Expr)] }
   : {- empty -}     { [] }
   | ForStepNonEmpty { $1 }
@@ -996,13 +1022,13 @@ CaseKW :: { CaseKW }
   | "casex" { CaseX }
   | "casez" { CaseZ }
 
-CasesWithDefault :: { ([Case], Maybe Stmt) }
+Cases :: { ([Case], Maybe Stmt) }
   : {- empty -}                { ([], Nothing) }
-  | Case CasesWithDefault { ($1 : fst $2, snd $2) }
-  | CaseDefault Cases     { ($2, Just $1) }
-Cases :: { [Case] }
+  | Case Cases                 { ($1 : fst $2, snd $2) }
+  | CaseDefault CasesNoDefault { ($2, Just $1) }
+CasesNoDefault :: { [Case] }
   : {- empty -} { [] }
-  | Cases Case   { $1 ++ [$2] }
+  | CasesNoDefault Case  { $1 ++ [$2] }
 
 Case :: { Case }
   : Exprs ":" Stmt { ($1, $3) }
@@ -1020,6 +1046,8 @@ Time :: { String }
   : time { tokenString $1 }
 
 CallArgs :: { Args }
+  : "(" CallArgsInside ")" { $2 }
+CallArgsInside :: { Args }
   : {- empty -}                        { Args [            ] [] }
   |                NamedCallArgsFollow { Args [            ] $1 }
   | Expr                 NamedCallArgs { Args [Just $1     ] $2 }
@@ -1049,8 +1077,8 @@ Expr :: { Expr }
   : "(" Expr ")"                { $2 }
   | String                      { String $1 }
   | Number                      { Number $1 }
-  |                 Identifier "(" CallArgs ")" { Call (Nothing) $1 $3 }
-  | Identifier "::" Identifier "(" CallArgs ")" { Call (Just $1) $3 $5 }
+  |                 Identifier CallArgs { Call (Nothing) $1 $2 }
+  | Identifier "::" Identifier CallArgs { Call (Just $1) $3 $4 }
   | DimsFn "(" TypeOrExpr ")"   { DimsFn $1 $3 }
   | DimFn  "(" TypeOrExpr ")"   { DimFn  $1 $3 (Number "1") }
   | DimFn  "(" TypeOrExpr "," Expr ")" { DimFn $1 $3 $5 }
@@ -1156,8 +1184,8 @@ ConditionalGenerateConstruct :: { GenItem }
 LoopGenerateConstruct :: { GenItem }
   : "for" "(" GenvarInitialization ";" Expr ";" GenvarIteration ")" GenBlock { (uncurry $ GenFor $3 $5 $7) $9 }
 
-GenBlock :: { (Maybe Identifier, [GenItem]) }
-  : "begin" opt(Tag) GenItems "end" opt(Tag) { (combineTags $2 $5, $3) }
+GenBlock :: { (Identifier, [GenItem]) }
+  : "begin" StrTag GenItems "end" StrTag { (combineTags $2 $5, $3) }
 
 GenCasesWithDefault :: { ([GenCase], Maybe GenItem) }
   : {- empty -}                 { ([], Nothing) }
@@ -1222,7 +1250,7 @@ parseError a = case a of
 
 genItemsToGenItem :: [GenItem] -> GenItem
 genItemsToGenItem [x] = x
-genItemsToGenItem xs = GenBlock Nothing xs
+genItemsToGenItem xs = GenBlock "" xs
 
 combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) -> ([Decl], [Stmt])
 combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2)
@@ -1242,13 +1270,13 @@ defaultFuncInput (Variable dir (Implicit sg rs) x a me) =
       else Implicit sg rs
 defaultFuncInput other = other
 
-combineTags :: Maybe Identifier -> Maybe Identifier -> Maybe Identifier
-combineTags (Just a) (Just b) =
+combineTags :: Identifier -> Identifier -> Identifier
+combineTags a "" = a
+combineTags "" b = b
+combineTags a b =
   if a == b
-    then Just a
+    then a
     else error $ "tag mismatch: " ++ show (a, b)
-combineTags Nothing other = other
-combineTags other   _     = other
 
 toLHS :: Expr -> LHS
 toLHS expr =

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -35,7 +35,7 @@ module Language.SystemVerilog.Parser.ParseDecl
 , parseDTsAsDecls
 , parseDTsAsDecl
 , parseDTsAsDeclOrAsgn
-, parseDTsAsDeclsAndAsgns
+, parseDTsAsDeclsOrAsgns
 ) where
 
 import Data.List (elemIndex, findIndex, findIndices)
@@ -219,28 +219,14 @@ parseDTsAsDeclOrAsgn tokens =
         isAsgn (DTAsgn _ _) = True
         isAsgn _ = False
 
--- [PUBLIC]: parser for mixed comma-separated declaration and assignment lists;
--- the main use case is for `for` loop initialization lists
-parseDTsAsDeclsAndAsgns :: [DeclToken] -> [Either Decl (LHS, Expr)]
-parseDTsAsDeclsAndAsgns [] = []
-parseDTsAsDeclsAndAsgns tokens =
+-- [PUBLIC]: parser for comma-separated declarations or assignment lists; this
+-- is only used for `for` loop initialization lists
+parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)]
+parseDTsAsDeclsOrAsgns tokens =
+    forbidNonEqAsgn tokens $
     if hasLeadingAsgn || tripLookahead tokens
-        then
-            let (lhsToks, l0) = break isDTAsgn tokens
-                lhs = case takeLHS lhsToks of
-                    Nothing ->
-                        error $ "could not parse as LHS: " ++ show lhsToks
-                    Just l -> l
-                DTAsgn AsgnOpEq expr : l1 = l0
-                asgn = Right (lhs, expr)
-            in case l1 of
-                DTComma : remaining -> asgn : parseDTsAsDeclsAndAsgns remaining
-                [] -> [asgn]
-                _ -> error $ "bad decls and asgns tokens: " ++ show tokens
-        else
-            let (component, remaining) = parseDTsAsComponent tokens
-                decls = finalize component
-            in (map Left decls) ++ parseDTsAsDeclsAndAsgns remaining
+        then Right $ parseDTsAsAsgns tokens
+        else Left  $ parseDTsAsDecls tokens
     where
         hasLeadingAsgn =
             -- if there is an asgn token before the next comma
@@ -248,6 +234,22 @@ parseDTsAsDeclsAndAsgns tokens =
                 (Just a, Just b) -> a > b
                 (Nothing, Just _) -> True
                 _ -> False
+
+-- internal parser for basic assignment lists
+parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)]
+parseDTsAsAsgns tokens =
+    case l1 of
+        [] -> [asgn]
+        DTComma : remaining -> asgn : parseDTsAsAsgns remaining
+        _ -> error $ "bad assignment tokens: " ++ show tokens
+    where
+        (lhsToks, l0) = break isDTAsgn tokens
+        lhs = case takeLHS lhsToks of
+            Nothing -> error $ "could not parse as LHS: " ++ show lhsToks
+            Just l -> l
+        DTAsgn AsgnOpEq expr : l1 = l0
+        asgn = (lhs, expr)
+
         isDTAsgn :: DeclToken -> Bool
         isDTAsgn (DTAsgn _ _) = True
         isDTAsgn _ = False