ty = exprType fun
ignore_note (CoreNote _) = True
- ignore_note InlineCall = True
ignore_note InlineMe = True
ignore_note _other = False
-- We don't ignore SCCs, since they require some code generation
Type -- The to-type: type of whole coerce expression
Type -- The from-type: type of enclosed expression
- | InlineCall -- Instructs simplifier to inline
- -- the enclosed call
-
| InlineMe -- Instructs simplifer to treat the enclosed expression
-- as very small, and inline it at its call sites
\begin{code}
callSiteInline :: DynFlags
-> Bool -- True <=> the Id can be inlined
- -> Bool -- 'inline' note at call site
-> OccInfo
-> Id -- The Id
-> [Bool] -- One for each value arg; True if it is interesting
-> Maybe CoreExpr -- Unfolding, if any
-callSiteInline dflags active_inline inline_call occ id arg_infos interesting_cont
+callSiteInline dflags active_inline occ id arg_infos interesting_cont
= case idUnfolding id of {
NoUnfolding -> Nothing ;
OtherCon cs -> Nothing ;
-- consider_safe decides whether it's a good idea to
-- inline something, given that there's no
-- work-duplication issue (the caller checks that).
- | inline_call = True
-
- | otherwise
= case guidance of
UnfoldNever -> False
UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
mkNote InlineMe expr = mkInlineMe expr
mkNote note expr = Note note expr
#endif
-
--- Slide InlineCall in around the function
--- No longer necessary I think (SLPJ Apr 99)
--- mkNote InlineCall (App f a) = App (mkNote InlineCall f) a
--- mkNote InlineCall (Var v) = Note InlineCall (Var v)
--- mkNote InlineCall expr = expr
\end{code}
Drop trivial InlineMe's. This is somewhat important, because if we have an unfolding
eq_note env (SCC cc1) (SCC cc2) = cc1 == cc2
eq_note env (Coerce t1 f1) (Coerce t2 f2) = tcEqTypeX env t1 t2 && tcEqTypeX env f1 f2
-eq_note env InlineCall InlineCall = True
eq_note env (CoreNote s1) (CoreNote s2) = s1 == s2
eq_note env other1 other2 = False
\end{code}
noteSize (SCC cc) = cc `seq` 1
noteSize (Coerce t1 t2) = seqType t1 `seq` seqType t2 `seq` 1
-noteSize InlineCall = 1
noteSize InlineMe = 1
noteSize (CoreNote s) = s `seq` 1 -- hdaume: core annotations
make_exp (Case e v ty alts) = C.Case (make_exp e) (make_vbind v) (make_ty ty) (map make_alt alts)
make_exp (Note (SCC cc) e) = C.Note "SCC" (make_exp e) -- temporary
make_exp (Note (Coerce t_to t_from) e) = C.Coerce (make_ty t_to) (make_exp e)
-make_exp (Note InlineCall e) = C.Note "InlineCall" (make_exp e)
make_exp (Note (CoreNote s) e) = C.Note s (make_exp e) -- hdaume: core annotations
make_exp (Note InlineMe e) = C.Note "InlineMe" (make_exp e)
make_exp _ = error "MkExternalCore died: make_exp"
pprParendExpr expr]
#endif
-ppr_expr add_par (Note InlineCall expr)
- = add_par (ptext SLIT("__inline_call") <+> pprParendExpr expr)
-
ppr_expr add_par (Note InlineMe expr)
= add_par $ ptext SLIT("__inline_me") <+> pprParendExpr expr
tyVarsOfType, mkForAllTys, mkTyConApp,
isPrimitiveType, splitTyConApp_maybe,
splitRecNewType_maybe, splitForAllTy_maybe,
- isUnboxedTupleType, coreView
+ isUnboxedTupleType
)
import PrimOp ( PrimOp(..) )
)
import BasicTypes ( Boxity(..) )
import Literal ( mkMachInt )
-import PrelNames ( Unique, hasKey, ioTyConKey, boolTyConKey, unitTyConKey,
+import PrelNames ( Unique, hasKey, boolTyConKey, unitTyConKey,
int8TyConKey, int16TyConKey, int32TyConKey,
word8TyConKey, word16TyConKey, word32TyConKey
-- dotnet interop
put_ bh (IfaceCoerce ab) = do
putByte bh 1
put_ bh ab
- put_ bh IfaceInlineCall = do
- putByte bh 2
put_ bh IfaceInlineMe = do
putByte bh 3
put_ bh (IfaceCoreNote s) = do
return (IfaceSCC aa)
1 -> do ab <- get bh
return (IfaceCoerce ab)
- 2 -> do return IfaceInlineCall
3 -> do return IfaceInlineMe
_ -> do ac <- get bh
return (IfaceCoreNote ac)
data IfaceNote = IfaceSCC CostCentre
| IfaceCoerce IfaceType
- | IfaceInlineCall
| IfaceInlineMe
| IfaceCoreNote String
instance Outputable IfaceNote where
ppr (IfaceSCC cc) = pprCostCentreCore cc
ppr (IfaceCoerce ty) = ptext SLIT("__coerce") <+> pprParendIfaceType ty
- ppr IfaceInlineCall = ptext SLIT("__inline_call")
ppr IfaceInlineMe = ptext SLIT("__inline_me")
ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
---------------------
toIfaceNote ext (SCC cc) = IfaceSCC cc
toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
-toIfaceNote ext InlineCall = IfaceInlineCall
toIfaceNote ext InlineMe = IfaceInlineMe
toIfaceNote ext (CoreNote s) = IfaceCoreNote s
eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
eq_ifaceNote env (IfaceSCC c1) (IfaceSCC c2) = bool (c1==c2)
eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2) = eq_ifType env t1 t2
-eq_ifaceNote env IfaceInlineCall IfaceInlineCall = Equal
eq_ifaceNote env IfaceInlineMe IfaceInlineMe = Equal
eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
eq_ifaceNote env _ _ = NotEqual
IfaceCoerce to_ty -> tcIfaceType to_ty `thenM` \ to_ty' ->
returnM (Note (Coerce to_ty'
(exprType expr')) expr')
- IfaceInlineCall -> returnM (Note InlineCall expr')
IfaceInlineMe -> returnM (Note InlineMe expr')
IfaceSCC cc -> returnM (Note (SCC cc) expr')
IfaceCoreNote n -> returnM (Note (CoreNote n) expr')
unpackCStringUtf8Name = varQual pREL_BASE FSLIT("unpackCStringUtf8#") unpackCStringUtf8IdKey
eqStringName = varQual pREL_BASE FSLIT("eqString") eqStringIdKey
+-- The 'inline' function
+inlineIdName = varQual pREL_BASE FSLIT("inline") inlineIdKey
+
-- Base classes (Eq, Ord, Functor)
eqClassName = clsQual pREL_BASE FSLIT("Eq") eqClassKey
eqName = methName eqClassName FSLIT("==") eqClassOpKey
breakpointJumpIdKey = mkPreludeMiscIdUnique 64
breakpointCondJumpIdKey = mkPreludeMiscIdUnique 65
+inlineIdKey = mkPreludeMiscIdUnique 66
+
-- Parallel array functions
nullPIdKey = mkPreludeMiscIdUnique 80
lengthPIdKey = mkPreludeMiscIdUnique 81
#include "HsVersions.h"
import CoreSyn
-import Id ( mkWildId, isPrimOpId_maybe )
+import Id ( mkWildId, isPrimOpId_maybe, idUnfolding )
import Literal ( Literal(..), mkMachInt, mkMachWord
, literalType
, word2IntLit, int2WordLit
import Type ( tyConAppTyCon, coreEqType )
import OccName ( occNameFS )
import PrelNames ( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
- eqStringName, unpackCStringIdKey )
+ eqStringName, unpackCStringIdKey, inlineIdName )
import Maybes ( orElse )
import Name ( Name )
import Outputable
-- Rules for non-primops that can't be expressed using a RULE pragma
builtinRules
= [ BuiltinRule FSLIT("AppendLitString") unpackCStringFoldrName match_append_lit,
- BuiltinRule FSLIT("EqString") eqStringName match_eq_string
+ BuiltinRule FSLIT("EqString") eqStringName match_eq_string,
+ BuiltinRule FSLIT("Inline") inlineIdName match_inline
]
+---------------------------------------------------
-- The rule is this:
-- unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n) = unpackFoldrCString# "foobaz" c n
match_append_lit other = Nothing
+---------------------------------------------------
-- The rule is this:
-- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
= Just (if s1 == s2 then trueVal else falseVal)
match_eq_string other = Nothing
+
+
+---------------------------------------------------
+-- The rule is this:
+-- inline (f a b c) = <f's unfolding> a b c
+-- (if f has an unfolding)
+match_inline (e:args2)
+ | (Var f, args1) <- collectArgs e,
+ Just unf <- maybeUnfoldingTemplate (idUnfolding f)
+ = Just (mkApps (mkApps unf args1) args2)
+
+match_inline other = Nothing
\end{code}
= -- Wimp out for now
mkCoLets' to_drop (Note note (fiExpr [] expr))
-fiExpr to_drop (_, AnnNote InlineCall expr)
- = -- Wimp out for InlineCall; keep it close
- -- the the call it annotates
- mkCoLets' to_drop (Note InlineCall (fiExpr [] expr))
-
fiExpr to_drop (_, AnnNote InlineMe expr)
= -- Ditto... don't float anything into an INLINE expression
mkCoLets' to_drop (Note InlineMe (fiExpr [] expr))
| CoerceIt OutType -- The To-type, simplified
SimplCont
- | InlinePlease -- This continuation makes a function very
- SimplCont -- keen to inline itelf
-
| ApplyTo DupFlag
InExpr SimplEnv -- The argument, as yet unsimplified,
SimplCont -- and its environment
ppr (Select dup bndr alts se cont) = (ptext SLIT("Select") <+> ppr dup <+> ppr bndr) $$
(nest 4 (ppr alts)) $$ ppr cont
ppr (CoerceIt ty cont) = (ptext SLIT("CoerceIt") <+> ppr ty) $$ ppr cont
- ppr (InlinePlease cont) = ptext SLIT("InlinePlease") $$ ppr cont
data DupFlag = OkToDup | NoDup
contIsDupable (ApplyTo OkToDup _ _ _) = True
contIsDupable (Select OkToDup _ _ _ _) = True
contIsDupable (CoerceIt _ cont) = contIsDupable cont
-contIsDupable (InlinePlease cont) = contIsDupable cont
contIsDupable other = False
-------------------
discardableCont :: SimplCont -> Bool
discardableCont (Stop _ _ _) = False
discardableCont (CoerceIt _ cont) = discardableCont cont
-discardableCont (InlinePlease cont) = discardableCont cont
discardableCont other = True
discardCont :: SimplCont -- A continuation, expecting
contResultType (ArgOf _ _ to_ty _) = to_ty
contResultType (ApplyTo _ _ _ cont) = contResultType cont
contResultType (CoerceIt _ cont) = contResultType cont
-contResultType (InlinePlease cont) = contResultType cont
contResultType (Select _ _ _ _ cont) = contResultType cont
-------------------
getContArgs :: SwitchChecker
-> OutId -> SimplCont
-> ([(InExpr, SimplEnv, Bool)], -- Arguments; the Bool is true for strict args
- SimplCont, -- Remaining continuation
- Bool) -- Whether we came across an InlineCall
+ SimplCont) -- Remaining continuation
-- getContArgs id k = (args, k', inl)
-- args are the leading ApplyTo items in k
-- (i.e. outermost comes first)
stricts | switchIsOn chkr NoCaseOfCase = vanilla_stricts
| otherwise = computed_stricts
in
- go [] stricts False orig_cont
+ go [] stricts orig_cont
where
----------------------------
-- Type argument
- go acc ss inl (ApplyTo _ arg@(Type _) se cont)
- = go ((arg,se,False) : acc) ss inl cont
+ go acc ss (ApplyTo _ arg@(Type _) se cont)
+ = go ((arg,se,False) : acc) ss cont
-- NB: don't bother to instantiate the function type
-- Value argument
- go acc (s:ss) inl (ApplyTo _ arg se cont)
- = go ((arg,se,s) : acc) ss inl cont
-
- -- An Inline continuation
- go acc ss inl (InlinePlease cont)
- = go acc ss True cont
+ go acc (s:ss) (ApplyTo _ arg se cont)
+ = go ((arg,se,s) : acc) ss cont
-- We're run out of arguments, or else we've run out of demands
-- The latter only happens if the result is guaranteed bottom
-- Then, especially in the first of these cases, we'd like to discard
-- the continuation, leaving just the bottoming expression. But the
-- type might not be right, so we may have to add a coerce.
- go acc ss inl cont
- | null ss && discardableCont cont = (reverse acc, discardCont cont, inl)
- | otherwise = (reverse acc, cont, inl)
+ go acc ss cont
+ | null ss && discardableCont cont = (reverse acc, discardCont cont)
+ | otherwise = (reverse acc, cont)
----------------------------
vanilla_stricts, computed_stricts :: [Bool]
interestingCallContext some_args some_val_args cont
= interesting cont
where
- interesting (InlinePlease _) = True
interesting (Select _ _ _ _ _) = some_args
interesting (ApplyTo _ _ _ _) = True -- Can happen if we have (coerce t (f x)) y
-- Perhaps True is a bit over-keen, but I've
interestingArgContext fn cont
= idHasRules fn || go cont
where
- go (InlinePlease c) = go c
go (Select {}) = False
go (ApplyTo {}) = False
go (ArgOf {}) = True
= simplExpr (setEnclosingCC env currentCCS) e `thenSmpl` \ e' ->
rebuild env (mkSCC cc e') cont
-simplNote env InlineCall e cont
- = simplExprF env e (InlinePlease cont)
-
-- See notes with SimplMonad.inlineMode
simplNote env InlineMe e cont
| contIsRhsOrArg cont -- Totally boring continuation; see notes above
= -- Simplify the arguments
getDOptsSmpl `thenSmpl` \ dflags ->
let
- chkr = getSwitchChecker env
- (args, call_cont, inline_call) = getContArgs chkr var cont
- fn_ty = idType var
+ chkr = getSwitchChecker env
+ (args, call_cont) = getContArgs chkr var cont
+ fn_ty = idType var
in
simplifyArgs env fn_ty (interestingArgContext var call_cont) args
(contResultType call_cont) $ \ env args ->
(notNull arg_infos)
call_cont
active_inline = activeInline env var occ_info
- maybe_inline = callSiteInline dflags active_inline inline_call occ_info
+ maybe_inline = callSiteInline dflags active_inline occ_info
var arg_infos interesting_cont
in
case maybe_inline of {
rebuild env expr (Stop _ _ _) = rebuildDone env expr
rebuild env expr (ArgOf _ _ _ cont_fn) = cont_fn env expr
rebuild env expr (CoerceIt to_ty cont) = rebuild env (mkCoerce to_ty expr) cont
-rebuild env expr (InlinePlease cont) = rebuild env (Note InlineCall expr) cont
rebuild env expr (Select _ bndr alts se cont) = rebuildCase (setInScope se env) expr bndr alts cont
rebuild env expr (ApplyTo _ arg se cont) = rebuildApp (setInScope se env) expr arg cont
= mkDupableCont env cont `thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->
returnSmpl (floats, (CoerceIt ty dup_cont, nondup_cont))
-mkDupableCont env (InlinePlease cont)
- = mkDupableCont env cont `thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->
- returnSmpl (floats, (InlinePlease dup_cont, nondup_cont))
-
mkDupableCont env cont@(ArgOf _ arg_ty _ _)
= returnSmpl (emptyFloats env, (mkBoringStop arg_ty, cont))
-- Do *not* duplicate an ArgOf continuation
-- from nested matches; see the Let case of match, below
--
type SubstEnv = (TvSubstEnv, IdSubstEnv, OrdList CoreBind)
-type IdSubstEnv = IdEnv CoreExpr
+type IdSubstEnv = IdEnv CoreExpr
emptySubstEnv :: SubstEnv
emptySubstEnv = (emptyVarEnv, emptyVarEnv, nilOL)
</sect1>
+<sect1 id="special-ids">
+<title>Special built-in functions</title>
+<para>GHC has a few built-in funcions with special behaviour,
+described in this section. All are exported by
+<literal>GHC.Exts</literal>.</para>
+
+<sect2> <title>The <literal>inline</literal> function </title>
+<para>
+The <literal>inline</literal> function is somewhat experimental.
+<programlisting>
+ inline :: a -> a
+</programlisting>
+The call <literal>(inline f)</literal> arranges that <literal>f</literal>
+is inlined, regardless of its size. More precisely, the call
+<literal>(inline f)</literal> rewrites to the right-hand side of <literal>f</literal>'s
+definition.
+This allows the programmer to control inlining from
+a particular <emphasis>call site</emphasis>
+rather than the <emphasis>definition site</emphasis> of the function
+(c.f. <literal>INLINE</literal> pragmas <xref linkend="inline-noinline-pragma"/>).
+</para>
+<para>
+This inlining occurs regardless of the argument to the call
+or the size of <literal>f</literal>'s definition; it is unconditional.
+The main caveat is that <literal>f</literal>'s definition must be
+visible to the compiler. That is, <literal>f</literal> must be
+let-bound in the current scope.
+If no inlining takes place, the <literal>inline</literal> function
+expands to the identity function in Phase zero; so its use imposes
+no overhead.</para>
+
+<para> If the function is defined in another
+module, GHC only exposes its inlining in the interface file if the
+function is sufficiently small that it <emphasis>might</emphasis> be
+inlined by the automatic mechanism. There is currently no way to tell
+GHC to expose arbitrarily-large functions in the interface file. (This
+shortcoming is something that could be fixed, with some kind of pragma.)
+</para>
+</sect2>
+
+<sect2> <title>The <literal>inline</literal> function </title>
+<para>
+The <literal>lazy</literal> function restrains strictness analysis a little:
+<programlisting>
+ lazy :: a -> a
+</programlisting>
+The call <literal>(lazy e)</literal> means the same as <literal>e</literal>,
+but <literal>lazy</literal> has a magical property so far as strictness
+analysis is concerned: it is lazy in its first argument,
+even though its semantics is strict. After strictness analysis has run,
+calls to <literal>lazy</literal> are inlined to be the identity function.
+</para>
+<para>
+This behaviour is occasionally useful when controlling evaluation order.
+Notably, <literal>lazy</literal> is used in the library definition of
+<literal>Control.Parallel.par</literal>:
+<programlisting>
+ par :: a -> b -> b
+ par x y = case (par# x) of { _ -> lazy y }
+</programlisting>
+If <literal>lazy</literal> were not lazy, <literal>par</literal> would
+look strict in <literal>y</literal> which would defeat the whole
+purpose of <literal>par</literal>.
+</para>
+</sect2>
+</sect1>
+
+
<sect1 id="generic-classes">
<title>Generic classes</title>
projects / ghc-hetmet.git / commitdiff