luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

support for statement labels and basic fork-join

This commit is contained in:
Zachary Snow 2019-09-30 23:03:55 -04:00
parent d57c967090
commit b7959c7aa2
11 changed files with 171 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Convert/BlockDecl.hs
View File

@ -20,8 +20,8 @@ convert =
$ traverseStmts $ convertStmt
convertStmt :: Stmt -> Stmt
convertStmt (Block name decls stmts) =
Block name decls' stmts'
convertStmt (Block Seq name decls stmts) =
Block Seq name decls' stmts'
where
splitDecls = map splitDecl decls
decls' = map fst splitDecls

43
src/Convert/ForDecl.hs
View File

@ -11,8 +11,6 @@
module Convert.ForDecl (convert) where
import Data.Either (isLeft, isRight, lefts, rights)
import Convert.Traverse
import Language.SystemVerilog.AST
@ -24,14 +22,14 @@ convert =
)
convertGenItem :: GenItem -> GenItem
convertGenItem (GenFor (True, x, e) a b mbx c) =
GenBlock Nothing genItems
convertGenItem (GenFor (True, x, e) a b bx c) =
GenBlock "" genItems
where
x' = (maybe "" (++ "_") mbx) ++ x
x' = if null bx then x else bx ++ "_" ++ x
Generate genItems =
traverseNestedModuleItems converter $ Generate $
[ GenModuleItem $ Genvar x'
, GenFor (False, x, e) a b mbx c
, GenFor (False, x, e) a b bx c
]
converter =
(traverseExprs $ traverseNestedExprs convertExpr) .
@ -45,33 +43,28 @@ convertGenItem (GenFor (True, x, e) a b mbx c) =
convertGenItem other = other
convertStmt :: Stmt -> Stmt
convertStmt (For [] cc asgns stmt) =
convertStmt (For (Left []) cc asgns stmt) =
convertStmt $ For (Right []) cc asgns stmt
convertStmt (For (Right []) cc asgns stmt) =
convertStmt $ For inits cc asgns stmt
where inits = [Left $ dummyDecl (Just $ Number "0")]
convertStmt (orig @ (For [Right _] _ _ _)) = orig
where inits = Left [dummyDecl (Just $ Number "0")]
convertStmt (orig @ (For (Right [_]) _ _ _)) = orig
convertStmt (orig @ (For (inits @ (Left _: _)) cc asgns stmt)) =
if not $ all isLeft inits
then error $ "for loop has mix of decls and asgns: " ++ show orig
else Block
Nothing
decls
(initAsgns ++ [For [Right (lhs, expr)] cc asgns stmt])
convertStmt (For (Left inits) cc asgns stmt) =
Block Seq "" decls $
initAsgns ++
[For (Right [(lhs, expr)]) cc asgns stmt]
where
splitDecls = map splitDecl $ lefts inits
splitDecls = map splitDecl inits
decls = map fst splitDecls
initAsgns = map asgnStmt $ init $ map snd splitDecls
(lhs, expr) = snd $ last splitDecls
convertStmt (orig @ (For inits cc asgns stmt)) =
if not $ all isRight inits
then error $ "for loop has mix of decls and asgns: " ++ show orig
else Block
Nothing
[]
(initAsgns ++ [For [Right (lhs, expr)] cc asgns stmt])
convertStmt (For (Right origPairs) cc asgns stmt) =
Block Seq "" [] $
initAsgns ++
[For (Right [(lhs, expr)]) cc asgns stmt]
where
origPairs = rights inits
(lhs, expr) = last origPairs
initAsgns = map asgnStmt $ init origPairs

2
src/Convert/Foreach.hs
View File

@ -25,7 +25,7 @@ convertStmt (Foreach x idxs stmt) =
toLoop :: (Int, Maybe Identifier) -> (Stmt -> Stmt)
toLoop (_, Nothing) = id
toLoop (d, Just i) =
For [Left idxDecl] (Just cmp) [incr]
For (Left [idxDecl]) cmp [incr]
where
queryFn f = DimFn f (Right $ Ident x) (Number $ show d)
idxDecl = Variable Local (IntegerAtom TInteger Unspecified) i []

12
src/Convert/NamedBlock.hs
View File

@ -26,19 +26,19 @@ convert asts =
where runner = mapM . traverseDescriptionsM . traverseModuleItemsM . traverseStmtsM
collectStmtM :: Stmt -> State Idents Stmt
collectStmtM (Block (Just x) decls stmts) = do
collectStmtM (Block kw x decls stmts) = do
modify $ Set.insert x
return $ Block (Just x) decls stmts
return $ Block kw x decls stmts
collectStmtM other = return other
traverseStmtM :: Stmt -> State Idents Stmt
traverseStmtM (Block Nothing [] stmts) =
return $ Block Nothing [] stmts
traverseStmtM (Block Nothing decls stmts) = do
traverseStmtM (Block kw "" [] stmts) =
return $ Block kw "" [] stmts
traverseStmtM (Block kw "" decls stmts) = do
names <- get
let x = uniqueBlockName names
modify $ Set.insert x
return $ Block (Just x) decls stmts
return $ Block kw x decls stmts
traverseStmtM other = return other
uniqueBlockName :: Idents -> Identifier

2
src/Convert/StmtBlock.hs
View File

@ -27,4 +27,4 @@ convertPackageItem other = other
stmtsToStmt :: [Stmt] -> Stmt
stmtsToStmt [stmt] = stmt
stmtsToStmt stmts = Block Nothing [] stmts
stmtsToStmt stmts = Block Seq "" [] stmts

8
src/Convert/Stream.hs
View File

@ -29,7 +29,7 @@ convertDescription other = other
streamerBlock :: Expr -> Expr -> (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
streamerBlock chunk size asgn output input =
Block Nothing
Block Seq ""
[ Variable Local t inp [] $ Just input
, Variable Local t out [] Nothing
, Variable Local (IntegerAtom TInteger Unspecified) idx [] Nothing
@ -50,14 +50,14 @@ streamerBlock chunk size asgn output input =
idx = name ++ "_idx"
bas = name ++ "_bas"
-- main chunk loop
inits = [Right (LHSIdent idx, lo)]
cmp = Just $ BinOp Le (Ident idx) (BinOp Sub hi chunk)
inits = Right [(LHSIdent idx, lo)]
cmp = BinOp Le (Ident idx) (BinOp Sub hi chunk)
incr = [(LHSIdent idx, AsgnOp Add, chunk)]
lhs = LHSRange (LHSIdent out) IndexedMinus (BinOp Sub hi (Ident idx), chunk)
expr = Range (Ident inp) IndexedPlus (Ident idx, chunk)
stmt = AsgnBlk AsgnOpEq lhs expr
-- final chunk loop
cmp2 = Just $ BinOp Lt (Ident idx) (BinOp Sub size (Ident bas))
cmp2 = BinOp Lt (Ident idx) (BinOp Sub size (Ident bas))
incr2 = [(LHSIdent idx, AsgnOp Add, Number "1")]
lhs2 = LHSBit (LHSIdent out) (Ident idx)
expr2 = Bit (Ident inp) (BinOp Add (Ident idx) (Ident bas))

44
src/Convert/Traverse.hs
View File

@ -126,7 +126,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d
let items'' = concatMap breakGenerate items'
return $ Part attrs extern kw lifetime name ports items''
where
fullMapper (Generate [GenBlock Nothing genItems]) =
fullMapper (Generate [GenBlock "" genItems]) =
mapM fullGenItemMapper genItems >>= mapper . Generate
fullMapper (Generate genItems) = do
let genItems' = filter (/= GenNull) genItems
@ -138,7 +138,7 @@ traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = d
genItemMapper (GenModuleItem moduleItem) = do
moduleItem' <- fullMapper moduleItem
return $ case moduleItem' of
Generate subItems -> GenBlock Nothing subItems
Generate subItems -> GenBlock "" subItems
_ -> GenModuleItem moduleItem'
genItemMapper (GenIf (Number "1") s _) = return s
genItemMapper (GenIf (Number "0") _ s) = return s
@ -228,9 +228,9 @@ traverseSinglyNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt
traverseSinglyNestedStmtsM fullMapper = cs
where
cs (StmtAttr a stmt) = fullMapper stmt >>= return . StmtAttr a
cs (Block Nothing [] []) = return Null
cs (Block name decls stmts) =
mapM fullMapper stmts >>= return . Block name decls
cs (Block _ "" [] []) = return Null
cs (Block kw name decls stmts) =
mapM fullMapper stmts >>= return . Block kw name decls
cs (Case u kw expr cases def) = do
caseStmts <- mapM fullMapper $ map snd cases
let cases' = zip (map fst cases) caseStmts
@ -373,16 +373,17 @@ traverseStmtLHSsM mapper = stmtMapper
stmtMapper (AsgnBlk op lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk op lhs' expr
stmtMapper (Asgn mt lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn mt lhs' expr
stmtMapper (For inits me incrs stmt) = do
inits' <- mapM mapInit inits
inits' <- mapInits inits
let (lhss, asgnOps, exprs) = unzip3 incrs
lhss' <- mapM fullMapper lhss
let incrs' = zip3 lhss' asgnOps exprs
return $ For inits' me incrs' stmt
where
mapInit (Left decl) = return $ Left decl
mapInit (Right (lhs, expr)) = do
lhs' <- fullMapper lhs
return $ Right (lhs', expr)
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
@ -664,9 +665,9 @@ traverseStmtExprsM exprMapper = flatStmtMapper
flatStmtMapper (StmtAttr attr stmt) =
-- note: we exclude expressions in attributes from conversion
return $ StmtAttr attr stmt
flatStmtMapper (Block name decls stmts) = do
flatStmtMapper (Block kw name decls stmts) = do
decls' <- mapM declMapper decls
return $ Block name decls' stmts
return $ Block kw name decls' stmts
flatStmtMapper (Case u kw e cases def) = do
e' <- exprMapper e
cases' <- mapM caseMapper cases
@ -680,8 +681,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper
expr' <- exprMapper expr
return $ Asgn mt lhs' expr'
flatStmtMapper (For inits cc asgns stmt) = do
inits' <- mapM initMapper inits
cc' <- maybeExprMapper cc
inits' <- initsMapper inits
cc' <- exprMapper cc
asgns' <- mapM asgnMapper asgns
return $ For inits' cc' asgns' stmt
flatStmtMapper (While e stmt) =
@ -709,8 +710,9 @@ traverseStmtExprsM exprMapper = flatStmtMapper
return $ Assertion a''
flatStmtMapper (Null) = return Null
initMapper (Left decl) = declMapper decl >>= return . Left
initMapper (Right (l, e)) = exprMapper e >>= \e' -> return $ Right (l, e')
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')
@ -802,9 +804,9 @@ traverseDeclsM' strat mapper item = do
else return decls
return $ MIPackageItem $ Task l x decls' stmts
miMapper other = return other
stmtMapper (Block name decls stmts) = do
stmtMapper (Block kw name decls stmts) = do
decls' <- mapM mapper decls
return $ Block name decls' stmts
return $ Block kw name decls' stmts
stmtMapper other = return other
traverseDecls' :: TFStrategy -> Mapper Decl -> Mapper ModuleItem
@ -938,7 +940,7 @@ traverseSinglyNestedGenItemsM fullMapper = gim
return $ GenModuleItem moduleItem
gim (GenNull) = return GenNull
flattenBlocks :: GenItem -> [GenItem]
flattenBlocks (GenBlock Nothing items) = items
flattenBlocks (GenBlock "" items) = items
flattenBlocks other = [other]
traverseAsgnsM' :: Monad m => TFStrategy -> MapperM m (LHS, Expr) -> MapperM m ModuleItem
@ -1032,10 +1034,10 @@ traverseScopesM declMapper moduleItemMapper stmtMapper =
nestedStmtMapper stmt =
stmtMapper stmt >>= traverseSinglyNestedStmtsM fullStmtMapper
fullStmtMapper (Block name decls stmts) = do
fullStmtMapper (Block kw name decls stmts) = do
prevState <- get
decls' <- mapM declMapper decls
block <- nestedStmtMapper $ Block name decls' stmts
block <- nestedStmtMapper $ Block kw name decls' stmts
put prevState
return block
fullStmtMapper other = nestedStmtMapper other

12
src/Language/SystemVerilog/AST/GenItem.hs
View File

@ -20,9 +20,9 @@ import Language.SystemVerilog.AST.Type (Identifier)
import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)
data GenItem
= GenBlock (Maybe Identifier) [GenItem]
= GenBlock Identifier [GenItem]
| GenCase Expr [GenCase] (Maybe GenItem)
| GenFor (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) (Maybe Identifier) [GenItem]
| GenFor (Bool, Identifier, Expr) Expr (Identifier, AsgnOp, Expr) Identifier [GenItem]
| GenIf Expr GenItem GenItem
| GenNull
| GenModuleItem ModuleItem
@ -30,9 +30,9 @@ data GenItem
instance Show GenItem where
showList i _ = unlines' $ map show i
show (GenBlock mx i) =
show (GenBlock x i) =
printf "begin%s\n%s\nend"
(maybe "" (" : " ++) mx)
(if null x then "" else " : " ++ x)
(indent $ unlines' $ map show i)
show (GenCase e cs def) =
printf "case (%s)\n%s%s\nendcase" (show e) bodyStr defStr
@ -43,13 +43,13 @@ instance Show GenItem where
Just c -> printf "\n\tdefault: %s" (show c)
show (GenIf e a GenNull) = printf "if (%s) %s" (show e) (show a)
show (GenIf e a b ) = printf "if (%s) %s\nelse %s" (show e) (show a) (show b)
show (GenFor (new, x1, e1) c (x2, o2, e2) mx is) =
show (GenFor (new, x1, e1) c (x2, o2, e2) x is) =
printf "for (%s%s = %s; %s; %s %s %s) %s"
(if new then "genvar " else "")
x1 (show e1)
(show c)
x2 (show o2) (show e2)
(show $ GenBlock mx is)
(show $ GenBlock x is)
show (GenNull) = ";"
show (GenModuleItem item) = show item

39
src/Language/SystemVerilog/AST/Stmt.hs
View File

@ -20,6 +20,7 @@ module Language.SystemVerilog.AST.Stmt
, Assertion (..)
, PropertySpec (..)
, UniquePriority (..)
, BlockKW (..)
) where
import Text.Printf (printf)
@ -29,14 +30,14 @@ import Language.SystemVerilog.AST.Attr (Attr)
import Language.SystemVerilog.AST.Decl (Decl)
import Language.SystemVerilog.AST.Expr (Expr, Args)
import Language.SystemVerilog.AST.LHS (LHS)
import Language.SystemVerilog.AST.Op (AsgnOp)
import Language.SystemVerilog.AST.Op (AsgnOp(AsgnOpEq))
import Language.SystemVerilog.AST.Type (Identifier)
data Stmt
= StmtAttr Attr Stmt
| Block (Maybe Identifier) [Decl] [Stmt]
| Block BlockKW Identifier [Decl] [Stmt]
| Case (Maybe UniquePriority) CaseKW Expr [Case] (Maybe Stmt)
| For [Either Decl (LHS, Expr)] (Maybe Expr) [(LHS, AsgnOp, Expr)] Stmt
| For (Either [Decl] [(LHS, Expr)]) Expr [(LHS, AsgnOp, Expr)] Stmt
| AsgnBlk AsgnOp LHS Expr
| Asgn (Maybe Timing) LHS Expr
| While Expr Stmt
@ -55,10 +56,10 @@ data Stmt
instance Show Stmt where
show (StmtAttr attr stmt) = printf "%s\n%s" (show attr) (show stmt)
show (Block name decls stmts) =
printf "begin%s\n%s\nend" header body
show (Block kw name decls stmts) =
printf "%s%s\n%s\n%s" (show kw) header body (blockEndToken kw)
where
header = maybe "" (" : " ++) name
header = if null name then "" else " : " ++ name
bodyLines = (map show decls) ++ (map show stmts)
body = indent $ unlines' bodyLines
show (Case u kw e cs def) =
@ -68,16 +69,17 @@ instance Show Stmt where
defStr = case def of
Nothing -> ""
Just c -> printf "\n\tdefault: %s" (show c)
show (For inits mc assigns stmt) =
show (For inits cond assigns stmt) =
printf "for (%s; %s; %s)\n%s"
(commas $ map showInit inits)
(maybe "" show mc)
(showInits inits)
(show cond)
(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)
showInits :: Either [Decl] [(LHS, Expr)] -> String
showInits (Left decls) = commas $ map (init . show) decls
showInits (Right asgns) = commas $ map showInit asgns
where showInit (l, e) = showAssign (l, AsgnOpEq, e)
showAssign :: (LHS, AsgnOp, Expr) -> String
showAssign (l, op, e) = printf "%s %s %s" (show l) (show op) (show e)
show (Subroutine ps x a) = printf "%s%s(%s);" (maybe "" (++ "::") ps) x (show a)
@ -221,3 +223,16 @@ instance Show UniquePriority where
show Unique = "unique"
show Unique0 = "unique0"
show Priority = "priority"
data BlockKW
= Seq
| Par
deriving Eq
instance Show BlockKW where
show Seq = "begin"
show Par = "fork"
blockEndToken :: BlockKW -> Identifier
blockEndToken Seq = "end"
blockEndToken Par = "join"

90
src/Language/SystemVerilog/Parser/Parse.y
View File

@ -518,6 +518,10 @@ PackageDeclaration :: { Description }
Tag :: { Identifier }
: ":" Identifier { $2 }
StrTag :: { Identifier }
: {- empty -} { "" }
| ":" Identifier { $2 }
PackageImportDeclarations :: { [ModuleItem] }
: PackageImportDeclaration PackageImportDeclarations { $1 ++ $2 }
| {- empty -} { [] }
@ -699,8 +703,8 @@ SeqMatchItems :: { [SeqMatchItem] }
: "," SeqMatchItem { [$2] }
| SeqMatchItems "," SeqMatchItem { $1 ++ [$3] }
SeqMatchItem :: { SeqMatchItem }
: ForStepAssignment { Left $1 }
| Identifier "(" CallArgs ")" { Right ($1, $3) }
: ForStepAssignment { Left $1 }
| Identifier CallArgs { Right ($1, $2) }
ActionBlock :: { ActionBlock }
: Stmt %prec NoElse { ActionBlockIf $1 }
@ -879,22 +883,31 @@ Stmts :: { [Stmt] }
| Stmts Stmt { $1 ++ [$2] }
Stmt :: { Stmt }
: StmtNonAsgn { $1 }
| LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
: StmtAsgn { $1 }
| StmtNonAsgn { $1 }
StmtAsgn :: { Stmt }
: LHS AsgnOp Expr ";" { AsgnBlk $2 $1 $3 }
| LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") }
| LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
| Identifier ";" { Subroutine (Nothing) $1 (Args [] []) }
| Identifier "::" Identifier ";" { Subroutine (Just $1) $3 (Args [] []) }
| LHS "<=" opt(DelayOrEventControl) Expr ";" { Asgn $3 $1 $4 }
| LHS IncOrDecOperator ";" { AsgnBlk (AsgnOp $2) $1 (Number "1") }
StmtNonAsgn :: { Stmt }
: StmtBlock(BlockKWSeq, "end" ) { $1 }
| StmtBlock(BlockKWPar, "join") { $1 }
| StmtNonBlock { $1 }
| Identifier ":" StmtNonBlock { Block Seq $1 [] [$3] }
StmtBlock(begin, end) :: { Stmt }
: begin StrTag DeclsAndStmts end StrTag { uncurry (Block $1 $ combineTags $2 $5) $3 }
| Identifier ":" begin DeclsAndStmts end StrTag { uncurry (Block $3 $ combineTags $1 $6) $4 }
StmtNonBlock :: { Stmt }
: ";" { Null }
| "begin" opt(Tag) DeclsAndStmts "end" opt(Tag) { Block (combineTags $2 $5) (fst $3) (snd $3) }
| Unique "if" "(" Expr ")" Stmt "else" Stmt { If $1 $4 $6 $8 }
| Unique "if" "(" Expr ")" Stmt %prec NoElse { If $1 $4 $6 Null }
| "for" "(" ";" opt(Expr) ";" ForStep ")" Stmt { For [] $4 $6 $8 }
| "for" "(" DeclTokens(";") opt(Expr) ";" ForStep ")" Stmt { For (parseDTsAsDeclsAndAsgns $3) $4 $6 $8 }
| Unique CaseKW "(" Expr ")" CasesWithDefault "endcase" { Case $1 $2 $4 (fst $6) (snd $6) }
| Identifier "(" CallArgs ")" ";" { Subroutine (Nothing) $1 $3 }
| Identifier "::" Identifier "(" CallArgs ")" ";" { Subroutine (Just $1) $3 $5 }
| 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 }
| Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 (fst $6) (snd $6) }
| Identifier CallArgs ";" { Subroutine (Nothing) $1 $2 }
| Identifier "::" Identifier CallArgs ";" { Subroutine (Just $1) $3 $4 }
| TimingControl Stmt { Timing $1 $2 }
| "return" Expr ";" { Return $2 }
| "while" "(" Expr ")" Stmt { While $3 $5 }
@ -907,12 +920,25 @@ StmtNonAsgn :: { Stmt }
| ProceduralAssertionStatement { Assertion $1 }
| IncOrDecOperator LHS ";" { AsgnBlk (AsgnOp $1) $2 (Number "1") }
BlockKWPar :: { BlockKW }
: "fork" { Par }
BlockKWSeq :: { BlockKW }
: "begin" { Seq }
Unique :: { Maybe UniquePriority }
: {- empty -} { Nothing }
| "unique" { Just Unique }
| "unique0" { Just Unique0 }
| "priority" { Just Priority }
ForInit :: { Either [Decl] [(LHS, Expr)] }
: ";" { Right [] }
| DeclTokens(";") { parseDTsAsDeclsOrAsgns $1 }
ForCond :: { Expr }
: ";" { Number "1" }
| Expr ";" { $1 }
ForStep :: { [(LHS, AsgnOp, Expr)] }
: {- empty -} { [] }
| ForStepNonEmpty { $1 }
@ -996,13 +1022,13 @@ CaseKW :: { CaseKW }
| "casex" { CaseX }
| "casez" { CaseZ }
CasesWithDefault :: { ([Case], Maybe Stmt) }
: {- empty -} { ([], Nothing) }
| Case CasesWithDefault { ($1 : fst $2, snd $2) }
| CaseDefault Cases { ($2, Just $1) }
Cases :: { [Case] }
: {- empty -} { [] }
| Cases Case { $1 ++ [$2] }
Cases :: { ([Case], Maybe Stmt) }
: {- empty -} { ([], Nothing) }
| Case Cases { ($1 : fst $2, snd $2) }
| CaseDefault CasesNoDefault { ($2, Just $1) }
CasesNoDefault :: { [Case] }
: {- empty -} { [] }
| CasesNoDefault Case { $1 ++ [$2] }
Case :: { Case }
: Exprs ":" Stmt { ($1, $3) }
@ -1020,6 +1046,8 @@ Time :: { String }
: time { tokenString $1 }
CallArgs :: { Args }
: "(" CallArgsInside ")" { $2 }
CallArgsInside :: { Args }
: {- empty -} { Args [ ] [] }
| NamedCallArgsFollow { Args [ ] $1 }
| Expr NamedCallArgs { Args [Just $1 ] $2 }
@ -1049,8 +1077,8 @@ Expr :: { Expr }
: "(" Expr ")" { $2 }
| String { String $1 }
| Number { Number $1 }
| Identifier "(" CallArgs ")" { Call (Nothing) $1 $3 }
| Identifier "::" Identifier "(" CallArgs ")" { Call (Just $1) $3 $5 }
| Identifier CallArgs { Call (Nothing) $1 $2 }
| Identifier "::" Identifier CallArgs { Call (Just $1) $3 $4 }
| DimsFn "(" TypeOrExpr ")" { DimsFn $1 $3 }
| DimFn "(" TypeOrExpr ")" { DimFn $1 $3 (Number "1") }
| DimFn "(" TypeOrExpr "," Expr ")" { DimFn $1 $3 $5 }
@ -1156,8 +1184,8 @@ ConditionalGenerateConstruct :: { GenItem }
LoopGenerateConstruct :: { GenItem }
: "for" "(" GenvarInitialization ";" Expr ";" GenvarIteration ")" GenBlock { (uncurry $ GenFor $3 $5 $7) $9 }
GenBlock :: { (Maybe Identifier, [GenItem]) }
: "begin" opt(Tag) GenItems "end" opt(Tag) { (combineTags $2 $5, $3) }
GenBlock :: { (Identifier, [GenItem]) }
: "begin" StrTag GenItems "end" StrTag { (combineTags $2 $5, $3) }
GenCasesWithDefault :: { ([GenCase], Maybe GenItem) }
: {- empty -} { ([], Nothing) }
@ -1222,7 +1250,7 @@ parseError a = case a of
genItemsToGenItem :: [GenItem] -> GenItem
genItemsToGenItem [x] = x
genItemsToGenItem xs = GenBlock Nothing xs
genItemsToGenItem xs = GenBlock "" xs
combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) -> ([Decl], [Stmt])
combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2)
@ -1242,13 +1270,13 @@ defaultFuncInput (Variable dir (Implicit sg rs) x a me) =
else Implicit sg rs
defaultFuncInput other = other
combineTags :: Maybe Identifier -> Maybe Identifier -> Maybe Identifier
combineTags (Just a) (Just b) =
combineTags :: Identifier -> Identifier -> Identifier
combineTags a "" = a
combineTags "" b = b
combineTags a b =
if a == b
then Just a
then a
else error $ "tag mismatch: " ++ show (a, b)
combineTags Nothing other = other
combineTags other _ = other
toLHS :: Expr -> LHS
toLHS expr =

46
src/Language/SystemVerilog/Parser/ParseDecl.hs
View File

@ -35,7 +35,7 @@ module Language.SystemVerilog.Parser.ParseDecl
, parseDTsAsDecls
, parseDTsAsDecl
, parseDTsAsDeclOrAsgn
, parseDTsAsDeclsAndAsgns
, parseDTsAsDeclsOrAsgns
) where
import Data.List (elemIndex, findIndex, findIndices)
@ -219,28 +219,14 @@ parseDTsAsDeclOrAsgn tokens =
isAsgn (DTAsgn _ _) = True
isAsgn _ = False
-- [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 =
-- [PUBLIC]: parser for comma-separated declarations or assignment lists; this
-- is only used for `for` loop initialization lists
parseDTsAsDeclsOrAsgns :: [DeclToken] -> Either [Decl] [(LHS, Expr)]
parseDTsAsDeclsOrAsgns tokens =
forbidNonEqAsgn tokens $
if hasLeadingAsgn || tripLookahead tokens
then
let (lhsToks, l0) = break isDTAsgn tokens
lhs = case takeLHS lhsToks of
Nothing ->
error $ "could not parse as LHS: " ++ show lhsToks
Just l -> l
DTAsgn AsgnOpEq expr : l1 = l0
asgn = Right (lhs, expr)
in case l1 of
DTComma : remaining -> asgn : parseDTsAsDeclsAndAsgns remaining
[] -> [asgn]
_ -> error $ "bad decls and asgns tokens: " ++ show tokens
else
let (component, remaining) = parseDTsAsComponent tokens
decls = finalize component
in (map Left decls) ++ parseDTsAsDeclsAndAsgns remaining
then Right $ parseDTsAsAsgns tokens
else Left $ parseDTsAsDecls tokens
where
hasLeadingAsgn =
-- if there is an asgn token before the next comma
@ -248,6 +234,22 @@ parseDTsAsDeclsAndAsgns tokens =
(Just a, Just b) -> a > b
(Nothing, Just _) -> True
_ -> False
-- internal parser for basic assignment lists
parseDTsAsAsgns :: [DeclToken] -> [(LHS, Expr)]
parseDTsAsAsgns tokens =
case l1 of
[] -> [asgn]
DTComma : remaining -> asgn : parseDTsAsAsgns remaining
_ -> error $ "bad assignment tokens: " ++ show tokens
where
(lhsToks, l0) = break isDTAsgn tokens
lhs = case takeLHS lhsToks of
Nothing -> error $ "could not parse as LHS: " ++ show lhsToks
Just l -> l
DTAsgn AsgnOpEq expr : l1 = l0
asgn = (lhs, expr)
isDTAsgn :: DeclToken -> Bool
isDTAsgn (DTAsgn _ _) = True
isDTAsgn _ = False