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
2 changed files:
Changes:
| ... | ... | @@ -59,8 +59,6 @@ import GHC.Core.Coercion |
| 59 | 59 | import GHC.Core.Rules
|
| 60 | 60 | import GHC.Core.Ppr( pprCoreBinders )
|
| 61 | 61 | import GHC.Core.TyCo.Compare( eqType )
|
| 62 | -import GHC.Core.TyCo.FVs
|
|
| 63 | -import GHC.Core.TyCo.Rep
|
|
| 64 | 62 | |
| 65 | 63 | import GHC.Builtin.Names
|
| 66 | 64 | import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy )
|
| ... | ... | @@ -1611,10 +1609,8 @@ ds_hs_wrapper hs_wrap |
| 1611 | 1609 | go (WpTyLam tv) k = k $ Lam tv
|
| 1612 | 1610 | go (WpCast co) k = assert (coercionRole co == Representational) $
|
| 1613 | 1611 | do { zap_casts <- hasZapCasts <$> getDynFlags
|
| 1614 | - -- AMG TODO: clean this up if it helps T5030
|
|
| 1615 | - -- TODO: T15703 gets much worse with this, why? Need heuristic?
|
|
| 1616 | 1612 | ; if zap_casts
|
| 1617 | - then k $ \e -> if isSmallCo co then mkCastDs e co else Cast e (ZCoercion (coercionRKind co) (shallowCoVarsOfCo co))
|
|
| 1613 | + then k $ \e -> mkCastDs_may_zap e co
|
|
| 1618 | 1614 | else k $ \e -> mkCastDs e co
|
| 1619 | 1615 | }
|
| 1620 | 1616 | go (WpEvApp tm) k = do { core_tm <- dsEvTerm tm
|
| ... | ... | @@ -1632,25 +1628,6 @@ ds_hs_wrapper hs_wrap |
| 1632 | 1628 | arg = w1 (Var x)
|
| 1633 | 1629 | in k (\e -> (Lam x (w2 (app e arg)))) }
|
| 1634 | 1630 | |
| 1635 | -isSmallCo :: Coercion -> Bool
|
|
| 1636 | -isSmallCo Refl{} = True
|
|
| 1637 | -isSmallCo GRefl{} = True
|
|
| 1638 | -isSmallCo AxiomCo{} = True
|
|
| 1639 | -isSmallCo CoVarCo{} = True
|
|
| 1640 | -isSmallCo (SymCo co) = isSmallCo co
|
|
| 1641 | -isSmallCo (KindCo co) = isSmallCo co
|
|
| 1642 | -isSmallCo (SubCo co) = isSmallCo co
|
|
| 1643 | -isSmallCo TyConAppCo{} = False
|
|
| 1644 | -isSmallCo AppCo{} = False
|
|
| 1645 | -isSmallCo ForAllCo{} = False
|
|
| 1646 | -isSmallCo FunCo{} = False
|
|
| 1647 | -isSmallCo UnivCo{} = False
|
|
| 1648 | -isSmallCo TransCo{} = False
|
|
| 1649 | -isSmallCo SelCo{} = False
|
|
| 1650 | -isSmallCo LRCo{} = False
|
|
| 1651 | -isSmallCo InstCo{} = False
|
|
| 1652 | -isSmallCo HoleCo{} = False
|
|
| 1653 | - |
|
| 1654 | 1631 | --------------------------------------
|
| 1655 | 1632 | dsTcEvBinds_s :: [TcEvBinds] -> ([CoreBind] -> DsM a) -> DsM a
|
| 1656 | 1633 | dsTcEvBinds_s [] k = k []
|
| ... | ... | @@ -28,7 +28,7 @@ module GHC.HsToCore.Utils ( |
| 28 | 28 | mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult, mkCoSynCaseMatchResult,
|
| 29 | 29 | wrapBind, wrapBinds,
|
| 30 | 30 | |
| 31 | - mkErrorAppDs, mkCastDs, mkFailExpr,
|
|
| 31 | + mkErrorAppDs, mkCastDs, mkCastDs_may_zap, mkFailExpr,
|
|
| 32 | 32 | |
| 33 | 33 | seqVar,
|
| 34 | 34 | |
| ... | ... | @@ -64,6 +64,7 @@ import GHC.Core.PatSyn |
| 64 | 64 | import GHC.Core.Type
|
| 65 | 65 | import GHC.Core.Coercion
|
| 66 | 66 | import GHC.Core.TyCo.Rep( Scaled(..) )
|
| 67 | +import GHC.Core.TyCo.FVs
|
|
| 67 | 68 | import GHC.Builtin.Types
|
| 68 | 69 | import GHC.Core.ConLike
|
| 69 | 70 | import GHC.Types.Unique.Set
|
| ... | ... | @@ -476,6 +477,15 @@ mkCastDs :: CoreExpr -> Coercion -> CoreExpr |
| 476 | 477 | mkCastDs e co | isReflCo co = e
|
| 477 | 478 | | otherwise = Cast e (CCoercion co)
|
| 478 | 479 | |
| 480 | +mkCastDs_may_zap :: CoreExpr -> Coercion -> CoreExpr
|
|
| 481 | +mkCastDs_may_zap e co
|
|
| 482 | + | isReflCo co = e
|
|
| 483 | + | coercionSize co > castCoercionSize zapped_co = Cast e zapped_co
|
|
| 484 | + | otherwise = Cast e (CCoercion co)
|
|
| 485 | + where
|
|
| 486 | + zapped_co = ZCoercion (coercionRKind co) (shallowCoVarsOfCo co)
|
|
| 487 | + |
|
| 488 | + |
|
| 479 | 489 | {-
|
| 480 | 490 | ************************************************************************
|
| 481 | 491 | * *
|