diff options
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 11 | ||||
| -rw-r--r-- | compiler/rename/RnSource.hs | 8 | ||||
| -rw-r--r-- | compiler/rename/RnUnbound.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/T15659.hs | 5 | ||||
| -rw-r--r-- | testsuite/tests/rename/should_fail/T15659.stderr | 6 | ||||
| -rw-r--r-- | 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 6ca37e07ce..61285ba0c6 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 00fc3351e5..91c46b3cc4 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 a77025fe7e..ce5d0dc315 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 0000000000..9fa516f2b6 --- /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 0000000000..e1cbf9f079 --- /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 c69efb9c66..f8b950b563 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, ['']) |