Commit c1d4bc17 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Merge branch 'master' of darcs.haskell.org:/srv/darcs//ghc

parents 0b6336a2 6181e007
......@@ -84,6 +84,7 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds =
, declPath = []
, tte_dflags = dflags
, exports = exports
, inlines = emptyVarSet
, inScope = emptyVarSet
, blackList = Map.fromList
[ (getSrcSpan (tyConName tyCon),())
......@@ -231,6 +232,7 @@ addTickLHsBind :: LHsBind Id -> TM (LHsBind Id)
addTickLHsBind (L pos bind@(AbsBinds { abs_binds = binds,
abs_exports = abs_exports })) = do
withEnv add_exports $ do
withEnv add_inlines $ do
binds' <- addTickLHsBinds binds
return $ L pos $ bind { abs_binds = binds' }
where
......@@ -245,9 +247,24 @@ addTickLHsBind (L pos bind@(AbsBinds { abs_binds = binds,
| ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
, idName pid `elemNameSet` (exports env) ] }
add_inlines env =
env{ inlines = inlines env `extendVarSetList`
[ mid
| ABE{ abe_poly = pid, abe_mono = mid } <- abs_exports
, isAnyInlinePragma (idInlinePragma pid) ] }
addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
let name = getOccString id
decl_path <- getPathEntry
density <- getDensity
inline_ids <- liftM inlines getEnv
let inline = isAnyInlinePragma (idInlinePragma id)
|| id `elemVarSet` inline_ids
-- See Note [inline sccs]
if inline && opt_SccProfilingOn then return (L pos funBind) else do
(fvs, (MatchGroup matches' ty)) <-
getFreeVars $
......@@ -255,7 +272,6 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
addTickMatchGroup False (fun_matches funBind)
blackListed <- isBlackListed pos
density <- getDensity
exported_names <- liftM exports getEnv
-- We don't want to generate code for blacklisted positions
......@@ -264,8 +280,6 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do
let simple = isSimplePatBind funBind
toplev = null decl_path
exported = idName id `elemNameSet` exported_names
inline = {- pprTrace "inline" (ppr id <+> ppr (idInlinePragma id)) $ -}
isAnyInlinePragma (idInlinePragma id)
tick <- if not blackListed &&
shouldTickBind density toplev exported simple inline
......@@ -321,6 +335,21 @@ bindTick density name pos fvs = do
allocATickBox box_label count_entries top_only pos fvs
-- Note [inline sccs]
--
-- It should be reasonable to add ticks to INLINE functions; however
-- currently this tickles a bug later on because the SCCfinal pass
-- does not look inside unfoldings to find CostCentres. It would be
-- difficult to fix that, because SCCfinal currently works on STG and
-- not Core (and since it also generates CostCentres for CAFs,
-- changing this would be difficult too).
--
-- Another reason not to add ticks to INLINE functions is that this
-- sometimes handy for avoiding adding a tick to a particular function
-- (see #6131)
--
-- So for now we do not add any ticks to INLINE functions at all.
-- -----------------------------------------------------------------------------
-- Decorate an LHsExpr with ticks
......@@ -869,6 +898,7 @@ data TickTransEnv = TTE { fileName :: FastString
, density :: TickDensity
, tte_dflags :: DynFlags
, exports :: NameSet
, inlines :: VarSet
, declPath :: [String]
, inScope :: VarSet
, blackList :: Map SrcSpan ()
......
......@@ -1095,8 +1095,6 @@ data RecompileRequired
| RecompBecause String
-- ^ The .o/.hi files are up to date, but something else has changed
-- to force recompilation; the String says what (one-line summary)
| RecompForcedByTH
-- ^ recompile is forced due to use of TH by the module
deriving Eq
recompileRequired :: RecompileRequired -> Bool
......
......@@ -625,7 +625,7 @@ genericHscCompile compiler hscMessage hsc_env
case mb_checked_iface of
Just iface | not (recompileRequired recomp_reqd) ->
if mi_used_th iface && not stable
then compile RecompForcedByTH
then compile (RecompBecause "TH")
else skip iface
_otherwise ->
compile recomp_reqd
......@@ -851,7 +851,6 @@ batchMsg hsc_env mb_mod_index recomp mod_summary =
| verbosity (hsc_dflags hsc_env) >= 2 -> showMsg "Skipping " ""
| otherwise -> return ()
RecompBecause reason -> showMsg "Compiling " (" [" ++ reason ++ "]")
RecompForcedByTH -> showMsg "Compiling " " [TH]"
where
dflags = hsc_dflags hsc_env
showMsg msg reason =
......
......@@ -1177,7 +1177,7 @@ chooseBoxingStrategy arg_ty bang
-- representation of the argument type
-- However: even when OmitInterfacePragmas is on, we still want
-- to know if we have HsUnpackFailed, because we omit a
-- warning in that case (#3676)
-- warning in that case (#3966)
HsUnpackFailed -> pprPanic "chooseBoxingStrategy" (ppr arg_ty)
-- Source code never has shtes
where
......
......@@ -975,14 +975,59 @@ rec { b &lt;- f a c ===> (b,c) &lt;- mfix (\~(b,c) -> do { b &lt;- f a c
</para>
<para>
The <literal>mdo</literal>-notation removes the burden of placing explicit <literal>rec</literal> blocks in the code.
It automatically identifies minimally dependent recursive groups, treating them as if the user wrapped a
<literal>rec</literal> qualified around them. The definition of <emphasis>minimal</emphasis> in this context
is syntax oriented: Two bindings are called dependent if the latter one uses a variable defined by the former. Furthermore,
if a binding is dependent on another, then all the bindings that textually appear in between them are dependent on each other
as well. A minimally dependent group of bindings is simply a contagious group where none of the textually following
bindings depend on it. (Segments in this sense are related to <emphasis>strongly-connected components</emphasis>
analysis, with the exception that bindings in a segment cannot be reordered and has to be contagious.)
The <literal>mdo</literal> notation removes the burden of placing
explicit <literal>rec</literal> blocks in the code. Unlike an
ordinary <literal>do</literal> expression, in which variables bound by
statements are only in scope for later statements, variables bound in
an <literal>mdo</literal> expression are in scope for all statements
of the expression. The compiler then automatically identifies minimal
mutually recursively dependent segments of statements, treating them as
if the user had wrapped a <literal>rec</literal> qualifier around them.
</para>
<para>
The definition is syntactic:
</para>
<itemizedlist>
<listitem>
<para>
A generator <replaceable>g</replaceable>
<emphasis>depends</emphasis> on a textually following generator
<replaceable>g'</replaceable>, if
</para>
<itemizedlist>
<listitem>
<para>
<replaceable>g'</replaceable> defines a variable that
is used by <replaceable>g</replaceable>, or
</para>
</listitem>
<listitem>
<para>
<replaceable>g'</replaceable> textually appears between
<replaceable>g</replaceable> and
<replaceable>g''</replaceable>, where <replaceable>g</replaceable>
depends on <replaceable>g''</replaceable>.
</para>
</listitem>
</itemizedlist>
</listitem>
<listitem>
<para>
A <emphasis>segment</emphasis> of a given
<literal>mdo</literal>-expression is a minimal sequence of generators
such that no generator of the sequence depends on an outside
generator. As a special case, although it is not a generator,
the final expression in an <literal>mdo</literal>-expression is
considered to form a segment by itself.
</para>
</listitem>
</itemizedlist>
<para>
Segments in this sense are
related to <emphasis>strongly-connected components</emphasis> analysis,
with the exception that bindings in a segment cannot be reordered and
must be contiguous.
</para>
<para>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment