diff options
Diffstat (limited to 'compiler/GHC')
| -rw-r--r-- | compiler/GHC/Core/Opt/Arity.hs | 3 | ||||
| -rw-r--r-- | compiler/GHC/Core/SimpleOpt.hs | 30 | ||||
| -rw-r--r-- | compiler/GHC/CoreToStg.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Driver/Config.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Types/Id.hs | 3 |
5 files changed, 18 insertions, 21 deletions
diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index 67b5353d71..ff9a6eff45 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -1895,8 +1895,7 @@ This turned up in #7542. tryEtaReduce :: [Var] -> CoreExpr -> Maybe CoreExpr tryEtaReduce bndrs body - = let res = go (reverse bndrs) body refl_co - in pprTrace "tryEtaReduce" (ppr bndrs $$ ppr body $$ ppr res) res + = go (reverse bndrs) body refl_co where refl_co = mkRepReflCo (exprType body) incoming_arity = count isId bndrs diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 16906df1c1..bc7531c130 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -92,14 +92,15 @@ little dance in action; the full Simplifier is a lot more complicated. data SimpleOpts = SimpleOpts { so_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , so_eta_red :: !Bool -- ^ Eta reduction on? } -- | Default options for the Simple optimiser. defaultSimpleOpts :: SimpleOpts defaultSimpleOpts = SimpleOpts { so_uf_opts = defaultUnfoldingOpts - , so_co_opts = OptCoercionOpts - { optCoercionEnabled = False } + , so_co_opts = OptCoercionOpts { optCoercionEnabled = False } + , so_eta_red = False } simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr @@ -182,11 +183,8 @@ simpleOptPgm opts this_mod binds rules = type SimpleClo = (SimpleOptEnv, InExpr) data SimpleOptEnv - = SOE { soe_co_opt_opts :: !OptCoercionOpts - -- ^ Options for the coercion optimiser - - , soe_uf_opts :: !UnfoldingOpts - -- ^ Unfolding options + = SOE { soe_opts :: {-# UNPACK #-} ! SimpleOpts + -- ^ Simplifier options , soe_inl :: IdEnv SimpleClo -- ^ Deals with preInlineUnconditionally; things @@ -204,12 +202,9 @@ instance Outputable SimpleOptEnv where <+> text "}" emptyEnv :: SimpleOpts -> SimpleOptEnv -emptyEnv opts = SOE - { soe_inl = emptyVarEnv - , soe_subst = emptySubst - , soe_co_opt_opts = so_co_opts opts - , soe_uf_opts = so_uf_opts opts - } +emptyEnv opts = SOE { soe_inl = emptyVarEnv + , soe_subst = emptySubst + , soe_opts = opts } soeZapSubst :: SimpleOptEnv -> SimpleOptEnv soeZapSubst env@(SOE { soe_subst = subst }) @@ -282,7 +277,7 @@ simple_opt_expr env expr (env', b') = subst_opt_bndr env b ---------------------- - go_co co = optCoercion (soe_co_opt_opts env) (getTCvSubst subst) co + go_co co = optCoercion (so_co_opts (soe_opts env)) (getTCvSubst subst) co ---------------------- go_alt env (Alt con bndrs rhs) @@ -297,7 +292,8 @@ simple_opt_expr env expr where (env', b') = subst_opt_bndr env b go_lam env bs' e - | Just etad_e <- tryEtaReduce bs e' = etad_e + | so_eta_red (soe_opts env) + , Just etad_e <- tryEtaReduce bs e' = etad_e | otherwise = mkLams bs e' where bs = reverse bs' @@ -422,7 +418,7 @@ simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst }) (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing) | Coercion co <- in_rhs - , let out_co = optCoercion (soe_co_opt_opts env) (getTCvSubst (soe_subst rhs_env)) co + , let out_co = optCoercion (so_co_opts (soe_opts env)) (getTCvSubst (soe_subst rhs_env)) co = assert (isCoVar in_bndr) (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing) @@ -654,7 +650,7 @@ add_info env old_bndr top_level new_rhs new_bndr | otherwise = lazySetIdInfo new_bndr new_info where subst = soe_subst env - uf_opts = soe_uf_opts env + uf_opts = so_uf_opts (soe_opts env) old_info = idInfo old_bndr -- Add back in the rules and unfolding which were diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs index 57b59d0a66..b8f18de5c0 100644 --- a/compiler/GHC/CoreToStg.hs +++ b/compiler/GHC/CoreToStg.hs @@ -549,7 +549,7 @@ coreToStgApp f args ticks = do -- Some primitive operator that might be implemented as a library call. -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps -- we require that primop applications be saturated. - PrimOpId op -> assertPpr saturated (ppr f <+> ppr args) $ + PrimOpId op -> -- assertPpr saturated (ppr f <+> ppr args) $ StgOpApp (StgPrimOp op) args' res_ty -- A call to some primitive Cmm function. diff --git a/compiler/GHC/Driver/Config.hs b/compiler/GHC/Driver/Config.hs index 2d4135a847..bd9790312b 100644 --- a/compiler/GHC/Driver/Config.hs +++ b/compiler/GHC/Driver/Config.hs @@ -29,6 +29,7 @@ initSimpleOpts :: DynFlags -> SimpleOpts initSimpleOpts dflags = SimpleOpts { so_uf_opts = unfoldingOpts dflags , so_co_opts = initOptCoercionOpts dflags + , so_eta_red = gopt Opt_DoEtaReduction dflags } -- | Extract BCO options from DynFlags diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs index 1c990cba9f..67fe339265 100644 --- a/compiler/GHC/Types/Id.hs +++ b/compiler/GHC/Types/Id.hs @@ -564,7 +564,8 @@ hasNoBinding :: Id -> Bool -- exception to this is unboxed tuples and sums datacons, which definitely have -- no binding hasNoBinding id = case Var.idDetails id of - PrimOpId _ -> True -- See Note [Eta expanding primops] in GHC.Builtin.PrimOps +-- PrimOpId _ -> True -- See Note [Eta expanding primops] in GHC.Builtin.PrimOps +-- Omit this: #19982 FCallId _ -> True DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc _ -> isCompulsoryUnfolding (idUnfolding id) |