Commit cad5d0b6 authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent 7e77f414
...@@ -179,8 +179,15 @@ is Less Cool because ...@@ -179,8 +179,15 @@ is Less Cool because
typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.) typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.)
-} -}
-- | An unbound variable; used for treating out-of-scope variables as -- | An unbound variable; used for treating
-- expression holes -- 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 data UnboundVar
= OutOfScope OccName GlobalRdrEnv -- ^ An (unqualified) out-of-scope = OutOfScope OccName GlobalRdrEnv -- ^ An (unqualified) out-of-scope
-- variable, together with the GlobalRdrEnv -- variable, together with the GlobalRdrEnv
......
...@@ -29,7 +29,7 @@ import RnUtils ( HsDocContext(..), mapFvRn, bindLocalNames ...@@ -29,7 +29,7 @@ import RnUtils ( HsDocContext(..), mapFvRn, bindLocalNames
, checkDupRdrNames, inHsDocContext, bindLocalNamesFV , checkDupRdrNames, inHsDocContext, bindLocalNamesFV
, checkShadowedRdrNames, warnUnusedTypePatterns , checkShadowedRdrNames, warnUnusedTypePatterns
, extendTyVarEnvFVRn, newLocalBndrsRn ) , extendTyVarEnvFVRn, newLocalBndrsRn )
import RnUnbound ( mkUnboundName ) import RnUnbound ( mkUnboundName, notInScopeErr )
import RnNames import RnNames
import RnHsDoc ( rnHsDoc, rnMbLHsDoc ) import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcAnnotations ( annCtxt ) import TcAnnotations ( annCtxt )
...@@ -1093,14 +1093,14 @@ badRuleVar name var ...@@ -1093,14 +1093,14 @@ badRuleVar name var
badRuleLhsErr :: FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> SDoc badRuleLhsErr :: FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> SDoc
badRuleLhsErr name lhs bad_e badRuleLhsErr name lhs bad_e
= sep [text "Rule" <+> pprRuleName name <> colon, = sep [text "Rule" <+> pprRuleName name <> colon,
nest 4 (vcat [err, nest 2 (vcat [err,
text "in left-hand side:" <+> ppr lhs])] text "in left-hand side:" <+> ppr lhs])]
$$ $$
text "LHS must be of form (f e1 .. en) where f is not forall'd" text "LHS must be of form (f e1 .. en) where f is not forall'd"
where where
err = case bad_e of err = case bad_e of
HsUnboundVar _ uv -> text "Not in scope:" <+> ppr uv HsUnboundVar _ uv -> notInScopeErr (mkRdrUnqual (unboundVarOcc uv))
_ -> text "Illegal expression:" <+> ppr bad_e _ -> text "Illegal expression:" <+> ppr bad_e
{- ************************************************************** {- **************************************************************
* * * *
......
...@@ -12,7 +12,8 @@ module RnUnbound ( mkUnboundName ...@@ -12,7 +12,8 @@ module RnUnbound ( mkUnboundName
, WhereLooking(..) , WhereLooking(..)
, unboundName , unboundName
, unboundNameX , unboundNameX
, perhapsForallMsg ) where , perhapsForallMsg
, notInScopeErr ) where
import GhcPrelude import GhcPrelude
...@@ -60,8 +61,7 @@ unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name ...@@ -60,8 +61,7 @@ unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name
unboundNameX where_look rdr_name extra unboundNameX where_look rdr_name extra
= do { dflags <- getDynFlags = do { dflags <- getDynFlags
; let show_helpful_errors = gopt Opt_HelpfulErrors dflags ; let show_helpful_errors = gopt Opt_HelpfulErrors dflags
what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) err = notInScopeErr rdr_name $$ extra
err = unknownNameErr what rdr_name $$ extra
; if not show_helpful_errors ; if not show_helpful_errors
then addErr err then addErr err
else do { local_env <- getLocalRdrEnv else do { local_env <- getLocalRdrEnv
...@@ -72,12 +72,13 @@ unboundNameX where_look rdr_name extra ...@@ -72,12 +72,13 @@ unboundNameX where_look rdr_name extra
; addErr (err $$ suggestions) } ; addErr (err $$ suggestions) }
; return (mkUnboundNameRdr rdr_name) } ; return (mkUnboundNameRdr rdr_name) }
unknownNameErr :: SDoc -> RdrName -> SDoc notInScopeErr :: RdrName -> SDoc
unknownNameErr what rdr_name notInScopeErr rdr_name
= vcat [ hang (text "Not in scope:") = vcat [ hang (text "Not in scope:")
2 (what <+> quotes (ppr rdr_name)) 2 (what <+> quotes (ppr rdr_name))
, extra ] , extra ]
where where
what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
extra | rdr_name == forall_tv_RDR = perhapsForallMsg extra | rdr_name == forall_tv_RDR = perhapsForallMsg
| otherwise = Outputable.empty | otherwise = Outputable.empty
......
module T15659 where
{-# RULES "test" forall x. f x = x #-}
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
...@@ -134,4 +134,4 @@ test('T14591', normal, compile_fail, ['']) ...@@ -134,4 +134,4 @@ test('T14591', normal, compile_fail, [''])
test('T15214', normal, compile_fail, ['']) test('T15214', normal, compile_fail, [''])
test('T15539', normal, compile_fail, ['']) test('T15539', normal, compile_fail, [''])
test('T15487', normal, multimod_compile_fail, ['T15487','-v0']) test('T15487', normal, multimod_compile_fail, ['T15487','-v0'])
test('T15659', normal, compile_fail, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment