diff options
Diffstat (limited to 'compiler/parser/Parser.y')
| -rw-r--r-- | compiler/parser/Parser.y | 50 |
1 files changed, 25 insertions, 25 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 469e02d0a6..aa1f2647a9 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2582,8 +2582,8 @@ exp :: { ExpCmdP } infixexp :: { ExpCmdP } : exp10 { $1 } | infixexp qop exp10 { ExpCmdP $ - runExpCmdP $1 >>= \ $1 -> - runExpCmdP $3 >>= \ $3 -> + runExpCmdPV $1 >>= \ $1 -> + runExpCmdPV $3 >>= \ $3 -> ams (sLL $1 $> (ecOpApp $1 $2 $3)) [mj AnnVal $2] } -- AnnVal annotation for NPlusKPat, which discards the operator @@ -2670,13 +2670,13 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In fexp :: { ExpCmdP } : fexp aexp {% runExpCmdP $2 >>= \ $2 -> - checkBlockArguments $2 >>= \_ -> + runPV (checkBlockArguments $2) >>= \_ -> return $ ExpCmdP $ - runExpCmdP $1 >>= \ $1 -> + runExpCmdPV $1 >>= \ $1 -> checkBlockArguments $1 >>= \_ -> return (sLL $1 $> (ecHsApp $1 $2)) } | fexp TYPEAPP atype {% runExpCmdP $1 >>= \ $1 -> - checkBlockArguments $1 >>= \_ -> + runPV (checkBlockArguments $1) >>= \_ -> fmap ecFromExp $ ams (sLL $1 $> $ HsAppType noExt $1 (mkHsWildCardBndrs $3)) [mj AnnAt $2] } @@ -2699,7 +2699,7 @@ aexp :: { ExpCmdP } | '\\' apat apats '->' exp { ExpCmdP $ - runExpCmdP $5 >>= \ $5 -> + runExpCmdPV $5 >>= \ $5 -> ams (sLL $1 $> $ ecHsLam (mkMatchGroup FromSource [sLL $1 $> $ Match { m_ext = noExt , m_ctxt = LambdaExpr @@ -2707,12 +2707,12 @@ aexp :: { ExpCmdP } , m_grhss = unguardedGRHSs $5 }])) [mj AnnLam $1, mu AnnRarrow $4] } | 'let' binds 'in' exp { ExpCmdP $ - runExpCmdP $4 >>= \ $4 -> + runExpCmdPV $4 >>= \ $4 -> ams (sLL $1 $> $ ecHsLet (snd (unLoc $2)) $4) (mj AnnLet $1:mj AnnIn $3 :(fst $ unLoc $2)) } | '\\' 'lcase' altslist - {% $3 >>= \ $3 -> + {% runPV $3 >>= \ $3 -> fmap ecFromExp $ ams (sLL $1 $> $ HsLamCase noExt (mkMatchGroup FromSource (snd $ unLoc $3))) @@ -2720,8 +2720,8 @@ aexp :: { ExpCmdP } | 'if' exp optSemi 'then' exp optSemi 'else' exp {% runExpCmdP $2 >>= \ $2 -> return $ ExpCmdP $ - runExpCmdP $5 >>= \ $5 -> - runExpCmdP $8 >>= \ $8 -> + runExpCmdPV $5 >>= \ $5 -> + runExpCmdPV $8 >>= \ $8 -> checkDoAndIfThenElse $2 (snd $3) $5 (snd $6) $8 >> ams (sLL $1 $> $ ecHsIf $2 $5 $8) (mj AnnIf $1:mj AnnThen $4 @@ -2746,7 +2746,7 @@ aexp :: { ExpCmdP } ams (cL (comb2 $1 $2) (ecHsDo (mapLoc snd $2))) (mj AnnDo $1:(fst $ unLoc $2)) } - | 'mdo' stmtlist {% $2 >>= \ $2 -> + | 'mdo' stmtlist {% runPV $2 >>= \ $2 -> fmap ecFromExp $ ams (cL (comb2 $1 $2) (mkHsDo MDoExpr (snd $ unLoc $2))) @@ -2788,7 +2788,7 @@ aexp2 :: { ExpCmdP } -- correct Haskell (you'd have to write '((+ 3), (4 -))') -- but the less cluttered version fell out of having texps. | '(' texp ')' { ExpCmdP $ - runExpCmdP $2 >>= \ $2 -> + runExpCmdPV $2 >>= \ $2 -> ams (sLL $1 $> (ecHsPar $2)) [mop $1,mcp $3] } | '(' tup_exprs ')' {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2) ; fmap ecFromExp $ @@ -3022,12 +3022,12 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau amsL (comb2 $1 $>) (fst $ unLoc $3) >> return (sLL $1 $> [sLL $1 $> ((snd $ unLoc $3) (reverse (unLoc $1)))]) } | squals ',' qual - {% $3 >>= \ $3 -> + {% runPV $3 >>= \ $3 -> addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >> return (sLL $1 $> ($3 : unLoc $1)) } | transformqual {% ams $1 (fst $ unLoc $1) >> return (sLL $1 $> [cL (getLoc $1) ((snd $ unLoc $1) [])]) } - | qual {% $1 >>= \ $1 -> + | qual {% runPV $1 >>= \ $1 -> return $ sL1 $1 [$1] } -- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) } -- | '{|' pquals '|}' { sL1 $1 [$2] } @@ -3068,11 +3068,11 @@ guardquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } : guardquals1 { cL (getLoc $1) (reverse (unLoc $1)) } guardquals1 :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } - : guardquals1 ',' qual {% $3 >>= \ $3 -> + : guardquals1 ',' qual {% runPV $3 >>= \ $3 -> addAnnotation (gl $ head $ unLoc $1) AnnComma (gl $2) >> return (sLL $1 $> ($3 : unLoc $1)) } - | qual {% $1 >>= \ $1 -> + | qual {% runPV $1 >>= \ $1 -> return $ sL1 $1 [$1] } ----------------------------------------------------------------------------- @@ -3126,7 +3126,7 @@ alt_rhs :: { forall b. ExpCmdI b => PV (Located ([AddAnn],GRHSs GhcPs (Located ( return $ sLL alt $> (fst $ unLoc $2, GRHSs noExt (unLoc alt) (snd $ unLoc $2)) } ralt :: { forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))]) } - : '->' exp { runExpCmdP $2 >>= \ $2 -> + : '->' exp { runExpCmdPV $2 >>= \ $2 -> ams (sLL $1 $> (unguardedRHS (comb2 $1 $2) $2)) [mu AnnRarrow $1] } | gdpats { $1 >>= \gdpats -> @@ -3142,14 +3142,14 @@ gdpats :: { forall b. ExpCmdI b => PV (Located [LGRHS GhcPs (Located (b GhcPs))] -- generate the open brace in addition to the vertical bar in the lexer, and -- we don't need it. ifgdpats :: { Located ([AddAnn],[LGRHS GhcPs (LHsExpr GhcPs)]) } - : '{' gdpats '}' {% $2 >>= \ $2 -> + : '{' gdpats '}' {% runPV $2 >>= \ $2 -> return $ sLL $1 $> ([moc $1,mcc $3],unLoc $2) } - | gdpats close {% $1 >>= \ $1 -> + | gdpats close {% runPV $1 >>= \ $1 -> return $ sL1 $1 ([],unLoc $1) } gdpat :: { forall b. ExpCmdI b => PV (LGRHS GhcPs (Located (b GhcPs))) } : '|' guardquals '->' exp - { runExpCmdP $4 >>= \ $4 -> + { runExpCmdPV $4 >>= \ $4 -> ams (sL (comb2 $1 $>) $ GRHS noExt (unLoc $2) $4) [mj AnnVbar $1,mu AnnRarrow $3] } @@ -3229,12 +3229,12 @@ stmts :: { forall b. ExpCmdI b => PV (Located ([AddAnn],[LStmt GhcPs (Located (b -- For typing stmts at the GHCi prompt, where -- the input may consist of just comments. maybe_stmt :: { Maybe (LStmt GhcPs (LHsExpr GhcPs)) } - : stmt {% fmap Just $1 } + : stmt {% fmap Just (runPV $1) } | {- nothing -} { Nothing } -- For GHC API. e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) } - : stmt {% $1 } + : stmt {% runPV $1 } stmt :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) } : qual { $1 } @@ -3243,10 +3243,10 @@ stmt :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) } (mj AnnRec $1:(fst $ unLoc $2)) } qual :: { forall b. ExpCmdI b => PV (LStmt GhcPs (Located (b GhcPs))) } - : bindpat '<-' exp { runExpCmdP $3 >>= \ $3 -> + : bindpat '<-' exp { runExpCmdPV $3 >>= \ $3 -> ams (sLL $1 $> $ mkBindStmt $1 $3) [mu AnnLarrow $2] } - | exp { runExpCmdP $1 >>= \ $1 -> + | exp { runExpCmdPV $1 >>= \ $1 -> return $ sL1 $1 $ mkBodyStmt $1 } | 'let' binds { ams (sLL $1 $> $ LetStmt noExt (snd $ unLoc $2)) (mj AnnLet $1:(fst $ unLoc $2)) } @@ -4037,7 +4037,7 @@ am a (b,s) = do -- as any annotations that may arise in the binds. This will include open -- and closing braces if they are used to delimit the let expressions. -- -ams :: Located a -> [AddAnn] -> P (Located a) +ams :: MonadP m => Located a -> [AddAnn] -> m (Located a) ams a@(dL->L l _) bs = addAnnsAt l bs >> return a amsL :: SrcSpan -> [AddAnn] -> P () |