Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC
Commits:
-
3925e6fb
by Simon Peyton Jones at 2026-05-02T13:15:55+01:00
4 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Data/List/SetOps.hs
- compiler/GHC/Types/Id/Make.hs
Changes:
| ... | ... | @@ -2052,7 +2052,7 @@ Note [Avoiding simplifying repeatedly] |
| 2052 | 2052 | One way in which we can get exponential behaviour is if we simplify a
|
| 2053 | 2053 | big expression, and then re-simplify it -- and then this happens in a
|
| 2054 | 2054 | deeply-nested way. So we must be jolly careful about re-simplifying
|
| 2055 | -an expression (#26989).
|
|
| 2055 | +an expression (#26989).
|
|
| 2056 | 2056 | |
| 2057 | 2057 | Example:
|
| 2058 | 2058 | f BIG, where f has a RULE
|
| ... | ... | @@ -2359,7 +2359,8 @@ simplInId env var cont |
| 2359 | 2359 | , isLazyDataConRep dc -- See Note [Fast path for lazy data constructors]
|
| 2360 | 2360 | = rebuild env (Var var) cont
|
| 2361 | 2361 | | otherwise
|
| 2362 | - = case substId env var of
|
|
| 2362 | + = assertPpr (not (isCoVar var)) (ppr var) $
|
|
| 2363 | + case substId env var of
|
|
| 2363 | 2364 | ContEx se e mco
|
| 2364 | 2365 | -> do { cont' <- pushCastMCo env mco cont
|
| 2365 | 2366 | ; simplExprF (se `setInScopeFromE` env) e cont' }
|
| ... | ... | @@ -326,8 +326,7 @@ simple_opt_expr env expr = go expr |
| 326 | 326 | (env', b') = subst_opt_bndr env b
|
| 327 | 327 | |
| 328 | 328 | ----------------------
|
| 329 | - go_co co = pprTrace "add_cast" (ppr (optCoercionEnabled $ so_co_opts (soe_opts env)) $$ ppr co) $
|
|
| 330 | - optCoercion (so_co_opts (soe_opts env)) subst co
|
|
| 329 | + go_co co = optCoercion (so_co_opts (soe_opts env)) subst co
|
|
| 331 | 330 | |
| 332 | 331 | ----------------------
|
| 333 | 332 | go_alt env (Alt con bndrs rhs)
|
| ... | ... | @@ -40,7 +40,7 @@ import Data.List.NonEmpty (NonEmpty(..)) |
| 40 | 40 | import Data.Ord (comparing)
|
| 41 | 41 | import qualified Data.Set as S
|
| 42 | 42 | |
| 43 | -getNth :: Outputable a => [a] -> Int -> a
|
|
| 43 | +getNth :: (HasDebugCallStack, Outputable a) => [a] -> Int -> a
|
|
| 44 | 44 | getNth xs n = assertPpr (xs `lengthExceeds` n) (ppr n $$ ppr xs) $
|
| 45 | 45 | xs !! n
|
| 46 | 46 |
| ... | ... | @@ -564,7 +564,7 @@ dictSelRule :: Name -> Arity -> Int -> CoreRule |
| 564 | 564 | -- sel_i t1..tk (D t1..tk op1 ... opm) = opi
|
| 565 | 565 | --
|
| 566 | 566 | -- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance
|
| 567 | -dictSelRule name val_index n_ty_args
|
|
| 567 | +dictSelRule name n_ty_args val_index
|
|
| 568 | 568 | = rule
|
| 569 | 569 | where
|
| 570 | 570 | rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
|
| ... | ... | @@ -579,14 +579,25 @@ dictSelRule name val_index n_ty_args |
| 579 | 579 | | (dict_arg : _) <- drop n_ty_args args
|
| 580 | 580 | , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe in_scope_env dict_arg
|
| 581 | 581 | , let meth_e = getNth con_args val_index
|
| 582 | - meth_id = mkTemplateLocal 1 (exprType meth_e)
|
|
| 583 | 582 | = Just (RM { rm_floats = floats
|
| 584 | - , rm_rhs = Lam meth_id (Var meth_id)
|
|
| 585 | - , rm_args = [meth_e]
|
|
| 586 | - , rm_rule = rule })
|
|
| 583 | + , rm_rhs = mkIdLam (exprType meth_e)
|
|
| 584 | + , rm_args = [meth_e]
|
|
| 585 | + , rm_rule = rule })
|
|
| 587 | 586 | | otherwise
|
| 588 | 587 | = Nothing
|
| 589 | 588 | |
| 589 | + |
|
| 590 | +mkIdLam :: Type -> CoreExpr
|
|
| 591 | +-- Make an identity lambda (\(x::ty).x), already occ-analysed
|
|
| 592 | +mkIdLam ty
|
|
| 593 | + = Lam x (varToCoreExpr x)
|
|
| 594 | + where
|
|
| 595 | + x = mkTemplateLocal 1 ty
|
|
| 596 | + `setIdOccInfo` OneOcc { occ_in_lam = NotInsideLam
|
|
| 597 | + , occ_n_br = 1
|
|
| 598 | + , occ_int_cxt = NotInteresting
|
|
| 599 | + , occ_tail = NoTailCallInfo }
|
|
| 600 | + |
|
| 590 | 601 | {-
|
| 591 | 602 | ************************************************************************
|
| 592 | 603 | * *
|