diff options
Diffstat (limited to 'compiler/coreSyn')
| -rw-r--r-- | compiler/coreSyn/CoreArity.hs | 2 | ||||
| -rw-r--r-- | compiler/coreSyn/CorePrep.hs | 1 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreSyn.hs | 18 | ||||
| -rw-r--r-- | compiler/coreSyn/CoreTidy.hs | 17 |
4 files changed, 27 insertions, 11 deletions
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs index d940d9d69c..04c8557882 100644 --- a/compiler/coreSyn/CoreArity.hs +++ b/compiler/coreSyn/CoreArity.hs @@ -881,7 +881,7 @@ inside the RHS of the join as well as into the body. AND if j has an unfolding we have to push it into there too. AND j might be recursive... -So for now I'm abandonig the no-crap rule in this case. I think +So for now I'm abandoning the no-crap rule in this case. I think that for the use in CorePrep it really doesn't matter; and if it does, then CoreToStg.myCollectArgs will fall over. diff --git a/compiler/coreSyn/CorePrep.hs b/compiler/coreSyn/CorePrep.hs index 9d4044cf57..f2e7aee46b 100644 --- a/compiler/coreSyn/CorePrep.hs +++ b/compiler/coreSyn/CorePrep.hs @@ -560,6 +560,7 @@ it seems good for CorePrep to be robust. cpeJoinPair :: CorePrepEnv -> JoinId -> CoreExpr -> UniqSM (JoinId, CpeRhs) -- Used for all join bindings +-- No eta-expansion: see Note [Do not eta-expand join points] in SimplUtils cpeJoinPair env bndr rhs = ASSERT(isJoinId bndr) do { let Just join_arity = isJoinId_maybe bndr diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs index d94761b237..e3ad4715f1 100644 --- a/compiler/coreSyn/CoreSyn.hs +++ b/compiler/coreSyn/CoreSyn.hs @@ -681,9 +681,21 @@ Join points must follow these invariants: 2. For join arity n, the right-hand side must begin with at least n lambdas. No ticks, no casts, just lambdas! C.f. CoreUtils.joinRhsArity. - 2a. Moreover, this same constraint applies to any unfolding of the binder. - Reason: if we want to push a continuation into the RHS we must push it - into the unfolding as well. + 2a. Moreover, this same constraint applies to any unfolding of + the binder. Reason: if we want to push a continuation into + the RHS we must push it into the unfolding as well. + + 2b. The Arity (in the IdInfo) of a join point is the number of value + binders in the top n lambdas, where n is the join arity. + + So arity <= join arity; the former counts only value binders + while the latter counts all binders. + e.g. Suppose $j has join arity 1 + let j = \x y. e in case x of { A -> j 1; B -> j 2 } + Then its ordinary arity is also 1, not 2. + + The arity of a join point isn't very important; but short of setting + it to zero, it is helpful to have an invariant. E.g. #17294. 3. If the binding is recursive, then all other bindings in the recursive group must also be join points. diff --git a/compiler/coreSyn/CoreTidy.hs b/compiler/coreSyn/CoreTidy.hs index dfb031df7f..135d8e9b5b 100644 --- a/compiler/coreSyn/CoreTidy.hs +++ b/compiler/coreSyn/CoreTidy.hs @@ -18,7 +18,6 @@ import GhcPrelude import CoreSyn import CoreSeq ( seqUnfolding ) -import CoreArity import Id import IdInfo import Demand ( zapUsageEnvSig ) @@ -45,14 +44,15 @@ tidyBind :: TidyEnv -> (TidyEnv, CoreBind) tidyBind env (NonRec bndr rhs) - = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') -> + = tidyLetBndr env env bndr =: \ (env', bndr') -> (env', NonRec bndr' (tidyExpr env' rhs)) tidyBind env (Rec prs) = let - (env', bndrs') = mapAccumL (tidyLetBndr env') env prs + (bndrs, rhss) = unzip prs + (env', bndrs') = mapAccumL (tidyLetBndr env') env bndrs in - map (tidyExpr env') (map snd prs) =: \ rhss' -> + map (tidyExpr env') rhss =: \ rhss' -> (env', Rec (zip bndrs' rhss')) @@ -166,10 +166,10 @@ tidyIdBndr env@(tidy_env, var_env) id tidyLetBndr :: TidyEnv -- Knot-tied version for unfoldings -> TidyEnv -- The one to extend - -> (Id, CoreExpr) -> (TidyEnv, Var) + -> Id -> (TidyEnv, Id) -- Used for local (non-top-level) let(rec)s -- Just like tidyIdBndr above, but with more IdInfo -tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs) +tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id = case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> let ty' = tidyType env (idType id) @@ -193,13 +193,15 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs) -- (See Note [Zapping DmdEnv after Demand Analyzer] in WorkWrap) -- -- Similarly arity info for eta expansion in CorePrep + -- Don't attempt to recompute arity here; this is just tidying! + -- Trying to do so led to #17294 -- -- Set inline-prag info so that we preseve it across -- separate compilation boundaries old_info = idInfo id new_info = vanillaIdInfo `setOccInfo` occInfo old_info - `setArityInfo` exprArity rhs + `setArityInfo` arityInfo old_info `setStrictnessInfo` zapUsageEnvSig (strictnessInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info @@ -209,6 +211,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) (id,rhs) new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf | otherwise = zapUnfolding old_unf -- See Note [Preserve evaluatedness] + in ((tidy_env', var_env'), id') } |