Don't look up unnecessary return in LastStmt
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 20 Sep 2018 19:02:39 +0000 (20:02 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Sun, 23 Sep 2018 01:45:23 +0000 (02:45 +0100)
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.

compiler/hsSyn/HsExpr.hs
compiler/rename/RnExpr.hs
testsuite/tests/rename/should_fail/T15607.hs [new file with mode: 0644]
testsuite/tests/rename/should_fail/T15607.stderr [new file with mode: 0644]
testsuite/tests/rename/should_fail/all.T

index 61285ba..45b1b07 100644 (file)
@@ -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
index b9e097c..ae2bdf7 100644 (file)
@@ -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 (file)
index 0000000..a692ca5
--- /dev/null
@@ -0,0 +1,6 @@
+{-# LANGUAGE RebindableSyntax #-}\r
+module T15607 where\r
+\r
+import Prelude hiding (pure, return)\r
+\r
+t = do { pure 5 }\r
diff --git a/testsuite/tests/rename/should_fail/T15607.stderr b/testsuite/tests/rename/should_fail/T15607.stderr
new file mode 100644 (file)
index 0000000..9bc84f4
--- /dev/null
@@ -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).
index f8b950b..182dc42 100644 (file)
@@ -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, [''])