[Git][ghc/ghc][wip/ani/kill-SrcCodeOrigin] route the correct ExpectedFunTyCtxt SDoc. Add missing RecordUpdCtxt to errCtxtCtOrigin
by Apoorv Ingle (＠ani) 09 Mar '26
by Apoorv Ingle (＠ani) 09 Mar '26
09 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC
Commits:
643f650f by Apoorv Ingle at 2026-03-09T01:21:07-05:00
route the correct ExpectedFunTyCtxt SDoc. Add missing RecordUpdCtxt to errCtxtCtOrigin
- - - - -
1 changed file:
- compiler/GHC/Tc/Types/Origin.hs
Changes:
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -639,6 +639,7 @@ errCtxtCtOrigin (FunAppCtxt (FunAppCtxtExpr _ e) _) = exprCtOrigin e
errCtxtCtOrigin (StmtErrCtxt{}) = DoStmtOrigin
errCtxtCtOrigin (DoStmtErrCtxt{}) = DoStmtOrigin
errCtxtCtOrigin (StmtErrCtxtPat _ _ p) = DoPatOrigin p
+errCtxtCtOrigin (RecordUpdCtxt{}) = RecordUpdOrigin
errCtxtCtOrigin _ = Shouldn'tHappenOrigin "errCtxtCtOrigin"
@@ -1169,7 +1170,7 @@ pprFixedRuntimeRepContext FRRBindStmtGuard
pprFixedRuntimeRepContext (FRRArrow arrowContext)
= pprFRRArrowContext arrowContext
pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig _)
- = pprExpectedFunTyHerald funTyOrig
+ = pprExpectedFunTyCtxt funTyOrig
pprFixedRuntimeRepContext (FRRDeepSubsumption is_exp pos mb_fun)
= hsep [ text "The", what, text "type of the"
, ppr (Argument pos)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/643f650f97f0fae43fbb3b09a24103c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/643f650f97f0fae43fbb3b09a24103c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/kill-SrcCodeOrigin] trying out ErrCtxtMsg zonking
by Apoorv Ingle (＠ani) 09 Mar '26
by Apoorv Ingle (＠ani) 09 Mar '26
09 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC
Commits:
b611de8e by Apoorv Ingle at 2026-03-09T00:58:26-05:00
trying out ErrCtxtMsg zonking
- - - - -
4 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
Changes:
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -1064,6 +1064,7 @@ instance Outputable XXExprGhcRn where
pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e)
pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat)
+ pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e)
pprCtxt _ = empty
instance Outputable XXExprGhcTc where
@@ -1079,6 +1080,7 @@ instance Outputable XXExprGhcTc where
pprCtxt (ExprCtxt e) = ppr_builder "<OrigExpr>:" (ppr e)
pprCtxt (StmtErrCtxt _ stmt) = ppr_builder "<OrigStmt>:" (ppr stmt)
pprCtxt (StmtErrCtxtPat _ _ pat) = ppr_builder "<OrigPat>:" (ppr pat)
+ pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:" (ppr e)
pprCtxt _ = empty
-- e is the expanded expression, we print the original
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1961,18 +1961,20 @@ mkErrCtxt env ctxts
= go False 0 env ctxts -- regular error ctx
where
go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
- go _ _ _ [] = return []
+ go _ _ _ [] = return []
go dbg n env (MkErrCtxt LandmarkUserSrcCode ctxt : ctxts)
- = do { -- (env', msg) <- liftZonkM $ emptyTidyEnv env
- ; rest <- go dbg n env ctxts
- ; return (ctxt : rest) }
+ = do { (env', msg) <- liftZonkM $ zonkTidyErrCtxtMsg env ctxt
+ ; rest <- go dbg n env' ctxts
+ ; return (msg : rest) }
go dbg n env (MkErrCtxt _ ctxt : ctxts)
| n < mAX_CONTEXTS -- Too verbose || dbg
- = do { -- (env', msg) <- liftZonkM $ emptyTidyEnv env
- ; rest <- go dbg (n+1) env ctxts
- ; return (ctxt : rest) }
- | otherwise
- = go dbg n env ctxts -- need to compute this for zonking
+ = do { (env', msg) <- liftZonkM $ zonkTidyErrCtxtMsg env ctxt
+ ; rest <- go dbg (n+1) env' ctxts
+ ; return (msg : rest) }
+ | otherwise -- need to compute this for zonking
+ = do { (env', _) <- liftZonkM $ zonkTidyErrCtxtMsg env ctxt
+ ; go dbg n env' ctxts
+ }
mAX_CONTEXTS :: Int -- No more than this number of non-landmark contexts
=====================================
compiler/GHC/Tc/Zonk/TcType.hs
=====================================
@@ -49,7 +49,7 @@ module GHC.Tc.Zonk.TcType
, tidyCt, tidyEvVar, tidyDelayedError
-- ** Zonk & tidy
- , zonkTidyTcType, zonkTidyTcTypes
+ , zonkTidyTcType, zonkTidyTcTypes, zonkTidyErrCtxtMsg
, zonkTidyOrigin, zonkTidyOrigins
, zonkTidyFRRInfos
@@ -793,3 +793,171 @@ tidyFRROrigin env (FixedRuntimeRepOrigin ty orig)
tidyEvVar :: TidyEnv -> EvVar -> EvVar
tidyEvVar env var = updateIdTypeAndMult (tidyType env) var
-- No need for tidyOpenType because all the free tyvars are already tidied
+
+
+
+{-
+Zonk ErrCtxtMsg
+-}
+
+zonkTidyErrCtxtMsg :: TidyEnv -> ErrCtxtMsg -> ZonkM (TidyEnv, ErrCtxtMsg)
+zonkTidyErrCtxtMsg env e@(ExprCtxt{}) = return (env, e)
+zonkTidyErrCtxtMsg env (ThetaCtxt ctxt theta_ty) = do
+ (env', theta_ty') <- zonkTidyTcTypes env theta_ty
+ return $ (env', ThetaCtxt ctxt theta_ty')
+-- zonkTidyErrCtxtMsg env (QuantifiedCtCtxt ty) = do
+-- (env', ty') <- zonkTidyTcTypes env ty
+-- return $ QuantifiedCtCtxt ty'
+zonkTidyErrCtxtMsg env (InferredTypeCtxt n ty) = do
+ (env', ty') <- zonkTidyTcType env ty
+ return $ (env', InferredTypeCtxt n ty')
+-- zonkTidyErrCtxtMsg (RecordUpdCtxt n1 n2 tys) = do
+-- tys' <- lift $ mapM zonkTcTypeToType tys
+-- return $ RecordUpdCtxt n1 n2 tys'
+zonkTidyErrCtxtMsg env (ClassOpCtxt n ty) = do
+ (env', ty') <- zonkTidyTcType env ty
+ return $ (env', ClassOpCtxt n ty')
+zonkTidyErrCtxtMsg env (MethSigCtxt n ty1 ty2) = do
+ (env', ty1) <- zonkTidyTcType env ty1
+ (env', ty2) <- zonkTidyTcType env ty2
+ return $ (env', MethSigCtxt n ty1 ty2)
+-- zonkTidyErrCtxtMsg (PatSigErrCtxt ty exp_ty) = do
+-- ty' <- lift $ zonkTcTypeToType ty
+-- exp_ty' <- lift $ readExpType_maybe exp_ty
+-- case exp_ty' of
+-- Nothing -> error "zonkTidyErrCtxtMsg PatSingErrCtxt"
+-- Just exp_ty' -> do
+-- exp_ty' <- lift $ zonkTcTypeToType exp_ty'
+-- return $ PatSigErrCtxt ty' exp_ty'
+
+zonkTidyErrCtxtMsg env e@(FunAppCtxt{}) = return (env, e)
+zonkTidyErrCtxtMsg env (FunTysCtxt ctxt ty i1 i2) = do
+ (env', ty') <- zonkTidyTcType env ty
+ return $ (env', FunTysCtxt ctxt ty' i1 i2)
+zonkTidyErrCtxtMsg env (FunResCtxt e i1 ty1 ty2 i2 i3) = do
+ (env', ty1') <- zonkTidyTcType env ty1
+ (env', ty2') <- zonkTidyTcType env ty2
+ return $ (env', FunResCtxt e i1 ty1' ty2' i2 i3)
+zonkTidyErrCtxtMsg env p = return (env, p)
+{-
+ -- or a type signature, or... (see 'Sig').
+ | SigCtxt !(Sig GhcRn)
+ -- | In a user-written type signature.
+ | UserSigCtxt !UserTypeCtxt !UserSigType
+
+ -- | In a pattern.
+ | PatCtxt !(Pat GhcRn)
+ -- | In a pattern synonym declaration.
+ | PatSynDeclCtxt !Name
+ -- | In a pattern matching context, e.g. a equation for a function binding,
+ -- or a case alternative, ...
+ | MatchCtxt !HsMatchContextRn
+ -- | In a match in a pattern matching context,
+ -- either for an expression or for an arrow command.
+ | forall body. (Outputable body)
+ => MatchInCtxt !(Match GhcRn body)
+ -- | In the declaration of a type constructor.
+ | TyConDeclCtxt !Name !(TyConFlavour TyCon)
+ -- | In a type or data family instance (or default instance).
+ | TyConInstCtxt !Name !TyConInstFlavour
+ -- | In the declaration of a data constructor.
+ | DataConDefCtxt !(NE.NonEmpty (LocatedN Name))
+ -- | In the result type of a data constructor.
+ | DataConResTyCtxt !(NE.NonEmpty (LocatedN Name))
+ -- | In the equations for a closed type family.
+ | ClosedFamEqnCtxt !TyCon
+ -- | In the expansion of a type synonym.
+ | TySynErrCtxt !TyCon
+ -- | In a role annotation.
+ | RoleAnnotErrCtxt !Name
+ -- | In an arrow command.
+ | CmdCtxt !(HsCmd GhcRn)
+ -- | In an instance declaration.
+ | InstDeclErrCtxt !(Either (LHsType GhcRn) PredType)
+ -- | In a default declaration.
+ | DefaultDeclErrCtxt { ddec_in_type_list :: !Bool }
+ -- | In the body of a static form.
+ | StaticFormCtxt !(LHsExpr GhcRn)
+ -- | In a pattern binding.
+ | forall p. OutputableBndrId p
+ => PatMonoBindsCtxt !(LPat (GhcPass p)) !(GRHSs GhcRn (LHsExpr GhcRn))
+ -- | In a foreign import/export declaration.
+ | ForeignDeclCtxt !(ForeignDecl GhcRn)
+ -- | In a record field.
+ | FieldCtxt !FieldLabelString
+ -- | In a type.
+ | TypeCtxt !(LHsType GhcRn)
+ -- | In a kind.
+ | KindCtxt !(LHsKind GhcRn)
+ -- | In an ambiguity check.
+ | AmbiguityCheckCtxt !UserTypeCtxt !Bool
+
+ -- | In a term-level use of a 'Name'.
+ | TermLevelUseCtxt !Name !TermLevelUseCtxt
+
+ -- | When checking the type of the @main@ function.
+ | MainCtxt !Name
+ -- | Warning emitted when inferring use of visible dependent quantification.
+ | VDQWarningCtxt !TcTyCon
+
+ -- | In a statement
+ | forall body.
+ ( Anno (StmtLR GhcRn GhcRn body) ~ SrcSpanAnnA
+ , Outputable body
+ ) => StmtErrCtxt !HsStmtContextRn !(StmtLR GhcRn GhcRn body)
+
+ -- | In a do statement.
+ | DoStmtErrCtxt !HsStmtContextRn !(ExprLStmt GhcRn)
+
+ -- | In patten of the do statement. (c.f. MonadFailErrors)
+ | StmtErrCtxtPat !HsStmtContextRn !(ExprLStmt GhcRn) (LPat GhcRn)
+
+ -- | In an rebindable syntax expression.
+ | SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan
+ -- | In a RULE.
+ | RuleCtxt !FastString
+ -- | In a subtype check.
+ | SubTypeCtxt !TcType !TcType
+
+ -- | In an export.
+ | forall p. OutputableBndrId p
+ => ExportCtxt (IE (GhcPass p))
+ -- | In an export of a pattern synonym.
+ | PatSynExportCtxt !PatSyn
+ -- | In an export of a pattern synonym record field.
+ | PatSynRecSelExportCtxt !PatSyn !Name
+
+ -- | In an annotation.
+ | forall p. OutputableBndrId p
+ => AnnCtxt (AnnDecl (GhcPass p))
+
+ -- | In a specialise pragma.
+ | SpecPragmaCtxt !(Sig GhcRn)
+
+ -- | In a deriving clause.
+ | DerivInstCtxt !PredType
+ -- | In a standalone deriving clause.
+ | StandaloneDerivCtxt !(LHsSigWcType GhcRn)
+ -- | When typechecking the body of a derived instance.
+ | DerivBindCtxt !Id !Class ![Type]
+
+ -- | In an untyped Template Haskell quote.
+ | UntypedTHBracketCtxt !(HsQuote GhcPs)
+ -- | In a typed Template Haskell quote.
+ | forall p. OutputableBndrId p
+ => TypedTHBracketCtxt !(LHsExpr (GhcPass p))
+ -- | In an untyped Template Haskell splice or quasi-quote.
+ | UntypedSpliceCtxt !(HsUntypedSplice GhcPs)
+ -- | In a typed Template Haskell splice.
+ | forall p. OutputableBndrId p
+ => TypedSpliceCtxt !(Maybe SplicePointName) !(HsTypedSplice (GhcPass p))
+ -- | In the result of a typed Template Haskell splice.
+ | TypedSpliceResultCtxt !(LHsExpr GhcTc)
+ -- | In an argument to the Template Haskell @reifyInstances@ function.
+ | ReifyInstancesCtxt !TH.Name ![TH.Type]
+
+ -- | While merging Backpack signatures.
+ | MergeSignaturesCtxt !UnitState !ModuleName ![InstantiatedModule]
+ -- | While checking that a module implements a Backpack signature.
+ | CheckImplementsCtxt !UnitState !Module !InstantiatedModule
+-}
=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -2005,4 +2005,3 @@ Quantifying here is awkward because (a) the data type is big and (b)
finding the free type vars of an expression is necessarily monadic
operation. (consider /\a -> f @ b, where b is side-effected to a)
-}
-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b611de8e019ea78a89a98fb061ac9a7…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b611de8e019ea78a89a98fb061ac9a7…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/kill-SrcCodeOrigin] remove CtOrigin.ExpansionOrigin in favour of errCtxtCtOrigin, remove CtOrign...
by Apoorv Ingle (＠ani) 09 Mar '26
by Apoorv Ingle (＠ani) 09 Mar '26
09 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC
Commits:
a648f030 by Apoorv Ingle at 2026-03-08T22:00:00-05:00
remove CtOrigin.ExpansionOrigin in favour of errCtxtCtOrigin, remove CtOrign from ErrMsgCtxt.FunTysCtxt
- - - - -
14 changed files:
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/Origin.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -642,7 +642,7 @@ deriving instance Eq (IE GhcTc)
-- TODO: I think we still need instances for StmtCtxt, ExprCtxt and PatCtxt ctors of ErrCtxtMsg
instance Data ErrCtxtMsg where
gunfold _ _ _ = error "no gunfold for ErrCtxtMsg"
- gfoldl _ _ _ = error "no goldl for ErrCtxtMsg"
+ gfoldl _ _ _ = error "no gfoldl for ErrCtxtMsg"
toConstr = error "no toConstr for ErrCtxtMsg"
dataTypeOf = error "no dataTypeOf for ErrCtxtMsg"
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -83,7 +83,6 @@ import qualified GHC.Data.Strict as Strict
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
-import Language.Haskell.Syntax (HsExpr (RecordUpd, HsGetField, HsProjection))
import Control.Monad ( when, foldM, forM_ )
import Data.Bifunctor ( bimap )
@@ -2778,10 +2777,6 @@ isHasFieldOrigin = \case
RecordUpdOrigin {} -> True
RecordFieldProjectionOrigin {} -> True
GetFieldOrigin {} -> True
- ExpansionOrigin (ExprCtxt e)
- | HsGetField{} <- e -> True
- | RecordUpd{} <- e -> True
- | HsProjection{} <- e -> True
_ -> False
-----------------------
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -7798,6 +7798,7 @@ pprErrCtxtMsg = \case
| otherwise
-> empty
+ -- text "Debug" <+> vcat [ppr fun, ppr n_val_args, ppr res_fun, ppr res_env, ppr n_fun, ppr n_env]
where
not_fun ty -- ty is definitely not an arrow type,
-- and cannot conceivably become one
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -907,10 +907,10 @@ tcInstFun do_ql inst_final ds_flag (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigm
; return (mkScaled mult_ty arg_nu) }
- mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> CtOrigin
+ mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt
mk_herald tc_fun arg
= case fun_orig of
- ExpansionOrigin (StmtErrCtxt{}) -> ExpectedTySyntax DoStmtOrigin arg
+ DoStmtOrigin -> ExpectedTySyntax DoStmtOrigin arg
_ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg
-- Is the argument supposed to instantiate a forall?
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1068,7 +1068,7 @@ tcSynArgE orig op sigma_ty syn_ty thing_inside
-- fixed RuntimeRep, as needed to call mkWpFun.
; return (result, match_wrapper <.> fun_wrap) }
where
- herald = ExpectedFunTySyntaxOp 1 orig op
+ herald = ExpectedFunTySyntaxOp orig op
go rho_ty (SynType the_ty)
= do { wrap <- tcSubTypePat orig GenSigCtxt the_ty rho_ty
@@ -1097,7 +1097,7 @@ tcSynArgA orig op sigma_ty arg_shapes res_shape thing_inside
thing_inside (arg_results ++ res_results) (map scaledMult arg_tys ++ arg_res_mults)
; return (result, match_wrapper, arg_wrappers, res_wrapper) }
where
- herald = ExpectedFunTySyntaxOp (length arg_shapes) orig op
+ herald = ExpectedFunTySyntaxOp orig op
tc_syn_args_e :: [TcSigmaTypeFRR] -> [SyntaxOpType]
-> ([TcSigmaTypeFRR] -> [Mult] -> TcM a)
@@ -1849,4 +1849,3 @@ checkMissingFields con_like rbinds arg_tys
field_strs = conLikeImplBangs con_like
fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds
-
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -465,7 +465,7 @@ tcInferAppHead_maybe fun = case fun of
-- visible type applications in the argument.
-- c.f. T19167
(\ (e, ds_flag, ty) -> (mkExpandedTc o e, ds_flag, ty)) <$>
- tcExprSigma False (ExpansionOrigin o) e
+ tcExprSigma False (errCtxtCtOrigin o) e
)
_ -> return Nothing
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -114,7 +114,7 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
= assertPpr (funBindPrecondition matches) (pprMatches matches) $
do { -- Check that they all have the same no of arguments
arity <- checkArgCounts matches
- ; let herald = ExpectedFunTyMatches arity (NameThing fun_name) matches
+ ; let herald = ExpectedFunTyMatches (NameThing fun_name) matches
; traceTc "tcFunBindMatches 1" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)
; (wrap_fun, r)
=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -701,7 +701,7 @@ tc_pat scaled_exp_pat_ty@(Scaled w_pat exp_pat_ty) penv ps_pat thing_inside =
-- 'view_expr' must be a function; expose its argument/result types
-- using 'matchActualFunTy'.
- ; let herald = ExpectedFunTyViewPat 1 $ unLoc view_expr
+ ; let herald = ExpectedFunTyViewPat $ unLoc view_expr
; (view_expr_co1, Scaled _mult view_arg_ty, view_res_ty)
<- matchActualFunTy herald (Just . HsExprRnThing $ unLoc view_expr)
(1, view_expr_rho) view_expr_rho
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Tc.Instance.Typeable
import GHC.Tc.Utils.TcMType
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.CtLoc
-import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(ExpansionOrigin) )
+import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(GetFieldOrigin) )
import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcLookupDataFamInst, FamInstEnvs )
import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) )
@@ -1288,7 +1288,7 @@ warnIncompleteRecSel dflags sel_id ct_loc
-- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin,
-- despite the expansion to (getField @"x" r)
- isGetFieldOrigin (ExpansionOrigin (ExprCtxt (HsGetField {}))) = True
+ isGetFieldOrigin GetFieldOrigin{} = True
isGetFieldOrigin _ = False
lookupHasFieldLabel
=====================================
compiler/GHC/Tc/Types/ErrCtxt.hs
=====================================
@@ -21,7 +21,7 @@ import GHC.Hs.Extension
import GHC.Parser.Annotation ( LocatedN, SrcSpanAnnA )
import GHC.Tc.Errors.Types.PromotionErr ( TermLevelUseCtxt )
-import {-# SOURCE #-} GHC.Tc.Types.Origin ( CtOrigin )
+import {-# SOURCE #-} GHC.Tc.Types.Origin ( CtOrigin, ExpectedFunTyCtxt )
import GHC.Tc.Utils.TcType ( TcType, TcTyCon, ExpType )
import GHC.Types.Basic ( TyConFlavour )
@@ -283,7 +283,7 @@ data ErrCtxtMsg
-- | In a function application.
| FunAppCtxt !FunAppCtxtFunArg !Int
-- | In a function call.
- | FunTysCtxt !CtOrigin !Type !Int !Int
+ | FunTysCtxt !ExpectedFunTyCtxt !Type !Int !Int
-- | In the result of a function call.
| FunResCtxt !(HsExpr GhcTc) !Int !Type !Type !Int !Int
-- | In the declaration of a type constructor.
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -211,9 +211,6 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec)
-- See Note [ErrCtxtStack Manipulation]
setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt
setLclCtxtSrcCodeOrigin ec lclCtxt
- -- | ecs@(MkErrCtxt ExpansionCodeCtxt _ : _) <- tcl_err_ctxt lclCtxt
- -- , MkErrCtxt ExpansionCodeCtxt ExprCtxt{} <- ec
- -- = lclCtxt { tcl_err_ctxt = ec : ecs }
-- never stack 2 statement error contexts on top of each other
| MkErrCtxt _ DoStmtErrCtxt{} : ecs <- tcl_err_ctxt lclCtxt
, MkErrCtxt _ DoStmtErrCtxt{} <- ec
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -9,9 +9,8 @@ module GHC.Tc.Types.Origin (
-- * CtOrigin
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
- srcCodeOriginCtOrigin,
+ srcCodeOriginCtOrigin, errCtxtCtOrigin,
invisibleOrigin_maybe, isVisibleOrigin, toInvisibleOrigin,
- updatePositionCtOrigin,
pprCtOrigin, pprCtOriginBriefly, isGivenOrigin,
defaultReprEqOrigins, isWantedSuperclassOrigin,
ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..),
@@ -37,7 +36,7 @@ module GHC.Tc.Types.Origin (
FRRArrowContext(..), pprFRRArrowContext,
-- ** ExpectedFunTy FixedRuntimeRepOrigin
- pprExpectedFunTyHerald,
+ ExpectedFunTyCtxt(..), pprExpectedFunTyCtxt, pprExpectedFunTyHerald,
-- * InstanceWhat
InstanceWhat(..), SafeOverlapping
@@ -512,72 +511,6 @@ data CtOrigin
| AmbiguityCheckOrigin UserTypeCtxt
| ImplicitLiftOrigin HsImplicitLiftSplice
- | ExpansionOrigin ErrCtxtMsg -- This is due to an expansion of the original thing given by the ErrCtxtMsg
-
- | ExpectedTySyntax !CtOrigin (HsExpr GhcRn)
-
- -- | A rebindable syntax operator is expected to have a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
- | forall (p :: Pass)
- . (OutputableBndrId p)
- => ExpectedFunTySyntaxOp Int
- !CtOrigin !(HsExpr (GhcPass p))
- -- ^ rebindable syntax operator
-
- -- | A view pattern must have a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyBinder
- | ExpectedFunTyViewPat Int
- !(HsExpr GhcRn)
- -- ^ function used in the view pattern
-
- -- | Need to be able to extract an argument type from a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyApp
- | forall (p :: Pass)
- . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
- !TypedThing
- -- ^ function
- !(HsExpr (GhcPass p))
- -- ^ argument
-
- -- | Ensure that a function defined by equations indeed has a function type
- -- with the appropriate number of arguments.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyBinder, RepPolyRecordPattern, RepPolyWildcardPattern
- | ExpectedFunTyMatches Int
- !TypedThing
- -- ^ name of the function
- !(MatchGroup GhcRn (LHsExpr GhcRn))
- -- ^ equations
-
- -- | Ensure that a lambda abstraction has a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyLambda, RepPolyMatch
- | ExpectedFunTyLam HsLamVariant
- !(HsExpr GhcRn)
- -- ^ the entire lambda-case expression
-
- -- | A partial application of the constructor of a representation-polymorphic
- -- unlifted newtype in which the argument type does not have a fixed
- -- runtime representation.
- --
- -- Test cases: UnliftedNewtypesLevityBinder, UnliftedNewtypesCoerceFail.
- | FRRRepPolyUnliftedNewtype !DataCon
-
-
-updatePositionCtOrigin :: Int -> CtOrigin -> CtOrigin
-updatePositionCtOrigin i (ExpectedFunTySyntaxOp _ c e) = ExpectedFunTySyntaxOp i c e
-updatePositionCtOrigin i (ExpectedFunTyViewPat _ e) = ExpectedFunTyViewPat i e
-updatePositionCtOrigin i (ExpectedFunTyMatches _ t e) = ExpectedFunTyMatches i t e
-updatePositionCtOrigin _ c = c
-
data NonLinearPatternReason
= LazyPatternReason
@@ -680,18 +613,18 @@ exprCtOrigin (HsTypedBracket {}) = Shouldn'tHappenOrigin "TH typed bracket"
exprCtOrigin (HsUntypedBracket {}) = Shouldn'tHappenOrigin "TH untyped bracket"
exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice"
exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice"
-exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc"
-exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression"
-exprCtOrigin (HsEmbTy {}) = Shouldn'tHappenOrigin "type expression"
-exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression"
-exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms]
-exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms]
-exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms]
-exprCtOrigin e@(ExplicitList {}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(HsIf {}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(HsProjection _ _) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(RecordUpd{}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(HsGetField{}) = ExpansionOrigin (ExprCtxt e)
+exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc"
+exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression"
+exprCtOrigin (HsEmbTy {}) = Shouldn'tHappenOrigin "type expression"
+exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression"
+exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms]
+exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms]
+exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms]
+exprCtOrigin (ExplicitList {}) = ListOrigin
+exprCtOrigin (HsIf {}) = IfThenElseOrigin
+exprCtOrigin (HsProjection _ p) = RecordFieldProjectionOrigin (FieldLabelStrings $ fmap noLocA p)
+exprCtOrigin (RecordUpd _ _ flds) = RecordUpdOrigin flds
+exprCtOrigin (HsGetField _ _ f) = GetFieldOrigin (fmap field_label $ dfoLabel (unLoc f))
exprCtOrigin (XExpr (ExpandedThingRn o _)) = errCtxtCtOrigin o
exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel $ L (getLoc $ foLabel f) (foExt f)
@@ -736,31 +669,6 @@ pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin sk)
= ctoHerald <+> ppr sk
-pprCtOrigin (ExpansionOrigin o)
- = ctoHerald <+> what
- where
- what :: SDoc
- what = case o of
- StmtErrCtxt{} ->
- text "a do statement"
- DoStmtErrCtxt{} ->
- text "a do statement"
- StmtErrCtxtPat _ _ p ->
- text "a do statement" $$
- text "with the failable pattern" <+> quotes (ppr p)
- ExprCtxt (HsGetField _ _ (L _ f)) ->
- hsep [text "selecting the field", quotes (ppr f)]
- ExprCtxt (HsOverLabel _ l) ->
- hsep [text "the overloaded label" , quotes (char '#' <> ppr l)]
- ExprCtxt (RecordUpd{}) -> text "a record update"
- ExprCtxt (ExplicitList{}) -> text "an overloaded list"
- ExprCtxt (HsIf{}) -> text "an if-then-else expression"
- ExprCtxt (HsProjection _ p) -> text "the record selector" <+>
- quotes (ppr ((FieldLabelStrings $ fmap noLocA p)))
- ExprCtxt e -> text "the expression" <+> (ppr e)
- RecordUpdCtxt{} -> text "a record update"
- _ -> text "shouldn't happen ExpansionOrigin pprCtOrigin"
-
pprCtOrigin (GivenSCOrigin sk d blk)
= vcat [ ctoHerald <+> pprSkolInfo sk
, whenPprDebug (braces (text "given-sc:" <+> ppr d <> comma <> ppr blk)) ]
@@ -867,46 +775,9 @@ pprCtOrigin (NonLinearPatternOrigin reason pat)
= hang (ctoHerald <+> text "a non-linear pattern" <+> quotes (ppr pat))
2 (pprNonLinearPatternReason reason)
-pprCtOrigin (ExpectedTySyntax orig arg)
- = vcat [ text "The expression" <+> quotes (ppr arg)
- , nest 2 (ppr orig) ]
-
-pprCtOrigin (ExpectedFunTySyntaxOp i orig op) =
- vcat [ sep [ the_arg_of i
- , text "the rebindable syntax operator"
- , quotes (ppr op) ]
- , nest 2 (ppr orig) ]
-
-pprCtOrigin (ExpectedFunTyViewPat i expr) =
- vcat [ the_arg_of i <+> text "the view pattern"
- , nest 2 (ppr expr) ]
-pprCtOrigin (ExpectedFunTyArg fun arg) =
- sep [ text "The argument"
- , quotes (ppr arg)
- , text "of"
- , quotes (ppr fun) ]
-pprCtOrigin (ExpectedFunTyMatches i fun (MG { mg_alts = L _ alts }))
- | null alts
- = the_arg_of i <+> quotes (ppr fun)
- | otherwise
- = text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
- <+> text "for" <+> quotes (ppr fun)
-pprCtOrigin (ExpectedFunTyLam lam_variant _) = binder_of $ lamCaseKeyword lam_variant
-pprCtOrigin (FRRRepPolyUnliftedNewtype dc) =
- vcat [ text "Unsaturated use of a representation-polymorphic unlifted newtype."
- , text "The argument of the newtype constructor" <+> quotes (ppr dc) ]
-
pprCtOrigin simple_origin
= ctoHerald <+> pprCtOriginBriefly simple_origin
-the_arg_of :: Int -> SDoc
-the_arg_of i = text "The" <+> speakNth i <+> text "argument of"
-
-binder_of :: SDoc -> SDoc
-binder_of what = text "The binder of the" <+> what <+> text "expression"
-
-
-
-- | Print CtOrigin briefly, with a one-liner
pprCtOriginBriefly :: CtOrigin -> SDoc
pprCtOriginBriefly = ppr_br -- ppr_br is a local function with a short name!
@@ -979,22 +850,6 @@ ppr_br (InstanceSigOrigin {}) = text "a type signature in an instance"
ppr_br (AmbiguityCheckOrigin {}) = text "a type ambiguity check"
ppr_br (ImpedanceMatching {}) = text "combining required constraints"
ppr_br (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)]
-ppr_br (ExpansionOrigin (ExprCtxt (HsOverLabel _ l))) = hsep [text "the overloaded label", quotes (char '#' <> ppr l)]
-ppr_br (ExpansionOrigin (ExprCtxt (RecordUpd{}))) = text "a record update"
-ppr_br (ExpansionOrigin (ExprCtxt (ExplicitList{}))) = text "an overloaded list"
-ppr_br (ExpansionOrigin (ExprCtxt (HsIf{}))) = text "an if-then-else expression"
-ppr_br (ExpansionOrigin (ExprCtxt e)) = text "an expression" <+> ppr e
-ppr_br (ExpansionOrigin (StmtErrCtxt{})) = text "a do statement"
-ppr_br (ExpansionOrigin (StmtErrCtxtPat{})) = text "a do statement"
-ppr_br (ExpansionOrigin{}) = text "shouldn't happen ExpansionOrigin ppr_br"
-ppr_br (ExpectedTySyntax o _) = ppr_br o
-ppr_br (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator"
-ppr_br (ExpectedFunTyViewPat{}) = text "a view pattern"
-ppr_br (ExpectedFunTyArg{}) = text "a funtion head"
-ppr_br (ExpectedFunTyMatches{}) = text "a match statement"
-ppr_br (ExpectedFunTyLam{}) = text "a lambda expression"
-ppr_br (FRRRepPolyUnliftedNewtype{}) = text "a unlifted newtype"
-
pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc
pprNonLinearPatternReason LazyPatternReason = parens (text "non-variable lazy pattern aren't linear")
@@ -1225,9 +1080,9 @@ data FixedRuntimeRepContext
-- | A representation-polymorphism check arising from a call
-- to 'matchExpectedFunTys' or 'matchActualFunTy'.
--
- -- See 'ExpectedFunTyOrigin' for more details.
+ -- See 'ExpectedFunTyCtxt' for more details.
| FRRExpectedFunTy
- !CtOrigin
+ !ExpectedFunTyCtxt
!Int
-- ^ argument position (1-indexed)
@@ -1314,7 +1169,7 @@ pprFixedRuntimeRepContext FRRBindStmtGuard
pprFixedRuntimeRepContext (FRRArrow arrowContext)
= pprFRRArrowContext arrowContext
pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig _)
- = pprCtOrigin funTyOrig
+ = pprExpectedFunTyHerald funTyOrig
pprFixedRuntimeRepContext (FRRDeepSubsumption is_exp pos mb_fun)
= hsep [ text "The", what, text "type of the"
, ppr (Argument pos)
@@ -1540,15 +1395,136 @@ instance Outputable FRRArrowContext where
ppr = pprFRRArrowContext
-pprExpectedFunTyHerald :: CtOrigin -> SDoc
+{- *********************************************************************
+* *
+ FixedRuntimeRep: ExpectedFunTy origin
+* *
+********************************************************************* -}
+
+-- | In what context are we calling 'matchExpectedFunTys'
+-- or 'matchActualFunTy'?
+--
+-- Used for two things:
+--
+-- 1. Reporting error messages which explain that a function has been
+-- given an unexpected number of arguments.
+-- Uses 'pprExpectedFunTyHerald'.
+-- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify.
+--
+-- 2. Reporting representation-polymorphism errors when a function argument
+-- doesn't have a fixed RuntimeRep as per Note [Fixed RuntimeRep]
+-- in GHC.Tc.Utils.Concrete.
+-- Uses 'pprExpectedFunTyCtxt'.
+-- See 'FixedRuntimeRepContext' for the situations in which
+-- representation-polymorphism checks are performed.
+data ExpectedFunTyCtxt
+
+ -- | A rebindable syntax operator is expected to have a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
+ = forall (p :: Pass)
+ . (OutputableBndrId p)
+ => ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p))
+ -- ^ rebindable syntax operator
+
+ -- |
+ | ExpectedTySyntax !CtOrigin !(HsExpr GhcRn)
+
+ -- | A view pattern must have a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyBinder
+ | ExpectedFunTyViewPat
+ !(HsExpr GhcRn)
+ -- ^ function used in the view pattern
+
+ -- | Need to be able to extract an argument type from a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyApp
+ | forall (p :: Pass)
+ . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
+ !TypedThing
+ -- ^ function
+ !(HsExpr (GhcPass p))
+ -- ^ argument
+
+ -- | Ensure that a function defined by equations indeed has a function type
+ -- with the appropriate number of arguments.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyBinder, RepPolyRecordPattern, RepPolyWildcardPattern
+ | ExpectedFunTyMatches
+ !TypedThing
+ -- ^ name of the function
+ !(MatchGroup GhcRn (LHsExpr GhcRn))
+ -- ^ equations
+
+ -- | Ensure that a lambda abstraction has a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyLambda, RepPolyMatch
+ | ExpectedFunTyLam HsLamVariant
+ !(HsExpr GhcRn)
+ -- ^ the entire lambda-case expression
+
+ -- | A partial application of the constructor of a representation-polymorphic
+ -- unlifted newtype in which the argument type does not have a fixed
+ -- runtime representation.
+ --
+ -- Test cases: UnliftedNewtypesLevityBinder, UnliftedNewtypesCoerceFail.
+ | FRRRepPolyUnliftedNewtype !DataCon
+
+pprExpectedFunTyCtxt :: ExpectedFunTyCtxt
+ -> Int -- ^ argument position (starting at 1)
+ -> SDoc
+pprExpectedFunTyCtxt funTy_origin i =
+ case funTy_origin of
+ ExpectedFunTySyntaxOp orig op ->
+ vcat [ sep [ the_arg_of
+ , text "the rebindable syntax operator"
+ , quotes (ppr op) ]
+ , nest 2 (ppr orig) ]
+ ExpectedTySyntax orig arg ->
+ vcat [ text "the expression" <+> quotes (ppr arg)
+ , nest 2 (ppr orig) ]
+ ExpectedFunTyViewPat expr ->
+ vcat [ the_arg_of <+> text "the view pattern"
+ , nest 2 (ppr expr) ]
+ ExpectedFunTyArg fun arg ->
+ sep [ text "The argument"
+ , quotes (ppr arg)
+ , text "of"
+ , quotes (ppr fun) ]
+ ExpectedFunTyMatches fun (MG { mg_alts = L _ alts })
+ | null alts
+ -> the_arg_of <+> quotes (ppr fun)
+ | otherwise
+ -> text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
+ <+> text "for" <+> quotes (ppr fun)
+ ExpectedFunTyLam lam_variant _ -> binder_of $ lamCaseKeyword lam_variant
+ FRRRepPolyUnliftedNewtype dc ->
+ vcat [ text "Unsaturated use of a representation-polymorphic unlifted newtype."
+ , text "The argument of the newtype constructor" <+> quotes (ppr dc) ]
+ where
+ the_arg_of :: SDoc
+ the_arg_of = text "The" <+> speakNth i <+> text "argument of"
+
+ binder_of :: SDoc -> SDoc
+ binder_of what = text "The binder of the" <+> what <+> text "expression"
+
+pprExpectedFunTyHerald :: ExpectedFunTyCtxt -> SDoc
pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {})
= text "This rebindable syntax expects a function with"
+pprExpectedFunTyHerald (ExpectedTySyntax orig _)
+ = pprCtOriginBriefly orig
pprExpectedFunTyHerald (ExpectedFunTyViewPat {})
= text "A view pattern expression expects"
pprExpectedFunTyHerald (ExpectedFunTyArg fun _)
= sep [ text "The function" <+> quotes (ppr fun)
, text "is applied to" ]
-pprExpectedFunTyHerald (ExpectedFunTyMatches _ fun (MG { mg_alts = L _ alts }))
+pprExpectedFunTyHerald (ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }))
= text "The equation" <> plural alts <+> text "for" <+> quotes (ppr fun) <+> hasOrHave alts
pprExpectedFunTyHerald (ExpectedFunTyLam lam_variant expr)
= sep [ text "The" <+> lamCaseKeyword lam_variant <+> text "expression"
@@ -1557,7 +1533,6 @@ pprExpectedFunTyHerald (ExpectedFunTyLam lam_variant expr)
, text "has" ]
pprExpectedFunTyHerald (FRRRepPolyUnliftedNewtype dc)
= text "The unlifted newtype" <+> quotes (ppr dc) <+> text "expects"
-pprExpectedFunTyHerald orig = ppr (Shouldn'tHappenOrigin "pprExpectedFunTyHerald") <+> ppr orig
{- *******************************************************************
* *
=====================================
compiler/GHC/Tc/Types/Origin.hs-boot
=====================================
@@ -5,6 +5,7 @@ import GHC.Utils.Misc ( HasDebugCallStack )
import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type )
data CtOrigin
+data ExpectedFunTyCtxt
data SkolemInfoAnon
data SkolemInfo
data FixedRuntimeRepContext
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -139,7 +139,7 @@ import Data.Traversable (for)
--
-- See Note [Return arguments with a fixed RuntimeRep].
matchActualFunTy
- :: CtOrigin
+ :: ExpectedFunTyCtxt
-- ^ See Note [Herald for matchExpectedFunTys]
-> Maybe TypedThing
-- ^ The thing with type TcSigmaType
@@ -178,7 +178,7 @@ matchActualFunTy herald mb_thing err_info fun_ty
go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg_ty, ft_res = res_ty })
= assert (isVisibleFunArg af) $
- do { (arg_co, arg_ty) <- hasFixedRuntimeRep (FRRExpectedFunTy (updatePositionCtOrigin 1 herald) 1) arg_ty
+ do { (arg_co, arg_ty) <- hasFixedRuntimeRep (FRRExpectedFunTy herald 1) arg_ty
; let fun_co = mkFunCo Nominal af
(mkReflCo Nominal w)
arg_co
@@ -249,7 +249,7 @@ Ugh!
-- INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep
-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
-- See Note [Return arguments with a fixed RuntimeRep].
-matchActualFunTys :: CtOrigin -- ^ See Note [Herald for matchExpectedFunTys]
+matchActualFunTys :: ExpectedFunTyCtxt -- ^ See Note [Herald for matchExpectedFunTys]
-> CtOrigin
-> Arity
-> TcSigmaType
@@ -793,7 +793,7 @@ Example:
-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
-- See Note [Return arguments with a fixed RuntimeRep].
matchExpectedFunTys :: forall a.
- CtOrigin -- See Note [Herald for matchExpectedFunTys]
+ ExpectedFunTyCtxt -- See Note [Herald for matchExpectedFunTys]
-> UserTypeCtxt
-> VisArity
-> ExpSigmaType
@@ -875,7 +875,7 @@ matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside
, ft_arg = arg_ty, ft_res = res_ty })
= assert (isVisibleFunArg af) $
do { let arg_pos = arity - n_req + 1 -- 1 for the first argument etc
- ; (arg_co, arg_ty_frr) <- hasFixedRuntimeRep (FRRExpectedFunTy (updatePositionCtOrigin arg_pos herald) arg_pos) arg_ty
+ ; (arg_co, arg_ty_frr) <- hasFixedRuntimeRep (FRRExpectedFunTy herald arg_pos) arg_ty
; let scaled_arg_ty_frr = Scaled mult arg_ty_frr
; (res_wrap, result) <- check (n_req - 1)
(mkCheckExpFunPatTy scaled_arg_ty_frr : rev_pat_tys)
@@ -947,19 +947,19 @@ matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside
; co <- unifyType Nothing (mkScaledFunTys more_arg_tys res_ty) fun_ty
; return (mkWpCastN co, result) }
-new_infer_arg_ty :: CtOrigin -> Int -> TcM (Scaled ExpRhoTypeFRR)
+new_infer_arg_ty :: ExpectedFunTyCtxt -> Int -> TcM (Scaled ExpRhoTypeFRR)
new_infer_arg_ty herald arg_pos -- position for error messages only
= do { mult <- newFlexiTyVarTy multiplicityTy
- ; inf_hole <- newInferExpTypeFRR IIF_DeepRho (FRRExpectedFunTy (updatePositionCtOrigin arg_pos herald) arg_pos)
+ ; inf_hole <- newInferExpTypeFRR IIF_DeepRho (FRRExpectedFunTy herald arg_pos)
; return (mkScaled mult inf_hole) }
-new_check_arg_ty :: CtOrigin -> Int -> TcM (Scaled TcType)
+new_check_arg_ty :: ExpectedFunTyCtxt -> Int -> TcM (Scaled TcType)
new_check_arg_ty herald arg_pos -- Position for error messages only, 1 for first arg
= do { mult <- newFlexiTyVarTy multiplicityTy
- ; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy (updatePositionCtOrigin arg_pos herald) arg_pos)
+ ; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy herald arg_pos)
; return (mkScaled mult arg_ty) }
-mkFunTysMsg :: CtOrigin
+mkFunTysMsg :: ExpectedFunTyCtxt
-> (VisArity, TcType)
-> ErrCtxtMsg
-- See Note [Reporting application arity errors]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a648f0303e70e85481ce8a1f532d502…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a648f0303e70e85481ce8a1f532d502…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/ani/kill-SrcCodeOrigin] remove CtOrigin.ExpansionOrigin in favour of errCtxtCtOrigin, remove CtOrign...
by Apoorv Ingle (＠ani) 09 Mar '26
by Apoorv Ingle (＠ani) 09 Mar '26
09 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC
Commits:
93003cd2 by Apoorv Ingle at 2026-03-08T21:48:20-05:00
remove CtOrigin.ExpansionOrigin in favour of errCtxtCtOrigin, remove CtOrign from ErrMsgCtxt.FunTysCtxt
- - - - -
13 changed files:
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/Origin.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
Changes:
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -83,7 +83,6 @@ import qualified GHC.Data.Strict as Strict
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
-import Language.Haskell.Syntax (HsExpr (RecordUpd, HsGetField, HsProjection))
import Control.Monad ( when, foldM, forM_ )
import Data.Bifunctor ( bimap )
@@ -2778,10 +2777,6 @@ isHasFieldOrigin = \case
RecordUpdOrigin {} -> True
RecordFieldProjectionOrigin {} -> True
GetFieldOrigin {} -> True
- ExpansionOrigin (ExprCtxt e)
- | HsGetField{} <- e -> True
- | RecordUpd{} <- e -> True
- | HsProjection{} <- e -> True
_ -> False
-----------------------
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -7798,6 +7798,7 @@ pprErrCtxtMsg = \case
| otherwise
-> empty
+ -- text "Debug" <+> vcat [ppr fun, ppr n_val_args, ppr res_fun, ppr res_env, ppr n_fun, ppr n_env]
where
not_fun ty -- ty is definitely not an arrow type,
-- and cannot conceivably become one
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -907,10 +907,10 @@ tcInstFun do_ql inst_final ds_flag (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigm
; return (mkScaled mult_ty arg_nu) }
- mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> CtOrigin
+ mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt
mk_herald tc_fun arg
= case fun_orig of
- ExpansionOrigin (StmtErrCtxt{}) -> ExpectedTySyntax DoStmtOrigin arg
+ DoStmtOrigin -> ExpectedTySyntax DoStmtOrigin arg
_ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg
-- Is the argument supposed to instantiate a forall?
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -1068,7 +1068,7 @@ tcSynArgE orig op sigma_ty syn_ty thing_inside
-- fixed RuntimeRep, as needed to call mkWpFun.
; return (result, match_wrapper <.> fun_wrap) }
where
- herald = ExpectedFunTySyntaxOp 1 orig op
+ herald = ExpectedFunTySyntaxOp orig op
go rho_ty (SynType the_ty)
= do { wrap <- tcSubTypePat orig GenSigCtxt the_ty rho_ty
@@ -1097,7 +1097,7 @@ tcSynArgA orig op sigma_ty arg_shapes res_shape thing_inside
thing_inside (arg_results ++ res_results) (map scaledMult arg_tys ++ arg_res_mults)
; return (result, match_wrapper, arg_wrappers, res_wrapper) }
where
- herald = ExpectedFunTySyntaxOp (length arg_shapes) orig op
+ herald = ExpectedFunTySyntaxOp orig op
tc_syn_args_e :: [TcSigmaTypeFRR] -> [SyntaxOpType]
-> ([TcSigmaTypeFRR] -> [Mult] -> TcM a)
@@ -1849,4 +1849,3 @@ checkMissingFields con_like rbinds arg_tys
field_strs = conLikeImplBangs con_like
fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds
-
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -465,7 +465,7 @@ tcInferAppHead_maybe fun = case fun of
-- visible type applications in the argument.
-- c.f. T19167
(\ (e, ds_flag, ty) -> (mkExpandedTc o e, ds_flag, ty)) <$>
- tcExprSigma False (ExpansionOrigin o) e
+ tcExprSigma False (errCtxtCtOrigin o) e
)
_ -> return Nothing
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -114,7 +114,7 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
= assertPpr (funBindPrecondition matches) (pprMatches matches) $
do { -- Check that they all have the same no of arguments
arity <- checkArgCounts matches
- ; let herald = ExpectedFunTyMatches arity (NameThing fun_name) matches
+ ; let herald = ExpectedFunTyMatches (NameThing fun_name) matches
; traceTc "tcFunBindMatches 1" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)
; (wrap_fun, r)
=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -701,7 +701,7 @@ tc_pat scaled_exp_pat_ty@(Scaled w_pat exp_pat_ty) penv ps_pat thing_inside =
-- 'view_expr' must be a function; expose its argument/result types
-- using 'matchActualFunTy'.
- ; let herald = ExpectedFunTyViewPat 1 $ unLoc view_expr
+ ; let herald = ExpectedFunTyViewPat $ unLoc view_expr
; (view_expr_co1, Scaled _mult view_arg_ty, view_res_ty)
<- matchActualFunTy herald (Just . HsExprRnThing $ unLoc view_expr)
(1, view_expr_rho) view_expr_rho
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -20,7 +20,7 @@ import GHC.Tc.Instance.Typeable
import GHC.Tc.Utils.TcMType
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.CtLoc
-import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(ExpansionOrigin) )
+import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(GetFieldOrigin) )
import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcLookupDataFamInst, FamInstEnvs )
import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) )
@@ -1288,7 +1288,7 @@ warnIncompleteRecSel dflags sel_id ct_loc
-- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin,
-- despite the expansion to (getField @"x" r)
- isGetFieldOrigin (ExpansionOrigin (ExprCtxt (HsGetField {}))) = True
+ isGetFieldOrigin GetFieldOrigin{} = True
isGetFieldOrigin _ = False
lookupHasFieldLabel
=====================================
compiler/GHC/Tc/Types/ErrCtxt.hs
=====================================
@@ -21,7 +21,7 @@ import GHC.Hs.Extension
import GHC.Parser.Annotation ( LocatedN, SrcSpanAnnA )
import GHC.Tc.Errors.Types.PromotionErr ( TermLevelUseCtxt )
-import {-# SOURCE #-} GHC.Tc.Types.Origin ( CtOrigin )
+import {-# SOURCE #-} GHC.Tc.Types.Origin ( CtOrigin, ExpectedFunTyCtxt )
import GHC.Tc.Utils.TcType ( TcType, TcTyCon, ExpType )
import GHC.Types.Basic ( TyConFlavour )
@@ -283,7 +283,7 @@ data ErrCtxtMsg
-- | In a function application.
| FunAppCtxt !FunAppCtxtFunArg !Int
-- | In a function call.
- | FunTysCtxt !CtOrigin !Type !Int !Int
+ | FunTysCtxt !ExpectedFunTyCtxt !Type !Int !Int
-- | In the result of a function call.
| FunResCtxt !(HsExpr GhcTc) !Int !Type !Type !Int !Int
-- | In the declaration of a type constructor.
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -211,9 +211,6 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec)
-- See Note [ErrCtxtStack Manipulation]
setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt
setLclCtxtSrcCodeOrigin ec lclCtxt
- -- | ecs@(MkErrCtxt ExpansionCodeCtxt _ : _) <- tcl_err_ctxt lclCtxt
- -- , MkErrCtxt ExpansionCodeCtxt ExprCtxt{} <- ec
- -- = lclCtxt { tcl_err_ctxt = ec : ecs }
-- never stack 2 statement error contexts on top of each other
| MkErrCtxt _ DoStmtErrCtxt{} : ecs <- tcl_err_ctxt lclCtxt
, MkErrCtxt _ DoStmtErrCtxt{} <- ec
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -9,9 +9,8 @@ module GHC.Tc.Types.Origin (
-- * CtOrigin
CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
- srcCodeOriginCtOrigin,
+ srcCodeOriginCtOrigin, errCtxtCtOrigin,
invisibleOrigin_maybe, isVisibleOrigin, toInvisibleOrigin,
- updatePositionCtOrigin,
pprCtOrigin, pprCtOriginBriefly, isGivenOrigin,
defaultReprEqOrigins, isWantedSuperclassOrigin,
ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..),
@@ -37,7 +36,7 @@ module GHC.Tc.Types.Origin (
FRRArrowContext(..), pprFRRArrowContext,
-- ** ExpectedFunTy FixedRuntimeRepOrigin
- pprExpectedFunTyHerald,
+ ExpectedFunTyCtxt(..), pprExpectedFunTyCtxt, pprExpectedFunTyHerald,
-- * InstanceWhat
InstanceWhat(..), SafeOverlapping
@@ -512,72 +511,6 @@ data CtOrigin
| AmbiguityCheckOrigin UserTypeCtxt
| ImplicitLiftOrigin HsImplicitLiftSplice
- | ExpansionOrigin ErrCtxtMsg -- This is due to an expansion of the original thing given by the ErrCtxtMsg
-
- | ExpectedTySyntax !CtOrigin (HsExpr GhcRn)
-
- -- | A rebindable syntax operator is expected to have a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
- | forall (p :: Pass)
- . (OutputableBndrId p)
- => ExpectedFunTySyntaxOp Int
- !CtOrigin !(HsExpr (GhcPass p))
- -- ^ rebindable syntax operator
-
- -- | A view pattern must have a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyBinder
- | ExpectedFunTyViewPat Int
- !(HsExpr GhcRn)
- -- ^ function used in the view pattern
-
- -- | Need to be able to extract an argument type from a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyApp
- | forall (p :: Pass)
- . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
- !TypedThing
- -- ^ function
- !(HsExpr (GhcPass p))
- -- ^ argument
-
- -- | Ensure that a function defined by equations indeed has a function type
- -- with the appropriate number of arguments.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyBinder, RepPolyRecordPattern, RepPolyWildcardPattern
- | ExpectedFunTyMatches Int
- !TypedThing
- -- ^ name of the function
- !(MatchGroup GhcRn (LHsExpr GhcRn))
- -- ^ equations
-
- -- | Ensure that a lambda abstraction has a function type.
- --
- -- Test cases for representation-polymorphism checks:
- -- RepPolyLambda, RepPolyMatch
- | ExpectedFunTyLam HsLamVariant
- !(HsExpr GhcRn)
- -- ^ the entire lambda-case expression
-
- -- | A partial application of the constructor of a representation-polymorphic
- -- unlifted newtype in which the argument type does not have a fixed
- -- runtime representation.
- --
- -- Test cases: UnliftedNewtypesLevityBinder, UnliftedNewtypesCoerceFail.
- | FRRRepPolyUnliftedNewtype !DataCon
-
-
-updatePositionCtOrigin :: Int -> CtOrigin -> CtOrigin
-updatePositionCtOrigin i (ExpectedFunTySyntaxOp _ c e) = ExpectedFunTySyntaxOp i c e
-updatePositionCtOrigin i (ExpectedFunTyViewPat _ e) = ExpectedFunTyViewPat i e
-updatePositionCtOrigin i (ExpectedFunTyMatches _ t e) = ExpectedFunTyMatches i t e
-updatePositionCtOrigin _ c = c
-
data NonLinearPatternReason
= LazyPatternReason
@@ -680,18 +613,18 @@ exprCtOrigin (HsTypedBracket {}) = Shouldn'tHappenOrigin "TH typed bracket"
exprCtOrigin (HsUntypedBracket {}) = Shouldn'tHappenOrigin "TH untyped bracket"
exprCtOrigin (HsTypedSplice {}) = Shouldn'tHappenOrigin "TH typed splice"
exprCtOrigin (HsUntypedSplice {}) = Shouldn'tHappenOrigin "TH untyped splice"
-exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc"
-exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression"
-exprCtOrigin (HsEmbTy {}) = Shouldn'tHappenOrigin "type expression"
-exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression"
-exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms]
-exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms]
-exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms]
-exprCtOrigin e@(ExplicitList {}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(HsIf {}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(HsProjection _ _) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(RecordUpd{}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin e@(HsGetField{}) = ExpansionOrigin (ExprCtxt e)
+exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc"
+exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression"
+exprCtOrigin (HsEmbTy {}) = Shouldn'tHappenOrigin "type expression"
+exprCtOrigin (HsHole _) = Shouldn'tHappenOrigin "hole expression"
+exprCtOrigin (HsForAll {}) = Shouldn'tHappenOrigin "forall telescope" -- See Note [Types in terms]
+exprCtOrigin (HsQual {}) = Shouldn'tHappenOrigin "constraint context" -- See Note [Types in terms]
+exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" -- See Note [Types in terms]
+exprCtOrigin (ExplicitList {}) = ListOrigin
+exprCtOrigin (HsIf {}) = IfThenElseOrigin
+exprCtOrigin (HsProjection _ p) = RecordFieldProjectionOrigin (FieldLabelStrings $ fmap noLocA p)
+exprCtOrigin (RecordUpd _ _ flds) = RecordUpdOrigin flds
+exprCtOrigin (HsGetField _ _ f) = GetFieldOrigin (fmap field_label $ dfoLabel (unLoc f))
exprCtOrigin (XExpr (ExpandedThingRn o _)) = errCtxtCtOrigin o
exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel $ L (getLoc $ foLabel f) (foExt f)
@@ -736,31 +669,6 @@ pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin sk)
= ctoHerald <+> ppr sk
-pprCtOrigin (ExpansionOrigin o)
- = ctoHerald <+> what
- where
- what :: SDoc
- what = case o of
- StmtErrCtxt{} ->
- text "a do statement"
- DoStmtErrCtxt{} ->
- text "a do statement"
- StmtErrCtxtPat _ _ p ->
- text "a do statement" $$
- text "with the failable pattern" <+> quotes (ppr p)
- ExprCtxt (HsGetField _ _ (L _ f)) ->
- hsep [text "selecting the field", quotes (ppr f)]
- ExprCtxt (HsOverLabel _ l) ->
- hsep [text "the overloaded label" , quotes (char '#' <> ppr l)]
- ExprCtxt (RecordUpd{}) -> text "a record update"
- ExprCtxt (ExplicitList{}) -> text "an overloaded list"
- ExprCtxt (HsIf{}) -> text "an if-then-else expression"
- ExprCtxt (HsProjection _ p) -> text "the record selector" <+>
- quotes (ppr ((FieldLabelStrings $ fmap noLocA p)))
- ExprCtxt e -> text "the expression" <+> (ppr e)
- RecordUpdCtxt{} -> text "a record update"
- _ -> text "shouldn't happen ExpansionOrigin pprCtOrigin"
-
pprCtOrigin (GivenSCOrigin sk d blk)
= vcat [ ctoHerald <+> pprSkolInfo sk
, whenPprDebug (braces (text "given-sc:" <+> ppr d <> comma <> ppr blk)) ]
@@ -867,46 +775,9 @@ pprCtOrigin (NonLinearPatternOrigin reason pat)
= hang (ctoHerald <+> text "a non-linear pattern" <+> quotes (ppr pat))
2 (pprNonLinearPatternReason reason)
-pprCtOrigin (ExpectedTySyntax orig arg)
- = vcat [ text "The expression" <+> quotes (ppr arg)
- , nest 2 (ppr orig) ]
-
-pprCtOrigin (ExpectedFunTySyntaxOp i orig op) =
- vcat [ sep [ the_arg_of i
- , text "the rebindable syntax operator"
- , quotes (ppr op) ]
- , nest 2 (ppr orig) ]
-
-pprCtOrigin (ExpectedFunTyViewPat i expr) =
- vcat [ the_arg_of i <+> text "the view pattern"
- , nest 2 (ppr expr) ]
-pprCtOrigin (ExpectedFunTyArg fun arg) =
- sep [ text "The argument"
- , quotes (ppr arg)
- , text "of"
- , quotes (ppr fun) ]
-pprCtOrigin (ExpectedFunTyMatches i fun (MG { mg_alts = L _ alts }))
- | null alts
- = the_arg_of i <+> quotes (ppr fun)
- | otherwise
- = text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
- <+> text "for" <+> quotes (ppr fun)
-pprCtOrigin (ExpectedFunTyLam lam_variant _) = binder_of $ lamCaseKeyword lam_variant
-pprCtOrigin (FRRRepPolyUnliftedNewtype dc) =
- vcat [ text "Unsaturated use of a representation-polymorphic unlifted newtype."
- , text "The argument of the newtype constructor" <+> quotes (ppr dc) ]
-
pprCtOrigin simple_origin
= ctoHerald <+> pprCtOriginBriefly simple_origin
-the_arg_of :: Int -> SDoc
-the_arg_of i = text "The" <+> speakNth i <+> text "argument of"
-
-binder_of :: SDoc -> SDoc
-binder_of what = text "The binder of the" <+> what <+> text "expression"
-
-
-
-- | Print CtOrigin briefly, with a one-liner
pprCtOriginBriefly :: CtOrigin -> SDoc
pprCtOriginBriefly = ppr_br -- ppr_br is a local function with a short name!
@@ -979,22 +850,6 @@ ppr_br (InstanceSigOrigin {}) = text "a type signature in an instance"
ppr_br (AmbiguityCheckOrigin {}) = text "a type ambiguity check"
ppr_br (ImpedanceMatching {}) = text "combining required constraints"
ppr_br (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)]
-ppr_br (ExpansionOrigin (ExprCtxt (HsOverLabel _ l))) = hsep [text "the overloaded label", quotes (char '#' <> ppr l)]
-ppr_br (ExpansionOrigin (ExprCtxt (RecordUpd{}))) = text "a record update"
-ppr_br (ExpansionOrigin (ExprCtxt (ExplicitList{}))) = text "an overloaded list"
-ppr_br (ExpansionOrigin (ExprCtxt (HsIf{}))) = text "an if-then-else expression"
-ppr_br (ExpansionOrigin (ExprCtxt e)) = text "an expression" <+> ppr e
-ppr_br (ExpansionOrigin (StmtErrCtxt{})) = text "a do statement"
-ppr_br (ExpansionOrigin (StmtErrCtxtPat{})) = text "a do statement"
-ppr_br (ExpansionOrigin{}) = text "shouldn't happen ExpansionOrigin ppr_br"
-ppr_br (ExpectedTySyntax o _) = ppr_br o
-ppr_br (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator"
-ppr_br (ExpectedFunTyViewPat{}) = text "a view pattern"
-ppr_br (ExpectedFunTyArg{}) = text "a funtion head"
-ppr_br (ExpectedFunTyMatches{}) = text "a match statement"
-ppr_br (ExpectedFunTyLam{}) = text "a lambda expression"
-ppr_br (FRRRepPolyUnliftedNewtype{}) = text "a unlifted newtype"
-
pprNonLinearPatternReason :: HasDebugCallStack => NonLinearPatternReason -> SDoc
pprNonLinearPatternReason LazyPatternReason = parens (text "non-variable lazy pattern aren't linear")
@@ -1225,9 +1080,9 @@ data FixedRuntimeRepContext
-- | A representation-polymorphism check arising from a call
-- to 'matchExpectedFunTys' or 'matchActualFunTy'.
--
- -- See 'ExpectedFunTyOrigin' for more details.
+ -- See 'ExpectedFunTyCtxt' for more details.
| FRRExpectedFunTy
- !CtOrigin
+ !ExpectedFunTyCtxt
!Int
-- ^ argument position (1-indexed)
@@ -1314,7 +1169,7 @@ pprFixedRuntimeRepContext FRRBindStmtGuard
pprFixedRuntimeRepContext (FRRArrow arrowContext)
= pprFRRArrowContext arrowContext
pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig _)
- = pprCtOrigin funTyOrig
+ = pprExpectedFunTyHerald funTyOrig
pprFixedRuntimeRepContext (FRRDeepSubsumption is_exp pos mb_fun)
= hsep [ text "The", what, text "type of the"
, ppr (Argument pos)
@@ -1540,15 +1395,136 @@ instance Outputable FRRArrowContext where
ppr = pprFRRArrowContext
-pprExpectedFunTyHerald :: CtOrigin -> SDoc
+{- *********************************************************************
+* *
+ FixedRuntimeRep: ExpectedFunTy origin
+* *
+********************************************************************* -}
+
+-- | In what context are we calling 'matchExpectedFunTys'
+-- or 'matchActualFunTy'?
+--
+-- Used for two things:
+--
+-- 1. Reporting error messages which explain that a function has been
+-- given an unexpected number of arguments.
+-- Uses 'pprExpectedFunTyHerald'.
+-- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify.
+--
+-- 2. Reporting representation-polymorphism errors when a function argument
+-- doesn't have a fixed RuntimeRep as per Note [Fixed RuntimeRep]
+-- in GHC.Tc.Utils.Concrete.
+-- Uses 'pprExpectedFunTyCtxt'.
+-- See 'FixedRuntimeRepContext' for the situations in which
+-- representation-polymorphism checks are performed.
+data ExpectedFunTyCtxt
+
+ -- | A rebindable syntax operator is expected to have a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyDoBind, RepPolyDoBody{1,2}, RepPolyMc{Bind,Body,Guard}, RepPolyNPlusK
+ = forall (p :: Pass)
+ . (OutputableBndrId p)
+ => ExpectedFunTySyntaxOp !CtOrigin !(HsExpr (GhcPass p))
+ -- ^ rebindable syntax operator
+
+ -- |
+ | ExpectedTySyntax !CtOrigin !(HsExpr GhcRn)
+
+ -- | A view pattern must have a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyBinder
+ | ExpectedFunTyViewPat
+ !(HsExpr GhcRn)
+ -- ^ function used in the view pattern
+
+ -- | Need to be able to extract an argument type from a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyApp
+ | forall (p :: Pass)
+ . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg
+ !TypedThing
+ -- ^ function
+ !(HsExpr (GhcPass p))
+ -- ^ argument
+
+ -- | Ensure that a function defined by equations indeed has a function type
+ -- with the appropriate number of arguments.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyBinder, RepPolyRecordPattern, RepPolyWildcardPattern
+ | ExpectedFunTyMatches
+ !TypedThing
+ -- ^ name of the function
+ !(MatchGroup GhcRn (LHsExpr GhcRn))
+ -- ^ equations
+
+ -- | Ensure that a lambda abstraction has a function type.
+ --
+ -- Test cases for representation-polymorphism checks:
+ -- RepPolyLambda, RepPolyMatch
+ | ExpectedFunTyLam HsLamVariant
+ !(HsExpr GhcRn)
+ -- ^ the entire lambda-case expression
+
+ -- | A partial application of the constructor of a representation-polymorphic
+ -- unlifted newtype in which the argument type does not have a fixed
+ -- runtime representation.
+ --
+ -- Test cases: UnliftedNewtypesLevityBinder, UnliftedNewtypesCoerceFail.
+ | FRRRepPolyUnliftedNewtype !DataCon
+
+pprExpectedFunTyCtxt :: ExpectedFunTyCtxt
+ -> Int -- ^ argument position (starting at 1)
+ -> SDoc
+pprExpectedFunTyCtxt funTy_origin i =
+ case funTy_origin of
+ ExpectedFunTySyntaxOp orig op ->
+ vcat [ sep [ the_arg_of
+ , text "the rebindable syntax operator"
+ , quotes (ppr op) ]
+ , nest 2 (ppr orig) ]
+ ExpectedTySyntax orig arg ->
+ vcat [ text "the expression" <+> quotes (ppr arg)
+ , nest 2 (ppr orig) ]
+ ExpectedFunTyViewPat expr ->
+ vcat [ the_arg_of <+> text "the view pattern"
+ , nest 2 (ppr expr) ]
+ ExpectedFunTyArg fun arg ->
+ sep [ text "The argument"
+ , quotes (ppr arg)
+ , text "of"
+ , quotes (ppr fun) ]
+ ExpectedFunTyMatches fun (MG { mg_alts = L _ alts })
+ | null alts
+ -> the_arg_of <+> quotes (ppr fun)
+ | otherwise
+ -> text "The" <+> speakNth i <+> text "pattern in the equation" <> plural alts
+ <+> text "for" <+> quotes (ppr fun)
+ ExpectedFunTyLam lam_variant _ -> binder_of $ lamCaseKeyword lam_variant
+ FRRRepPolyUnliftedNewtype dc ->
+ vcat [ text "Unsaturated use of a representation-polymorphic unlifted newtype."
+ , text "The argument of the newtype constructor" <+> quotes (ppr dc) ]
+ where
+ the_arg_of :: SDoc
+ the_arg_of = text "The" <+> speakNth i <+> text "argument of"
+
+ binder_of :: SDoc -> SDoc
+ binder_of what = text "The binder of the" <+> what <+> text "expression"
+
+pprExpectedFunTyHerald :: ExpectedFunTyCtxt -> SDoc
pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {})
= text "This rebindable syntax expects a function with"
+pprExpectedFunTyHerald (ExpectedTySyntax orig _)
+ = pprCtOriginBriefly orig
pprExpectedFunTyHerald (ExpectedFunTyViewPat {})
= text "A view pattern expression expects"
pprExpectedFunTyHerald (ExpectedFunTyArg fun _)
= sep [ text "The function" <+> quotes (ppr fun)
, text "is applied to" ]
-pprExpectedFunTyHerald (ExpectedFunTyMatches _ fun (MG { mg_alts = L _ alts }))
+pprExpectedFunTyHerald (ExpectedFunTyMatches fun (MG { mg_alts = L _ alts }))
= text "The equation" <> plural alts <+> text "for" <+> quotes (ppr fun) <+> hasOrHave alts
pprExpectedFunTyHerald (ExpectedFunTyLam lam_variant expr)
= sep [ text "The" <+> lamCaseKeyword lam_variant <+> text "expression"
@@ -1557,7 +1533,6 @@ pprExpectedFunTyHerald (ExpectedFunTyLam lam_variant expr)
, text "has" ]
pprExpectedFunTyHerald (FRRRepPolyUnliftedNewtype dc)
= text "The unlifted newtype" <+> quotes (ppr dc) <+> text "expects"
-pprExpectedFunTyHerald orig = ppr (Shouldn'tHappenOrigin "pprExpectedFunTyHerald") <+> ppr orig
{- *******************************************************************
* *
=====================================
compiler/GHC/Tc/Types/Origin.hs-boot
=====================================
@@ -5,6 +5,7 @@ import GHC.Utils.Misc ( HasDebugCallStack )
import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type )
data CtOrigin
+data ExpectedFunTyOrigin
data SkolemInfoAnon
data SkolemInfo
data FixedRuntimeRepContext
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -139,7 +139,7 @@ import Data.Traversable (for)
--
-- See Note [Return arguments with a fixed RuntimeRep].
matchActualFunTy
- :: CtOrigin
+ :: ExpectedFunTyCtxt
-- ^ See Note [Herald for matchExpectedFunTys]
-> Maybe TypedThing
-- ^ The thing with type TcSigmaType
@@ -178,7 +178,7 @@ matchActualFunTy herald mb_thing err_info fun_ty
go (FunTy { ft_af = af, ft_mult = w, ft_arg = arg_ty, ft_res = res_ty })
= assert (isVisibleFunArg af) $
- do { (arg_co, arg_ty) <- hasFixedRuntimeRep (FRRExpectedFunTy (updatePositionCtOrigin 1 herald) 1) arg_ty
+ do { (arg_co, arg_ty) <- hasFixedRuntimeRep (FRRExpectedFunTy herald 1) arg_ty
; let fun_co = mkFunCo Nominal af
(mkReflCo Nominal w)
arg_co
@@ -249,7 +249,7 @@ Ugh!
-- INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep
-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
-- See Note [Return arguments with a fixed RuntimeRep].
-matchActualFunTys :: CtOrigin -- ^ See Note [Herald for matchExpectedFunTys]
+matchActualFunTys :: ExpectedFunTyCtxt -- ^ See Note [Herald for matchExpectedFunTys]
-> CtOrigin
-> Arity
-> TcSigmaType
@@ -793,7 +793,7 @@ Example:
-- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
-- See Note [Return arguments with a fixed RuntimeRep].
matchExpectedFunTys :: forall a.
- CtOrigin -- See Note [Herald for matchExpectedFunTys]
+ ExpectedFunTyCtxt -- See Note [Herald for matchExpectedFunTys]
-> UserTypeCtxt
-> VisArity
-> ExpSigmaType
@@ -875,7 +875,7 @@ matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside
, ft_arg = arg_ty, ft_res = res_ty })
= assert (isVisibleFunArg af) $
do { let arg_pos = arity - n_req + 1 -- 1 for the first argument etc
- ; (arg_co, arg_ty_frr) <- hasFixedRuntimeRep (FRRExpectedFunTy (updatePositionCtOrigin arg_pos herald) arg_pos) arg_ty
+ ; (arg_co, arg_ty_frr) <- hasFixedRuntimeRep (FRRExpectedFunTy herald arg_pos) arg_ty
; let scaled_arg_ty_frr = Scaled mult arg_ty_frr
; (res_wrap, result) <- check (n_req - 1)
(mkCheckExpFunPatTy scaled_arg_ty_frr : rev_pat_tys)
@@ -947,19 +947,19 @@ matchExpectedFunTys herald ctx arity (Check top_ty) thing_inside
; co <- unifyType Nothing (mkScaledFunTys more_arg_tys res_ty) fun_ty
; return (mkWpCastN co, result) }
-new_infer_arg_ty :: CtOrigin -> Int -> TcM (Scaled ExpRhoTypeFRR)
+new_infer_arg_ty :: ExpectedFunTyCtxt -> Int -> TcM (Scaled ExpRhoTypeFRR)
new_infer_arg_ty herald arg_pos -- position for error messages only
= do { mult <- newFlexiTyVarTy multiplicityTy
- ; inf_hole <- newInferExpTypeFRR IIF_DeepRho (FRRExpectedFunTy (updatePositionCtOrigin arg_pos herald) arg_pos)
+ ; inf_hole <- newInferExpTypeFRR IIF_DeepRho (FRRExpectedFunTy herald arg_pos)
; return (mkScaled mult inf_hole) }
-new_check_arg_ty :: CtOrigin -> Int -> TcM (Scaled TcType)
+new_check_arg_ty :: ExpectedFunTyCtxt -> Int -> TcM (Scaled TcType)
new_check_arg_ty herald arg_pos -- Position for error messages only, 1 for first arg
= do { mult <- newFlexiTyVarTy multiplicityTy
- ; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy (updatePositionCtOrigin arg_pos herald) arg_pos)
+ ; arg_ty <- newOpenFlexiFRRTyVarTy (FRRExpectedFunTy herald arg_pos)
; return (mkScaled mult arg_ty) }
-mkFunTysMsg :: CtOrigin
+mkFunTysMsg :: ExpectedFunTyCtxt
-> (VisArity, TcType)
-> ErrCtxtMsg
-- See Note [Reporting application arity errors]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93003cd213439d70af0ca6728e7660b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93003cd213439d70af0ca6728e7660b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/T2057] Add regression test for #2057
by Simon Jakobi (＠sjakobi2) 09 Mar '26
by Simon Jakobi (＠sjakobi2) 09 Mar '26
09 Mar '26
Simon Jakobi pushed to branch wip/sjakobi/T2057 at Glasgow Haskell Compiler / GHC
Commits:
d968566a by Simon Jakobi at 2026-03-09T02:40:59+01:00
Add regression test for #2057
Test that GHC stops after an interface-file error instead of
continuing into the linker.
The test constructs a stale package dependency on purpose. `pkgB` is compiled
against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
Closes #2057.
Assisted-by: Codex
- - - - -
12 changed files:
- + testsuite/tests/driver/T2057/.gitignore
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA1/pkg.conf.in
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgA2/pkg.conf.in
- + testsuite/tests/driver/T2057/pkgB/B.hs
- + testsuite/tests/driver/T2057/pkgB/pkg.conf.in
Changes:
=====================================
testsuite/tests/driver/T2057/.gitignore
=====================================
@@ -0,0 +1 @@
+work/
=====================================
testsuite/tests/driver/T2057/Makefile
=====================================
@@ -0,0 +1,60 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+WORK = work
+PKGDB = $(WORK)/pkgdb
+PKGA1 = $(WORK)/pkgA1
+PKGA2 = $(WORK)/pkgA2
+PKGB = $(WORK)/pkgB
+APP = $(WORK)/app
+OUT = $(WORK)/T2057.out
+BASE_ID := $(shell "$(GHC_PKG)" field base id --simple-output)
+
+.PHONY: T2057 clean
+
+clean:
+ rm -rf $(WORK)
+
+# Dependency graph:
+# pkgA is first registered from the pkgA1 source tree, where A exports f1.
+# pkgB is built against this pkgA.
+# We then rebuild that same package from the pkgA2 source tree, where A
+# instead exports f2. Reading B.hi therefore finds an unfolding for g that
+# still refers to f1, and compiling Main against pkgB should stop at the
+# interface error.
+T2057: clean
+
+ # Create an isolated package DB and output directories for the repro.
+ mkdir -p '$(PKGA1)' '$(PKGA2)' '$(PKGB)' '$(APP)'
+ '$(GHC_PKG)' init '$(PKGDB)'
+
+ # Build and register pkgA from the pkgA1 sources.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA1/A.hs -outputdir '$(PKGA1)'
+ ar q '$(PKGA1)/libHSpkgA.a' '$(PKGA1)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA1/pkg.conf.in >'$(WORK)/pkgA1.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgA1.conf' >/dev/null
+
+ # Build and register pkgB against pkgA so B.hi records the unfolding of g = f1.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -package pkgA -this-unit-id pkgB -O -c pkgB/B.hs \
+ -outputdir '$(PKGB)'
+ ar q '$(PKGB)/libHSpkgB.a' '$(PKGB)/B.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgB/pkg.conf.in >'$(WORK)/pkgB.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgB.conf' >/dev/null
+
+ # Rebuild pkgA from the pkgA2 source tree, replacing f1 with f2.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA2/A.hs -outputdir '$(PKGA2)'
+ ar q '$(PKGA2)/libHSpkgA.a' '$(PKGA2)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA2/pkg.conf.in >'$(WORK)/pkgA2.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' update '$(WORK)/pkgA2.conf' >/dev/null
+
+ # Compiling Main against pkgB should now fail while loading the stale B.hi.
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make app/Main.hs \
+ -O -fforce-recomp -package-db '$(PKGDB)' -package pkgB \
+ >'$(OUT)' 2>&1 || { echo "expected compilation failure" >&2; exit 1; }
+
+ # Strip the absolute test directory prefix before comparing against T2057.stderr.
+ sed "s#$(CURDIR)/##g" '$(OUT)' >&2
=====================================
testsuite/tests/driver/T2057/README.md
=====================================
@@ -0,0 +1,20 @@
+`T2057` checks that GHC stops after an interface-file error instead of
+continuing into the linker.
+
+The test constructs a stale package dependency on purpose. The two directories
+`pkgA1/` and `pkgA2/` are just two source trees for the same registered
+package, `pkgA`.
+
+The Makefile first registers `pkgA` from `pkgA1/`, where module `A` exports
+`f1`. It then builds `pkgB` against that package, so `B.hi` records an
+unfolding `g = f1`.
+
+After that, the Makefile updates the same package `pkgA` from `pkgA2/`, where
+module `A` exports `f2` instead. When `Main` imports `B`, GHC has to load
+`B.hi`, sees the stale reference to `f1`, and should fail while loading
+interfaces.
+
+The golden [`T2057.stderr`](T2057.stderr) captures the fixed behaviour:
+diagnose the missing declaration in the stale interface and then stop with
+`Cannot continue after interface file error`. Any linker output would be a
+regression.
=====================================
testsuite/tests/driver/T2057/T2057.stderr
=====================================
@@ -0,0 +1,9 @@
+work/pkgB/B.hi
+Declaration for g
+Unfolding of g:
+ f1 ErrorWithoutFlag
+ Can't find interface-file declaration for variable f1
+ Probable cause: bug in .hi-boot file, or inconsistent .hi file
+ Use -ddump-if-trace to get an idea of which file caused the error
+<no location info>:
+ Cannot continue after interface file error
=====================================
testsuite/tests/driver/T2057/all.T
=====================================
@@ -0,0 +1,11 @@
+test(
+ 'T2057',
+ [ extra_files(['pkgA1', 'pkgA2', 'pkgB', 'app', 'README.md'])
+ , when(opsys('mingw32'), skip)
+ , js_skip
+ , wasm_skip
+ , ignore_stdout
+ ],
+ makefile_test,
+ []
+)
=====================================
testsuite/tests/driver/T2057/app/Main.hs
=====================================
@@ -0,0 +1,6 @@
+module Main where
+
+import B
+
+main :: IO ()
+main = print (g 41)
=====================================
testsuite/tests/driver/T2057/pkgA1/A.hs
=====================================
@@ -0,0 +1,5 @@
+module A (f1) where
+
+{-# INLINE f1 #-}
+f1 :: Int -> Int
+f1 x = x + 1
=====================================
testsuite/tests/driver/T2057/pkgA1/pkg.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA1
+library-dirs: ${pkgroot}/pkgA1
+dynamic-library-dirs: ${pkgroot}/pkgA1
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgA2/A.hs
=====================================
@@ -0,0 +1,4 @@
+module A (f2) where
+
+f2 :: Int -> Int
+f2 x = x + 100
=====================================
testsuite/tests/driver/T2057/pkgA2/pkg.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA2
+library-dirs: ${pkgroot}/pkgA2
+dynamic-library-dirs: ${pkgroot}/pkgA2
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgB/B.hs
=====================================
@@ -0,0 +1,7 @@
+module B (g) where
+
+import A
+
+{-# INLINE g #-}
+g :: Int -> Int
+g x = f1 x
=====================================
testsuite/tests/driver/T2057/pkgB/pkg.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgB
+version: 1.0
+id: pkgB
+key: pkgB
+exposed: True
+exposed-modules: B
+import-dirs: ${pkgroot}/pkgB
+library-dirs: ${pkgroot}/pkgB
+dynamic-library-dirs: ${pkgroot}/pkgB
+hs-libraries: HSpkgB
+depends: pkgA @BASE_ID@
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d968566af553c83a5d113565c2453e3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d968566af553c83a5d113565c2453e3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/andreask/ghc_par] 70 commits: Add SIMD absolute value on x86 and LLVM
by Andreas Klebinger (＠AndreasK) 09 Mar '26
by Andreas Klebinger (＠AndreasK) 09 Mar '26
09 Mar '26
Andreas Klebinger pushed to branch wip/andreask/ghc_par at Glasgow Haskell Compiler / GHC
Commits:
476c4cdf by Sean D. Gillespie at 2026-03-02T10:14:37-05:00
Add SIMD absolute value on x86 and LLVM
On x86, absolute value of 32 bits or less is implemented with
PABSB/PABSW/PABSD if SSSE3 is available. Otherwise, there is a fallback
for SSE2. For 64 bit integers it uses VPABSQ, required by AVX-512VL,
with fallbacks for SSE4.2 and SSE2.
There is no dedicated instruction for floating point absolute value on
x86, so it is simulated using bitwise AND.
Absolute value for signed integers and floats are implemented by the
"llvm.abs/llvm.fabs" standard library intrinsics. This implementation
uses MachOps constructors, unlike non-vector floating point absolute
value, which uses CallishMachOps.
- - - - -
709448c0 by Sean D. Gillespie at 2026-03-02T10:14:46-05:00
Add SIMD floating point square root
On x86, this is implemented with the SQRTPS and SQRTPD instructions. On
LLVM, it uses the sqrt library intrinstic.
- - - - -
0deadf66 by Sean D. Gillespie at 2026-03-02T10:14:47-05:00
Improve error message for SIMD on aarch64
When encountering vector literals on aarch64, previously it would
throw:
<no location info>: error:
panic! (the 'impossible' happened)
GHC version 9.15.20251219:
getRegister' (CmmLit:CmmVec):
Now it is more consistent with the other vector operations:
<no location info>: error:
sorry! (unimplemented feature or known bug)
GHC version 9.15.20251219:
SIMD operations on AArch64 currently require the LLVM backend
- - - - -
7d64031b by Vladislav Zavialov at 2026-03-03T11:09:28-05:00
Replace maybeAddSpace with spaceIfSingleQuote
Simplify pretty-printing of HsTypes by using spaceIfSingleQuote.
This allows us to drop the unwieldy lhsTypeHasLeadingPromotionQuote
helper function.
Follow-up to 178c1fd830c78377ef5d338406a41e1d8eb5f0da
- - - - -
598db847 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00
Correct `hIsReadable` and `hIsWritable` for duplex handles
This contribution implements CLC proposal #371. It changes `hIsReadable`
and `hIsWritable` such that they always throw a respective exception
when encountering a closed or semi-closed handle, not just in the case
of a file handle.
- - - - -
b90201e5 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00
Document `SemiClosedHandle`
- - - - -
c9df72b5 by Wolfgang Jeltsch at 2026-03-06T06:25:25-05:00
Tell users what “semi-closed” means for duplex handles
- - - - -
a8aa1868 by Ilias Tsitsimpis at 2026-03-06T06:26:29-05:00
Fix determinism of linker arguments
The switch from Data.Map to UniqMap in 3b5be05ac29 introduced
non-determinism in the order of packages passed to the linker.
This resulted in non-reproducible builds where the DT_NEEDED entries in
dynamic libraries were ordered differently across builds.
Fix the regression by explicitly sorting the package list derived from
UniqMap.
Fixes #26838
- - - - -
9b64ad3a by Matthew Pickering at 2026-03-06T06:27:16-05:00
determinism: Use a deterministic renaming when writing bytecode files
Now when writing the bytecode file, a counter and substitution are used
to provide deterministic keys to local variables (rather than relying on
uniques). This change ensures that `.gbc` are produced
deterministically.
Fixes #26499
- - - - -
d29800e0 by Teo Camarasu at 2026-03-06T06:28:46-05:00
ghc-internal: delete Version hs-boot loop
Version has a Read instance which needs Unicode but part of the Unicode interface is the unicode version. This is easy to resolve. We simply don't re-export the version from the Unicode module.
Resolves #26940
- - - - -
ad25af90 by Sylvain Henry at 2026-03-06T06:30:33-05:00
Linker: implement support for COMMON symbols (#6107)
Add some support for COMMON symbols. We don't support common symbols
having different sizes where the larger one is allocated after the
smaller one. The linker will fail with an appropriate error message if
it happens.
- - - - -
3b59f158 by Cheng Shao at 2026-03-06T06:31:16-05:00
compiler: fix redundant import of GHC.Hs.Lit
This patch removes a redundant import of `GHC.Hs.Lit` which causes a
ghc build failure with validate flavours when bootstrapping from 9.14.
Fixes #26972.
- - - - -
148d36f3 by Cheng Shao at 2026-03-06T06:32:01-05:00
compiler: avoid unneeded traversals in GHC.Unit.State
Following !15591, this patch avoids unneeded traversals in
`reportCycles`/`reportUnusable` when log verbosity is below given
threshold. Also applies `logVerbAtLeast` when appropriate.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
7e31367c by Cheng Shao at 2026-03-06T06:32:46-05:00
ghc-internal: fix redundant import in GHC.Internal.Event.Windows.ManagedThreadPool
This patch fixes redundant import in
`GHC.Internal.Event.Windows.ManagedThreadPool` that causes a
compilation error when building windows target with validate flavours
and bootstrapping from 9.14. Fixes #26976.
- - - - -
fc8b8e27 by sheaf at 2026-03-06T06:33:28-05:00
System.Info.fullCompilerVersion: add 'since' annot
Fixes #26973
- - - - -
c8238375 by Sylvain Henry at 2026-03-06T06:34:23-05:00
Hadrian: deprecate --bignum and automatically enable +native_bignum for JS
Deprecate --bignum=... to select the bignum backend. It's only used to
select the native backend, and this can be done with the +native_bignum
flavour transformer.
Additionally, we automatically enable +native_bignum for the JS target
because the GMP backend isn't supported.
- - - - -
a3ac7074 by Sylvain Henry at 2026-03-06T06:35:17-05:00
JS: fix putEnum/fromEnum (#24593)
Don't go through Word16 when serializing Enums.
- - - - -
0b36e96c by Andreas Klebinger at 2026-03-06T06:35:58-05:00
Docs: Document -fworker-wrapper-cbv default setting.
Fixes #26841
- - - - -
eca445e7 by mangoiv at 2026-03-07T05:02:36-05:00
drop deb9/10 from CI, add deb13
debian 9 and 10 are end of life, hence we drop them
from our CI, but we do add debian 13. Jobs that were
previously run on 9 and 10 run on 13, too, jobs that
were run on 10, are run on 11 now. Jobs that were
previously run on debian 12 are run on debian 13 now.
This MR also updates hadrian's bootstrap plans for that
reason.
Metric Decrease:
T9872d
- - - - -
12f8b829 by Luite Stegeman at 2026-03-07T05:03:33-05:00
Fix GHC.Internal.Prim haddock
Haddock used to parse Haskell source to generate documentation,
but switched to using interface files instead. This broke documentation
of the GHC.Internal.Prim module, since it's a wired-in interface that
didn't provide a document structure.
This patch adds the missing document structure and updates genprimopcode
to make the section headers and descriptions available.
fixes #26954
- - - - -
f87e5e57 by Luite Stegeman at 2026-03-07T05:03:33-05:00
Remove obsolete --make-haskell-source from genprimopcode
Now that haddock uses the wired-in interface for GHC.Internal.Prim,
the generated Haskell source file is no longer needed. Remove the
--make-haskell-source code generator from genprimopcode and replace
the generated GHC/Internal/Prim.hs with a minimal static source file.
- - - - -
4a7ddc7b by Sylvain Henry at 2026-03-07T05:04:59-05:00
JS: fix linking of exposed but non-preload units (#24886)
Units exposed in the unit database but not explicitly passed on the
command-line were not considered by the JS linker. This isn't an issue
for cabal which passes every unit explicitly but it is an issue when
using GHC directly (cf T24886 test).
- - - - -
689aafcd by mangoiv at 2026-03-07T05:05:52-05:00
testsuite: double foundation timeout multiplier
The runtime timeout in the foundation test was regularly hit by code
generated by the wasm backend - we increase the timout since the high
runtime is expected on the wasm backend for this rather complex test.
Resolves #26938
- - - - -
f41ff125 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
core: add CoreCompUnit newtype
- - - - -
1069971e by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Thread CompilationUnit through compiler.
Instead of a CoreProgram being a list of types it's now a list of compilation units which can be compiled independently.
- - - - -
1a39613e by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Put local rules into compilation unit
- - - - -
7a54d5a9 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Needs checking: Combine compilation units
When compiling compilation units we must ensure the uniques of top level functions don't clash.
We do so by substituting over them.
- - - - -
81aeb179 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Maybe deal with glomming
- - - - -
968fddc2 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Simplify deshadowBinds and make it operate only on binds.
- - - - -
f7a07729 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Add splitting pass, fix some printing stuff
- - - - -
6d55d9b2 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Merge/Split core around CSE
- - - - -
a22dc75f by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Enable split core by default
- - - - -
9ef65916 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
More simple plugin test failures
- - - - -
88a4166e by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Better flattening, we should now retain rules
- - - - -
d3645d58 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Take apart ModGuts for simplifier.
- - - - -
2f324822 by Andreas Klebinger at 2026-03-08T20:46:15+00:00
Don't output compilation unit header if there is only a singly unit
- - - - -
7557d0ae by Andreas Klebinger at 2026-03-08T20:46:16+00:00
suppress unit marker for single unit
- - - - -
60cc0cb7 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Place local-relevant rules in compilation unit
- - - - -
e40644d3 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Fix rule assignment to comp units during occAnalSplit
- - - - -
78e28598 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Dead code analysis now respects unit rules.
- - - - -
9dd7360a by Andreas Klebinger at 2026-03-08T20:46:16+00:00
[Slop] Testsuite: Detect errors that only consist of output reordering
- - - - -
8180a503 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Don't pass full ModGuts to Specialise
- - - - -
f4b81743 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
FloatOut: Use list of binds rather than CoreProgram
- - - - -
e99cf96e by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Include unit rules in simplifier rules env during interations
- - - - -
20ebc186 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
HACK: Always run occAnal after merge to clear up letrecs
- - - - -
817c7fe0 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Lint: Better check for CompUnit invariants
- - - - -
bb7d2545 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Do unit/guts split for specialise
- - - - -
e030e234 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Fiddle with dumps
- - - - -
c95587d2 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Some fixes to specialise.
It now processes units one at a time.
- - - - -
64dfbe8d by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Use all fvs of rules as edges when splitting
- - - - -
5290e4ee by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Handle rules which stop refering to local binders
- - - - -
26081203 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Refactored splitting.
Broke it into parts to make it easier to understand.
- - - - -
d5f94558 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Make sure CoreMerge reattaches unstable unfoldings
- - - - -
169bb1bc by Andreas Klebinger at 2026-03-08T20:46:16+00:00
testsuite: Ignore compilation unit header in output comparison
- - - - -
e61ea11e by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Some useless checks
- - - - -
b7d21061 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Possible fixes to simplifier/specConstr from the bot
- - - - -
e7f43bf9 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
merge/split around late cse
- - - - -
312195a1 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Make CSE work independently over compilation units
- - - - -
d3941fe3 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Keep rules attributed to units in the simplifier
- - - - -
096254a9 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Some vibe based fixes
- - - - -
6b71cac7 by Andreas Klebinger at 2026-03-08T20:46:16+00:00
Fix an issue with dependency analysis with boot files
- - - - -
7aecf8f3 by Andreas Klebinger at 2026-03-08T22:45:49+00:00
Don't split if module has a boot file to avoid expensive dep analysis.
- - - - -
fe27f5b3 by Andreas Klebinger at 2026-03-08T23:23:01+00:00
Allow split cse with -fsplit-cse
- - - - -
d2a79687 by Andreas Klebinger at 2026-03-08T23:28:25+00:00
Dubious: Stop looking at imported unfoldings
- - - - -
15a8a1ca by Andreas Klebinger at 2026-03-08T23:58:28+00:00
Increase unit independent processing
- - - - -
7810af67 by Andreas Klebinger at 2026-03-09T00:10:22+00:00
AI tuning of Split.hs
- - - - -
33ec5869 by Andreas Klebinger at 2026-03-09T00:19:45+00:00
Do some stuff in parallel
- - - - -
8d7e76b6 by Andreas Klebinger at 2026-03-09T00:40:02+00:00
par WW
- - - - -
e62e43fe by Andreas Klebinger at 2026-03-09T01:25:13+00:00
Make simp more per unit
- - - - -
a1fc3262 by Andreas Klebinger at 2026-03-09T01:37:57+00:00
Make things parallel
- - - - -
168 changed files:
- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC.hs
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Builtin/primops.txt.pp
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/Cmm/MachOp.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core.hs-boot
- + compiler/GHC/Core/FVs.hs-boot
- compiler/GHC/Core/LateCC.hs
- compiler/GHC/Core/LateCC/Utils.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/CSE.hs
- compiler/GHC/Core/Opt/CallArity.hs
- compiler/GHC/Core/Opt/CallerCC.hs
- + compiler/GHC/Core/Opt/CompUnit.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/Exitify.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/LiberateCase.hs
- compiler/GHC/Core/Opt/Monad.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- + compiler/GHC/Core/Opt/OccurAnal.hs-boot
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Pipeline/Types.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- + compiler/GHC/Core/Opt/Split.hs
- compiler/GHC/Core/Opt/StaticArgs.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Subst.hs
- + compiler/GHC/Core/Subst.hs-boot
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/Runtime/Interpreter/JS.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/Object.hs
- compiler/GHC/StgToJS/Prim.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Error.hs
- compiler/ghc.cabal.in
- docs/users_guide/using-optimisation.rst
- hadrian/README.md
- hadrian/bootstrap/generate_bootstrap_plans
- hadrian/bootstrap/plan-9_10_1.json
- hadrian/bootstrap/plan-9_10_2.json
- + hadrian/bootstrap/plan-9_10_3.json
- hadrian/bootstrap/plan-bootstrap-9_10_1.json
- hadrian/bootstrap/plan-bootstrap-9_10_2.json
- + hadrian/bootstrap/plan-bootstrap-9_10_3.json
- hadrian/src/CommandLine.hs
- hadrian/src/Main.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/GenPrimopCode.hs
- libraries/base/changelog.md
- libraries/base/src/GHC/Base.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/GHC/Unicode.hs
- libraries/base/src/System/Info.hs
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-internal/ghc-internal.cabal.in
- − libraries/ghc-internal/src/GHC/Internal/Data/Version.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- + libraries/ghc-internal/src/GHC/Internal/Prim.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
- libraries/ghc-internal/tools/ucd2haskell/exe/UCD2Haskell/ModuleGenerators.hs
- rts/Linker.c
- rts/LinkerInternals.h
- rts/linker/Elf.c
- rts/linker/MachO.c
- rts/linker/PEi386.c
- testsuite/driver/junit.py
- testsuite/driver/perf_notes.py
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/ghci/should_run/all.T
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- + testsuite/tests/javascript/T24886.hs
- + testsuite/tests/javascript/T24886.stderr
- + testsuite/tests/javascript/T24886.stdout
- testsuite/tests/javascript/all.T
- testsuite/tests/numeric/should_run/all.T
- testsuite/tests/overloadedrecflds/should_compile/all.T
- testsuite/tests/overloadedrecflds/should_run/all.T
- testsuite/tests/plugins/HomePackagePlugin.hs
- testsuite/tests/plugins/all.T
- testsuite/tests/plugins/annotation-plugin/SayAnnNames.hs
- testsuite/tests/plugins/late-plugin/LatePlugin.hs
- testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
- testsuite/tests/plugins/simple-plugin/Simple/ReplacePlugin.hs
- testsuite/tests/pmcheck/should_compile/T11303.hs
- testsuite/tests/quasiquotation/qq005/test.T
- testsuite/tests/quasiquotation/qq006/test.T
- testsuite/tests/rts/linker/Makefile
- + testsuite/tests/rts/linker/T6107.hs
- + testsuite/tests/rts/linker/T6107.stdout
- + testsuite/tests/rts/linker/T6107_sym1.s
- + testsuite/tests/rts/linker/T6107_sym2.s
- testsuite/tests/rts/linker/all.T
- testsuite/tests/saks/should_compile/all.T
- testsuite/tests/showIface/all.T
- testsuite/tests/simd/should_run/doublex2_arith.hs
- testsuite/tests/simd/should_run/doublex2_arith.stdout
- testsuite/tests/simd/should_run/doublex2_arith_baseline.hs
- testsuite/tests/simd/should_run/doublex2_arith_baseline.stdout
- testsuite/tests/simd/should_run/floatx4_arith.hs
- testsuite/tests/simd/should_run/floatx4_arith.stdout
- testsuite/tests/simd/should_run/floatx4_arith_baseline.hs
- testsuite/tests/simd/should_run/floatx4_arith_baseline.stdout
- testsuite/tests/simd/should_run/int16x8_arith.hs
- testsuite/tests/simd/should_run/int16x8_arith.stdout
- testsuite/tests/simd/should_run/int16x8_arith_baseline.hs
- testsuite/tests/simd/should_run/int16x8_arith_baseline.stdout
- testsuite/tests/simd/should_run/int32x4_arith.hs
- testsuite/tests/simd/should_run/int32x4_arith.stdout
- testsuite/tests/simd/should_run/int32x4_arith_baseline.hs
- testsuite/tests/simd/should_run/int32x4_arith_baseline.stdout
- testsuite/tests/simd/should_run/int64x2_arith.hs
- testsuite/tests/simd/should_run/int64x2_arith.stdout
- testsuite/tests/simd/should_run/int64x2_arith_baseline.hs
- testsuite/tests/simd/should_run/int64x2_arith_baseline.stdout
- testsuite/tests/simd/should_run/int8x16_arith.hs
- testsuite/tests/simd/should_run/int8x16_arith.stdout
- testsuite/tests/simd/should_run/int8x16_arith_baseline.hs
- testsuite/tests/simd/should_run/int8x16_arith_baseline.stdout
- testsuite/tests/th/all.T
- testsuite/tests/vdq-rta/should_compile/all.T
- utils/genprimopcode/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec5be4425b0ee8c19f4a817d36236b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec5be4425b0ee8c19f4a817d36236b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/T2057] Add regression test for #2057
by Simon Jakobi (＠sjakobi2) 09 Mar '26
by Simon Jakobi (＠sjakobi2) 09 Mar '26
09 Mar '26
Simon Jakobi pushed to branch wip/sjakobi/T2057 at Glasgow Haskell Compiler / GHC
Commits:
14fa99ca by Simon Jakobi at 2026-03-09T02:12:44+01:00
Add regression test for #2057
Test that GHC stops after an interface-file error instead of
continuing into the linker.
The test constructs a stale package dependency on purpose. `pkgB` is compiled
against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
Closes #2057.
Assisted-by: Codex
- - - - -
12 changed files:
- + testsuite/tests/driver/T2057/.gitignore
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA1/pkg.conf.in
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgA2/pkg.conf.in
- + testsuite/tests/driver/T2057/pkgB/B.hs
- + testsuite/tests/driver/T2057/pkgB/pkg.conf.in
Changes:
=====================================
testsuite/tests/driver/T2057/.gitignore
=====================================
@@ -0,0 +1 @@
+work/
=====================================
testsuite/tests/driver/T2057/Makefile
=====================================
@@ -0,0 +1,59 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+WORK = work
+PKGDB = $(WORK)/pkgdb
+PKGA1 = $(WORK)/pkgA1
+PKGA2 = $(WORK)/pkgA2
+PKGB = $(WORK)/pkgB
+APP = $(WORK)/app
+OUT = $(WORK)/T2057.out
+BASE_ID := $(shell "$(GHC_PKG)" field base id --simple-output)
+
+.PHONY: T2057 clean
+
+clean:
+ rm -rf $(WORK)
+
+# Dependency graph:
+# pkgB is built against pkgA1, where A exports f1.
+# We then rebuild the same installed unit id (pkgA) from the pkgA2 sources,
+# where A instead exports f2. Reading B.hi therefore finds an unfolding for g
+# that still refers to f1, and compiling Main against pkgB should stop at the
+# interface error.
+T2057: clean
+
+ # Create an isolated package DB and output directories for the repro.
+ mkdir -p '$(PKGA1)' '$(PKGA2)' '$(PKGB)' '$(APP)'
+ '$(GHC_PKG)' init '$(PKGDB)'
+
+ # Build and register pkgA1, the original version of A.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA1/A.hs -outputdir '$(PKGA1)'
+ ar q '$(PKGA1)/libHSpkgA.a' '$(PKGA1)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA1/pkg.conf.in >'$(WORK)/pkgA1.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgA1.conf' >/dev/null
+
+ # Build and register pkgB against pkgA1 so B.hi records the unfolding of g = f1.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -package pkgA1 -this-unit-id pkgB -O -c pkgB/B.hs \
+ -outputdir '$(PKGB)'
+ ar q '$(PKGB)/libHSpkgB.a' '$(PKGB)/B.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgB/pkg.conf.in >'$(WORK)/pkgB.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgB.conf' >/dev/null
+
+ # Rebuild the same installed unit id from pkgA2, replacing f1 with f2.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA2/A.hs -outputdir '$(PKGA2)'
+ ar q '$(PKGA2)/libHSpkgA.a' '$(PKGA2)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA2/pkg.conf.in >'$(WORK)/pkgA2.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' update '$(WORK)/pkgA2.conf' >/dev/null
+
+ # Compiling Main against pkgB should now fail while loading the stale B.hi.
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make app/Main.hs \
+ -O -fforce-recomp -package-db '$(PKGDB)' -package pkgB \
+ >'$(OUT)' 2>&1 || { echo "expected compilation failure" >&2; exit 1; }
+
+ # Strip the absolute test directory prefix before comparing against T2057.stderr.
+ sed "s#$(CURDIR)/##g" '$(OUT)' >&2
=====================================
testsuite/tests/driver/T2057/README.md
=====================================
@@ -0,0 +1,8 @@
+`T2057` checks that GHC stops after an interface-file error instead of
+continuing into the linker.
+
+The test constructs a stale package dependency on purpose. `pkgB` is compiled
+against one version of package `A`, then the same unit id is replaced by an
+incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
+finds an unfolding that still mentions the old `A`, and should fail while
+loading interfaces.
=====================================
testsuite/tests/driver/T2057/T2057.stderr
=====================================
@@ -0,0 +1,9 @@
+work/pkgB/B.hi
+Declaration for g
+Unfolding of g:
+ f1 ErrorWithoutFlag
+ Can't find interface-file declaration for variable f1
+ Probable cause: bug in .hi-boot file, or inconsistent .hi file
+ Use -ddump-if-trace to get an idea of which file caused the error
+<no location info>:
+ Cannot continue after interface file error
=====================================
testsuite/tests/driver/T2057/all.T
=====================================
@@ -0,0 +1,11 @@
+test(
+ 'T2057',
+ [ extra_files(['pkgA1', 'pkgA2', 'pkgB', 'app', 'README.md'])
+ , when(opsys('mingw32'), skip)
+ , js_skip
+ , wasm_skip
+ , ignore_stdout
+ ],
+ makefile_test,
+ []
+)
=====================================
testsuite/tests/driver/T2057/app/Main.hs
=====================================
@@ -0,0 +1,6 @@
+module Main where
+
+import B
+
+main :: IO ()
+main = print (g 41)
=====================================
testsuite/tests/driver/T2057/pkgA1/A.hs
=====================================
@@ -0,0 +1,5 @@
+module A (f1) where
+
+{-# INLINE f1 #-}
+f1 :: Int -> Int
+f1 x = x + 1
=====================================
testsuite/tests/driver/T2057/pkgA1/pkg.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA1
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA1
+library-dirs: ${pkgroot}/pkgA1
+dynamic-library-dirs: ${pkgroot}/pkgA1
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgA2/A.hs
=====================================
@@ -0,0 +1,4 @@
+module A (f2) where
+
+f2 :: Int -> Int
+f2 x = x + 100
=====================================
testsuite/tests/driver/T2057/pkgA2/pkg.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA1
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA2
+library-dirs: ${pkgroot}/pkgA2
+dynamic-library-dirs: ${pkgroot}/pkgA2
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgB/B.hs
=====================================
@@ -0,0 +1,7 @@
+module B (g) where
+
+import A
+
+{-# INLINE g #-}
+g :: Int -> Int
+g x = f1 x
=====================================
testsuite/tests/driver/T2057/pkgB/pkg.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgB
+version: 1.0
+id: pkgB
+key: pkgB
+exposed: True
+exposed-modules: B
+import-dirs: ${pkgroot}/pkgB
+library-dirs: ${pkgroot}/pkgB
+dynamic-library-dirs: ${pkgroot}/pkgB
+hs-libraries: HSpkgB
+depends: pkgA @BASE_ID@
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14fa99cac2deab1e84de199ba2a570c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/14fa99cac2deab1e84de199ba2a570c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/T2057] Add regression test for #2057
by Simon Jakobi (＠sjakobi2) 09 Mar '26
by Simon Jakobi (＠sjakobi2) 09 Mar '26
09 Mar '26
Simon Jakobi pushed to branch wip/sjakobi/T2057 at Glasgow Haskell Compiler / GHC
Commits:
e894fe64 by Simon Jakobi at 2026-03-09T02:03:45+01:00
Add regression test for #2057
Test that GHC stops after an interface-file error instead of
continuing into the linker.
The test constructs a stale package dependency on purpose. `pkgB` is compiled
against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
Closes #2057.
Assisted-by: Codex
- - - - -
12 changed files:
- + testsuite/tests/driver/T2057/.gitignore
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1.conf.in
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA2.conf.in
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgB.conf.in
- + testsuite/tests/driver/T2057/pkgB/B.hs
Changes:
=====================================
testsuite/tests/driver/T2057/.gitignore
=====================================
@@ -0,0 +1 @@
+work/
=====================================
testsuite/tests/driver/T2057/Makefile
=====================================
@@ -0,0 +1,59 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+WORK = work
+PKGDB = $(WORK)/pkgdb
+PKGA1 = $(WORK)/pkgA1
+PKGA2 = $(WORK)/pkgA2
+PKGB = $(WORK)/pkgB
+APP = $(WORK)/app
+OUT = $(WORK)/T2057.out
+BASE_ID := $(shell "$(GHC_PKG)" field base id --simple-output)
+
+.PHONY: T2057 clean
+
+clean:
+ rm -rf $(WORK)
+
+# Dependency graph:
+# pkgB is built against pkgA1, where A exports f1.
+# We then rebuild the same installed unit id (pkgA) from the pkgA2 sources,
+# where A instead exports f2. Reading B.hi therefore finds an unfolding for g
+# that still refers to f1, and compiling Main against pkgB should stop at the
+# interface error.
+T2057: clean
+
+ # Create an isolated package DB and output directories for the repro.
+ mkdir -p '$(PKGA1)' '$(PKGA2)' '$(PKGB)' '$(APP)'
+ '$(GHC_PKG)' init '$(PKGDB)'
+
+ # Build and register pkgA1, the original version of A.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA1/A.hs -outputdir '$(PKGA1)'
+ ar q '$(PKGA1)/libHSpkgA.a' '$(PKGA1)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA1.conf.in >'$(WORK)/pkgA1.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgA1.conf' >/dev/null
+
+ # Build and register pkgB against pkgA1 so B.hi records the unfolding of g = f1.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -package pkgA1 -this-unit-id pkgB -O -c pkgB/B.hs \
+ -outputdir '$(PKGB)'
+ ar q '$(PKGB)/libHSpkgB.a' '$(PKGB)/B.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgB.conf.in >'$(WORK)/pkgB.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgB.conf' >/dev/null
+
+ # Rebuild the same installed unit id from pkgA2, replacing f1 with f2.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA2/A.hs -outputdir '$(PKGA2)'
+ ar q '$(PKGA2)/libHSpkgA.a' '$(PKGA2)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA2.conf.in >'$(WORK)/pkgA2.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' update '$(WORK)/pkgA2.conf' >/dev/null
+
+ # Compiling Main against pkgB should now fail while loading the stale B.hi.
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make app/Main.hs \
+ -O -fforce-recomp -package-db '$(PKGDB)' -package pkgB \
+ >'$(OUT)' 2>&1 || { echo "expected compilation failure" >&2; exit 1; }
+
+ # Strip the absolute test directory prefix before comparing against T2057.stderr.
+ sed "s#$(CURDIR)/##g" '$(OUT)' >&2
=====================================
testsuite/tests/driver/T2057/README.md
=====================================
@@ -0,0 +1,8 @@
+`T2057` checks that GHC stops after an interface-file error instead of
+continuing into the linker.
+
+The test constructs a stale package dependency on purpose. `pkgB` is compiled
+against one version of package `A`, then the same unit id is replaced by an
+incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
+finds an unfolding that still mentions the old `A`, and should fail while
+loading interfaces.
=====================================
testsuite/tests/driver/T2057/T2057.stderr
=====================================
@@ -0,0 +1,9 @@
+work/pkgB/B.hi
+Declaration for g
+Unfolding of g:
+ f1 ErrorWithoutFlag
+ Can't find interface-file declaration for variable f1
+ Probable cause: bug in .hi-boot file, or inconsistent .hi file
+ Use -ddump-if-trace to get an idea of which file caused the error
+<no location info>:
+ Cannot continue after interface file error
=====================================
testsuite/tests/driver/T2057/all.T
=====================================
@@ -0,0 +1,11 @@
+test(
+ 'T2057',
+ [ extra_files(['pkgA1', 'pkgA2', 'pkgB', 'app', 'README.md', 'pkgA1.conf.in', 'pkgA2.conf.in', 'pkgB.conf.in'])
+ , when(opsys('mingw32'), skip)
+ , js_skip
+ , wasm_skip
+ , ignore_stdout
+ ],
+ makefile_test,
+ []
+)
=====================================
testsuite/tests/driver/T2057/app/Main.hs
=====================================
@@ -0,0 +1,6 @@
+module Main where
+
+import B
+
+main :: IO ()
+main = print (g 41)
=====================================
testsuite/tests/driver/T2057/pkgA1.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA1
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA1
+library-dirs: ${pkgroot}/pkgA1
+dynamic-library-dirs: ${pkgroot}/pkgA1
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgA1/A.hs
=====================================
@@ -0,0 +1,5 @@
+module A (f1) where
+
+{-# INLINE f1 #-}
+f1 :: Int -> Int
+f1 x = x + 1
=====================================
testsuite/tests/driver/T2057/pkgA2.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA1
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA2
+library-dirs: ${pkgroot}/pkgA2
+dynamic-library-dirs: ${pkgroot}/pkgA2
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgA2/A.hs
=====================================
@@ -0,0 +1,4 @@
+module A (f2) where
+
+f2 :: Int -> Int
+f2 x = x + 100
=====================================
testsuite/tests/driver/T2057/pkgB.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgB
+version: 1.0
+id: pkgB
+key: pkgB
+exposed: True
+exposed-modules: B
+import-dirs: ${pkgroot}/pkgB
+library-dirs: ${pkgroot}/pkgB
+dynamic-library-dirs: ${pkgroot}/pkgB
+hs-libraries: HSpkgB
+depends: pkgA @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgB/B.hs
=====================================
@@ -0,0 +1,7 @@
+module B (g) where
+
+import A
+
+{-# INLINE g #-}
+g :: Int -> Int
+g x = f1 x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e894fe640926df1ae83c757dd4a821f…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e894fe640926df1ae83c757dd4a821f…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/sjakobi/T2057] Add regression test for #2057
by Simon Jakobi (＠sjakobi2) 09 Mar '26
by Simon Jakobi (＠sjakobi2) 09 Mar '26
09 Mar '26
Simon Jakobi pushed to branch wip/sjakobi/T2057 at Glasgow Haskell Compiler / GHC
Commits:
40c3c3c3 by Simon Jakobi at 2026-03-09T02:01:42+01:00
Add regression test for #2057
Closes #2057.
Assisted-by: Codex
- - - - -
12 changed files:
- + testsuite/tests/driver/T2057/.gitignore
- + testsuite/tests/driver/T2057/Makefile
- + testsuite/tests/driver/T2057/README.md
- + testsuite/tests/driver/T2057/T2057.stderr
- + testsuite/tests/driver/T2057/all.T
- + testsuite/tests/driver/T2057/app/Main.hs
- + testsuite/tests/driver/T2057/pkgA1.conf.in
- + testsuite/tests/driver/T2057/pkgA1/A.hs
- + testsuite/tests/driver/T2057/pkgA2.conf.in
- + testsuite/tests/driver/T2057/pkgA2/A.hs
- + testsuite/tests/driver/T2057/pkgB.conf.in
- + testsuite/tests/driver/T2057/pkgB/B.hs
Changes:
=====================================
testsuite/tests/driver/T2057/.gitignore
=====================================
@@ -0,0 +1 @@
+work/
=====================================
testsuite/tests/driver/T2057/Makefile
=====================================
@@ -0,0 +1,59 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+WORK = work
+PKGDB = $(WORK)/pkgdb
+PKGA1 = $(WORK)/pkgA1
+PKGA2 = $(WORK)/pkgA2
+PKGB = $(WORK)/pkgB
+APP = $(WORK)/app
+OUT = $(WORK)/T2057.out
+BASE_ID := $(shell "$(GHC_PKG)" field base id --simple-output)
+
+.PHONY: T2057 clean
+
+clean:
+ rm -rf $(WORK)
+
+# Dependency graph:
+# pkgB is built against pkgA1, where A exports f1.
+# We then rebuild the same installed unit id (pkgA) from the pkgA2 sources,
+# where A instead exports f2. Reading B.hi therefore finds an unfolding for g
+# that still refers to f1, and compiling Main against pkgB should stop at the
+# interface error.
+T2057: clean
+
+ # Create an isolated package DB and output directories for the repro.
+ mkdir -p '$(PKGA1)' '$(PKGA2)' '$(PKGB)' '$(APP)'
+ '$(GHC_PKG)' init '$(PKGDB)'
+
+ # Build and register pkgA1, the original version of A.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA1/A.hs -outputdir '$(PKGA1)'
+ ar q '$(PKGA1)/libHSpkgA.a' '$(PKGA1)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA1.conf.in >'$(WORK)/pkgA1.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgA1.conf' >/dev/null
+
+ # Build and register pkgB against pkgA1 so B.hi records the unfolding of g = f1.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -package pkgA1 -this-unit-id pkgB -O -c pkgB/B.hs \
+ -outputdir '$(PKGB)'
+ ar q '$(PKGB)/libHSpkgB.a' '$(PKGB)/B.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgB.conf.in >'$(WORK)/pkgB.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgB.conf' >/dev/null
+
+ # Rebuild the same installed unit id from pkgA2, replacing f1 with f2.
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA -O -c pkgA2/A.hs -outputdir '$(PKGA2)'
+ ar q '$(PKGA2)/libHSpkgA.a' '$(PKGA2)/A.o' >/dev/null 2>&1
+ sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA2.conf.in >'$(WORK)/pkgA2.conf'
+ '$(GHC_PKG)' --package-db '$(PKGDB)' update '$(WORK)/pkgA2.conf' >/dev/null
+
+ # Compiling Main against pkgB should now fail while loading the stale B.hi.
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make app/Main.hs \
+ -O -fforce-recomp -package-db '$(PKGDB)' -package pkgB \
+ >'$(OUT)' 2>&1 || { echo "expected compilation failure" >&2; exit 1; }
+
+ # Strip the absolute test directory prefix before comparing against T2057.stderr.
+ sed "s#$(CURDIR)/##g" '$(OUT)' >&2
=====================================
testsuite/tests/driver/T2057/README.md
=====================================
@@ -0,0 +1,8 @@
+`T2057` checks that GHC stops after an interface-file error instead of
+continuing into the linker.
+
+The test constructs a stale package dependency on purpose. `pkgB` is compiled
+against one version of package `A`, then the same unit id is replaced by an
+incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
+finds an unfolding that still mentions the old `A`, and should fail while
+loading interfaces.
=====================================
testsuite/tests/driver/T2057/T2057.stderr
=====================================
@@ -0,0 +1,9 @@
+work/pkgB/B.hi
+Declaration for g
+Unfolding of g:
+ f1 ErrorWithoutFlag
+ Can't find interface-file declaration for variable f1
+ Probable cause: bug in .hi-boot file, or inconsistent .hi file
+ Use -ddump-if-trace to get an idea of which file caused the error
+<no location info>:
+ Cannot continue after interface file error
=====================================
testsuite/tests/driver/T2057/all.T
=====================================
@@ -0,0 +1,11 @@
+test(
+ 'T2057',
+ [ extra_files(['pkgA1', 'pkgA2', 'pkgB', 'app', 'README.md', 'pkgA1.conf.in', 'pkgA2.conf.in', 'pkgB.conf.in'])
+ , when(opsys('mingw32'), skip)
+ , js_skip
+ , wasm_skip
+ , ignore_stdout
+ ],
+ makefile_test,
+ []
+)
=====================================
testsuite/tests/driver/T2057/app/Main.hs
=====================================
@@ -0,0 +1,6 @@
+module Main where
+
+import B
+
+main :: IO ()
+main = print (g 41)
=====================================
testsuite/tests/driver/T2057/pkgA1.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA1
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA1
+library-dirs: ${pkgroot}/pkgA1
+dynamic-library-dirs: ${pkgroot}/pkgA1
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgA1/A.hs
=====================================
@@ -0,0 +1,5 @@
+module A (f1) where
+
+{-# INLINE f1 #-}
+f1 :: Int -> Int
+f1 x = x + 1
=====================================
testsuite/tests/driver/T2057/pkgA2.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgA1
+version: 1.0
+id: pkgA
+key: pkgA
+exposed: True
+exposed-modules: A
+import-dirs: ${pkgroot}/pkgA2
+library-dirs: ${pkgroot}/pkgA2
+dynamic-library-dirs: ${pkgroot}/pkgA2
+hs-libraries: HSpkgA
+depends: @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgA2/A.hs
=====================================
@@ -0,0 +1,4 @@
+module A (f2) where
+
+f2 :: Int -> Int
+f2 x = x + 100
=====================================
testsuite/tests/driver/T2057/pkgB.conf.in
=====================================
@@ -0,0 +1,11 @@
+name: pkgB
+version: 1.0
+id: pkgB
+key: pkgB
+exposed: True
+exposed-modules: B
+import-dirs: ${pkgroot}/pkgB
+library-dirs: ${pkgroot}/pkgB
+dynamic-library-dirs: ${pkgroot}/pkgB
+hs-libraries: HSpkgB
+depends: pkgA @BASE_ID@
=====================================
testsuite/tests/driver/T2057/pkgB/B.hs
=====================================
@@ -0,0 +1,7 @@
+module B (g) where
+
+import A
+
+{-# INLINE g #-}
+g :: Int -> Int
+g x = f1 x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40c3c3c3f69fd83c87a9a0a5bde3a18…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/40c3c3c3f69fd83c87a9a0a5bde3a18…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
09 Mar '26
Simon Jakobi pushed to branch wip/sjakobi/T2057 at Glasgow Haskell Compiler / GHC
Commits:
a2a79272 by Simon Jakobi at 2026-03-09T01:48:39+01:00
Shorten README
- - - - -
359dd071 by Simon Jakobi at 2026-03-09T01:51:06+01:00
Wibbles
- - - - -
2 changed files:
- testsuite/tests/driver/T2057/Makefile
- testsuite/tests/driver/T2057/README.md
Changes:
=====================================
testsuite/tests/driver/T2057/Makefile
=====================================
@@ -19,29 +19,41 @@ clean:
# Dependency graph:
# pkgB is built against pkgA1, where A exports f1.
# We then rebuild the same installed unit id (pkgA-1) from the pkgA2 sources,
-# where A instead exports f2.
-# Reading B.hi therefore finds an unfolding for g that still refers to f1,
-# and compiling Main against pkgB should stop at the interface error.
+# where A instead exports f2. Reading B.hi therefore finds an unfolding for g
+# that still refers to f1, and compiling Main against pkgB should stop at the
+# interface error.
T2057: clean
+
# Create an isolated package DB and output directories for the repro.
mkdir -p '$(PKGA1)' '$(PKGA2)' '$(PKGB)' '$(APP)'
'$(GHC_PKG)' init '$(PKGDB)'
+
# Build and register pkgA1, the original version of A.
- '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' -this-unit-id pkgA-1 -O -c pkgA1/A.hs -outputdir '$(PKGA1)'
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA-1 -O -c pkgA1/A.hs -outputdir '$(PKGA1)'
ar q '$(PKGA1)/libHSpkgA-1.a' '$(PKGA1)/A.o' >/dev/null 2>&1
sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA1.conf.in >'$(WORK)/pkgA1.conf'
'$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgA1.conf' >/dev/null
+
# Build and register pkgB against pkgA1 so B.hi records the unfolding of g = f1.
- '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' -package pkgA1 -this-unit-id pkgB-1 -O -c pkgB/B.hs -outputdir '$(PKGB)'
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -package pkgA1 -this-unit-id pkgB-1 -O -c pkgB/B.hs \
+ -outputdir '$(PKGB)'
ar q '$(PKGB)/libHSpkgB-1.a' '$(PKGB)/B.o' >/dev/null 2>&1
sed "s|@BASE_ID@|$(BASE_ID)|g" pkgB.conf.in >'$(WORK)/pkgB.conf'
'$(GHC_PKG)' --package-db '$(PKGDB)' register '$(WORK)/pkgB.conf' >/dev/null
+
# Rebuild the same installed unit id from pkgA2, replacing f1 with f2.
- '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' -this-unit-id pkgA-1 -O -c pkgA2/A.hs -outputdir '$(PKGA2)'
+ '$(TEST_HC)' $(TEST_HC_OPTS) -v0 -package-db '$(PKGDB)' \
+ -this-unit-id pkgA-1 -O -c pkgA2/A.hs -outputdir '$(PKGA2)'
ar q '$(PKGA2)/libHSpkgA-1.a' '$(PKGA2)/A.o' >/dev/null 2>&1
sed "s|@BASE_ID@|$(BASE_ID)|g" pkgA2.conf.in >'$(WORK)/pkgA2.conf'
'$(GHC_PKG)' --package-db '$(PKGDB)' update '$(WORK)/pkgA2.conf' >/dev/null
+
# Compiling Main against pkgB should now fail while loading the stale B.hi.
- ! '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make app/Main.hs -O -fforce-recomp -package-db '$(PKGDB)' -package pkgB >'$(OUT)' 2>&1 || { echo "expected compilation failure" >&2; exit 1; }
+ ! '$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make app/Main.hs \
+ -O -fforce-recomp -package-db '$(PKGDB)' -package pkgB \
+ >'$(OUT)' 2>&1 || { echo "expected compilation failure" >&2; exit 1; }
+
# Strip the absolute test directory prefix before comparing against T2057.stderr.
sed "s#$(CURDIR)/##g" '$(OUT)' >&2
=====================================
testsuite/tests/driver/T2057/README.md
=====================================
@@ -6,8 +6,3 @@ against one version of package `A`, then the same unit id is replaced by an
incompatible build of `A`. When `Main` imports `B`, GHC has to read `B.hi`,
finds an unfolding that still mentions the old `A`, and should fail while
loading interfaces.
-
-The golden [`T2057.stderr`](T2057.stderr) captures the expected behaviour on a
-fixed compiler: report the missing declaration from the stale interface and
-then abort with `Cannot continue after interface file error`. Any linker output
-would be a regression.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89ed54d65e87dda1c86b0165988115…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/89ed54d65e87dda1c86b0165988115…
You're receiving this email because of your account on gitlab.haskell.org.
1
0