diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2011-05-06 15:56:06 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2011-05-06 15:56:06 +0100 |
| commit | ca53c38335cdc671f0b1e0949aa1514fc3fd72a5 (patch) | |
| tree | fb8adff51bd236c6c912a062702a8e08937333d4 /compiler/parser/Parser.y.pp | |
| parent | 4f8d714962667c219de4e684fe069136a0f78729 (diff) | |
| parent | 246183c669a1e851ccc42697dbbf309292bf2a08 (diff) | |
| download | haskell-ca53c38335cdc671f0b1e0949aa1514fc3fd72a5.tar.gz | |
Merge master into the ghc-new-co branch
Diffstat (limited to 'compiler/parser/Parser.y.pp')
| -rw-r--r-- | compiler/parser/Parser.y.pp | 20 |
1 files changed, 9 insertions, 11 deletions
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index bfadfbaff8..aa20ea6799 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -1283,14 +1283,9 @@ exp10 :: { LHsExpr RdrName } | 'case' exp 'of' altslist { LL $ HsCase $2 (mkMatchGroup (unLoc $4)) } | '-' fexp { LL $ NegApp $2 noSyntaxExpr } - | 'do' stmtlist {% let loc = comb2 $1 $2 in - checkDo loc (unLoc $2) >>= \ (stmts,body) -> - return (L loc (mkHsDo DoExpr stmts body)) } - | 'mdo' stmtlist {% let loc = comb2 $1 $2 in - checkDo loc (unLoc $2) >>= \ (stmts,body) -> - return (L loc (mkHsDo MDoExpr - [L loc (mkRecStmt stmts)] - body)) } + | 'do' stmtlist { L (comb2 $1 $2) (mkHsDo DoExpr (unLoc $2)) } + | 'mdo' stmtlist { L (comb2 $1 $2) (mkHsDo MDoExpr (unLoc $2)) } + | scc_annot exp { LL $ if opt_SccProfilingOn then HsSCC (unLoc $1) $2 else HsPar $2 } @@ -1465,7 +1460,10 @@ list :: { LHsExpr RdrName } | texp ',' exp '..' { LL $ ArithSeq noPostTcExpr (FromThen $1 $3) } | texp '..' exp { LL $ ArithSeq noPostTcExpr (FromTo $1 $3) } | texp ',' exp '..' exp { LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) } - | texp '|' flattenedpquals { sL (comb2 $1 $>) $ mkHsDo ListComp (unLoc $3) $1 } + | texp '|' flattenedpquals + {% checkMonadComp >>= \ ctxt -> + return (sL (comb2 $1 $>) $ + mkHsComp ctxt (unLoc $3) $1) } lexps :: { Located [LHsExpr RdrName] } : lexps ',' texp { LL (((:) $! $3) $! unLoc $1) } @@ -1480,7 +1478,7 @@ flattenedpquals :: { Located [LStmt RdrName] } -- We just had one thing in our "parallel" list so -- we simply return that thing directly - qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss]] + qss -> L1 [L1 $ ParStmt [(qs, undefined) | qs <- qss] noSyntaxExpr noSyntaxExpr noSyntaxExpr] -- We actually found some actual parallel lists so -- we wrap them into as a ParStmt } @@ -1537,7 +1535,7 @@ parr :: { LHsExpr RdrName } (reverse (unLoc $1)) } | texp '..' exp { LL $ PArrSeq noPostTcExpr (FromTo $1 $3) } | texp ',' exp '..' exp { LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) } - | texp '|' flattenedpquals { LL $ mkHsDo PArrComp (unLoc $3) $1 } + | texp '|' flattenedpquals { LL $ mkHsComp PArrComp (unLoc $3) $1 } -- We are reusing `lexps' and `flattenedpquals' from the list case. |