Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC Commits: 427c26b4 by Apoorv Ingle at 2026-03-09T12:19:03-05:00 route the correct ExpectedFunTyCtxt SDoc. Add missing RecordUpdCtxt to errCtxtCtOrigin - - - - - 2 changed files: - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Zonk/TcType.hs Changes: ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -431,7 +431,7 @@ data CtOrigin | ProvCtxtOrigin -- The "provided" context of a pattern synonym signature (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in -- particular the name and the right-hand side - | RecordUpdOrigin (LHsRecUpdFields GhcRn) + | RecordUpdOrigin | ViewPatOrigin -- | 'ScOrigin' is used only for the Wanted constraints for the @@ -623,7 +623,7 @@ exprCtOrigin (HsFunArr {}) = Shouldn'tHappenOrigin "function arrow" exprCtOrigin (ExplicitList {}) = ListOrigin exprCtOrigin (HsIf {}) = IfThenElseOrigin exprCtOrigin (HsProjection _ p) = RecordFieldProjectionOrigin (FieldLabelStrings $ fmap noLocA p) -exprCtOrigin (RecordUpd _ _ flds) = RecordUpdOrigin flds +exprCtOrigin (RecordUpd{}) = RecordUpdOrigin 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) @@ -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" @@ -1168,8 +1169,8 @@ pprFixedRuntimeRepContext FRRBindStmtGuard = sep [ text "The body of the bind statement" ] pprFixedRuntimeRepContext (FRRArrow arrowContext) = pprFRRArrowContext arrowContext -pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig _) - = pprExpectedFunTyHerald funTyOrig +pprFixedRuntimeRepContext (FRRExpectedFunTy funTyOrig i) + = pprExpectedFunTyCtxt funTyOrig i pprFixedRuntimeRepContext (FRRDeepSubsumption is_exp pos mb_fun) = hsep [ text "The", what, text "type of the" , ppr (Argument pos) ===================================== compiler/GHC/Tc/Zonk/TcType.hs ===================================== @@ -811,153 +811,19 @@ zonkTidyErrCtxtMsg env (ThetaCtxt ctxt theta_ty) = do 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 + (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 + (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 --} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/427c26b4248a4abc92ef13f4f929eaeb... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/427c26b4248a4abc92ef13f4f929eaeb... You're receiving this email because of your account on gitlab.haskell.org.