%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
module CoreSyn (
isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
-- * Unfolding data types
- Unfolding(..), UnfoldingGuidance(..), InlineRuleInfo(..),
+ Unfolding(..), UnfoldingGuidance(..), UnfoldingSource(..),
-- Abstract everywhere but in CoreUnfold.lhs
-- ** Constructing 'Unfolding's
noUnfolding, evaldUnfolding, mkOtherCon,
+ unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
-- ** Predicates and deconstruction on 'Unfolding'
- unfoldingTemplate, setUnfoldingTemplate,
+ unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
maybeUnfoldingTemplate, otherCons, unfoldingArity,
isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
- isExpandableUnfolding,
+ isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding,
- isStableUnfolding, canUnfold, neverUnfoldGuidance,
+ isStableUnfolding, canUnfold, neverUnfoldGuidance, isInlineRuleSource,
-- * Strictness
seqExpr, seqExprs, seqUnfolding,
-- * Core rule data types
CoreRule(..), -- CoreSubst, CoreTidy, CoreFVs, PprCore only
- RuleName,
+ RuleName, IdUnfoldingFun,
-- ** Operations on 'CoreRule's
seqRules, ruleArity, ruleName, ruleIdName, ruleActivation_maybe,
import Outputable
import Util
+import Data.Data
import Data.Word
infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`
-- The type parameter @b@ is for the type of binders in the expression tree.
data Expr b
= Var Id -- ^ Variables
+
| Lit Literal -- ^ Primitive literals
+
| App (Expr b) (Arg b) -- ^ Applications: note that the argument may be a 'Type'.
--
-- See "CoreSyn#let_app_invariant" for another invariant
+
| Lam b (Expr b) -- ^ Lambda abstraction
+
| Let (Bind b) (Expr b) -- ^ Recursive and non recursive @let@s. Operationally
-- this corresponds to allocating a thunk for the things
-- bound and then executing the sub-expression.
-- the meaning of /lifted/ vs. /unlifted/).
--
-- #let_app_invariant#
- -- The right hand side of of a non-recursive 'Let' _and_ the argument of an 'App',
+ -- The right hand side of of a non-recursive 'Let'
+ -- _and_ the argument of an 'App',
-- /may/ be of unlifted type, but only if the expression
- -- is ok-for-speculation. This means that the let can be floated around
- -- without difficulty. For example, this is OK:
+ -- is ok-for-speculation. This means that the let can be floated
+ -- around without difficulty. For example, this is OK:
--
-- > y::Int# = x +# 1#
--
- -- But this is not, as it may affect termination if the expression is floated out:
+ -- But this is not, as it may affect termination if the
+ -- expression is floated out:
--
-- > y::Int# = fac 4#
--
-- At the moment, the rest of the compiler only deals with type-let
-- in a Let expression, rather than at top level. We may want to revist
-- this choice.
+
| Case (Expr b) b Type [Alt b] -- ^ Case split. Operationally this corresponds to evaluating
-- the scrutinee (expression examined) to weak head normal form
-- and then examining at most one level of resulting constructor (i.e. you
-- and the 'Type' must be that of all the case alternatives
--
-- #case_invariants#
- -- This is one of the more complicated elements of the Core language, and comes
- -- with a number of restrictions:
+ -- This is one of the more complicated elements of the Core language,
+ -- and comes with a number of restrictions:
--
- -- The 'DEFAULT' case alternative must be first in the list, if it occurs at all.
+ -- The 'DEFAULT' case alternative must be first in the list,
+ -- if it occurs at all.
--
-- The remaining cases are in order of increasing
-- tag (for 'DataAlts') or
-- lit (for 'LitAlts').
- -- This makes finding the relevant constructor easy, and makes comparison easier too.
+ -- This makes finding the relevant constructor easy,
+ -- and makes comparison easier too.
--
-- The list of alternatives must be exhaustive. An /exhaustive/ case
-- does not necessarily mention all constructors:
-- Blue -> ... ) ...
-- @
--
- -- The inner case does not need a @Red@ alternative, because @x@ can't be @Red@ at
- -- that program point.
- | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type. This is used to implement @newtype@s
- -- (a @newtype@ constructor or destructor just becomes a 'Cast' in Core) and GADTs.
+ -- The inner case does not need a @Red@ alternative, because @x@
+ -- can't be @Red@ at that program point.
+
+ | Cast (Expr b) Coercion -- ^ Cast an expression to a particular type.
+ -- This is used to implement @newtype@s (a @newtype@ constructor or
+ -- destructor just becomes a 'Cast' in Core) and GADTs.
+
| Note Note (Expr b) -- ^ Notes. These allow general information to be
-- added to expressions in the syntax tree
+
| Type Type -- ^ A type: this should only show up at the top
-- level of an Arg
+ deriving (Data, Typeable)
-- | Type synonym for expressions that occur in function argument positions.
-- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
-- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
| LitAlt Literal -- ^ A literal: @case e of { 1 -> ... }@
| DEFAULT -- ^ Trivial alternative: @case e of { _ -> ... }@
- deriving (Eq, Ord)
+ deriving (Eq, Ord, Data, Typeable)
-- | Binding, used for top level bindings in a module and local bindings in a @let@.
data Bind b = NonRec b (Expr b)
| Rec [(b, (Expr b))]
+ deriving (Data, Typeable)
\end{code}
-------------------------- CoreSyn INVARIANTS ---------------------------
data Note
= SCC CostCentre -- ^ A cost centre annotation for profiling
| CoreNote String -- ^ A generic core annotation, propagated but not used by GHC
+ deriving (Data, Typeable)
\end{code}
ru_fn :: Name, -- ^ As above
ru_nargs :: Int, -- ^ Number of arguments that 'ru_try' consumes,
-- if it fires, including type arguments
- ru_try :: [CoreExpr] -> Maybe CoreExpr
+ ru_try :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
-- ^ This function does the rewrite. It given too many
-- arguments, it simply discards them; the returned 'CoreExpr'
-- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
}
-- See Note [Extra args in rule matching] in Rules.lhs
+type IdUnfoldingFun = Id -> Unfolding
+-- A function that embodies how to unfold an Id if you need
+-- to do that in the Rule. The reason we need to pass this info in
+-- is that whether an Id is unfoldable depends on the simplifier phase
+
isBuiltinRule :: CoreRule -> Bool
isBuiltinRule (BuiltinRule {}) = True
isBuiltinRule _ = False
--
-- Here, @f@ gets an @OtherCon []@ unfolding.
- | DFunUnfolding DataCon [CoreExpr]
- -- The Unfolding of a DFunId
+ | DFunUnfolding -- The Unfolding of a DFunId
+ -- See Note [DFun unfoldings]
-- df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
-- (op2 a1..am d1..dn)
- -- where Arity = n, the number of dict args to the dfun
- -- The [CoreExpr] are the superclasses and methods [op1,op2],
+
+ Arity -- Arity = m+n, the *total* number of args
+ -- (unusually, both type and value) to the dfun
+
+ DataCon -- The dictionary data constructor (possibly a newtype datacon)
+
+ [CoreExpr] -- The [CoreExpr] are the superclasses and methods [op1,op2],
-- in positional order.
-- 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.)
- uf_tmpl :: CoreExpr, -- Template; occurrence info is correct
- uf_arity :: Arity, -- Number of value arguments expected
+ 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
+ -- Cached version of exprIsConLike
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
-- uf_guidance: Tells us about the /size/ of the unfolding template
------------------------------------------------
+data UnfoldingSource
+ = 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
+ -- Used to abbreviate the uf_tmpl in interface files
+ -- 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
data UnfoldingGuidance
- = UnfoldAlways -- There is /no original definition/, so you'd better unfold.
- -- The unfolding is guaranteed to have no free variables
- -- so no need to think about it during dependency analysis
-
- | InlineRule { -- See Note [InlineRules]
- -- Be very keen to inline this
- -- The uf_tmpl is the *original* RHS; do *not* replace it on
- -- each simlifier run. Hence, the *actual* RHS of the function
- -- may be different by now, because it may have been optimised.
- ug_ir_info :: InlineRuleInfo, -- Supplementary info about the InlineRule
- ug_small :: Bool -- True <=> the RHS is so small (eg no bigger than a call)
- -- that you should always inline a saturated call,
- } -- regardless of how boring the context is
- -- See Note [INLINE for small functions] in CoreUnfold]
-
- | UnfoldIfGoodArgs { -- Arose from a normal Id; the info here is the
+ = UnfWhen { -- Inline without thinking about the *size* of the uf_tmpl
+ -- Used (a) for small *and* cheap unfoldings
+ -- (b) for INLINE functions
+ -- See Note [INLINE for small functions] in CoreUnfold
+ ug_unsat_ok :: Bool, -- True <=> ok to inline even if unsaturated
+ ug_boring_ok :: Bool -- True <=> ok to inline even if the context is boring
+ -- So True,True means "always"
+ }
+
+ | UnfIfGoodArgs { -- Arose from a normal Id; the info here is the
-- result of a simple analysis of the RHS
ug_args :: [Int], -- Discount if the argument is evaluated.
} -- a context (case (thing args) of ...),
-- (where there are the right number of arguments.)
- | UnfoldNever
+ | UnfNever -- The RHS is big, so don't inline it
+\end{code}
+
+
+Note [DFun unfoldings]
+~~~~~~~~~~~~~~~~~~~~~~
+The Arity in a DFunUnfolding is total number of args (type and value)
+that the DFun needs to produce a dictionary. That's not necessarily
+related to the ordinary arity of the dfun Id, esp if the class has
+one method, so the dictionary is represented by a newtype. Example
-data InlineRuleInfo
- = InlSat -- A user-specifed or compiler injected INLINE pragma
- -- ONLY inline when it's applied to 'arity' arguments
+ class C a where { op :: a -> Int }
+ instance C a -> C [a] where op xs = op (head xs)
- | InlUnSat -- The compiler decided to "capture" the RHS into an
- -- InlineRule, but do not require that it appears saturated
+The instance translates to
- | InlWrapper Id -- This unfolding is a the wrapper in a
- -- worker/wrapper split from the strictness analyser
- -- Used to abbreviate the uf_tmpl in interface files
- -- which don't need to contain the RHS;
- -- it can be derived from the strictness info
+ $dfCList :: forall a. C a => C [a] -- Arity 2!
+ $dfCList = /\a.\d. $copList {a} d |> co
+
+ $copList :: forall a. C a => [a] -> Int -- Arity 2!
+ $copList = /\a.\d.\xs. op {a} d (head xs)
+
+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
+
+
+\begin{code}
+-- Constants for the UnfWhen constructor
+needSaturated, unSaturatedOk :: Bool
+needSaturated = False
+unSaturatedOk = True
+
+boringCxtNotOk, boringCxtOk :: Bool
+boringCxtOk = True
+boringCxtNotOk = False
------------------------------------------------
noUnfolding :: Unfolding
seqUnfolding :: Unfolding -> ()
seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
uf_is_value = b1, uf_is_cheap = b2,
- uf_expandable = b3, uf_arity = a, uf_guidance = g})
- = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` seqGuidance g
+ uf_expandable = b3, uf_is_conlike = b4,
+ uf_arity = a, uf_guidance = g})
+ = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
seqUnfolding _ = ()
seqGuidance :: UnfoldingGuidance -> ()
-seqGuidance (UnfoldIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
-seqGuidance _ = ()
+seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
+seqGuidance _ = ()
\end{code}
\begin{code}
+isInlineRuleSource :: UnfoldingSource -> Bool
+isInlineRuleSource InlineCompulsory = True
+isInlineRuleSource InlineRule = True
+isInlineRuleSource (InlineWrapper {}) = True
+isInlineRuleSource InlineRhs = False
+
-- | Retrieves the template of an unfolding: panics if none is known
unfoldingTemplate :: Unfolding -> CoreExpr
unfoldingTemplate = uf_tmpl
isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
isEvaldUnfolding _ = False
+-- | @True@ if the unfolding is a constructor application, the application
+-- of a CONLIKE function or 'OtherCon'
+isConLikeUnfolding :: Unfolding -> Bool
+isConLikeUnfolding (OtherCon _) = True
+isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con }) = con
+isConLikeUnfolding _ = False
+
-- | Is the thing we will unfold into certainly cheap?
isCheapUnfolding :: Unfolding -> Bool
isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
isExpandableUnfolding _ = False
-isInlineRule :: Unfolding -> Bool
-isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
-isInlineRule _ = False
+expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
+-- Expand an expandable unfolding; this is used in rule matching
+-- See Note [Expanding variables] in Rules.lhs
+-- The key point here is that CONLIKE things can be expanded
+expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
+expandUnfolding_maybe _ = Nothing
-isInlineRule_maybe :: Unfolding -> Maybe InlineRuleInfo
-isInlineRule_maybe (CoreUnfolding {
- uf_guidance = InlineRule { ug_ir_info = inl } }) = Just inl
-isInlineRule_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
+ = Just (src, unsat_ok)
+ where
+ unsat_ok = case guide of
+ UnfWhen unsat_ok _ -> unsat_ok
+ _ -> needSaturated
+isInlineRule_maybe _ = Nothing
+
+isCompulsoryUnfolding :: Unfolding -> Bool
+isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
+isCompulsoryUnfolding _ = False
isStableUnfolding :: Unfolding -> Bool
-- True of unfoldings that should not be overwritten
-- by a CoreUnfolding for the RHS of a let-binding
-isStableUnfolding (CoreUnfolding { uf_guidance = InlineRule {} }) = True
-isStableUnfolding (DFunUnfolding {}) = True
-isStableUnfolding _ = False
+isStableUnfolding (CoreUnfolding { uf_src = src }) = isInlineRuleSource src
+isStableUnfolding (DFunUnfolding {}) = True
+isStableUnfolding _ = False
unfoldingArity :: Unfolding -> Arity
unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
isClosedUnfolding :: Unfolding -> Bool -- No free variables
isClosedUnfolding (CoreUnfolding {}) = False
+isClosedUnfolding (DFunUnfolding {}) = False
isClosedUnfolding _ = True
-- | Only returns False if there is no unfolding information available at all
hasSomeUnfolding _ = True
neverUnfoldGuidance :: UnfoldingGuidance -> Bool
-neverUnfoldGuidance UnfoldNever = True
-neverUnfoldGuidance _ = False
+neverUnfoldGuidance UnfNever = True
+neverUnfoldGuidance _ = False
canUnfold :: Unfolding -> Bool
canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
canUnfold _ = False
\end{code}
-Note [InlineRule]
+Note [InlineRules]
~~~~~~~~~~~~~~~~~
When you say
{-# INLINE f #-}
you intend that calls (f e) are replaced by <rhs>[e/x] So we
should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
with it. Meanwhile, we can optimise <rhs> to our heart's content,
-leaving the original unfolding intact in Unfolding of 'f'.
+leaving the original unfolding intact in Unfolding of 'f'. For example
+ all xs = foldr (&&) True xs
+ any p = all . map p {-# INLINE any #-}
+We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
+which deforests well at the call site.
-So the representation of an Unfolding has changed quite a bit
-(see CoreSyn). An INLINE pragma gives rise to an InlineRule
-unfolding.
+So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
Moreover, it's only used when 'f' is applied to the
specified number of arguments; that is, the number of argument on
projects / ghc-hetmet.git / blobdiff