Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC
Commits:
-
f024f6b6
by Simon Peyton Jones at 2026-04-17T00:12:16+01:00
2 changed files:
Changes:
| ... | ... | @@ -321,13 +321,10 @@ opt_co_refl subst co |
| 321 | 321 | go (Refl ty) = Refl (substTy subst ty)
|
| 322 | 322 | go (GRefl r ty mco) = GRefl r $!! go_ty ty $!! go_m mco
|
| 323 | 323 | go (CoVarCo cv) = substCoVar subst cv
|
| 324 | - go (HoleCo h) = HoleCo $!! go_hole h
|
|
| 325 | - go (SymCo co) = mkSymCo $!! go co
|
|
| 326 | - go (KindCo co) = mkKindCo $!! go co
|
|
| 327 | - go (SubCo co) = mkSubCo $!! (let co' = go co in
|
|
| 328 | - if isReflexiveCo co' && not (isReflCo co')
|
|
| 329 | - then pprTrace "yuike" (ppr co $$ ppr co') co'
|
|
| 330 | - else co')
|
|
| 324 | + go (HoleCo h) = HoleCo $!! go_hole h
|
|
| 325 | + go (SymCo co) = mkSymCo $!! go co
|
|
| 326 | + go (KindCo co) = mkKindCo $!! go co
|
|
| 327 | + go (SubCo co) = mkSubCo $!! go co
|
|
| 331 | 328 | go (SelCo n co) = mkSelCo n $!! go co
|
| 332 | 329 | go (LRCo n co) = mkLRCo n $!! go co
|
| 333 | 330 | go (AppCo co1 co2) = mkAppCo $!! go co1 $!! go co2
|
| ... | ... | @@ -117,9 +117,11 @@ topLevelBindsCC pred core_bind = |
| 117 | 117 | -- executions of the RHS. Note that the lambdas might be hidden under ticks
|
| 118 | 118 | -- or casts. So look through these as well.
|
| 119 | 119 | addCC :: Id -> CoreExpr -> LateCCM s CoreExpr
|
| 120 | - addCC bndr (Cast rhs co) = pure Cast <*> addCC bndr rhs <*> pure co
|
|
| 121 | - addCC bndr (Tick t rhs) = (Tick t) <$> addCC bndr rhs
|
|
| 122 | - addCC bndr (Lam b rhs) = Lam b <$> addCC bndr rhs
|
|
| 120 | + addCC bndr (Cast rhs co) = Cast <$> addCC bndr rhs <*> pure co
|
|
| 121 | + addCC bndr (Tick t rhs) = Tick t <$> addCC bndr rhs
|
|
| 122 | + addCC bndr (Lam b rhs) = Lam b <$> addCC bndr rhs
|
|
| 123 | + addCC _ e@(Coercion {}) = return e -- Do not add cost centres
|
|
| 124 | + addCC _ e@(Type {}) = return e -- around coercions or types
|
|
| 123 | 125 | addCC bndr rhs = do
|
| 124 | 126 | let name = idName bndr
|
| 125 | 127 | cc_loc = nameSrcSpan name
|