Commit d127a697 authored by parcs's avatar parcs

Merge remote-tracking branch 'origin/master' into ghc-parmake-gsoc

parents a2e338f3 32ade417
......@@ -1184,6 +1184,7 @@ AC_SUBST(GccLT46)
dnl Check to see if the C compiler is clang or llvm-gcc
dnl
GccIsClang=NO
AC_DEFUN([FP_CC_LLVM_BACKEND],
[AC_REQUIRE([AC_PROG_CC])
AC_MSG_CHECKING([whether C compiler is clang])
......@@ -1191,6 +1192,7 @@ $CC -x c /dev/null -dM -E > conftest.txt 2>&1
if grep "__clang__" conftest.txt >/dev/null 2>&1; then
AC_SUBST([CC_CLANG_BACKEND], [1])
AC_SUBST([CC_LLVM_BACKEND], [1])
GccIsClang=YES
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
......@@ -1205,6 +1207,7 @@ else
AC_MSG_RESULT([no])
fi
fi
AC_SUBST(GccIsClang)
rm -f conftest.txt
])
......@@ -2049,7 +2052,16 @@ AC_DEFUN([FIND_GCC],[
then
$1="$CC"
else
FP_ARG_WITH_PATH_GNU_PROG([$1], [$2], [$3])
FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([$1], [$2], [$3])
# From Xcode 5 on, OS X command line tools do not include gcc anymore. Use clang.
if test -z "$$1"
then
FP_ARG_WITH_PATH_GNU_PROG_OPTIONAL([$1], [clang], [clang])
fi
if test -z "$$1"
then
AC_MSG_ERROR([cannot find $3 nor clang in your PATH])
fi
fi
AC_SUBST($1)
])
......
......@@ -58,7 +58,7 @@ sub sanity_check_tree {
if (/^#/) {
# Comment; do nothing
}
elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+$/) {
elsif (/^([a-zA-Z0-9\/.-]+) +([^ ]+) +[^ ]+ +[^ ]+$/) {
$dir = $1;
$tag = $2;
......
......@@ -695,8 +695,7 @@ dataConArgUnpack arg_ty
-- An interface file specified Unpacked, but we couldn't unpack it
isUnpackableType :: FamInstEnvs -> Type -> Bool
-- True if we can unpack the UNPACK fields of the constructor
-- without involving the NameSet tycons
-- True if we can unpack the UNPACK the argument type
-- See Note [Recursive unboxing]
-- We look "deeply" inside rather than relying on the DataCons
-- we encounter on the way, because otherwise we might well
......@@ -730,9 +729,11 @@ isUnpackableType fam_envs ty
-- NB: dataConStrictMarks gives the *user* request;
-- We'd get a black hole if we used dataConRepBangs
attempt_unpack (HsUnpack {}) = True
attempt_unpack (HsUserBang (Just unpk) _) = unpk
attempt_unpack _ = False
attempt_unpack (HsUnpack {}) = True
attempt_unpack (HsUserBang (Just unpk) bang) = bang && unpk
attempt_unpack (HsUserBang Nothing bang) = bang -- Be conservative
attempt_unpack HsStrict = False
attempt_unpack HsNoBang = False
\end{code}
Note [Unpack one-wide fields]
......@@ -761,14 +762,26 @@ Here we can represent T with an Int#.
Note [Recursive unboxing]
~~~~~~~~~~~~~~~~~~~~~~~~~
Be careful not to try to unbox this!
data T = MkT {-# UNPACK #-} !T Int
Reason: consider
Consider
data R = MkR {-# UNPACK #-} !S Int
data S = MkS {-# UNPACK #-} !Int
The representation arguments of MkR are the *representation* arguments
of S (plus Int); the rep args of MkS are Int#. This is obviously no
good for T, because then we'd get an infinite number of arguments.
of S (plus Int); the rep args of MkS are Int#. This is all fine.
But be careful not to try to unbox this!
data T = MkT {-# UNPACK #-} !T Int
Because then we'd get an infinite number of arguments.
Here is a more complicated case:
data S = MkS {-# UNPACK #-} !T Int
data T = MkT {-# UNPACK #-} !S Int
Each of S and T must decide independendently whether to unpack
and they had better not both say yes. So they must both say no.
Also behave conservatively when there is no UNPACK pragma
data T = MkS !T Int
with -funbox-strict-fields or -funbox-small-strict-fields
we need to behave as if there was an UNPACK pragma there.
But it's the *argument* type that matters. This is fine:
data S = MkS S !Int
......
......@@ -52,7 +52,7 @@ data CmmNode e x where
[CmmActual] -> -- zero or more arguments
CmmNode O O
-- Semantics: clobbers any GlobalRegs for which callerSaves r == True
-- See Note [foreign calls clobber GlobalRegs]
-- See Note [Unsafe foreign calls clobber caller-save registers]
--
-- Invariant: the arguments and the ForeignTarget must not
-- mention any registers for which CodeGen.Platform.callerSaves
......@@ -158,8 +158,8 @@ made manifest in CmmLayoutStack, where they are lowered into the above
sequence.
-}
{- Note [foreign calls clobber GlobalRegs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{- Note [Unsafe foreign calls clobber caller-save registers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A foreign call is defined to clobber any GlobalRegs that are mapped to
caller-saves machine registers (according to the prevailing C ABI).
......@@ -329,8 +329,9 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where
foldRegsDefd dflags f z n = case n of
CmmAssign lhs _ -> fold f z lhs
CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt)
CmmCall {} -> fold f z activeRegs
CmmForeignCall {tgt=tgt} -> fold f z (foreignTargetRegs tgt)
CmmCall {} -> fold f z activeRegs
CmmForeignCall {} -> fold f z activeRegs
-- See Note [Safe foreign calls clobber STG registers]
_ -> z
where fold :: forall a b.
DefinerOfRegs GlobalReg a =>
......@@ -344,6 +345,74 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where
foreignTargetRegs (ForeignTarget _ (ForeignConvention _ _ _ CmmNeverReturns)) = []
foreignTargetRegs _ = activeCallerSavesRegs
-- Note [Safe foreign calls clobber STG registers]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- During stack layout phase every safe foreign call is expanded into a block
-- that contains unsafe foreign call (instead of safe foreign call) and ends
-- with a normal call (See Note [Foreign calls]). This means that we must
-- treat safe foreign call as if it was a normal call (because eventually it
-- will be). This is important if we try to run sinking pass before stack
-- layout phase. Consider this example of what might go wrong (this is cmm
-- code from stablename001 test). Here is code after common block elimination
-- (before stack layout):
--
-- c1q6:
-- _s1pf::P64 = R1;
-- _c1q8::I64 = performMajorGC;
-- I64[(young<c1q9> + 8)] = c1q9;
-- foreign call "ccall" arg hints: [] result hints: [] (_c1q8::I64)(...)
-- returns to c1q9 args: ([]) ress: ([])ret_args: 8ret_off: 8;
-- c1q9:
-- I64[(young<c1qb> + 8)] = c1qb;
-- R1 = _s1pc::P64;
-- call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;
--
-- If we run sinking pass now (still before stack layout) we will get this:
--
-- c1q6:
-- I64[(young<c1q9> + 8)] = c1q9;
-- foreign call "ccall" arg hints: [] result hints: [] performMajorGC(...)
-- returns to c1q9 args: ([]) ress: ([])ret_args: 8ret_off: 8;
-- c1q9:
-- I64[(young<c1qb> + 8)] = c1qb;
-- _s1pf::P64 = R1; <------ _s1pf sunk past safe foreign call
-- R1 = _s1pc::P64;
-- call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;
--
-- Notice that _s1pf was sunk past a foreign call. When we run stack layout
-- safe call to performMajorGC will be turned into:
--
-- c1q6:
-- _s1pc::P64 = P64[Sp + 8];
-- I64[Sp - 8] = c1q9;
-- Sp = Sp - 8;
-- I64[I64[CurrentTSO + 24] + 16] = Sp;
-- P64[CurrentNursery + 8] = Hp + 8;
-- (_u1qI::I64) = call "ccall" arg hints: [PtrHint,]
-- result hints: [PtrHint] suspendThread(BaseReg, 0);
-- call "ccall" arg hints: [] result hints: [] performMajorGC();
-- (_u1qJ::I64) = call "ccall" arg hints: [PtrHint]
-- result hints: [PtrHint] resumeThread(_u1qI::I64);
-- BaseReg = _u1qJ::I64;
-- _u1qK::P64 = CurrentTSO;
-- _u1qL::P64 = I64[_u1qK::P64 + 24];
-- Sp = I64[_u1qL::P64 + 16];
-- SpLim = _u1qL::P64 + 192;
-- HpAlloc = 0;
-- Hp = I64[CurrentNursery + 8] - 8;
-- HpLim = I64[CurrentNursery] + (%MO_SS_Conv_W32_W64(I32[CurrentNursery + 48]) * 4096 - 1);
-- call (I64[Sp])() returns to c1q9, args: 8, res: 8, upd: 8;
-- c1q9:
-- I64[(young<c1qb> + 8)] = c1qb;
-- _s1pf::P64 = R1; <------ INCORRECT!
-- R1 = _s1pc::P64;
-- call stg_makeStableName#(R1) returns to c1qb, args: 8, res: 8, upd: 8;
--
-- Notice that c1q6 now ends with a call. Sinking _s1pf::P64 = R1 past that
-- call is clearly incorrect. This is what would happen if we assumed that
-- safe foreign call has the same semantics as unsafe foreign call. To prevent
-- this we need to treat safe foreign call as if was normal call.
-----------------------------------
-- mapping Expr in CmmNode
......@@ -429,6 +498,8 @@ foldExpForeignTarget exp (ForeignTarget e _) z = exp e z
foldExpForeignTarget _ (PrimTarget _) z = z
-- Take a folder on expressions and apply it recursively.
-- Specifically (wrapRecExpf f e z) deals with CmmMachOp and CmmLoad
-- itself, delegating all the other CmmExpr forms to 'f'.
wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
wrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)
......
......@@ -43,38 +43,52 @@ import qualified Data.Set as Set
--
-- * Start by doing liveness analysis.
--
-- * Keep a list of assignments A; earlier ones may refer to later ones
-- * Keep a list of assignments A; earlier ones may refer to later ones.
-- Currently we only sink assignments to local registers, because we don't
-- have liveness information about global registers.
--
-- * Walk forwards through the graph, look at each node N:
-- * If any assignments in A (1) occur only once in N, and (2) are
-- not live after N, inline the assignment and remove it
-- from A.
-- * If N is an assignment:
-- * If the register is not live after N, discard it
-- * otherwise pick up the assignment and add it to A
-- * If N is a non-assignment node:
--
-- * If it is a dead assignment, i.e. assignment to a register that is
-- not used after N, discard it.
--
-- * Try to inline based on current list of assignments
-- * If any assignments in A (1) occur only once in N, and (2) are
-- not live after N, inline the assignment and remove it
-- from A.
--
-- * If an assignment in A is cheap (RHS is local register), then
-- inline the assignment and keep it in A in case it is used afterwards.
--
-- * Otherwise don't inline.
--
-- * If N is assignment to a local register pick up the assignment
-- and add it to A.
--
-- * If N is not an assignment to a local register:
-- * remove any assignments from A that conflict with N, and
-- place them before N in the current block. (we call this
-- "dropping" the assignments).
-- place them before N in the current block. We call this
-- "dropping" the assignments.
--
-- * An assignment conflicts with N if it:
-- - assigns to a register mentioned in N
-- - mentions a register assigned by N
-- - reads from memory written by N
-- * do this recursively, dropping dependent assignments
-- * At a multi-way branch:
-- * drop any assignments that are live on more than one branch
-- * if any successor has more than one predecessor (a
-- join-point), drop everything live in that successor
--
-- As a side-effect we'll delete some dead assignments (transitively,
-- even). This isn't as good as removeDeadAssignments, but it's much
-- cheaper.
-- If we do this *before* stack layout, we might be able to avoid
-- saving some things across calls/procpoints.
--
-- *but*, that will invalidate the liveness analysis, and we'll have
-- to re-do it.
-- * At an exit node:
-- * drop any assignments that are live on more than one successor
-- and are not trivial
-- * if any successor has more than one predecessor (a join-point),
-- drop everything live in that successor. Since we only propagate
-- assignments that are not dead at the successor, we will therefore
-- eliminate all assignments dead at this point. Thus analysis of a
-- join-point will always begin with an empty list of assignments.
--
--
-- As a result of above algorithm, sinking deletes some dead assignments
-- (transitively, even). This isn't as good as removeDeadAssignments,
-- but it's much cheaper.
-- -----------------------------------------------------------------------------
-- things that we aren't optimising very well yet.
......@@ -122,6 +136,12 @@ type Assignment = (LocalReg, CmmExpr, AbsMem)
-- Assignment caches AbsMem, an abstraction of the memory read by
-- the RHS of the assignment.
type Assignments = [Assignment]
-- A sequence of assignements; kept in *reverse* order
-- So the list [ x=e1, y=e2 ] means the sequence of assignments
-- y = e2
-- x = e1
cmmSink :: DynFlags -> CmmGraph -> CmmGraph
cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
where
......@@ -132,7 +152,7 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
join_pts = findJoinPoints blocks
sink :: BlockEnv [Assignment] -> [CmmBlock] -> [CmmBlock]
sink :: BlockEnv Assignments -> [CmmBlock] -> [CmmBlock]
sink _ [] = []
sink sunk (b:bs) =
-- pprTrace "sink" (ppr lbl) $
......@@ -209,7 +229,8 @@ isSmall _ = False
isTrivial :: CmmExpr -> Bool
isTrivial (CmmReg (CmmLocal _)) = True
-- isTrivial (CmmLit _) = True
-- isTrivial (CmmLit _) = True -- Disabled because it used to make thing worse.
-- Needs further investigation
isTrivial _ = False
--
......@@ -234,7 +255,7 @@ findJoinPoints blocks = mapFilter (>1) succ_counts
-- filter the list of assignments to remove any assignments that
-- are not live in a continuation.
--
filterAssignments :: DynFlags -> LocalRegSet -> [Assignment] -> [Assignment]
filterAssignments :: DynFlags -> LocalRegSet -> Assignments -> Assignments
filterAssignments dflags live assigs = reverse (go assigs [])
where go [] kept = kept
go (a@(r,_,_):as) kept | needed = go as (a:kept)
......@@ -249,26 +270,36 @@ filterAssignments dflags live assigs = reverse (go assigs [])
-- -----------------------------------------------------------------------------
-- Walk through the nodes of a block, sinking and inlining assignments
-- as we go.
--
-- On input we pass in a:
-- * list of nodes in the block
-- * a list of assignments that appeared *before* this block and
-- that are being sunk.
--
-- On output we get:
-- * a new block
-- * a list of assignments that will be placed *after* that block.
--
walk :: DynFlags
-> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with
-- the set of registers live *after*
-- this node.
-> [Assignment] -- The current list of
-> Assignments -- The current list of
-- assignments we are sinking.
-- Later assignments may refer
-- to earlier ones.
-> ( Block CmmNode O O -- The new block
, [Assignment] -- Assignments to sink further
, Assignments -- Assignments to sink further
)
walk dflags nodes assigs = go nodes emptyBlock assigs
where
go [] block as = (block, as)
go ((live,node):ns) block as
| shouldDiscard node live = go ns block as
| shouldDiscard node live = go ns block as -- discard dead assignment
| Just a <- shouldSink dflags node2 = go ns block (a : as1)
| otherwise = go ns block' as'
where
......@@ -316,17 +347,17 @@ shouldDiscard node live
CmmAssign r (CmmReg r') | r == r' -> True
CmmAssign (CmmLocal r) _ -> not (r `Set.member` live)
_otherwise -> False
toNode :: Assignment -> CmmNode O O
toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs
dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> [Assignment]
-> ([CmmNode O O], [Assignment])
dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> Assignments
-> ([CmmNode O O], Assignments)
dropAssignmentsSimple dflags f = dropAssignments dflags (\a _ -> (f a, ())) ()
dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> [Assignment]
-> ([CmmNode O O], [Assignment])
dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> Assignments
-> ([CmmNode O O], Assignments)
dropAssignments dflags should_drop state assigs
= (dropped, reverse kept)
where
......@@ -351,16 +382,16 @@ tryToInline
-- that is live after the node, unless
-- it is small enough to duplicate.
-> CmmNode O x -- The node to inline into
-> [Assignment] -- Assignments to inline
-> Assignments -- Assignments to inline
-> (
CmmNode O x -- New node
, [Assignment] -- Remaining assignments
, Assignments -- Remaining assignments
)
tryToInline dflags live node assigs = go usages node [] assigs
where
usages :: UniqFM Int
usages = foldRegsUsed dflags addUsage emptyUFM node
usages :: UniqFM Int -- Maps each LocalReg to a count of how often it is used
usages = foldLocalRegsUsed dflags addUsage emptyUFM node
go _usages node _skipped [] = (node, [])
......@@ -371,10 +402,10 @@ tryToInline dflags live node assigs = go usages node [] assigs
| otherwise = dont_inline
where
inline_and_discard = go usages' inl_node skipped rest
where usages' = foldRegsUsed dflags addUsage usages rhs
where usages' = foldLocalRegsUsed dflags addUsage usages rhs
dont_inline = keep node -- don't inline the assignment, keep it
inline_and_keep = keep inl_node -- inline the assignment, keep it
dont_inline = keep node -- don't inline the assignment, keep it
inline_and_keep = keep inl_node -- inline the assignment, keep it
keep node' = (final_node, a : rest')
where (final_node, rest') = go usages' node' (l:skipped) rest
......@@ -470,10 +501,10 @@ conflicts dflags (r, rhs, addr) node
| SpMem{} <- addr, CmmAssign (CmmGlobal Sp) _ <- node = True
-- (4) assignments that read caller-saves GlobalRegs conflict with a
-- foreign call. See Note [foreign calls clobber GlobalRegs].
-- foreign call. See Note [Unsafe foreign calls clobber caller-save registers]
| CmmUnsafeForeignCall{} <- node, anyCallerSavesRegs dflags rhs = True
-- (5) foreign calls clobber heap: see Note [foreign calls clobber heap]
-- (5) foreign calls clobber heap: see Note [Foreign calls clobber heap]
| CmmUnsafeForeignCall{} <- node, memConflicts addr AnyMem = True
-- (6) native calls clobber any memory
......@@ -532,7 +563,8 @@ data AbsMem
-- that was written in the same basic block. To take advantage of
-- non-aliasing of heap memory we will have to be more clever.
-- Note [foreign calls clobber]
-- Note [Foreign calls clobber heap]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- It is tempting to say that foreign calls clobber only
-- non-heap/stack memory, but unfortunately we break this invariant in
......
......@@ -11,7 +11,7 @@ module StgCmm ( codeGen ) where
#define FAST_STRING_NOT_NEEDED
#include "HsVersions.h"
import StgCmmProf
import StgCmmProf (initCostCentres, ldvEnter)
import StgCmmMonad
import StgCmmEnv
import StgCmmBind
......
......@@ -20,7 +20,8 @@ import StgCmmMonad
import StgCmmEnv
import StgCmmCon
import StgCmmHeap
import StgCmmProf
import StgCmmProf (curCCS, ldvEnterClosure, enterCostCentreFun, enterCostCentreThunk,
initUpdFrameProf, costCentreFrom)
import StgCmmTicky
import StgCmmLayout
import StgCmmUtils
......
......@@ -23,7 +23,7 @@ import StgCmmEnv
import StgCmmHeap
import StgCmmUtils
import StgCmmClosure
import StgCmmProf
import StgCmmProf ( curCCS )
import CmmExpr
import CLabel
......
......@@ -17,7 +17,7 @@ import StgCmmMonad
import StgCmmHeap
import StgCmmEnv
import StgCmmCon
import StgCmmProf
import StgCmmProf (saveCurrentCostCentre, restoreCurrentCostCentre, emitSetCCC)
import StgCmmLayout
import StgCmmPrim
import StgCmmHpc
......
......@@ -18,7 +18,7 @@ module StgCmmForeign (
#include "HsVersions.h"
import StgSyn
import StgCmmProf
import StgCmmProf (storeCurCCS, ccsType, curCCS)
import StgCmmEnv
import StgCmmMonad
import StgCmmUtils
......
......@@ -28,7 +28,7 @@ import CLabel
import StgCmmLayout
import StgCmmUtils
import StgCmmMonad
import StgCmmProf
import StgCmmProf (profDynAlloc, dynProfHdr, staticProfHdr)
import StgCmmTicky
import StgCmmClosure
import StgCmmEnv
......
......@@ -29,7 +29,7 @@ import StgCmmArgRep -- notably: ( slowCallPattern )
import StgCmmTicky
import StgCmmMonad
import StgCmmUtils
import StgCmmProf
import StgCmmProf (curCCS)
import MkGraph
import SMRep
......
......@@ -21,7 +21,7 @@ import StgCmmMonad
import StgCmmUtils
import StgCmmTicky
import StgCmmHeap
import StgCmmProf
import StgCmmProf ( costCentreFrom, curCCS )
import DynFlags
import Platform
......
......@@ -16,7 +16,7 @@ A ``lint'' pass to check for Core correctness
{-# OPTIONS_GHC -fprof-auto #-}
module CoreLint ( lintCoreBindings, lintUnfolding ) where
module CoreLint ( lintCoreBindings, lintUnfolding, lintExpr ) where
#include "HsVersions.h"
......@@ -120,14 +120,15 @@ find an occurence of an Id, we fetch it from the in-scope set.
\begin{code}
lintCoreBindings :: CoreProgram -> (Bag MsgDoc, Bag MsgDoc)
lintCoreBindings :: [Var] -> CoreProgram -> (Bag MsgDoc, Bag MsgDoc)
-- Returns (warnings, errors)
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism]
lintCoreBindings binds
lintCoreBindings local_in_scope binds
= initL $
addLoc TopLevelBindings $
addInScopeVars binders $
addLoc TopLevelBindings $
addInScopeVars local_in_scope $
addInScopeVars binders $
-- Put all the top-level binders in scope at the start
-- This is because transformation rules can bring something
-- into use 'unexpectedly'
......@@ -178,6 +179,18 @@ lintUnfolding locn vars expr
(_warns, errs) = initL (addLoc (ImportedUnfolding locn) $
addInScopeVars vars $
lintCoreExpr expr)
lintExpr :: [Var] -- Treat these as in scope
-> CoreExpr
-> Maybe MsgDoc -- Nothing => OK
lintExpr vars expr
| isEmptyBag errs = Nothing
| otherwise = Just (pprMessageBag errs)
where
(_warns, errs) = initL (addLoc TopLevelBindings $
addInScopeVars vars $
lintCoreExpr expr)
\end{code}
%************************************************************************
......
......@@ -172,7 +172,7 @@ corePrepPgm dflags hsc_env binds data_tycons = do
floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds
return (deFloatTop (floats1 `appendFloats` floats2))
endPass dflags CorePrep binds_out []
endPass hsc_env CorePrep binds_out []
return binds_out
corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr
......
......@@ -714,7 +714,9 @@ data Unfolding
------------------------------------------------
data UnfoldingSource
= InlineRhs -- The current rhs of the function
= -- See also Note [Historical note: unfoldings for wrappers]
InlineRhs -- The current rhs of the function
-- Replace uf_tmpl each time around
| InlineStable -- From an INLINE or INLINABLE pragma
......@@ -739,13 +741,6 @@ data UnfoldingSource
-- (see MkId.lhs, calls to mkCompulsoryUnfolding).
-- Inline absolutely always, however boring the context.
| InlineWrapper -- This unfolding is the wrapper in a
-- worker/wrapper split from the strictness
-- analyser
--
-- cf some history in TcIface's Note [wrappers
-- in interface files]
-- | 'UnfoldingGuidance' says when unfolding should take place
......@@ -775,6 +770,25 @@ data UnfoldingGuidance
| UnfNever -- The RHS is big, so don't inline it
\end{code}
Note [Historical note: unfoldings for wrappers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used to have a nice clever scheme in interface files for
wrappers. A wrapper's unfolding can be reconstructed from its worker's
id and its strictness. This decreased .hi file size (sometimes
significantly, for modules like GHC.Classes with many high-arity w/w
splits) and had a slight corresponding effect on compile times.
However, when we added the second demand analysis, this scheme lead to
some Core lint errors. The second analysis could change the strictness
signatures, which sometimes resulted in a wrapper's regenerated
unfolding applying the wrapper to too many arguments.