added source trace comments

- Trace comments cover module items, decls, and stmts
- Added pseudo-lexer to Alex parser for monadic Position production
- Added Position to every DeclToken
- Removed Comment PackageItem
- Added CommentStmt and CommentDecl
- Fixed traversal skipping outer MIAttr ModuleItems
- Generally cleaned up Parser modules

src/Convert/Assertion.hs

@@ -15,7 +15,7 @@ convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem
 convertModuleItem :: ModuleItem -> ModuleItem
 convertModuleItem (AssertionItem item) =
     Generate $
-    map (GenModuleItem . MIPackageItem . Comment) $
+    map (GenModuleItem . MIPackageItem . Decl . CommentDecl) $
         "removed an assertion item" :
         (lines $ show $ AssertionItem item)
 convertModuleItem other = traverseStmts convertStmt other

src/Convert/Interface.hs

@@ -191,6 +191,7 @@ prefixModuleItems prefix =
         prefixDecl (Variable d t x a me) = Variable d t (prefix ++ x) a me
         prefixDecl (Param    s t x    e) = Param    s t (prefix ++ x)    e
         prefixDecl (ParamType  s x   mt) = ParamType  s (prefix ++ x)   mt
+        prefixDecl (CommentDecl       c) = CommentDecl                   c
         prefixExpr :: Expr -> Expr
         prefixExpr (Ident x) = Ident (prefix ++ x)
         prefixExpr other = other
@@ -229,12 +230,15 @@ lookupType _ expr =
 -- convert an interface instantiation into a series of equivalent module items
 inlineInterface :: Interface -> (Identifier, [ParamBinding], [PortBinding]) -> [ModuleItem]
 inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
-    (:) (MIPackageItem $ Comment $ "expanded instance: " ++ instanceName) $
+    (:) comment $
     flip (++) portBindings $
     map (traverseNestedModuleItems removeModport) $
     map (traverseNestedModuleItems removeDeclDir) $
     itemsPrefixed
     where
+        comment = MIPackageItem $ Decl $ CommentDecl $
+            "expanded instance: " ++ instanceName
+
         prefix = instanceName ++ "_"
         itemsPrefixed =
             map (prefixModuleItems prefix) $
@@ -257,7 +261,7 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) =
         removeDeclDir other = other
         removeModport :: ModuleItem -> ModuleItem
         removeModport (Modport x _) =
-            MIPackageItem $ Comment $ "removed modport " ++ x
+            MIPackageItem $ Decl $ CommentDecl $ "removed modport " ++ x
         removeModport other = other
 
         instanceParamMap = Map.fromList instanceParams

src/Convert/Logic.hs

@@ -88,10 +88,11 @@ convertDescription ports orig =
             if null newItems
                 then Instance moduleName params instanceName rs bindings
                 else Generate $ map GenModuleItem $
-                    (MIPackageItem $ Comment "rewrote reg-to-output bindings") :
-                    newItems ++
+                    comment : newItems ++
                     [Instance moduleName params instanceName rs bindings']
             where
+                comment = MIPackageItem $ Decl $ CommentDecl
+                    "rewrote reg-to-output bindings"
                 (bindings', newItemsList) = unzip $ map fixBinding bindings
                 newItems = concat newItemsList
                 fixBinding :: PortBinding -> (PortBinding, [ModuleItem])

src/Convert/MultiplePacked.hs

@@ -51,8 +51,7 @@ traverseDeclM (Variable dir t ident a me) = do
 traverseDeclM (Param s t ident e) = do
     t' <- traverseTypeM t [] ident
     return $ Param s t' ident e
-traverseDeclM (ParamType s ident mt) =
-    return $ ParamType s ident mt
+traverseDeclM other = return other
 
 traverseTypeM :: Type -> [Range] -> Identifier -> State Info Type
 traverseTypeM t a ident = do

src/Convert/NestPI.hs

@@ -104,7 +104,7 @@ piName (Typedef    _ ident    ) = Just ident
 piName (Decl (Variable _ _ ident _ _)) = Just ident
 piName (Decl (Param    _ _ ident   _)) = Just ident
 piName (Decl (ParamType  _ ident   _)) = Just ident
+piName (Decl (CommentDecl          _)) = Nothing
 piName (Import x y) = Just $ show $ Import x y
 piName (Export    _) = Nothing
-piName (Comment   _) = Nothing
 piName (Directive _) = Nothing

src/Convert/Package.hs

@@ -175,7 +175,7 @@ piName (Typedef    _ ident    ) = Just ident
 piName (Decl (Variable _ _ ident _ _)) = Just ident
 piName (Decl (Param    _ _ ident   _)) = Just ident
 piName (Decl (ParamType  _ ident   _)) = Just ident
+piName (Decl (CommentDecl          _)) = Nothing
 piName (Import  _ _) = Nothing
 piName (Export    _) = Nothing
-piName (Comment   _) = Nothing
 piName (Directive _) = Nothing

src/Convert/RemoveComments.hs

@@ -15,12 +15,49 @@ convert = map convertFile
 convertFile :: AST -> AST
 convertFile =
     traverseDescriptions (traverseModuleItems convertModuleItem) .
-    filter (not . isComment)
+    filter (not . isTopLevelComment)
 
-isComment :: Description -> Bool
-isComment (PackageItem (Comment _)) = True
-isComment _ = False
+isTopLevelComment :: Description -> Bool
+isTopLevelComment (PackageItem (Decl CommentDecl{})) = True
+isTopLevelComment _ = False
 
 convertModuleItem :: ModuleItem -> ModuleItem
-convertModuleItem (MIPackageItem (Comment _)) = Generate []
-convertModuleItem other = other
+convertModuleItem (MIAttr _ (Generate [])) = Generate []
+convertModuleItem (MIPackageItem (Decl CommentDecl{})) = Generate []
+convertModuleItem (MIPackageItem item) =
+    MIPackageItem $ convertPackageItem item
+convertModuleItem other =
+    traverseStmts (traverseNestedStmts convertStmt) other
+
+convertPackageItem :: PackageItem -> PackageItem
+convertPackageItem (Function l t x decls stmts) =
+    Function l t x decls' stmts'
+    where
+        decls' = convertDecls decls
+        stmts' = convertStmts stmts
+convertPackageItem (Task     l   x decls stmts) =
+    Task     l   x decls' stmts'
+    where
+        decls' = convertDecls decls
+        stmts' = convertStmts stmts
+convertPackageItem other = other
+
+convertStmt :: Stmt -> Stmt
+convertStmt (CommentStmt _) = Null
+convertStmt (Block kw name decls stmts) =
+    Block kw name decls' stmts
+    where decls' = convertDecls decls
+convertStmt (For (Left decls) cond incr stmt) =
+    For (Left decls') cond incr stmt
+    where decls' = convertDecls decls
+convertStmt other = other
+
+convertDecls :: [Decl] -> [Decl]
+convertDecls = filter (not . isCommentDecl)
+    where
+        isCommentDecl :: Decl -> Bool
+        isCommentDecl CommentDecl{} = True
+        isCommentDecl _ = False
+
+convertStmts :: [Stmt] -> [Stmt]
+convertStmts = map $ traverseNestedStmts convertStmt

src/Convert/SizeCast.hs

@@ -45,6 +45,7 @@ traverseDeclM decl = do
         Variable _ t x _ _ -> modify $ Map.insert x t
         Param    _ t x   _ -> modify $ Map.insert x t
         ParamType    _ _ _ -> return ()
+        CommentDecl      _ -> return ()
     return decl
 
 traverseModuleItemM :: ModuleItem -> ST ModuleItem

src/Convert/Struct.hs

@@ -194,8 +194,8 @@ traverseDeclM structs origDecl = do
             modify $ Map.insert x t
             e' <- convertDeclExpr x e
             return $ Param s t x e'
-        ParamType s x mt ->
-            return $ ParamType s x mt
+        ParamType{} -> return origDecl
+        CommentDecl{} -> return origDecl
     where
         convertDeclExpr :: Identifier -> Expr -> State Types Expr
         convertDeclExpr x e = do

src/Convert/Traverse.hs

@@ -131,7 +131,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d
             let genItems' = filter (/= GenNull) genItems
             mapM fullGenItemMapper genItems' >>= mapper . Generate
         fullMapper (MIAttr attr mi) =
-            fullMapper mi >>= return . MIAttr attr
+            fullMapper mi >>= mapper . MIAttr attr
         fullMapper other = mapper other
         fullGenItemMapper = traverseNestedGenItemsM genItemMapper
         genItemMapper (GenModuleItem moduleItem) = do
@@ -264,6 +264,7 @@ traverseSinglyNestedStmtsM fullMapper = cs
         cs (Continue) = return Continue
         cs (Break) = return Break
         cs (Null) = return Null
+        cs (CommentStmt c) = return $ CommentStmt c
 
 traverseAssertionStmtsM :: Monad m => MapperM m Stmt -> MapperM m Assertion
 traverseAssertionStmtsM mapper = assertionMapper
@@ -548,6 +549,8 @@ exprMapperHelpers exprMapper =
         a' <- mapM rangeMapper a
         me' <- maybeExprMapper me
         return $ Variable d t' x a' me'
+    declMapper (CommentDecl c) =
+        return $ CommentDecl c
 
     lhsMapper (LHSRange l m r) =
         rangeMapper r >>= return . LHSRange l m
@@ -640,8 +643,6 @@ traverseExprsM' strat exprMapper = moduleItemMapper
         return $ Generate items'
     moduleItemMapper (MIPackageItem (Directive c)) =
         return $ MIPackageItem $ Directive c
-    moduleItemMapper (MIPackageItem (Comment c)) =
-        return $ MIPackageItem $ Comment c
     moduleItemMapper (MIPackageItem (Import x y)) =
         return $ MIPackageItem $ Import x y
     moduleItemMapper (MIPackageItem (Export x)) =
@@ -744,6 +745,7 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     flatStmtMapper (Continue) = return Continue
     flatStmtMapper (Break) = return Break
     flatStmtMapper (Null) = return Null
+    flatStmtMapper (CommentStmt c) = return $ CommentStmt c
 
     initsMapper (Left decls) = mapM declMapper decls >>= return . Left
     initsMapper (Right asgns) = mapM mapper asgns >>= return . Right
@@ -926,6 +928,7 @@ traverseTypesM mapper item =
             maybeMapper mt >>= \mt' -> return $ ParamType s x mt'
         declMapper (Variable d t x a me) =
             fullMapper t >>= \t' -> return $ Variable d t' x a me
+        declMapper (CommentDecl c) = return $ CommentDecl c
         miMapper (MIPackageItem (Typedef t x)) =
             fullMapper t >>= \t' -> return $ MIPackageItem $ Typedef t' x
         miMapper (MIPackageItem (Function l t x d s)) =

src/Convert/TypeOf.hs

@@ -53,7 +53,8 @@ traverseDeclM decl = do
         Param    _ t ident   _ -> do
             modify $ Map.insert ident t
             return decl'
-        ParamType    _     _ _ -> return decl'
+        ParamType{} -> return decl'
+        CommentDecl{} -> return decl'
 
 traverseModuleItemM :: ModuleItem -> State Info ModuleItem
 traverseModuleItemM item = traverseTypesM traverseTypeM item

src/Convert/Typedef.hs

@@ -30,7 +30,7 @@ convert =
         getTypedef _ = return ()
         removeTypedef :: Description -> Description
         removeTypedef (PackageItem (Typedef _ x)) =
-            PackageItem $ Comment $ "removed typedef: " ++ x
+            PackageItem $ Decl $ CommentDecl $ "removed typedef: " ++ x
         removeTypedef other = other
 
 convertDescription :: Types -> Description -> Description
@@ -48,7 +48,7 @@ convertDescription globalTypes description =
         getTypedef _ = return ()
         removeTypedef :: ModuleItem -> ModuleItem
         removeTypedef (MIPackageItem (Typedef _ x)) =
-            MIPackageItem $ Comment $ "removed typedef: " ++ x
+            MIPackageItem $ Decl $ CommentDecl  $ "removed typedef: " ++ x
         removeTypedef other = other
         convertTypeOrExpr :: TypeOrExpr -> TypeOrExpr
         convertTypeOrExpr (Left (TypeOf (Ident x))) =

src/Convert/UnpackedArray.hs

@@ -45,10 +45,7 @@ traverseDeclM (orig @ (Variable dir _ x _ me)) = do
         then lift $ tell $ Set.singleton orig
         else return ()
     return orig
-traverseDeclM (orig @ (Param _ _ _ _)) =
-    return orig
-traverseDeclM (orig @ (ParamType _ _ _)) =
-    return orig
+traverseDeclM other = return other
 
 -- pack the given decls marked for packing
 packDecl :: DeclSet -> Decl -> Decl
@@ -59,8 +56,7 @@ packDecl decls (orig @ (Variable d t x a me)) = do
             let t' = tf $ a ++ rs
             Variable d t' x [] me
         else orig
-packDecl _ (orig @ Param{}) = orig
-packDecl _ (orig @ ParamType{}) = orig
+packDecl _ other = other
 
 
 traverseModuleItemM :: ModuleItem -> ST ModuleItem

src/Language/SystemVerilog/AST/Decl.hs

@@ -23,6 +23,7 @@ data Decl
     = Param     ParamScope Type Identifier Expr
     | ParamType ParamScope Identifier (Maybe Type)
     | Variable   Direction Type Identifier [Range] (Maybe Expr)
+    | CommentDecl String
     deriving (Eq, Ord)
 
 instance Show Decl where
@@ -30,6 +31,10 @@ instance Show Decl where
     show (Param s t x e) = printf "%s %s%s = %s;" (show s) (showPad t) x (show e)
     show (ParamType s x mt) = printf "%s type %s%s;" (show s) x (showAssignment mt)
     show (Variable d t x a me) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment me)
+    show (CommentDecl c) =
+        if elem '\n' c
+            then "// " ++ show c
+            else "// " ++ c
 
 data Direction
     = Input

src/Language/SystemVerilog/AST/Description.hs

@@ -61,7 +61,6 @@ data PackageItem
     | Export (Maybe (Identifier, Maybe Identifier))
     | Decl Decl
     | Directive String
-    | Comment String
     deriving Eq
 
 instance Show PackageItem where
@@ -79,10 +78,6 @@ instance Show PackageItem where
     show (Export (Just (x, y))) = printf "export %s::%s;" x (fromMaybe "*" y)
     show (Decl decl) = show decl
     show (Directive str) = str
-    show (Comment c) =
-        if elem '\n' c
-            then "// " ++ show c
-            else "// " ++ c
 
 data PartKW
     = Module

src/Language/SystemVerilog/AST/Stmt.hs

@@ -54,6 +54,7 @@ data Stmt
     | Continue
     | Break
     | Null
+    | CommentStmt String
     deriving Eq
 
 instance Show Stmt where
@@ -98,8 +99,15 @@ instance Show Stmt where
     show (Continue   ) = "continue;"
     show (Break      ) = "break;"
     show (Null       ) = ";"
+    show (CommentStmt c) =
+        if elem '\n' c
+            then "// " ++ show c
+            else "// " ++ c
 
 showBranch :: Stmt -> String
+showBranch (Block Seq "" [] [CommentStmt c, stmt]) =
+    '\n' : (indent $ unlines' $ map show stmts)
+    where stmts = [CommentStmt c, stmt]
 showBranch (block @ Block{}) = ' ' : show block
 showBranch stmt = '\n' : (indent $ show stmt)
 

src/Language/SystemVerilog/Parser.hs

@@ -6,10 +6,12 @@ module Language.SystemVerilog.Parser
     ) where
 
 import Control.Monad.Except
+import Control.Monad.State
 import qualified Data.Map.Strict as Map
 import Language.SystemVerilog.AST (AST)
 import Language.SystemVerilog.Parser.Lex (lexFile, Env)
 import Language.SystemVerilog.Parser.Parse (parse)
+import Language.SystemVerilog.Parser.Tokens (Position(..), tokenPosition)
 
 -- parses a compilation unit given include search paths and predefined macros
 parseFiles :: [FilePath] -> [(String, String)] -> Bool -> [FilePath] -> IO (Either String [AST])
@@ -32,5 +34,9 @@ parseFile' :: [String] -> Env -> FilePath -> ExceptT String IO (AST, Env)
 parseFile' includePaths env path = do
     result <- liftIO $ lexFile includePaths env path
     (tokens, env') <- liftEither result
-    ast <- parse tokens
+    let position =
+            if null tokens
+                then Position path 1 1
+                else tokenPosition $ head tokens
+    ast <- evalStateT parse (position, tokens)
     return (ast, env')

src/Language/SystemVerilog/Parser/Parse.y

@@ -11,15 +11,18 @@
  - the ability to easily blame/diff this file.
  -}
 {
+{-# LANGUAGE BlockArguments #-}
 module Language.SystemVerilog.Parser.Parse (parse) where
 
 import Control.Monad.Except
+import Control.Monad.State
 import Language.SystemVerilog.AST
 import Language.SystemVerilog.Parser.ParseDecl
 import Language.SystemVerilog.Parser.Tokens
 }
 
-%monad { ExceptT String IO }
+%monad { ParseState }
+%lexer { positionKeep } { TokenEOF }
 %name parse
 %tokentype { Token }
 %error { parseError }
@@ -588,38 +591,29 @@ Identifiers :: { [Identifier] }
 DeclTokens(delim) :: { [DeclToken] }
   : DeclToken                           delim  { [$1] }
   | DeclToken                DeclTokens(delim) { [$1] ++ $2 }
-  | AsgnOp Expr "," DeclTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 }
-  | AsgnOp Expr                delim  { [DTAsgn $1 $2] }
+  | Identifier ParamBindings DeclTokens(delim) {% posInject \p -> [DTIdent p $1, DTParams p $2] ++ $3 }
+  | AsgnOp Expr ","          DeclTokens(delim) {% posInject \p -> [DTAsgn p $1 $2, DTComma p] ++ $4 }
+  | AsgnOp Expr                         delim  {% posInject \p -> [DTAsgn p $1 $2] }
 DeclToken :: { DeclToken }
-  : DeclOrStmtToken   { $1 }
-  | ParameterBindings { DTParams   $1 }
-
-DeclOrStmtTokens(delim) :: { [DeclToken] }
-  : DeclOrStmtToken                  delim  { [$1] }
-  | DeclOrStmtToken DeclOrStmtTokens(delim) { [$1] ++ $2 }
-  | AsgnOp Expr "," DeclOrStmtTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 }
-  | AsgnOp Expr                      delim  { [DTAsgn $1 $2] }
-  | IncOrDecOperator                 delim  { [DTAsgn (AsgnOp $1) (Number "1")] }
-  | "<=" opt(DelayOrEventControl) Expr "," DeclOrStmtTokens(delim) { [DTAsgnNBlk $2 $3, DTComma] ++ $5 }
-  | "<=" opt(DelayOrEventControl) Expr                      delim  { [DTAsgnNBlk $2 $3] }
-DeclOrStmtToken :: { DeclToken }
-  : ","            { DTComma }
-  | "[" "]"        { DTAutoDim }
-  | PartSelect     { DTRange    $1 }
-  | Identifier     { DTIdent    $1 }
-  | Direction      { DTDir      $1 }
-  | "[" Expr "]"   { DTBit      $2 }
-  | LHSConcat      { DTConcat   $1 }
-  | PartialType    { DTType     $1 }
-  | "." Identifier { DTDot      $2 }
-  | PortBindings   { DTInstance $1 }
-  | Signing        { DTSigning  $1 }
-  | ExplicitLifetime { DTLifetime $1 }
-  | Identifier "::" Identifier { DTPSIdent $1 $3 }
-  | "const" PartialType { DTType $2 }
-  | "{" StreamOp StreamSize Concat "}" { DTStream $2 $3           (map toLHS $4) }
-  | "{" StreamOp            Concat "}" { DTStream $2 (Number "1") (map toLHS $3) }
-  | opt("var") "type" "(" Expr ")" { DTType $ \Unspecified -> \[] -> TypeOf $4 }
+  : ","                                {% posInject \p -> DTComma    p }
+  | "[" "]"                            {% posInject \p -> DTAutoDim  p }
+  | PartSelect                         {% posInject \p -> DTRange    p $1 }
+  | Identifier                         {% posInject \p -> DTIdent    p $1 }
+  | Direction                          {% posInject \p -> DTDir      p $1 }
+  | "[" Expr "]"                       {% posInject \p -> DTBit      p $2 }
+  | LHSConcat                          {% posInject \p -> DTConcat   p $1 }
+  | PartialType                        {% posInject \p -> DTType     p $1 }
+  | "." Identifier                     {% posInject \p -> DTDot      p $2 }
+  | PortBindings                       {% posInject \p -> DTInstance p $1 }
+  | Signing                            {% posInject \p -> DTSigning  p $1 }
+  | ExplicitLifetime                   {% posInject \p -> DTLifetime p $1 }
+  | "const" PartialType                {% posInject \p -> DTType     p $2 }
+  | Identifier "::" Identifier         {% posInject \p -> DTPSIdent  p $1 $3 }
+  | "{" StreamOp StreamSize Concat "}" {% posInject \p -> DTStream   p $2 $3           (map toLHS $4) }
+  | "{" StreamOp            Concat "}" {% posInject \p -> DTStream   p $2 (Number "1") (map toLHS $3) }
+  | opt("var") "type" "(" Expr ")"     {% posInject \p -> DTType     p (\Unspecified -> \[] -> TypeOf $4) }
+  | "<=" opt(DelayOrEventControl) Expr {% posInject \p -> DTAsgnNBlk p $2 $3 }
+  | IncOrDecOperator                   {% posInject \p -> DTAsgn     p (AsgnOp $1) (Number "1") }
 
 VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
   : VariablePortIdentifier                             { [$1] }
@@ -635,7 +629,7 @@ Direction :: { Direction }
 
 ModuleItems :: { [ModuleItem] }
   : {- empty -}                    { [] }
-  | ModuleItems ModuleItem { $1 ++ $2 }
+  | ModuleItems MITrace ModuleItem { $1 ++ [$2] ++ $3 }
   | ModuleItems ";"                { $1 }
 
 ModuleItem :: { [ModuleItem] }
@@ -770,7 +764,7 @@ LHSAsgn :: { (LHS, Expr) }
 PackageItems :: { [PackageItem] }
   : {- empty -}                      { [] }
   | PackageItems ";"                 { $1 }
-  | PackageItems PackageItem { $1 ++ $2 }
+  | PackageItems PITrace PackageItem { $1 ++ [$2] ++ $3 }
 PackageItem :: { [PackageItem] }
   : DeclTokens(";")    { map Decl $ parseDTsAsDecls $1 }
   | ParameterDecl(";") { map Decl $1 }
@@ -888,7 +882,7 @@ PortBinding :: { PortBinding }
   | Expr                             { ("", Just $1) }
   | ".*"                             { ("*", Nothing) }
 
-ParameterBindings :: { [ParamBinding] }
+ParamBindings :: { [ParamBinding] }
   : "#" "(" ParamBindingsInside ")" { $3 }
 ParamBindingsInside :: { [ParamBinding] }
   : ParamBinding                         { [$1] }
@@ -903,12 +897,13 @@ Stmts :: { [Stmt] }
   | Stmts Stmt  { $1 ++ [$2] }
 
 Stmt :: { Stmt }
-  : StmtAsgn    { $1 }
-  | StmtNonAsgn { $1 }
+  : StmtTrace StmtAsgn    { Block Seq "" [] [$1, $2] }
+  | StmtTrace StmtNonAsgn { $2 }
 
 StmtAsgn :: { Stmt }
   : LHS AsgnOp Expr ";"                        { AsgnBlk $2 $1 $3 }
   | LHS IncOrDecOperator ";"                   { AsgnBlk (AsgnOp $2) $1 (Number "1") }
+  | IncOrDecOperator LHS ";"                   { AsgnBlk (AsgnOp $1) $2 (Number "1") }
   | LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
   | LHS          ";" { Subroutine (lhsToExpr $1) (Args [] []) }
   | LHS CallArgs ";" { Subroutine (lhsToExpr $1) $2 }
@@ -940,7 +935,6 @@ StmtNonBlock :: { Stmt }
   | "->>" Identifier ";"                       { Trigger False $2 }
   | AttributeInstance Stmt                     { StmtAttr $1 $2 }
   | ProceduralAssertionStatement               { Assertion $1 }
-  | IncOrDecOperator LHS ";"                   { AsgnBlk (AsgnOp $1) $2 (Number "1") }
   | "void" "'" "(" Expr CallArgs ")" ";"       { Subroutine $4 $5 }
 
 BlockKWPar :: { BlockKW }
@@ -980,11 +974,11 @@ IdxVarsInside :: { [Maybe Identifier] }
   | opt(Identifier) "," IdxVarsInside { $1 : $3 }
 
 DeclsAndStmts :: { ([Decl], [Stmt]) }
-  : DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $1 $2 }
-  | StmtNonAsgn Stmts        { ([], $1 : $2) }
-  | {- empty -}              { ([], []) }
+  : StmtTrace DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $2 $3 }
+  | StmtTrace StmtNonAsgn Stmts        { ([], $1 : $2 : $3) }
+  | StmtTrace {- empty -}              { ([], []) }
 DeclOrStmt :: { ([Decl], [Stmt]) }
-  : DeclOrStmtTokens(";") { parseDTsAsDeclOrAsgn $1 }
+  : DeclTokens(";")    { parseDTsAsDeclOrStmt $1 }
   | ParameterDecl(";") { ($1, []) }
 
 ModuleParameterDecl(delim) :: { [Decl] }
@@ -1271,12 +1265,40 @@ DimFn :: { DimFn }
   | "$increment"           { FnIncrement          }
   | "$size"                { FnSize               }
 
+MITrace :: { ModuleItem }
+  : PITrace { MIPackageItem $1 }
+PITrace :: { PackageItem }
+  : Trace { Decl $ CommentDecl $1 }
+StmtTrace :: { Stmt }
+  : Trace { CommentStmt $1 }
+Trace :: { String }
+  : position { "Trace: " ++ show $1 }
+position :: { Position }
+  : {- empty -} {% gets fst }
+
 {
 
-parseError :: [Token] -> ExceptT String IO a
+type ParseState = StateT (Position, [Token]) (ExceptT String IO)
+
+posInject :: (Position -> a) -> ParseState a
+posInject cont = do
+  pos <- gets fst
+  return $ cont pos
+
+positionKeep :: (Token -> ParseState a) -> ParseState a
+positionKeep cont = do
+  tokens <- gets snd
+  case tokens of
+    [] -> cont TokenEOF
+    tok : toks -> do
+      put (tokenPosition tok, toks)
+      cont tok
+
+parseError :: Token -> ParseState a
 parseError a = case a of
-  []              -> throwError $ "Parse error: no tokens left to parse."
-  Token t s p : _ -> throwError $ show p ++ ": Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ")."
+  TokenEOF    -> throwError $ "Parse error: no tokens left to parse."
+  Token t s p -> throwError $ show p ++ ": Parse error: unexpected token '"
+                  ++ s ++ "' (" ++ show t ++ ")."
 
 genItemsToGenItem :: [GenItem] -> GenItem
 genItemsToGenItem [x] = x
@@ -1288,6 +1310,7 @@ combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2)
 makeInput :: Decl -> Decl
 makeInput (Variable Local t x a me) = Variable Input t x a me
 makeInput (Variable Input t x a me) = Variable Input t x a me
+makeInput (CommentDecl c) = CommentDecl c
 makeInput other =
   error $ "unexpected non-var or non-input decl: " ++ (show other)
 

src/Language/SystemVerilog/Parser/ParseDecl.hs

 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Advanced parser for declarations and module instantiations.
+ - Advanced parser for declarations, module instantiations, and some statements.
  -
- - This module exists because the SystemVerilog grammar has conflicts which
- - cannot be resolved by an LALR(1) parser. This module provides an interface
- - for parsing an list of "DeclTokens" into `Decl`s and/or `ModuleItem`s. This
- - works through a series of functions which have an greater lookahead for
+ - This module exists because the SystemVerilog grammar is not LALR(1), and
+ - Happy can only produce LALR(1) parsers. This module provides an interface for
+ - parsing a list of "DeclTokens" into `Decl`s, `ModuleItem`s, or `Stmt`s. This
+ - works through a series of functions which have use a greater lookahead for
  - resolving the conflicts.
  -
  - Consider the following two module declarations:
@@ -16,12 +16,19 @@
  - When `{one} two ,` is on the stack, it is impossible to know whether to A)
  - shift `three` to add to the current declaration list; or B) to reduce the
  - stack and begin a new port declaration; without looking ahead more than 1
- - token (even ignoring the fact that a range is itself multiple tokens).
+ - token.
  -
- - While I previous had some success dealing with conflicts in the parser with
+ - While I previously had some success dealing with these conflicts with
  - increasingly convoluted grammars, this became more and more untenable as I
  - added support for more SystemVerilog constructs.
  -
+ - Because declarations and statements are subject to the same kind of
+ - conflicts, this module additionally provides an interface for parsing
+ - DeclTokens as either declarations or the basic statements (either assignments
+ - or task/function calls) with which they can conflict. The initialization
+ - portion of a for loop also allows for declarations and assignments, and so a
+ - similar interface is provided for this case.
+ -
  - This parser is very liberal, and so accepts some syntactically invalid files.
  - In the future, we may add some basic type-checking to complain about
  - malformed input files. However, we generally assume that users have tested
@@ -34,40 +41,41 @@ module Language.SystemVerilog.Parser.ParseDecl
 , parseDTsAsModuleItems
 , parseDTsAsDecls
 , parseDTsAsDecl
-, parseDTsAsDeclOrAsgn
+, parseDTsAsDeclOrStmt
 , parseDTsAsDeclsOrAsgns
 ) where
 
-import Data.List (elemIndex, findIndex, findIndices, partition)
+import Data.List (findIndex, findIndices, partition)
 import Data.Maybe (mapMaybe)
 
 import Language.SystemVerilog.AST
+import Language.SystemVerilog.Parser.Tokens (Position(..))
 
 -- [PUBLIC]: combined (irregular) tokens for declarations
 data DeclToken
-    = DTComma
-    | DTAutoDim
-    | DTAsgn     AsgnOp Expr
-    | DTAsgnNBlk (Maybe Timing) Expr
-    | DTRange    (PartSelectMode, Range)
-    | DTIdent    Identifier
-    | DTPSIdent  Identifier Identifier
-    | DTDir      Direction
-    | DTType     (Signing -> [Range] -> Type)
-    | DTParams   [ParamBinding]
-    | DTInstance [PortBinding]
-    | DTBit      Expr
-    | DTConcat   [LHS]
-    | DTStream   StreamOp Expr [LHS]
-    | DTDot      Identifier
-    | DTSigning  Signing
-    | DTLifetime Lifetime
+    = DTComma    Position
+    | DTAutoDim  Position
+    | DTAsgn     Position AsgnOp Expr
+    | DTAsgnNBlk Position (Maybe Timing) Expr
+    | DTRange    Position (PartSelectMode, Range)
+    | DTIdent    Position Identifier
+    | DTPSIdent  Position Identifier Identifier
+    | DTDir      Position Direction
+    | DTType     Position (Signing -> [Range] -> Type)
+    | DTParams   Position [ParamBinding]
+    | DTInstance Position [PortBinding]
+    | DTBit      Position Expr
+    | DTConcat   Position [LHS]
+    | DTStream   Position StreamOp Expr [LHS]
+    | DTDot      Position Identifier
+    | DTSigning  Position Signing
+    | DTLifetime Position Lifetime
     deriving (Show, Eq)
 
 
--- entrypoints besides `parseDTsAsDeclOrAsgn` use this to disallow `DTAsgnNBlk`
+-- entrypoints besides `parseDTsAsDeclOrStmt` use this to disallow `DTAsgnNBlk`
 -- and `DTAsgn` with a binary assignment operator because we don't expect to see
--- those assignment oeprators in declarations
+-- those assignment operators in declarations
 forbidNonEqAsgn :: [DeclToken] -> a -> a
 forbidNonEqAsgn tokens =
     if any isNonEqAsgn tokens
@@ -75,8 +83,8 @@ forbidNonEqAsgn tokens =
         else id
     where
         isNonEqAsgn :: DeclToken -> Bool
-        isNonEqAsgn (DTAsgnNBlk _ _) = True
-        isNonEqAsgn (DTAsgn (AsgnOp _) _) = True
+        isNonEqAsgn (DTAsgnNBlk _ _ _) = True
+        isNonEqAsgn (DTAsgn _ (AsgnOp _) _) = True
         isNonEqAsgn _ = False
 
 
@@ -100,14 +108,13 @@ parseDTsAsPortDecls pieces =
         simpleIdents = map extractIdent $ filter isIdent pieces
         declarations = parseDTsAsDecls pieces
 
-        isComma :: DeclToken -> Bool
-        isComma token = token == DTComma
-        extractIdent = \(DTIdent x) -> x
+        extractIdent = \(DTIdent _ x) -> x
 
         portNames :: [Decl] -> [Identifier]
         portNames items = mapMaybe portName items
         portName :: Decl -> Maybe Identifier
         portName (Variable _ _ ident _ _) = Just ident
+        portName CommentDecl{} = Nothing
         portName decl =
             error $ "unexpected non-variable port declaration: " ++ (show decl)
 
@@ -125,29 +132,29 @@ parseDTsAsModuleItems tokens =
         map (MIPackageItem . Decl) $ parseDTsAsDecl tokens
     where
         isElabTask :: DeclToken -> Bool
-        isElabTask (DTIdent x) = elem x elabTasks
+        isElabTask (DTIdent _ x) = elem x elabTasks
             where elabTasks = ["$fatal", "$error", "$warning", "$info"]
         isElabTask _ = False
         isInstance :: DeclToken -> Bool
-        isInstance (DTInstance _) = True
+        isInstance (DTInstance{}) = True
         isInstance _ = False
 
 -- internal; approximates the behavior of the elaboration system tasks
 asElabTask :: [DeclToken] -> [ModuleItem]
-asElabTask [DTIdent name, DTInstance args] =
+asElabTask [DTIdent _ name, DTInstance _ args] =
     if name == "$info"
         then [] -- just drop them for simplicity
         else [Instance "ThisModuleDoesNotExist" [] name' Nothing args]
     where name' = "__sv2v_elab_" ++ tail name
-asElabTask [DTIdent name] =
-    asElabTask [DTIdent name, DTInstance []]
+asElabTask [DTIdent pos name] =
+    asElabTask [DTIdent pos name, DTInstance pos []]
 asElabTask tokens =
     error $ "could not parse elaboration system task: " ++ show tokens
 
 
 -- internal; parser for module instantiations
 parseDTsAsIntantiations :: [DeclToken] -> [ModuleItem]
-parseDTsAsIntantiations (DTIdent name : tokens) =
+parseDTsAsIntantiations (DTIdent _ name : tokens) =
     if not (all isInstanceToken rest)
         then error $ "instantiations mixed with other items: " ++ (show rest)
         else step rest
@@ -157,23 +164,23 @@ parseDTsAsIntantiations (DTIdent name : tokens) =
         step toks =
             Instance name params x mr p : follow
             where
-                (inst, toks') = span (DTComma /=) toks
+                (inst, toks') = span (not . isComma) toks
                 (x, mr, p) = case inst of
-                    [DTIdent a, DTRange (NonIndexed, s), DTInstance b] ->
+                    [DTIdent _ a, DTRange _ (NonIndexed, s), DTInstance _ b] ->
                         (a, Just s , b)
-                    [DTIdent a, DTInstance b] -> (a, Nothing, b)
+                    [DTIdent _ a, DTInstance _ b] -> (a, Nothing, b)
                     _ -> error $ "unrecognized instantiation of " ++ name
                             ++ ": " ++ show inst
                 follow = x `seq` if null toks' then [] else step (tail toks')
         (params, rest) =
             case head tokens of
-                DTParams ps -> (ps, tail tokens)
+                DTParams _ ps -> (ps, tail tokens)
                 _             -> ([],      tokens)
         isInstanceToken :: DeclToken -> Bool
-        isInstanceToken (DTInstance _) = True
-        isInstanceToken (DTRange _) = True
-        isInstanceToken (DTIdent _) = True
-        isInstanceToken DTComma = True
+        isInstanceToken (DTInstance{}) = True
+        isInstanceToken (DTRange{}) = True
+        isInstanceToken (DTIdent{}) = True
+        isInstanceToken (DTComma{}) = True
         isInstanceToken _ = False
 parseDTsAsIntantiations tokens =
     error $
@@ -200,19 +207,22 @@ parseDTsAsDecl tokens =
 
 
 -- [PUBLIC]: parser for single block item declarations or assign or arg-less
--- subroutine call statetments
-parseDTsAsDeclOrAsgn :: [DeclToken] -> ([Decl], [Stmt])
-parseDTsAsDeclOrAsgn [DTIdent     f] = ([], [Subroutine (Ident     f) (Args [] [])])
-parseDTsAsDeclOrAsgn [DTPSIdent p f] = ([], [Subroutine (PSIdent p f) (Args [] [])])
-parseDTsAsDeclOrAsgn tokens =
+-- subroutine call statements
+parseDTsAsDeclOrStmt :: [DeclToken] -> ([Decl], [Stmt])
+parseDTsAsDeclOrStmt [DTIdent   pos   f] = ([], [traceStmt pos, Subroutine (Ident     f) (Args [] [])])
+parseDTsAsDeclOrStmt [DTPSIdent pos p f] = ([], [traceStmt pos, Subroutine (PSIdent p f) (Args [] [])])
+parseDTsAsDeclOrStmt (DTAsgn pos (AsgnOp op) e : tok : toks) =
+    parseDTsAsDeclOrStmt $ (tok : toks) ++ [DTAsgn pos (AsgnOp op) e]
+parseDTsAsDeclOrStmt tokens =
     if (isStmt (last tokens) || tripLookahead tokens) && maybeLhs /= Nothing
-        then ([], [stmt])
+        then ([], [traceStmt pos, stmt])
         else (parseDTsAsDecl tokens, [])
     where
+        pos = tokPos $ last tokens
         stmt = case last tokens of
-            DTAsgn     op e -> AsgnBlk op lhs e
-            DTAsgnNBlk mt e -> Asgn    mt lhs e
-            DTInstance args -> Subroutine (lhsToExpr lhs) (instanceToArgs args)
+            DTAsgn     _ op e -> AsgnBlk op lhs e
+            DTAsgnNBlk _ mt e -> Asgn    mt lhs e
+            DTInstance _ args -> Subroutine (lhsToExpr lhs) (instanceToArgs args)
             _ -> error $ "invalid block item decl or stmt: " ++ (show tokens)
         maybeLhs = takeLHS $ init tokens
         Just lhs = maybeLhs
@@ -222,6 +232,9 @@ parseDTsAsDeclOrAsgn tokens =
         isStmt (DTInstance{}) = True
         isStmt _ = False
 
+traceStmt :: Position -> Stmt
+traceStmt pos = CommentStmt $ "Trace: " ++ show pos
+
 -- converts port bindings to call args
 instanceToArgs :: [PortBinding] -> Args
 instanceToArgs bindings =
@@ -242,7 +255,7 @@ parseDTsAsDeclsOrAsgns tokens =
     where
         hasLeadingAsgn =
             -- if there is an asgn token before the next comma
-            case (elemIndex DTComma tokens, findIndex isAsgnToken tokens) of
+            case (findIndex isComma tokens, findIndex isAsgnToken tokens) of
                 (Just a, Just b) -> a > b
                 (Nothing, Just _) -> True
                 _ -> False
@@ -252,27 +265,27 @@ parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)]
 parseDTsAsAsgns tokens =
     case l1 of
         [] -> [asgn]
-        DTComma : remaining -> asgn : parseDTsAsAsgns remaining
+        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
+        DTAsgn _ AsgnOpEq expr : l1 = l0
         asgn = (lhs, expr)
 
         isDTAsgn :: DeclToken -> Bool
-        isDTAsgn (DTAsgn _ _) = True
+        isDTAsgn (DTAsgn{}) = True
         isDTAsgn _ = False
 
 isAsgnToken :: DeclToken -> Bool
-isAsgnToken (DTBit             _) = True
-isAsgnToken (DTConcat          _) = True
-isAsgnToken (DTStream      _ _ _) = True
-isAsgnToken (DTDot             _) = True
-isAsgnToken (DTAsgnNBlk      _ _) = True
-isAsgnToken (DTAsgn (AsgnOp _) _) = True
+isAsgnToken (DTBit             _ _) = True
+isAsgnToken (DTConcat          _ _) = True
+isAsgnToken (DTStream      _ _ _ _) = True
+isAsgnToken (DTDot             _ _) = True
+isAsgnToken (DTAsgnNBlk      _ _ _) = True
+isAsgnToken (DTAsgn _ (AsgnOp _) _) = True
 isAsgnToken _ = False
 
 takeLHS :: [DeclToken] -> Maybe LHS
@@ -281,40 +294,41 @@ takeLHS (t : ts) =
     foldl takeLHSStep (takeLHSStart t) ts
 
 takeLHSStart :: DeclToken -> Maybe LHS
-takeLHSStart (DTConcat     lhss) = Just $ LHSConcat lhss
-takeLHSStart (DTStream o e lhss) = Just $ LHSStream o e lhss
-takeLHSStart (DTIdent  x       ) = Just $ LHSIdent x
+takeLHSStart (DTConcat _     lhss) = Just $ LHSConcat lhss
+takeLHSStart (DTStream _ o e lhss) = Just $ LHSStream o e lhss
+takeLHSStart (DTIdent  _ x       ) = Just $ LHSIdent x
 takeLHSStart _ = Nothing
 
 takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
-takeLHSStep (Just curr) (DTBit    e   ) = Just $ LHSBit   curr e
-takeLHSStep (Just curr) (DTRange (m,r)) = Just $ LHSRange curr m r
-takeLHSStep (Just curr) (DTDot    x   ) = Just $ LHSDot curr x
+takeLHSStep (Just curr) (DTBit   _  e   ) = Just $ LHSBit   curr e
+takeLHSStep (Just curr) (DTRange _ (m,r)) = Just $ LHSRange curr m r
+takeLHSStep (Just curr) (DTDot   _  x   ) = Just $ LHSDot curr x
 takeLHSStep _ _ = Nothing
 
 
--- batches together seperate declaration lists
+-- batches together separate declaration lists
 type Triplet = (Identifier, [Range], Maybe Expr)
 type Component = (Direction, Type, [Triplet])
-finalize :: Component -> [Decl]
-finalize (dir, typ, trips) =
+finalize :: (Position, Component) -> [Decl]
+finalize (pos, (dir, typ, trips)) =
+    CommentDecl ("Trace: " ++ show pos) :
     map (\(x, a, me) -> Variable dir typ x a me) trips
 
 
 -- internal; entrypoint of the critical portion of our parser
-parseDTsAsComponents :: [DeclToken] -> [Component]
+parseDTsAsComponents :: [DeclToken] -> [(Position, Component)]
 parseDTsAsComponents [] = []
 parseDTsAsComponents tokens =
-    component : parseDTsAsComponents tokens'
+    (position, component) : parseDTsAsComponents tokens'
     where
-        (component, tokens') = parseDTsAsComponent tokens
+        (position, component, tokens') = parseDTsAsComponent tokens
 
-parseDTsAsComponent :: [DeclToken] -> (Component, [DeclToken])
+parseDTsAsComponent :: [DeclToken] -> (Position, Component, [DeclToken])
 parseDTsAsComponent [] = error "parseDTsAsComponent unexpected end of tokens"
 parseDTsAsComponent l0 =
     if l /= Nothing && l /= Just Automatic
         then error $ "unexpected non-automatic lifetime: " ++ show l0
-        else (component, l5)
+        else (position, component, l5)
     where
         (dir, l1) = takeDir      l0
         (l  , l2) = takeLifetime l1
@@ -322,7 +336,7 @@ parseDTsAsComponent l0 =
         (rs , l4) = takeRanges   l3
         (tps, l5) = takeTrips    l4 True
         component = (dir, tf rs, tps)
-
+        position = tokPos $ head l0
 
 takeTrips :: [DeclToken] -> Bool -> ([Triplet], [DeclToken])
 takeTrips [] True = error "incomplete declaration"
@@ -358,33 +372,33 @@ tripLookahead l0 =
     -- type name, as type names must be followed by a first identifier before a
     -- comma or the end of the list
     else
-        (not $ null l3) && (head l3 == DTComma)
+        (not $ null l3) && (isComma $ head l3)
     where
         (_   , l1) = takeIdent  l0
         (_   , l2) = takeRanges l1
         (asgn, l3) = takeAsgn   l2
 
 takeDir :: [DeclToken] -> (Direction, [DeclToken])
-takeDir (DTDir dir : rest) = (dir  , rest)
+takeDir (DTDir _ dir : rest) = (dir  , rest)
 takeDir                rest  = (Local, rest)
 
 takeLifetime :: [DeclToken] -> (Maybe Lifetime, [DeclToken])
-takeLifetime (DTLifetime l : rest) = (Just  l, rest)
+takeLifetime (DTLifetime _ l : rest) = (Just  l, rest)
 takeLifetime                   rest  = (Nothing, rest)
 
 takeType :: [DeclToken] -> ([Range] -> Type, [DeclToken])
-takeType (DTIdent a  : DTDot b      : rest) = (InterfaceT a (Just b), rest)
-takeType (DTType  tf : DTSigning sg : rest) = (tf       sg          , rest)
-takeType (DTType  tf                : rest) = (tf       Unspecified , rest)
-takeType (DTSigning sg              : rest) = (Implicit sg          , rest)
-takeType (DTPSIdent ps tn           : rest) = (Alias (Just ps) tn   , rest)
-takeType (DTIdent tn                : rest) =
+takeType (DTIdent _ a  : DTDot _ b      : rest) = (InterfaceT a (Just b), rest)
+takeType (DTType  _ tf : DTSigning _ sg : rest) = (tf       sg          , rest)
+takeType (DTType  _ tf                  : rest) = (tf       Unspecified , rest)
+takeType (DTSigning _ sg                : rest) = (Implicit sg          , rest)
+takeType (DTPSIdent _ ps tn             : rest) = (Alias (Just ps) tn   , rest)
+takeType (DTIdent pos tn                : rest) =
     if couldBeTypename
         then (Alias (Nothing) tn  ,                  rest)
-        else (Implicit Unspecified, DTIdent tn : rest)
+        else (Implicit Unspecified, DTIdent pos tn : rest)
     where
         couldBeTypename =
-            case (findIndex isIdent rest, elemIndex DTComma rest) of
+            case (findIndex isIdent rest, findIndex isComma rest) of
                 -- no identifiers left => no decl asgns
                 (Nothing, _) -> False
                 -- an identifier is left, and no more commas
@@ -397,12 +411,12 @@ takeRanges :: [DeclToken] -> ([Range], [DeclToken])
 takeRanges [] = ([], [])
 takeRanges (token : tokens) =
     case token of
-        DTRange (NonIndexed, r) -> (r         : rs, rest          )
-        DTBit   s               -> (asRange s : rs, rest          )
-        DTAutoDim               ->
+        DTRange _ (NonIndexed, r) -> (r         : rs, rest          )
+        DTBit   _ s               -> (asRange s : rs, rest          )
+        DTAutoDim _               ->
             case rest of
-                (DTAsgn AsgnOpEq (Pattern l) : _) -> autoDim l
-                (DTAsgn AsgnOpEq (Concat  l) : _) -> autoDim l
+                (DTAsgn _ AsgnOpEq (Pattern l) : _) -> autoDim l
+                (DTAsgn _ AsgnOpEq (Concat  l) : _) -> autoDim l
                 _ ->                 ([]            , token : tokens)
         _                         -> ([]            , token : tokens)
     where
@@ -417,24 +431,47 @@ takeRanges (token : tokens) =
                 hi = Number $ show (n - 1)
 
 -- Matching DTAsgnNBlk here allows tripLookahead to work both for standard
--- declarations and in `parseDTsAsDeclOrAsgn`, where we're checking for an
--- assignment assignment statement. The other entry points disallow
--- `DTAsgnNBlk`, so this doesn't liberalize the parser.
+-- declarations and in `parseDTsAsDeclOrStmt`, where we're checking for an
+-- assignment statement. The other entry points disallow `DTAsgnNBlk`, so this
+-- doesn't liberalize the parser.
 takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken])
-takeAsgn (DTAsgn AsgnOpEq e : rest) = (Just e , rest)
-takeAsgn (DTAsgnNBlk    _ e : rest) = (Just e , rest)
+takeAsgn (DTAsgn _ AsgnOpEq e : rest) = (Just e , rest)
+takeAsgn (DTAsgnNBlk    _ _ e : rest) = (Just e , rest)
 takeAsgn                        rest  = (Nothing, rest)
 
 takeComma :: [DeclToken] -> (Bool, [DeclToken])
 takeComma [] = (False, [])
-takeComma (DTComma : rest) = (True, rest)
+takeComma (DTComma{} : rest) = (True, rest)
 takeComma toks = error $ "expected comma or end of decl, got: " ++ show toks
 
 takeIdent :: [DeclToken] -> (Identifier, [DeclToken])
-takeIdent (DTIdent x : rest) = (x, rest)
+takeIdent (DTIdent _ x : rest) = (x, rest)
 takeIdent tokens = error $ "takeIdent didn't find identifier: " ++ show tokens
 
 
 isIdent :: DeclToken -> Bool
-isIdent (DTIdent _) = True
+isIdent (DTIdent{}) = True
 isIdent _ = False
+
+isComma :: DeclToken -> Bool
+isComma (DTComma{}) = True
+isComma _ = False
+
+tokPos :: DeclToken -> Position
+tokPos (DTComma    p) = p
+tokPos (DTAutoDim  p) = p
+tokPos (DTAsgn     p _ _) = p
+tokPos (DTAsgnNBlk p _ _) = p
+tokPos (DTRange    p _) = p
+tokPos (DTIdent    p _) = p
+tokPos (DTPSIdent  p _ _) = p
+tokPos (DTDir      p _) = p
+tokPos (DTType     p _) = p
+tokPos (DTParams   p _) = p
+tokPos (DTInstance p _) = p
+tokPos (DTBit      p _) = p
+tokPos (DTConcat   p _) = p
+tokPos (DTStream   p _ _ _) = p
+tokPos (DTDot      p _) = p
+tokPos (DTSigning  p _) = p
+tokPos (DTLifetime p _) = p

src/Language/SystemVerilog/Parser/Tokens.hs

+{-# LANGUAGE PatternSynonyms #-}
 {- sv2v
  - Author: Tom Hawkins <tomahawkins@gmail.com>
  - Modified by: Zachary Snow <zach@zachjs.com>
@@ -11,6 +12,8 @@ module Language.SystemVerilog.Parser.Tokens
     , Position  (..)
     , tokenString
     , tokenName
+    , tokenPosition
+    , pattern TokenEOF
     ) where
 
 import Text.Printf
@@ -21,6 +24,12 @@ tokenString (Token _ s _) = s
 tokenName :: Token -> TokenName
 tokenName (Token kw _ _) = kw
 
+tokenPosition :: Token -> Position
+tokenPosition (Token _ _ pos) = pos
+
+pattern TokenEOF :: Token
+pattern TokenEOF = Token MacroBoundary "" (Position "" 0 0)
+
 data Position
     = Position String Int Int
     deriving Eq

test/basic/inc.sv

@@ -4,4 +4,18 @@ module top;
         x++;
         $display(x);
     end
+    initial begin
+        ++x;
+        $display(x);
+    end
+    initial begin
+        repeat (0);
+        x++;
+        $display(x);
+    end
+    initial begin
+        repeat (0);
+        ++x;
+        $display(x);
+    end
 endmodule

test/basic/inc.v

 module top;
     integer x = 0;
-    initial begin
+    initial repeat (4) begin
         x = x + 1;
         $display(x);
     end