summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--compiler/GHC/Hs/Expr.hs115
-rw-r--r--compiler/deSugar/DsMeta.hs2
-rw-r--r--compiler/parser/RdrHsSyn.hs2
-rw-r--r--compiler/rename/RnExpr.hs6
-rw-r--r--compiler/rename/RnSource.hs2
-rw-r--r--compiler/rename/RnTypes.hs4
-rw-r--r--compiler/typecheck/TcBackpack.hs1
-rw-r--r--compiler/typecheck/TcCanonical.hs12
-rw-r--r--compiler/typecheck/TcErrors.hs233
-rw-r--r--compiler/typecheck/TcExpr.hs7
-rw-r--r--compiler/typecheck/TcHsSyn.hs3
-rw-r--r--compiler/typecheck/TcMType.hs3
-rw-r--r--compiler/typecheck/TcRnDriver.hs10
-rw-r--r--compiler/typecheck/TcRnMonad.hs31
-rw-r--r--compiler/typecheck/TcRnTypes.hs48
-rw-r--r--compiler/typecheck/TcSimplify.hs5
-rw-r--r--testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs4
-rw-r--r--testsuite/tests/th/T10267.stderr51
-rw-r--r--testsuite/tests/th/T11680.stderr31
-rw-r--r--testsuite/tests/th/T16980.hs16
-rw-r--r--testsuite/tests/th/T16980.stderr2
-rw-r--r--testsuite/tests/th/T16980a.hs10
-rw-r--r--testsuite/tests/th/T16980a.stderr5
-rw-r--r--testsuite/tests/th/T2222.stderr2
-rw-r--r--testsuite/tests/th/T5358.stderr30
-rw-r--r--testsuite/tests/th/all.T2
-rw-r--r--testsuite/tests/typecheck/should_fail/T12589.stderr4
27 files changed, 175 insertions, 466 deletions
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index cd1a9f62bd..a3ad2bcada 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -35,7 +35,6 @@ import CoreSyn
import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
import Name
import NameSet
-import RdrName ( GlobalRdrEnv )
import BasicTypes
import ConLike
import SrcLoc
@@ -186,104 +185,6 @@ 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
---
--- 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
- -- with respect to which it is unbound
-
- -- See Note [OutOfScope and GlobalRdrEnv]
-
- | TrueExprHole OccName -- ^ A "true" expression hole (_ or _x)
-
- deriving Data
-
-instance Outputable UnboundVar where
- ppr (OutOfScope occ _) = text "OutOfScope" <> parens (ppr occ)
- ppr (TrueExprHole occ) = text "ExprHole" <> parens (ppr occ)
-
-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 #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 p
= HsVar (XVar p)
@@ -292,7 +193,7 @@ data HsExpr p
-- See Note [Located RdrNames]
| HsUnboundVar (XUnboundVar p)
- UnboundVar -- ^ Unbound variable; also used for "holes"
+ OccName -- ^ Unbound variable; also used for "holes"
-- (_ or _x).
-- Turned from HsVar to HsUnboundVar by the
-- renamer, when it finds an out-of-scope
@@ -945,7 +846,7 @@ ppr_lexpr e = ppr_expr (unLoc e)
ppr_expr :: forall p. (OutputableBndrId (GhcPass p))
=> HsExpr (GhcPass p) -> SDoc
ppr_expr (HsVar _ (L _ v)) = pprPrefixOcc v
-ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)
+ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc uv
ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c
ppr_expr (HsIPVar _ v) = ppr v
ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l
@@ -1129,12 +1030,12 @@ ppr_expr (HsRecFld _ f) = ppr f
ppr_expr (XExpr x) = ppr x
ppr_infix_expr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc
-ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
-ppr_infix_expr (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))
-ppr_infix_expr (HsRecFld _ f) = Just (pprInfixOcc f)
-ppr_infix_expr (HsUnboundVar _ h@TrueExprHole{}) = Just (pprInfixOcc (unboundVarOcc h))
-ppr_infix_expr (HsWrap _ _ e) = ppr_infix_expr e
-ppr_infix_expr _ = Nothing
+ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)
+ppr_infix_expr (HsConLikeOut _ c) = Just (pprInfixOcc (conLikeName c))
+ppr_infix_expr (HsRecFld _ f) = Just (pprInfixOcc f)
+ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ)
+ppr_infix_expr (HsWrap _ _ e) = ppr_infix_expr e
+ppr_infix_expr _ = Nothing
ppr_apps :: (OutputableBndrId (GhcPass p))
=> HsExpr (GhcPass p)
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 7baa748faa..6d7f281752 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1394,7 +1394,7 @@ repE (ArithSeq _ _ aseq) =
repE (HsSpliceE _ splice) = repSplice splice
repE (HsStatic _ e) = repLE e >>= rep2 staticEName . (:[]) . unC
repE (HsUnboundVar _ uv) = do
- occ <- occNameLit (unboundVarOcc uv)
+ occ <- occNameLit uv
sname <- repNameS occ
repUnboundVar sname
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 0686f669d3..911bda1efb 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -2102,7 +2102,7 @@ patSynErr l e explanation =
; return (cL l hsHoleExpr) }
hsHoleExpr :: HsExpr (GhcPass id)
-hsHoleExpr = HsUnboundVar noExtField (TrueExprHole (mkVarOcc "_"))
+hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")
-- | See Note [Ambiguous syntactic categories] and Note [PatBuilder]
data PatBuilder p
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 3ec24a7a6d..42d38c23e9 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -108,11 +108,7 @@ rnUnboundVar v
then -- Treat this as a "hole"
-- Do not fail right now; instead, return HsUnboundVar
-- and let the type checker report the error
- do { let occ = rdrNameOcc v
- ; uv <- if startsWithUnderscore occ
- then return (TrueExprHole occ)
- else OutOfScope occ <$> getGlobalRdrEnv
- ; return (HsUnboundVar noExtField uv, emptyFVs) }
+ return (HsUnboundVar noExtField (rdrNameOcc v), emptyFVs)
else -- Fail immediately (qualified name)
do { n <- reportUnboundName v
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 1ab80e755a..ea8cfb5347 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -1141,7 +1141,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 _ uv -> notInScopeErr (mkRdrUnqual (unboundVarOcc uv))
+ HsUnboundVar _ uv -> notInScopeErr (mkRdrUnqual uv)
_ -> text "Illegal expression:" <+> ppr bad_e
{- **************************************************************
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 5f0a1c62c7..87f364011e 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1180,7 +1180,7 @@ mkOpAppRn e1 op fix e2 -- Default case, no rearrangment
-- | Name of an operator in an operator application or section
data OpName = NormalOp Name -- ^ A normal identifier
| NegateOp -- ^ Prefix negation
- | UnboundOp UnboundVar -- ^ An unbound indentifier
+ | UnboundOp OccName -- ^ An unbound indentifier
| RecFldOp (AmbiguousFieldOcc GhcRn)
-- ^ A (possibly ambiguous) record field occurrence
@@ -1347,7 +1347,7 @@ checkSectionPrec direction section op arg
lookupFixityOp :: OpName -> RnM Fixity
lookupFixityOp (NormalOp n) = lookupFixityRn n
lookupFixityOp NegateOp = lookupFixityRn negateName
-lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName (unboundVarOcc u))
+lookupFixityOp (UnboundOp u) = lookupFixityRn (mkUnboundName u)
lookupFixityOp (RecFldOp f) = lookupFieldFixityRn f
diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index f756a7715a..bc66834849 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -521,7 +521,6 @@ mergeSignatures
-- tcg_dus?
-- tcg_th_used = tcg_th_used orig_tcg_env,
-- tcg_th_splice_used = tcg_th_splice_used orig_tcg_env
- -- tcg_th_top_level_locs = tcg_th_top_level_locs orig_tcg_env
}) $ do
tcg_env <- getGblEnv
diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs
index 55054805ef..c2e90c6023 100644
--- a/compiler/typecheck/TcCanonical.hs
+++ b/compiler/typecheck/TcCanonical.hs
@@ -32,6 +32,7 @@ import FamInst ( tcTopNormaliseNewTypeTF_maybe )
import Var
import VarEnv( mkInScopeSet )
import VarSet( delVarSetList )
+import OccName ( OccName )
import Outputable
import DynFlags( DynFlags )
import NameSet
@@ -134,8 +135,8 @@ canonicalize (CFunEqCan { cc_ev = ev
= {-# SCC "canEqLeafFunEq" #-}
canCFunEqCan ev fn xis1 fsk
-canonicalize (CHoleCan { cc_ev = ev, cc_hole = hole })
- = canHole ev hole
+canonicalize (CHoleCan { cc_ev = ev, cc_occ = occ, cc_hole = hole })
+ = canHole ev occ hole
{-
************************************************************************
@@ -640,13 +641,14 @@ canIrred ev
_ -> continueWith $
mkIrredCt new_ev } }
-canHole :: CtEvidence -> Hole -> TcS (StopOrContinue Ct)
-canHole ev hole
+canHole :: CtEvidence -> OccName -> HoleSort -> TcS (StopOrContinue Ct)
+canHole ev occ hole_sort
= do { let pred = ctEvPred ev
; (xi,co) <- flatten FM_SubstOnly ev pred -- co :: xi ~ pred
; rewriteEvidence ev xi co `andWhenContinue` \ new_ev ->
do { updInertIrreds (`snocCts` (CHoleCan { cc_ev = new_ev
- , cc_hole = hole }))
+ , cc_occ = occ
+ , cc_hole = hole_sort }))
; stopWith new_ev "Emit insoluble hole" } }
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 832f859c8a..814143103c 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -33,11 +33,9 @@ import Class
import DataCon
import TcEvidence
import TcEvTerm
-import GHC.Hs.Expr ( UnboundVar(..) )
import GHC.Hs.Binds ( PatSynBind(..) )
import Name
-import RdrName ( lookupGlobalRdrEnv, lookupGRE_Name, GlobalRdrEnv
- , mkRdrUnqual, isLocalGRE, greSrcSpan )
+import RdrName ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual )
import PrelNames ( typeableClassName )
import Id
import Var
@@ -62,7 +60,6 @@ import FV ( fvVarList, unionFV )
import Control.Monad ( when )
import Data.Foldable ( toList )
import Data.List ( partition, mapAccumL, nub, sortBy, unfoldr )
-import qualified Data.Set as Set
import {-# SOURCE #-} TcHoleErrors ( findValidHoleFits )
@@ -1098,105 +1095,63 @@ mkIrredErr ctxt cts
----------------
mkHoleError :: [Ct] -> ReportErrCtxt -> Ct -> TcM ErrMsg
-mkHoleError _ _ 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
+mkHoleError tidy_simples 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
; imp_info <- getImports
; curr_mod <- getModule
; hpt <- getHpt
- ; let suggs_msg = unknownNameSuggestions dflags hpt curr_mod 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)
- 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 occ hole_ty)
+ ; mkErrDocAt (RealSrcSpan (tcl_loc lcl_env)) $
+ errDoc [out_of_scope_msg] []
+ [unknownNameSuggestions dflags hpt curr_mod rdr_env
+ (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)] }
- herald | isDataOcc occ = text "Data constructor not in scope:"
- | otherwise = text "Variable not in scope:"
-
- -- 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 tidy_simples ctxt ct@(CHoleCan { cc_hole = hole })
- -- Explicit holes, like "_" or "_f"
+ | otherwise -- Explicit holes, like "_" or "_f"
= do { (ctxt, binds_msg, ct) <- relevantBindings False ctxt ct
- -- The 'False' means "don't filter the bindings"; see #8191
+ -- The 'False' means "don't filter the bindings"; see Trac #8191
; show_hole_constraints <- goptM Opt_ShowHoleConstraints
; let constraints_msg
| isExprHoleCt ct, show_hole_constraints
- = givenConstraintsMsg ctxt
- | otherwise = empty
+ = givenConstraintsMsg ctxt
+ | otherwise
+ = empty
; show_valid_hole_fits <- goptM Opt_ShowValidHoleFits
; (ctxt, sub_msg) <- if show_valid_hole_fits
then validHoleFits ctxt tidy_simples ct
else return (ctxt, empty)
+
; mkErrorMsgFromCt ctxt ct $
important hole_msg `mappend`
relevant_bindings (binds_msg $$ constraints_msg) `mappend`
- valid_hole_fits sub_msg}
+ valid_hole_fits sub_msg }
where
- occ = holeOcc hole
- hole_ty = ctEvPred (ctEvidence ct)
- hole_kind = tcTypeKind hole_ty
- 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 pp_hole_type_with_kind)
- , tyvars_msg, type_hole_hint ]
+ ct_loc = ctLoc ct
+ lcl_env = ctLocEnv ct_loc
+ hole_ty = ctEvPred (ctEvidence ct)
+ hole_kind = tcTypeKind hole_ty
+ 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
+
+ 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 pp_hole_type_with_kind)
+ , tyvars_msg, type_hole_hint ]
pp_hole_type_with_kind
| isLiftedTypeKind hole_kind
@@ -1272,9 +1227,6 @@ givenConstraintsMsg ctxt =
hang (text "Constraints include")
2 (vcat $ map pprConstraint constraints)
-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
@@ -1295,7 +1247,6 @@ mkIPErr ctxt cts
(ct1:_) = cts
{-
-
Note [Constraints include ...]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'givenConstraintsMsg' returns the "Constraints include ..." message enabled by
@@ -1313,112 +1264,6 @@ would generate the message:
Constraints are displayed in order from innermost (closest to the hole) to
outermost. There's currently no filtering or elimination of duplicates.
-
-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 7ae1e8b4e7..31c2ea4298 100644
--- a/compiler/typecheck/TcExpr.hs
+++ b/compiler/typecheck/TcExpr.hs
@@ -1848,7 +1848,7 @@ tc_infer_id lbl id_name
| otherwise = return ()
-tcUnboundId :: HsExpr GhcRn -> UnboundVar -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcUnboundId :: HsExpr GhcRn -> OccName -> ExpRhoType -> TcM (HsExpr GhcTcId)
-- Typecheck an occurrence of an unbound Id
--
-- Some of these started life as a true expression hole "_".
@@ -1857,12 +1857,11 @@ tcUnboundId :: HsExpr GhcRn -> UnboundVar -> ExpRhoType -> TcM (HsExpr GhcTcId)
-- 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 rn_expr unbound res_ty
+tcUnboundId rn_expr occ res_ty
= do { ty <- newOpenFlexiTyVarTy -- Allow Int# etc (#12531)
- ; let occ = unboundVarOcc unbound
; name <- newSysName occ
; let ev = mkLocalId name ty
- ; can <- newHoleCt (ExprHole unbound) ev ty
+ ; can <- newHoleCt ExprHole ev ty
; emitInsoluble can
; tcWrapResultO (UnboundOccurrenceOf occ) rn_expr
(HsVar noExtField (noLoc ev)) ty res_ty }
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index fb7dc117c1..f1bc51f56d 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -960,7 +960,8 @@ zonkExpr env (HsWrap x co_fn expr)
new_expr <- zonkExpr env1 expr
return (HsWrap x new_co_fn new_expr)
-zonkExpr _ e@(HsUnboundVar {}) = return e
+zonkExpr _ e@(HsUnboundVar {})
+ = return e
zonkExpr _ expr = pprPanic "zonkExpr" (ppr expr)
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 8a15d9cd44..ebd531ec13 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -183,13 +183,14 @@ newWanteds :: CtOrigin -> ThetaType -> TcM [CtEvidence]
newWanteds orig = mapM (newWanted orig Nothing)
-- | Create a new 'CHoleCan' 'Ct'.
-newHoleCt :: Hole -> Id -> Type -> TcM Ct
+newHoleCt :: HoleSort -> Id -> Type -> TcM Ct
newHoleCt hole ev ty = do
loc <- getCtLocM HoleOrigin Nothing
pure $ CHoleCan { cc_ev = CtWanted { ctev_pred = ty
, ctev_dest = EvVarDest ev
, ctev_nosh = WDeriv
, ctev_loc = loc }
+ , cc_occ = getOccName ev
, cc_hole = hole }
----------------------------------------------
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index cda34f07d8..22606871aa 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -586,8 +586,11 @@ tc_rn_src_decls ds
{ Nothing -> return (tcg_env, tcl_env, lie1)
-- If there's a splice, we must carry on
- ; Just (SpliceDecl _ (dL->L loc splice) _, rest_ds) ->
- do { recordTopLevelSpliceLoc loc
+ ; Just (SpliceDecl _ (dL->L _ splice) _, rest_ds) ->
+ do {
+ -- We need to simplify any constraints from the previous declaration
+ -- group, or else we might reify metavariables, as in #16980.
+ ; ev_binds1 <- simplifyTop lie1
-- Rename the splice expression, and get its supporting decls
; (spliced_decls, splice_fvs) <- rnTopSpliceDecls splice
@@ -595,9 +598,10 @@ tc_rn_src_decls ds
-- Glue them on the front of the remaining decls and loop
; (tcg_env, tcl_env, lie2) <-
setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
+ addTopEvBinds ev_binds1 $
tc_rn_src_decls (spliced_decls ++ rest_ds)
- ; return (tcg_env, tcl_env, lie1 `andWC` lie2)
+ ; return (tcg_env, tcl_env, lie2)
}
; Just (XSpliceDecl nec, _) -> noExtCon nec
}
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index f788b3e001..fe3f3e6d4c 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -107,8 +107,8 @@ module TcRnMonad(
emitNamedWildCardHoleConstraints, emitAnonWildCardHoleConstraint,
-- * Template Haskell context
- recordThUse, recordThSpliceUse, recordTopLevelSpliceLoc,
- getTopLevelSpliceLocs, keepAlive, getStage, getStageAndBindLevel, setStage,
+ recordThUse, recordThSpliceUse,
+ keepAlive, getStage, getStageAndBindLevel, setStage,
addModFinalizersWithLclEnv,
-- * Safe Haskell context
@@ -183,8 +183,6 @@ import qualified GHC.LanguageExtensions as LangExt
import Data.IORef
import Control.Monad
-import Data.Set ( Set )
-import qualified Data.Set as Set
import {-# SOURCE #-} TcEnv ( tcInitTidyEnv )
@@ -214,7 +212,6 @@ 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) ;
dfun_n_var <- newIORef emptyOccSet ;
type_env_var <- case hsc_type_env_var hsc_env of {
@@ -274,8 +271,6 @@ 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,
@@ -1681,7 +1676,8 @@ emitAnonWildCardHoleConstraint tv
; emitInsolubles $ unitBag $
CHoleCan { cc_ev = CtDerived { ctev_pred = mkTyVarTy tv
, ctev_loc = ct_loc }
- , cc_hole = TypeHole (mkTyVarOcc "_") } }
+ , cc_occ = mkTyVarOcc "_"
+ , cc_hole = TypeHole } }
emitNamedWildCardHoleConstraints :: [(Name, TcTyVar)] -> TcM ()
emitNamedWildCardHoleConstraints wcs
@@ -1693,7 +1689,8 @@ emitNamedWildCardHoleConstraints wcs
do_one ct_loc (name, tv)
= CHoleCan { cc_ev = CtDerived { ctev_pred = mkTyVarTy tv
, ctev_loc = ct_loc' }
- , cc_hole = TypeHole (occName name) }
+ , cc_occ = occName name
+ , cc_hole = TypeHole }
where
real_span = case nameSrcSpan name of
RealSrcSpan span -> span
@@ -1768,22 +1765,6 @@ 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 86b975859f..f95f853a70 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -136,7 +136,7 @@ module TcRnTypes(
-- Misc other types
TcId, TcIdSet,
- Hole(..), holeOcc,
+ HoleSort(..),
NameShape(..),
-- Role annotations
@@ -197,7 +197,7 @@ import CostCentreState
import Control.Monad (ap, msum)
import qualified Control.Monad.Fail as MonadFail
-import Data.Set ( Set )
+import Data.Set ( Set )
import qualified Data.Set as S
import Data.List ( sort )
@@ -573,10 +573,6 @@ 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.
@@ -1785,7 +1781,8 @@ data Ct
-- Treated as an "insoluble" constraint
-- See Note [Insoluble constraints]
cc_ev :: CtEvidence,
- cc_hole :: Hole
+ cc_occ :: OccName, -- The name of this hole
+ cc_hole :: HoleSort -- The sort of this hole (expr, type, ...)
}
| CQuantCan QCInst -- A quantified constraint
@@ -1808,27 +1805,19 @@ instance Outputable QCInst where
ppr (QCI { qci_ev = ev }) = ppr ev
------------
--- | 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)
-
-instance Outputable Hole where
- ppr (ExprHole ub) = ppr ub
- ppr (TypeHole occ) = text "TypeHole" <> parens (ppr occ)
-
-holeOcc :: Hole -> OccName
-holeOcc (ExprHole uv) = unboundVarOcc uv
-holeOcc (TypeHole occ) = occ
+-- | Used to indicate which sort of hole we have.
+data HoleSort = ExprHole
+ -- ^ Either an out-of-scope variable or a "true" hole in an
+ -- expression (TypedHoles)
+ | TypeHole
+ -- ^ A hole in a type (PartialTypeSignatures)
{- Note [Hole constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~
CHoleCan constraints are used for two kinds of holes,
distinguished by cc_hole:
- * For holes in expressions (including variables not in scope)
+ * For holes in expressions
e.g. f x = g _ x
* For holes in type signatures
@@ -1945,7 +1934,7 @@ instance Outputable Ct where
CIrredCan { cc_insol = insol }
| insol -> text "CIrredCan(insol)"
| otherwise -> text "CIrredCan(sol)"
- CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr hole
+ CHoleCan { cc_occ = occ } -> text "CHoleCan:" <+> ppr occ
CQuantCan (QCI { qci_pend_sc = pend_sc })
| pend_sc -> text "CQuantCan(psc)"
| otherwise -> text "CQuantCan"
@@ -2227,17 +2216,18 @@ isHoleCt (CHoleCan {}) = True
isHoleCt _ = False
isOutOfScopeCt :: Ct -> Bool
--- 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
+-- 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)
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
@@ -3709,7 +3699,7 @@ lexprCtOrigin (L _ e) = exprCtOrigin e
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
-exprCtOrigin (HsUnboundVar _ uv) = UnboundOccurrenceOf (unboundVarOcc uv)
+exprCtOrigin (HsUnboundVar _ uv) = UnboundOccurrenceOf uv
exprCtOrigin (HsConLikeOut {}) = panic "exprCtOrigin HsConLikeOut"
exprCtOrigin (HsRecFld _ f) = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)
exprCtOrigin (HsOverLabel _ _ l) = OverLabelOrigin l
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 2c930cbd30..7efaf2f29a 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -31,7 +31,6 @@ import GhcPrelude
import Bag
import Class ( Class, classKey, classTyCon )
import DynFlags
-import GHC.Hs.Expr ( UnboundVar(..) )
import Id ( idType, mkLocalId )
import Inst
import ListSetOps
@@ -39,7 +38,6 @@ import Name
import Outputable
import PrelInfo
import PrelNames
-import RdrName ( emptyGlobalRdrEnv )
import TcErrors
import TcEvidence
import TcInteract
@@ -657,8 +655,7 @@ tcNormalise given_ids ty
let occ = mkVarOcc "$tcNorm"
name <- newSysName occ
let ev = mkLocalId name ty
- hole = ExprHole $ OutOfScope occ emptyGlobalRdrEnv
- newHoleCt hole ev ty
+ newHoleCt ExprHole ev ty
{- Note [Superclasses and satisfiability]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
index dc6e9762f5..2a04742a53 100644
--- a/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
+++ b/testsuite/tests/plugins/hole-fit-plugin/HoleFitPlugin.hs
@@ -34,8 +34,8 @@ fromModule (GreHFCand gre) =
fromModule _ = []
toHoleFitCommand :: TypedHole -> String -> Maybe String
-toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h)} str
- = stripPrefix ("_" <> str) $ occNameString $ holeOcc h
+toHoleFitCommand TyH{tyHCt = Just (CHoleCan _ h _)} str
+ = stripPrefix ("_" <> str) $ occNameString h
toHoleFitCommand _ _ = Nothing
diff --git a/testsuite/tests/th/T10267.stderr b/testsuite/tests/th/T10267.stderr
index 71aca96b86..6262bf72ff 100644
--- a/testsuite/tests/th/T10267.stderr
+++ b/testsuite/tests/th/T10267.stderr
@@ -27,58 +27,7 @@ T10267.hs:8:1: error:
j :: forall a0. a0 -> a0
with j @a
(bound at T10267.hs:8:1)
- k :: forall a. a -> a
- with k @a
- (defined at T10267.hs:14:3)
- l :: forall a. a -> a
- with l @a
- (defined at T10267.hs:23:3)
- foo :: forall a. a -> a
- with foo @a
- (defined at T10267.hs:33:1)
id :: forall a. a -> a
with id @a
(imported from ‘Prelude’ at T10267.hs:3:8-13
(and originally defined in ‘GHC.Base’))
-
-T10267.hs:14:3: error:
- • Found hole: _foo :: a -> a
- Where: ‘a’ is a rigid type variable bound by
- the type signature for:
- k :: forall a. a -> a
- at T10267.hs:(14,3)-(21,2)
- Or perhaps ‘_foo’ is mis-spelled, or not in scope
- • In the expression: _foo
- In an equation for ‘k’: k = _foo
- • Relevant bindings include k :: a -> a (bound at T10267.hs:14:3)
- Valid hole fits include
- k :: a -> a (bound at T10267.hs:14:3)
- j :: forall a0. a0 -> a0
- with j @a
- (bound at T10267.hs:8:1)
- i :: forall a0. a0 -> a0
- with i @a
- (bound at T10267.hs:8:1)
- l :: forall a. a -> a
- with l @a
- (defined at T10267.hs:23:3)
- foo :: forall a. a -> a
- with foo @a
- (defined at T10267.hs:33:1)
- id :: forall a. a -> a
- with id @a
- (imported from ‘Prelude’ at T10267.hs:3:8-13
- (and originally defined in ‘GHC.Base’))
-
-T10267.hs:23:3: error:
- • Found hole: _ :: a
- Where: ‘a’ is a rigid type variable bound by
- the type signature for:
- l :: forall a. a -> a
- at T10267.hs:(23,3)-(30,2)
- • In the expression: _
- In an equation for ‘l’: l x = _
- • Relevant bindings include
- x :: a (bound at T10267.hs:23:3)
- l :: a -> a (bound at T10267.hs:23:3)
- Valid hole fits include x :: a (bound at T10267.hs:23:3)
diff --git a/testsuite/tests/th/T11680.stderr b/testsuite/tests/th/T11680.stderr
index 5788490f35..07d88403f1 100644
--- a/testsuite/tests/th/T11680.stderr
+++ b/testsuite/tests/th/T11680.stderr
@@ -5,25 +5,17 @@ T11680.hs:20:7: error:
• Variable not in scope: abce :: [a]
• Perhaps you meant ‘abcd’ (line 23)
-T11680.hs:31:7: error:
- • Variable not in scope: foo :: Int
- • ‘foo’ (line 100) is not in scope before the splice on line 96
+T11680.hs:31:7: error: Variable not in scope: foo :: Int
T11680.hs:39:7: error:
• Variable not in scope: bar :: ()
- • ‘bar’ (line 110) is not in scope
- before the splice on lines 106-108
- Perhaps you meant one of these: ‘bat’ (line 42), ‘baz’ (line 45)
+ • Perhaps you meant one of these: ‘bat’ (line 42), ‘baz’ (line 45)
-T11680.hs:50:7: error:
- • Variable not in scope: ns :: [Double]
- • ‘ns’ (splice on lines 106-108) is not in scope before line 106
+T11680.hs:50:7: error: Variable not in scope: ns :: [Double]
T11680.hs:55:7: error:
• Variable not in scope: intercalate
- • ‘intercalate’ (line 114) is not in scope
- before the splice on lines 106-108
- Perhaps you meant ‘List.intercalate’ (imported from Data.List)
+ • Perhaps you meant ‘List.intercalate’ (imported from Data.List)
T11680.hs:59:7: error:
• Variable not in scope: nub
@@ -33,17 +25,4 @@ T11680.hs:64:7: error: Variable not in scope: x :: t0 -> Int
T11680.hs:69:7: error:
• Variable not in scope: cat :: ()
- • ‘cat’ (splice on lines 79-86) is not in scope before line 79
- Perhaps you meant ‘bat’ (line 42)
-
-T11680.hs:79:3: error:
- • Variable not in scope: cab
- • Perhaps you meant ‘cap’ (line 79)
-
-T11680.hs:79:3: error:
- • Variable not in scope: cab
- • Perhaps you meant one of these: ‘cat’ (line 79), ‘cap’ (line 79)
-
-T11680.hs:91:8: error:
- • Variable not in scope: cat :: ()
- • Perhaps you meant one of these: ‘bat’ (line 42), ‘cap’ (line 79)
+ • Perhaps you meant ‘bat’ (line 42)
diff --git a/testsuite/tests/th/T16980.hs b/testsuite/tests/th/T16980.hs
new file mode 100644
index 0000000000..5acd455a07
--- /dev/null
+++ b/testsuite/tests/th/T16980.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T16980 where
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Ppr
+
+import System.IO
+
+aNumber = 5
+
+do VarI name1 t1 _ <- reify 'aNumber
+ runIO . print $ ppr_sig name1 t1
+ runIO . print =<< reifyType 'aNumber
+ runIO $ hFlush stdout
+ return []
diff --git a/testsuite/tests/th/T16980.stderr b/testsuite/tests/th/T16980.stderr
new file mode 100644
index 0000000000..b9d25b4aab
--- /dev/null
+++ b/testsuite/tests/th/T16980.stderr
@@ -0,0 +1,2 @@
+T16980.aNumber :: GHC.Integer.Type.Integer
+ConT GHC.Integer.Type.Integer
diff --git a/testsuite/tests/th/T16980a.hs b/testsuite/tests/th/T16980a.hs
new file mode 100644
index 0000000000..b3024c4a41
--- /dev/null
+++ b/testsuite/tests/th/T16980a.hs
@@ -0,0 +1,10 @@
+module T16980a where
+
+default (Integer) -- just to be really explicit
+
+x = 5 -- this should be an Integer
+
+$(return [])
+
+y :: Int
+y = x -- this should be a type error; types cannot communicate across splices
diff --git a/testsuite/tests/th/T16980a.stderr b/testsuite/tests/th/T16980a.stderr
new file mode 100644
index 0000000000..52673a8779
--- /dev/null
+++ b/testsuite/tests/th/T16980a.stderr
@@ -0,0 +1,5 @@
+
+T16980a.hs:10:5: error:
+ • Couldn't match expected type ‘Int’ with actual type ‘Integer’
+ • In the expression: x
+ In an equation for ‘y’: y = x
diff --git a/testsuite/tests/th/T2222.stderr b/testsuite/tests/th/T2222.stderr
index 3265a5e938..c65f7da665 100644
--- a/testsuite/tests/th/T2222.stderr
+++ b/testsuite/tests/th/T2222.stderr
@@ -1,4 +1,4 @@
-inside b: p_0
+inside b: GHC.Integer.Type.Integer
inside d: GHC.Types.Bool
type of c: GHC.Types.Bool
inside f: GHC.Types.Bool
diff --git a/testsuite/tests/th/T5358.stderr b/testsuite/tests/th/T5358.stderr
index 4bfc53a78e..cc1df54bed 100644
--- a/testsuite/tests/th/T5358.stderr
+++ b/testsuite/tests/th/T5358.stderr
@@ -1,4 +1,34 @@
+T5358.hs:7:1: error:
+ • Couldn't match expected type ‘Int’ with actual type ‘p1 -> p1’
+ • The equation(s) for ‘t1’ have one argument,
+ but its type ‘Int’ has none
+
+T5358.hs:8:1: error:
+ • Couldn't match expected type ‘Int’ with actual type ‘p0 -> p0’
+ • The equation(s) for ‘t2’ have one argument,
+ but its type ‘Int’ has none
+
+T5358.hs:10:13: error:
+ • Couldn't match expected type ‘t -> a0’ with actual type ‘Int’
+ • The function ‘t1’ is applied to one argument,
+ but its type ‘Int’ has none
+ In the first argument of ‘(==)’, namely ‘t1 x’
+ In the expression: t1 x == t2 x
+ • Relevant bindings include
+ x :: t (bound at T5358.hs:10:9)
+ prop_x1 :: t -> Bool (bound at T5358.hs:10:1)
+
+T5358.hs:10:21: error:
+ • Couldn't match expected type ‘t -> a0’ with actual type ‘Int’
+ • The function ‘t2’ is applied to one argument,
+ but its type ‘Int’ has none
+ In the second argument of ‘(==)’, namely ‘t2 x’
+ In the expression: t1 x == t2 x
+ • Relevant bindings include
+ x :: t (bound at T5358.hs:10:9)
+ prop_x1 :: t -> Bool (bound at T5358.hs:10:1)
+
T5358.hs:14:12: error:
• Exception when trying to run compile-time code:
runTest called error: forall (t_0 :: *) . t_0 -> GHC.Types.Bool
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 5aa0e4df26..590b060b0b 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -483,3 +483,5 @@ test('T16895e', normal, compile_fail, [''])
test('T16976', normal, compile, [''])
test('T16976f', normal, compile_fail, [''])
test('T16976z', normal, compile_fail, [''])
+test('T16980', normal, compile, [''])
+test('T16980a', normal, compile_fail, [''])
diff --git a/testsuite/tests/typecheck/should_fail/T12589.stderr b/testsuite/tests/typecheck/should_fail/T12589.stderr
index 3f380e47a4..07acb0a1b3 100644
--- a/testsuite/tests/typecheck/should_fail/T12589.stderr
+++ b/testsuite/tests/typecheck/should_fail/T12589.stderr
@@ -7,5 +7,5 @@ T12589.hs:13:5: error:
(forall a. Bounded a => f0 a) -> h0 f0 xs0
GHC doesn't yet support impredicative polymorphism
• In the second argument of ‘(&)’, namely ‘hcpure (Proxy @Bounded)’
- In the expression: (&) minBound hcpure (Proxy @Bounded)
- In an equation for ‘a’: a = (&) minBound hcpure (Proxy @Bounded)
+ In the expression: minBound & hcpure (Proxy @Bounded)
+ In an equation for ‘a’: a = minBound & hcpure (Proxy @Bounded)