Adam Gundry pushed to branch wip/amg/castz at Glasgow Haskell Compiler / GHC Commits: df288bc2 by Adam Gundry at 2025-11-21T16:02:22+00:00 Try a better heuristic in ds_hs_wrapper - - - - - 2 changed files: - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Utils.hs Changes: ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -59,8 +59,6 @@ import GHC.Core.Coercion import GHC.Core.Rules import GHC.Core.Ppr( pprCoreBinders ) import GHC.Core.TyCo.Compare( eqType ) -import GHC.Core.TyCo.FVs -import GHC.Core.TyCo.Rep import GHC.Builtin.Names import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy ) @@ -1611,10 +1609,8 @@ ds_hs_wrapper hs_wrap go (WpTyLam tv) k = k $ Lam tv go (WpCast co) k = assert (coercionRole co == Representational) $ do { zap_casts <- hasZapCasts <$> getDynFlags - -- AMG TODO: clean this up if it helps T5030 - -- TODO: T15703 gets much worse with this, why? Need heuristic? ; if zap_casts - then k $ \e -> if isSmallCo co then mkCastDs e co else Cast e (ZCoercion (coercionRKind co) (shallowCoVarsOfCo co)) + then k $ \e -> mkCastDs_may_zap e co else k $ \e -> mkCastDs e co } go (WpEvApp tm) k = do { core_tm <- dsEvTerm tm @@ -1632,25 +1628,6 @@ ds_hs_wrapper hs_wrap arg = w1 (Var x) in k (\e -> (Lam x (w2 (app e arg)))) } -isSmallCo :: Coercion -> Bool -isSmallCo Refl{} = True -isSmallCo GRefl{} = True -isSmallCo AxiomCo{} = True -isSmallCo CoVarCo{} = True -isSmallCo (SymCo co) = isSmallCo co -isSmallCo (KindCo co) = isSmallCo co -isSmallCo (SubCo co) = isSmallCo co -isSmallCo TyConAppCo{} = False -isSmallCo AppCo{} = False -isSmallCo ForAllCo{} = False -isSmallCo FunCo{} = False -isSmallCo UnivCo{} = False -isSmallCo TransCo{} = False -isSmallCo SelCo{} = False -isSmallCo LRCo{} = False -isSmallCo InstCo{} = False -isSmallCo HoleCo{} = False - -------------------------------------- dsTcEvBinds_s :: [TcEvBinds] -> ([CoreBind] -> DsM a) -> DsM a dsTcEvBinds_s [] k = k [] ===================================== compiler/GHC/HsToCore/Utils.hs ===================================== @@ -28,7 +28,7 @@ module GHC.HsToCore.Utils ( mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult, mkCoSynCaseMatchResult, wrapBind, wrapBinds, - mkErrorAppDs, mkCastDs, mkFailExpr, + mkErrorAppDs, mkCastDs, mkCastDs_may_zap, mkFailExpr, seqVar, @@ -64,6 +64,7 @@ import GHC.Core.PatSyn import GHC.Core.Type import GHC.Core.Coercion import GHC.Core.TyCo.Rep( Scaled(..) ) +import GHC.Core.TyCo.FVs import GHC.Builtin.Types import GHC.Core.ConLike import GHC.Types.Unique.Set @@ -476,6 +477,15 @@ mkCastDs :: CoreExpr -> Coercion -> CoreExpr mkCastDs e co | isReflCo co = e | otherwise = Cast e (CCoercion co) +mkCastDs_may_zap :: CoreExpr -> Coercion -> CoreExpr +mkCastDs_may_zap e co + | isReflCo co = e + | coercionSize co > castCoercionSize zapped_co = Cast e zapped_co + | otherwise = Cast e (CCoercion co) + where + zapped_co = ZCoercion (coercionRKind co) (shallowCoVarsOfCo co) + + {- ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df288bc2b2dc5b657cb3ea7ea7cba712... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df288bc2b2dc5b657cb3ea7ea7cba712... You're receiving this email because of your account on gitlab.haskell.org.