diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-09-20 19:53:56 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-09-23 02:45:23 +0100 |
commit | cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed (patch) | |
tree | e245f11c6cb56e4422a9e0875ceacd93c3ef4096 | |
parent | 7e77f41430ae1cad84d5b0c90328331d38f3eda0 (diff) | |
download | haskell-cad5d0b69bc039b635a6eb0e5c9ed47d7c5a38ed.tar.gz |
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.
-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, ['']) |