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,8 +248,8 @@ rewriteModuleItem info =
         rewriteLHS (LHSConcat ls) = LHSConcat $ map rewriteLHS ls
 
         rewriteStmt :: Stmt -> Stmt
-        rewriteStmt (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr
-        rewriteStmt (Asgn    lhs expr) = convertAssignment Asgn    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
         convertAssignment constructor (lhs @ (LHSIdent ident)) (expr @ (Repeat _ exprs)) =

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,8 +137,8 @@ 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 (Asgn    lhs expr) = return $ Asgn    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
         cs (RepeatL e stmt) = fullMapper stmt >>= return . RepeatL e
@@ -160,8 +160,8 @@ 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 (Asgn    lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn    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
         senseMapper (SensePosedge lhs) = fullMapper lhs >>= return . SensePosedge
@@ -258,10 +258,10 @@ 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 (Asgn    lhs expr) =
-        exprMapper expr >>= return . Asgn    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
         e1' <- exprMapper e1
         e2' <- exprMapper e2
@@ -463,12 +463,12 @@ 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'
-        stmtMapper (Asgn    lhs expr) = do
+            return $ AsgnBlk op lhs' expr'
+        stmtMapper (Asgn       lhs expr) = do
             (lhs', expr') <- mapper (lhs, expr)
-            return $ Asgn    lhs' expr'
+            return $ Asgn       lhs' expr'
         stmtMapper other = return other
 
 traverseAsgns :: Mapper (LHS, Expr) -> Mapper ModuleItem

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,8 +453,8 @@ 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 (Asgn    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)
   show (DoWhile e s) = printf "do %s while (%s);" (show s) (show e)

src/Language/SystemVerilog/Parser/Parse.y

@@ -269,10 +269,10 @@ Identifiers :: { [Identifier] }
 
 -- uses delimiter propagation hack to avoid conflicts
 DeclTokens(delim) :: { [DeclToken] }
-  : DeclToken               delim  { [$1] }
-  | DeclToken    DeclTokens(delim) { [$1] ++ $2 }
-  | "=" Expr "," DeclTokens(delim) { [DTAsgn $2, DTComma] ++ $4 }
-  | "=" Expr                delim  { [DTAsgn $2] }
+  : DeclToken                  delim  { [$1] }
+  | DeclToken       DeclTokens(delim) { [$1] ++ $2 }
+  | AsgnOp Expr "," DeclTokens(delim) { [DTAsgn $1 $2, DTComma] ++ $4 }
+  | AsgnOp Expr                delim  { [DTAsgn $1 $2] }
 DeclToken :: { DeclToken }
   : DeclOrStmtToken     { $1 }
   | ParameterBindings   { DTParams   $1 }
@@ -281,10 +281,10 @@ DeclToken :: { DeclToken }
 DeclOrStmtTokens(delim) :: { [DeclToken] }
   : DeclOrStmtToken                  delim  { [$1] }
   | DeclOrStmtToken DeclOrStmtTokens(delim) { [$1] ++ $2 }
-  | "="  Expr ","   DeclOrStmtTokens(delim) { [DTAsgn     $2, DTComma] ++ $4 }
-  | "<=" Expr ","   DeclOrStmtTokens(delim) { [DTAsgnNBlk $2, DTComma] ++ $4 }
-  | "="  Expr                        delim  { [DTAsgn     $2] }
-  | "<=" Expr                        delim  { [DTAsgnNBlk $2] }
+  | AsgnOp Expr "," DeclOrStmtTokens(delim) { [DTAsgn $1  $2, DTComma] ++ $4 }
+  | "<="   Expr "," DeclOrStmtTokens(delim) { [DTAsgnNBlk $2, DTComma] ++ $4 }
+  | AsgnOp Expr                      delim  { [DTAsgn $1  $2] }
+  | "<="   Expr                      delim  { [DTAsgnNBlk $2] }
 DeclOrStmtToken :: { DeclToken }
   : ","                       { DTComma }
   | Range                     { DTRange  $1 }
@@ -405,10 +405,10 @@ Stmts :: { [Stmt] }
   | Stmts Stmt  { $1 ++ [$2] }
 
 Stmt :: { Stmt }
-  : StmtNonAsgn       { $1 }
-  | LHS "="  Expr ";" { AsgnBlk $1 $3 }
-  | LHS "<=" Expr ";" { Asgn    $1 $3 }
-  | Identifier    ";" { Subroutine $1 [] }
+  : StmtNonAsgn         { $1 }
+  | LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
+  | LHS "<="   Expr ";" { Asgn       $1 $3 }
+  | Identifier      ";" { Subroutine $1 [] }
 StmtNonAsgn :: { Stmt }
   : ";" { Null }
   | "begin"                DeclsAndStmts "end" { Block Nothing   (fst $2) (snd $2) }
@@ -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,14 +150,15 @@ parseDTsAsDeclOrAsgn tokens =
         else (parseDTsAsDecl tokens, [])
     where
         (constructor, expr) = case last tokens of
-            DTAsgn     e -> (AsgnBlk, e)
-            DTAsgnNBlk e -> (Asgn   , 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
         isAsgnToken :: DeclToken -> Bool
-        isAsgnToken (DTBit      _) = True
-        isAsgnToken (DTConcat   _) = True
-        isAsgnToken (DTAsgnNBlk _) = True
+        isAsgnToken (DTBit             _) = True
+        isAsgnToken (DTConcat          _) = True
+        isAsgnToken (DTAsgnNBlk        _) = True
+        isAsgnToken (DTAsgn (AsgnOp _) _) = True
         isAsgnToken _ = False
 
 takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
@@ -257,8 +258,8 @@ 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 (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])