Commit d127a697 authored by parcs's avatar parcs
Browse files

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.