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