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(..), InlSatFlag(..),
  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   = InlineRule {        -- Be very keen to inline this; See Note [InlineRules]
 444                         -- The uf_tmpl is the *original* RHS; do *not* replace it on
 445                         --   each simlifier run.  Hence, the *actual* RHS of the function
 446                         --   may be different by now, because it may have been optimised.
 447
 448         ir_sat  :: InlSatFlag,
 449         ir_info :: InlineRuleInfo
 450     }
 451
 452   | UnfoldIfGoodArgs {  -- Arose from a normal Id; the info here is the
 453                         -- result of a simple analysis of the RHS
 454
 455       ug_args ::  [Int],  -- Discount if the argument is evaluated.
 456                           -- (i.e., a simplification will definitely
 457                           -- be possible).  One elt of the list per *value* arg.
 458
 459       ug_size :: Int,     -- The "size" of the unfolding.
 460
 461       ug_res :: Int       -- Scrutinee discount: the discount to substract if the thing is in
 462     }                     -- a context (case (thing args) of ...),
 463                           -- (where there are the right number of arguments.)
 464
 465   | UnfoldNever           -- A variant of UnfoldIfGoodArgs, used for big RHSs
 466
 467 data InlineRuleInfo
 468   = InlAlways       -- Inline absolutely always, however boring the context.
 469                     -- There is /no original definition/. Only a few primop-like things
 470                     -- have this property (see MkId.lhs, calls to mkCompulsoryUnfolding).
 471
 472   | InlSmall        -- The RHS is very small (eg no bigger than a call), so inline any
 473                     -- /saturated/ application, regardless of context
 474                     -- See Note [INLINE for small functions] in CoreUnfold
 475
 476   | InlVanilla
 477
 478   | InlWrapper Id   -- This unfolding is a the wrapper in a
 479                     --     worker/wrapper split from the strictness analyser
 480                     -- Used to abbreviate the uf_tmpl in interface files
 481                     --  which don't need to contain the RHS;
 482                     --  it can be derived from the strictness info
 483                     -- [In principle this is orthogonal to the InlSmall/InVanilla thing,
 484                     --  but it's convenient to have it here.]
 485
 486 data InlSatFlag = InlSat | InlUnSat
 487     -- Specifies whether to INLINE only if the thing is applied to 'arity' args
 488
 489 ------------------------------------------------
 490 noUnfolding :: Unfolding
 491 -- ^ There is no known 'Unfolding'
 492 evaldUnfolding :: Unfolding
 493 -- ^ This unfolding marks the associated thing as being evaluated
 494
 495 noUnfolding    = NoUnfolding
 496 evaldUnfolding = OtherCon []
 497
 498 mkOtherCon :: [AltCon] -> Unfolding
 499 mkOtherCon = OtherCon
 500
 501 seqUnfolding :: Unfolding -> ()
 502 seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
 503                 uf_is_value = b1, uf_is_cheap = b2,
 504                 uf_expandable = b3, uf_is_conlike = b4,
 505                 uf_arity = a, uf_guidance = g})
 506   = seqExpr e `seq` top `seq` b1 `seq` a `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
 507
 508 seqUnfolding _ = ()
 509
 510 seqGuidance :: UnfoldingGuidance -> ()
 511 seqGuidance (UnfoldIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
 512 seqGuidance _                         = ()
 513 \end{code}
 514
 515 \begin{code}
 516 -- | Retrieves the template of an unfolding: panics if none is known
 517 unfoldingTemplate :: Unfolding -> CoreExpr
 518 unfoldingTemplate = uf_tmpl
 519
 520 setUnfoldingTemplate :: Unfolding -> CoreExpr -> Unfolding
 521 setUnfoldingTemplate unf rhs = unf { uf_tmpl = rhs }
 522
 523 -- | Retrieves the template of an unfolding if possible
 524 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
 525 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })       = Just expr
 526 maybeUnfoldingTemplate _                                        = Nothing
 527
 528 -- | The constructors that the unfolding could never be:
 529 -- returns @[]@ if no information is available
 530 otherCons :: Unfolding -> [AltCon]
 531 otherCons (OtherCon cons) = cons
 532 otherCons _               = []
 533
 534 -- | Determines if it is certainly the case that the unfolding will
 535 -- yield a value (something in HNF): returns @False@ if unsure
 536 isValueUnfolding :: Unfolding -> Bool
 537         -- Returns False for OtherCon
 538 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 539 isValueUnfolding _                                          = False
 540
 541 -- | Determines if it possibly the case that the unfolding will
 542 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
 543 -- for 'OtherCon'
 544 isEvaldUnfolding :: Unfolding -> Bool
 545         -- Returns True for OtherCon
 546 isEvaldUnfolding (OtherCon _)                               = True
 547 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 548 isEvaldUnfolding _                                          = False
 549
 550 -- | @True@ if the unfolding is a constructor application, the application
 551 -- of a CONLIKE function or 'OtherCon'
 552 isConLikeUnfolding :: Unfolding -> Bool
 553 isConLikeUnfolding (OtherCon _)                             = True
 554 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
 555 isConLikeUnfolding _                                        = False
 556
 557 -- | Is the thing we will unfold into certainly cheap?
 558 isCheapUnfolding :: Unfolding -> Bool
 559 isCheapUnfolding (CoreUnfolding { uf_is_cheap = is_cheap }) = is_cheap
 560 isCheapUnfolding _                                          = False
 561
 562 isExpandableUnfolding :: Unfolding -> Bool
 563 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
 564 isExpandableUnfolding _                                              = False
 565
 566 isInlineRule :: Unfolding -> Bool
 567 isInlineRule (CoreUnfolding { uf_guidance = InlineRule {}}) = True
 568 isInlineRule _                                              = False
 569
 570 isInlineRule_maybe :: Unfolding -> Maybe (InlineRuleInfo, InlSatFlag)
 571 isInlineRule_maybe (CoreUnfolding { uf_guidance =
 572                         InlineRule { ir_info = inl, ir_sat = sat } }) = Just (inl,sat)
 573 isInlineRule_maybe _                                                  = Nothing
 574
 575 isStableUnfolding :: Unfolding -> Bool
 576 -- True of unfoldings that should not be overwritten
 577 -- by a CoreUnfolding for the RHS of a let-binding
 578 isStableUnfolding (CoreUnfolding { uf_guidance = InlineRule {} }) = True
 579 isStableUnfolding (DFunUnfolding {})                              = True
 580 isStableUnfolding _                                               = False
 581
 582 unfoldingArity :: Unfolding -> Arity
 583 unfoldingArity (CoreUnfolding { uf_arity = arity }) = arity
 584 unfoldingArity _                                    = panic "unfoldingArity"
 585
 586 isClosedUnfolding :: Unfolding -> Bool          -- No free variables
 587 isClosedUnfolding (CoreUnfolding {}) = False
 588 isClosedUnfolding _                  = True
 589
 590 -- | Only returns False if there is no unfolding information available at all
 591 hasSomeUnfolding :: Unfolding -> Bool
 592 hasSomeUnfolding NoUnfolding = False
 593 hasSomeUnfolding _           = True
 594
 595 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
 596 neverUnfoldGuidance UnfoldNever = True
 597 neverUnfoldGuidance _           = False
 598
 599 canUnfold :: Unfolding -> Bool
 600 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
 601 canUnfold _                                   = False
 602 \end{code}
 603
 604 Note [InlineRule]
 605 ~~~~~~~~~~~~~~~~~
 606 When you say
 607       {-# INLINE f #-}
 608       f x = <rhs>
 609 you intend that calls (f e) are replaced by <rhs>[e/x] So we
 610 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
 611 with it.  Meanwhile, we can optimise <rhs> to our heart's content,
 612 leaving the original unfolding intact in Unfolding of 'f'.
 613
 614 So the representation of an Unfolding has changed quite a bit
 615 (see CoreSyn).  An INLINE pragma gives rise to an InlineRule
 616 unfolding.
 617
 618 Moreover, it's only used when 'f' is applied to the
 619 specified number of arguments; that is, the number of argument on
 620 the LHS of the '=' sign in the original source definition.
 621 For example, (.) is now defined in the libraries like this
 622    {-# INLINE (.) #-}
 623    (.) f g = \x -> f (g x)
 624 so that it'll inline when applied to two arguments. If 'x' appeared
 625 on the left, thus
 626    (.) f g x = f (g x)
 627 it'd only inline when applied to three arguments.  This slightly-experimental
 628 change was requested by Roman, but it seems to make sense.
 629
 630 See also Note [Inlining an InlineRule] in CoreUnfold.
 631
 632
 633 Note [OccInfo in unfoldings and rules]
 634 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 635 In unfoldings and rules, we guarantee that the template is occ-analysed,
 636 so that the occurence info on the binders is correct.  This is important,
 637 because the Simplifier does not re-analyse the template when using it. If
 638 the occurrence info is wrong
 639   - We may get more simpifier iterations than necessary, because
 640     once-occ info isn't there
 641   - More seriously, we may get an infinite loop if there's a Rec
 642     without a loop breaker marked
 643
 644
 645 %************************************************************************
 646 %*                                                                      *
 647 \subsection{The main data type}
 648 %*                                                                      *
 649 %************************************************************************
 650
 651 \begin{code}
 652 -- The Ord is needed for the FiniteMap used in the lookForConstructor
 653 -- in SimplEnv.  If you declared that lookForConstructor *ignores*
 654 -- constructor-applications with LitArg args, then you could get
 655 -- rid of this Ord.
 656
 657 instance Outputable AltCon where
 658   ppr (DataAlt dc) = ppr dc
 659   ppr (LitAlt lit) = ppr lit
 660   ppr DEFAULT      = ptext (sLit "__DEFAULT")
 661
 662 instance Show AltCon where
 663   showsPrec p con = showsPrecSDoc p (ppr con)
 664
 665 cmpAlt :: Alt b -> Alt b -> Ordering
 666 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
 667
 668 ltAlt :: Alt b -> Alt b -> Bool
 669 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
 670
 671 cmpAltCon :: AltCon -> AltCon -> Ordering
 672 -- ^ Compares 'AltCon's within a single list of alternatives
 673 cmpAltCon DEFAULT      DEFAULT     = EQ
 674 cmpAltCon DEFAULT      _           = LT
 675
 676 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
 677 cmpAltCon (DataAlt _)  DEFAULT      = GT
 678 cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
 679 cmpAltCon (LitAlt _)   DEFAULT      = GT
 680
 681 cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+>
 682                                   ppr con1 <+> ppr con2 )
 683                       LT
 684 \end{code}
 685
 686 %************************************************************************
 687 %*                                                                      *
 688 \subsection{Useful synonyms}
 689 %*                                                                      *
 690 %************************************************************************
 691
 692 \begin{code}
 693 -- | The common case for the type of binders and variables when
 694 -- we are manipulating the Core language within GHC
 695 type CoreBndr = Var
 696 -- | Expressions where binders are 'CoreBndr's
 697 type CoreExpr = Expr CoreBndr
 698 -- | Argument expressions where binders are 'CoreBndr's
 699 type CoreArg  = Arg  CoreBndr
 700 -- | Binding groups where binders are 'CoreBndr's
 701 type CoreBind = Bind CoreBndr
 702 -- | Case alternatives where binders are 'CoreBndr's
 703 type CoreAlt  = Alt  CoreBndr
 704 \end{code}
 705
 706 %************************************************************************
 707 %*                                                                      *
 708 \subsection{Tagging}
 709 %*                                                                      *
 710 %************************************************************************
 711
 712 \begin{code}
 713 -- | Binders are /tagged/ with a t
 714 data TaggedBndr t = TB CoreBndr t       -- TB for "tagged binder"
 715
 716 type TaggedBind t = Bind (TaggedBndr t)
 717 type TaggedExpr t = Expr (TaggedBndr t)
 718 type TaggedArg  t = Arg  (TaggedBndr t)
 719 type TaggedAlt  t = Alt  (TaggedBndr t)
 720
 721 instance Outputable b => Outputable (TaggedBndr b) where
 722   ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
 723
 724 instance Outputable b => OutputableBndr (TaggedBndr b) where
 725   pprBndr _ b = ppr b   -- Simple
 726 \end{code}
 727
 728
 729 %************************************************************************
 730 %*                                                                      *
 731 \subsection{Core-constructing functions with checking}
 732 %*                                                                      *
 733 %************************************************************************
 734
 735 \begin{code}
 736 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
 737 -- use 'CoreUtils.mkCoreApps' if possible
 738 mkApps    :: Expr b -> [Arg b]  -> Expr b
 739 -- | Apply a list of type argument expressions to a function expression in a nested fashion
 740 mkTyApps  :: Expr b -> [Type]   -> Expr b
 741 -- | Apply a list of type or value variables to a function expression in a nested fashion
 742 mkVarApps :: Expr b -> [Var] -> Expr b
 743 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
 744 -- use 'MkCore.mkCoreConApps' if possible
 745 mkConApp      :: DataCon -> [Arg b] -> Expr b
 746
 747 mkApps    f args = foldl App                       f args
 748 mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
 749 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
 750 mkConApp con args = mkApps (Var (dataConWorkId con)) args
 751
 752
 753 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
 754 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 755 mkIntLit      :: Integer -> Expr b
 756 -- | Create a machine integer literal expression of type @Int#@ from an @Int@.
 757 -- If you want an expression of type @Int@ use 'MkCore.mkIntExpr'
 758 mkIntLitInt   :: Int     -> Expr b
 759
 760 mkIntLit    n = Lit (mkMachInt n)
 761 mkIntLitInt n = Lit (mkMachInt (toInteger n))
 762
 763 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
 764 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 765 mkWordLit     :: Integer -> Expr b
 766 -- | Create a machine word literal expression of type  @Word#@ from a @Word@.
 767 -- If you want an expression of type @Word@ use 'MkCore.mkWordExpr'
 768 mkWordLitWord :: Word -> Expr b
 769
 770 mkWordLit     w = Lit (mkMachWord w)
 771 mkWordLitWord w = Lit (mkMachWord (toInteger w))
 772
 773 -- | Create a machine character literal expression of type @Char#@.
 774 -- If you want an expression of type @Char@ use 'MkCore.mkCharExpr'
 775 mkCharLit :: Char -> Expr b
 776 -- | Create a machine string literal expression of type @Addr#@.
 777 -- If you want an expression of type @String@ use 'MkCore.mkStringExpr'
 778 mkStringLit :: String -> Expr b
 779
 780 mkCharLit   c = Lit (mkMachChar c)
 781 mkStringLit s = Lit (mkMachString s)
 782
 783 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
 784 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 785 mkFloatLit :: Rational -> Expr b
 786 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
 787 -- If you want an expression of type @Float@ use 'MkCore.mkFloatExpr'
 788 mkFloatLitFloat :: Float -> Expr b
 789
 790 mkFloatLit      f = Lit (mkMachFloat f)
 791 mkFloatLitFloat f = Lit (mkMachFloat (toRational f))
 792
 793 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
 794 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 795 mkDoubleLit :: Rational -> Expr b
 796 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
 797 -- If you want an expression of type @Double@ use 'MkCore.mkDoubleExpr'
 798 mkDoubleLitDouble :: Double -> Expr b
 799
 800 mkDoubleLit       d = Lit (mkMachDouble d)
 801 mkDoubleLitDouble d = Lit (mkMachDouble (toRational d))
 802
 803 -- | Bind all supplied binding groups over an expression in a nested let expression. Prefer to
 804 -- use 'CoreUtils.mkCoreLets' if possible
 805 mkLets        :: [Bind b] -> Expr b -> Expr b
 806 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
 807 -- use 'CoreUtils.mkCoreLams' if possible
 808 mkLams        :: [b] -> Expr b -> Expr b
 809
 810 mkLams binders body = foldr Lam body binders
 811 mkLets binds body   = foldr Let body binds
 812
 813
 814 -- | Create a binding group where a type variable is bound to a type. Per "CoreSyn#type_let",
 815 -- this can only be used to bind something in a non-recursive @let@ expression
 816 mkTyBind :: TyVar -> Type -> CoreBind
 817 mkTyBind tv ty      = NonRec tv (Type ty)
 818
 819 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
 820 varToCoreExpr :: CoreBndr -> Expr b
 821 varToCoreExpr v | isId v = Var v
 822                 | otherwise = Type (mkTyVarTy v)
 823
 824 varsToCoreExprs :: [CoreBndr] -> [Expr b]
 825 varsToCoreExprs vs = map varToCoreExpr vs
 826 \end{code}
 827
 828
 829 %************************************************************************
 830 %*                                                                      *
 831 \subsection{Simple access functions}
 832 %*                                                                      *
 833 %************************************************************************
 834
 835 \begin{code}
 836 -- | Extract every variable by this group
 837 bindersOf  :: Bind b -> [b]
 838 bindersOf (NonRec binder _) = [binder]
 839 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 840
 841 -- | 'bindersOf' applied to a list of binding groups
 842 bindersOfBinds :: [Bind b] -> [b]
 843 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
 844
 845 rhssOfBind :: Bind b -> [Expr b]
 846 rhssOfBind (NonRec _ rhs) = [rhs]
 847 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 848
 849 rhssOfAlts :: [Alt b] -> [Expr b]
 850 rhssOfAlts alts = [e | (_,_,e) <- alts]
 851
 852 -- | Collapse all the bindings in the supplied groups into a single
 853 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
 854 flattenBinds :: [Bind b] -> [(b, Expr b)]
 855 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
 856 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 857 flattenBinds []                   = []
 858 \end{code}
 859
 860 \begin{code}
 861 -- | We often want to strip off leading lambdas before getting down to
 862 -- business. This function is your friend.
 863 collectBinders               :: Expr b -> ([b],         Expr b)
 864 -- | Collect as many type bindings as possible from the front of a nested lambda
 865 collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
 866 -- | Collect as many value bindings as possible from the front of a nested lambda
 867 collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
 868 -- | Collect type binders from the front of the lambda first,
 869 -- then follow up by collecting as many value bindings as possible
 870 -- from the resulting stripped expression
 871 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 872
 873 collectBinders expr
 874   = go [] expr
 875   where
 876     go bs (Lam b e) = go (b:bs) e
 877     go bs e          = (reverse bs, e)
 878
 879 collectTyAndValBinders expr
 880   = (tvs, ids, body)
 881   where
 882     (tvs, body1) = collectTyBinders expr
 883     (ids, body)  = collectValBinders body1
 884
 885 collectTyBinders expr
 886   = go [] expr
 887   where
 888     go tvs (Lam b e) | isTyVar b = go (b:tvs) e
 889     go tvs e                     = (reverse tvs, e)
 890
 891 collectValBinders expr
 892   = go [] expr
 893   where
 894     go ids (Lam b e) | isId b = go (b:ids) e
 895     go ids body               = (reverse ids, body)
 896 \end{code}
 897
 898 \begin{code}
 899 -- | Takes a nested application expression and returns the the function
 900 -- being applied and the arguments to which it is applied
 901 collectArgs :: Expr b -> (Expr b, [Arg b])
 902 collectArgs expr
 903   = go expr []
 904   where
 905     go (App f a) as = go f (a:as)
 906     go e         as = (e, as)
 907 \end{code}
 908
 909 \begin{code}
 910 -- | Gets the cost centre enclosing an expression, if any.
 911 -- It looks inside lambdas because @(scc \"foo\" \\x.e) = \\x. scc \"foo\" e@
 912 coreExprCc :: Expr b -> CostCentre
 913 coreExprCc (Note (SCC cc) _)   = cc
 914 coreExprCc (Note _ e)          = coreExprCc e
 915 coreExprCc (Lam _ e)           = coreExprCc e
 916 coreExprCc _                   = noCostCentre
 917 \end{code}
 918
 919 %************************************************************************
 920 %*                                                                      *
 921 \subsection{Predicates}
 922 %*                                                                      *
 923 %************************************************************************
 924
 925 At one time we optionally carried type arguments through to runtime.
 926 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
 927 i.e. if type applications are actual lambdas because types are kept around
 928 at runtime.  Similarly isRuntimeArg.
 929
 930 \begin{code}
 931 -- | Will this variable exist at runtime?
 932 isRuntimeVar :: Var -> Bool
 933 isRuntimeVar = isId
 934
 935 -- | Will this argument expression exist at runtime?
 936 isRuntimeArg :: CoreExpr -> Bool
 937 isRuntimeArg = isValArg
 938
 939 -- | Returns @False@ iff the expression is a 'Type' expression at its top level
 940 isValArg :: Expr b -> Bool
 941 isValArg (Type _) = False
 942 isValArg _        = True
 943
 944 -- | Returns @True@ iff the expression is a 'Type' expression at its top level
 945 isTypeArg :: Expr b -> Bool
 946 isTypeArg (Type _) = True
 947 isTypeArg _        = False
 948
 949 -- | The number of binders that bind values rather than types
 950 valBndrCount :: [CoreBndr] -> Int
 951 valBndrCount = count isId
 952
 953 -- | The number of argument expressions that are values rather than types at their top level
 954 valArgCount :: [Arg b] -> Int
 955 valArgCount = count isValArg
 956 \end{code}
 957
 958
 959 %************************************************************************
 960 %*                                                                      *
 961 \subsection{Seq stuff}
 962 %*                                                                      *
 963 %************************************************************************
 964
 965 \begin{code}
 966 seqExpr :: CoreExpr -> ()
 967 seqExpr (Var v)         = v `seq` ()
 968 seqExpr (Lit lit)       = lit `seq` ()
 969 seqExpr (App f a)       = seqExpr f `seq` seqExpr a
 970 seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
 971 seqExpr (Let b e)       = seqBind b `seq` seqExpr e
 972 seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
 973 seqExpr (Cast e co)     = seqExpr e `seq` seqType co
 974 seqExpr (Note n e)      = seqNote n `seq` seqExpr e
 975 seqExpr (Type t)        = seqType t
 976
 977 seqExprs :: [CoreExpr] -> ()
 978 seqExprs [] = ()
 979 seqExprs (e:es) = seqExpr e `seq` seqExprs es
 980
 981 seqNote :: Note -> ()
 982 seqNote (CoreNote s)   = s `seq` ()
 983 seqNote _              = ()
 984
 985 seqBndr :: CoreBndr -> ()
 986 seqBndr b = b `seq` ()
 987
 988 seqBndrs :: [CoreBndr] -> ()
 989 seqBndrs [] = ()
 990 seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
 991
 992 seqBind :: Bind CoreBndr -> ()
 993 seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
 994 seqBind (Rec prs)    = seqPairs prs
 995
 996 seqPairs :: [(CoreBndr, CoreExpr)] -> ()
 997 seqPairs [] = ()
 998 seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
 999
1000 seqAlts :: [CoreAlt] -> ()
1001 seqAlts [] = ()
1002 seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
1003
1004 seqRules :: [CoreRule] -> ()
1005 seqRules [] = ()
1006 seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
1007   = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
1008 seqRules (BuiltinRule {} : rules) = seqRules rules
1009 \end{code}
1010
1011 %************************************************************************
1012 %*                                                                      *
1013 \subsection{Annotated core}
1014 %*                                                                      *
1015 %************************************************************************
1016
1017 \begin{code}
1018 -- | Annotated core: allows annotation at every node in the tree
1019 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
1020
1021 -- | A clone of the 'Expr' type but allowing annotation at every tree node
1022 data AnnExpr' bndr annot
1023   = AnnVar      Id
1024   | AnnLit      Literal
1025   | AnnLam      bndr (AnnExpr bndr annot)
1026   | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)
1027   | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
1028   | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)
1029   | AnnCast     (AnnExpr bndr annot) Coercion
1030   | AnnNote     Note (AnnExpr bndr annot)
1031   | AnnType     Type
1032
1033 -- | A clone of the 'Alt' type but allowing annotation at every tree node
1034 type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
1035
1036 -- | A clone of the 'Bind' type but allowing annotation at every tree node
1037 data AnnBind bndr annot
1038   = AnnNonRec bndr (AnnExpr bndr annot)
1039   | AnnRec    [(bndr, AnnExpr bndr annot)]
1040 \end{code}
1041
1042 \begin{code}
1043 deAnnotate :: AnnExpr bndr annot -> Expr bndr
1044 deAnnotate (_, e) = deAnnotate' e
1045
1046 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
1047 deAnnotate' (AnnType t)           = Type t
1048 deAnnotate' (AnnVar  v)           = Var v
1049 deAnnotate' (AnnLit  lit)         = Lit lit
1050 deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
1051 deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
1052 deAnnotate' (AnnCast e co)        = Cast (deAnnotate e) co
1053 deAnnotate' (AnnNote note body)   = Note note (deAnnotate body)
1054
1055 deAnnotate' (AnnLet bind body)
1056   = Let (deAnnBind bind) (deAnnotate body)
1057   where
1058     deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
1059     deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
1060
1061 deAnnotate' (AnnCase scrut v t alts)
1062   = Case (deAnnotate scrut) v t (map deAnnAlt alts)
1063
1064 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
1065 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
1066 \end{code}
1067
1068 \begin{code}
1069 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
1070 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
1071 collectAnnBndrs e
1072   = collect [] e
1073   where
1074     collect bs (_, AnnLam b body) = collect (b:bs) body
1075     collect bs body               = (reverse bs, body)
1076 \end{code}