diff options
Diffstat (limited to 'compiler/GHC/Core/Opt')
| -rw-r--r-- | compiler/GHC/Core/Opt/Arity.hs | 17 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/CSE.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 7 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/SpecConstr.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Specialise.hs | 2 |
5 files changed, 16 insertions, 14 deletions
diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index 5df571ee1c..8d51457ae0 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -1023,7 +1023,7 @@ etaInfoApp subst (Tick t e) eis etaInfoApp subst expr _ | (Var fun, _) <- collectArgs expr - , Var fun' <- lookupIdSubst (text "etaInfoApp" <+> ppr fun) subst fun + , Var fun' <- lookupIdSubst subst fun , isJoinId fun' = subst_expr subst expr @@ -1132,13 +1132,16 @@ mkEtaWW orig_n ppr_orig_expr in_scope orig_ty --------------- --- Don't use short-cutting substitution - we may be changing the types of join --- points, so applying the in-scope set is necessary --- TODO Check if we actually *are* changing any join points' types - +------------ subst_expr :: Subst -> CoreExpr -> CoreExpr -subst_expr = substExpr (text "GHC.Core.Opt.Arity:substExpr") +-- Apply a substitution to an expression. We use substExpr +-- not substExprSC (short-cutting substitution) because +-- we may be changing the types of join points, so applying +-- the in-scope set is necessary. +-- +-- ToDo: we could instead check if we actually *are* +-- changing any join points' types, and if not use substExprSC. +subst_expr = substExpr -------------- diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs index d6f37f6eb5..019b578db2 100644 --- a/compiler/GHC/Core/Opt/CSE.hs +++ b/compiler/GHC/Core/Opt/CSE.hs @@ -775,7 +775,7 @@ csEnvSubst :: CSEnv -> Subst csEnvSubst = cs_subst lookupSubst :: CSEnv -> Id -> OutExpr -lookupSubst (CS { cs_subst = sub}) x = lookupIdSubst (text "CSE.lookupSubst") sub x +lookupSubst (CS { cs_subst = sub}) x = lookupIdSubst sub x extendCSSubst :: CSEnv -> Id -> CoreExpr -> CSEnv extendCSSubst cse x rhs = cse { cs_subst = extendSubst (cs_subst cse) x rhs } diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index eca8f0a474..b002474bbd 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -1804,7 +1804,7 @@ abstractFloats dflags top_lvl main_tvs floats body = ASSERT( notNull body_floats ) ASSERT( isNilOL (sfJoinFloats floats) ) do { (subst, float_binds) <- mapAccumLM abstract empty_subst body_floats - ; return (float_binds, GHC.Core.Subst.substExpr (text "abstract_floats1") subst body) } + ; return (float_binds, GHC.Core.Subst.substExpr subst body) } where is_top_lvl = isTopLevel top_lvl main_tv_set = mkVarSet main_tvs @@ -1818,7 +1818,7 @@ abstractFloats dflags top_lvl main_tvs floats body subst' = GHC.Core.Subst.extendIdSubst subst id poly_app ; return (subst', NonRec poly_id2 poly_rhs) } where - rhs' = GHC.Core.Subst.substExpr (text "abstract_floats2") subst rhs + rhs' = GHC.Core.Subst.substExpr subst rhs -- tvs_here: see Note [Which type variables to abstract over] tvs_here = scopedSort $ @@ -1831,8 +1831,7 @@ abstractFloats dflags top_lvl main_tvs floats body ; let subst' = GHC.Core.Subst.extendSubstList subst (ids `zip` poly_apps) poly_pairs = [ mk_poly2 poly_id tvs_here rhs' | (poly_id, rhs) <- poly_ids `zip` rhss - , let rhs' = GHC.Core.Subst.substExpr (text "abstract_floats") - subst' rhs ] + , let rhs' = GHC.Core.Subst.substExpr subst' rhs ] ; return (subst', Rec poly_pairs) } where (ids,rhss) = unzip prs diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index c3135de28f..7cd753a42c 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -860,7 +860,7 @@ lookupHowBound :: ScEnv -> Id -> Maybe HowBound lookupHowBound env id = lookupVarEnv (sc_how_bound env) id scSubstId :: ScEnv -> Id -> CoreExpr -scSubstId env v = lookupIdSubst (text "scSubstId") (sc_subst env) v +scSubstId env v = lookupIdSubst (sc_subst env) v scSubstTy :: ScEnv -> Type -> Type scSubstTy env ty = substTy (sc_subst env) ty diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs index ae3d1cb287..31b7541b50 100644 --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -1008,7 +1008,7 @@ instance Outputable SpecEnv where , text "interesting =" <+> ppr interesting ]) specVar :: SpecEnv -> Id -> CoreExpr -specVar env v = Core.lookupIdSubst (text "specVar") (se_subst env) v +specVar env v = Core.lookupIdSubst (se_subst env) v specExpr :: SpecEnv -> CoreExpr -> SpecM (CoreExpr, UsageDetails) |