support for more complex for loop components

src/Convert/AsgnOp.hs

 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Conversion for binary assignment operators, which appear in generate for
- - loops and as a special case of blocking assignment statements. We simply
- - elaborate them in the obvious manner.
+ - Conversion for binary assignment operators, which appear in standard and
+ - generate for loops and as a special case of blocking assignment statements.
+ - We simply elaborate them in the obvious manner.
  -}
 
 module Convert.AsgnOp (convert) where
@@ -24,6 +24,14 @@ convertGenItem (GenFor a b (ident, AsgnOp op, expr) c d) =
 convertGenItem other = other
 
 convertStmt :: Stmt -> Stmt
+convertStmt (For inits cc asgns stmt) =
+    For inits cc asgns' stmt
+    where
+        asgns' = map convertAsgn asgns
+        convertAsgn :: (LHS, AsgnOp, Expr) -> (LHS, AsgnOp, Expr)
+        convertAsgn (lhs, AsgnOp op, expr) =
+            (lhs, AsgnOpEq, BinOp op (lhsToExpr lhs) expr)
+        convertAsgn other = other
 convertStmt (AsgnBlk (AsgnOp op) lhs expr) =
     AsgnBlk AsgnOpEq lhs (BinOp op (lhsToExpr lhs) expr)
 convertStmt other = other

src/Convert/PackedArray.hs

@@ -268,8 +268,8 @@ rewriteModuleItem info =
                 assign = constructor
                     (LHSBit (LHSIdent $ prefix ident) (Ident index))
                     (Concat exprs)
-                inir = (index, b)
-                chkr = BinOp Le (Ident index) a
-                incr = (index, BinOp Add (Ident index) (Number "1"))
+                inir = [Right (LHSIdent index, b)]
+                chkr = Just $ BinOp Le (Ident index) a
+                incr = [(LHSIdent index, AsgnOp Add, Number "1")]
         convertAssignment constructor lhs expr =
             constructor (rewriteLHS lhs) expr

src/Convert/Traverse.hs

@@ -282,11 +282,11 @@ traverseExprsM mapper = moduleItemMapper
         exprMapper expr >>= return . AsgnBlk op lhs
     flatStmtMapper (Asgn    mt lhs expr) =
         exprMapper expr >>= return . Asgn    mt lhs
-    flatStmtMapper (For (x1, e1) cc (x2, e2) stmt) = do
-        e1' <- exprMapper e1
-        e2' <- exprMapper e2
-        cc' <- exprMapper cc
-        return $ For (x1, e1') cc' (x2, e2') stmt
+    flatStmtMapper (For inits cc asgns stmt) = do
+        inits' <- mapM initMapper inits
+        cc' <- maybeExprMapper cc
+        asgns' <- mapM asgnMapper asgns
+        return $ For inits' cc' asgns' stmt
     flatStmtMapper (While   e stmt) =
         exprMapper e >>= \e' -> return $ While   e' stmt
     flatStmtMapper (RepeatL e stmt) =
@@ -304,6 +304,11 @@ traverseExprsM mapper = moduleItemMapper
     flatStmtMapper (Trigger x) = return $ Trigger x
     flatStmtMapper (Null) = return Null
 
+    initMapper (Left decl) = declMapper decl >>= return . Left
+    initMapper (Right (l, e)) = exprMapper e >>= \e' -> return $ Right (l, e')
+
+    asgnMapper (l, op, e) = exprMapper e >>= \e' -> return $ (l, op, e')
+
     portBindingMapper (p, me) =
         maybeExprMapper me >>= \me' -> return (p, me')
 

src/Language/SystemVerilog/AST/Stmt.hs

@@ -27,7 +27,7 @@ data Stmt
     = StmtAttr Attr Stmt
     | Block   (Maybe Identifier) [Decl] [Stmt]
     | Case    Bool CaseKW Expr [Case] (Maybe Stmt)
-    | For     (Identifier, Expr) Expr (Identifier, Expr) Stmt
+    | For     [Either Decl (LHS, Expr)] (Maybe Expr) [(LHS, AsgnOp, Expr)] Stmt
     | AsgnBlk AsgnOp LHS Expr
     | Asgn    (Maybe Timing) LHS Expr
     | While   Expr Stmt
@@ -58,8 +58,18 @@ instance Show Stmt where
             defStr = case def of
                 Nothing -> ""
                 Just c -> printf "\n\tdefault: %s" (show c)
-    show (For (a,b) c (d,e) f) =
-        printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) (indent $ show f)
+    show (For inits mc assigns stmt) =
+        printf "for (%s; %s; %s)\n%s"
+            (commas $ map showInit inits)
+            (maybe "" show mc)
+            (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)
+            showAssign :: (LHS, AsgnOp, Expr) -> String
+            showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e)
     show (Subroutine x a) = printf "%s(%s);" x (commas $ map (maybe "" show) a)
     show (AsgnBlk o v e) = printf "%s %s %s;" (show v) (show o) (show e)
     show (Asgn    t v e) = printf "%s <= %s%s;" (show v) (maybe "" showPad t) (show e)

src/Language/SystemVerilog/Parser/Parse.y

@@ -548,7 +548,7 @@ StmtNonAsgn :: { Stmt }
   | "begin" opt(Tag) DeclsAndStmts "end" opt(Tag) { Block (combineTags $2 $5) (fst $3) (snd $3) }
   | "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 }
+  | "for" "(" DeclTokens(";") opt(Expr) ";" ForStep ")" Stmt { For (parseDTsAsDeclsAndAsgns $3) $4 $6 $8 }
   | Unique CaseKW "(" Expr ")" Cases opt(CaseDefault) "endcase" { Case $1 $2 $4 $6 $7 }
   | TimingControl Stmt                         { Timing $1 $2 }
   | "return" Expr ";"                          { Return $2 }
@@ -560,6 +560,17 @@ StmtNonAsgn :: { Stmt }
   | "->" Identifier ";"                        { Trigger $2 }
   | AttributeInstance Stmt                     { StmtAttr $1 $2 }
 
+ForStep :: { [(LHS, AsgnOp, Expr)] }
+  : {- empty -}     { [] }
+  | ForStepNonEmpty { $1 }
+ForStepNonEmpty :: { [(LHS, AsgnOp, Expr)] }
+  : ForStepAssignment                     { [$1] }
+  | ForStepNonEmpty "," ForStepAssignment { $1 ++ [$3] }
+ForStepAssignment :: { (LHS, AsgnOp, Expr) }
+  : LHS AsgnOp Expr { ($1, $2, $3) }
+  | IncOrDecOperator LHS { ($2, AsgnOp $1, Number "1") }
+  | LHS IncOrDecOperator { ($1, AsgnOp $2, Number "1") }
+
 DeclsAndStmts :: { ([Decl], [Stmt]) }
   : DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $1 $2 }
   | StmtNonAsgn Stmts        { ([], $1 : $2) }

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -36,10 +36,11 @@ module Language.SystemVerilog.Parser.ParseDecl
 , parseDTsAsDecls
 , parseDTsAsDecl
 , parseDTsAsDeclOrAsgn
+, parseDTsAsDeclsAndAsgns
 ) where
 
-import Data.List (findIndices)
-import Data.Maybe (mapMaybe)
+import Data.List (elemIndex, findIndex, findIndices)
+import Data.Maybe (fromJust, mapMaybe)
 
 import Language.SystemVerilog.AST
 
@@ -187,13 +188,41 @@ parseDTsAsDeclOrAsgn tokens =
             DTAsgn     op e -> (AsgnBlk op, e)
             DTAsgnNBlk mt e -> (Asgn    mt, e)
             _ -> 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 (DTAsgnNBlk      _ _) = True
-        isAsgnToken (DTAsgn (AsgnOp _) _) = True
-        isAsgnToken _ = False
+        lhs = takeLHS $ init tokens
+
+-- [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 =
+    if hasLeadingAsgn
+        then
+            let (lhsToks, l0) = break isAsgnToken tokens
+                lhs = takeLHS lhsToks
+                DTAsgnNBlk Nothing expr : l1 = l0
+                DTComma : remaining = l1
+            in Right (lhs, expr) : parseDTsAsDeclsAndAsgns remaining
+        else
+            let (component, remaining) = parseDTsAsComponent tokens
+                decls = finalize component
+            in (map Left decls) ++ parseDTsAsDeclsAndAsgns remaining
+    where
+        hasLeadingAsgn =
+            -- if there is an asgn token before the next comma
+            case (elemIndex DTComma tokens, findIndex isAsgnToken tokens) of
+                (Just a, Just b) -> a > b
+                (Nothing, Just _) -> True
+                _ -> False
+
+isAsgnToken :: DeclToken -> Bool
+isAsgnToken (DTBit             _) = True
+isAsgnToken (DTConcat          _) = True
+isAsgnToken (DTAsgnNBlk      _ _) = True
+isAsgnToken (DTAsgn (AsgnOp _) _) = True
+isAsgnToken _ = False
+
+takeLHS :: [DeclToken] -> LHS
+takeLHS tokens = fromJust $ foldl takeLHSStep Nothing tokens
 
 takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
 takeLHSStep (Nothing  ) (DTConcat lhss) = Just $ LHSConcat lhss
@@ -216,8 +245,15 @@ finalize (dir, typ, trips) =
 -- internal; entrypoint of the critical portion of our parser
 parseDTsAsComponents :: [DeclToken] -> [Component]
 parseDTsAsComponents [] = []
-parseDTsAsComponents l0 =
-    component : parseDTsAsComponents l4
+parseDTsAsComponents tokens =
+    component : parseDTsAsComponents tokens'
+    where
+        (component, tokens') = parseDTsAsComponent tokens
+
+parseDTsAsComponent :: [DeclToken] -> (Component, [DeclToken])
+parseDTsAsComponent [] = error "parseDTsAsComponent unexpected end of tokens"
+parseDTsAsComponent l0 =
+    (component, l4)
     where
         (dir, l1) = takeDir    l0
         (tf , l2) = takeType   l1