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 Wibbles - - - - - 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: ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -2052,7 +2052,7 @@ Note [Avoiding simplifying repeatedly] One way in which we can get exponential behaviour is if we simplify a big expression, and then re-simplify it -- and then this happens in a deeply-nested way. So we must be jolly careful about re-simplifying -an expression (#26989). +an expression (#26989). Example: f BIG, where f has a RULE @@ -2359,7 +2359,8 @@ simplInId env var cont , isLazyDataConRep dc -- See Note [Fast path for lazy data constructors] = rebuild env (Var var) cont | otherwise - = case substId env var of + = assertPpr (not (isCoVar var)) (ppr var) $ + case substId env var of ContEx se e mco -> do { cont' <- pushCastMCo env mco cont ; simplExprF (se `setInScopeFromE` env) e cont' } ===================================== compiler/GHC/Core/SimpleOpt.hs ===================================== @@ -326,8 +326,7 @@ simple_opt_expr env expr = go expr (env', b') = subst_opt_bndr env b ---------------------- - go_co co = pprTrace "add_cast" (ppr (optCoercionEnabled $ so_co_opts (soe_opts env)) $$ ppr co) $ - optCoercion (so_co_opts (soe_opts env)) subst co + go_co co = optCoercion (so_co_opts (soe_opts env)) subst co ---------------------- go_alt env (Alt con bndrs rhs) ===================================== compiler/GHC/Data/List/SetOps.hs ===================================== @@ -40,7 +40,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Ord (comparing) import qualified Data.Set as S -getNth :: Outputable a => [a] -> Int -> a +getNth :: (HasDebugCallStack, Outputable a) => [a] -> Int -> a getNth xs n = assertPpr (xs `lengthExceeds` n) (ppr n $$ ppr xs) $ xs !! n ===================================== compiler/GHC/Types/Id/Make.hs ===================================== @@ -564,7 +564,7 @@ dictSelRule :: Name -> Arity -> Int -> CoreRule -- sel_i t1..tk (D t1..tk op1 ... opm) = opi -- -- See Note [ClassOp/DFun selection] in GHC.Tc.TyCl.Instance -dictSelRule name val_index n_ty_args +dictSelRule name n_ty_args val_index = rule where rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS` @@ -579,14 +579,25 @@ dictSelRule name val_index n_ty_args | (dict_arg : _) <- drop n_ty_args args , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe in_scope_env dict_arg , let meth_e = getNth con_args val_index - meth_id = mkTemplateLocal 1 (exprType meth_e) = Just (RM { rm_floats = floats - , rm_rhs = Lam meth_id (Var meth_id) - , rm_args = [meth_e] - , rm_rule = rule }) + , rm_rhs = mkIdLam (exprType meth_e) + , rm_args = [meth_e] + , rm_rule = rule }) | otherwise = Nothing + +mkIdLam :: Type -> CoreExpr +-- Make an identity lambda (\(x::ty).x), already occ-analysed +mkIdLam ty + = Lam x (varToCoreExpr x) + where + x = mkTemplateLocal 1 ty + `setIdOccInfo` OneOcc { occ_in_lam = NotInsideLam + , occ_n_br = 1 + , occ_int_cxt = NotInteresting + , occ_tail = NoTailCallInfo } + {- ************************************************************************ * * View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3925e6fb140ca7c3a22c8746b025ea3a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3925e6fb140ca7c3a22c8746b025ea3a... You're receiving this email because of your account on gitlab.haskell.org.