%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
module CoreSyn (
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(..), InlineRuleInfo(..), InlSatFlag(..),
+ 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, isConLikeUnfolding,
- isInlineRule, isInlineRule_maybe, isClosedUnfolding, hasSomeUnfolding,
- isStableUnfolding, canUnfold, neverUnfoldGuidance,
+ isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
+ 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,
-- * 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`
+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>.
-- 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}
= 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,
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
+ | 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_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_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 <=> 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
-- uf_guidance: Tells us about the /size/ of the unfolding template
------------------------------------------------
+data UnfoldingSource
+ = 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.
+
+ | 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
+
+
+
-- | 'UnfoldingGuidance' says when unfolding should take place
data UnfoldingGuidance
- = InlineRule { -- Be very keen to inline this; See Note [InlineRules]
- -- 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.
-
- ir_sat :: InlSatFlag,
- ir_info :: InlineRuleInfo
+ = 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"
}
- | UnfoldIfGoodArgs { -- Arose from a normal Id; the info here is the
+ | 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 -- A variant of UnfoldIfGoodArgs, used for big RHSs
+ | 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
+
+ class C a where { op :: a -> Int }
+ instance C a -> C [a] where op xs = op (head xs)
-data InlineRuleInfo
- = InlAlways -- Inline absolutely always, however boring the context.
- -- There is /no original definition/. Only a few primop-like things
- -- have this property (see MkId.lhs, calls to mkCompulsoryUnfolding).
+The instance translates to
- | InlSmall -- The RHS is very small (eg no bigger than a call), so inline any
- -- /saturated/ application, regardless of context
- -- See Note [INLINE for small functions] in CoreUnfold
+ $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)
- | InlVanilla
+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 record the number of expected arguments in the DFunUnfolding.
- | 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
- -- [In principle this is orthogonal to the InlSmall/InVanilla thing,
- -- but it's convenient to have it here.]
+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
+needSaturated, unSaturatedOk :: Bool
+needSaturated = False
+unSaturatedOk = True
-data InlSatFlag = InlSat | InlUnSat
- -- Specifies whether to INLINE only if the thing is applied to 'arity' args
+boringCxtNotOk, boringCxtOk :: Bool
+boringCxtOk = True
+boringCxtNotOk = False
------------------------------------------------
noUnfolding :: Unfolding
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}
+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
unfoldingTemplate = uf_tmpl
isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
isExpandableUnfolding _ = False
-isInlineRule :: Unfolding -> Bool
-isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
-isInlineRule _ = False
-
-isInlineRule_maybe :: Unfolding -> Maybe (InlineRuleInfo, InlSatFlag)
-isInlineRule_maybe (CoreUnfolding { uf_guidance =
- InlineRule { ir_info = inl, ir_sat = sat } }) = Just (inl,sat)
-isInlineRule_maybe _ = Nothing
+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
+
+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
+
+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 }) = isStableSource 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
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