summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <rae@richarde.dev>2019-09-26 14:31:30 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-10-08 13:26:20 -0400
commit9612e91c793830b3049d2bc9a9ee28d9d82b928d (patch)
treef34d5c1f295026aaf1e706b8e2d20426fad6ac23
parentbf02c26402cf926d41c006ab930ed9747e92a373 (diff)
downloadhaskell-9612e91c793830b3049d2bc9a9ee28d9d82b928d.tar.gz
Solve constraints from top-level groups sooner
Previously, all constraints from all top-level groups (as separated by top-level splices) were lumped together and solved at the end. This could leak metavariables to TH, though, and that's bad. This patch solves each group's constraints before running the next group's splice. Naturally, we now report fewer errors in some cases. One nice benefit is that this also fixes #11680, but in a much simpler way than the original fix for that ticket. Admittedly, the error messages degrade just a bit from the fix from #11680 (previously, we informed users about variables that will be brought into scope below a top-level splice, and now we just report an out-of-scope error), but the amount of complexity required throughout GHC to get that error was just not worth it. This patch thus reverts much of f93c9517a2c6e158e4a5c5bc7a3d3f88cb4ed119. Fixes #16980 Test cases: th/T16980{,a}
-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)