Commit 528df8ec authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Modules: Core operations (#13009)

parent 53ff2cd0
Pipeline #16855 passed with stages
in 442 minutes and 22 seconds
...@@ -354,7 +354,7 @@ an unlifted literal, like all the others. ...@@ -354,7 +354,7 @@ an unlifted literal, like all the others.
Also, we do not permit case analysis with literal patterns on floating-point Also, we do not permit case analysis with literal patterns on floating-point
types. See #9238 and Note [Rules for floating-point comparisons] in types. See #9238 and Note [Rules for floating-point comparisons] in
PrelRules for the rationale for this restriction. GHC.Core.Op.ConstantFold for the rationale for this restriction.
-------------------------- GHC.Core INVARIANTS --------------------------- -------------------------- GHC.Core INVARIANTS ---------------------------
...@@ -508,7 +508,7 @@ checked by Core Lint. ...@@ -508,7 +508,7 @@ checked by Core Lint.
5. Floating-point values must not be scrutinised against literals. 5. Floating-point values must not be scrutinised against literals.
See #9238 and Note [Rules for floating-point comparisons] See #9238 and Note [Rules for floating-point comparisons]
in PrelRules for rationale. Checked in lintCaseExpr; in GHC.Core.Op.ConstantFold for rationale. Checked in lintCaseExpr;
see the call to isFloatingTy. see the call to isFloatingTy.
6. The 'ty' field of (Case scrut bndr ty alts) is the type of the 6. The 'ty' field of (Case scrut bndr ty alts) is the type of the
...@@ -784,7 +784,7 @@ is crucial for understanding how case-of-case interacts with join points: ...@@ -784,7 +784,7 @@ is crucial for understanding how case-of-case interacts with join points:
_ -> False _ -> False
The simplifier will pull the case into the join point (see Note [Join points The simplifier will pull the case into the join point (see Note [Join points
and case-of-case] in Simplify): and case-of-case] in GHC.Core.Op.Simplify):
join join
j :: Int -> Bool -> Bool -- changed! j :: Int -> Bool -> Bool -- changed!
...@@ -1810,9 +1810,9 @@ the occurrence info is wrong ...@@ -1810,9 +1810,9 @@ the occurrence info is wrong
-} -}
-- The Ord is needed for the FiniteMap used in the lookForConstructor -- The Ord is needed for the FiniteMap used in the lookForConstructor
-- in SimplEnv. If you declared that lookForConstructor *ignores* -- in GHC.Core.Op.Simplify.Env. If you declared that lookForConstructor
-- constructor-applications with LitArg args, then you could get -- *ignores* constructor-applications with LitArg args, then you could get rid
-- rid of this Ord. -- of this Ord.
instance Outputable AltCon where instance Outputable AltCon where
ppr (DataAlt dc) = ppr dc ppr (DataAlt dc) = ppr dc
......
...@@ -1499,7 +1499,7 @@ mkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co ...@@ -1499,7 +1499,7 @@ mkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co
-- We didn't call mkForAllCo here because if v does not appear -- We didn't call mkForAllCo here because if v does not appear
-- in co, the argement coercion will be nominal. But here we -- in co, the argement coercion will be nominal. But here we
-- want it to be r. It is only called in 'mkPiCos', which is -- want it to be r. It is only called in 'mkPiCos', which is
-- only used in SimplUtils, where we are sure for -- only used in GHC.Core.Op.Simplify.Utils, where we are sure for
-- now (Aug 2018) v won't occur in co. -- now (Aug 2018) v won't occur in co.
mkFunCo r (mkReflCo r (varType v)) co mkFunCo r (mkReflCo r (varType v)) co
| otherwise = mkFunCo r (mkReflCo r (varType v)) co | otherwise = mkFunCo r (mkReflCo r (varType v)) co
......
...@@ -314,7 +314,7 @@ Nevertheless it is still useful to have data families in the FamInstEnv: ...@@ -314,7 +314,7 @@ Nevertheless it is still useful to have data families in the FamInstEnv:
- For finding overlaps and conflicts - For finding overlaps and conflicts
- For finding the representation type...see FamInstEnv.topNormaliseType - For finding the representation type...see FamInstEnv.topNormaliseType
and its call site in Simplify and its call site in GHC.Core.Op.Simplify
- In standalone deriving instance Eq (T [Int]) we need to find the - In standalone deriving instance Eq (T [Int]) we need to find the
representation type for T [Int] representation type for T [Int]
......
...@@ -29,7 +29,7 @@ import GHC.Core ...@@ -29,7 +29,7 @@ import GHC.Core
import GHC.Core.FVs import GHC.Core.FVs
import GHC.Core.Utils import GHC.Core.Utils
import GHC.Core.Stats ( coreBindsStats ) import GHC.Core.Stats ( coreBindsStats )
import CoreMonad import GHC.Core.Op.Monad
import Bag import Bag
import Literal import Literal
import GHC.Core.DataCon import GHC.Core.DataCon
...@@ -167,7 +167,7 @@ In the desugarer, it's very very convenient to be able to say (in effect) ...@@ -167,7 +167,7 @@ In the desugarer, it's very very convenient to be able to say (in effect)
let x::a = True in <body> let x::a = True in <body>
That is, use a type let. See Note [Type let] in CoreSyn. That is, use a type let. See Note [Type let] in CoreSyn.
One place it is used is in mkWwArgs; see Note [Join points and beta-redexes] One place it is used is in mkWwArgs; see Note [Join points and beta-redexes]
in WwLib. (Maybe there are other "clients" of this feature; I'm not sure). in GHC.Core.Op.WorkWrap.Lib. (Maybe there are other "clients" of this feature; I'm not sure).
* Hence when linting <body> we need to remember that a=Int, else we * Hence when linting <body> we need to remember that a=Int, else we
might reject a correct program. So we carry a type substitution (in might reject a correct program. So we carry a type substitution (in
...@@ -639,7 +639,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs) ...@@ -639,7 +639,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
-- We used to check that the dmdTypeDepth of a demand signature never -- We used to check that the dmdTypeDepth of a demand signature never
-- exceeds idArity, but that is an unnecessary complication, see -- exceeds idArity, but that is an unnecessary complication, see
-- Note [idArity varies independently of dmdTypeDepth] in DmdAnal -- Note [idArity varies independently of dmdTypeDepth] in GHC.Core.Op.DmdAnal
-- Check that the binder's arity is within the bounds imposed by -- Check that the binder's arity is within the bounds imposed by
-- the type and the strictness signature. See Note [exprArity invariant] -- the type and the strictness signature. See Note [exprArity invariant]
...@@ -1146,7 +1146,7 @@ lintCaseExpr scrut var alt_ty alts = ...@@ -1146,7 +1146,7 @@ lintCaseExpr scrut var alt_ty alts =
-- Check that the scrutinee is not a floating-point type -- Check that the scrutinee is not a floating-point type
-- if there are any literal alternatives -- if there are any literal alternatives
-- See GHC.Core Note [Case expression invariants] item (5) -- See GHC.Core Note [Case expression invariants] item (5)
-- See Note [Rules for floating-point comparisons] in PrelRules -- See Note [Rules for floating-point comparisons] in GHC.Core.Op.ConstantFold
; let isLitPat (LitAlt _, _ , _) = True ; let isLitPat (LitAlt _, _ , _) = True
isLitPat _ = False isLitPat _ = False
; checkL (not $ isFloatingTy scrut_ty && any isLitPat alts) ; checkL (not $ isFloatingTy scrut_ty && any isLitPat alts)
...@@ -2838,7 +2838,7 @@ lintAnnots pname pass guts = do ...@@ -2838,7 +2838,7 @@ lintAnnots pname pass guts = do
let binds = flattenBinds $ mg_binds nguts let binds = flattenBinds $ mg_binds nguts
binds' = flattenBinds $ mg_binds nguts' binds' = flattenBinds $ mg_binds nguts'
(diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds' (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds'
when (not (null diffs)) $ CoreMonad.putMsg $ vcat when (not (null diffs)) $ GHC.Core.Op.Monad.putMsg $ vcat
[ lint_banner "warning" pname [ lint_banner "warning" pname
, text "Core changes with annotations:" , text "Core changes with annotations:"
, withPprStyle (defaultDumpStyle dflags) $ nest 2 $ vcat diffs , withPprStyle (defaultDumpStyle dflags) $ nest 2 $ vcat diffs
......
...@@ -193,7 +193,7 @@ mkWildEvBinder pred = mkWildValBinder pred ...@@ -193,7 +193,7 @@ mkWildEvBinder pred = mkWildValBinder pred
-- that you expect to use only at a *binding* site. Do not use it at -- that you expect to use only at a *binding* site. Do not use it at
-- occurrence sites because it has a single, fixed unique, and it's very -- occurrence sites because it has a single, fixed unique, and it's very
-- easy to get into difficulties with shadowing. That's why it is used so little. -- easy to get into difficulties with shadowing. That's why it is used so little.
-- See Note [WildCard binders] in SimplEnv -- See Note [WildCard binders] in GHC.Core.Op.Simplify.Env
mkWildValBinder :: Type -> Id mkWildValBinder :: Type -> Id
mkWildValBinder ty = mkLocalIdOrCoVar wildCardName ty mkWildValBinder ty = mkLocalIdOrCoVar wildCardName ty
-- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
...@@ -576,7 +576,7 @@ data FloatBind ...@@ -576,7 +576,7 @@ data FloatBind
= FloatLet CoreBind = FloatLet CoreBind
| FloatCase CoreExpr Id AltCon [Var] | FloatCase CoreExpr Id AltCon [Var]
-- case e of y { C ys -> ... } -- case e of y { C ys -> ... }
-- See Note [Floating single-alternative cases] in SetLevels -- See Note [Floating single-alternative cases] in GHC.Core.Op.SetLevels
instance Outputable FloatBind where instance Outputable FloatBind where
ppr (FloatLet b) = text "LET" <+> ppr b ppr (FloatLet b) = text "LET" <+> ppr b
...@@ -880,7 +880,7 @@ the first. But the stable-unfolding for f looks like ...@@ -880,7 +880,7 @@ the first. But the stable-unfolding for f looks like
\x. case x of MkT a b -> g ($WMkT b a) \x. case x of MkT a b -> g ($WMkT b a)
where $WMkT is the wrapper for MkT that evaluates its arguments. We where $WMkT is the wrapper for MkT that evaluates its arguments. We
apply the same w/w split to this unfolding (see Note [Worker-wrapper apply the same w/w split to this unfolding (see Note [Worker-wrapper
for INLINEABLE functions] in WorkWrap) so the template ends up like for INLINEABLE functions] in GHC.Core.Op.WorkWrap) so the template ends up like
\b. let a = absentError "blah" \b. let a = absentError "blah"
x = MkT a b x = MkT a b
in case x of MkT a b -> g ($WMkT b a) in case x of MkT a b -> g ($WMkT b a)
...@@ -925,7 +925,7 @@ aBSENT_ERROR_ID ...@@ -925,7 +925,7 @@ aBSENT_ERROR_ID
where where
absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTy addrPrimTy alphaTy) absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTy addrPrimTy alphaTy)
-- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
-- lifted-type things; see Note [Absent errors] in WwLib -- lifted-type things; see Note [Absent errors] in GHC.Core.Op.WorkWrap.Lib
arity_info = vanillaIdInfo `setArityInfo` 1 arity_info = vanillaIdInfo `setArityInfo` 1
-- NB: no bottoming strictness info, unlike other error-ids. -- NB: no bottoming strictness info, unlike other error-ids.
-- See Note [aBSENT_ERROR_ID] -- See Note [aBSENT_ERROR_ID]
......
...@@ -9,7 +9,7 @@ ...@@ -9,7 +9,7 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module CSE (cseProgram, cseOneExpr) where module GHC.Core.Op.CSE (cseProgram, cseOneExpr) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -123,12 +123,12 @@ Notice that ...@@ -123,12 +123,12 @@ Notice that
Notice also that in the SUBSTITUTE case we leave behind a binding Notice also that in the SUBSTITUTE case we leave behind a binding
x = y x = y
even though we /also/ carry a substitution x -> y. Can we just drop even though we /also/ carry a substitution x -> y. Can we just drop
the binding instead? Well, not at top level! See SimplUtils the binding instead? Well, not at top level! See Note [Top level and
Note [Top level and postInlineUnconditionally]; and in any case CSE postInlineUnconditionally] in GHC.Core.Op.Simplify.Utils; and in any
applies only to the /bindings/ of the program, and we leave it to the case CSE applies only to the /bindings/ of the program, and we leave
simplifier to propate effects to the RULES. Finally, it doesn't seem it to the simplifier to propate effects to the RULES. Finally, it
worth the effort to discard the nested bindings because the simplifier doesn't seem worth the effort to discard the nested bindings because
will do it next. the simplifier will do it next.
Note [CSE for case expressions] Note [CSE for case expressions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...@@ -230,8 +230,8 @@ Here 'foo' has a stable unfolding, but its (optimised) RHS is trivial. ...@@ -230,8 +230,8 @@ Here 'foo' has a stable unfolding, but its (optimised) RHS is trivial.
the Integer instance of Enum in GHC.Enum.) Suppose moreover that foo's the Integer instance of Enum in GHC.Enum.) Suppose moreover that foo's
stable unfolding originates from an INLINE or INLINEABLE pragma on foo. stable unfolding originates from an INLINE or INLINEABLE pragma on foo.
Then we obviously do NOT want to extend the substitution with (foo->x), Then we obviously do NOT want to extend the substitution with (foo->x),
because we promised to inline foo as what the user wrote. See similar because we promised to inline foo as what the user wrote. See similar Note
SimplUtils Note [Stable unfoldings and postInlineUnconditionally]. [Stable unfoldings and postInlineUnconditionally] in GHC.Core.Op.Simplify.Utils.
Nor do we want to change the reverse mapping. Suppose we have Nor do we want to change the reverse mapping. Suppose we have
...@@ -687,7 +687,7 @@ turning K2 into 'x' increases the number of live variables. But ...@@ -687,7 +687,7 @@ turning K2 into 'x' increases the number of live variables. But
Note [Combine case alternatives] Note [Combine case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
combineAlts is just a more heavyweight version of the use of combineAlts is just a more heavyweight version of the use of
combineIdenticalAlts in SimplUtils.prepareAlts. The basic idea is combineIdenticalAlts in GHC.Core.Op.Simplify.Utils.prepareAlts. The basic idea is
to transform to transform
DEFAULT -> e1 DEFAULT -> e1
...@@ -710,7 +710,7 @@ Note [Combine case alts: awkward corner] ...@@ -710,7 +710,7 @@ Note [Combine case alts: awkward corner]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We would really like to check isDeadBinder on the binders in the We would really like to check isDeadBinder on the binders in the
alternative. But alas, the simplifer zaps occ-info on binders in case alternative. But alas, the simplifer zaps occ-info on binders in case
alternatives; see Note [Case alternative occ info] in Simplify. alternatives; see Note [Case alternative occ info] in GHC.Core.Op.Simplify.
* One alternative (perhaps a good one) would be to do OccAnal * One alternative (perhaps a good one) would be to do OccAnal
just before CSE. Then perhaps we could get rid of combineIdenticalAlts just before CSE. Then perhaps we could get rid of combineIdenticalAlts
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- Copyright (c) 2014 Joachim Breitner -- Copyright (c) 2014 Joachim Breitner
-- --
module CallArity module GHC.Core.Op.CallArity
( callArityAnalProgram ( callArityAnalProgram
, callArityRHS -- for testing , callArityRHS -- for testing
) where ) where
......
...@@ -16,7 +16,7 @@ ToDo: ...@@ -16,7 +16,7 @@ ToDo:
DeriveFunctor #-} DeriveFunctor #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-}
module PrelRules module GHC.Core.Op.ConstantFold
( primOpRules ( primOpRules
, builtinRules , builtinRules
, caseRules , caseRules
...@@ -1117,13 +1117,13 @@ is: ...@@ -1117,13 +1117,13 @@ is:
the returned value. the returned value.
* An application like (dataToTag# (Just x)) is optimised by * An application like (dataToTag# (Just x)) is optimised by
dataToTagRule in PrelRules. dataToTagRule in GHC.Core.Op.ConstantFold.
* A case expression like * A case expression like
case (dataToTag# e) of <alts> case (dataToTag# e) of <alts>
gets transformed t gets transformed t
case e of <transformed alts> case e of <transformed alts>
by PrelRules.caseRules; see Note [caseRules for dataToTag] by GHC.Core.Op.ConstantFold.caseRules; see Note [caseRules for dataToTag]
See #15696 for a long saga. See #15696 for a long saga.
-} -}
...@@ -1198,7 +1198,7 @@ Things to note ...@@ -1198,7 +1198,7 @@ Things to note
Implementing seq#. The compiler has magic for SeqOp in Implementing seq#. The compiler has magic for SeqOp in
- PrelRules.seqRule: eliminate (seq# <whnf> s) - GHC.Core.Op.ConstantFold.seqRule: eliminate (seq# <whnf> s)
- GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq# - GHC.StgToCmm.Expr.cgExpr, and cgCase: special case for seq#
...@@ -1207,7 +1207,7 @@ Implementing seq#. The compiler has magic for SeqOp in ...@@ -1207,7 +1207,7 @@ Implementing seq#. The compiler has magic for SeqOp in
- Simplify.addEvals records evaluated-ness for the result; see - Simplify.addEvals records evaluated-ness for the result; see
Note [Adding evaluatedness info to pattern-bound variables] Note [Adding evaluatedness info to pattern-bound variables]
in Simplify in GHC.Core.Op.Simplify
-} -}
seqRule :: RuleM CoreExpr seqRule :: RuleM CoreExpr
...@@ -2054,7 +2054,7 @@ wordPrimOps dflags = PrimOps ...@@ -2054,7 +2054,7 @@ wordPrimOps dflags = PrimOps
-------------------------------------------------------- --------------------------------------------------------
-- Constant folding through case-expressions -- Constant folding through case-expressions
-- --
-- cf Scrutinee Constant Folding in simplCore/SimplUtils -- cf Scrutinee Constant Folding in simplCore/GHC.Core.Op.Simplify.Utils
-------------------------------------------------------- --------------------------------------------------------
-- | Match the scrutinee of a case and potentially return a new scrutinee and a -- | Match the scrutinee of a case and potentially return a new scrutinee and a
...@@ -2215,7 +2215,7 @@ We don't want to get this! ...@@ -2215,7 +2215,7 @@ We don't want to get this!
DEFAULT -> e1 DEFAULT -> e1
DEFAULT -> e2 DEFAULT -> e2
Instead, we deal with turning one branch into DEFAULT in SimplUtils Instead, we deal with turning one branch into DEFAULT in GHC.Core.Op.Simplify.Utils
(add_default in mkCase3). (add_default in mkCase3).
Note [caseRules for dataToTag] Note [caseRules for dataToTag]
......
...@@ -7,13 +7,13 @@ ...@@ -7,13 +7,13 @@
-- See https://www.microsoft.com/en-us/research/publication/constructed-product-result-analysis-haskell/. -- See https://www.microsoft.com/en-us/research/publication/constructed-product-result-analysis-haskell/.
-- CPR analysis should happen after strictness analysis. -- CPR analysis should happen after strictness analysis.
-- See Note [Phase ordering]. -- See Note [Phase ordering].
module CprAnal ( cprAnalProgram ) where module GHC.Core.Op.CprAnal ( cprAnalProgram ) where
#include "HsVersions.h" #include "HsVersions.h"
import GhcPrelude import GhcPrelude
import WwLib ( deepSplitProductType_maybe ) import GHC.Core.Op.WorkWrap.Lib ( deepSplitProductType_maybe )
import GHC.Driver.Session import GHC.Driver.Session
import Demand import Demand
import Cpr import Cpr
...@@ -107,7 +107,7 @@ cprAnalProgram dflags fam_envs binds = do ...@@ -107,7 +107,7 @@ cprAnalProgram dflags fam_envs binds = do
let binds_plus_cpr = snd $ mapAccumL cprAnalTopBind env binds let binds_plus_cpr = snd $ mapAccumL cprAnalTopBind env binds
dumpIfSet_dyn dflags Opt_D_dump_cpr_signatures "Cpr signatures" FormatText $ dumpIfSet_dyn dflags Opt_D_dump_cpr_signatures "Cpr signatures" FormatText $
dumpIdInfoOfProgram (ppr . cprInfo) binds_plus_cpr dumpIdInfoOfProgram (ppr . cprInfo) binds_plus_cpr
-- See Note [Stamp out space leaks in demand analysis] in DmdAnal -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Op.DmdAnal
seqBinds binds_plus_cpr `seq` return binds_plus_cpr seqBinds binds_plus_cpr `seq` return binds_plus_cpr
-- Analyse a (group of) top-level binding(s) -- Analyse a (group of) top-level binding(s)
...@@ -251,7 +251,7 @@ cprFix top_lvl env orig_pairs ...@@ -251,7 +251,7 @@ cprFix top_lvl env orig_pairs
= loop 1 initial_pairs = loop 1 initial_pairs
where where
bot_sig = mkCprSig 0 botCpr bot_sig = mkCprSig 0 botCpr
-- See Note [Initialising strictness] in DmdAnal.hs -- See Note [Initialising strictness] in GHC.Core.Op.DmdAnal
initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ] initial_pairs | ae_virgin env = [(setIdCprInfo id bot_sig, rhs) | (id, rhs) <- orig_pairs ]
| otherwise = orig_pairs | otherwise = orig_pairs
......
...@@ -9,14 +9,14 @@ ...@@ -9,14 +9,14 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module DmdAnal ( dmdAnalProgram ) where module GHC.Core.Op.DmdAnal ( dmdAnalProgram ) where
#include "HsVersions.h" #include "HsVersions.h"
import GhcPrelude import GhcPrelude
import GHC.Driver.Session import GHC.Driver.Session
import WwLib ( findTypeShape ) import GHC.Core.Op.WorkWrap.Lib ( findTypeShape )
import Demand -- All of it import Demand -- All of it
import GHC.Core import GHC.Core
import GHC.Core.Seq ( seqBinds ) import GHC.Core.Seq ( seqBinds )
...@@ -759,7 +759,7 @@ information, but ...@@ -759,7 +759,7 @@ information, but
* Performing the worker/wrapper split based on this information would be * Performing the worker/wrapper split based on this information would be
implicitly eta-expanding `f`, playing fast and loose with divergence and implicitly eta-expanding `f`, playing fast and loose with divergence and
even being unsound in the presence of newtypes, so we refrain from doing so. even being unsound in the presence of newtypes, so we refrain from doing so.
Also see Note [Don't eta expand in w/w] in WorkWrap. Also see Note [Don't eta expand in w/w] in GHC.Core.Op.WorkWrap.
Since we only compute one signature, we do so for arity 1. Computing multiple Since we only compute one signature, we do so for arity 1. Computing multiple
signatures for different arities (i.e., polyvariance) would be entirely signatures for different arities (i.e., polyvariance) would be entirely
...@@ -1246,8 +1246,9 @@ The once-used information is (currently) only used by the code ...@@ -1246,8 +1246,9 @@ The once-used information is (currently) only used by the code
generator, though. So: generator, though. So:
* We zap the used-once info in the worker-wrapper; * We zap the used-once info in the worker-wrapper;
see Note [Zapping Used Once info in WorkWrap] in WorkWrap. If it's see Note [Zapping Used Once info in WorkWrap] in
not reliable, it's better not to have it at all. GHC.Core.Op.WorkWrap.
If it's not reliable, it's better not to have it at all.
* Just before TidyCore, we add a pass of the demand analyser, * Just before TidyCore, we add a pass of the demand analyser,
but WITHOUT subsequent worker/wrapper and simplifier, but WITHOUT subsequent worker/wrapper and simplifier,
......
module Exitify ( exitifyProgram ) where module GHC.Core.Op.Exitify ( exitifyProgram ) where
{- {-
Note [Exitification] Note [Exitification]
...@@ -246,7 +246,7 @@ exitifyRec in_scope pairs ...@@ -246,7 +246,7 @@ exitifyRec in_scope pairs
-- We are going to abstract over these variables, so we must -- We are going to abstract over these variables, so we must
-- zap any IdInfo they have; see #15005 -- zap any IdInfo they have; see #15005
-- cf. SetLevels.abstractVars -- cf. GHC.Core.Op.SetLevels.abstractVars
zap v | isId v = setIdInfo v vanillaIdInfo zap v | isId v = setIdInfo v vanillaIdInfo
| otherwise = v | otherwise = v
......
...@@ -16,7 +16,7 @@ then discover that they aren't needed in the chosen branch. ...@@ -16,7 +16,7 @@ then discover that they aren't needed in the chosen branch.
{-# OPTIONS_GHC -fprof-auto #-} {-# OPTIONS_GHC -fprof-auto #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module FloatIn ( floatInwards ) where module GHC.Core.Op.FloatIn ( floatInwards ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -27,7 +27,7 @@ import GHC.Core.Make hiding ( wrapFloats ) ...@@ -27,7 +27,7 @@ import GHC.Core.Make hiding ( wrapFloats )
import GHC.Driver.Types ( ModGuts(..) ) import GHC.Driver.Types ( ModGuts(..) )
import GHC.Core.Utils import GHC.Core.Utils
import GHC.Core.FVs import GHC.Core.FVs
import CoreMonad ( CoreM ) import GHC.Core.Op.Monad ( CoreM )
import Id ( isOneShotBndr, idType, isJoinId, isJoinId_maybe ) import Id ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
import Var import Var
import GHC.Core.Type import GHC.Core.Type
...@@ -91,7 +91,7 @@ The fix is ...@@ -91,7 +91,7 @@ The fix is
to let bind the algebraic case scrutinees (done, I think) and to let bind the algebraic case scrutinees (done, I think) and
the case alternatives (except the ones with an the case alternatives (except the ones with an
unboxed type)(not done, I think). This is best done in the unboxed type)(not done, I think). This is best done in the
SetLevels.hs module, which tags things with their level numbers. GHC.Core.Op.SetLevels.hs module, which tags things with their level numbers.
\item \item
do the full laziness pass (floating lets outwards). do the full laziness pass (floating lets outwards).
\item \item
......
...@@ -8,21 +8,21 @@ ...@@ -8,21 +8,21 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module FloatOut ( floatOutwards ) where module GHC.Core.Op.FloatOut ( floatOutwards ) where
import GhcPrelude import GhcPrelude
import GHC.Core import GHC.Core
import GHC.Core.Utils import GHC.Core.Utils
import GHC.Core.Make import GHC.Core.Make
import GHC.Core.Arity ( etaExpand ) import GHC.Core.Arity ( etaExpand )
import CoreMonad ( FloatOutSwitches(..) ) import GHC.Core.Op.Monad ( FloatOutSwitches(..) )
import GHC.Driver.Session import GHC.Driver.Session
import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) ) import ErrUtils ( dumpIfSet_dyn, DumpFormat (..) )
import Id ( Id, idArity, idType, isBottomingId, import Id ( Id, idArity, idType, isBottomingId,
isJoinId, isJoinId_maybe ) isJoinId, isJoinId_maybe )
import SetLevels import GHC.Core.Op.SetLevels
import UniqSupply ( UniqSupply ) import UniqSupply ( UniqSupply )
import Bag import Bag
import Util import Util
...@@ -113,7 +113,7 @@ Note [Join points] ...@@ -113,7 +113,7 @@ Note [Join points]
Every occurrence of a join point must be a tail call (see Note [Invariants on Every occurrence of a join point must be a tail call (see Note [Invariants on
join points] in GHC.Core), so we must be careful with how far we float them. The join points] in GHC.Core), so we must be careful with how far we float them. The
mechanism for doing so is the *join ceiling*, detailed in Note [Join ceiling] mechanism for doing so is the *join ceiling*, detailed in Note [Join ceiling]
in SetLevels. For us, the significance is that a binder might be marked to be in GHC.Core.Op.SetLevels. For us, the significance is that a binder might be marked to be
dropped at the nearest boundary between tail calls and non-tail calls. For dropped at the nearest boundary between tail calls and non-tail calls. For
example: example:
...@@ -220,7 +220,7 @@ floatBind (NonRec (TB var _) rhs) ...@@ -220,7 +220,7 @@ floatBind (NonRec (TB var _) rhs)
= case (floatRhs var rhs) of { (fs, rhs_floats, rhs') -> = case (floatRhs var rhs) of { (fs, rhs_floats, rhs') ->
-- A tiresome hack: -- A tiresome hack:
-- see Note [Bottoming floats: eta expansion] in SetLevels -- see Note [Bottoming floats: eta expansion] in GHC.Core.Op.SetLevels
let rhs'' | isBottomingId var = etaExpand (idArity var) rhs' let rhs'' | isBottomingId var = etaExpand (idArity var) rhs'
| otherwise = rhs' | otherwise = rhs'
...@@ -337,7 +337,7 @@ makes f and x' look mutually recursive when they're not. ...@@ -337,7 +337,7 @@ makes f and x' look mutually recursive when they're not.
The test was shootout/k-nucleotide, as compiled using commit 47d5dd68 on the The test was shootout/k-nucleotide, as compiled using commit 47d5dd68 on the
wip/join-points branch. wip/join-points branch.
TODO: This can probably be solved somehow in SetLevels. The difference between TODO: This can probably be solved somehow in GHC.Core.Op.SetLevels. The difference between
"this *is at* level <2,0>" and "this *depends on* level <2,0>" is very "this *is at* level <2,0>" and "this *depends on* level <2,0>" is very
important.) important.)
...@@ -408,7 +408,7 @@ floatExpr lam@(Lam (TB _ lam_spec) _) ...@@ -408,7 +408,7 @@ floatExpr lam@(Lam (TB _ lam_spec) _)
bndrs = [b | TB b _ <- bndrs_w_lvls] bndrs = [b | TB b _ <- bndrs_w_lvls]
bndr_lvl = asJoinCeilLvl (floatSpecLevel lam_spec) bndr_lvl = asJoinCeilLvl (floatSpecLevel lam_spec)
-- All the binders have the same level -- All the binders have the same level
-- See SetLevels.lvlLamBndrs -- See GHC.Core.Op.SetLevels.lvlLamBndrs
-- Use asJoinCeilLvl to make this the join ceiling -- Use asJoinCeilLvl to make this the join ceiling
in in
case (floatBody bndr_lvl body) of { (fs, floats, body') -> case (floatBody bndr_lvl body) of { (fs, floats, body') ->
...@@ -597,7 +597,7 @@ lifted to top level. ...@@ -597,7 +597,7 @@ lifted to top level.
The trouble is that The trouble is that
(a) we partition these floating bindings *at every binding site* (a) we partition these floating bindings *at every binding site*
(b) SetLevels introduces a new bindings site for every float (b) GHC.Core.Op.SetLevels introduces a new bindings site for every float
So we had better not look at each binding at each binding site! So we had better not look at each binding at each binding site!
That is why MajorEnv is represented as a finite map. That is why MajorEnv is represented as a finite map.
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module LiberateCase ( liberateCase ) where module GHC.Core.Op.LiberateCase ( liberateCase ) where
#include "HsVersions.h" #include "HsVersions.h"
......
{- {-
(c) The AQUA Project, Glasgow University, 1993-1998 (c) The AQUA Project, Glasgow University, 1993-1998
\section[CoreMonad]{The core pipeline monad}
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
...@@ -9,7 +8,7 @@ ...@@ -9,7 +8,7 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}