Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 3c4db9cf by Apoorv Ingle at 2025-05-26T11:18:53-05:00 remove special case for HsExpanded in Ticks - - - - - 655c636b by Apoorv Ingle at 2025-05-26T11:19:29-05:00 check the right origin for record selector incomplete warnings - - - - - 2 changed files: - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Tc/Instance/Class.hs Changes: ===================================== compiler/GHC/HsToCore/Ticks.hs ===================================== @@ -583,7 +583,11 @@ addTickHsExpr (HsProc x pat cmdtop) = addTickHsExpr (XExpr (WrapExpr w e)) = liftM (XExpr . WrapExpr w) $ (addTickHsExpr e) -- Explicitly no tick on inside -addTickHsExpr (XExpr (ExpandedThingTc o e)) = addTickHsExpanded o e +addTickHsExpr (XExpr (ExpandedThingTc o e)) = + liftM (XExpr . ExpandedThingTc o) $ + (addTickHsExpr e) -- Explicitly no tick on inside + + -- addTickHsExpanded o e addTickHsExpr e@(XExpr (ConLikeTc {})) = return e @@ -607,24 +611,24 @@ addTickHsExpr (HsDo srcloc cxt (L l stmts)) ListComp -> Just $ BinBox QualBinBox _ -> Nothing -addTickHsExpanded :: HsThingRn -> HsExpr 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. - OrigStmt (L pos _) _ -> do_tick_black pos - _ -> skip - where - skip = addTickHsExpr e - do_tick_black pos = do - d <- getDensity - case d of - TickForCoverage -> tick_it_black pos - TickForBreakPoints -> tick_it_black pos - _ -> skip - tick_it_black pos = - unLoc <$> allocTickBox (ExpBox False) False False (locA pos) - (withBlackListed (locA pos) $ - addTickHsExpr e) +-- addTickHsExpanded :: HsThingRn -> HsExpr 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. +-- OrigStmt (L pos _) _ -> do_tick_black pos +-- _ -> skip +-- where +-- skip = addTickHsExpr e +-- do_tick_black pos = do +-- d <- getDensity +-- case d of +-- TickForCoverage -> tick_it_black pos +-- TickForBreakPoints -> tick_it_black pos +-- _ -> skip +-- tick_it_black pos = +-- unLoc <$> allocTickBox (ExpBox False) False False (locA pos) +-- (withBlackListed (locA pos) $ +-- addTickHsExpr e) addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc) addTickTupArg (Present x e) = do { e' <- addTickLHsExpr e ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -22,7 +22,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(GetFieldOrigin) ) +import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(OccurrenceOf) ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst, FamInstEnvs ) import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) ) @@ -1327,7 +1327,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 (GetFieldOrigin {}) = True + isGetFieldOrigin (OccurrenceOf f) = f `hasKey` getFieldClassOpKey isGetFieldOrigin _ = False lookupHasFieldLabel View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a7db680e0e4c4928e08191bed80300... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3a7db680e0e4c4928e08191bed80300... You're receiving this email because of your account on gitlab.haskell.org.