mirror of https://github.com/zachjs/sv2v.git
allow block item declarations for un-named blocks
This commit is contained in:
parent
e006e36ddc
commit
dd5b03431d
|
|
@ -130,7 +130,8 @@ traverseNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt
|
|||
traverseNestedStmtsM mapper = fullMapper
|
||||
where
|
||||
fullMapper stmt = mapper stmt >>= cs
|
||||
cs (Block decls stmts) = mapM fullMapper stmts >>= return . Block decls
|
||||
cs (Block name decls stmts) =
|
||||
mapM fullMapper stmts >>= return . Block name decls
|
||||
cs (Case u kw expr cases def) = do
|
||||
caseStmts <- mapM fullMapper $ map snd cases
|
||||
let cases' = zip (map fst cases) caseStmts
|
||||
|
|
@ -250,13 +251,9 @@ traverseExprsM mapper = moduleItemMapper
|
|||
exprs' <- mapM exprMapper exprs
|
||||
return (exprs', stmt)
|
||||
stmtMapper = traverseNestedStmtsM flatStmtMapper
|
||||
flatStmtMapper (Block header stmts) = do
|
||||
if header == Nothing
|
||||
then return $ Block Nothing stmts
|
||||
else do
|
||||
let Just (name, decls) = header
|
||||
decls' <- mapM declMapper decls
|
||||
return $ Block (Just (name, decls')) stmts
|
||||
flatStmtMapper (Block name decls stmts) = do
|
||||
decls' <- mapM declMapper decls
|
||||
return $ Block name decls' stmts
|
||||
flatStmtMapper (Case u kw e cases def) = do
|
||||
e' <- exprMapper e
|
||||
cases' <- mapM caseMapper cases
|
||||
|
|
@ -368,9 +365,9 @@ traverseDeclsM mapper item = do
|
|||
decls' <- mapM mapper decls
|
||||
return $ MIPackageItem $ Task l x decls' s
|
||||
miMapperA other = return other
|
||||
miMapperB (Block (Just (name, decls)) stmts) = do
|
||||
miMapperB (Block name decls stmts) = do
|
||||
decls' <- mapM mapper decls
|
||||
return $ Block (Just (name, decls')) stmts
|
||||
return $ Block name decls' stmts
|
||||
miMapperB other = return other
|
||||
|
||||
traverseDecls :: Mapper Decl -> Mapper ModuleItem
|
||||
|
|
|
|||
|
|
@ -419,7 +419,7 @@ instance Show CaseKW where
|
|||
show CaseX = "casex"
|
||||
|
||||
data Stmt
|
||||
= Block (Maybe (Identifier, [Decl])) [Stmt]
|
||||
= Block (Maybe Identifier) [Decl] [Stmt]
|
||||
| Case Bool CaseKW Expr [Case] (Maybe Stmt)
|
||||
| For (Identifier, Expr) Expr (Identifier, Expr) Stmt
|
||||
| AsgnBlk LHS Expr
|
||||
|
|
@ -439,14 +439,12 @@ commas :: [String] -> String
|
|||
commas = intercalate ", "
|
||||
|
||||
instance Show Stmt where
|
||||
show (Block header stmts) =
|
||||
printf "begin%s\n%s\nend" extra (block stmts)
|
||||
show (Block name decls stmts) =
|
||||
printf "begin%s\n%s\n%s\nend" header (block decls) (block stmts)
|
||||
where
|
||||
header = maybe "" (" : " ++) name
|
||||
block :: Show t => [t] -> String
|
||||
block = indent . unlines' . map show
|
||||
extra = case header of
|
||||
Nothing -> ""
|
||||
Just (x, i) -> printf " : %s\n%s" x (block i)
|
||||
show (Case u kw e cs def) =
|
||||
printf "%s%s (%s)\n%s%s\nendcase" uniqStr (show kw) (show e) (indent $ unlines' $ map showCase cs) defStr
|
||||
where
|
||||
|
|
@ -469,7 +467,7 @@ instance Show Stmt where
|
|||
where
|
||||
rest = case s of
|
||||
Null -> ";"
|
||||
Block _ _ -> " " ++ (show s)
|
||||
Block _ _ _ -> " " ++ (show s)
|
||||
_ -> "\n" ++ (indent $ show s)
|
||||
show (Null ) = ";"
|
||||
|
||||
|
|
|
|||
|
|
@ -411,8 +411,8 @@ Stmt :: { Stmt }
|
|||
| Identifier ";" { Subroutine $1 [] }
|
||||
StmtNonAsgn :: { Stmt }
|
||||
: ";" { Null }
|
||||
| "begin" Stmts "end" { Block Nothing $2 }
|
||||
| "begin" ":" Identifier DeclsAndStmts "end" { Block (Just ($3, fst $4)) (snd $4) }
|
||||
| "begin" DeclsAndStmts "end" { Block Nothing (fst $2) (snd $2) }
|
||||
| "begin" ":" Identifier DeclsAndStmts "end" { Block (Just $3) (fst $4) (snd $4) }
|
||||
| "if" "(" Expr ")" Stmt "else" Stmt { If $3 $5 $7 }
|
||||
| "if" "(" Expr ")" Stmt %prec NoElse { If $3 $5 Null }
|
||||
| "for" "(" Identifier "=" Expr ";" Expr ";" Identifier "=" Expr ")" Stmt { For ($3, $5) $7 ($9, $11) $13 }
|
||||
|
|
|
|||
|
|
@ -155,8 +155,9 @@ parseDTsAsDeclOrAsgn tokens =
|
|||
_ -> 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 (DTBit _) = True
|
||||
isAsgnToken (DTConcat _) = True
|
||||
isAsgnToken (DTAsgnNBlk _) = True
|
||||
isAsgnToken _ = False
|
||||
|
||||
takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
|
||||
|
|
@ -267,7 +268,7 @@ takeComma _ = error "take comma encountered neither comma nor end of tokens"
|
|||
|
||||
takeIdent :: [DeclToken] -> (Identifier, [DeclToken])
|
||||
takeIdent (DTIdent x : rest) = (x, rest)
|
||||
takeIdent _ = error "takeIdent didn't find identifier"
|
||||
takeIdent tokens = error $ "takeIdent didn't find identifier: " ++ show tokens
|
||||
|
||||
|
||||
isIdent :: DeclToken -> Bool
|
||||
|
|
|
|||
Loading…
Reference in New Issue