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,
- isStableUnfolding, isStableUnfolding_maybe,
+ isStableUnfolding, isStableCoreUnfolding_maybe,
isClosedUnfolding, hasSomeUnfolding,
canUnfold, neverUnfoldGuidance, isStableSource,
-- * Annotated expression data types
AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
+ -- ** Operations on annotated expressions
+ collectAnnArgs,
+
-- ** Operations on annotations
deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
RuleName, IdUnfoldingFun,
-- ** Operations on 'CoreRule's
- seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
+ seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
setRuleIdName,
isBuiltinRule, isLocalRule
) where
= 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,
ruleName :: CoreRule -> RuleName
ruleName = ru_name
-ruleActivation_maybe :: CoreRule -> Maybe Activation
-ruleActivation_maybe (BuiltinRule { }) = Nothing
-ruleActivation_maybe (Rule { ru_act = act }) = Just act
+ruleActivation :: CoreRule -> Activation
+ruleActivation (BuiltinRule { }) = AlwaysActive
+ruleActivation (Rule { ru_act = act }) = act
-- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
ruleIdName :: CoreRule -> Name
-- Replace uf_tmpl each time around
| InlineStable -- From an INLINE or INLINABLE pragma
- -- Do not replace uf_tmpl; instead, keep it unchanged
+ -- 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
expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
expandUnfolding_maybe _ = Nothing
-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
-isStableUnfolding_maybe _ = Nothing
+isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
+isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
+ | isStableSource src = Just src
+isStableCoreUnfolding_maybe _ = Nothing
isCompulsoryUnfolding :: Unfolding -> Bool
isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
-- | 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