diff options
author | Jason Eisenberg <jasoneisenberg@gmail.com> | 2016-04-10 19:17:46 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-04-10 22:58:28 +0200 |
commit | 470d4d5b8e7cbcc176b1f3ac26ce0d95acd35a78 (patch) | |
tree | 536e3f294da6c76878c1997d28508402b0b4c9cc /compiler | |
parent | 5a1add134fdb2ab4d91b0f66de1dc89f0cd69354 (diff) | |
download | haskell-470d4d5b8e7cbcc176b1f3ac26ce0d95acd35a78.tar.gz |
Fix suggestions for unbound variables (#11680)
When the typechecker generates the error message for an out-of-scope
variable, it now uses the GlobalRdrEnv with respect to which the
variable is unbound, not the GlobalRdrEnv which is available at the time
the error is reported. Doing so ensures we do not provide suggestions
which themselves are out-of-scope (because they are bound in a later
inter-splice group).
Nonetheless, we do note in the error message if an unambiguous, exact
match to the out-of-scope variable is found in a later inter-splice
group, and we specify where that match is not in scope.
Test Plan: ./validate
Reviewers: goldfire, austin, bgamari
Reviewed By: goldfire
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2000
GHC Trac Issues: #11680
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/basicTypes/OccName.hs | 1 | ||||
-rw-r--r-- | compiler/basicTypes/RdrName.hs | 10 | ||||
-rw-r--r-- | compiler/deSugar/DsMeta.hs | 4 | ||||
-rw-r--r-- | compiler/hsSyn/HsExpr.hs | 105 | ||||
-rw-r--r-- | compiler/rename/RnExpr.hs | 8 | ||||
-rw-r--r-- | compiler/rename/RnSource.hs | 2 | ||||
-rw-r--r-- | compiler/rename/RnTypes.hs | 6 | ||||
-rw-r--r-- | compiler/typecheck/TcCanonical.hs | 12 | ||||
-rw-r--r-- | compiler/typecheck/TcErrors.hs | 209 | ||||
-rw-r--r-- | compiler/typecheck/TcExpr.hs | 10 | ||||
-rw-r--r-- | compiler/typecheck/TcHsSyn.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 9 | ||||
-rw-r--r-- | compiler/typecheck/TcRnMonad.hs | 24 | ||||
-rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 56 |
14 files changed, 374 insertions, 85 deletions
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs index a45cc960ac..74bd96bfec 100644 --- a/compiler/basicTypes/OccName.hs +++ b/compiler/basicTypes/OccName.hs @@ -386,6 +386,7 @@ instance Uniquable OccName where getUnique (OccName TcClsName fs) = mkTcOccUnique fs newtype OccEnv a = A (UniqFM a) + deriving (Data, Typeable) emptyOccEnv :: OccEnv a unitOccEnv :: OccName -> a -> OccEnv a diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 62f473ee18..fec54119de 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -430,7 +430,8 @@ data GlobalRdrElt , gre_par :: Parent , gre_lcl :: Bool -- ^ True <=> the thing was defined locally , gre_imp :: [ImportSpec] -- ^ In scope through these imports - } -- INVARIANT: either gre_lcl = True or gre_imp is non-empty + } deriving (Data, Typeable) + -- INVARIANT: either gre_lcl = True or gre_imp is non-empty -- See Note [GlobalRdrElt provenance] -- | The children of a Name are the things that are abbreviated by the ".." @@ -440,7 +441,7 @@ data Parent = NoParent | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString } -- ^ See Note [Parents for record fields] | PatternSynonym - deriving (Eq) + deriving (Eq, Data, Typeable) instance Outputable Parent where ppr NoParent = empty @@ -1001,7 +1002,7 @@ shadowName env name -- It's quite elaborate so that we can give accurate unused-name warnings. data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec, is_item :: ImpItemSpec } - deriving( Eq, Ord ) + deriving( Eq, Ord, Data, Typeable ) -- | Describes a particular import declaration and is -- shared among all the 'Provenance's for that decl @@ -1016,7 +1017,7 @@ data ImpDeclSpec is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause) is_qual :: Bool, -- ^ Was this import qualified? is_dloc :: SrcSpan -- ^ The location of the entire import declaration - } + } deriving (Data, Typeable) -- | Describes import info a particular Name data ImpItemSpec @@ -1035,6 +1036,7 @@ data ImpItemSpec -- -- Here the constructors of @T@ are not named explicitly; -- only @T@ is named explicitly. + deriving (Data, Typeable) instance Eq ImpDeclSpec where p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index 84f1a9ca58..b14c0a4bf5 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -1179,8 +1179,8 @@ repE (ArithSeq _ _ aseq) = repE (HsSpliceE splice) = repSplice splice repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC -repE (HsUnboundVar name) = do - occ <- occNameLit name +repE (HsUnboundVar uv) = do + occ <- occNameLit (unboundVarOcc uv) sname <- repNameS occ repUnboundVar sname diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs index 05f1ac8ce1..b6c5bdde92 100644 --- a/compiler/hsSyn/HsExpr.hs +++ b/compiler/hsSyn/HsExpr.hs @@ -30,6 +30,7 @@ import CoreSyn import Var import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) ) import Name +import RdrName ( GlobalRdrEnv ) import BasicTypes import ConLike import SrcLoc @@ -166,17 +167,109 @@ 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 +data UnboundVar + = OutOfScope OccName GlobalRdrEnv -- ^ An (unqualified) out-of-scope + -- variable, together with the GlobalRdrEnv + -- with respect to which it is unbound + + -- See Note [OutOfScope and GlobalRdrEnv] + + | TrueExprHole OccName -- ^ A "true" expression hole (_ or _x) + + deriving (Data, Typeable) + +instance Outputable UnboundVar where + ppr = ppr . unboundVarOcc + +unboundVarOcc :: UnboundVar -> OccName +unboundVarOcc (OutOfScope occ _) = occ +unboundVarOcc (TrueExprHole occ) = occ + +{- +Note [OutOfScope and GlobalRdrEnv] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To understand why we bundle a GlobalRdrEnv with an out-of-scope variable, +consider the following module: + + module A where + + foo :: () + foo = bar + + bat :: [Double] + bat = [1.2, 3.4] + + $(return []) + + bar = () + bad = False + +When A is compiled, the renamer determines that `bar` is not in scope in the +declaration of `foo` (since `bar` is declared in the following inter-splice +group). Once it has finished typechecking the entire module, the typechecker +then generates the associated error message, which specifies both the type of +`bar` and a list of possible in-scope alternatives: + + A.hs:6:7: error: + • Variable not in scope: bar :: () + • ‘bar’ (line 13) is not in scope before the splice on line 11 + Perhaps you meant ‘bat’ (line 9) + +When it calls RnEnv.unknownNameSuggestions to identify these alternatives, the +typechecker must provide a GlobalRdrEnv. If it provided the current one, which +contains top-level declarations for the entire module, the error message would +incorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives +for `bar` (see Trac #11680). Instead, the typechecker must use the same +GlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope. + +To obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope +`bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to +look it up in some global store? Unfortunately, no. The problem is that +location information is not always sufficient for this task. This is most +apparent when dealing with the TH function addTopDecls, which adds its +declarations to the FOLLOWING inter-splice group. Consider these declarations: + + ex9 = cat -- cat is NOT in scope here + + $(do ------------------------------------------------------------- + ds <- [d| f = cab -- cat and cap are both in scope here + cat = () + |] + addTopDecls ds + [d| g = cab -- only cap is in scope here + cap = True + |]) + + ex10 = cat -- cat is NOT in scope here + + $(return []) ----------------------------------------------------- + + ex11 = cat -- cat is in scope + +Here, both occurrences of `cab` are out-of-scope, and so the typechecker needs +the GlobalRdrEnvs which were used when they were renamed. These GlobalRdrEnvs +are different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the +locations of the two `cab`s are the same (they are both created in the same +splice). Thus, we must include some additional information with each `cab` to +allow the typechecker to obtain the correct GlobalRdrEnv. Clearly, the simplest +information to use is the GlobalRdrEnv itself. +-} + -- | A Haskell expression. data HsExpr id = HsVar (Located id) -- ^ Variable -- See Note [Located RdrNames] - | HsUnboundVar OccName -- ^ Unbound variable; also used for "holes" _, or _x. - -- Turned from HsVar to HsUnboundVar by the renamer, when - -- it finds an out-of-scope variable - -- Turned into HsVar by type checker, to support deferred - -- type errors. (The HsUnboundVar only has an OccName.) + | HsUnboundVar UnboundVar -- ^ Unbound variable; also used for "holes" + -- (_ or _x). + -- Turned from HsVar to HsUnboundVar by the + -- renamer, when it finds an out-of-scope + -- variable or hole. + -- Turned into HsVar by type checker, to support + -- deferred type errors. | HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector @@ -684,7 +777,7 @@ ppr_lexpr e = ppr_expr (unLoc e) ppr_expr :: forall id. OutputableBndr id => HsExpr id -> SDoc ppr_expr (HsVar (L _ v)) = pprPrefixOcc v -ppr_expr (HsUnboundVar v) = pprPrefixOcc v +ppr_expr (HsUnboundVar uv)= pprPrefixOcc (unboundVarOcc uv) ppr_expr (HsIPVar v) = ppr v ppr_expr (HsOverLabel l) = char '#' <> ppr l ppr_expr (HsLit lit) = ppr lit diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs index 86bd178c70..2ee2911601 100644 --- a/compiler/rename/RnExpr.hs +++ b/compiler/rename/RnExpr.hs @@ -93,7 +93,11 @@ rnUnboundVar v then -- Treat this as a "hole" -- Do not fail right now; instead, return HsUnboundVar -- and let the type checker report the error - return (HsUnboundVar (rdrNameOcc v), emptyFVs) + do { let occ = rdrNameOcc v + ; uv <- if startsWithUnderscore occ + then return (TrueExprHole occ) + else OutOfScope occ <$> getGlobalRdrEnv + ; return (HsUnboundVar uv, emptyFVs) } else -- Fail immediately (qualified name) do { n <- reportUnboundName v @@ -403,7 +407,7 @@ rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other) -- HsWrap hsHoleExpr :: HsExpr id -hsHoleExpr = HsUnboundVar (mkVarOcc "_") +hsHoleExpr = HsUnboundVar (TrueExprHole (mkVarOcc "_")) arrowFail :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) arrowFail e diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs index 03d65ef11c..89880422ea 100644 --- a/compiler/rename/RnSource.hs +++ b/compiler/rename/RnSource.hs @@ -1061,7 +1061,7 @@ badRuleLhsErr name lhs bad_e text "LHS must be of form (f e1 .. en) where f is not forall'd" where err = case bad_e of - HsUnboundVar occ -> text "Not in scope:" <+> ppr occ + HsUnboundVar uv -> text "Not in scope:" <+> ppr uv _ -> text "Illegal expression:" <+> ppr bad_e {- diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs index 7a9f75d7aa..fc8dfa6724 100644 --- a/compiler/rename/RnTypes.hs +++ b/compiler/rename/RnTypes.hs @@ -1220,9 +1220,9 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment get_op :: LHsExpr Name -> Name -- An unbound name could be either HsVar or HsUnboundVar -- See RnExpr.rnUnboundVar -get_op (L _ (HsVar (L _ n))) = n -get_op (L _ (HsUnboundVar occ)) = mkUnboundName occ -get_op other = pprPanic "get_op" (ppr other) +get_op (L _ (HsVar (L _ n))) = n +get_op (L _ (HsUnboundVar uv)) = mkUnboundName (unboundVarOcc uv) +get_op other = pprPanic "get_op" (ppr other) -- Parser left-associates everything, but -- derived instances may have correctly-associated things to diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index db69e7ba57..4bbf2e0a10 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -23,7 +23,6 @@ import FamInstEnv ( FamInstEnvs ) import FamInst ( tcTopNormaliseNewTypeTF_maybe ) import Var import Name( isSystemName ) -import OccName( OccName ) import Outputable import DynFlags( DynFlags ) import VarSet @@ -164,8 +163,8 @@ canonicalize (CFunEqCan { cc_ev = ev canonicalize (CIrredEvCan { cc_ev = ev }) = canIrred ev -canonicalize (CHoleCan { cc_ev = ev, cc_occ = occ, cc_hole = hole }) - = canHole ev occ hole +canonicalize (CHoleCan { cc_ev = ev, cc_hole = hole }) + = canHole ev hole canEvNC :: CtEvidence -> TcS (StopOrContinue Ct) -- Called only for non-canonical EvVars @@ -487,14 +486,13 @@ canIrred old_ev _ -> continueWith $ CIrredEvCan { cc_ev = new_ev } } } -canHole :: CtEvidence -> OccName -> HoleSort -> TcS (StopOrContinue Ct) -canHole ev occ hole_sort +canHole :: CtEvidence -> Hole -> TcS (StopOrContinue Ct) +canHole ev hole = do { let ty = ctEvPred ev ; (xi,co) <- flatten FM_SubstOnly ev ty -- co :: xi ~ ty ; rewriteEvidence ev xi co `andWhenContinue` \ new_ev -> do { emitInsoluble (CHoleCan { cc_ev = new_ev - , cc_occ = occ - , cc_hole = hole_sort }) + , cc_hole = hole }) ; stopWith new_ev "Emit insoluble hole" } } {- diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index b344333f62..ba079ddcf0 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -27,9 +27,11 @@ import TyCon import Class import DataCon import TcEvidence +import HsExpr ( UnboundVar(..) ) import HsBinds ( PatSynBind(..) ) import Name -import RdrName ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual ) +import RdrName ( lookupGlobalRdrEnv, lookupGRE_Name, GlobalRdrEnv + , mkRdrUnqual, isLocalGRE, greSrcSpan ) import PrelNames ( typeableClassName, hasKey, ptrRepLiftedDataConKey , ptrRepUnliftedDataConKey ) import Id @@ -53,6 +55,7 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad ( when ) import Data.List ( partition, mapAccumL, nub, sortBy ) +import qualified Data.Set as Set #if __GLASGOW_HASKELL__ > 710 import Data.Semigroup ( Semigroup ) @@ -849,45 +852,89 @@ mkIrredErr ctxt cts ---------------- mkHoleError :: ReportErrCtxt -> Ct -> TcM ErrMsg -mkHoleError ctxt ct@(CHoleCan { cc_occ = occ, cc_hole = hole_sort }) - | isOutOfScopeCt ct -- Out of scope variables, like 'a', where 'a' isn't bound - -- Suggest possible in-scope variables in the message - = do { dflags <- getDynFlags - ; rdr_env <- getGlobalRdrEnv - ; impInfo <- getImports - ; mkErrDocAt (RealSrcSpan (tcl_loc lcl_env)) $ - errDoc [out_of_scope_msg] [] - [unknownNameSuggestions dflags rdr_env - (tcl_rdr lcl_env) impInfo (mkRdrUnqual occ)] } - - | otherwise -- Explicit holes, like "_" or "_f" - = do { (ctxt, binds_msg, ct) <- relevantBindings False ctxt ct - -- The 'False' means "don't filter the bindings"; see Trac #8191 - ; mkErrorMsgFromCt ctxt ct $ - important hole_msg `mappend` relevant_bindings binds_msg } +mkHoleError _ctxt ct@(CHoleCan { cc_hole = ExprHole (OutOfScope occ rdr_env0) }) + -- Out-of-scope variables, like 'a', where 'a' isn't bound; suggest possible + -- in-scope variables in the message, and note inaccessible exact matches + = do { dflags <- getDynFlags + ; imp_info <- getImports + ; let suggs_msg = unknownNameSuggestions dflags rdr_env0 + (tcl_rdr lcl_env) imp_info rdr + ; rdr_env <- getGlobalRdrEnv + ; splice_locs <- getTopLevelSpliceLocs + ; let match_msgs = mk_match_msgs rdr_env splice_locs + ; mkErrDocAt (RealSrcSpan err_loc) $ + errDoc [out_of_scope_msg] [] (match_msgs ++ [suggs_msg]) } where + rdr = mkRdrUnqual occ ct_loc = ctLoc ct lcl_env = ctLocEnv ct_loc + err_loc = tcl_loc lcl_env hole_ty = ctEvPred (ctEvidence ct) - tyvars = tyCoVarsOfTypeList hole_ty boring_type = isTyVarTy hole_ty out_of_scope_msg -- Print v :: ty only if the type has structure | boring_type = hang herald 2 (ppr occ) - | otherwise = hang herald 2 pp_with_type + | otherwise = hang herald 2 (pp_with_type occ hole_ty) - pp_with_type = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType hole_ty) herald | isDataOcc occ = text "Data constructor not in scope:" | otherwise = text "Variable not in scope:" - hole_msg = case hole_sort of - ExprHole -> vcat [ hang (text "Found hole:") - 2 pp_with_type - , tyvars_msg, expr_hole_hint ] - TypeHole -> vcat [ hang (text "Found type wildcard" <+> quotes (ppr occ)) - 2 (text "standing for" <+> quotes (pprType hole_ty)) - , tyvars_msg, type_hole_hint ] + -- Indicate if the out-of-scope variable exactly (and unambiguously) matches + -- a top-level binding in a later inter-splice group; see Note [OutOfScope + -- exact matches] + mk_match_msgs rdr_env splice_locs + = let gres = filter isLocalGRE (lookupGlobalRdrEnv rdr_env occ) + in case gres of + [gre] + | RealSrcSpan bind_loc <- greSrcSpan gre + -- Find splice between the unbound variable and the match; use + -- lookupLE, not lookupLT, since match could be in the splice + , Just th_loc <- Set.lookupLE bind_loc splice_locs + , err_loc < th_loc + -> [mk_bind_scope_msg bind_loc th_loc] + _ -> [] + + mk_bind_scope_msg bind_loc th_loc + | is_th_bind + = hang (quotes (ppr occ) <+> parens (text "splice on" <+> th_rng)) + 2 (text "is not in scope before line" <+> int th_start_ln) + | otherwise + = hang (quotes (ppr occ) <+> bind_rng <+> text "is not in scope") + 2 (text "before the splice on" <+> th_rng) + where + bind_rng = parens (text "line" <+> int bind_ln) + th_rng + | th_start_ln == th_end_ln = single + | otherwise = multi + single = text "line" <+> int th_start_ln + multi = text "lines" <+> int th_start_ln <> text "-" <> int th_end_ln + bind_ln = srcSpanStartLine bind_loc + th_start_ln = srcSpanStartLine th_loc + th_end_ln = srcSpanEndLine th_loc + is_th_bind = th_loc `containsSpan` bind_loc + +mkHoleError ctxt ct@(CHoleCan { cc_hole = hole }) + -- Explicit holes, like "_" or "_f" + = do { (ctxt, binds_msg, ct) <- relevantBindings False ctxt ct + -- The 'False' means "don't filter the bindings"; see Trac #8191 + ; mkErrorMsgFromCt ctxt ct $ + important hole_msg `mappend` relevant_bindings binds_msg } + + where + occ = holeOcc hole + hole_ty = ctEvPred (ctEvidence ct) + tyvars = tyCoVarsOfTypeList hole_ty + + hole_msg = case hole of + ExprHole {} -> vcat [ hang (text "Found hole:") + 2 (pp_with_type occ hole_ty) + , tyvars_msg, expr_hole_hint ] + TypeHole {} -> vcat [ hang (text "Found type wildcard" <+> + quotes (ppr occ)) + 2 (text "standing for" <+> + quotes (pprType hole_ty)) + , tyvars_msg, type_hole_hint ] tyvars_msg = ppUnless (null tyvars) $ text "Where:" <+> vcat (map loc_msg tyvars) @@ -919,6 +966,9 @@ mkHoleError ctxt ct@(CHoleCan { cc_occ = occ, cc_hole = hole_sort }) mkHoleError _ ct = pprPanic "mkHoleError" (ppr ct) +pp_with_type :: OccName -> Type -> SDoc +pp_with_type occ ty = hang (pprPrefixOcc occ) 2 (dcolon <+> pprType ty) + ---------------- mkIPErr :: ReportErrCtxt -> [Ct] -> TcM ErrMsg mkIPErr ctxt cts @@ -939,6 +989,111 @@ mkIPErr ctxt cts (ct1:_) = cts {- +Note [OutOfScope exact matches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When constructing an out-of-scope error message, we not only generate a list of +possible in-scope alternatives but also search for an exact, unambiguous match +in a later inter-splice group. If we find such a match, we report its presence +(and indirectly, its scope) in the message. For example, if a module A contains +the following declarations, + + foo :: Int + foo = x + + $(return []) -- Empty top-level splice + + x :: Int + x = 23 + +we will issue an error similar to + + A.hs:6:7: error: + • Variable not in scope: x :: Int + • ‘x’ (line 11) is not in scope before the splice on line 8 + +By providing information about the match, we hope to clarify why declaring a +variable after a top-level splice but using it before the splice generates an +out-of-scope error (a situation which is often confusing to Haskell newcomers). + +Note that if we find multiple exact matches to the out-of-scope variable +(hereafter referred to as x), we report nothing. Such matches can only be +duplicate record fields, as the presence of any other duplicate top-level +declarations would have already halted compilation. But if these record fields +are declared in a later inter-splice group, then so too are their corresponding +types. Thus, these types must not occur in the inter-splice group containing x +(any unknown types would have already been reported), and so the matches to the +record fields are most likely coincidental. + +One oddity of the exact match portion of the error message is that we specify +where the match to x is NOT in scope. Why not simply state where the match IS +in scope? It most cases, this would be just as easy and perhaps a little +clearer for the user. But now consider the following example: + + {-# LANGUAGE TemplateHaskell #-} + + module A where + + import Language.Haskell.TH + import Language.Haskell.TH.Syntax + + foo = x + + $(do ------------------------------------------------- + ds <- [d| ok1 = x + |] + addTopDecls ds + return []) + + bar = $(do + ds <- [d| x = 23 + ok2 = x + |] + addTopDecls ds + litE $ stringL "hello") + + $(return []) ----------------------------------------- + + ok3 = x + +Here, x is out-of-scope in the declaration of foo, and so we report + + A.hs:8:7: error: + • Variable not in scope: x + • ‘x’ (line 16) is not in scope before the splice on lines 10-14 + +If we instead reported where x IS in scope, we would have to state that it is in +scope after the second top-level splice as well as among all the top-level +declarations added by both calls to addTopDecls. But doing so would not only +add complexity to the code but also overwhelm the user with unneeded +information. + +The logic which determines where x is not in scope is straightforward: it simply +finds the last top-level splice which occurs after x but before (or at) the +match to x (assuming such a splice exists). In most cases, the check that the +splice occurs after x acts only as a sanity check. For example, when the match +to x is a non-TH top-level declaration and a splice S occurs before the match, +then x must precede S; otherwise, it would be in scope. But when dealing with +addTopDecls, this check serves a practical purpose. Consider the following +declarations: + + $(do + ds <- [d| ok = x + x = 23 + |] + addTopDecls ds + return []) + + foo = x + +In this case, x is not in scope in the declaration for foo. Since x occurs +AFTER the splice containing the match, the logic does not find any splices after +x but before or at its match, and so we report nothing about x's scope. If we +had not checked whether x occurs before the splice, we would have instead +reported that x is not in scope before the splice. While correct, such an error +message is more likely to confuse than to enlighten. +-} + +{- ************************************************************************ * * Equality errors diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index a65e60f0f4..79fd25033d 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -162,7 +162,7 @@ NB: The res_ty is always deeply skolemised. tcExpr :: HsExpr Name -> ExpRhoType -> TcM (HsExpr TcId) tcExpr (HsVar (L _ name)) res_ty = tcCheckId name res_ty -tcExpr (HsUnboundVar v) res_ty = tcUnboundId v res_ty +tcExpr (HsUnboundVar uv) res_ty = tcUnboundId uv res_ty tcExpr e@(HsApp {}) res_ty = tcApp1 e res_ty tcExpr e@(HsAppType {}) res_ty = tcApp1 e res_ty @@ -1594,7 +1594,7 @@ tc_infer_id lbl id_name | otherwise = return () -tcUnboundId :: OccName -> ExpRhoType -> TcM (HsExpr TcId) +tcUnboundId :: UnboundVar -> ExpRhoType -> TcM (HsExpr TcId) -- Typechedk an occurrence of an unbound Id -- -- Some of these started life as a true hole "_". Others might simply @@ -1603,16 +1603,16 @@ tcUnboundId :: OccName -> ExpRhoType -> TcM (HsExpr TcId) -- We turn all of them into HsVar, since HsUnboundVar can't contain an -- Id; and indeed the evidence for the CHoleCan does bind it, so it's -- not unbound any more! -tcUnboundId occ res_ty +tcUnboundId unbound res_ty = do { ty <- newFlexiTyVarTy liftedTypeKind + ; let occ = unboundVarOcc unbound ; name <- newSysName occ ; let ev = mkLocalId name ty ; loc <- getCtLocM HoleOrigin Nothing ; let can = CHoleCan { cc_ev = CtWanted { ctev_pred = ty , ctev_dest = EvVarDest ev , ctev_loc = loc} - , cc_occ = occ - , cc_hole = ExprHole } + , cc_hole = ExprHole unbound } ; emitInsoluble can ; tcWrapResultO (UnboundOccurrenceOf occ) (HsVar (noLoc ev)) ty res_ty } diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 5d78adb88d..b740e9da9e 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -798,8 +798,7 @@ zonkExpr env (HsWrap co_fn expr) new_expr <- zonkExpr env1 expr return (HsWrap new_co_fn new_expr) -zonkExpr _ (HsUnboundVar v) - = return (HsUnboundVar v) +zonkExpr _ e@(HsUnboundVar {}) = return e zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr) diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 00f1960818..c166ab798e 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -610,9 +610,12 @@ tc_rn_src_decls ds } #else -- If there's a splice, we must carry on - ; Just (SpliceDecl (L _ splice) _, rest_ds) -> - do { -- Rename the splice expression, and get its supporting decls - (spliced_decls, splice_fvs) <- checkNoErrs (rnTopSpliceDecls splice) + ; Just (SpliceDecl (L loc splice) _, rest_ds) -> + do { recordTopLevelSpliceLoc loc + + -- Rename the splice expression, and get its supporting decls + ; (spliced_decls, splice_fvs) <- checkNoErrs (rnTopSpliceDecls + splice) -- Glue them on the front of the remaining decls and loop ; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $ diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 77ad2ac071..5a6ff4363e 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -56,6 +56,8 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Exception import Data.IORef import Control.Monad +import Data.Set ( Set ) +import qualified Data.Set as Set #ifdef GHCI import qualified Data.Map as Map @@ -87,6 +89,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this used_gre_var <- newIORef [] ; th_var <- newIORef False ; th_splice_var<- newIORef False ; + th_locs_var <- newIORef Set.empty ; infer_var <- newIORef (True, emptyBag) ; lie_var <- newIORef emptyWC ; dfun_n_var <- newIORef emptyOccSet ; @@ -137,6 +140,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_ann_env = emptyAnnEnv, tcg_th_used = th_var, tcg_th_splice_used = th_splice_var, + tcg_th_top_level_locs + = th_locs_var, tcg_exports = [], tcg_imports = emptyImportAvails, tcg_used_gres = used_gre_var, @@ -1345,8 +1350,7 @@ emitWildCardHoleConstraints wcs ty = mkTyVarTy tv can = CHoleCan { cc_ev = CtDerived { ctev_pred = ty , ctev_loc = ctLoc' } - , cc_occ = occName name - , cc_hole = TypeHole } + , cc_hole = TypeHole (occName name) } ; emitInsoluble can } } {- @@ -1363,6 +1367,22 @@ recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True } recordThSpliceUse :: TcM () recordThSpliceUse = do { env <- getGblEnv; writeTcRef (tcg_th_splice_used env) True } +-- | When generating an out-of-scope error message for a variable matching a +-- binding in a later inter-splice group, the typechecker uses the splice +-- locations to provide details in the message about the scope of that binding. +recordTopLevelSpliceLoc :: SrcSpan -> TcM () +recordTopLevelSpliceLoc (RealSrcSpan real_loc) + = do { env <- getGblEnv + ; let locs_var = tcg_th_top_level_locs env + ; locs0 <- readTcRef locs_var + ; writeTcRef locs_var (Set.insert real_loc locs0) } +recordTopLevelSpliceLoc (UnhelpfulSpan _) = return () + +getTopLevelSpliceLocs :: TcM (Set RealSrcSpan) +getTopLevelSpliceLocs + = do { env <- getGblEnv + ; readTcRef (tcg_th_top_level_locs env) } + keepAlive :: Name -> TcRn () -- Record the name in the keep-alive set keepAlive name = do { env <- getGblEnv diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index 056848ab4c..f14ddf70bc 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -123,7 +123,8 @@ module TcRnTypes( pprEvVars, pprEvVarWithType, -- Misc other types - TcId, TcIdSet, HoleSort(..) + TcId, TcIdSet, + Hole(..), holeOcc ) where @@ -175,6 +176,7 @@ import Control.Monad (ap, liftM, msum) #if __GLASGOW_HASKELL__ > 710 import qualified Control.Monad.Fail as MonadFail #endif +import Data.Set ( Set ) #ifdef GHCI import Data.Map ( Map ) @@ -466,6 +468,10 @@ data TcGblEnv -- -- Splices disable recompilation avoidance (see #481) + tcg_th_top_level_locs :: TcRef (Set RealSrcSpan), + -- ^ Locations of the top-level splices; used for providing details on + -- scope in error messages for out-of-scope variables + tcg_dfun_n :: TcRef OccSet, -- ^ Allows us to choose unique DFun names. @@ -1438,13 +1444,19 @@ data Ct -- Treated as an "insoluble" constraint -- See Note [Insoluble constraints] cc_ev :: CtEvidence, - cc_occ :: OccName, -- The name of this hole - cc_hole :: HoleSort -- The sort of this hole (expr, type, ...) + cc_hole :: Hole } --- | Used to indicate which sort of hole we have. -data HoleSort = ExprHole -- ^ A hole in an expression (TypedHoles) - | TypeHole -- ^ A hole in a type (PartialTypeSignatures) +-- | An expression or type hole +data Hole = ExprHole UnboundVar + -- ^ Either an out-of-scope variable or a "true" hole in an + -- expression (TypedHoles) + | TypeHole OccName + -- ^ A hole in a type (PartialTypeSignatures) + +holeOcc :: Hole -> OccName +holeOcc (ExprHole uv) = unboundVarOcc uv +holeOcc (TypeHole occ) = occ {- Note [Hole constraints] @@ -1452,7 +1464,7 @@ Note [Hole constraints] CHoleCan constraints are used for two kinds of holes, distinguished by cc_hole: - * For holes in expressions + * For holes in expressions (including variables not in scope) e.g. f x = g _ x * For holes in type signatures @@ -1550,7 +1562,7 @@ instance Outputable Ct where | pend_sc -> text "CDictCan(psc)" | otherwise -> text "CDictCan" CIrredEvCan {} -> text "CIrredEvCan" - CHoleCan { cc_occ = occ } -> text "CHoleCan:" <+> ppr occ + CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr (holeOcc hole) {- ************************************************************************ @@ -1741,18 +1753,17 @@ isHoleCt (CHoleCan {}) = True isHoleCt _ = False isOutOfScopeCt :: Ct -> Bool --- A Hole that does not have a leading underscore is --- simply an out-of-scope variable, and we treat that --- a bit differently when it comes to error reporting -isOutOfScopeCt (CHoleCan { cc_occ = occ }) = not (startsWithUnderscore occ) +-- We treat expression holes representing out-of-scope variables a bit +-- differently when it comes to error reporting +isOutOfScopeCt (CHoleCan { cc_hole = ExprHole (OutOfScope {}) }) = True isOutOfScopeCt _ = False isExprHoleCt :: Ct -> Bool -isExprHoleCt (CHoleCan { cc_hole = ExprHole }) = True +isExprHoleCt (CHoleCan { cc_hole = ExprHole {} }) = True isExprHoleCt _ = False isTypeHoleCt :: Ct -> Bool -isTypeHoleCt (CHoleCan { cc_hole = TypeHole }) = True +isTypeHoleCt (CHoleCan { cc_hole = TypeHole {} }) = True isTypeHoleCt _ = False -- | The following constraints are considered to be a custom type error: @@ -1950,14 +1961,17 @@ insolubleWC tc_lvl (WC { wc_impl = implics, wc_insol = insols }) || anyBag insolubleImplic implics trulyInsoluble :: TcLevel -> Ct -> Bool --- The constraint is in the wc_insol set, --- but we do not treat as truly isoluble --- a) type-holes, arising from PartialTypeSignatures, --- (except out-of-scope variables masquerading as type-holes) +-- Constraints in the wc_insol set which ARE NOT +-- treated as truly insoluble: +-- a) type holes, arising from PartialTypeSignatures, +-- b) "true" expression holes arising from TypedHoles +-- +-- Out-of-scope variables masquerading as expression holes +-- ARE treated as truly insoluble. -- Yuk! trulyInsoluble _tc_lvl insol - | CHoleCan {} <- insol = isOutOfScopeCt insol - | otherwise = True + | isHoleCt insol = isOutOfScopeCt insol + | otherwise = True instance Outputable WantedConstraints where ppr (WC {wc_simple = s, wc_impl = i, wc_insol = n}) @@ -2806,7 +2820,7 @@ ctoHerald = text "arising from" -- | Extract a suitable CtOrigin from a HsExpr exprCtOrigin :: HsExpr Name -> CtOrigin exprCtOrigin (HsVar (L _ name)) = OccurrenceOf name -exprCtOrigin (HsUnboundVar occ) = UnboundOccurrenceOf occ +exprCtOrigin (HsUnboundVar uv) = UnboundOccurrenceOf (unboundVarOcc uv) exprCtOrigin (HsRecFld f) = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f) exprCtOrigin (HsOverLabel l) = OverLabelOrigin l exprCtOrigin (HsIPVar ip) = IPOccOrigin ip |