diff --git a/src/Convert/AsgnOp.hs b/src/Convert/AsgnOp.hs index 3173b3f..2bcd282 100644 --- a/src/Convert/AsgnOp.hs +++ b/src/Convert/AsgnOp.hs @@ -1,8 +1,9 @@ {- sv2v - Author: Zachary Snow - - - 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 diff --git a/src/Convert/PackedArray.hs b/src/Convert/PackedArray.hs index 43ea27c..b83ef1e 100644 --- a/src/Convert/PackedArray.hs +++ b/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)) = diff --git a/src/Convert/Return.hs b/src/Convert/Return.hs index 88c48a6..b51b3eb 100644 --- a/src/Convert/Return.hs +++ b/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 diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index dede47c..84db19c 100644 --- a/src/Convert/Traverse.hs +++ b/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 diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index c3663e7..284c844 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/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) diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 4e46133..0b9183b 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/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 } diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index 4cfa3d3..3f1231e 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/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])