improved handling of procedural for loops

- convert loops with no or many incrementations
- restrict AST node to only contain traditional initializations
- parser elaborates for loop decls into a synthetic block
- decl list codegen is now specific to parameter decl lists
- update jump conversion special cases for new representation
- first experiments with bimapM

src/Convert.hs

@@ -18,7 +18,7 @@ import qualified Convert.DimensionQuery
 import qualified Convert.DuplicateGenvar
 import qualified Convert.EmptyArgs
 import qualified Convert.Enum
-import qualified Convert.ForDecl
+import qualified Convert.ForAsgn
 import qualified Convert.Foreach
 import qualified Convert.FuncRet
 import qualified Convert.FuncRoutine
@@ -89,7 +89,7 @@ mainPhases selectExclude =
     , Convert.Unsigned.convert
     , Convert.Wildcard.convert
     , Convert.Enum.convert
-    , Convert.ForDecl.convert
+    , Convert.ForAsgn.convert
     , Convert.StringParam.convert
     , selectExclude Job.Interface Convert.Interface.convert
     , selectExclude Job.Succinct Convert.RemoveComments.convert

src/Convert/ForAsgn.hs

+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ -
+ - Verilog-2005 requires that for loops have have one initialization and one
+ - incrementation. If there are excess initializations, they are turned into
+ - preceding statements. If there is no loop variable, a dummy loop variable is
+ - created. If there are multiple incrementations, they are all safely combined
+ - into a single concatenation. If there is no incrementation, a no-op
+ - assignment is added.
+ -}
+
+module Convert.ForAsgn (convert) where
+
+import Convert.Traverse
+import Language.SystemVerilog.AST
+
+convert :: [AST] -> [AST]
+convert =
+    map $ traverseDescriptions $ traverseModuleItems $
+    traverseStmts convertStmt
+
+convertStmt :: Stmt -> Stmt
+
+-- for loop with multiple incrementations
+convertStmt (For inits cond incrs@(_ : _ : _) stmt) =
+    convertStmt $ For inits cond incrs' stmt
+    where
+        incrs' = [(LHSConcat lhss, AsgnOpEq, Concat exprs)]
+        lhss = map (\(lhs, _, _) -> lhs) incrs
+        exprs = map toRHS incrs
+        toRHS :: (LHS, AsgnOp, Expr) -> Expr
+        toRHS (lhs, AsgnOpEq, expr) =
+            Cast (Left $ TypeOf $ lhsToExpr lhs) expr
+        toRHS (lhs, asgnop, expr) =
+            toRHS (lhs, AsgnOpEq, BinOp binop (lhsToExpr lhs) expr)
+            where AsgnOp binop = asgnop
+
+-- for loop with no initializations
+convertStmt (For [] cond incrs stmt) =
+    Block Seq "" [dummyDecl Nil] $ pure $
+    For [(LHSIdent dummyIdent, RawNum 0)] cond incrs stmt
+
+-- for loop with no incrementations
+convertStmt (For inits cond [] stmt) =
+    convertStmt $ For inits cond incrs stmt
+    where
+        (lhs, _) : _ = inits
+        incrs = [(lhs, AsgnOpEq, lhsToExpr lhs)]
+
+-- for loop with multiple initializations
+convertStmt (For inits@(_ : _ : _) cond incrs@[_] stmt) =
+    Block Seq "" [] $
+        (map asgnStmt $ init inits) ++
+        [For [last inits] cond incrs stmt]
+
+convertStmt other = other
+
+asgnStmt :: (LHS, Expr) -> Stmt
+asgnStmt = uncurry $ Asgn AsgnOpEq Nothing
+
+dummyIdent :: Identifier
+dummyIdent = "_sv2v_dummy"
+
+dummyDecl :: Expr -> Decl
+dummyDecl = Variable Local (IntegerAtom TInteger Unspecified) dummyIdent []

src/Convert/ForDecl.hs

-{- sv2v
- - Author: Zachary Snow <zach@zachjs.com>
- -
- - Verilog-2005 requires that for loops have have exactly one assignment in the
- - initialization section. For procedural for loops, we pull the declarations
- - out to a wrapping block, and convert all but one assignment to a preceding
- - statement. If a for loop has no assignments or declarations, a dummy
- - declaration is generated.
- -}
-
-module Convert.ForDecl (convert) where
-
-import Convert.Traverse
-import Language.SystemVerilog.AST
-
-convert :: [AST] -> [AST]
-convert =
-    map $ traverseDescriptions $ traverseModuleItems $
-    traverseStmts convertStmt
-
-convertStmt :: Stmt -> Stmt
-convertStmt (For (Right []) cc asgns stmt) =
-    convertStmt $ For inits cc asgns stmt
-    where inits = Left [dummyDecl $ RawNum 0]
-convertStmt (orig @ (For (Right [_]) _ _ _)) = orig
-
-convertStmt (For (Left inits) cc asgns stmt) =
-    Block Seq "" decls $
-        initAsgns ++
-        [For (Right [(lhs, expr)]) cc asgns stmt]
-    where
-        splitDecls = map splitDecl $ filter (not . isComment) inits
-        decls = map fst splitDecls
-        initAsgns = map asgnStmt $ init $ map snd splitDecls
-        (lhs, expr) = snd $ last splitDecls
-
-convertStmt (For (Right origPairs) cc asgns stmt) =
-    Block Seq "" [] $
-        initAsgns ++
-        [For (Right [(lhs, expr)]) cc asgns stmt]
-    where
-        (lhs, expr) = last origPairs
-        initAsgns = map asgnStmt $ init origPairs
-
-convertStmt other = other
-
-splitDecl :: Decl -> (Decl, (LHS, Expr))
-splitDecl decl =
-    (Variable d t ident a Nil, (LHSIdent ident, e))
-    where Variable d t ident a e = decl
-
-isComment :: Decl -> Bool
-isComment CommentDecl{} = True
-isComment _ = False
-
-asgnStmt :: (LHS, Expr) -> Stmt
-asgnStmt = uncurry $ Asgn AsgnOpEq Nothing
-
-dummyDecl :: Expr -> Decl
-dummyDecl = Variable Local (IntegerAtom TInteger Unspecified) "_sv2v_dummy" []

src/Convert/Foreach.hs

@@ -25,11 +25,12 @@ convertStmt (Foreach x idxs stmt) =
         toLoop :: (Integer, Identifier) -> (Stmt -> Stmt)
         toLoop (_, "") = id
         toLoop (d, i) =
-            For (Left [idxDecl]) cmp [incr]
+            Block Seq "" [idxDecl] . pure .
+                For [(LHSIdent i, queryFn FnLeft)] cmp [incr]
             where
                 queryFn f = DimFn f (Right $ Ident x) (RawNum d)
-                idxDecl = Variable Local (IntegerAtom TInteger Unspecified) i []
-                    (queryFn FnLeft)
+                idxType = IntegerAtom TInteger Unspecified
+                idxDecl = Variable Local idxType i [] Nil
                 cmp =
                     Mux (BinOp Eq (queryFn FnIncrement) (RawNum 1))
                         (BinOp Ge (Ident i) (queryFn FnRight))

src/Convert/Jump.hs

@@ -118,19 +118,14 @@ convertStmts stmts = do
     return stmts'
 
 
-pattern SimpleLoopInits :: String -> Type -> Identifier -> Expr
-    -> Either [Decl] [(LHS, Expr)]
-pattern SimpleLoopInits msg typ var expr =
-    Left [CommentDecl msg, Variable Local typ var [] expr]
+pattern SimpleLoopInits :: Identifier -> [(LHS, Expr)]
+pattern SimpleLoopInits var <- [(LHSIdent var, _)]
 
-pattern SimpleLoopInitsAlt :: String -> Expr -> Either [Decl] [(LHS, Expr)]
-pattern SimpleLoopInitsAlt var expr = Right [(LHSIdent var, expr)]
+pattern SimpleLoopGuard :: Identifier -> Expr
+pattern SimpleLoopGuard var <- BinOp _ (Ident var) _
 
-pattern SimpleLoopGuard :: BinOp -> Identifier -> Expr -> Expr
-pattern SimpleLoopGuard cmp var bound = BinOp cmp (Ident var) bound
-
-pattern SimpleLoopIncrs :: Identifier -> AsgnOp -> Expr -> [(LHS, AsgnOp, Expr)]
-pattern SimpleLoopIncrs var op step = [(LHSIdent var, op, step)]
+pattern SimpleLoopIncrs :: Identifier -> [(LHS, AsgnOp, Expr)]
+pattern SimpleLoopIncrs var <- [(LHSIdent var, _, _)]
 
 -- rewrites the given statement, and returns the type of any unfinished jump
 convertStmt :: Stmt -> State Info Stmt
@@ -143,6 +138,23 @@ convertStmt (Block Par x decls stmts) = do
     modify $ \s -> s { sJumpAllowed = jumpAllowed }
     return $ Block Par x decls stmts'
 
+convertStmt (Block Seq ""
+    decls@[CommentDecl{}, Variable Local _ var0 [] Nil]
+    [ comment@CommentStmt{}
+    , For
+        inits@(SimpleLoopInits var1)
+        comp@(SimpleLoopGuard var2)
+        incr@(SimpleLoopIncrs var3)
+        stmt
+    ]) =
+    convertLoop localInfo loop comp incr stmt
+        >>= return . Block Seq "" decls . (comment :) . pure
+    where
+        loop c i s = For inits c i s
+        localInfo = if var0 /= var1 || var1 /= var2 || var2 /= var3
+                        then Nothing
+                        else Just ""
+
 convertStmt (Block Seq x decls stmts) =
     step stmts >>= return . Block Seq x decls
     where
@@ -181,19 +193,9 @@ convertStmt (Case unique kw expr cases) = do
     return $ Case unique kw expr cases'
 
 convertStmt (For
-    (inits @ (SimpleLoopInits _ _ var1 _))
-    (comp @ (SimpleLoopGuard _ var2 _))
-    (incr @ (SimpleLoopIncrs var3 _ _)) stmt) =
-    convertLoop localInfo loop comp incr stmt
-    where
-        loop c i s = For inits c i s
-        localInfo = if var1 /= var2 || var2 /= var3
-                        then Nothing
-                        else Just ""
-convertStmt (For
-    (inits @ (SimpleLoopInitsAlt var1 _))
-    (comp @ (SimpleLoopGuard _ var2 _))
-    (incr @ (SimpleLoopIncrs var3 _ _)) stmt) =
+    inits@(SimpleLoopInits var1)
+    comp@(SimpleLoopGuard var2)
+    incr@(SimpleLoopIncrs var3) stmt) =
     convertLoop localInfo loop comp incr stmt
     where
         loop c i s = For inits c i s

src/Convert/RemoveComments.hs

@@ -48,9 +48,6 @@ convertStmt (Block kw name decls stmts) =
     where
         decls' = convertDecls decls
         stmts' = filter (/= Null) stmts
-convertStmt (For (Left decls) cond incr stmt) =
-    For (Left decls') cond incr stmt
-    where decls' = convertDecls decls
 convertStmt other = other
 
 convertDecls :: [Decl] -> [Decl]

src/Convert/Stream.hs

@@ -137,7 +137,7 @@ streamerBlock chunk inSize outSize asgn output input =
         out = name ++ "_out"
         idx = name ++ "_idx"
         -- main chunk loop
-        inits = Right [(LHSIdent idx, lo)]
+        inits = [(LHSIdent idx, lo)]
         cmp = BinOp Le (Ident idx) (BinOp Sub inSize chunk)
         incr = [(LHSIdent idx, AsgnOp Add, chunk)]
         lhs = LHSRange (LHSIdent out) IndexedMinus (BinOp Sub hi (Ident idx), chunk)

src/Convert/Traverse.hs

@@ -110,6 +110,7 @@ module Convert.Traverse
 , collectNetAsVarM
 ) where
 
+import Data.Bitraversable (bimapM)
 import Data.Functor.Identity (Identity, runIdentity)
 import Control.Monad.Writer.Strict
 import Language.SystemVerilog.AST
@@ -373,17 +374,11 @@ traverseStmtLHSsM mapper = stmtMapper
         stmtMapper (Asgn op mt lhs expr) =
             fullMapper lhs >>= \lhs' -> return $ Asgn op mt lhs' expr
         stmtMapper (For inits me incrs stmt) = do
-            inits' <- mapInits inits
+            inits' <- mapM (bimapM fullMapper return) inits
             let (lhss, asgnOps, exprs) = unzip3 incrs
             lhss' <- mapM fullMapper lhss
             let incrs' = zip3 lhss' asgnOps exprs
             return $ For inits' me incrs' stmt
-            where
-                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
@@ -682,7 +677,7 @@ traverseStmtExprsM exprMapper = flatStmtMapper
         expr' <- exprMapper expr
         return $ Asgn op mt lhs' expr'
     flatStmtMapper (For inits cc asgns stmt) = do
-        inits' <- initsMapper inits
+        inits' <- mapM (bimapM return exprMapper) inits
         cc' <- exprMapper cc
         asgns' <- mapM asgnMapper asgns
         return $ For inits' cc' asgns' stmt
@@ -715,10 +710,6 @@ traverseStmtExprsM exprMapper = flatStmtMapper
     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
-        where mapper (l, e) = exprMapper e >>= return . (,) l
-
     asgnMapper (l, op, e) = exprMapper e >>= \e' -> return $ (l, op, e')
 
 traverseStmtExprs :: Mapper Expr -> Mapper Stmt

src/Language/SystemVerilog/AST/Decl.hs

@@ -10,10 +10,8 @@ module Language.SystemVerilog.AST.Decl
     ( Decl       (..)
     , Direction  (..)
     , ParamScope (..)
-    , showDecls
     ) where
 
-import Data.List (intercalate)
 import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp (showPad, showPadBefore, unlines')
@@ -44,20 +42,6 @@ instance Show Decl where
             then "// " ++ show c
             else "// " ++ c
 
-showDecls :: Char -> String -> [Decl] -> String
-showDecls delim whitespace =
-    dropDelim . intercalate whitespace . map showDecl
-    where
-        dropDelim :: String -> String
-        dropDelim [] = []
-        dropDelim [x] = if x == delim then [] else [x]
-        dropDelim (x : xs) = x : dropDelim xs
-        showDecl (CommentDecl c) =
-            if whitespace == " "
-                then "/* " ++ c ++ " */"
-                else show $ CommentDecl c
-        showDecl decl = (init $ show decl) ++ [delim]
-
 data Direction
     = Input
     | Output

src/Language/SystemVerilog/AST/Description.hs

@@ -14,12 +14,13 @@ module Language.SystemVerilog.AST.Description
     , ClassItem
     ) where
 
+import Data.List (intercalate)
 import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp
 
 import Language.SystemVerilog.AST.Attr (Attr)
-import Language.SystemVerilog.AST.Decl (Decl, showDecls)
+import Language.SystemVerilog.AST.Decl (Decl(CommentDecl))
 import Language.SystemVerilog.AST.Stmt (Stmt)
 import Language.SystemVerilog.AST.Type (Type, Identifier)
 import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)
@@ -61,8 +62,18 @@ instance Show Description where
 
 showParamDecls :: [Decl] -> String
 showParamDecls [] = ""
-showParamDecls decls = " #(\n\t" ++ str ++ "\n)"
-    where str = showDecls ',' "\n\t" decls
+showParamDecls decls = " #(\n\t" ++ showDecls decls ++ "\n)"
+
+showDecls :: [Decl] -> String
+showDecls =
+    dropDelim . intercalate "\n\t" . map showDecl
+    where
+        dropDelim :: String -> String
+        dropDelim [] = []
+        dropDelim [x] = if x == ',' then [] else [x]
+        dropDelim (x : xs) = x : dropDelim xs
+        showDecl comment@CommentDecl{} = show comment
+        showDecl decl = (init $ show decl) ++ ","
 
 data PackageItem
     = Function Lifetime Type Identifier [Decl] [Stmt]

src/Language/SystemVerilog/AST/Stmt.hs

@@ -27,7 +27,7 @@ import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp (commas, indent, unlines', showPad, showBlock)
 import Language.SystemVerilog.AST.Attr (Attr)
-import Language.SystemVerilog.AST.Decl (Decl, showDecls)
+import Language.SystemVerilog.AST.Decl (Decl)
 import Language.SystemVerilog.AST.Expr (Expr(Nil), Args(..))
 import Language.SystemVerilog.AST.LHS (LHS)
 import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq))
@@ -37,7 +37,7 @@ data Stmt
     = StmtAttr Attr Stmt
     | Block   BlockKW Identifier [Decl] [Stmt]
     | Case    ViolationCheck CaseKW Expr [Case]
-    | For     (Either [Decl] [(LHS, Expr)]) Expr [(LHS, AsgnOp, Expr)] Stmt
+    | For     [(LHS, Expr)] Expr [(LHS, AsgnOp, Expr)] Stmt
     | Asgn    AsgnOp (Maybe Timing) LHS Expr
     | While   Expr Stmt
     | RepeatL Expr Stmt
@@ -77,9 +77,8 @@ instance Show Stmt where
             (commas $ map showAssign assigns)
             (indent $ show stmt)
         where
-            showInits :: Either [Decl] [(LHS, Expr)] -> String
-            showInits (Left decls) = showDecls ',' " " decls
-            showInits (Right asgns) = commas $ map showInit asgns
+            showInits :: [(LHS, Expr)] -> String
+            showInits = commas . map showInit
                 where showInit (l, e) = showAssign (l, AsgnOpEq, e)
             showAssign :: (LHS, AsgnOp, Expr) -> String
             showAssign (l, op, e) = (showPad l) ++ (showPad op) ++ (show e)

src/Language/SystemVerilog/Parser/Parse.y

@@ -18,7 +18,7 @@ module Language.SystemVerilog.Parser.Parse (parse) where
 
 import Control.Monad.Except
 import Control.Monad.State.Strict
-import Data.Maybe (fromMaybe)
+import Data.Maybe (catMaybes, fromMaybe)
 import Language.SystemVerilog.AST
 import Language.SystemVerilog.Parser.ParseDecl
 import Language.SystemVerilog.Parser.Tokens
@@ -1060,7 +1060,7 @@ StmtNonBlock :: { Stmt }
   : ";" { Null }
   | Unique "if" "(" Expr ")" Stmt "else" Stmt  { If $1 $4 $6 $8   }
   | Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null }
-  | "for" "(" ForInit ForCond ForStep ")" Stmt { For $3 $4 $5 $7 }
+  | "for" "(" ForInit ForCond ForStep ")" Stmt { makeFor $3 $4 $5 $7 }
   | CaseStmt                                   { $1 }
   | TimingControl Stmt                         { Timing $1 $2 }
   | "return" ExprOrNil ";"                     { Return $2 }
@@ -1654,4 +1654,21 @@ addCITrace :: ClassItem -> [ClassItem] -> [ClassItem]
 addCITrace _ items @ ((_, Decl CommentDecl{}) : _) = items
 addCITrace trace items = trace : items
 
+makeFor :: Either [Decl] [(LHS, Expr)] -> Expr -> [(LHS, AsgnOp, Expr)] -> Stmt -> Stmt
+makeFor (Left inits) cond incr stmt =
+  Block Seq "" decls
+    [ CommentStmt msg
+    , For (catMaybes maybeAsgns) cond incr stmt
+    ]
+  where
+    (decls, maybeAsgns) = unzip $ map splitInit inits
+    CommentDecl msg : _ = inits
+makeFor (Right asgns) cond incr stmt = For asgns cond incr stmt
+
+splitInit :: Decl -> (Decl, Maybe (LHS, Expr))
+splitInit decl@CommentDecl{} = (decl, Nothing)
+splitInit decl =
+  (Variable d t ident a Nil, Just (LHSIdent ident, e))
+  where Variable d t ident a e = decl
+
 }

sv2v.cabal

@@ -68,7 +68,7 @@ executable sv2v
     Convert.EmptyArgs
     Convert.Enum
     Convert.ExprUtils
-    Convert.ForDecl
+    Convert.ForAsgn
     Convert.Foreach
     Convert.FuncRet
     Convert.FuncRoutine

test/core/for_incrs.sv

+module top;
+    initial
+        for (integer x = 0, y = x + 10, z = y * 10 + 1; x < y; x += 1, y -= 2, z >>= 1)
+            $display("x = %0d, y = %0d, z = %0d", x, y, z);
+    initial
+        for (integer x = 0; x < 3; ) begin
+            $display("x = %0d", x);
+            ++x;
+        end
+endmodule

test/core/for_incrs.v

+module top;
+    initial begin : blk1
+        integer x, y, z;
+        y = 10;
+        z = 101;
+        for (x = 0; x < y; {x, y, z} = {x + 32'd1, y - 32'd2, z >> 1})
+            $display("x = %0d, y = %0d, z = %0d", x, y, z);
+    end
+    initial begin : blk2
+        integer x;
+        for (x = 0; x < 3; x = x + 1)
+            $display("x = %0d", x);
+    end
+endmodule