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