Commit 470d4d5b authored by Jason Eisenberg's avatar Jason Eisenberg Committed by Ben Gamari

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
parent 5a1add13
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
{-
......
......@@ -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
......
......@@ -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" } }
{-
......
......@@ -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
......@@ -938,6 +988,111 @@ mkIPErr ctxt cts
where
(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.
-}
{-
************************************************************************
* *
......
......@@ -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 }
......
......@@ -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)
......
......@@ -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) $
......
......@@ -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
......
......@@ -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
{-