Commit dd5b0343 by Zachary Snow

allow block item declarations for un-named blocks

parent e006e36d
......@@ -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
flatStmtMapper (Block name decls stmts) = do
decls' <- mapM declMapper decls
return $ Block (Just (name, decls')) stmts
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 }
......
......@@ -157,6 +157,7 @@ parseDTsAsDeclOrAsgn tokens =
isAsgnToken :: DeclToken -> Bool
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment