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