mkConApp, mkTyBind,
varToCoreExpr, varsToCoreExprs,
- isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
+ isTyCoVar, isId, cmpAltCon, cmpAlt, ltAlt,
-- ** Simple 'Expr' access functions and predicates
bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
collectArgs, coreExprCc, flattenBinds,
isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
+ notSccNote,
-- * Unfolding data types
Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
maybeUnfoldingTemplate, otherCons, unfoldingArity,
isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
- isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding,
- isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource,
+ isStableUnfolding, isStableUnfolding_maybe,
+ isClosedUnfolding, hasSomeUnfolding,
+ canUnfold, neverUnfoldGuidance, isStableSource,
-- * Strictness
seqExpr, seqExprs, seqUnfolding,
-- * Annotated expression data types
AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
+ -- ** Operations on annotated expressions
+ collectAnnArgs,
+
-- ** Operations on annotations
deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
import Data.Data
import Data.Word
-infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
+infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`
-- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
\end{code}
These data types are the heart of the compiler
\begin{code}
-infixl 8 `App` -- App brackets to the left
-
-- | This is the data type that represents GHCs core intermediate language. Currently
-- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
-- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
= Rule {
ru_name :: RuleName, -- ^ Name of the rule, for communication with the user
ru_act :: Activation, -- ^ When the rule is active
-
+
-- Rough-matching stuff
-- see comments with InstEnv.Instance( is_cls, is_rough )
ru_fn :: Name, -- ^ Name of the 'Id.Id' at the head of this rule
-- See Note [OccInfo in unfoldings and rules]
-- Locality
+ ru_auto :: Bool, -- ^ @True@ <=> this rule is auto-generated
+ -- @False@ <=> generated at the users behest
+ -- Main effect: reporting of orphan-hood
+
ru_local :: Bool -- ^ @True@ iff the fn at the head of the rule is
-- defined in the same module as the rule
-- and is not an implicit 'Id' (like a record selector,
-- They are usually variables, but can be trivial expressions
-- instead (e.g. a type application).
- | CoreUnfolding { -- An unfolding for an Id with no pragma, or perhaps a NOINLINE pragma
- -- (For NOINLINE, the phase, if any, is in the InlinePragInfo for this Id.)
+ | CoreUnfolding { -- An unfolding for an Id with no pragma,
+ -- or perhaps a NOINLINE pragma
+ -- (For NOINLINE, the phase, if any, is in the
+ -- InlinePragInfo for this Id.)
uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
uf_src :: UnfoldingSource, -- Where the unfolding came from
uf_is_top :: Bool, -- True <=> top level binding
uf_arity :: Arity, -- Number of value arguments expected
- uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard a `seq` on
- -- this variable
- uf_is_conlike :: Bool, -- True <=> application of constructor or CONLIKE function
+ uf_is_value :: Bool, -- exprIsHNF template (cached); it is ok to discard
+ -- a `seq` on this variable
+ uf_is_conlike :: Bool, -- True <=> applicn of constructor or CONLIKE function
-- Cached version of exprIsConLike
- uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand inside an inlining
+ uf_is_cheap :: Bool, -- True <=> doesn't waste (much) work to expand
+ -- inside an inlining
-- Cached version of exprIsCheap
uf_expandable :: Bool, -- True <=> can expand in RULE matching
-- Cached version of exprIsExpandable
------------------------------------------------
data UnfoldingSource
- = InlineCompulsory -- Something that *has* no binding, so you *must* inline it
+ = InlineRhs -- The current rhs of the function
+ -- Replace uf_tmpl each time around
+
+ | InlineStable -- From an INLINE or INLINABLE pragma
+ -- INLINE if guidance is UnfWhen
+ -- INLINABLE if guidance is UnfIfGoodArgs
+ -- (well, technically an INLINABLE might be made
+ -- UnfWhen if it was small enough, and then
+ -- it will behave like INLINE outside the current
+ -- module, but that is the way automatic unfoldings
+ -- work so it is consistent with the intended
+ -- meaning of INLINABLE).
+ --
+ -- uf_tmpl may change, but only as a result of
+ -- gentle simplification, it doesn't get updated
+ -- to the current RHS during compilation as with
+ -- InlineRhs.
+ --
+ -- See Note [InlineRules]
+
+ | InlineCompulsory -- Something that *has* no binding, so you *must* inline it
-- Only a few primop-like things have this property
-- (see MkId.lhs, calls to mkCompulsoryUnfolding).
-- Inline absolutely always, however boring the context.
- | InlineRule -- From an {-# INLINE #-} pragma; See Note [InlineRules]
-
| InlineWrapper Id -- This unfolding is a the wrapper in a
-- worker/wrapper split from the strictness analyser
-- The Id is the worker-id
-- which don't need to contain the RHS;
-- it can be derived from the strictness info
- | InlineRhs -- The current rhs of the function
-
- -- For InlineRhs, the uf_tmpl is replaced each time around
- -- For all the others we leave uf_tmpl alone
-- | 'UnfoldingGuidance' says when unfolding should take place
Now we might encounter (op (dfCList {ty} d) a1 a2)
and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
has all its arguments, even though its (value) arity is 2. That's
-why we cache the number of expected
+why we record the number of expected arguments in the DFunUnfolding.
+Note that although it's an Arity, it's most convenient for it to give
+the *total* number of arguments, both type and value. See the use
+site in exprIsConApp_maybe.
\begin{code}
-- Constants for the UnfWhen constructor
\end{code}
\begin{code}
-isInlineRuleSource :: UnfoldingSource -> Bool
-isInlineRuleSource InlineCompulsory = True
-isInlineRuleSource InlineRule = True
-isInlineRuleSource (InlineWrapper {}) = True
-isInlineRuleSource InlineRhs = False
+isStableSource :: UnfoldingSource -> Bool
+-- Keep the unfolding template
+isStableSource InlineCompulsory = True
+isStableSource InlineStable = True
+isStableSource (InlineWrapper {}) = True
+isStableSource InlineRhs = False
-- | Retrieves the template of an unfolding: panics if none is known
unfoldingTemplate :: Unfolding -> CoreExpr
expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
expandUnfolding_maybe _ = Nothing
-isInlineRule :: Unfolding -> Bool
-isInlineRule (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
-isInlineRule _ = False
-
-isInlineRule_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
-isInlineRule_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
- | isInlineRuleSource src
+isStableUnfolding_maybe :: Unfolding -> Maybe (UnfoldingSource, Bool)
+isStableUnfolding_maybe (CoreUnfolding { uf_src = src, uf_guidance = guide })
+ | isStableSource src
= Just (src, unsat_ok)
where
unsat_ok = case guide of
UnfWhen unsat_ok _ -> unsat_ok
_ -> needSaturated
-isInlineRule_maybe _ = Nothing
+isStableUnfolding_maybe _ = Nothing
isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
isStableUnfolding :: Unfolding -> Bool
-- True of unfoldings that should not be overwritten
-- by a CoreUnfolding for the RHS of a let-binding
-isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
+isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
isStableUnfolding (DFunUnfolding {}) = True
isStableUnfolding _ = False
collectTyBinders expr
= go [] expr
where
- go tvs (Lam b e) | isTyVar b = go (b:tvs) e
+ go tvs (Lam b e) | isTyCoVar b = go (b:tvs) e
go tvs e = (reverse tvs, e)
collectValBinders expr
-- | The number of argument expressions that are values rather than types at their top level
valArgCount :: [Arg b] -> Int
valArgCount = count isValArg
+
+notSccNote :: Note -> Bool
+notSccNote (SCC {}) = False
+notSccNote _ = True
\end{code}
\end{code}
\begin{code}
+-- | Takes a nested application expression and returns the the function
+-- being applied and the arguments to which it is applied
+collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
+collectAnnArgs expr
+ = go expr []
+ where
+ go (_, AnnApp f a) as = go f (a:as)
+ go e as = (e, as)
+\end{code}
+
+\begin{code}
deAnnotate :: AnnExpr bndr annot -> Expr bndr
deAnnotate (_, e) = deAnnotate' e
projects / ghc-hetmet.git / blobdiff