diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/hsSyn/HsExpr.hs | 11 | ||||
| -rw-r--r-- | compiler/rename/RnSource.hs | 8 | ||||
| -rw-r--r-- | compiler/rename/RnUnbound.hs | 11 |
3 files changed, 19 insertions, 11 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 |