Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
528df8ec
Commit
528df8ec
authored
Mar 17, 2020
by
Sylvain Henry
Committed by
Marge Bot
Mar 18, 2020
Browse files
Modules: Core operations (
#13009
)
parent
53ff2cd0
Pipeline
#16855
passed with stages
in 442 minutes and 22 seconds
Changes
82
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
compiler/GHC/Core.hs
View file @
528df8ec
...
...
@@ -354,7 +354,7 @@ an unlifted literal, like all the others.
Also, we do not permit case analysis with literal patterns on floating-point
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 ---------------------------
...
...
@@ -508,7 +508,7 @@ checked by Core Lint.
5. Floating-point values must not be scrutinised against literals.
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.
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:
_ -> False
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
j :: Int -> Bool -> Bool -- changed!
...
...
@@ -1810,9 +1810,9 @@ the occurrence info is wrong
-}
-- The Ord is needed for the FiniteMap used in the lookForConstructor
-- in SimplEnv. If you declared that lookForConstructor
*ignores*
-- constructor-applications with LitArg args, then you could get
--
rid
of this Ord.
-- in
GHC.Core.Op.
Simpl
ify.
Env. If you declared that lookForConstructor
--
*ignores*
constructor-applications with LitArg args, then you could get
rid
-- of this Ord.
instance
Outputable
AltCon
where
ppr
(
DataAlt
dc
)
=
ppr
dc
...
...
compiler/GHC/Core/Coercion.hs
View file @
528df8ec
...
...
@@ -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
-- in co, the argement coercion will be nominal. But here we
-- 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.
Simpl
ify.
Utils, where we are sure for
-- now (Aug 2018) v won't occur in co.
mkFunCo
r
(
mkReflCo
r
(
varType
v
))
co
|
otherwise
=
mkFunCo
r
(
mkReflCo
r
(
varType
v
))
co
...
...
compiler/GHC/Core/FamInstEnv.hs
View file @
528df8ec
...
...
@@ -314,7 +314,7 @@ Nevertheless it is still useful to have data families in the FamInstEnv:
- For finding overlaps and conflicts
- 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
representation type for T [Int]
...
...
compiler/GHC/Core/Lint.hs
View file @
528df8ec
...
...
@@ -29,7 +29,7 @@ import GHC.Core
import
GHC.Core.FVs
import
GHC.Core.Utils
import
GHC.Core.Stats
(
coreBindsStats
)
import
Core
Monad
import
GHC.Core.Op.
Monad
import
Bag
import
Literal
import
GHC.Core.DataCon
...
...
@@ -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>
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]
in
Ww
Lib. (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
might reject a correct program. So we carry a type substitution (in
...
...
@@ -639,7 +639,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
-- We used to check that the dmdTypeDepth of a demand signature never
-- 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
-- the type and the strictness signature. See Note [exprArity invariant]
...
...
@@ -1146,7 +1146,7 @@ lintCaseExpr scrut var alt_ty alts =
-- Check that the scrutinee is not a floating-point type
-- if there are any literal alternatives
-- 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
isLitPat
_
=
False
;
checkL
(
not
$
isFloatingTy
scrut_ty
&&
any
isLitPat
alts
)
...
...
@@ -2838,7 +2838,7 @@ lintAnnots pname pass guts = do
let
binds
=
flattenBinds
$
mg_binds
nguts
binds'
=
flattenBinds
$
mg_binds
nguts'
(
diffs
,
_
)
=
diffBinds
True
(
mkRnEnv2
emptyInScopeSet
)
binds
binds'
when
(
not
(
null
diffs
))
$
Core
Monad
.
putMsg
$
vcat
when
(
not
(
null
diffs
))
$
GHC
.
Core
.
Op
.
Monad
.
putMsg
$
vcat
[
lint_banner
"warning"
pname
,
text
"Core changes with annotations:"
,
withPprStyle
(
defaultDumpStyle
dflags
)
$
nest
2
$
vcat
diffs
...
...
compiler/GHC/Core/Make.hs
View file @
528df8ec
...
...
@@ -193,7 +193,7 @@ mkWildEvBinder pred = mkWildValBinder pred
-- 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
-- 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.
Simpl
ify.
Env
mkWildValBinder
::
Type
->
Id
mkWildValBinder
ty
=
mkLocalIdOrCoVar
wildCardName
ty
-- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors
...
...
@@ -576,7 +576,7 @@ data FloatBind
=
FloatLet
CoreBind
|
FloatCase
CoreExpr
Id
AltCon
[
Var
]
-- 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
ppr
(
FloatLet
b
)
=
text
"LET"
<+>
ppr
b
...
...
@@ -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)
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
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"
x = MkT a b
in case x of MkT a b -> g ($WMkT b a)
...
...
@@ -925,7 +925,7 @@ aBSENT_ERROR_ID
where
absent_ty
=
mkSpecForAllTys
[
alphaTyVar
]
(
mkVisFunTy
addrPrimTy
alphaTy
)
-- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
-- lifted-type things; see Note [Absent errors] in
Ww
Lib
-- lifted-type things; see Note [Absent errors] in
GHC.Core.Op.WorkWrap.
Lib
arity_info
=
vanillaIdInfo
`
setArityInfo
`
1
-- NB: no bottoming strictness info, unlike other error-ids.
-- See Note [aBSENT_ERROR_ID]
...
...
compiler/
simpl
Core/CSE.hs
→
compiler/
GHC/
Core/
Op/
CSE.hs
View file @
528df8ec
...
...
@@ -9,7 +9,7 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module
CSE
(
cseProgram
,
cseOneExpr
)
where
module
GHC.Core.Op.
CSE
(
cseProgram
,
cseOneExpr
)
where
#
include
"HsVersions.h"
...
...
@@ -123,12 +123,12 @@ Notice that
Notice also that in the SUBSTITUTE case we leave behind a binding
x = y
even though we /also/ carry a substitution x -> y. Can we just drop
the binding instead? Well, not at top level! See
SimplUtils
Note [Top level and
postInlineUnconditionally]; and in any
case CSE
applies only to the /bindings/ of the program, and we leave
it to the
simplifier to propate effects to the RULES.
Finally, it
doesn't seem
worth the effort to discard the nested bindings because
the simplifier
will do it next.
the binding instead? Well, not at top level! See
Note [Top level and
postInlineUnconditionally]
in GHC.Core.Op.Simplify.Utils
; and in any
case CSE
applies only to the /bindings/ of the program, and we leave
it to the
simplifier to propate effects to the RULES. Finally, it
doesn't seem
worth the effort to discard the nested bindings because
the simplifier
will do it next.
Note [CSE for case expressions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...
...
@@ -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
stable unfolding originates from an INLINE or INLINEABLE pragma on foo.
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
SimplUtils Note
[Stable unfoldings and postInlineUnconditionally].
because we promised to inline foo as what the user wrote. See similar
Note
[Stable unfoldings and postInlineUnconditionally]
in GHC.Core.Op.Simplify.Utils
.
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
Note [Combine case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
combineAlts is just a more heavyweight version of the use of
combineIdenticalAlts in SimplUtils.prepareAlts. The basic idea is
combineIdenticalAlts in
GHC.Core.Op.
Simpl
ify.
Utils.prepareAlts. The basic idea is
to transform
DEFAULT -> e1
...
...
@@ -710,7 +710,7 @@ Note [Combine case alts: awkward corner]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We would really like to check isDeadBinder on the binders in the
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
just before CSE. Then perhaps we could get rid of combineIdenticalAlts
...
...
compiler/
simpl
Core/CallArity.hs
→
compiler/
GHC/
Core/
Op/
CallArity.hs
View file @
528df8ec
...
...
@@ -2,7 +2,7 @@
-- Copyright (c) 2014 Joachim Breitner
--
module
CallArity
module
GHC.Core.Op.
CallArity
(
callArityAnalProgram
,
callArityRHS
-- for testing
)
where
...
...
compiler/
prelude/PrelRules
.hs
→
compiler/
GHC/Core/Op/ConstantFold
.hs
View file @
528df8ec
...
...
@@ -16,7 +16,7 @@ ToDo:
DeriveFunctor #-}
{-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE -Wno-incomplete-uni-patterns #-}
module
PrelRules
module
GHC.Core.Op.ConstantFold
(
primOpRules
,
builtinRules
,
caseRules
...
...
@@ -1117,13 +1117,13 @@ is:
the returned value.
* An application like (dataToTag# (Just x)) is optimised by
dataToTagRule in
PrelRules
.
dataToTagRule in
GHC.Core.Op.ConstantFold
.
* A case expression like
case (dataToTag# e) of <alts>
gets transformed t
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.
-}
...
...
@@ -1198,7 +1198,7 @@ Things to note
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#
...
...
@@ -1207,7 +1207,7 @@ Implementing seq#. The compiler has magic for SeqOp in
- Simplify.addEvals records evaluated-ness for the result; see
Note [Adding evaluatedness info to pattern-bound variables]
in Simplify
in
GHC.Core.Op.
Simplify
-}
seqRule
::
RuleM
CoreExpr
...
...
@@ -2054,7 +2054,7 @@ wordPrimOps dflags = PrimOps
--------------------------------------------------------
-- Constant folding through case-expressions
--
-- cf Scrutinee Constant Folding in simplCore/SimplUtils
-- cf Scrutinee Constant Folding in simplCore/
GHC.Core.Op.
Simpl
ify.
Utils
--------------------------------------------------------
-- | 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!
DEFAULT -> e1
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.
Simpl
ify.
Utils
(add_default in mkCase3).
Note [caseRules for dataToTag]
...
...
compiler/
stranal
/CprAnal.hs
→
compiler/
GHC/Core/Op
/CprAnal.hs
View file @
528df8ec
...
...
@@ -7,13 +7,13 @@
-- See https://www.microsoft.com/en-us/research/publication/constructed-product-result-analysis-haskell/.
-- CPR analysis should happen after strictness analysis.
-- See Note [Phase ordering].
module
CprAnal
(
cprAnalProgram
)
where
module
GHC.Core.Op.
CprAnal
(
cprAnalProgram
)
where
#
include
"HsVersions.h"
import
GhcPrelude
import
WwLib
(
deepSplitProductType_maybe
)
import
GHC.Core.Op.WorkWrap.Lib
(
deepSplitProductType_maybe
)
import
GHC.Driver.Session
import
Demand
import
Cpr
...
...
@@ -107,7 +107,7 @@ cprAnalProgram dflags fam_envs binds = do
let
binds_plus_cpr
=
snd
$
mapAccumL
cprAnalTopBind
env
binds
dumpIfSet_dyn
dflags
Opt_D_dump_cpr_signatures
"Cpr signatures"
FormatText
$
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
-- Analyse a (group of) top-level binding(s)
...
...
@@ -251,7 +251,7 @@ cprFix top_lvl env orig_pairs
=
loop
1
initial_pairs
where
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
]
|
otherwise
=
orig_pairs
...
...
compiler/
stranal
/DmdAnal.hs
→
compiler/
GHC/Core/Op
/DmdAnal.hs
View file @
528df8ec
...
...
@@ -9,14 +9,14 @@
{-# LANGUAGE CPP #-}
module
DmdAnal
(
dmdAnalProgram
)
where
module
GHC.Core.Op.
DmdAnal
(
dmdAnalProgram
)
where
#
include
"HsVersions.h"
import
GhcPrelude
import
GHC.Driver.Session
import
WwLib
(
findTypeShape
)
import
GHC.Core.Op.WorkWrap.Lib
(
findTypeShape
)
import
Demand
-- All of it
import
GHC.Core
import
GHC.Core.Seq
(
seqBinds
)
...
...
@@ -759,7 +759,7 @@ information, but
* Performing the worker/wrapper split based on this information would be
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.
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
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
generator, though. So:
* We zap the used-once info in the worker-wrapper;
see Note [Zapping Used Once info in WorkWrap] in WorkWrap. If it's
not reliable, it's better not to have it at all.
see Note [Zapping Used Once info in WorkWrap] in
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,
but WITHOUT subsequent worker/wrapper and simplifier,
...
...
compiler/
simpl
Core/Exitify.hs
→
compiler/
GHC/
Core/
Op/
Exitify.hs
View file @
528df8ec
module
Exitify
(
exitifyProgram
)
where
module
GHC.Core.Op.
Exitify
(
exitifyProgram
)
where
{-
Note [Exitification]
...
...
@@ -246,7 +246,7 @@ exitifyRec in_scope pairs
-- We are going to abstract over these variables, so we must
-- zap any IdInfo they have; see #15005
-- cf. SetLevels.abstractVars
-- cf.
GHC.Core.Op.
SetLevels.abstractVars
zap
v
|
isId
v
=
setIdInfo
v
vanillaIdInfo
|
otherwise
=
v
...
...
compiler/
simpl
Core/FloatIn.hs
→
compiler/
GHC/
Core/
Op/
FloatIn.hs
View file @
528df8ec
...
...
@@ -16,7 +16,7 @@ then discover that they aren't needed in the chosen branch.
{-# OPTIONS_GHC -fprof-auto #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module
FloatIn
(
floatInwards
)
where
module
GHC.Core.Op.
FloatIn
(
floatInwards
)
where
#
include
"HsVersions.h"
...
...
@@ -27,7 +27,7 @@ import GHC.Core.Make hiding ( wrapFloats )
import
GHC.Driver.Types
(
ModGuts
(
..
)
)
import
GHC.Core.Utils
import
GHC.Core.FVs
import
Core
Monad
(
CoreM
)
import
GHC.Core.Op.
Monad
(
CoreM
)
import
Id
(
isOneShotBndr
,
idType
,
isJoinId
,
isJoinId_maybe
)
import
Var
import
GHC.Core.Type
...
...
@@ -91,7 +91,7 @@ The fix is
to let bind the algebraic case scrutinees (done, I think) and
the case alternatives (except the ones with an
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
do the full laziness pass (floating lets outwards).
\item
...
...
compiler/
simpl
Core/FloatOut.hs
→
compiler/
GHC/
Core/
Op/
FloatOut.hs
View file @
528df8ec
...
...
@@ -8,21 +8,21 @@
{-# LANGUAGE CPP #-}
module
FloatOut
(
floatOutwards
)
where
module
GHC.Core.Op.
FloatOut
(
floatOutwards
)
where
import
GhcPrelude
import
GHC.Core
import
GHC.Core.Utils
import
GHC.Core.Make
import
GHC.Core.Arity
(
etaExpand
)
import
CoreMonad
(
FloatOutSwitches
(
..
)
)
import
GHC.Core.Arity
(
etaExpand
)
import
GHC.Core.Op.Monad
(
FloatOutSwitches
(
..
)
)
import
GHC.Driver.Session
import
ErrUtils
(
dumpIfSet_dyn
,
DumpFormat
(
..
)
)
import
Id
(
Id
,
idArity
,
idType
,
isBottomingId
,
isJoinId
,
isJoinId_maybe
)
import
SetLevels
import
GHC.Core.Op.
SetLevels
import
UniqSupply
(
UniqSupply
)
import
Bag
import
Util
...
...
@@ -113,7 +113,7 @@ Note [Join points]
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
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
example:
...
...
@@ -220,7 +220,7 @@ floatBind (NonRec (TB var _) rhs)
=
case
(
floatRhs
var
rhs
)
of
{
(
fs
,
rhs_floats
,
rhs'
)
->
-- 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'
|
otherwise
=
rhs'
...
...
@@ -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
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
important.)
...
...
@@ -408,7 +408,7 @@ floatExpr lam@(Lam (TB _ lam_spec) _)
bndrs
=
[
b
|
TB
b
_
<-
bndrs_w_lvls
]
bndr_lvl
=
asJoinCeilLvl
(
floatSpecLevel
lam_spec
)
-- All the binders have the same level
-- See SetLevels.lvlLamBndrs
-- See
GHC.Core.Op.
SetLevels.lvlLamBndrs
-- Use asJoinCeilLvl to make this the join ceiling
in
case
(
floatBody
bndr_lvl
body
)
of
{
(
fs
,
floats
,
body'
)
->
...
...
@@ -597,7 +597,7 @@ lifted to top level.
The trouble is that
(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!
That is why MajorEnv is represented as a finite map.
...
...
compiler/
simpl
Core/LiberateCase.hs
→
compiler/
GHC/
Core/
Op/
LiberateCase.hs
View file @
528df8ec
...
...
@@ -5,7 +5,7 @@
-}
{-# LANGUAGE CPP #-}
module
LiberateCase
(
liberateCase
)
where
module
GHC.Core.Op.
LiberateCase
(
liberateCase
)
where
#
include
"HsVersions.h"
...
...
compiler/
simplCore
/CoreMonad.hs
→
compiler/
GHC
/Core
/Op/
Monad.hs
View file @
528df8ec
{-
(c) The AQUA Project, Glasgow University, 1993-1998
\section[CoreMonad]{The core pipeline monad}
-}
{-# LANGUAGE CPP #-}
...
...
@@ -9,7 +8,7 @@
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module
Core
Monad
(
module
GHC.Core.Op.
Monad
(
-- * Configuration of the core-to-core passes
CoreToDo
(
..
),
runWhen
,
runMaybe
,
SimplMode
(
..
),
...
...
@@ -154,7 +153,7 @@ pprPassDetails (CoreDoSimplify n md) = vcat [ text "Max iterations =" <+> int n
,
ppr
md
]
pprPassDetails
_
=
Outputable
.
empty
data
SimplMode
-- See comments in SimplMonad
data
SimplMode
-- See comments in
GHC.Core.Op.
Simpl
ify.
Monad
=
SimplMode
{
sm_names
::
[
String
]
-- Name(s) of the phase
,
sm_phase
::
CompilerPhase
...
...
@@ -195,7 +194,7 @@ data FloatOutSwitches = FloatOutSwitches {
-- ^ True <=> float out over-saturated applications
-- based on arity information.
-- See Note [Floating over-saturated applications]
-- in SetLevels
-- in
GHC.Core.Op.
SetLevels
floatToTopLevelOnly
::
Bool
-- ^ Allow floating to the top level only.
}
instance
Outputable
FloatOutSwitches
where
...
...
compiler/
simplCore
/CoreMonad.hs-boot
→
compiler/
GHC
/Core
/Op/
Monad.hs-boot
View file @
528df8ec
-- Created this hs-boot file to remove circular dependencies from the use of
-- Plugins. Plugins needs CoreToDo and CoreM types to define core-to-core
-- transformations.
-- However
Core
Monad does much more than defining these, and because Plugins are
-- However
GHC.Core.Op.
Monad does much more than defining these, and because Plugins are
-- activated in various modules, the imports become circular. To solve this I
-- extracted CoreToDo and CoreM into this file.
-- I needed to write the whole definition of these types, otherwise it created
-- a data-newtype conflict.
module
Core
Monad
(
CoreToDo
,
CoreM
)
where
module
GHC.Core.Op.
Monad
(
CoreToDo
,
CoreM
)
where
import
GhcPrelude
...
...
compiler/
simpl
Core/OccurAnal.hs
→
compiler/
GHC/
Core/
Op/
OccurAnal.hs
View file @
528df8ec
...
...
@@ -15,7 +15,7 @@ core expression with (hopefully) improved usage information.
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module
OccurAnal
(
module
GHC.Core.Op.
OccurAnal
(
occurAnalysePgm
,
occurAnalyseExpr
,
occurAnalyseExpr_NoBinderSwap
)
where
...
...
@@ -302,7 +302,7 @@ But what is the graph? NOT the same graph as was used for Note
'f' that is *always* inlined if it is applicable. We do *not* disable
rules for loop-breakers. It's up to whoever makes the rules to make
sure that the rules themselves always terminate. See Note [Rules for
recursive functions] in Simplify
.hs
recursive functions] in
GHC.Core.Op.
Simplify
Hence, if
f's RHS (or its INLINE template if it has one) mentions g, and
...
...
@@ -647,7 +647,7 @@ Consider this group, which is typical of what SpecConstr builds:
So 'f' and 'fs' are in the same Rec group (since f refers to fs via its RULE).
But watch out! If 'fs' is not chosen as a loop breaker, we may get an infinite loop:
- the RULE is applied in f's RHS (see Note [Self-recursive rules] in Simplify
- the RULE is applied in f's RHS (see Note [Self-recursive rules] in
GHC.Core.Op.
Simplify
- fs is inlined (say it's small)
- now there's another opportunity to apply the RULE
...
...
@@ -1647,7 +1647,7 @@ So, when analysing the RHS of x3 we notice that x3 will itself
definitely inline the next time round, and so we analyse x3's rhs in
an ordinary context, not rhsCtxt. Hence the "certainly_inline" stuff.
Annoyingly, we have to approximate SimplUtils.preInlineUnconditionally.
Annoyingly, we have to approximate
GHC.Core.Op.
Simpl
ify.
Utils.preInlineUnconditionally.
If (a) the RHS is expandable (see isExpandableApp in occAnalApp), and
(b) certainly_inline says "yes" when preInlineUnconditionally says "no"
then the simplifier iterates indefinitely:
...
...
@@ -1871,7 +1871,7 @@ occAnalApp env (Var fun, args, ticks)
fun_uds
=
mkOneOcc
env
fun
(
if
n_val_args
>
0
then
IsInteresting
else
NotInteresting
)
n_args
is_exp
=
isExpandableApp
fun
n_val_args
-- See Note [CONLIKE pragma] in BasicTypes
-- The definition of is_exp should match that in Simplify.prepareRhs
-- The definition of is_exp should match that in
GHC.Core.Op.
Simplify.prepareRhs
one_shots
=
argsOneShots
(
idStrictness
fun
)
guaranteed_val_args
guaranteed_val_args
=
n_val_args
+
length
(
takeWhile
isOneShotInfo
...
...
compiler/
simpl
Core/SetLevels.hs
→
compiler/
GHC/
Core/
Op/
SetLevels.hs
View file @
528df8ec
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
\section{SetLevels}
\section{
GHC.Core.Op.
SetLevels}
***************************
Overview
...
...
@@ -52,7 +52,7 @@
{-# LANGUAGE CPP, MultiWayIf #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module
SetLevels
(
module
GHC.Core.Op.
SetLevels
(
setLevels
,
Level
(
..
),
LevelType
(
..
),
tOP_LEVEL
,
isJoinCeilLvl
,
asJoinCeilLvl
,
...
...
@@ -67,7 +67,7 @@ module SetLevels (
import
GhcPrelude
import
GHC.Core
import
CoreMonad
(
FloatOutSwitches
(
..
)
)
import
GHC.Core.Op.Monad
(
FloatOutSwitches
(
..
)
)
import
GHC.Core.Utils
(
exprType
,
exprIsHNF
,
exprOkForSpeculation
,
exprIsTopLevelBindable
...
...
@@ -178,7 +178,7 @@ But, check this out:
-- __inline (let x = e in \d. x)
-- things are bad. The inliner doesn't even inline it because it doesn't look
-- like a head-normal form. So it seems a lesser evil to let things float.
-- In SetLevels we do set the context to (Level 0 0) when we get to an InlineMe
-- In
GHC.Core.Op.
SetLevels we do set the context to (Level 0 0) when we get to an InlineMe
-- which discourages floating out.
So the conclusion is: don't do any floating at all inside an InlineMe.
...
...
@@ -375,7 +375,7 @@ lvlExpr env expr@(_, AnnLam {})
-- a lambda like this (\x -> coerce t (\s -> ...))
-- This used to happen quite a bit in state-transformer programs,
-- but not nearly so much now non-recursive newtypes are transparent.
-- [See SetLevels rev 1.50 for a version with this approach.]
-- [See
GHC.Core.Op.
SetLevels rev 1.50 for a version with this approach.]
lvlExpr
env
(
_
,
AnnLet
bind
body
)
=
do
{
(
bind'
,
new_env
)
<-
lvlBind
env
bind
...
...
@@ -434,7 +434,7 @@ lvlApp env orig_expr ((_,AnnVar fn), args)
left
n
(
_
,
AnnApp
f
a
)
rargs
|
isValArg
(
deAnnotate
a
)
=
left
(
n
-
1
)
f
(
a
:
rargs
)
|
otherwise
=
left
n
f
(
a
:
rargs
)
left
_
_
_
=
panic
"SetLevels.lvlExpr.left"
left
_
_
_
=
panic
"
GHC.Core.Op.
SetLevels.lvlExpr.left"
is_val_arg
::
CoreExprWithFVs
->
Bool
is_val_arg
(
_
,
AnnType
{})
=
False
...
...
@@ -950,8 +950,8 @@ Note [Bottoming floats: eta expansion] c.f Note [Bottoming floats]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Tiresomely, though, the simplifier has an invariant that the manifest
arity of the RHS should be the same as the arity; but we can't call
etaExpand during SetLevels because it works over a decorated form of
CoreExpr. So we do the eta expansion later, in FloatOut.
etaExpand during
GHC.Core.Op.
SetLevels because it works over a decorated form of
CoreExpr. So we do the eta expansion later, in
GHC.Core.Op.
FloatOut.
Note [Case MFEs]
~~~~~~~~~~~~~~~~
...
...
@@ -1140,7 +1140,7 @@ lvlBind env (AnnRec pairs)
-- This mightBeUnliftedType stuff is the same test as in the non-rec case
-- You might wonder whether we can have a recursive binding for
-- an unlifted value -- but we can if it's a /join binding/ (#16978)
-- (Ultimately I think we should not use SetLevels to
-- (Ultimately I think we should not use
GHC.Core.Op.
SetLevels to
-- float join bindings at all, but that's another story.)
=
-- No float
do
{
let
bind_lvl
=
incMinorLvl
(
le_ctxt_lvl
env
)
...
...
@@ -1399,7 +1399,7 @@ destLevel env fvs fvs_ty is_function is_bot is_join
=
tOP_LEVEL
|
is_join
-- Never float a join point past the join ceiling
-- See Note [Join points] in FloatOut
-- See Note [Join points] in
GHC.Core.Op.
FloatOut
=
if
max_fv_id_level
`
ltLvl
`
join_ceiling
then
join_ceiling