Apoorv Ingle pushed to branch wip/ani/tc-expand at Glasgow Haskell Compiler / GHC Commits: 95b5f2cb by Apoorv Ingle at 2026-03-16T13:35:36-05:00 make HsExpandedRn and HsExpandedTc payload LExpr, add tcExpand for expanding Do expressions before typechecking in tcExpr - - - - - 15 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Syn/Type.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Gen/Do.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Match.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/Tc/Zonk/Type.hs Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -661,43 +661,23 @@ type instance XXExpr GhcTc = XXExprGhcTc ********************************************************************* -} data XXExprGhcRn - = ExpandedThingRn { xrn_orig :: HsCtxt -- The original source thing context to be used for error messages - , xrn_expanded :: HsExpr GhcRn -- The compiler generated, expanded thing - } + = ExpandedThingRn { xrn_orig :: HsCtxt -- The original source thing context to be used for error messages + , xrn_expanded :: LHsExpr GhcRn } -- The compiler generated, expanded thing + -- This is located because of do statements (TODO ANI : Add Note) | HsRecSelRn (FieldOcc GhcRn) -- ^ Variable pointing to record selector -- See Note [Non-overloaded record field selectors] and -- Note [Record selectors in the AST] --- | Build an expression using the extension constructor `XExpr`, --- and the two components of the expansion: original expression and --- expanded expressions. -mkExpandedExpr - :: HsExpr GhcRn -- ^ source expression context - -> HsExpr GhcRn -- ^ expanded expression - -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn { xrn_orig = ExprCtxt oExpr - , xrn_expanded = eExpr }) - --- | Build an expression using the extension constructor `XExpr`, --- and the two components of the expansion: original do stmt and --- expanded expression -mkExpandedStmt - :: ExprLStmt GhcRn -- ^ source statement context - -> HsDoFlavour -- ^ source statements do flavour - -> HsExpr GhcRn -- ^ expanded expression - -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedStmt oStmt flav eExpr = XExpr (ExpandedThingRn { xrn_orig = StmtErrCtxt (HsDoStmt flav) oStmt - , xrn_expanded = eExpr }) - data XXExprGhcTc = WrapExpr -- Type and evidence application and abstractions HsWrapper (HsExpr GhcTc) | ExpandedThingTc -- See Note [Rebindable syntax and XXExprGhcRn] -- See Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do` - { xtc_orig :: HsCtxt -- The original user written thing - , xtc_expanded :: HsExpr GhcTc } -- The expanded typechecked expression + { xtc_orig :: HsCtxt -- The original user written thing + , xtc_expanded :: LHsExpr GhcTc } -- The expanded typechecked expression + -- This is located because of do statements (TODO ANI: Add NOTE) | ConLikeTc -- ^ A 'ConLike', either a data constructor or pattern synonym @@ -722,22 +702,6 @@ data XXExprGhcTc -- See Note [Non-overloaded record field selectors] and -- Note [Record selectors in the AST] - --- | Build a 'XXExprGhcRn' out of an extension constructor, --- and the two components of the expansion: original and --- expanded typechecked expressions. -mkExpandedExprTc - :: HsExpr GhcRn -- ^ source expression - -> HsExpr GhcTc -- ^ expanded typechecked expression - -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedExprTc oExpr eExpr = mkExpandedTc (ExprCtxt oExpr) eExpr - -mkExpandedTc - :: HsCtxt -- ^ source, user written do statement/expression - -> HsExpr GhcTc -- ^ expanded typechecked expression - -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' -mkExpandedTc o e = XExpr (ExpandedThingTc o e) - {- ********************************************************************* * * Pretty-printing expressions ===================================== compiler/GHC/Hs/Syn/Type.hs ===================================== @@ -153,7 +153,7 @@ hsExprType (HsQual x _ _) = dataConCantHappen x hsExprType (HsForAll x _ _) = dataConCantHappen x hsExprType (HsFunArr x _ _ _) = dataConCantHappen x hsExprType (XExpr (WrapExpr wrap e)) = hsWrapperType wrap $ hsExprType e -hsExprType (XExpr (ExpandedThingTc _ e)) = hsExprType e +hsExprType (XExpr (ExpandedThingTc _ e)) = lhsExprType e hsExprType (XExpr (ConLikeTc con)) = conLikeType con hsExprType (XExpr (HsTick _ e)) = lhsExprType e hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -41,7 +41,6 @@ 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) @@ -308,10 +307,7 @@ dsExpr e@(XExpr ext_expr_tc) WrapExpr {} -> dsApp e ConLikeTc {} -> dsApp e - ExpandedThingTc o e - | StmtErrCtxt _ (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 + ExpandedThingTc _ e -> dsLExpr e -- Hpc Support HsTick tickish e -> do ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -1167,7 +1167,7 @@ viewLExprEq (e1,_) (e2,_) = lexp e1 e2 exp (XExpr (WrapExpr h e)) (XExpr (WrapExpr h' e')) = wrap h h' && exp e e' exp (XExpr (ExpandedThingTc _ x)) (XExpr (ExpandedThingTc _ x')) - = exp x x' + = lexp x x' exp (HsVar _ i) (HsVar _ i') = i == i' exp (HsIPVar _ i) (HsIPVar _ i') = -- the instance for IPName derives using the id, so follow the HsVar case ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1739,7 +1739,7 @@ repE e@(XExpr (ExpandedThingRn o x)) | ExprCtxt e <- o = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax ; if rebindable_on -- See Note [Quotation and rebindable syntax] - then repE x + then repLE x else repE e } | otherwise = notHandled (ThExpressionForm e) ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -492,7 +492,7 @@ isCallSite HsApp{} = True isCallSite HsAppType{} = True isCallSite HsCase{} = True isCallSite (XExpr (ExpandedThingTc _ e)) - = isCallSite e + = isCallSite (unLoc e) -- NB: OpApp, SectionL, SectionR are all expanded out isCallSite _ = False @@ -660,14 +660,14 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts)) ListComp -> Just $ BinBox QualBinBox _ -> Nothing -addTickHsExpanded :: HsCtxt -> HsExpr GhcTc -> TM (HsExpr GhcTc) +addTickHsExpanded :: HsCtxt -> LHsExpr GhcTc -> TM (HsExpr GhcTc) addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of -- We always want statements to get a tick, so we can step over each one. -- To avoid duplicates we blacklist SrcSpans we already inserted here. StmtErrCtxt _ (L pos _) -> do_tick_black pos _ -> skip where - skip = addTickHsExpr e + skip = addTickLHsExpr e do_tick_black pos = do d <- getDensity case d of @@ -675,9 +675,9 @@ addTickHsExpanded o e = liftM (XExpr . ExpandedThingTc o) $ case o of TickForBreakPoints -> tick_it_black pos _ -> skip tick_it_black pos = - unLoc <$> allocTickBox (ExpBox False) False False (locA pos) + allocTickBox (ExpBox False) False False (locA pos) (withBlackListed (locA pos) $ - addTickHsExpr e) + addTickHsExpr (unLoc e)) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -757,8 +757,8 @@ instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where HsPragE _ _ e -> computeLType e XExpr (ExpandedThingTc thing e) | ExprCtxt (HsGetField{}) <- thing -- for record-dot-syntax - -> Just (hsExprType e) - | otherwise -> computeType e + -> Just (lhsExprType e) + | otherwise -> computeLType e XExpr (HsTick _ e) -> computeLType e XExpr (HsBinTick _ _ e) -> computeLType e e -> Just (hsExprType e) @@ -1353,7 +1353,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where -> [ toHie $ L mspan a , toHie (L mspan w) ] ExpandedThingTc _ e - -> [ toHie (L mspan e) ] + -> [ toHie e ] ConLikeTc con -> [ toHie $ C Use $ L mspan $ conLikeName con ] HsTick _ expr ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -24,6 +24,8 @@ module GHC.Rename.Utils ( genSimpleFunBind, genFunBind, genHsLamDoExp, genHsCaseAltDoExp, genSimpleMatch, genHsLet, + mkExpandedRn, mkExpandedExpr, mkExpandedStmt, mkExpandedLExpr, mkExpandedTc, mkExpandedExprTc, + mkRnSyntaxExpr, newLocalBndrRn, newLocalBndrsRn, @@ -45,7 +47,6 @@ import GHC.Core.Type import GHC.Hs import GHC.Types.Name.Reader import GHC.Tc.Errors.Types --- import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad import GHC.Types.Name import GHC.Types.Name.Set @@ -816,3 +817,50 @@ genSimpleMatch ctxt pats rhs = wrapGenSpan $ Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = noLocA pats , m_grhss = unguardedGRHSs generatedSrcSpan rhs noAnn } + + +-- | Build an expression using the extension constructor `XExpr`, +-- and the two components of the expansion: original expression and +-- expanded expressions. +mkExpandedExpr + :: HsExpr GhcRn -- ^ source expression context + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' +mkExpandedExpr oExpr eExpr = mkExpandedRn (ExprCtxt oExpr) (wrapGenSpan eExpr) + +mkExpandedLExpr + :: HsExpr GhcRn -- ^ source expression context + -> LHsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' +mkExpandedLExpr oExpr eExpr = mkExpandedRn (ExprCtxt oExpr) eExpr + +-- | Build an expression using the extension constructor `XExpr`, +-- and the two components of the expansion: original do stmt and +-- expanded expression +mkExpandedStmt + :: ExprLStmt GhcRn -- ^ source statement context + -> HsDoFlavour -- ^ source statements do flavour + -> HsExpr GhcRn -- ^ expanded expression + -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' +mkExpandedStmt oStmt flav eExpr = mkExpandedRn (StmtErrCtxt (HsDoStmt flav) oStmt) (wrapGenSpan eExpr) + +mkExpandedRn + :: HsCtxt -- ^ source, user written do statement/expression + -> LHsExpr GhcRn -- ^ expanded typechecked expression + -> HsExpr GhcRn -- ^ suitably wrapped 'XXExprGhcRn' +mkExpandedRn orig expr = XExpr (ExpandedThingRn orig expr) + +-- | Build a 'XXExprGhcRn' out of an extension constructor, +-- and the two components of the expansion: original and +-- expanded typechecked expressions. +mkExpandedExprTc + :: HsExpr GhcRn -- ^ source expression + -> HsExpr GhcTc -- ^ expanded typechecked expression + -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' +mkExpandedExprTc oExpr eExpr = mkExpandedTc (ExprCtxt oExpr) (wrapGenSpan eExpr) + +mkExpandedTc + :: HsCtxt -- ^ source, user written do statement/expression + -> LHsExpr GhcTc -- ^ expanded typechecked expression + -> HsExpr GhcTc -- ^ suitably wrapped 'XXExprGhcRn' +mkExpandedTc o e = XExpr (ExpandedThingTc o e) ===================================== compiler/GHC/Tc/Gen/Do.hs ===================================== @@ -14,8 +14,7 @@ module GHC.Tc.Gen.Do (expandDoStmts) where import GHC.Prelude -import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet, - genHsLamDoExp, genHsCaseAltDoExp, genWildPat ) +import GHC.Rename.Utils import GHC.Rename.Env ( irrefutableConLikeRn ) import GHC.Tc.Utils.Monad @@ -77,7 +76,7 @@ expand_do_stmts flav [stmt@(L sloc (LastStmt _ body@(L body_loc _) _ ret_expr))] -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt` | NoSyntaxExprRn <- ret_expr -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt - = return $ L sloc (mkExpandedStmt stmt flav (unLoc body)) + = return $ L sloc (mkExpandedStmt stmt flav (unLoc body)) -- TODO ANI: why not just body? | SyntaxExprRn ret <- ret_expr -- We have unfortunately lost the location on the return function :( -- @@ -484,4 +483,4 @@ It stores the original statement (with location) and the expanded expression mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn mkExpandedPatRn pat e = XExpr $ ExpandedThingRn { xrn_orig = StmtErrCtxtPat pat - , xrn_expanded = e} + , xrn_expanded = wrapGenSpan e} ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -36,6 +36,7 @@ import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls ) import GHC.Tc.Gen.App import GHC.Tc.Gen.Head +import GHC.Tc.Gen.Do import GHC.Tc.Gen.Bind ( tcLocalBinds ) import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Arrow @@ -92,6 +93,8 @@ import GHC.Data.Maybe import Control.Monad import qualified Data.List.NonEmpty as NE +import qualified GHC.LanguageExtensions as LangExt + {- ************************************************************************ * * @@ -562,7 +565,17 @@ tcExpr (HsMultiIf _ alts) res_ty ; res_ty <- readExpType res_ty ; return (HsMultiIf res_ty alts') } -tcExpr (HsDo _ do_or_lc stmts) res_ty +tcExpr expr@(HsDo _ do_or_lc stmts) res_ty + | DoExpr{} <- do_or_lc + = do isApplicativeDo <- xoptM LangExt.ApplicativeDo + if isApplicativeDo + then tcDoStmts do_or_lc stmts res_ty + else do { expr' <- tcExpandExpr expr + ; tcExpr expr' res_ty } + | MDoExpr{} <- do_or_lc + = do expr' <- tcExpandExpr expr + tcExpr expr' res_ty + | otherwise = tcDoStmts do_or_lc stmts res_ty tcExpr (HsProc x pat cmd) res_ty @@ -809,7 +822,7 @@ The rest of this Note explains how that is done. like "In the expression: x+y" or "In the record update: r { x=2 }" * Now, when - tcMonoLHsExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) + tcMonoLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) gets a located expression, it does 2 things: * Calls `addLExprCtxt` to perform error context management * Calls `tcExpr` to typecheck the expression. @@ -839,7 +852,7 @@ tcXExpr (ExpandedThingRn o e) res_ty = mkExpandedTc o <$> -- necessary for hpc ticks -- Need to call tcExpr and not tcApp -- as e can be let statement which tcApp cannot gracefully handle - tcExpr e res_ty + tcMonoLExpr e res_ty -- For record selection, same as HsVar case tcXExpr xe res_ty = tcApp (XExpr xe) res_ty @@ -1846,3 +1859,16 @@ checkMissingFields con_like rbinds arg_tys field_strs = conLikeImplBangs con_like fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds + + +-- Expands the expression +tcExpandExpr :: HsExpr GhcRn -> TcM (HsExpr GhcRn) +tcExpandExpr orig_expr@(HsDo _ flav (L _ stmts)) + = do { expanded_expr <- expandDoStmts flav stmts + -- We lose the location on the first statement location in GhcTc, unfortunately. + -- It is needed for get the pattern match warnings right cf. T14546d + -- That location is currently recovered from the location stored in StmtErrCtxt + -- in dsExpr of ExpandedThingTc + ; return (mkExpandedLExpr orig_expr expanded_expr) } + +tcExpandExpr e = return e ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -29,6 +29,8 @@ import GHC.Prelude import GHC.Hs import GHC.Hs.Syn.Type +import GHC.Rename.Utils (mkExpandedTc, mkExpandedExprTc) + import GHC.Tc.Gen.HsType import GHC.Tc.Gen.Bind( chooseInferredQuantifiers ) import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig ) @@ -460,11 +462,11 @@ tcInferAppHead_maybe fun = case fun of ExprWithTySig _ e hs_ty -> Just <$> with_get_ds (tcExprWithSig e hs_ty) HsOverLit _ lit -> Just <$> with_get_ds (tcInferOverLit lit) XExpr (HsRecSelRn f) -> Just <$> with_get_ds (tcInferRecSelId f) - XExpr (ExpandedThingRn o e) -> Just <$> ( + XExpr (ExpandedThingRn o (L loc e)) -> Just <$> ( -- We do not want to instantiate the type of the head as there may be -- visible type applications in the argument. -- c.f. T19167 - (\ (e, ds_flag, ty) -> (mkExpandedTc o e, ds_flag, ty)) <$> + (\ (e, ds_flag, ty) -> (mkExpandedTc o (L loc e), ds_flag, ty)) <$> tcExprSigma False (errCtxtCtOrigin o) e ) _ -> return Nothing ===================================== compiler/GHC/Tc/Gen/Match.hs ===================================== @@ -35,7 +35,7 @@ where import GHC.Prelude import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoFRRNC - , tcMonoLExprNC, tcMonoLExpr, tcExpr + , tcMonoLExprNC, tcExpr , tcCheckMonoExpr, tcCheckMonoExprNC , tcCheckPolyExpr, tcPolyLExpr ) @@ -44,7 +44,6 @@ import GHC.Tc.Errors.Types import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Env import GHC.Tc.Gen.Pat -import GHC.Tc.Gen.Do import GHC.Tc.Gen.Head( tcCheckId ) import GHC.Tc.Utils.TcMType import GHC.Tc.Utils.TcType @@ -391,32 +390,14 @@ tcDoStmts MonadComp (L l stmts) res_ty ; res_ty <- readExpType res_ty ; return (HsDo res_ty MonadComp (L l stmts')) } -tcDoStmts ctxt@GhciStmtCtxt _ _ = pprPanic "tcDoStmts" (pprHsDoFlavour ctxt) - -tcDoStmts doExpr@(DoExpr _) ss@(L l stmts) res_ty - = do { isApplicativeDo <- xoptM LangExt.ApplicativeDo - ; if isApplicativeDo - then do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty - ; res_ty <- readExpType res_ty - ; return (HsDo res_ty doExpr (L l stmts')) } - else do { expanded_expr <- expandDoStmts doExpr stmts -- Do expansion on the fly - ; traceTc "tcDoStmts" (ppr expanded_expr) - ; let orig = HsDo noExtField doExpr ss - ; mkExpandedExprTc orig <$> ( - -- We lose the location on the first statement location in GhcTc, unfortunately. - -- It is needed for get the pattern match warnings right cf. T14546d - -- That location is currently recovered from the location stored in OrigStmt - -- in dsExpr of ExpandedThingTc - unLoc <$> tcMonoLExpr expanded_expr res_ty) - } - } -tcDoStmts mDoExpr ss@(L _ stmts) res_ty - = do { expanded_expr <- expandDoStmts mDoExpr stmts -- Do expansion on the fly - ; let orig = HsDo noExtField mDoExpr ss - ; e' <- tcMonoLExpr expanded_expr res_ty - ; return (mkExpandedExprTc orig (unLoc e')) - } +tcDoStmts doExpr@(DoExpr _) (L l stmts) res_ty + = do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty + ; res_ty <- readExpType res_ty + ; return (HsDo res_ty doExpr (L l stmts')) } + +-- NB: ghcistmts should fail, MDoExpr is handled by expansions +tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprHsDoFlavour ctxt) tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc) tcBody body res_ty ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1334,7 +1334,7 @@ addLExprCtxt lspan e thing_inside | not (isGeneratedSrcSpan lspan) = setSrcSpan lspan $ add_expr_ctxt e thing_inside | otherwise -- no op in generated code - = thing_inside + = setSrcSpan lspan $ thing_inside where add_expr_ctxt :: HsExpr GhcRn -> TcRn a -> TcRn a add_expr_ctxt e thing_inside @@ -1349,10 +1349,10 @@ addLExprCtxt lspan e thing_inside -- error context. So here we flip the ErrCtxt state to expanded if the expression is expanded. -- c.f. RecordDotSyntaxFail9 ExprWithTySig _ (L _ e') _ - | XExpr (ExpandedThingRn o _) <- e' -> addExpansionErrCtxt o thing_inside + | XExpr (ExpandedThingRn o _) <- e' -> addErrCtxt o thing_inside -- Flip error ctxt into expansion mode - XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o thing_inside + XExpr (ExpandedThingRn o _) -> addErrCtxt o thing_inside _ -> addErrCtxt (ExprCtxt e) thing_inside ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -105,7 +105,7 @@ import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Basic import GHC.Types.Unique.Set (nonDetEltsUniqSet) -import GHC.Types.SrcLoc (unLoc) +import GHC.Types.SrcLoc (unLoc, GenLocated (..)) import GHC.Utils.Misc import GHC.Utils.Outputable as Outputable @@ -2047,7 +2047,7 @@ getDeepSubsumptionFlag_DataConHead app_head = go app_head | XExpr (ConLikeTc (RealDataCon {})) <- app_head = Deep TopSub - | XExpr (ExpandedThingTc _ f) <- app_head + | XExpr (ExpandedThingTc _ (L _ f)) <- app_head = go f | XExpr (WrapExpr _ f) <- app_head = go f ===================================== compiler/GHC/Tc/Zonk/Type.hs ===================================== @@ -1096,7 +1096,7 @@ zonkExpr (XExpr (WrapExpr co_fn expr)) return (XExpr (WrapExpr new_co_fn new_expr)) zonkExpr (XExpr (ExpandedThingTc thing e)) - = do e' <- zonkExpr e + = do e' <- zonkLExpr e return $ XExpr (ExpandedThingTc thing e') zonkExpr e@(XExpr (ConLikeTc {})) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95b5f2cb50612f64e66c73e463a87145... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95b5f2cb50612f64e66c73e463a87145... You're receiving this email because of your account on gitlab.haskell.org.