Simon Peyton Jones pushed to branch wip/spj-try-opt-coercion at Glasgow Haskell Compiler / GHC
Commits:
-
862f385e
by Simon Peyton Jones at 2026-01-08T23:42:20+00:00
1 changed file:
Changes:
| ... | ... | @@ -239,6 +239,8 @@ optCoAlt is (Alt k bs e) |
| 239 | 239 | |
| 240 | 240 | optCoRefl :: Coercion -> Coercion
|
| 241 | 241 | optCoRefl in_co
|
| 242 | +#ifdef DEBUG
|
|
| 243 | + -- Debug check that optCoRefl doesn't change the type
|
|
| 242 | 244 | = let out_co = go in_co
|
| 243 | 245 | (Pair in_l in_r) = coercionKind in_co
|
| 244 | 246 | (Pair out_l out_r) = coercionKind out_co
|
| ... | ... | @@ -251,6 +253,9 @@ optCoRefl in_co |
| 251 | 253 | , text "in_co:" <+> ppr in_co
|
| 252 | 254 | , text "out_co:" <+> ppr out_co ]) $
|
| 253 | 255 | out_co
|
| 256 | +#else
|
|
| 257 | + = go in_co
|
|
| 258 | +#endif
|
|
| 254 | 259 | where
|
| 255 | 260 | go_m MRefl = MRefl
|
| 256 | 261 | go_m (MCo co) = MCo (go co)
|
| ... | ... | @@ -274,6 +279,7 @@ optCoRefl in_co |
| 274 | 279 | go (UnivCo p r lt rt cos) = mkUnivCo p (go_s cos) r lt rt
|
| 275 | 280 | go (AxiomCo ax cos) = mkAxiomCo ax (go_s cos)
|
| 276 | 281 | |
| 282 | + -- This is the main payload
|
|
| 277 | 283 | go (TransCo co1 co2) = gobble gs0 co1 [co2]
|
| 278 | 284 | where
|
| 279 | 285 | lk = coercionLKind co1
|
| ... | ... | @@ -288,8 +294,7 @@ optCoRefl in_co |
| 288 | 294 | = gobble gs co2 (co3 : cos)
|
| 289 | 295 | gobble (GS co1 tm) co2 cos
|
| 290 | 296 | = case lookupTM rk tm of
|
| 291 | - Just gs -> pprTrace "optCoRefl:hit eliminated" (ppr (TransCo co1 co2)) $
|
|
| 292 | - gobble0 gs cos
|
|
| 297 | + Just gs -> gobble0 gs cos
|
|
| 293 | 298 | Nothing -> gobble0 gs' cos
|
| 294 | 299 | where
|
| 295 | 300 | rk = coercionRKind co2
|