tyops
[ghc.git] / compiler / coreSyn / CoreSyn.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 \begin{code}
7 {-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
8
9 {-# OPTIONS -fno-warn-tabs #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and
12 -- detab the module (please do the detabbing in a separate patch). See
13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
14 -- for details
15
16 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
17 module CoreSyn (
18         -- * Main data types
19         Expr(..), Alt, Bind(..), AltCon(..), Arg, Tickish(..),
20         CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
21         TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
22
23         -- ** 'Expr' construction
24         mkLets, mkLams,
25         mkApps, mkTyApps, mkCoApps, mkVarApps,
26         
27         mkIntLit, mkIntLitInt,
28         mkWordLit, mkWordLitWord,
29         mkWord64LitWord64, mkInt64LitInt64,
30         mkCharLit, mkStringLit,
31         mkFloatLit, mkFloatLitFloat,
32         mkDoubleLit, mkDoubleLitDouble,
33         
34         mkConApp, mkTyBind, mkCoBind,
35         varToCoreExpr, varsToCoreExprs,
36
37         isId, cmpAltCon, cmpAlt, ltAlt,
38         
39         -- ** Simple 'Expr' access functions and predicates
40         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, 
41         collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
42         collectArgs, flattenBinds,
43
44         isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
45         isRuntimeArg, isRuntimeVar,
46
47         tickishCounts, tickishScoped, tickishIsCode, mkNoTick, mkNoScope,
48         tickishCanSplit,
49
50         -- * Unfolding data types
51         Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),
52
53         -- ** Constructing 'Unfolding's
54         noUnfolding, evaldUnfolding, mkOtherCon,
55         unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
56         
57         -- ** Predicates and deconstruction on 'Unfolding'
58         unfoldingTemplate, setUnfoldingTemplate, expandUnfolding_maybe,
59         maybeUnfoldingTemplate, otherCons, unfoldingArity,
60         isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
61         isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
62         isStableUnfolding, isStableCoreUnfolding_maybe,
63         isClosedUnfolding, hasSomeUnfolding, 
64         canUnfold, neverUnfoldGuidance, isStableSource,
65
66         -- * Strictness
67         seqExpr, seqExprs, seqUnfolding, 
68
69         -- * Annotated expression data types
70         AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
71         
72         -- ** Operations on annotated expressions
73         collectAnnArgs,
74
75         -- ** Operations on annotations
76         deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
77
78         -- * Core rule data types
79         CoreRule(..),   -- CoreSubst, CoreTidy, CoreFVs, PprCore only
80         RuleName, IdUnfoldingFun,
81         
82         -- ** Operations on 'CoreRule's 
83         seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
84         setRuleIdName,
85         isBuiltinRule, isLocalRule,
86
87         -- * Core vectorisation declarations data type
88         CoreVect(..)
89     ) where
90
91 #include "HsVersions.h"
92
93 import CostCentre
94 import Var
95 import Type
96 import Coercion
97 import Name
98 import Literal
99 import DataCon
100 import Module
101 import TyCon
102 import BasicTypes
103 import FastString
104 import Outputable
105 import Util
106
107 import Data.Data hiding (TyCon)
108 import Data.Int
109 import Data.Word
110
111 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
112 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
113 \end{code}
114
115 %************************************************************************
116 %*                                                                      *
117 \subsection{The main data types}
118 %*                                                                      *
119 %************************************************************************
120
121 These data types are the heart of the compiler
122
123 \begin{code}
124 -- | This is the data type that represents GHCs core intermediate language. Currently
125 -- GHC uses System FC <http://research.microsoft.com/~simonpj/papers/ext-f/> for this purpose,
126 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
127 --
128 -- We get from Haskell source to this Core language in a number of stages:
129 --
130 -- 1. The source code is parsed into an abstract syntax tree, which is represented
131 --    by the data type 'HsExpr.HsExpr' with the names being 'RdrName.RdrNames'
132 --
133 -- 2. This syntax tree is /renamed/, which attaches a 'Unique.Unique' to every 'RdrName.RdrName'
134 --    (yielding a 'Name.Name') to disambiguate identifiers which are lexically identical. 
135 --    For example, this program:
136 --
137 -- @
138 --      f x = let f x = x + 1
139 --            in f (x - 2)
140 -- @
141 --
142 --    Would be renamed by having 'Unique's attached so it looked something like this:
143 --
144 -- @
145 --      f_1 x_2 = let f_3 x_4 = x_4 + 1
146 --                in f_3 (x_2 - 2)
147 -- @
148 --
149 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
150 --    type class arguments) to yield a 'HsExpr.HsExpr' type that has 'Id.Id' as it's names.
151 --
152 -- 4. Finally the syntax tree is /desugared/ from the expressive 'HsExpr.HsExpr' type into
153 --    this 'Expr' type, which has far fewer constructors and hence is easier to perform
154 --    optimization, analysis and code generation on.
155 --
156 -- The type parameter @b@ is for the type of binders in the expression tree.
157 --
158 -- The language consists of the following elements:
159 --
160 -- *  Variables
161 --
162 -- *  Primitive literals
163 --
164 -- *  Applications: note that the argument may be a 'Type'.
165 --
166 --    See "CoreSyn#let_app_invariant" for another invariant
167 --
168 -- *  Lambda abstraction
169 --
170 -- *  Recursive and non recursive @let@s. Operationally
171 --    this corresponds to allocating a thunk for the things
172 --    bound and then executing the sub-expression.
173 --    
174 --    #top_level_invariant#
175 --    #letrec_invariant#
176 --    
177 --    The right hand sides of all top-level and recursive @let@s
178 --    /must/ be of lifted type (see "Type#type_classification" for
179 --    the meaning of /lifted/ vs. /unlifted/).
180 --    
181 --    #let_app_invariant#
182 --    The right hand side of of a non-recursive 'Let' 
183 --    _and_ the argument of an 'App',
184 --    /may/ be of unlifted type, but only if the expression 
185 --    is ok-for-speculation.  This means that the let can be floated 
186 --    around without difficulty. For example, this is OK:
187 --    
188 --    > y::Int# = x +# 1#
189 --    
190 --    But this is not, as it may affect termination if the 
191 --    expression is floated out:
192 --    
193 --    > y::Int# = fac 4#
194 --    
195 --    In this situation you should use @case@ rather than a @let@. The function
196 --    'CoreUtils.needsCaseBinding' can help you determine which to generate, or
197 --    alternatively use 'MkCore.mkCoreLet' rather than this constructor directly,
198 --    which will generate a @case@ if necessary
199 --    
200 --    #type_let#
201 --    We allow a /non-recursive/ let to bind a type variable, thus:
202 --    
203 --    > Let (NonRec tv (Type ty)) body
204 --    
205 --    This can be very convenient for postponing type substitutions until
206 --    the next run of the simplifier.
207 --    
208 --    At the moment, the rest of the compiler only deals with type-let
209 --    in a Let expression, rather than at top level.  We may want to revist
210 --    this choice.
211 --
212 -- *  Case split. Operationally this corresponds to evaluating
213 --    the scrutinee (expression examined) to weak head normal form
214 --    and then examining at most one level of resulting constructor (i.e. you
215 --    cannot do nested pattern matching directly with this).
216 --    
217 --    The binder gets bound to the value of the scrutinee,
218 --    and the 'Type' must be that of all the case alternatives
219 --    
220 --    #case_invariants#
221 --    This is one of the more complicated elements of the Core language, 
222 --    and comes with a number of restrictions:
223 --    
224 --    1. The list of alternatives is non-empty
225 --
226 --    2. The 'DEFAULT' case alternative must be first in the list, 
227 --       if it occurs at all.
228 --    
229 --    3. The remaining cases are in order of increasing 
230 --         tag  (for 'DataAlts') or
231 --         lit  (for 'LitAlts').
232 --       This makes finding the relevant constructor easy, 
233 --       and makes comparison easier too.
234 --    
235 --    4. The list of alternatives must be exhaustive. An /exhaustive/ case 
236 --       does not necessarily mention all constructors:
237 --    
238 --       @
239 --            data Foo = Red | Green | Blue
240 --       ... case x of 
241 --            Red   -> True
242 --            other -> f (case x of 
243 --                            Green -> ...
244 --                            Blue  -> ... ) ...
245 --       @
246 --    
247 --       The inner case does not need a @Red@ alternative, because @x@ 
248 --       can't be @Red@ at that program point.
249 --
250 -- *  Cast an expression to a particular type. 
251 --    This is used to implement @newtype@s (a @newtype@ constructor or 
252 --    destructor just becomes a 'Cast' in Core) and GADTs.
253 --
254 -- *  Notes. These allow general information to be added to expressions
255 --    in the syntax tree
256 --
257 -- *  A type: this should only show up at the top level of an Arg
258 --
259 -- *  A coercion
260 data Expr b
261   = Var   Id
262   | Lit   Literal
263   | App   (Expr b) (Arg b)
264   | Lam   b (Expr b)
265   | Let   (Bind b) (Expr b)
266   | Case  (Expr b) b Type [Alt b]       -- See #case_invariant#
267   | Cast  (Expr b) Coercion
268   | Tick  (Tickish Id) (Expr b)
269   | Type  Type
270   | Coercion Coercion
271   deriving (Data, Typeable)
272
273 -- | Type synonym for expressions that occur in function argument positions.
274 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
275 type Arg b = Expr b
276
277 -- | A case split alternative. Consists of the constructor leading to the alternative,
278 -- the variables bound from the constructor, and the expression to be executed given that binding.
279 -- The default alternative is @(DEFAULT, [], rhs)@
280 type Alt b = (AltCon, [b], Expr b)
281
282 -- | A case alternative constructor (i.e. pattern match)
283 data AltCon 
284   = DataAlt DataCon   --  ^ A plain data constructor: @case e of { Foo x -> ... }@.
285                       -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
286
287   | LitAlt  Literal   -- ^ A literal: @case e of { 1 -> ... }@
288                       -- Invariant: always an *unlifted* literal
289                       -- See Note [Literal alternatives]
290                       
291   | DEFAULT           -- ^ Trivial alternative: @case e of { _ -> ... }@
292    deriving (Eq, Ord, Data, Typeable)
293
294 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
295 data Bind b = NonRec b (Expr b)
296             | Rec [(b, (Expr b))]
297   deriving (Data, Typeable)
298 \end{code}
299
300 Note [Literal alternatives]
301 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
302 Literal alternatives (LitAlt lit) are always for *un-lifted* literals.
303 We have one literal, a literal Integer, that is lifted, and we don't
304 allow in a LitAlt, because LitAlt cases don't do any evaluation. Also
305 (see Trac #5603) if you say
306     case 3 of
307       S# x -> ...
308       J# _ _ -> ...
309 (where S#, J# are the constructors for Integer) we don't want the
310 simplifier calling findAlt with argument (LitAlt 3).  No no.  Integer
311 literals are an opaque encoding of an algebraic data type, not of
312 an unlifted literal, like all the others.
313
314
315 -------------------------- CoreSyn INVARIANTS ---------------------------
316
317 Note [CoreSyn top-level invariant]
318 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
319 See #toplevel_invariant#
320
321 Note [CoreSyn letrec invariant]
322 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
323 See #letrec_invariant#
324
325 Note [CoreSyn let/app invariant]
326 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
327 See #let_app_invariant#
328
329 This is intially enforced by DsUtils.mkCoreLet and mkCoreApp
330
331 Note [CoreSyn case invariants]
332 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
333 See #case_invariants#
334
335 Note [CoreSyn let goal]
336 ~~~~~~~~~~~~~~~~~~~~~~~
337 * The simplifier tries to ensure that if the RHS of a let is a constructor
338   application, its arguments are trivial, so that the constructor can be
339   inlined vigorously.
340
341
342 Note [Type let]
343 ~~~~~~~~~~~~~~~
344 See #type_let#
345
346 %************************************************************************
347 %*                                                                      *
348               Ticks
349 %*                                                                      *
350 %************************************************************************
351
352 \begin{code}
353 -- | Allows attaching extra information to points in expressions
354 data Tickish id =
355     -- | An @{-# SCC #-}@ profiling annotation, either automatically
356     -- added by the desugarer as a result of -auto-all, or added by
357     -- the user.
358     ProfNote {
359       profNoteCC    :: CostCentre, -- ^ the cost centre
360       profNoteCount :: !Bool,      -- ^ bump the entry count?
361       profNoteScope :: !Bool       -- ^ scopes over the enclosed expression
362                                    -- (i.e. not just a tick)
363     }
364
365   -- | A "tick" used by HPC to track the execution of each
366   -- subexpression in the original source code.
367   | HpcTick {
368       tickModule :: Module,
369       tickId     :: !Int
370     }
371
372   -- | A breakpoint for the GHCi debugger.  This behaves like an HPC
373   -- tick, but has a list of free variables which will be available
374   -- for inspection in GHCi when the program stops at the breakpoint.
375   --
376   -- NB. we must take account of these Ids when (a) counting free variables,
377   -- and (b) substituting (don't substitute for them)
378   | Breakpoint
379     { breakpointId     :: !Int
380     , breakpointFVs    :: [id]  -- ^ the order of this list is important:
381                                 -- it matches the order of the lists in the
382                                 -- appropriate entry in HscTypes.ModBreaks.
383                                 --
384                                 -- Careful about substitution!  See
385                                 -- Note [substTickish] in CoreSubst.
386     }
387
388   deriving (Eq, Ord, Data, Typeable)
389
390
391 -- | A "tick" note is one that counts evaluations in some way.  We
392 -- cannot discard a tick, and the compiler should preserve the number
393 -- of ticks as far as possible.
394 --
395 -- Hwever, we stil allow the simplifier to increase or decrease
396 -- sharing, so in practice the actual number of ticks may vary, except
397 -- that we never change the value from zero to non-zero or vice versa.
398 --
399 tickishCounts :: Tickish id -> Bool
400 tickishCounts n@ProfNote{} = profNoteCount n
401 tickishCounts HpcTick{}    = True
402 tickishCounts Breakpoint{} = True
403
404 tickishScoped :: Tickish id -> Bool
405 tickishScoped n@ProfNote{} = profNoteScope n
406 tickishScoped HpcTick{}    = False
407 tickishScoped Breakpoint{} = True
408    -- Breakpoints are scoped: eventually we're going to do call
409    -- stacks, but also this helps prevent the simplifier from moving
410    -- breakpoints around and changing their result type (see #1531).
411
412 mkNoTick :: Tickish id -> Tickish id
413 mkNoTick n@ProfNote{} = n {profNoteCount = False}
414 mkNoTick Breakpoint{} = panic "mkNoTick: Breakpoint" -- cannot split a BP
415 mkNoTick t = t
416
417 mkNoScope :: Tickish id -> Tickish id
418 mkNoScope n@ProfNote{} = n {profNoteScope = False}
419 mkNoScope Breakpoint{} = panic "mkNoScope: Breakpoint" -- cannot split a BP
420 mkNoScope t = t
421
422 -- | Return True if this source annotation compiles to some code, or will
423 -- disappear before the backend.
424 tickishIsCode :: Tickish id -> Bool
425 tickishIsCode _tickish = True  -- all of them for now
426
427 -- | Return True if this Tick can be split into (tick,scope) parts with
428 -- 'mkNoScope' and 'mkNoTick' respectively.
429 tickishCanSplit :: Tickish Id -> Bool
430 tickishCanSplit Breakpoint{} = False
431 tickishCanSplit _ = True
432 \end{code}
433
434
435 %************************************************************************
436 %*                                                                      *
437 \subsection{Transformation rules}
438 %*                                                                      *
439 %************************************************************************
440
441 The CoreRule type and its friends are dealt with mainly in CoreRules,
442 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
443
444 \begin{code}
445 -- | A 'CoreRule' is:
446 --
447 -- * \"Local\" if the function it is a rule for is defined in the
448 --   same module as the rule itself.
449 --
450 -- * \"Orphan\" if nothing on the LHS is defined in the same module
451 --   as the rule itself
452 data CoreRule
453   = Rule { 
454         ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user
455         ru_act  :: Activation,          -- ^ When the rule is active
456
457         -- Rough-matching stuff
458         -- see comments with InstEnv.ClsInst( is_cls, is_rough )
459         ru_fn    :: Name,               -- ^ Name of the 'Id.Id' at the head of this rule
460         ru_rough :: [Maybe Name],       -- ^ Name at the head of each argument to the left hand side
461         
462         -- Proper-matching stuff
463         -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
464         ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over
465         ru_args  :: [CoreExpr],         -- ^ Left hand side arguments
466         
467         -- And the right-hand side
468         ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule
469                                         -- Occurrence info is guaranteed correct
470                                         -- See Note [OccInfo in unfoldings and rules]
471
472         -- Locality
473         ru_auto :: Bool,        -- ^ @True@  <=> this rule is auto-generated
474                                 --   @False@ <=> generated at the users behest
475                                 --   Main effect: reporting of orphan-hood
476
477         ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
478                                 -- defined in the same module as the rule
479                                 -- and is not an implicit 'Id' (like a record selector,
480                                 -- class operation, or data constructor)
481
482                 -- NB: ru_local is *not* used to decide orphan-hood
483                 --      c.g. MkIface.coreRuleToIfaceRule
484     }
485
486   -- | Built-in rules are used for constant folding
487   -- and suchlike.  They have no free variables.
488   | BuiltinRule {               
489         ru_name  :: RuleName,   -- ^ As above
490         ru_fn    :: Name,       -- ^ As above
491         ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,
492                                 -- if it fires, including type arguments
493         ru_try  :: IdUnfoldingFun -> [CoreExpr] -> Maybe CoreExpr
494                 -- ^ This function does the rewrite.  It given too many
495                 -- arguments, it simply discards them; the returned 'CoreExpr'
496                 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
497     }
498                 -- See Note [Extra args in rule matching] in Rules.lhs
499
500 type IdUnfoldingFun = Id -> Unfolding
501 -- A function that embodies how to unfold an Id if you need
502 -- to do that in the Rule.  The reason we need to pass this info in
503 -- is that whether an Id is unfoldable depends on the simplifier phase
504
505 isBuiltinRule :: CoreRule -> Bool
506 isBuiltinRule (BuiltinRule {}) = True
507 isBuiltinRule _                = False
508
509 -- | The number of arguments the 'ru_fn' must be applied 
510 -- to before the rule can match on it
511 ruleArity :: CoreRule -> Int
512 ruleArity (BuiltinRule {ru_nargs = n}) = n
513 ruleArity (Rule {ru_args = args})      = length args
514
515 ruleName :: CoreRule -> RuleName
516 ruleName = ru_name
517
518 ruleActivation :: CoreRule -> Activation
519 ruleActivation (BuiltinRule { })       = AlwaysActive
520 ruleActivation (Rule { ru_act = act }) = act
521
522 -- | The 'Name' of the 'Id.Id' at the head of the rule left hand side
523 ruleIdName :: CoreRule -> Name
524 ruleIdName = ru_fn
525
526 isLocalRule :: CoreRule -> Bool
527 isLocalRule = ru_local
528
529 -- | Set the 'Name' of the 'Id.Id' at the head of the rule left hand side
530 setRuleIdName :: Name -> CoreRule -> CoreRule
531 setRuleIdName nm ru = ru { ru_fn = nm }
532 \end{code}
533
534
535 %************************************************************************
536 %*                                                                      *
537 \subsection{Vectorisation declarations}
538 %*                                                                      *
539 %************************************************************************
540
541 Representation of desugared vectorisation declarations that are fed to the vectoriser (via
542 'ModGuts').
543
544 \begin{code}
545 data CoreVect = Vect      Id   (Maybe CoreExpr)
546               | NoVect    Id
547               | VectType  Bool TyCon (Maybe TyCon)
548               | VectClass TyCon                     -- class tycon
549               | VectInst  Id                        -- instance dfun (always SCALAR)
550 \end{code}
551
552
553 %************************************************************************
554 %*                                                                      *
555                 Unfoldings
556 %*                                                                      *
557 %************************************************************************
558
559 The @Unfolding@ type is declared here to avoid numerous loops
560
561 \begin{code}
562 -- | Records the /unfolding/ of an identifier, which is approximately the form the
563 -- identifier would have if we substituted its definition in for the identifier.
564 -- This type should be treated as abstract everywhere except in "CoreUnfold"
565 data Unfolding
566   = NoUnfolding        -- ^ We have no information about the unfolding
567
568   | OtherCon [AltCon]  -- ^ It ain't one of these constructors.
569                        -- @OtherCon xs@ also indicates that something has been evaluated
570                        -- and hence there's no point in re-evaluating it.
571                        -- @OtherCon []@ is used even for non-data-type values
572                        -- to indicated evaluated-ness.  Notably:
573                        --
574                        -- > data C = C !(Int -> Int)
575                        -- > case x of { C f -> ... }
576                        --
577                        -- Here, @f@ gets an @OtherCon []@ unfolding.
578
579   | DFunUnfolding       -- The Unfolding of a DFunId  
580                         -- See Note [DFun unfoldings]
581                         --     df = /\a1..am. \d1..dn. MkD (op1 a1..am d1..dn)
582                         --                                 (op2 a1..am d1..dn)
583
584         Arity           -- Arity = m+n, the *total* number of args 
585                         --   (unusually, both type and value) to the dfun
586
587         DataCon         -- The dictionary data constructor (possibly a newtype datacon)
588
589         [CoreExpr]      -- Specification of superclasses and methods, in positional order
590
591   | CoreUnfolding {             -- An unfolding for an Id with no pragma, 
592                                 -- or perhaps a NOINLINE pragma
593                                 -- (For NOINLINE, the phase, if any, is in the 
594                                 -- InlinePragInfo for this Id.)
595         uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct
596         uf_src        :: UnfoldingSource, -- Where the unfolding came from
597         uf_is_top     :: Bool,          -- True <=> top level binding
598         uf_arity      :: Arity,         -- Number of value arguments expected
599         uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard 
600                                         --      a `seq` on this variable
601         uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function
602                                         --      Cached version of exprIsConLike
603         uf_is_cheap   :: Bool,          -- True <=> doesn't waste (much) work to expand 
604                                         --          inside an inlining
605                                         --      Cached version of exprIsCheap
606         uf_expandable :: Bool,          -- True <=> can expand in RULE matching
607                                         --      Cached version of exprIsExpandable
608         uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.
609     }
610   -- ^ An unfolding with redundant cached information. Parameters:
611   --
612   --  uf_tmpl: Template used to perform unfolding; 
613   --           NB: Occurrence info is guaranteed correct: 
614   --               see Note [OccInfo in unfoldings and rules]
615   --
616   --  uf_is_top: Is this a top level binding?
617   --
618   --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
619   --     this variable
620   --
621   --  uf_is_cheap:  Does this waste only a little work if we expand it inside an inlining?
622   --     Basically this is a cached version of 'exprIsCheap'
623   --
624   --  uf_guidance:  Tells us about the /size/ of the unfolding template
625
626 ------------------------------------------------
627 data UnfoldingSource
628   = InlineRhs          -- The current rhs of the function
629                        -- Replace uf_tmpl each time around
630
631   | InlineStable       -- From an INLINE or INLINABLE pragma 
632                        --   INLINE     if guidance is UnfWhen
633                        --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever
634                        -- (well, technically an INLINABLE might be made
635                        -- UnfWhen if it was small enough, and then
636                        -- it will behave like INLINE outside the current
637                        -- module, but that is the way automatic unfoldings
638                        -- work so it is consistent with the intended
639                        -- meaning of INLINABLE).
640                        --
641                        -- uf_tmpl may change, but only as a result of
642                        -- gentle simplification, it doesn't get updated
643                        -- to the current RHS during compilation as with
644                        -- InlineRhs.
645                        --
646                        -- See Note [InlineRules]
647
648   | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
649                        -- Only a few primop-like things have this property 
650                        -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
651                        -- Inline absolutely always, however boring the context.
652
653   | InlineWrapper Id   -- This unfolding is a the wrapper in a 
654                        --     worker/wrapper split from the strictness analyser
655                        -- The Id is the worker-id
656                        -- Used to abbreviate the uf_tmpl in interface files
657                        --       which don't need to contain the RHS; 
658                        --       it can be derived from the strictness info
659
660
661
662 -- | 'UnfoldingGuidance' says when unfolding should take place
663 data UnfoldingGuidance
664   = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl
665                 -- Used (a) for small *and* cheap unfoldings
666                 --      (b) for INLINE functions 
667                 -- See Note [INLINE for small functions] in CoreUnfold
668       ug_unsat_ok  :: Bool,     -- True <=> ok to inline even if unsaturated
669       ug_boring_ok :: Bool      -- True <=> ok to inline even if the context is boring
670                 -- So True,True means "always"
671     }
672
673   | UnfIfGoodArgs {     -- Arose from a normal Id; the info here is the
674                         -- result of a simple analysis of the RHS
675
676       ug_args ::  [Int],  -- Discount if the argument is evaluated.
677                           -- (i.e., a simplification will definitely
678                           -- be possible).  One elt of the list per *value* arg.
679
680       ug_size :: Int,     -- The "size" of the unfolding.
681
682       ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in
683     }                     -- a context (case (thing args) of ...),
684                           -- (where there are the right number of arguments.)
685
686   | UnfNever        -- The RHS is big, so don't inline it
687 \end{code}
688
689
690 Note [DFun unfoldings]
691 ~~~~~~~~~~~~~~~~~~~~~~
692 The Arity in a DFunUnfolding is total number of args (type and value)
693 that the DFun needs to produce a dictionary.  That's not necessarily 
694 related to the ordinary arity of the dfun Id, esp if the class has
695 one method, so the dictionary is represented by a newtype.  Example
696
697      class C a where { op :: a -> Int }
698      instance C a -> C [a] where op xs = op (head xs)
699
700 The instance translates to
701
702      $dfCList :: forall a. C a => C [a]  -- Arity 2!
703      $dfCList = /\a.\d. $copList {a} d |> co
704  
705      $copList :: forall a. C a => [a] -> Int  -- Arity 2!
706      $copList = /\a.\d.\xs. op {a} d (head xs)
707
708 Now we might encounter (op (dfCList {ty} d) a1 a2)
709 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
710 has all its arguments, even though its (value) arity is 2.  That's
711 why we record the number of expected arguments in the DFunUnfolding.
712
713 Note that although it's an Arity, it's most convenient for it to give
714 the *total* number of arguments, both type and value.  See the use
715 site in exprIsConApp_maybe.
716
717 \begin{code}
718 -- Constants for the UnfWhen constructor
719 needSaturated, unSaturatedOk :: Bool
720 needSaturated = False
721 unSaturatedOk = True
722
723 boringCxtNotOk, boringCxtOk :: Bool
724 boringCxtOk    = True
725 boringCxtNotOk = False
726
727 ------------------------------------------------
728 noUnfolding :: Unfolding
729 -- ^ There is no known 'Unfolding'
730 evaldUnfolding :: Unfolding
731 -- ^ This unfolding marks the associated thing as being evaluated
732
733 noUnfolding    = NoUnfolding
734 evaldUnfolding = OtherCon []
735
736 mkOtherCon :: [AltCon] -> Unfolding
737 mkOtherCon = OtherCon
738
739 seqUnfolding :: Unfolding -> ()
740 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top, 
741                 uf_is_value = b1, uf_is_cheap = b2, 
742                 uf_expandable = b3, uf_is_conlike = b4,
743                 uf_arity = a, uf_guidance = g})
744   = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
745
746 seqUnfolding _ = ()
747
748 seqGuidance :: UnfoldingGuidance -> ()
749 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
750 seqGuidance _                      = ()
751 \end{code}
752
753 \begin{code}
754 isStableSource :: UnfoldingSource -> Bool
755 -- Keep the unfolding template
756 isStableSource InlineCompulsory   = True
757 isStableSource InlineStable       = True
758 isStableSource (InlineWrapper {}) = True
759 isStableSource InlineRhs          = False
760  
761 -- | Retrieves the template of an unfolding: panics if none is known
762 unfoldingTemplate :: Unfolding -> CoreExpr
763 unfoldingTemplate = uf_tmpl
764
765 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
766 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
767
768 -- | Retrieves the template of an unfolding if possible
769 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
770 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })       = Just expr
771 maybeUnfoldingTemplate _                                        = Nothing
772
773 -- | The constructors that the unfolding could never be: 
774 -- returns @[]@ if no information is available
775 otherCons :: Unfolding -> [AltCon]
776 otherCons (OtherCon cons) = cons
777 otherCons _               = []
778
779 -- | Determines if it is certainly the case that the unfolding will
780 -- yield a value (something in HNF): returns @False@ if unsure
781 isValueUnfolding :: Unfolding -> Bool
782         -- Returns False for OtherCon
783 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
784 isValueUnfolding _                                          = False
785
786 -- | Determines if it possibly the case that the unfolding will
787 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
788 -- for 'OtherCon'
789 isEvaldUnfolding :: Unfolding -> Bool
790         -- Returns True for OtherCon
791 isEvaldUnfolding (OtherCon _)                               = True
792 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
793 isEvaldUnfolding _                                          = False
794
795 -- | @True@ if the unfolding is a constructor application, the application
796 -- of a CONLIKE function or 'OtherCon'
797 isConLikeUnfolding :: Unfolding -> Bool
798 isConLikeUnfolding (OtherCon _)                             = True
799 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
800 isConLikeUnfolding _                                        = False
801
802 -- | Is the thing we will unfold into certainly cheap?
803 isCheapUnfolding :: Unfolding -> Bool
804 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
805 isCheapUnfolding _                                          = False
806
807 isExpandableUnfolding :: Unfolding -> Bool
808 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
809 isExpandableUnfolding _                                              = False
810
811 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
812 -- Expand an expandable unfolding; this is used in rule matching 
813 --   See Note [Expanding variables] in Rules.lhs
814 -- The key point here is that CONLIKE things can be expanded
815 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
816 expandUnfolding_maybe _                                                       = Nothing
817
818 isStableCoreUnfolding_maybe :: Unfolding -> Maybe UnfoldingSource
819 isStableCoreUnfolding_maybe (CoreUnfolding { uf_src = src })
820    | isStableSource src   = Just src
821 isStableCoreUnfolding_maybe _ = Nothing
822
823 isCompulsoryUnfolding :: Unfolding -> Bool
824 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
825 isCompulsoryUnfolding _                                             = False
826
827 isStableUnfolding :: Unfolding -> Bool
828 -- True of unfoldings that should not be overwritten 
829 -- by a CoreUnfolding for the RHS of a let-binding
830 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
831 isStableUnfolding (DFunUnfolding {})               = True
832 isStableUnfolding _                                = False
833
834 unfoldingArity :: Unfolding -> Arity
835 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
836 unfoldingArity _                                    = panic "unfoldingArity"
837
838 isClosedUnfolding :: Unfolding -> Bool          -- No free variables
839 isClosedUnfolding (CoreUnfolding {}) = False
840 isClosedUnfolding (DFunUnfolding {}) = False
841 isClosedUnfolding _                  = True
842
843 -- | Only returns False if there is no unfolding information available at all
844 hasSomeUnfolding :: Unfolding -> Bool
845 hasSomeUnfolding NoUnfolding = False
846 hasSomeUnfolding _           = True
847
848 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
849 neverUnfoldGuidance UnfNever = True
850 neverUnfoldGuidance _        = False
851
852 canUnfold :: Unfolding -> Bool
853 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
854 canUnfold _                                   = False
855 \end{code}
856
857 Note [InlineRules]
858 ~~~~~~~~~~~~~~~~~
859 When you say 
860       {-# INLINE f #-}
861       f x = <rhs>
862 you intend that calls (f e) are replaced by <rhs>[e/x] So we
863 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
864 with it.  Meanwhile, we can optimise <rhs> to our heart's content,
865 leaving the original unfolding intact in Unfolding of 'f'. For example
866         all xs = foldr (&&) True xs
867         any p = all . map p  {-# INLINE any #-}
868 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
869 which deforests well at the call site.
870
871 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
872
873 Moreover, it's only used when 'f' is applied to the
874 specified number of arguments; that is, the number of argument on 
875 the LHS of the '=' sign in the original source definition. 
876 For example, (.) is now defined in the libraries like this
877    {-# INLINE (.) #-}
878    (.) f g = \x -> f (g x)
879 so that it'll inline when applied to two arguments. If 'x' appeared
880 on the left, thus
881    (.) f g x = f (g x)
882 it'd only inline when applied to three arguments.  This slightly-experimental
883 change was requested by Roman, but it seems to make sense.
884
885 See also Note [Inlining an InlineRule] in CoreUnfold.
886
887
888 Note [OccInfo in unfoldings and rules]
889 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
890 In unfoldings and rules, we guarantee that the template is occ-analysed,
891 so that the occurence info on the binders is correct.  This is important,
892 because the Simplifier does not re-analyse the template when using it. If
893 the occurrence info is wrong
894   - We may get more simpifier iterations than necessary, because
895     once-occ info isn't there
896   - More seriously, we may get an infinite loop if there's a Rec
897     without a loop breaker marked
898
899
900 %************************************************************************
901 %*                                                                      *
902                   AltCon
903 %*                                                                      *
904 %************************************************************************
905
906 \begin{code}
907 -- The Ord is needed for the FiniteMap used in the lookForConstructor
908 -- in SimplEnv.  If you declared that lookForConstructor *ignores*
909 -- constructor-applications with LitArg args, then you could get
910 -- rid of this Ord.
911
912 instance Outputable AltCon where
913   ppr (DataAlt dc) = ppr dc
914   ppr (LitAlt lit) = ppr lit
915   ppr DEFAULT      = ptext (sLit "__DEFAULT")
916
917 instance Show AltCon where
918   showsPrec p con = showsPrecSDoc p (ppr con)
919
920 cmpAlt :: Alt b -> Alt b -> Ordering
921 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
922
923 ltAlt :: Alt b -> Alt b -> Bool
924 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
925
926 cmpAltCon :: AltCon -> AltCon -> Ordering
927 -- ^ Compares 'AltCon's within a single list of alternatives
928 cmpAltCon DEFAULT      DEFAULT     = EQ
929 cmpAltCon DEFAULT      _           = LT
930
931 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
932 cmpAltCon (DataAlt _)  DEFAULT      = GT
933 cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
934 cmpAltCon (LitAlt _)   DEFAULT      = GT
935
936 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+> 
937                                   ppr con1 <+> ppr con2 )
938                       LT
939 \end{code}
940
941 %************************************************************************
942 %*                                                                      *
943 \subsection{Useful synonyms}
944 %*                                                                      *
945 %************************************************************************
946
947 Note [CoreProgram]
948 ~~~~~~~~~~~~~~~~~~
949 The top level bindings of a program, a CoreProgram, are represented as
950 a list of CoreBind
951
952  * Later bindings in the list can refer to earlier ones, but not vice
953    versa.  So this is OK
954       NonRec { x = 4 }
955       Rec { p = ...q...x...
956           ; q = ...p...x }
957       Rec { f = ...p..x..f.. }
958       NonRec { g = ..f..q...x.. }
959    But it would NOT be ok for 'f' to refer to 'g'.
960
961  * The occurrence analyser does strongly-connected component analysis
962    on each Rec binding, and splits it into a sequence of smaller
963    bindings where possible.  So the program typically starts life as a
964    single giant Rec, which is then dependency-analysed into smaller
965    chunks.  
966
967 \begin{code}
968 type CoreProgram = [CoreBind]   -- See Note [CoreProgram]
969
970 -- | The common case for the type of binders and variables when
971 -- we are manipulating the Core language within GHC
972 type CoreBndr = Var
973 -- | Expressions where binders are 'CoreBndr's
974 type CoreExpr = Expr CoreBndr
975 -- | Argument expressions where binders are 'CoreBndr's
976 type CoreArg  = Arg  CoreBndr
977 -- | Binding groups where binders are 'CoreBndr's
978 type CoreBind = Bind CoreBndr
979 -- | Case alternatives where binders are 'CoreBndr's
980 type CoreAlt  = Alt  CoreBndr
981 \end{code}
982
983 %************************************************************************
984 %*                                                                      *
985 \subsection{Tagging}
986 %*                                                                      *
987 %************************************************************************
988
989 \begin{code}
990 -- | Binders are /tagged/ with a t
991 data TaggedBndr t = TB CoreBndr t       -- TB for "tagged binder"
992
993 type TaggedBind t = Bind (TaggedBndr t)
994 type TaggedExpr t = Expr (TaggedBndr t)
995 type TaggedArg  t = Arg  (TaggedBndr t)
996 type TaggedAlt  t = Alt  (TaggedBndr t)
997
998 instance Outputable b => Outputable (TaggedBndr b) where
999   ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
1000
1001 instance Outputable b => OutputableBndr (TaggedBndr b) where
1002   pprBndr _ b = ppr b   -- Simple
1003   pprInfixOcc  b = ppr b
1004   pprPrefixOcc b = ppr b
1005 \end{code}
1006
1007
1008 %************************************************************************
1009 %*                                                                      *
1010 \subsection{Core-constructing functions with checking}
1011 %*                                                                      *
1012 %************************************************************************
1013
1014 \begin{code}
1015 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
1016 -- use 'MkCore.mkCoreApps' if possible
1017 mkApps    :: Expr b -> [Arg b]  -> Expr b
1018 -- | Apply a list of type argument expressions to a function expression in a nested fashion
1019 mkTyApps  :: Expr b -> [Type]   -> Expr b
1020 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion
1021 mkCoApps  :: Expr b -> [Coercion] -> Expr b
1022 -- | Apply a list of type or value variables to a function expression in a nested fashion
1023 mkVarApps :: Expr b -> [Var] -> Expr b
1024 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
1025 -- use 'MkCore.mkCoreConApps' if possible
1026 mkConApp      :: DataCon -> [Arg b] -> Expr b
1027
1028 mkApps    f args = foldl App                       f args
1029 mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
1030 mkCoApps  f args = foldl (\ e a -> App e (Coercion a)) f args
1031 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
1032 mkConApp con args = mkApps (Var (dataConWorkId con)) args
1033
1034
1035 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
1036 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1037 mkIntLit      :: Integer -> Expr b
1038 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
1039 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
1040 mkIntLitInt   :: Int     -> Expr b
1041
1042 mkIntLit    n = Lit (mkMachInt n)
1043 mkIntLitInt n = Lit (mkMachInt (toInteger n))
1044
1045 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
1046 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1047 mkWordLit     :: Integer -> Expr b
1048 -- | Create a machine word literal expression of type  @Word#@ from a @Word@.
1049 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
1050 mkWordLitWord :: Word -> Expr b
1051
1052 mkWordLit     w = Lit (mkMachWord w)
1053 mkWordLitWord w = Lit (mkMachWord (toInteger w))
1054
1055 mkWord64LitWord64 :: Word64 -> Expr b
1056 mkWord64LitWord64 w = Lit (mkMachWord64 (toInteger w))
1057
1058 mkInt64LitInt64 :: Int64 -> Expr b
1059 mkInt64LitInt64 w = Lit (mkMachInt64 (toInteger w))
1060
1061 -- | Create a machine character literal expression of type @Char#@.
1062 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
1063 mkCharLit :: Char -> Expr b
1064 -- | Create a machine string literal expression of type @Addr#@.
1065 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
1066 mkStringLit :: String -> Expr b
1067
1068 mkCharLit   c = Lit (mkMachChar c)
1069 mkStringLit s = Lit (mkMachString s)
1070
1071 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
1072 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1073 mkFloatLit :: Rational -> Expr b
1074 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
1075 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
1076 mkFloatLitFloat :: Float -> Expr b
1077
1078 mkFloatLit      f = Lit (mkMachFloat f)
1079 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
1080
1081 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
1082 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1083 mkDoubleLit :: Rational -> Expr b
1084 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
1085 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
1086 mkDoubleLitDouble :: Double -> Expr b
1087
1088 mkDoubleLit       d = Lit (mkMachDouble d)
1089 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
1090
1091 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
1092 -- use 'MkCore.mkCoreLets' if possible
1093 mkLets        :: [Bind b] -> Expr b -> Expr b
1094 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
1095 -- use 'MkCore.mkCoreLams' if possible
1096 mkLams        :: [b] -> Expr b -> Expr b
1097
1098 mkLams binders body = foldr Lam body binders
1099 mkLets binds body   = foldr Let body binds
1100
1101
1102 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1103 -- this can only be used to bind something in a non-recursive @let@ expression
1104 mkTyBind :: TyVar -> Type -> CoreBind
1105 mkTyBind tv ty      = NonRec tv (Type ty)
1106
1107 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
1108 -- this can only be used to bind something in a non-recursive @let@ expression
1109 mkCoBind :: CoVar -> Coercion -> CoreBind
1110 mkCoBind cv co      = NonRec cv (Coercion co)
1111
1112 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
1113 varToCoreExpr :: CoreBndr -> Expr b
1114 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
1115                 | isCoVar v = Coercion (mkCoVarCo v)
1116                 | otherwise = ASSERT( isId v ) Var v
1117
1118 varsToCoreExprs :: [CoreBndr] -> [Expr b]
1119 varsToCoreExprs vs = map varToCoreExpr vs
1120 \end{code}
1121
1122
1123 %************************************************************************
1124 %*                                                                      *
1125 \subsection{Simple access functions}
1126 %*                                                                      *
1127 %************************************************************************
1128
1129 \begin{code}
1130 -- | Extract every variable by this group
1131 bindersOf  :: Bind b -> [b]
1132 bindersOf (NonRec binder _) = [binder]
1133 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
1134
1135 -- | 'bindersOf' applied to a list of binding groups
1136 bindersOfBinds :: [Bind b] -> [b]
1137 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
1138
1139 rhssOfBind :: Bind b -> [Expr b]
1140 rhssOfBind (NonRec _ rhs) = [rhs]
1141 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
1142
1143 rhssOfAlts :: [Alt b] -> [Expr b]
1144 rhssOfAlts alts = [e | (_,_,e) <- alts]
1145
1146 -- | Collapse all the bindings in the supplied groups into a single
1147 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
1148 flattenBinds :: [Bind b] -> [(b, Expr b)]
1149 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
1150 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
1151 flattenBinds []                   = []
1152 \end{code}
1153
1154 \begin{code}
1155 -- | We often want to strip off leading lambdas before getting down to
1156 -- business. This function is your friend.
1157 collectBinders               :: Expr b -> ([b],         Expr b)
1158 -- | Collect as many type bindings as possible from the front of a nested lambda
1159 collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
1160 -- | Collect as many value bindings as possible from the front of a nested lambda
1161 collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
1162 -- | Collect type binders from the front of the lambda first, 
1163 -- then follow up by collecting as many value bindings as possible
1164 -- from the resulting stripped expression
1165 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
1166
1167 collectBinders expr
1168   = go [] expr
1169   where
1170     go bs (Lam b e) = go (b:bs) e
1171     go bs e          = (reverse bs, e)
1172
1173 collectTyAndValBinders expr
1174   = (tvs, ids, body)
1175   where
1176     (tvs, body1) = collectTyBinders expr
1177     (ids, body)  = collectValBinders body1
1178
1179 collectTyBinders expr
1180   = go [] expr
1181   where
1182     go tvs (Lam b e) | isTyVar b = go (b:tvs) e
1183     go tvs e                     = (reverse tvs, e)
1184
1185 collectValBinders expr
1186   = go [] expr
1187   where
1188     go ids (Lam b e) | isId b = go (b:ids) e
1189     go ids body               = (reverse ids, body)
1190 \end{code}
1191
1192 \begin{code}
1193 -- | Takes a nested application expression and returns the the function
1194 -- being applied and the arguments to which it is applied
1195 collectArgs :: Expr b -> (Expr b, [Arg b])
1196 collectArgs expr
1197   = go expr []
1198   where
1199     go (App f a) as = go f (a:as)
1200     go e         as = (e, as)
1201 \end{code}
1202
1203 %************************************************************************
1204 %*                                                                      *
1205 \subsection{Predicates}
1206 %*                                                                      *
1207 %************************************************************************
1208
1209 At one time we optionally carried type arguments through to runtime.
1210 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
1211 i.e. if type applications are actual lambdas because types are kept around
1212 at runtime.  Similarly isRuntimeArg.  
1213
1214 \begin{code}
1215 -- | Will this variable exist at runtime?
1216 isRuntimeVar :: Var -> Bool
1217 isRuntimeVar = isId 
1218
1219 -- | Will this argument expression exist at runtime?
1220 isRuntimeArg :: CoreExpr -> Bool
1221 isRuntimeArg = isValArg
1222
1223 -- | Returns @False@ iff the expression is a 'Type' or 'Coercion'
1224 -- expression at its top level
1225 isValArg :: Expr b -> Bool
1226 isValArg e = not (isTypeArg e)
1227
1228 -- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
1229 -- expression at its top level
1230 isTyCoArg :: Expr b -> Bool
1231 isTyCoArg (Type {})     = True
1232 isTyCoArg (Coercion {}) = True
1233 isTyCoArg _             = False
1234
1235 -- | Returns @True@ iff the expression is a 'Type' expression at its
1236 -- top level.  Note this does NOT include 'Coercion's.
1237 isTypeArg :: Expr b -> Bool
1238 isTypeArg (Type {}) = True
1239 isTypeArg _         = False
1240
1241 -- | The number of binders that bind values rather than types
1242 valBndrCount :: [CoreBndr] -> Int
1243 valBndrCount = count isId
1244
1245 -- | The number of argument expressions that are values rather than types at their top level
1246 valArgCount :: [Arg b] -> Int
1247 valArgCount = count isValArg
1248 \end{code}
1249
1250
1251 %************************************************************************
1252 %*                                                                      *
1253 \subsection{Seq stuff}
1254 %*                                                                      *
1255 %************************************************************************
1256
1257 \begin{code}
1258 seqExpr :: CoreExpr -> ()
1259 seqExpr (Var v)         = v `seq` ()
1260 seqExpr (Lit lit)       = lit `seq` ()
1261 seqExpr (App f a)       = seqExpr f `seq` seqExpr a
1262 seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
1263 seqExpr (Let b e)       = seqBind b `seq` seqExpr e
1264 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
1265 seqExpr (Cast e co)     = seqExpr e `seq` seqCo co
1266 seqExpr (Tick n e)    = seqTickish n `seq` seqExpr e
1267 seqExpr (Type t)       = seqType t
1268 seqExpr (Coercion co)   = seqCo co
1269
1270 seqExprs :: [CoreExpr] -> ()
1271 seqExprs [] = ()
1272 seqExprs (e:es) = seqExpr e `seq` seqExprs es
1273
1274 seqTickish :: Tickish Id -> ()
1275 seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
1276 seqTickish HpcTick{} = ()
1277 seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
1278
1279 seqBndr :: CoreBndr -> ()
1280 seqBndr b = b `seq` ()
1281
1282 seqBndrs :: [CoreBndr] -> ()
1283 seqBndrs [] = ()
1284 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
1285
1286 seqBind :: Bind CoreBndr -> ()
1287 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
1288 seqBind (Rec prs)    = seqPairs prs
1289
1290 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
1291 seqPairs [] = ()
1292 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
1293
1294 seqAlts :: [CoreAlt] -> ()
1295 seqAlts [] = ()
1296 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1297
1298 seqRules :: [CoreRule] -> ()
1299 seqRules [] = ()
1300 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules) 
1301   = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1302 seqRules (BuiltinRule {} : rules) = seqRules rules
1303 \end{code}
1304
1305 %************************************************************************
1306 %*                                                                      *
1307 \subsection{Annotated core}
1308 %*                                                                      *
1309 %************************************************************************
1310
1311 \begin{code}
1312 -- | Annotated core: allows annotation at every node in the tree
1313 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1314
1315 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1316 data AnnExpr' bndr annot
1317   = AnnVar      Id
1318   | AnnLit      Literal
1319   | AnnLam      bndr (AnnExpr bndr annot)
1320   | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)
1321   | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1322   | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)
1323   | AnnCast     (AnnExpr bndr annot) (annot, Coercion)
1324                    -- Put an annotation on the (root of) the coercion
1325   | AnnTick     (Tickish Id) (AnnExpr bndr annot)
1326   | AnnType     Type
1327   | AnnCoercion Coercion
1328
1329 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1330 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1331
1332 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1333 data AnnBind bndr annot
1334   = AnnNonRec bndr (AnnExpr bndr annot)
1335   | AnnRec    [(bndr, AnnExpr bndr annot)]
1336 \end{code}
1337
1338 \begin{code}
1339 -- | Takes a nested application expression and returns the the function
1340 -- being applied and the arguments to which it is applied
1341 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
1342 collectAnnArgs expr
1343   = go expr []
1344   where
1345     go (_, AnnApp f a) as = go f (a:as)
1346     go e               as = (e, as)
1347 \end{code}
1348
1349 \begin{code}
1350 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1351 deAnnotate (_, e) = deAnnotate' e
1352
1353 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1354 deAnnotate' (AnnType t)           = Type t
1355 deAnnotate' (AnnCoercion co)      = Coercion co
1356 deAnnotate' (AnnVar  v)           = Var v
1357 deAnnotate' (AnnLit  lit)         = Lit lit
1358 deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
1359 deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
1360 deAnnotate' (AnnCast e (_,co))    = Cast (deAnnotate e) co
1361 deAnnotate' (AnnTick tick body)   = Tick tick (deAnnotate body)
1362
1363 deAnnotate' (AnnLet bind body)
1364   = Let (deAnnBind bind) (deAnnotate body)
1365   where
1366     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1367     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1368
1369 deAnnotate' (AnnCase scrut v t alts)
1370   = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1371
1372 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1373 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1374 \end{code}
1375
1376 \begin{code}
1377 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1378 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1379 collectAnnBndrs e
1380   = collect [] e
1381   where
1382     collect bs (_, AnnLam b body) = collect (b:bs) body
1383     collect bs body               = (reverse bs, body)
1384 \end{code}