diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-09-20 20:02:39 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-09-23 02:45:23 +0100 |
| commit | 4bde71df9a32bf6f5ee7d44fbbf79523da4b0a9e (patch) | |
| tree | a629d95f46f0e0c80279168f855b5ac4e36d07e5 | |
| parent | cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed (diff) | |
| download | haskell-4bde71df9a32bf6f5ee7d44fbbf79523da4b0a9e.tar.gz | |
Don't look up unnecessary return in LastStmt
This fixes Trac #15607. The general pattern is well
established (e.g. see the guard_op binding in rnStmt
of BodyStme), but we weren't using it for LastStmt.
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 37 | ||||
| -rw-r--r-- | compiler/rename/RnExpr.hs | 22 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/T15607.hs | 6 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/T15607.stderr | 5 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/all.T | 1 |
5 files changed, 49 insertions, 22 deletions
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 61285ba0c6..45b1b07d73 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -1241,7 +1241,7 @@ hsExprNeedsParens p = go go (HsMultiIf{}) = p > topPrec go (HsLet{}) = p > topPrec go (HsDo _ sc _) - | isListCompExpr sc = False + | isComprehensionContext sc = False | otherwise = p > topPrec go (ExplicitList{}) = False go (RecordUpd{}) = False @@ -1855,18 +1855,17 @@ type GhciStmt id = Stmt id (LHsExpr id) -- For details on above see note [Api annotations] in ApiAnnotation data StmtLR idL idR body -- body should always be (LHs**** idR) = LastStmt -- Always the last Stmt in ListComp, MonadComp, - -- and (after the renamer) DoExpr, MDoExpr + -- and (after the renamer, see RnExpr.checkLastStmt) DoExpr, MDoExpr -- Not used for GhciStmtCtxt, PatGuard, which scope over other stuff (XLastStmt idL idR body) body Bool -- True <=> return was stripped by ApplicativeDo - (SyntaxExpr idR) -- The return operator, used only for - -- MonadComp For ListComp we - -- use the baked-in 'return' For DoExpr, - -- MDoExpr, we don't apply a 'return' at - -- all See Note [Monad Comprehensions] | - -- - 'ApiAnnotation.AnnKeywordId' : - -- 'ApiAnnotation.AnnLarrow' + (SyntaxExpr idR) -- The return operator + -- The return operator is used only for MonadComp + -- For ListComp we use the baked-in 'return' + -- For DoExpr, MDoExpr, we don't apply a 'return' at all + -- See Note [Monad Comprehensions] + -- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnLarrow' -- For details on above see note [Api annotations] in ApiAnnotation | BindStmt (XBindStmt idL idR body) -- Post typechecking, @@ -2752,13 +2751,13 @@ data HsStmtContext id deriving Functor deriving instance (Data id) => Data (HsStmtContext id) -isListCompExpr :: HsStmtContext id -> Bool --- Uses syntax [ e | quals ] -isListCompExpr ListComp = True -isListCompExpr MonadComp = True -isListCompExpr (ParStmtCtxt c) = isListCompExpr c -isListCompExpr (TransStmtCtxt c) = isListCompExpr c -isListCompExpr _ = False +isComprehensionContext :: HsStmtContext id -> Bool +-- Uses comprehension syntax [ e | quals ] +isComprehensionContext ListComp = True +isComprehensionContext MonadComp = True +isComprehensionContext (ParStmtCtxt c) = isComprehensionContext c +isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c +isComprehensionContext _ = False -- | Should pattern match failure in a 'HsStmtContext' be desugared using -- 'MonadFail'? @@ -2771,6 +2770,10 @@ isMonadFailStmtContext (ParStmtCtxt ctxt) = isMonadFailStmtContext ctxt isMonadFailStmtContext (TransStmtCtxt ctxt) = isMonadFailStmtContext ctxt isMonadFailStmtContext _ = False -- ListComp, PatGuard, ArrowExpr +isMonadCompContext :: HsStmtContext id -> Bool +isMonadCompContext MonadComp = True +isMonadCompContext _ = False + matchSeparator :: HsMatchContext id -> SDoc matchSeparator (FunRhs {}) = text "=" matchSeparator CaseAlt = text "->" @@ -2893,7 +2896,7 @@ pprStmtInCtxt :: (OutputableBndrId (GhcPass idL), -> StmtLR (GhcPass idL) (GhcPass idR) body -> SDoc pprStmtInCtxt ctxt (LastStmt _ e _ _) - | isListCompExpr ctxt -- For [ e | .. ], do not mutter about "stmts" + | isComprehensionContext ctxt -- For [ e | .. ], do not mutter about "stmts" = hang (text "In the expression:") 2 (ppr e) pprStmtInCtxt ctxt stmt diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index b9e097c4d8..ae2bdf7a2b 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -826,20 +826,29 @@ rnStmt :: Outputable (body GhcPs) rnStmt ctxt rnBody (L loc (LastStmt _ body noret _)) thing_inside = do { (body', fv_expr) <- rnBody body - ; (ret_op, fvs1) <- lookupStmtName ctxt returnMName - ; (thing, fvs3) <- thing_inside [] + ; (ret_op, fvs1) <- if isMonadCompContext ctxt + then lookupStmtName ctxt returnMName + else return (noSyntaxExpr, emptyFVs) + -- The 'return' in a LastStmt is used only + -- for MonadComp; and we don't want to report + -- "non in scope: return" in other cases + -- Trac #15607 + + ; (thing, fvs3) <- thing_inside [] ; return (([(L loc (LastStmt noExt body' noret ret_op), fv_expr)] , thing), fv_expr `plusFV` fvs1 `plusFV` fvs3) } rnStmt ctxt rnBody (L loc (BodyStmt _ body _ _)) thing_inside = do { (body', fv_expr) <- rnBody body ; (then_op, fvs1) <- lookupStmtName ctxt thenMName - ; (guard_op, fvs2) <- if isListCompExpr ctxt + + ; (guard_op, fvs2) <- if isComprehensionContext ctxt then lookupStmtName ctxt guardMName else return (noSyntaxExpr, emptyFVs) -- Only list/monad comprehensions use 'guard' -- Also for sub-stmts of same eg [ e | x<-xs, gd | blah ] -- Here "gd" is a guard + ; (thing, fvs3) <- thing_inside [] ; return ( ([(L loc (BodyStmt noExt body' then_op guard_op), fv_expr)] , thing), fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) } @@ -854,14 +863,17 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body _ _)) thing_inside -- If the pattern is irrefutable (e.g.: wildcard, tuple, -- ~pat, etc.) we should not need to fail. | isIrrefutableHsPat pat - = return (noSyntaxExpr, emptyFVs) + = return (noSyntaxExpr, emptyFVs) + -- For non-monadic contexts (e.g. guard patterns, list -- comprehensions, etc.) we should not need to fail. -- See Note [Failing pattern matches in Stmts] | not (isMonadFailStmtContext ctxt) - = return (noSyntaxExpr, emptyFVs) + = return (noSyntaxExpr, emptyFVs) + | xMonadFailEnabled = lookupSyntaxName failMName | otherwise = lookupSyntaxName failMName_preMFP + ; (fail_op, fvs2) <- getFailFunction ; rnPat (StmtCtxt ctxt) pat $ \ pat' -> do diff --git a/testsuite/tests/rename/should_fail/T15607.hs b/testsuite/tests/rename/should_fail/T15607.hs new file mode 100644 index 0000000000..a692ca5580 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15607.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE RebindableSyntax #-}
+module T15607 where
+
+import Prelude hiding (pure, return)
+
+t = do { pure 5 }
diff --git a/testsuite/tests/rename/should_fail/T15607.stderr b/testsuite/tests/rename/should_fail/T15607.stderr new file mode 100644 index 0000000000..9bc84f42f7 --- /dev/null +++ b/testsuite/tests/rename/should_fail/T15607.stderr @@ -0,0 +1,5 @@ + +T15607.hs:6:10: error: + • Variable not in scope: pure :: Integer -> t + • Perhaps you want to remove ‘pure’ from the explicit hiding list + in the import of ‘Prelude’ (T15607.hs:4:1-36). diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T index f8b950b563..182dc421fb 100644 --- a/testsuite/tests/rename/should_fail/all.T +++ b/testsuite/tests/rename/should_fail/all.T @@ -135,3 +135,4 @@ test('T15214', normal, compile_fail, ['']) test('T15539', normal, compile_fail, ['']) test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) test('T15659', normal, compile_fail, ['']) +test('T15607', normal, compile_fail, ['']) |
