[commit: ghc] master: Buglet in reporting out of scope errors in rules (cad5d0b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed/ghc

>---------------------------------------------------------------

commit cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Sep 20 19:53:56 2018 +0100

    Buglet in reporting out of scope errors in rules
    
    Most out of scope errors get reported by the type checker these
    days, but not all.  Example, the function on the LHS of a RULE.
    
    Trace #15659 pointed out that this less-heavily-used code path
    produce a "wacky" error message.  Indeed so.  Easily fixed.


>---------------------------------------------------------------

cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed
 compiler/hsSyn/HsExpr.hs                         | 11 +++++++++--
 compiler/rename/RnSource.hs                      |  8 ++++----
 compiler/rename/RnUnbound.hs                     | 11 ++++++-----
 testsuite/tests/rename/should_fail/T15659.hs     |  5 +++++
 testsuite/tests/rename/should_fail/T15659.stderr |  6 ++++++
 testsuite/tests/rename/should_fail/all.T         |  2 +-
 6 files changed, 31 insertions(+), 12 deletions(-)

diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 6ca37e0..61285ba 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -179,8 +179,15 @@ is Less Cool because
     typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
 -}
 
--- | An unbound variable; used for treating out-of-scope variables as
--- expression holes
+-- | An unbound variable; used for treating
+-- out-of-scope variables as expression holes
+--
+-- Either "x", "y"     Plain OutOfScope
+-- or     "_", "_x"    A TrueExprHole
+--
+-- Both forms indicate an out-of-scope variable,  but the latter
+-- indicates that the user /expects/ it to be out of scope, and
+-- just wants GHC to report its type
 data UnboundVar
   = OutOfScope OccName GlobalRdrEnv  -- ^ An (unqualified) out-of-scope
                                      -- variable, together with the GlobalRdrEnv
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 00fc335..91c46b3 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -29,7 +29,7 @@ import RnUtils          ( HsDocContext(..), mapFvRn, bindLocalNames
                         , checkDupRdrNames, inHsDocContext, bindLocalNamesFV
                         , checkShadowedRdrNames, warnUnusedTypePatterns
                         , extendTyVarEnvFVRn, newLocalBndrsRn )
-import RnUnbound        ( mkUnboundName )
+import RnUnbound        ( mkUnboundName, notInScopeErr )
 import RnNames
 import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
 import TcAnnotations    ( annCtxt )
@@ -1093,14 +1093,14 @@ badRuleVar name var
 badRuleLhsErr :: FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> SDoc
 badRuleLhsErr name lhs bad_e
   = sep [text "Rule" <+> pprRuleName name <> colon,
-         nest 4 (vcat [err,
+         nest 2 (vcat [err,
                        text "in left-hand side:" <+> ppr lhs])]
     $$
     text "LHS must be of form (f e1 .. en) where f is not forall'd"
   where
     err = case bad_e of
-            HsUnboundVar _ uv -> text "Not in scope:" <+> ppr uv
-            _ -> text "Illegal expression:" <+> ppr bad_e
+            HsUnboundVar _ uv -> notInScopeErr (mkRdrUnqual (unboundVarOcc uv))
+            _                 -> text "Illegal expression:" <+> ppr bad_e
 
 {- **************************************************************
          *                                                      *
diff --git a/compiler/rename/RnUnbound.hs b/compiler/rename/RnUnbound.hs
index a77025f..ce5d0dc 100644
--- a/compiler/rename/RnUnbound.hs
+++ b/compiler/rename/RnUnbound.hs
@@ -12,7 +12,8 @@ module RnUnbound ( mkUnboundName
                  , WhereLooking(..)
                  , unboundName
                  , unboundNameX
-                 , perhapsForallMsg ) where
+                 , perhapsForallMsg
+                 , notInScopeErr ) where
 
 import GhcPrelude
 
@@ -60,8 +61,7 @@ unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name
 unboundNameX where_look rdr_name extra
   = do  { dflags <- getDynFlags
         ; let show_helpful_errors = gopt Opt_HelpfulErrors dflags
-              what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
-              err = unknownNameErr what rdr_name $$ extra
+              err = notInScopeErr rdr_name $$ extra
         ; if not show_helpful_errors
           then addErr err
           else do { local_env  <- getLocalRdrEnv
@@ -72,12 +72,13 @@ unboundNameX where_look rdr_name extra
                   ; addErr (err $$ suggestions) }
         ; return (mkUnboundNameRdr rdr_name) }
 
-unknownNameErr :: SDoc -> RdrName -> SDoc
-unknownNameErr what rdr_name
+notInScopeErr :: RdrName -> SDoc
+notInScopeErr rdr_name
   = vcat [ hang (text "Not in scope:")
               2 (what <+> quotes (ppr rdr_name))
          , extra ]
   where
+    what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
     extra | rdr_name == forall_tv_RDR = perhapsForallMsg
           | otherwise                 = Outputable.empty
 
diff --git a/testsuite/tests/rename/should_fail/T15659.hs b/testsuite/tests/rename/should_fail/T15659.hs
new file mode 100644
index 0000000..9fa516f
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T15659.hs
@@ -0,0 +1,5 @@
+module T15659 where
+
+{-# RULES "test" forall x. f x  = x #-}
+
+
diff --git a/testsuite/tests/rename/should_fail/T15659.stderr b/testsuite/tests/rename/should_fail/T15659.stderr
new file mode 100644
index 0000000..e1cbf9f
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T15659.stderr
@@ -0,0 +1,6 @@
+
+T15659.hs:3:11: error:
+    Rule "test":
+      Not in scope: ‘f’
+      in left-hand side: f x
+    LHS must be of form (f e1 .. en) where f is not forall'd
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index c69efb9..f8b950b 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -134,4 +134,4 @@ test('T14591', normal, compile_fail, [''])
 test('T15214', normal, compile_fail, [''])
 test('T15539', normal, compile_fail, [''])
 test('T15487', normal, multimod_compile_fail, ['T15487','-v0'])
-
+test('T15659', normal, compile_fail, [''])