diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2019-03-26 20:49:26 +0300 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-04-25 14:28:56 -0400 |
| commit | f85efdec3e0580591eed0d132404a20df9a76316 (patch) | |
| tree | 2d1b185ca7f6c5bc7c4c60ac273bf773d6799afc /compiler/parser/Parser.y | |
| parent | 0fc69416f5ed7186ce68c7a758cdd4c52fbf98f6 (diff) | |
| download | haskell-f85efdec3e0580591eed0d132404a20df9a76316.tar.gz | |
checkPattern error hint is PV context
There is a hint added to error messages reported in checkPattern.
Instead of passing it manually, we put it in a ReaderT environment inside PV.
Diffstat (limited to 'compiler/parser/Parser.y')
| -rw-r--r-- | compiler/parser/Parser.y | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index aa1f2647a9..4bc3fa9ad0 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -2396,8 +2396,8 @@ decl_no_th :: { LHsDecl GhcPs } | '!' aexp rhs {% runExpCmdP $2 >>= \ $2 -> do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2) ; l = comb2 $1 $> }; - (ann, r) <- checkValDef empty SrcStrict e Nothing $3 ; - hintBangPat (comb2 $1 $2) (unLoc e) ; + (ann, r) <- checkValDef SrcStrict e Nothing $3 ; + runPV $ hintBangPat (comb2 $1 $2) (unLoc e) ; -- Depending upon what the pattern looks like we might get either -- a FunBind or PatBind back from checkValDef. See Note -- [FunBind vs PatBind] @@ -2410,7 +2410,7 @@ decl_no_th :: { LHsDecl GhcPs } _ <- amsL l (ann ++ fst (unLoc $3) ++ [mj AnnBang $1]) ; return $! (sL l $ ValD noExt r) } } - | infixexp_top opt_sig rhs {% do { (ann,r) <- checkValDef empty NoSrcStrict $1 (snd $2) $3; + | infixexp_top opt_sig rhs {% do { (ann,r) <- checkValDef NoSrcStrict $1 (snd $2) $3; let { l = comb2 $1 $> }; -- Depending upon what the pattern looks like we might get either -- a FunBind or PatBind back from checkValDef. See Note @@ -2752,7 +2752,7 @@ aexp :: { ExpCmdP } (mkHsDo MDoExpr (snd $ unLoc $2))) (mj AnnMdo $1:(fst $ unLoc $2)) } | 'proc' aexp '->' exp - {% (checkPattern empty <=< runExpCmdP) $2 >>= \ p -> + {% (checkPattern <=< runExpCmdP) $2 >>= \ p -> runExpCmdP $4 >>= \ $4@cmd -> fmap ecFromExp $ ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd)) @@ -2825,7 +2825,7 @@ aexp2 :: { ExpCmdP } (if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) } | '[t|' ktype '|]' {% fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] } - | '[p|' infixexp '|]' {% (checkPattern empty <=< runExpCmdP) $2 >>= \p -> + | '[p|' infixexp '|]' {% (checkPattern <=< runExpCmdP) $2 >>= \p -> fmap ecFromExp $ ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p)) [mo $1,mu AnnCloseQ $3] } @@ -3158,26 +3158,26 @@ gdpat :: { forall b. ExpCmdI b => PV (LGRHS GhcPs (Located (b GhcPs))) } -- Bangs inside are parsed as infix operator applications, so that -- we parse them right when bang-patterns are off pat :: { LPat GhcPs } -pat : exp {% (checkPattern empty <=< runExpCmdP) $1 } +pat : exp {% (checkPattern <=< runExpCmdP) $1 } | '!' aexp {% runExpCmdP $2 >>= \ $2 -> - amms (checkPattern empty (sLL $1 $> (SectionR noExt + amms (checkPattern (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2))) [mj AnnBang $1] } bindpat :: { LPat GhcPs } bindpat : exp {% runExpCmdP $1 >>= \ $1 -> - checkPattern - (text "Possibly caused by a missing 'do'?") $1 } + -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn + checkPattern_msg (text "Possibly caused by a missing 'do'?") $1 } | '!' aexp {% runExpCmdP $2 >>= \ $2 -> - amms (checkPattern - (text "Possibly caused by a missing 'do'?") + -- See Note [Parser-Validator ReaderT SDoc] in RdrHsSyn + amms (checkPattern_msg (text "Possibly caused by a missing 'do'?") (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2))) [mj AnnBang $1] } apat :: { LPat GhcPs } -apat : aexp {% (checkPattern empty <=< runExpCmdP) $1 } +apat : aexp {% (checkPattern <=< runExpCmdP) $1 } | '!' aexp {% runExpCmdP $2 >>= \ $2 -> - amms (checkPattern empty + amms (checkPattern (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2))) [mj AnnBang $1] } |