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