[Git][ghc/ghc][wip/spj-unf-size] Fix a bad, subtle bug in exprIsConApp_maybe
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Fri Nov 3 12:13:40 UTC 2023
Simon Peyton Jones pushed to branch wip/spj-unf-size at Glasgow Haskell Compiler / GHC
Commits:
3934b269 by Simon Peyton Jones at 2023-11-03T12:12:08+00:00
Fix a bad, subtle bug in exprIsConApp_maybe
In extend_in_scope We were simply overwriting useful bindings in the
in-scope set, notably ones that had unfoldings. That could lead to
repeated simplifier iterations.
- - - - -
3 changed files:
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -920,14 +920,17 @@ substId (SimplEnv { seMode = mode, seInScope = in_scope, seIdSubst = ids }) v
Nothing -> DoneId (refineFromInScope mode in_scope v)
Just (DoneId v) -> DoneId (refineFromInScope mode in_scope v)
Just res -> res -- DoneEx non-var, or ContEx
+ -- NB: in the DoneEx case we don't need to do refineFromInScope
+ -- because simplIdF just invokes simplExprF again, which will
+ -- take another look.
- -- Get the most up-to-date thing from the in-scope set
- -- Even though it isn't in the substitution, it may be in
- -- the in-scope set with better IdInfo.
- --
- -- See also Note [In-scope set as a substitution] in GHC.Core.Opt.Simplify.
refineFromInScope :: HasDebugCallStack => SimplMode -> InScopeSet -> Var -> Var
+-- refineFromInScope: get the most up-to-date thing from the in-scope set
+-- Even though it isn't in the substitution, it may be in
+-- the in-scope set with better IdInfo.
+--
+-- See also Note [In-scope set as a substitution] in GHC.Core.Opt.Simplify.
refineFromInScope mode in_scope v
| isLocalId v = case lookupInScope in_scope v of
Just v' -> v'
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -419,7 +419,7 @@ simplAuxBind env bndr new_rhs
-- The cases would be inlined unconditionally by completeBind:
-- but it seems not uncommon, and avoids faff to do it here
-- This is safe because it's only used for auxiliary bindings, which
- -- have no NOLINE pragmas, nor RULEs
+ -- have no NOINLINE pragmas, nor RULEs
| exprIsTrivial new_rhs -- Short-cut for let x = y in ...
= return ( emptyFloats env
, case new_rhs of
@@ -3296,6 +3296,22 @@ simplAlt env scrut' _ case_bndr' cont' (Alt (DataAlt con) vs rhs)
; rhs' <- simplExprC env'' rhs cont'
; return (Alt (DataAlt con) vs' rhs') }
+
+{- -------- Debugging only -------------
+
+ppr_in_scope :: SimplEnv -> SDoc
+-- Show only in-scope thing with unfoldings
+ppr_in_scope env
+ = text "InScope(unf)" <+> braces (nonDetStrictFoldVarSet do_one empty (getInScopeVars (seInScope env)))
+ where
+ do_one v d | isId v
+ , Just e <- maybeUnfoldingTemplate (idUnfolding v)
+ = (ppr v <+> equals <+> my_ppr e) $$ d
+ | otherwise = d
+ my_ppr (Lam {}) = text "<lambda>"
+ my_ppr e = ppr e
+---------------------------------------- -}
+
{- Note [Adding evaluatedness info to pattern-bound variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
addEvals records the evaluated-ness of the bound variables of
@@ -3522,7 +3538,7 @@ knownCon env scrut dc_floats dc dc_ty_args dc_args bndr bs rhs cont
-- Nevertheless we must keep it if the case-binder is alive,
-- because it may be used in the con_app. See Note [knownCon occ info]
; (floats1, env2) <- simplAuxBind env' b' arg -- arg satisfies let-can-float invariant
- ; (floats2, env3) <- bind_args env2 bs' args
+ ; (floats2, env3) <- bind_args env2 bs' args
; return (floats1 `addFloats` floats2, env3) }
bind_args _ _ _ =
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -1220,9 +1220,17 @@ data ConCont = CC [CoreExpr] Coercion
--
-- We also return the incoming InScopeSet, augmented with
-- the binders from any [FloatBind] that we return
-exprIsConApp_maybe :: HasDebugCallStack
- => InScopeEnv -> CoreExpr
- -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
+exprIsConApp_maybe
+ :: HasDebugCallStack
+ => InScopeEnv -- Includes an InScopeSet
+ -> CoreExpr
+ -> Maybe ( InScopeSet -- Extends input InScopeSet with the
+ -- binders of the [FloatingBind]
+ , [FloatBind]
+ , DataCon
+ , [Type] -- Existential type args
+ , [CoreExpr] -- Arguments satisfy let-can-float invariant
+ )
exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
= go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr)))
where
@@ -1263,10 +1271,9 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
-- simplifier produces rhs[exp/a], changing semantics if exp is not ok-for-spec
-- Good: returning (Mk#, [x]) with a float of case exp of x { DEFAULT -> [] }
-- simplifier produces case exp of a { DEFAULT -> exp[x/a] }
- = let arg' = subst_expr subst arg
- bndr = uniqAway (subst_in_scope subst) (mkWildValBinder ManyTy arg_type)
- float = FloatCase arg' bndr DEFAULT []
- subst' = subst_extend_in_scope subst bndr
+ = let arg' = subst_expr subst arg
+ (bndr,subst') = fresh_id subst arg_type
+ float = FloatCase arg' bndr DEFAULT []
in go subst' (float:floats) fun (CC (Var bndr : args) co)
| otherwise
= go subst floats fun (CC (subst_expr subst arg : args) co)
@@ -1320,8 +1327,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
-- Look through dictionary functions; see Note [Unfolding DFuns]
| DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = dfun_args } <- unfolding
, bndrs `equalLength` args -- See Note [DFun arity check]
- , let in_scope' = extend_in_scope (exprsFreeVars dfun_args)
- subst = mkOpenSubst in_scope' (bndrs `zip` args)
+ , let -- in_scope' = extend_in_scope (exprsFreeVars dfun_args)
+ subst = mkOpenSubst in_scope (bndrs `zip` args)
-- We extend the in-scope set here to silence warnings from
-- substExpr when it finds not-in-scope Ids in dfun_args.
-- simplOptExpr initialises the in-scope set with exprFreeVars,
@@ -1337,8 +1344,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
| idArity fun == 0
, Just rhs <- expandUnfolding_maybe unfolding
-- If `fun` is in the in-scope set then the free var of its RHS should be too
- , let in_scope' = extend_in_scope (exprFreeVars rhs)
- = go (Left in_scope') floats rhs cont
+-- , let in_scope' = extend_in_scope (exprFreeVars rhs)
+ = go (Left in_scope) floats rhs cont
-- See Note [exprIsConApp_maybe on literal strings]
| (fun `hasKey` unpackCStringIdKey) ||
@@ -1349,11 +1356,13 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
dealWithStringLiteral fun str co
where
unfolding = id_unf fun
+{-
extend_in_scope unf_fvs
| isLocalId fun = in_scope `extendInScopeSetSet` unf_fvs
| otherwise = in_scope
-- A GlobalId has no (LocalId) free variables; and the
-- in-scope set tracks only LocalIds
+-}
go _ _ _ _ = Nothing
@@ -1369,11 +1378,15 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
-- Operations on the (Either InScopeSet GHC.Core.Subst)
-- The Left case is wildly dominant
- subst_in_scope (Left in_scope) = in_scope
- subst_in_scope (Right s) = getSubstInScope s
+ fresh_id :: Either InScopeSet Subst -> Type -> (Id, Either InScopeSet Subst)
+ fresh_id (Left in_scope) ty
+ | let new_id = mk_new_id in_scope ty
+ = (new_id, Left (in_scope `extendInScopeSet` new_id))
+ fresh_id (Right subst) ty
+ | let new_id = mk_new_id (getSubstInScope subst) ty
+ = (new_id, Right (subst `extendSubstInScope` new_id))
- subst_extend_in_scope (Left in_scope) v = Left (in_scope `extendInScopeSet` v)
- subst_extend_in_scope (Right s) v = Right (s `extendSubstInScope` v)
+ mk_new_id in_scope ty = uniqAway in_scope (mkWildValBinder ManyTy ty)
subst_co (Left {}) co = co
subst_co (Right s) co = GHC.Core.Subst.substCo s co
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3934b2690da34782c435b083b81ac61d4d5cc3eb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3934b2690da34782c435b083b81ac61d4d5cc3eb
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231103/0a084011/attachment-0001.html>
More information about the ghc-commits
mailing list