Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC Commits: 4800bc7c by Apoorv Ingle at 2026-02-22T21:39:54-06:00 some in complete data defs - - - - - 6 changed files: - compiler/GHC/Hs/Instances.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/TyCl/Instance.hs Changes: ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -620,48 +620,18 @@ deriving instance Eq (IE GhcTc) -- --------------------------------------------------------------------- --- deriving instance Data ErrCtxtMsg --- deriving instance Data XXExprGhcRn -con_ExpandedThingRn = mkConstr xXExprGhcRn_T "ExpandedThingRn" [] Prefix -con_HsRecSelRn = mkConstr xXExprGhcRn_T "HsRecSelRn" [] Prefix -xXExprGhcRn_T = mkDataType "GHC.Hs.Expr.XXExprGhcRn" [] +instance Data ErrCtxtMsg where + gunfold _ _ _ = error "no gunfold for ErrCtxtMsg" + gfoldl _ _ _ = error "no goldl for ErrCtxtMsg" -instance Data XXExprGhcRn where - toConstr (ExpandedThingRn{}) = con_ExpandedThingRn - toConstr (HsRecSelRn{}) = con_HsRecSelRn - dataTypeOf _ = xXExprGhcRn_T - - gunfold k z c = error "no gunfold for XXExprGhcRn" - gfoldl k z c = error "no gfoldl for XXExprGhcRn" +deriving instance Data XXExprGhcRn deriving instance Data a => Data (WithUserRdr a) --- --------------------------------------------------------------------- - --- deriving instance Data XXExprGhcTc -con_ExpandedThingTc = mkConstr xXExprGhcTc_T "ExpandedThingTc" [] Prefix -con_WrapExpr = mkConstr xXExprGhcTc_T "WrapExpr" [] Prefix -con_ConLikeTc = mkConstr xXExprGhcTc_T "ConLikeTc" [] Prefix -con_HsTick = mkConstr xXExprGhcTc_T "HsTick" [] Prefix -con_HsBinTick = mkConstr xXExprGhcTc_T "HsBinTick" [] Prefix -con_HsRecSelTc = mkConstr xXExprGhcTc_T "HsRecSelTc" [] Prefix -xXExprGhcTc_T = mkDataType "GHC.Hs.Expr.XXExprGhcTc" [] - -instance Data XXExprGhcTc where - toConstr (ExpandedThingTc{}) = con_ExpandedThingTc - toConstr (WrapExpr{}) = con_WrapExpr - toConstr (ConLikeTc{}) = con_ConLikeTc - toConstr (HsTick{}) = con_HsTick - toConstr (HsBinTick{}) = con_HsBinTick - toConstr (HsRecSelTc{}) = con_HsRecSelTc - - dataTypeOf _ = xXExprGhcTc_T - - - gunfold _ _ _ = error "no gunfold for XXExprGhcTc" - gfoldl _ _ _ = error "no gfoldl for XXExprGhcTc" - +-- ------------------------------- +-------------------------------------- +deriving instance Data XXExprGhcTc deriving instance Data XXPatGhcTc -- --------------------------------------------------------------------- ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -40,6 +40,7 @@ import GHC.Hs -- needs to see source types import GHC.Tc.Utils.TcType import GHC.Tc.Types.Evidence +import GHC.Tc.Types.ErrCtxt import GHC.Tc.Utils.Monad import GHC.Tc.Instance.Class (lookupHasFieldLabel) @@ -296,7 +297,7 @@ dsExpr e@(XExpr ext_expr_tc) ConLikeTc {} -> dsApp e ExpandedThingTc o e - | OrigStmt (L loc _) _ <- o -- c.f. T14546d. We have lost the location of the first statement in the GhcRn -> GhcTc + | DoStmtErrCtxt _ (L loc _) <- o -- c.f. T14546d. We have lost the location of the first statement in the GhcRn -> GhcTc -> putSrcSpanDsA loc $ dsExpr e | otherwise -> dsExpr e ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -41,6 +41,7 @@ import GHC.Hs.Decls.Overlap ( OverlapMode(..) ) import GHC.Tc.Utils.TcType import GHC.Tc.Types.Evidence +import GHC.Tc.Types.ErrCtxt import GHC.Tc.TyCl ( IsPrefixConGADT(..), unannotatedMultIsLinear ) import GHC.Core.Class @@ -1732,7 +1733,7 @@ repE (HsFunArr _ mult arg res) = do res' <- repLE res repApps fun [arg', res'] repE e@(XExpr (ExpandedThingRn o x)) - | OrigExpr e <- o + | ExprCtxt e <- o = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax ; if rebindable_on -- See Note [Quotation and rebindable syntax] then repE x ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -268,6 +268,13 @@ tcCheckMonoExpr, tcCheckMonoExprNC tcCheckMonoExpr expr res_ty = tcMonoLExpr expr (mkCheckExpType res_ty) tcCheckMonoExprNC expr res_ty = tcMonoLExprNC expr (mkCheckExpType res_ty) + +-- Expand the HsExpr if it is typechecked after expansions +-- See Note [Handling overloaded and rebindable constructs] +-- See Note [Typechecking by expansion: overview] +expand_expr :: HsExpr GhcRn -> TcM (HsExpr GhcRn) +expand_expr x = return x + --------------- tcMonoLExpr, tcMonoLExprNC :: LHsExpr GhcRn -- Expression to type check @@ -276,9 +283,10 @@ tcMonoLExpr, tcMonoLExprNC -> TcM (LHsExpr GhcTc) tcMonoLExpr (L loc expr) res_ty - = addLExprCtxt (locA loc) expr $ -- Note [Error contexts in generated code] - do { expr' <- tcExpr expr res_ty - ; return (L loc expr') } + = do expanded_expr <- expand_expr expr + addLExprCtxt (locA loc) expanded_expr $ -- Note [Error contexts in generated code] + do { expr' <- tcExpr expr res_ty + ; return (L loc expr') } tcMonoLExprNC (L loc expr) res_ty = setSrcSpanA loc $ @@ -676,7 +684,7 @@ tcExpr expr@(RecordUpd { rupd_expr = record_expr ; (ds_expr, ds_res_ty, err_msg) <- expandRecordUpd record_expr possible_parents rbnds res_ty - ; addExpansionErrCtxt (ExprCtxt expr) err_msg $ + ; addExpansionErrCtxt err_msg $ do { -- Typecheck the expanded expression. expr' <- tcExpr ds_expr (Check ds_res_ty) -- NB: it's important to use ds_res_ty and not res_ty here. ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -487,7 +487,7 @@ tcStmtsAndThen ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside | otherwise = do { (stmt', (stmts', thing)) <- setSrcSpanA loc $ - addErrCtxt (StmtErrCtxt ctxt (L loc stmt)) $ + addErrCtxt (StmtErrCtxt ctxt stmt) $ stmt_chk ctxt stmt res_ty $ \ res_ty' -> popErrCtxt $ tcStmtsAndThen ctxt stmt_chk stmts res_ty' $ ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -2108,7 +2108,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind -- The instance-sig is the focus here; the class-meth-sig -- is fixed (#18036) ; let orig = InstanceSigOrigin sel_name sig_ty local_meth_ty - ; hs_wrap <- addErrCtxtM (MethSigCtxt sel_name sig_ty meth_ty) $ + ; hs_wrap <- addErrCtxtM (MethSigCtxt sel_name sig_ty local_meth_ty) $ tcSubTypeSigma orig ctxt sig_ty local_meth_ty ; return (sig_ty, hs_wrap) } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4800bc7c37b8085d840c3e41cbd1f2ef... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4800bc7c37b8085d840c3e41cbd1f2ef... You're receiving this email because of your account on gitlab.haskell.org.