support for binary blocking assignment operators in statements

src/Convert/AsgnOp.hs

 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -
- - Conversion for binary assignment operators, which only appear in generate for
- - loops. We simply elaborate them in the obvious manner.
+ - 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.
  -}
 
 module Convert.AsgnOp (convert) where
@@ -12,11 +13,24 @@ import Language.SystemVerilog.AST
 
 convert :: AST -> AST
 convert =
-    traverseDescriptions $
-    traverseModuleItems $
-    traverseGenItems convertGenItem
+    traverseDescriptions $ traverseModuleItems $
+    ( traverseStmts    convertStmt
+    . traverseGenItems convertGenItem
+    )
 
 convertGenItem :: GenItem -> GenItem
 convertGenItem (GenFor a b (ident, AsgnOp op, expr) c d) =
     GenFor a b (ident, AsgnOpEq, BinOp op (Ident ident) expr) c d
 convertGenItem other = other
+
+convertStmt :: Stmt -> Stmt
+convertStmt (AsgnBlk (AsgnOp op) lhs expr) =
+    AsgnBlk AsgnOpEq lhs (BinOp op (lhsToExpr lhs) expr)
+convertStmt other = other
+
+lhsToExpr :: LHS -> Expr
+lhsToExpr (LHSIdent   x) = Ident x
+lhsToExpr (LHSBit   l e) = Bit    (lhsToExpr l) e
+lhsToExpr (LHSRange l r) = Range  (lhsToExpr l) r
+lhsToExpr (LHSDot   l x) = Access (lhsToExpr l) x
+lhsToExpr (LHSConcat ls) = Concat $ map lhsToExpr ls

src/Convert/PackedArray.hs

@@ -248,7 +248,7 @@ rewriteModuleItem info =
         rewriteLHS (LHSConcat ls) = LHSConcat $ map rewriteLHS ls
 
         rewriteStmt :: Stmt -> Stmt
-        rewriteStmt (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr
+        rewriteStmt (AsgnBlk op lhs expr) = convertAssignment (AsgnBlk op) lhs expr
         rewriteStmt (Asgn       lhs expr) = convertAssignment Asgn         lhs expr
         rewriteStmt other = other
         convertAssignment :: (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt

src/Convert/Return.hs

@@ -18,6 +18,6 @@ convertFunction (MIPackageItem (Function ml t f decls stmts)) =
     map (traverseNestedStmts convertStmt) stmts
     where
         convertStmt :: Stmt -> Stmt
-        convertStmt (Return e) = AsgnBlk (LHSIdent f) e
+        convertStmt (Return e) = AsgnBlk AsgnOpEq (LHSIdent f) e
         convertStmt other = other
 convertFunction other = other

src/Convert/Traverse.hs

@@ -137,7 +137,7 @@ traverseNestedStmtsM mapper = fullMapper
             let cases' = zip (map fst cases) caseStmts
             def' <- maybeDo fullMapper def
             return $ Case u kw expr cases' def'
-        cs (AsgnBlk lhs expr) = return $ AsgnBlk lhs expr
+        cs (AsgnBlk op lhs expr) = return $ AsgnBlk op lhs expr
         cs (Asgn       lhs expr) = return $ Asgn       lhs expr
         cs (For a b c stmt) = fullMapper stmt >>= return . For a b c
         cs (While   e stmt) = fullMapper stmt >>= return . While   e
@@ -160,7 +160,7 @@ traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
         stmtMapper (Timing (Event sense) stmt) = do
             sense' <- senseMapper sense
             return $ Timing (Event sense') stmt
-        stmtMapper (AsgnBlk lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk lhs' expr
+        stmtMapper (AsgnBlk op lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk op lhs' expr
         stmtMapper (Asgn       lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn       lhs' expr
         stmtMapper other = return other
         senseMapper (Sense        lhs) = fullMapper lhs >>= return . Sense
@@ -258,8 +258,8 @@ traverseExprsM mapper = moduleItemMapper
         e' <- exprMapper e
         cases' <- mapM caseMapper cases
         return $ Case u kw e' cases' def
-    flatStmtMapper (AsgnBlk lhs expr) =
-        exprMapper expr >>= return . AsgnBlk lhs
+    flatStmtMapper (AsgnBlk op lhs expr) =
+        exprMapper expr >>= return . AsgnBlk op lhs
     flatStmtMapper (Asgn       lhs expr) =
         exprMapper expr >>= return . Asgn       lhs
     flatStmtMapper (For (x1, e1) cc (x2, e2) stmt) = do
@@ -463,9 +463,9 @@ traverseAsgnsM mapper = moduleItemMapper
         miMapperA other = return other
 
         miMapperB = traverseStmtsM stmtMapper
-        stmtMapper (AsgnBlk lhs expr) = do
+        stmtMapper (AsgnBlk op lhs expr) = do
             (lhs', expr') <- mapper (lhs, expr)
-            return $ AsgnBlk lhs' expr'
+            return $ AsgnBlk op lhs' expr'
         stmtMapper (Asgn       lhs expr) = do
             (lhs', expr') <- mapper (lhs, expr)
             return $ Asgn       lhs' expr'

src/Language/SystemVerilog/AST.hs

@@ -422,7 +422,7 @@ data Stmt
   = Block   (Maybe Identifier) [Decl] [Stmt]
   | Case    Bool CaseKW Expr [Case] (Maybe Stmt)
   | For     (Identifier, Expr) Expr (Identifier, Expr) Stmt
-  | AsgnBlk LHS Expr
+  | AsgnBlk AsgnOp LHS Expr
   | Asgn    LHS Expr
   | While   Expr Stmt
   | RepeatL Expr Stmt
@@ -453,7 +453,7 @@ instance Show Stmt where
         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 (AsgnBlk v e) = printf "%s = %s;"  (show v) (show e)
+  show (AsgnBlk o v e) = printf "%s %s %s;" (show v) (show o) (show e)
   show (Asgn      v e) = printf "%s <= %s;" (show v) (show e)
   show (While   e s) = printf  "while (%s) %s" (show e) (show s)
   show (RepeatL e s) = printf "repeat (%s) %s" (show e) (show s)

src/Language/SystemVerilog/Parser/Parse.y

@@ -271,8 +271,8 @@ Identifiers :: { [Identifier] }
 DeclTokens(delim) :: { [DeclToken] }
   : DeclToken                  delim  { [$1] }
   | DeclToken       DeclTokens(delim) { [$1] ++ $2 }
-  | "=" Expr "," DeclTokens(delim) { [DTAsgn $2, DTComma] ++ $4 }
-  | "=" Expr                delim  { [DTAsgn $2] }
+  | AsgnOp Expr "," DeclTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 }
+  | AsgnOp Expr                delim  { [DTAsgn $1 $2] }
 DeclToken :: { DeclToken }
   : DeclOrStmtToken     { $1 }
   | ParameterBindings   { DTParams   $1 }
@@ -281,9 +281,9 @@ DeclToken :: { DeclToken }
 DeclOrStmtTokens(delim) :: { [DeclToken] }
   : DeclOrStmtToken                  delim  { [$1] }
   | DeclOrStmtToken DeclOrStmtTokens(delim) { [$1] ++ $2 }
-  | "="  Expr ","   DeclOrStmtTokens(delim) { [DTAsgn     $2, DTComma] ++ $4 }
+  | AsgnOp Expr "," DeclOrStmtTokens(delim) { [DTAsgn $1  $2, DTComma] ++ $4 }
   | "<="   Expr "," DeclOrStmtTokens(delim) { [DTAsgnNBlk $2, DTComma] ++ $4 }
-  | "="  Expr                        delim  { [DTAsgn     $2] }
+  | AsgnOp Expr                      delim  { [DTAsgn $1  $2] }
   | "<="   Expr                      delim  { [DTAsgnNBlk $2] }
 DeclOrStmtToken :: { DeclToken }
   : ","                       { DTComma }
@@ -406,7 +406,7 @@ Stmts :: { [Stmt] }
 
 Stmt :: { Stmt }
   : StmtNonAsgn         { $1 }
-  | LHS "="  Expr ";" { AsgnBlk $1 $3 }
+  | LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
   | LHS "<="   Expr ";" { Asgn       $1 $3 }
   | Identifier      ";" { Subroutine $1 [] }
 StmtNonAsgn :: { Stmt }
@@ -582,11 +582,11 @@ GenCaseDefault :: { GenItem }
   : "default" opt(":") GenItemOrNull { $3 }
 
 GenvarIteration :: { (Identifier, AsgnOp, Expr) }
-  : Identifier AssignmentOperator Expr { ($1, $2, $3) }
+  : Identifier AsgnOp Expr { ($1, $2, $3) }
   | IncOrDecOperator Identifier { ($2, AsgnOp $1, Number "1") }
   | Identifier IncOrDecOperator { ($1, AsgnOp $2, Number "1") }
 
-AssignmentOperator :: { AsgnOp }
+AsgnOp :: { AsgnOp }
   : "="    { AsgnOpEq }
   | "+="   { AsgnOp Add }
   | "-="   { AsgnOp Sub }

src/Language/SystemVerilog/Parser/ParseDecl.hs

@@ -46,7 +46,7 @@ import Language.SystemVerilog.AST
 -- [PUBLIC]: combined (irregular) tokens for declarations
 data DeclToken
     = DTComma
-    | DTAsgn     Expr
+    | DTAsgn     AsgnOp Expr
     | DTAsgnNBlk Expr
     | DTRange    Range
     | DTIdent    Identifier
@@ -150,7 +150,7 @@ parseDTsAsDeclOrAsgn tokens =
         else (parseDTsAsDecl tokens, [])
     where
         (constructor, expr) = case last tokens of
-            DTAsgn     e -> (AsgnBlk, e)
+            DTAsgn  op e -> (AsgnBlk op, e)
             DTAsgnNBlk e -> (Asgn      , e)
             _ -> error $ "invalid block item decl or stmt: " ++ (show tokens)
         Just lhs = foldl takeLHSStep Nothing $ init tokens
@@ -158,6 +158,7 @@ parseDTsAsDeclOrAsgn tokens =
         isAsgnToken (DTBit             _) = True
         isAsgnToken (DTConcat          _) = True
         isAsgnToken (DTAsgnNBlk        _) = True
+        isAsgnToken (DTAsgn (AsgnOp _) _) = True
         isAsgnToken _ = False
 
 takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
@@ -257,7 +258,7 @@ takeRanges (token : tokens) =
 -- to work both for standard declarations and in `parseDTsAsDeclOrAsgn`, where
 -- we're checking for an assignment
 takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken])
-takeAsgn (DTAsgn     e : rest) = (Just e , rest)
+takeAsgn (DTAsgn AsgnOpEq e : rest) = (Just e , rest)
 takeAsgn (DTAsgnNBlk      e : rest) = (Just e , rest)
 takeAsgn                 rest  = (Nothing, rest)