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 ...@@ -386,6 +386,7 @@ instance Uniquable OccName where
getUnique (OccName TcClsName fs) = mkTcOccUnique fs getUnique (OccName TcClsName fs) = mkTcOccUnique fs
newtype OccEnv a = A (UniqFM a) newtype OccEnv a = A (UniqFM a)
deriving (Data, Typeable)
emptyOccEnv :: OccEnv a emptyOccEnv :: OccEnv a
unitOccEnv :: OccName -> a -> OccEnv a unitOccEnv :: OccName -> a -> OccEnv a
......
...@@ -430,7 +430,8 @@ data GlobalRdrElt ...@@ -430,7 +430,8 @@ data GlobalRdrElt
, gre_par :: Parent , gre_par :: Parent
, gre_lcl :: Bool -- ^ True <=> the thing was defined locally , gre_lcl :: Bool -- ^ True <=> the thing was defined locally
, gre_imp :: [ImportSpec] -- ^ In scope through these imports , 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] -- See Note [GlobalRdrElt provenance]
-- | The children of a Name are the things that are abbreviated by the ".." -- | The children of a Name are the things that are abbreviated by the ".."
...@@ -440,7 +441,7 @@ data Parent = NoParent ...@@ -440,7 +441,7 @@ data Parent = NoParent
| FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString } | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString }
-- ^ See Note [Parents for record fields] -- ^ See Note [Parents for record fields]
| PatternSynonym | PatternSynonym
deriving (Eq) deriving (Eq, Data, Typeable)
instance Outputable Parent where instance Outputable Parent where
ppr NoParent = empty ppr NoParent = empty
...@@ -1001,7 +1002,7 @@ shadowName env name ...@@ -1001,7 +1002,7 @@ shadowName env name
-- It's quite elaborate so that we can give accurate unused-name warnings. -- It's quite elaborate so that we can give accurate unused-name warnings.
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec, data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
is_item :: ImpItemSpec } is_item :: ImpItemSpec }
deriving( Eq, Ord ) deriving( Eq, Ord, Data, Typeable )
-- | Describes a particular import declaration and is -- | Describes a particular import declaration and is
-- shared among all the 'Provenance's for that decl -- shared among all the 'Provenance's for that decl
...@@ -1016,7 +1017,7 @@ data ImpDeclSpec ...@@ -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_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_qual :: Bool, -- ^ Was this import qualified?
is_dloc :: SrcSpan -- ^ The location of the entire import declaration is_dloc :: SrcSpan -- ^ The location of the entire import declaration
} } deriving (Data, Typeable)
-- | Describes import info a particular Name -- | Describes import info a particular Name
data ImpItemSpec data ImpItemSpec
...@@ -1035,6 +1036,7 @@ data ImpItemSpec ...@@ -1035,6 +1036,7 @@ data ImpItemSpec
-- --
-- Here the constructors of @T@ are not named explicitly; -- Here the constructors of @T@ are not named explicitly;
-- only @T@ is named explicitly. -- only @T@ is named explicitly.
deriving (Data, Typeable)
instance Eq ImpDeclSpec where instance Eq ImpDeclSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
......
...@@ -1179,8 +1179,8 @@ repE (ArithSeq _ _ aseq) = ...@@ -1179,8 +1179,8 @@ repE (ArithSeq _ _ aseq) =
repE (HsSpliceE splice) = repSplice splice repE (HsSpliceE splice) = repSplice splice
repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC repE (HsStatic e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE (HsUnboundVar name) = do repE (HsUnboundVar uv) = do
occ <- occNameLit name occ <- occNameLit (unboundVarOcc uv)
sname <- repNameS occ sname <- repNameS occ
repUnboundVar sname repUnboundVar sname
......
...@@ -30,6 +30,7 @@ import CoreSyn ...@@ -30,6 +30,7 @@ import CoreSyn
import Var import Var
import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) ) import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
import Name import Name
import RdrName ( GlobalRdrEnv )
import BasicTypes import BasicTypes
import ConLike import ConLike
import SrcLoc import SrcLoc
...@@ -166,17 +167,109 @@ is Less Cool because ...@@ -166,17 +167,109 @@ 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
-- 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. -- | A Haskell expression.
data HsExpr id data HsExpr id
= HsVar (Located id) -- ^ Variable = HsVar (Located id) -- ^ Variable
-- See Note [Located RdrNames] -- See Note [Located RdrNames]
| HsUnboundVar OccName -- ^ Unbound variable; also used for "holes" _, or _x. | HsUnboundVar UnboundVar -- ^ Unbound variable; also used for "holes"
-- Turned from HsVar to HsUnboundVar by the renamer, when -- (_ or _x).
-- it finds an out-of-scope variable -- Turned from HsVar to HsUnboundVar by the
-- Turned into HsVar by type checker, to support deferred -- renamer, when it finds an out-of-scope
-- type errors. (The HsUnboundVar only has an OccName.) -- variable or hole.
-- Turned into HsVar by type checker, to support
-- deferred type errors.
| HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector | HsRecFld (AmbiguousFieldOcc id) -- ^ Variable pointing to record selector
...@@ -684,7 +777,7 @@ ppr_lexpr e = ppr_expr (unLoc e) ...@@ -684,7 +777,7 @@ ppr_lexpr e = ppr_expr (unLoc e)
ppr_expr :: forall id. OutputableBndr id => HsExpr id -> SDoc ppr_expr :: forall id. OutputableBndr id => HsExpr id -> SDoc
ppr_expr (HsVar (L _ v)) = pprPrefixOcc v 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 (HsIPVar v) = ppr v
ppr_expr (HsOverLabel l) = char '#' <> ppr l ppr_expr (HsOverLabel l) = char '#' <> ppr l
ppr_expr (HsLit lit) = ppr lit ppr_expr (HsLit lit) = ppr lit
......
...@@ -93,7 +93,11 @@ rnUnboundVar v ...@@ -93,7 +93,11 @@ rnUnboundVar v
then -- Treat this as a "hole" then -- Treat this as a "hole"
-- Do not fail right now; instead, return HsUnboundVar -- Do not fail right now; instead, return HsUnboundVar
-- and let the type checker report the error -- 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) else -- Fail immediately (qualified name)
do { n <- reportUnboundName v do { n <- reportUnboundName v
...@@ -403,7 +407,7 @@ rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other) ...@@ -403,7 +407,7 @@ rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
-- HsWrap -- HsWrap
hsHoleExpr :: HsExpr id hsHoleExpr :: HsExpr id
hsHoleExpr = HsUnboundVar (mkVarOcc "_") hsHoleExpr = HsUnboundVar (TrueExprHole (mkVarOcc "_"))
arrowFail :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) arrowFail :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
arrowFail e arrowFail e
......
...@@ -1061,7 +1061,7 @@ badRuleLhsErr name lhs bad_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" 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 occ -> text "Not in scope:" <+> ppr occ HsUnboundVar uv -> text "Not in scope:" <+> ppr uv
_ -> text "Illegal expression:" <+> ppr bad_e _ -> text "Illegal expression:" <+> ppr bad_e
{- {-
......
...@@ -1220,9 +1220,9 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment ...@@ -1220,9 +1220,9 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
get_op :: LHsExpr Name -> Name get_op :: LHsExpr Name -> Name
-- An unbound name could be either HsVar or HsUnboundVar -- An unbound name could be either HsVar or HsUnboundVar
-- See RnExpr.rnUnboundVar -- See RnExpr.rnUnboundVar
get_op (L _ (HsVar (L _ n))) = n get_op (L _ (HsVar (L _ n))) = n
get_op (L _ (HsUnboundVar occ)) = mkUnboundName occ get_op (L _ (HsUnboundVar uv)) = mkUnboundName (unboundVarOcc uv)
get_op other = pprPanic "get_op" (ppr other) get_op other = pprPanic "get_op" (ppr other)
-- Parser left-associates everything, but -- Parser left-associates everything, but
-- derived instances may have correctly-associated things to -- derived instances may have correctly-associated things to
......
...@@ -23,7 +23,6 @@ import FamInstEnv ( FamInstEnvs ) ...@@ -23,7 +23,6 @@ import FamInstEnv ( FamInstEnvs )
import FamInst ( tcTopNormaliseNewTypeTF_maybe ) import FamInst ( tcTopNormaliseNewTypeTF_maybe )
import Var import Var
import Name( isSystemName ) import Name( isSystemName )
import OccName( OccName )
import Outputable import Outputable
import DynFlags( DynFlags ) import DynFlags( DynFlags )
import VarSet import VarSet
...@@ -164,8 +163,8 @@ canonicalize (CFunEqCan { cc_ev = ev ...@@ -164,8 +163,8 @@ canonicalize (CFunEqCan { cc_ev = ev
canonicalize (CIrredEvCan { cc_ev = ev }) canonicalize (CIrredEvCan { cc_ev = ev })
= canIrred ev = canIrred ev
canonicalize (CHoleCan { cc_ev = ev, cc_occ = occ, cc_hole = hole }) canonicalize (CHoleCan { cc_ev = ev, cc_hole = hole })
= canHole ev occ hole = canHole ev hole
canEvNC :: CtEvidence -> TcS (StopOrContinue Ct) canEvNC :: CtEvidence -> TcS (StopOrContinue Ct)
-- Called only for non-canonical EvVars -- Called only for non-canonical EvVars
...@@ -487,14 +486,13 @@ canIrred old_ev ...@@ -487,14 +486,13 @@ canIrred old_ev
_ -> continueWith $ _ -> continueWith $
CIrredEvCan { cc_ev = new_ev } } } CIrredEvCan { cc_ev = new_ev } } }
canHole :: CtEvidence -> OccName -> HoleSort -> TcS (StopOrContinue Ct) canHole :: CtEvidence -> Hole -> TcS (StopOrContinue Ct)
canHole ev occ hole_sort canHole ev hole
= do { let ty = ctEvPred ev = do { let ty = ctEvPred ev
; (xi,co) <- flatten FM_SubstOnly ev ty -- co :: xi ~ ty ; (xi,co) <- flatten FM_SubstOnly ev ty -- co :: xi ~ ty
; rewriteEvidence ev xi co `andWhenContinue` \ new_ev -> ; rewriteEvidence ev xi co `andWhenContinue` \ new_ev ->
do { emitInsoluble (CHoleCan { cc_ev = new_ev do { emitInsoluble (CHoleCan { cc_ev = new_ev
, cc_occ = occ , cc_hole = hole })
, cc_hole = hole_sort })
; stopWith new_ev "Emit insoluble hole" } } ; stopWith new_ev "Emit insoluble hole" } }
{- {-
......
This diff is collapsed.
...@@ -162,7 +162,7 @@ NB: The res_ty is always deeply skolemised. ...@@ -162,7 +162,7 @@ NB: The res_ty is always deeply skolemised.
tcExpr :: HsExpr Name -> ExpRhoType -> TcM (HsExpr TcId) tcExpr :: HsExpr Name -> ExpRhoType -> TcM (HsExpr TcId)
tcExpr (HsVar (L _ name)) res_ty = tcCheckId name res_ty 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@(HsApp {}) res_ty = tcApp1 e res_ty
tcExpr e@(HsAppType {}) 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 ...@@ -1594,7 +1594,7 @@ tc_infer_id lbl id_name
| otherwise = return () | otherwise = return ()
tcUnboundId :: OccName -> ExpRhoType -> TcM (HsExpr TcId) tcUnboundId :: UnboundVar -> ExpRhoType -> TcM (HsExpr TcId)
-- Typechedk an occurrence of an unbound Id -- Typechedk an occurrence of an unbound Id
-- --
-- Some of these started life as a true hole "_". Others might simply -- Some of these started life as a true hole "_". Others might simply
...@@ -1603,16 +1603,16 @@ tcUnboundId :: OccName -> ExpRhoType -> TcM (HsExpr TcId) ...@@ -1603,16 +1603,16 @@ tcUnboundId :: OccName -> ExpRhoType -> TcM (HsExpr TcId)
-- We turn all of them into HsVar, since HsUnboundVar can't contain an -- 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 -- Id; and indeed the evidence for the CHoleCan does bind it, so it's
-- not unbound any more! -- not unbound any more!
tcUnboundId occ res_ty tcUnboundId unbound res_ty
= do { ty <- newFlexiTyVarTy liftedTypeKind = do { ty <- newFlexiTyVarTy liftedTypeKind
; let occ = unboundVarOcc unbound
; name <- newSysName occ ; name <- newSysName occ
; let ev = mkLocalId name ty ; let ev = mkLocalId name ty
; loc <- getCtLocM HoleOrigin Nothing ; loc <- getCtLocM HoleOrigin Nothing
; let can = CHoleCan { cc_ev = CtWanted { ctev_pred = ty ; let can = CHoleCan { cc_ev = CtWanted { ctev_pred = ty
, ctev_dest = EvVarDest ev , ctev_dest = EvVarDest ev
, ctev_loc = loc} , ctev_loc = loc}
, cc_occ = occ , cc_hole = ExprHole unbound }
, cc_hole = ExprHole }
; emitInsoluble can ; emitInsoluble can
; tcWrapResultO (UnboundOccurrenceOf occ) (HsVar (noLoc ev)) ty res_ty } ; tcWrapResultO (UnboundOccurrenceOf occ) (HsVar (noLoc ev)) ty res_ty }
......
...@@ -798,8 +798,7 @@ zonkExpr env (HsWrap co_fn expr) ...@@ -798,8 +798,7 @@ zonkExpr env (HsWrap co_fn expr)
new_expr <- zonkExpr env1 expr new_expr <- zonkExpr env1 expr
return (HsWrap new_co_fn new_expr) return (HsWrap new_co_fn new_expr)
zonkExpr _ (HsUnboundVar v) zonkExpr _ e@(HsUnboundVar {}) = return e
= return (HsUnboundVar v)
zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr) zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr)
......
...@@ -610,9 +610,12 @@ tc_rn_src_decls ds ...@@ -610,9 +610,12 @@ tc_rn_src_decls ds
} }
#else #else
-- If there's a splice, we must carry on -- If there's a splice, we must carry on
; Just (SpliceDecl (L _ splice) _, rest_ds) -> ; Just (SpliceDecl (L loc splice) _, rest_ds) ->
do { -- Rename the splice expression, and get its supporting decls do { recordTopLevelSpliceLoc loc
(spliced_decls, splice_fvs) <- checkNoErrs (rnTopSpliceDecls splice)
-- 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 -- Glue them on the front of the remaining decls and loop
; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $ ; setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
......
...@@ -56,6 +56,8 @@ import qualified GHC.LanguageExtensions as LangExt ...@@ -56,6 +56,8 @@ import qualified GHC.LanguageExtensions as LangExt
import Control.Exception import Control.Exception
import Data.IORef import Data.IORef
import Control.Monad import Control.Monad
import Data.Set ( Set )
import qualified Data.Set as Set
#ifdef GHCI #ifdef GHCI
import qualified Data.Map as Map import qualified Data.Map as Map
...@@ -87,6 +89,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this ...@@ -87,6 +89,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
used_gre_var <- newIORef [] ; used_gre_var <- newIORef [] ;
th_var <- newIORef False ; th_var <- newIORef False ;
th_splice_var<- newIORef False ; th_splice_var<- newIORef False ;
th_locs_var <- newIORef Set.empty ;
infer_var <- newIORef (True, emptyBag) ; infer_var <- newIORef (True, emptyBag) ;
lie_var <- newIORef emptyWC ; lie_var <- newIORef emptyWC ;
dfun_n_var <- newIORef emptyOccSet ; dfun_n_var <- newIORef emptyOccSet ;
...@@ -137,6 +140,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this ...@@ -137,6 +140,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_ann_env = emptyAnnEnv, tcg_ann_env = emptyAnnEnv,
tcg_th_used = th_var, tcg_th_used = th_var,
tcg_th_splice_used = th_splice_var, tcg_th_splice_used = th_splice_var,
tcg_th_top_level_locs
= th_locs_var,
tcg_exports = [], tcg_exports = [],
tcg_imports = emptyImportAvails, tcg_imports = emptyImportAvails,
tcg_used_gres = used_gre_var, tcg_used_gres = used_gre_var,
...@@ -1345,8 +1350,7 @@ emitWildCardHoleConstraints wcs ...@@ -1345,8 +1350,7 @@ emitWildCardHoleConstraints wcs
ty = mkTyVarTy tv ty = mkTyVarTy tv
can = CHoleCan { cc_ev = CtDerived { ctev_pred = ty can = CHoleCan { cc_ev = CtDerived { ctev_pred = ty
, ctev_loc = ctLoc' } , ctev_loc = ctLoc' }
, cc_occ = occName name , cc_hole = TypeHole (occName name) }
, cc_hole = TypeHole }
; emitInsoluble can } } ; emitInsoluble can } }
{- {-
...@@ -1363,6 +1367,22 @@ recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True } ...@@ -1363,6 +1367,22 @@ recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True }
recordThSpliceUse :: TcM () recordThSpliceUse :: TcM ()
recordThSpliceUse = do { env <- getGblEnv; writeTcRef (tcg_th_splice_used env) True } 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 -> TcRn () -- Record the name in the keep-alive set
keepAlive name keepAlive name
= do { env <- getGblEnv = do { env <- getGblEnv
......
...@@ -123,7 +123,8 @@ module TcRnTypes( ...@@ -123,7 +123,8 @@ module TcRnTypes(
pprEvVars, pprEvVarWithType, pprEvVars, pprEvVarWithType,
-- Misc other types -- Misc other types
TcId, TcIdSet, HoleSort(..) TcId, TcIdSet,
Hole(..), holeOcc
) where ) where
...@@ -175,6 +176,7 @@ import Control.Monad (ap, liftM, msum) ...@@ -175,6 +176,7 @@ import Control.Monad (ap, liftM, msum)
#if __GLASGOW_HASKELL__ > 710 #if __GLASGOW_HASKELL__ > 710
import qualified Control.Monad.Fail as MonadFail import qualified Control.Monad.Fail as MonadFail
#endif #endif
import Data.Set ( Set )
#ifdef GHCI #ifdef GHCI
import Data.Map ( Map ) import Data.Map ( Map )
...@@ -466,6 +468,10 @@ data TcGblEnv ...@@ -466,6 +468,10 @@ data TcGblEnv
-- --
-- Splices disable recompilation avoidance (see #481) -- 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, tcg_dfun_n :: TcRef OccSet,
-- ^ Allows us to choose unique DFun names. -- ^ Allows us to choose unique DFun names.
...@@ -1438,13 +1444,19 @@ data Ct ...@@ -1438,13 +1444,19 @@ data Ct
-- Treated as an "insoluble" constraint -- Treated as an "insoluble" constraint
-- See Note [Insoluble constraints] -- See Note [Insoluble constraints]
cc_ev :: CtEvidence, cc_ev :: CtEvidence,
cc_occ :: OccName, -- The name of this hole cc_hole :: Hole
cc_hole :: HoleSort -- The sort of this hole (expr, type, ...)
} }
-- | Used to indicate which sort of hole we have. -- | An expression or type hole
data HoleSort = ExprHole -- ^ A hole in an expression (TypedHoles) data Hole = ExprHole UnboundVar
| TypeHole -- ^ A hole in a type (PartialTypeSignatures) -- ^ 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] Note [Hole constraints]
...@@ -1452,7 +1464,7 @@ Note [Hole constraints] ...@@ -1452,7 +1464,7 @@ Note [Hole constraints]
CHoleCan constraints are used for two kinds of holes, CHoleCan constraints are used for two kinds of holes,
distinguished by cc_hole: distinguished by cc_hole:
* For holes in expressions * For holes in expressions (including variables not in scope)
e.g. f x = g _ x e.g. f x = g _ x
* For holes in type signatures * For holes in type signatures
...@@ -1550,7 +1562,7 @@ instance Outputable Ct where ...@@ -1550,7 +1562,7 @@ instance Outputable Ct where
| pend_sc -> text "CDictCan(psc)" | pend_sc -> text "CDictCan(psc)"
| otherwise -> text "CDictCan" | otherwise -> text "CDictCan"
CIrredEvCan {} -> text "CIrredEvCan" 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 ...@@ -1741,18 +1753,17 @@ isHoleCt (CHoleCan {}) = True
isHoleCt _ = False isHoleCt _ = False
isOutOfScopeCt :: Ct -> Bool isOutOfScopeCt :: Ct -> Bool
-- A Hole that does not have a leading underscore is -- We treat expression holes representing out-of-scope variables a bit
-- simply an out-of-scope variable, and we treat that -- differently when it comes to error reporting
-- a bit differently when it comes to error reporting isOutOfScopeCt (CHoleCan { cc_hole = ExprHole (OutOfScope {}) }) = True
isOutOfScopeCt (CHoleCan { cc_occ = occ }) = not (startsWithUnderscore occ)
isOutOfScopeCt _ = False isOutOfScopeCt _ = False
isExprHoleCt :: Ct -> Bool isExprHoleCt :: Ct -> Bool
isExprHoleCt (CHoleCan { cc_hole = ExprHole }) = True isExprHoleCt (CHoleCan { cc_hole = ExprHole {} }) = True
isExprHoleCt _ = False isExprHoleCt _ = False
isTypeHoleCt :: Ct -> Bool isTypeHoleCt :: Ct -> Bool
isTypeHoleCt (CHoleCan { cc_hole = TypeHole }) = True isTypeHoleCt (CHoleCan { cc_hole = TypeHole {} }) = True
isTypeHoleCt _ = False isTypeHoleCt _ = False
-- | The following constraints are considered to be a custom type error: -- | 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 }) ...@@ -1950,14 +1961,17 @@ insolubleWC tc_lvl (WC { wc_impl = implics, wc_insol = insols })
|| anyBag insolubleImplic implics || anyBag insolubleImplic implics
trulyInsoluble :: TcLevel -> Ct -> Bool trulyInsoluble :: TcLevel -> Ct -> Bool
-- The constraint is in the wc_insol set, -- Constraints in the wc_insol set which ARE NOT
-- but we do not treat as truly isoluble -- treated as truly insoluble:
-- a) type-holes, arising from PartialTypeSignatures, -- a) type holes, arising from PartialTypeSignatures,
-- (except out-of-scope variables masquerading as type-holes) -- b) "true" expression holes arising from TypedHoles
--
-- Out-of-scope variables masquerading as expression holes
-- ARE treated as truly insoluble.
-- Yuk! -- Yuk!
trulyInsoluble _tc_lvl insol trulyInsoluble _tc_lvl insol
| CHoleCan {} <- insol = isOutOfScopeCt insol | isHoleCt insol = isOutOfScopeCt insol
| otherwise = True | otherwise = True
instance Outputable WantedConstraints where instance Outputable WantedConstraints where
ppr (WC {wc_simple = s, wc_impl = i, wc_insol = n}) ppr (WC {wc_simple = s, wc_impl = i, wc_insol = n})
...@@ -2806,7 +2820,7 @@ ctoHerald = text "arising from" ...@@ -2806,7 +2820,7 @@ ctoHerald = text "arising from"
-- | Extract a suitable CtOrigin from a HsExpr -- | Extract a suitable CtOrigin from a HsExpr
exprCtOrigin :: HsExpr Name -> CtOrigin exprCtOrigin :: HsExpr Name -> CtOrigin
exprCtOrigin (HsVar (L _ name)) = OccurrenceOf name exprCtOrigin (HsVar (L _ name)) = OccurrenceOf name
exprCtOrigin (HsUnboundVar occ) = UnboundOccurrenceOf occ exprCtOrigin (HsUnboundVar uv) = UnboundOccurrenceOf (unboundVarOcc uv)
exprCtOrigin (HsRecFld f