never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 -}
    5 
    6 {-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
    7 {-# LANGUAGE NamedFieldPuns #-}
    8 {-# LANGUAGE BangPatterns #-}
    9 
   10 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
   11 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
   12 
   13 -- | GHC.Core holds all the main data types for use by for the Glasgow Haskell Compiler midsection
   14 module GHC.Core (
   15         -- * Main data types
   16         Expr(..), Alt(..), Bind(..), AltCon(..), Arg,
   17         CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
   18         TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
   19 
   20         -- * In/Out type synonyms
   21         InId, InBind, InExpr, InAlt, InArg, InType, InKind,
   22                InBndr, InVar, InCoercion, InTyVar, InCoVar,
   23         OutId, OutBind, OutExpr, OutAlt, OutArg, OutType, OutKind,
   24                OutBndr, OutVar, OutCoercion, OutTyVar, OutCoVar, MOutCoercion,
   25 
   26         -- ** 'Expr' construction
   27         mkLet, mkLets, mkLetNonRec, mkLetRec, mkLams,
   28         mkApps, mkTyApps, mkCoApps, mkVarApps, mkTyArg,
   29 
   30         mkIntLit, mkIntLitWrap,
   31         mkWordLit, mkWordLitWrap,
   32         mkWord8Lit,
   33         mkWord64LitWord64, mkInt64LitInt64,
   34         mkCharLit, mkStringLit,
   35         mkFloatLit, mkFloatLitFloat,
   36         mkDoubleLit, mkDoubleLitDouble,
   37 
   38         mkConApp, mkConApp2, mkTyBind, mkCoBind,
   39         varToCoreExpr, varsToCoreExprs,
   40 
   41         isId, cmpAltCon, cmpAlt, ltAlt,
   42 
   43         -- ** Simple 'Expr' access functions and predicates
   44         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
   45         collectBinders, collectTyBinders, collectTyAndValBinders,
   46         collectNBinders,
   47         collectArgs, stripNArgs, collectArgsTicks, flattenBinds,
   48 
   49         exprToType, exprToCoercion_maybe,
   50         applyTypeToArg,
   51 
   52         isValArg, isTypeArg, isCoArg, isTyCoArg, valArgCount, valBndrCount,
   53         isRuntimeArg, isRuntimeVar,
   54 
   55         -- * Unfolding data types
   56         Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),
   57 
   58         -- ** Constructing 'Unfolding's
   59         noUnfolding, bootUnfolding, evaldUnfolding, mkOtherCon,
   60         unSaturatedOk, needSaturated, boringCxtOk, boringCxtNotOk,
   61 
   62         -- ** Predicates and deconstruction on 'Unfolding'
   63         unfoldingTemplate, expandUnfolding_maybe,
   64         maybeUnfoldingTemplate, otherCons,
   65         isValueUnfolding, isEvaldUnfolding, isCheapUnfolding,
   66         isExpandableUnfolding, isConLikeUnfolding, isCompulsoryUnfolding,
   67         isStableUnfolding, isInlineUnfolding, isBootUnfolding,
   68         hasCoreUnfolding, hasSomeUnfolding,
   69         canUnfold, neverUnfoldGuidance, isStableSource,
   70 
   71         -- * Annotated expression data types
   72         AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt(..),
   73 
   74         -- ** Operations on annotated expressions
   75         collectAnnArgs, collectAnnArgsTicks,
   76 
   77         -- ** Operations on annotations
   78         deAnnotate, deAnnotate', deAnnAlt, deAnnBind,
   79         collectAnnBndrs, collectNAnnBndrs,
   80 
   81         -- * Orphanhood
   82         IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,
   83 
   84         -- * Core rule data types
   85         CoreRule(..), RuleBase,
   86         RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
   87         RuleEnv(..), RuleOpts(..), mkRuleEnv, emptyRuleEnv,
   88 
   89         -- ** Operations on 'CoreRule's
   90         ruleArity, ruleName, ruleIdName, ruleActivation,
   91         setRuleIdName, ruleModule,
   92         isBuiltinRule, isLocalRule, isAutoRule,
   93     ) where
   94 
   95 import GHC.Prelude
   96 import GHC.Platform
   97 
   98 import GHC.Types.Var.Env( InScopeSet )
   99 import GHC.Types.Var
  100 import GHC.Core.Type
  101 import GHC.Core.Coercion
  102 import GHC.Types.Name
  103 import GHC.Types.Name.Set
  104 import GHC.Types.Name.Env( NameEnv, emptyNameEnv )
  105 import GHC.Types.Literal
  106 import GHC.Types.Tickish
  107 import GHC.Core.DataCon
  108 import GHC.Unit.Module
  109 import GHC.Types.Basic
  110 import GHC.Types.Unique.Set
  111 
  112 import GHC.Utils.Binary
  113 import GHC.Utils.Misc
  114 import GHC.Utils.Outputable
  115 import GHC.Utils.Panic
  116 import GHC.Utils.Panic.Plain
  117 import GHC.Utils.Trace
  118 
  119 import Data.Data hiding (TyCon)
  120 import Data.Int
  121 import Data.Word
  122 
  123 infixl 4 `mkApps`, `mkTyApps`, `mkVarApps`, `App`, `mkCoApps`
  124 -- Left associative, so that we can say (f `mkTyApps` xs `mkVarApps` ys)
  125 
  126 {-
  127 ************************************************************************
  128 *                                                                      *
  129 \subsection{The main data types}
  130 *                                                                      *
  131 ************************************************************************
  132 
  133 These data types are the heart of the compiler
  134 -}
  135 
  136 -- | This is the data type that represents GHCs core intermediate language. Currently
  137 -- GHC uses System FC <https://www.microsoft.com/en-us/research/publication/system-f-with-type-equality-coercions/> for this purpose,
  138 -- which is closely related to the simpler and better known System F <http://en.wikipedia.org/wiki/System_F>.
  139 --
  140 -- We get from Haskell source to this Core language in a number of stages:
  141 --
  142 -- 1. The source code is parsed into an abstract syntax tree, which is represented
  143 --    by the data type 'GHC.Hs.Expr.HsExpr' with the names being 'GHC.Types.Name.Reader.RdrNames'
  144 --
  145 -- 2. This syntax tree is /renamed/, which attaches a 'GHC.Types.Unique.Unique' to every 'GHC.Types.Name.Reader.RdrName'
  146 --    (yielding a 'GHC.Types.Name.Name') to disambiguate identifiers which are lexically identical.
  147 --    For example, this program:
  148 --
  149 -- @
  150 --      f x = let f x = x + 1
  151 --            in f (x - 2)
  152 -- @
  153 --
  154 --    Would be renamed by having 'Unique's attached so it looked something like this:
  155 --
  156 -- @
  157 --      f_1 x_2 = let f_3 x_4 = x_4 + 1
  158 --                in f_3 (x_2 - 2)
  159 -- @
  160 --    But see Note [Shadowing] below.
  161 --
  162 -- 3. The resulting syntax tree undergoes type checking (which also deals with instantiating
  163 --    type class arguments) to yield a 'GHC.Hs.Expr.HsExpr' type that has 'GHC.Types.Id.Id' as it's names.
  164 --
  165 -- 4. Finally the syntax tree is /desugared/ from the expressive 'GHC.Hs.Expr.HsExpr' type into
  166 --    this 'Expr' type, which has far fewer constructors and hence is easier to perform
  167 --    optimization, analysis and code generation on.
  168 --
  169 -- The type parameter @b@ is for the type of binders in the expression tree.
  170 --
  171 -- The language consists of the following elements:
  172 --
  173 -- *  Variables
  174 --    See Note [Variable occurrences in Core]
  175 --
  176 -- *  Primitive literals
  177 --
  178 -- *  Applications: note that the argument may be a 'Type'.
  179 --    See Note [Core let/app invariant]
  180 --    See Note [Representation polymorphism invariants]
  181 --
  182 -- *  Lambda abstraction
  183 --    See Note [Representation polymorphism invariants]
  184 --
  185 -- *  Recursive and non recursive @let@s. Operationally
  186 --    this corresponds to allocating a thunk for the things
  187 --    bound and then executing the sub-expression.
  188 --
  189 --    See Note [Core letrec invariant]
  190 --    See Note [Core let/app invariant]
  191 --    See Note [Representation polymorphism invariants]
  192 --    See Note [Core type and coercion invariant]
  193 --
  194 -- *  Case expression. Operationally this corresponds to evaluating
  195 --    the scrutinee (expression examined) to weak head normal form
  196 --    and then examining at most one level of resulting constructor (i.e. you
  197 --    cannot do nested pattern matching directly with this).
  198 --
  199 --    The binder gets bound to the value of the scrutinee,
  200 --    and the 'Type' must be that of all the case alternatives
  201 --
  202 --    IMPORTANT: see Note [Case expression invariants]
  203 --
  204 -- *  Cast an expression to a particular type.
  205 --    This is used to implement @newtype@s (a @newtype@ constructor or
  206 --    destructor just becomes a 'Cast' in Core) and GADTs.
  207 --
  208 -- *  Ticks. These are used to represent all the source annotation we
  209 --    support: profiling SCCs, HPC ticks, and GHCi breakpoints.
  210 --
  211 -- *  A type: this should only show up at the top level of an Arg
  212 --
  213 -- *  A coercion
  214 
  215 {- Note [Why does Case have a 'Type' field?]
  216 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  217 The obvious alternative is
  218    exprType (Case scrut bndr alts)
  219      | (_,_,rhs1):_ <- alts
  220      = exprType rhs1
  221 
  222 But caching the type in the Case constructor
  223   exprType (Case scrut bndr ty alts) = ty
  224 is better for at least three reasons:
  225 
  226 * It works when there are no alternatives (see case invariant 1 above)
  227 
  228 * It might be faster in deeply-nested situations.
  229 
  230 * It might not be quite the same as (exprType rhs) for one
  231   of the RHSs in alts. Consider a phantom type synonym
  232        type S a = Int
  233    and we want to form the case expression
  234         case x of { K (a::*) -> (e :: S a) }
  235    Then exprType of the RHS is (S a), but we cannot make that be
  236    the 'ty' in the Case constructor because 'a' is simply not in
  237    scope there. Instead we must expand the synonym to Int before
  238    putting it in the Case constructor.  See GHC.Core.Utils.mkSingleAltCase.
  239 
  240    So we'd have to do synonym expansion in exprType which would
  241    be inefficient.
  242 
  243 * The type stored in the case is checked with lintInTy. This checks
  244   (among other things) that it does not mention any variables that are
  245   not in scope. If we did not have the type there, it would be a bit
  246   harder for Core Lint to reject case blah of Ex x -> x where
  247       data Ex = forall a. Ex a.
  248 -}
  249 
  250 -- If you edit this type, you may need to update the GHC formalism
  251 -- See Note [GHC Formalism] in GHC.Core.Lint
  252 data Expr b
  253   = Var   Id
  254   | Lit   Literal
  255   | App   (Expr b) (Arg b)
  256   | Lam   b (Expr b)
  257   | Let   (Bind b) (Expr b)
  258   | Case  (Expr b) b Type [Alt b]   -- See Note [Case expression invariants]
  259                                     -- and Note [Why does Case have a 'Type' field?]
  260   | Cast  (Expr b) CoercionR        -- The Coercion has Representational role
  261   | Tick  CoreTickish (Expr b)
  262   | Type  Type
  263   | Coercion Coercion
  264   deriving Data
  265 
  266 -- | Type synonym for expressions that occur in function argument positions.
  267 -- Only 'Arg' should contain a 'Type' at top level, general 'Expr' should not
  268 type Arg b = Expr b
  269 
  270 -- | A case split alternative. Consists of the constructor leading to the alternative,
  271 -- the variables bound from the constructor, and the expression to be executed given that binding.
  272 -- The default alternative is @(DEFAULT, [], rhs)@
  273 
  274 -- If you edit this type, you may need to update the GHC formalism
  275 -- See Note [GHC Formalism] in GHC.Core.Lint
  276 data Alt b
  277     = Alt AltCon [b] (Expr b)
  278     deriving (Data)
  279 
  280 -- | A case alternative constructor (i.e. pattern match)
  281 
  282 -- If you edit this type, you may need to update the GHC formalism
  283 -- See Note [GHC Formalism] in GHC.Core.Lint
  284 data AltCon
  285   = DataAlt DataCon   --  ^ A plain data constructor: @case e of { Foo x -> ... }@.
  286                       -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
  287 
  288   | LitAlt  Literal   -- ^ A literal: @case e of { 1 -> ... }@
  289                       -- Invariant: always an *unlifted* literal
  290                       -- See Note [Literal alternatives]
  291 
  292   | DEFAULT           -- ^ Trivial alternative: @case e of { _ -> ... }@
  293    deriving (Eq, Data)
  294 
  295 -- This instance is a bit shady. It can only be used to compare AltCons for
  296 -- a single type constructor. Fortunately, it seems quite unlikely that we'll
  297 -- ever need to compare AltCons for different type constructors.
  298 -- The instance adheres to the order described in [Core case invariants]
  299 instance Ord AltCon where
  300   compare (DataAlt con1) (DataAlt con2) =
  301     assert (dataConTyCon con1 == dataConTyCon con2) $
  302     compare (dataConTag con1) (dataConTag con2)
  303   compare (DataAlt _) _ = GT
  304   compare _ (DataAlt _) = LT
  305   compare (LitAlt l1) (LitAlt l2) = compare l1 l2
  306   compare (LitAlt _) DEFAULT = GT
  307   compare DEFAULT DEFAULT = EQ
  308   compare DEFAULT _ = LT
  309 
  310 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
  311 
  312 -- If you edit this type, you may need to update the GHC formalism
  313 -- See Note [GHC Formalism] in GHC.Core.Lint
  314 data Bind b = NonRec b (Expr b)
  315             | Rec [(b, (Expr b))]
  316   deriving Data
  317 
  318 {-
  319 Note [Shadowing]
  320 ~~~~~~~~~~~~~~~~
  321 While various passes attempt to rename on-the-fly in a manner that
  322 avoids "shadowing" (thereby simplifying downstream optimizations),
  323 neither the simplifier nor any other pass GUARANTEES that shadowing is
  324 avoided. Thus, all passes SHOULD work fine even in the presence of
  325 arbitrary shadowing in their inputs.
  326 
  327 In particular, scrutinee variables `x` in expressions of the form
  328 `Case e x t` are often renamed to variables with a prefix
  329 "wild_". These "wild" variables may appear in the body of the
  330 case-expression, and further, may be shadowed within the body.
  331 
  332 So the Unique in a Var is not really unique at all.  Still, it's very
  333 useful to give a constant-time equality/ordering for Vars, and to give
  334 a key that can be used to make sets of Vars (VarSet), or mappings from
  335 Vars to other things (VarEnv).   Moreover, if you do want to eliminate
  336 shadowing, you can give a new Unique to an Id without changing its
  337 printable name, which makes debugging easier.
  338 
  339 Note [Literal alternatives]
  340 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  341 Literal alternatives (LitAlt lit) are always for *un-lifted* literals.
  342 We have one literal, a literal Integer, that is lifted, and we don't
  343 allow in a LitAlt, because LitAlt cases don't do any evaluation. Also
  344 (see #5603) if you say
  345     case 3 of
  346       IS x -> ...
  347       IP _ -> ...
  348       IN _ -> ...
  349 (where IS, IP, IN are the constructors for Integer) we don't want the
  350 simplifier calling findAlt with argument (LitAlt 3).  No no.  Integer
  351 literals are an opaque encoding of an algebraic data type, not of
  352 an unlifted literal, like all the others.
  353 
  354 Also, we do not permit case analysis with literal patterns on floating-point
  355 types. See #9238 and Note [Rules for floating-point comparisons] in
  356 GHC.Core.Opt.ConstantFold for the rationale for this restriction.
  357 
  358 -------------------------- GHC.Core INVARIANTS ---------------------------
  359 
  360 Note [Variable occurrences in Core]
  361 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  362 Variable /occurrences/ are never CoVars, though /bindings/ can be.
  363 All CoVars appear in Coercions.
  364 
  365 For example
  366   \(c :: Age~#Int) (d::Int). d |> (sym c)
  367 Here 'c' is a CoVar, which is lambda-bound, but it /occurs/ in
  368 a Coercion, (sym c).
  369 
  370 Note [Core letrec invariant]
  371 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  372 The right hand sides of all top-level and recursive @let@s
  373 /must/ be of lifted type (see "Type#type_classification" for
  374 the meaning of /lifted/ vs. /unlifted/).
  375 
  376 There is one exception to this rule, top-level @let@s are
  377 allowed to bind primitive string literals: see
  378 Note [Core top-level string literals].
  379 
  380 Note [Core top-level string literals]
  381 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  382 As an exception to the usual rule that top-level binders must be lifted,
  383 we allow binding primitive string literals (of type Addr#) of type Addr# at the
  384 top level. This allows us to share string literals earlier in the pipeline and
  385 crucially allows other optimizations in the Core2Core pipeline to fire.
  386 Consider,
  387 
  388   f n = let a::Addr# = "foo"#
  389         in \x -> blah
  390 
  391 In order to be able to inline `f`, we would like to float `a` to the top.
  392 Another option would be to inline `a`, but that would lead to duplicating string
  393 literals, which we want to avoid. See #8472.
  394 
  395 The solution is simply to allow top-level unlifted binders. We can't allow
  396 arbitrary unlifted expression at the top-level though, unlifted binders cannot
  397 be thunks, so we just allow string literals.
  398 
  399 We allow the top-level primitive string literals to be wrapped in Ticks
  400 in the same way they can be wrapped when nested in an expression.
  401 CoreToSTG currently discards Ticks around top-level primitive string literals.
  402 See #14779.
  403 
  404 Also see Note [Compilation plan for top-level string literals].
  405 
  406 Note [Compilation plan for top-level string literals]
  407 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  408 Here is a summary on how top-level string literals are handled by various
  409 parts of the compilation pipeline.
  410 
  411 * In the source language, there is no way to bind a primitive string literal
  412   at the top level.
  413 
  414 * In Core, we have a special rule that permits top-level Addr# bindings. See
  415   Note [Core top-level string literals]. Core-to-core passes may introduce
  416   new top-level string literals.
  417 
  418 * In STG, top-level string literals are explicitly represented in the syntax
  419   tree.
  420 
  421 * A top-level string literal may end up exported from a module. In this case,
  422   in the object file, the content of the exported literal is given a label with
  423   the _bytes suffix.
  424 
  425 Note [Core let/app invariant]
  426 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  427 The let/app invariant
  428      the right hand side of a non-recursive 'Let', and
  429      the argument of an 'App',
  430     /may/ be of unlifted type, but only if
  431     the expression is ok-for-speculation
  432     or the 'Let' is for a join point.
  433 
  434 This means that the let can be floated around
  435 without difficulty. For example, this is OK:
  436 
  437    y::Int# = x +# 1#
  438 
  439 But this is not, as it may affect termination if the
  440 expression is floated out:
  441 
  442    y::Int# = fac 4#
  443 
  444 In this situation you should use @case@ rather than a @let@. The function
  445 'GHC.Core.Utils.needsCaseBinding' can help you determine which to generate, or
  446 alternatively use 'GHC.Core.Make.mkCoreLet' rather than this constructor directly,
  447 which will generate a @case@ if necessary
  448 
  449 The let/app invariant is initially enforced by mkCoreLet and mkCoreApp in
  450 GHC.Core.Make.
  451 
  452 For discussion of some implications of the let/app invariant primops see
  453 Note [Checking versus non-checking primops] in GHC.Builtin.PrimOps.
  454 
  455 Note [Case expression invariants]
  456 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  457 Case expressions are one of the more complicated elements of the Core
  458 language, and come with a number of invariants.  All of them should be
  459 checked by Core Lint.
  460 
  461 1. The list of alternatives may be empty;
  462    See Note [Empty case alternatives]
  463 
  464 2. The 'DEFAULT' case alternative must be first in the list,
  465    if it occurs at all.  Checked in GHC.Core.Lint.checkCaseAlts.
  466 
  467 3. The remaining cases are in order of (strictly) increasing
  468      tag  (for 'DataAlts') or
  469      lit  (for 'LitAlts').
  470    This makes finding the relevant constructor easy, and makes
  471    comparison easier too.   Checked in GHC.Core.Lint.checkCaseAlts.
  472 
  473 4. The list of alternatives must be exhaustive. An /exhaustive/ case
  474    does not necessarily mention all constructors:
  475 
  476    @
  477         data Foo = Red | Green | Blue
  478         ... case x of
  479               Red   -> True
  480               other -> f (case x of
  481                               Green -> ...
  482                               Blue  -> ... ) ...
  483    @
  484 
  485    The inner case does not need a @Red@ alternative, because @x@
  486    can't be @Red@ at that program point.
  487 
  488    This is not checked by Core Lint -- it's very hard to do so.
  489    E.g. suppose that inner case was floated out, thus:
  490          let a = case x of
  491                    Green -> ...
  492                    Blue  -> ... )
  493          case x of
  494            Red   -> True
  495            other -> f a
  496    Now it's really hard to see that the Green/Blue case is
  497    exhaustive.  But it is.
  498 
  499    If you have a case-expression that really /isn't/ exhaustive,
  500    we may generate seg-faults.  Consider the Green/Blue case
  501    above.  Since there are only two branches we may generate
  502    code that tests for Green, and if not Green simply /assumes/
  503    Blue (since, if the case is exhaustive, that's all that
  504    remains).  Of course, if it's not Blue and we start fetching
  505    fields that should be in a Blue constructor, we may die
  506    horribly. See also Note [Core Lint guarantee] in GHC.Core.Lint.
  507 
  508 5. Floating-point values must not be scrutinised against literals.
  509    See #9238 and Note [Rules for floating-point comparisons]
  510    in GHC.Core.Opt.ConstantFold for rationale.  Checked in lintCaseExpr;
  511    see the call to isFloatingTy.
  512 
  513 6. The 'ty' field of (Case scrut bndr ty alts) is the type of the
  514    /entire/ case expression.  Checked in lintAltExpr.
  515    See also Note [Why does Case have a 'Type' field?].
  516 
  517 7. The type of the scrutinee must be the same as the type
  518    of the case binder, obviously.  Checked in lintCaseExpr.
  519 
  520 8. The multiplicity of the binders in constructor patterns must be the
  521    multiplicity of the corresponding field /scaled by the multiplicity of the
  522    case binder/. Checked in lintCoreAlt.
  523 
  524 Note [Core type and coercion invariant]
  525 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  526 We allow a /non-recursive/, /non-top-level/ let to bind type and
  527 coercion variables.  These can be very convenient for postponing type
  528 substitutions until the next run of the simplifier.
  529 
  530 * A type variable binding must have a RHS of (Type ty)
  531 
  532 * A coercion variable binding must have a RHS of (Coercion co)
  533 
  534   It is possible to have terms that return a coercion, but we use
  535   case-binding for those; e.g.
  536      case (eq_sel d) of (co :: a ~# b) -> blah
  537   where eq_sel :: (a~b) -> (a~#b)
  538 
  539   Or even
  540       case (df @Int) of (co :: a ~# b) -> blah
  541   Which is very exotic, and I think never encountered; but see
  542   Note [Equality superclasses in quantified constraints]
  543   in GHC.Tc.Solver.Canonical
  544 
  545 Note [Core case invariants]
  546 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  547 See Note [Case expression invariants]
  548 
  549 Note [Representation polymorphism invariants]
  550 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  551 GHC allows us to abstract over calling conventions using **representation polymorphism**.
  552 For example, we have:
  553 
  554   ($) :: forall (r :: RuntimeRep) (a :: Type) (b :: TYPE r). a -> b -> b
  555 
  556 In this example, the type `b` is representation-polymorphic: it has kind `TYPE r`,
  557 where the type variable `r :: RuntimeRep` abstracts over the runtime representation
  558 of values of type `b`.
  559 
  560 To ensure that programs containing representation-polymorphism remain compilable,
  561 we enforce two invariants (the representation-polymorphism invariants),
  562 as per "Levity Polymorphism" [PLDI'17]:
  563 
  564   I1. The type of a bound variable must have a fixed runtime representation
  565       (except for join points: See Note [Invariants on join points])
  566   I2. The type of a function argument must have a fixed runtime representation.
  567 
  568 For example
  569   \(r::RuntimeRep). \(a::TYPE r). \(x::a). e
  570 is illegal because x's type has kind (TYPE r), which has 'r' free.
  571 We thus wouldn't know how to compile this lambda abstraction.
  572 
  573 In practice, we currently require something slightly stronger than a fixed runtime
  574 representation: we check whether bound variables and function arguments have a
  575 /fixed RuntimeRep/ in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete.
  576 See Note [Representation polymorphism checking] in GHC.Tc.Utils.Concrete
  577 for an overview of how we enforce these invariants in the typechecker.
  578 
  579 Note [Core let goal]
  580 ~~~~~~~~~~~~~~~~~~~~
  581 * The simplifier tries to ensure that if the RHS of a let is a constructor
  582   application, its arguments are trivial, so that the constructor can be
  583   inlined vigorously.
  584 
  585 Note [Empty case alternatives]
  586 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  587 The alternatives of a case expression should be exhaustive.  But
  588 this exhaustive list can be empty!
  589 
  590 * A case expression can have empty alternatives if (and only if) the
  591   scrutinee is bound to raise an exception or diverge. When do we know
  592   this?  See Note [Bottoming expressions] in GHC.Core.Utils.
  593 
  594 * The possibility of empty alternatives is one reason we need a type on
  595   the case expression: if the alternatives are empty we can't get the
  596   type from the alternatives!
  597 
  598 * In the case of empty types (see Note [Bottoming expressions]), say
  599     data T
  600   we do NOT want to replace
  601     case (x::T) of Bool {}   -->   error Bool "Inaccessible case"
  602   because x might raise an exception, and *that*'s what we want to see!
  603   (#6067 is an example.) To preserve semantics we'd have to say
  604      x `seq` error Bool "Inaccessible case"
  605   but the 'seq' is just such a case, so we are back to square 1.
  606 
  607 * We can use the empty-alternative construct to coerce error values from
  608   one type to another.  For example
  609 
  610     f :: Int -> Int
  611     f n = error "urk"
  612 
  613     g :: Int -> (# Char, Bool #)
  614     g x = case f x of { 0 -> ..., n -> ... }
  615 
  616   Then if we inline f in g's RHS we get
  617     case (error Int "urk") of (# Char, Bool #) { ... }
  618   and we can discard the alternatives since the scrutinee is bottom to give
  619     case (error Int "urk") of (# Char, Bool #) {}
  620 
  621   This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
  622   if for no other reason that we don't need to instantiate the (~) at an
  623   unboxed type.
  624 
  625 * We treat a case expression with empty alternatives as trivial iff
  626   its scrutinee is (see GHC.Core.Utils.exprIsTrivial).  This is actually
  627   important; see Note [Empty case is trivial] in GHC.Core.Utils
  628 
  629 * An empty case is replaced by its scrutinee during the CoreToStg
  630   conversion; remember STG is un-typed, so there is no need for
  631   the empty case to do the type conversion.
  632 
  633 Note [Join points]
  634 ~~~~~~~~~~~~~~~~~~
  635 In Core, a *join point* is a specially tagged function whose only occurrences
  636 are saturated tail calls. A tail call can appear in these places:
  637 
  638   1. In the branches (not the scrutinee) of a case
  639   2. Underneath a let (value or join point)
  640   3. Inside another join point
  641 
  642 We write a join-point declaration as
  643   join j @a @b x y = e1 in e2,
  644 like a let binding but with "join" instead (or "join rec" for "let rec"). Note
  645 that we put the parameters before the = rather than using lambdas; this is
  646 because it's relevant how many parameters the join point takes *as a join
  647 point.* This number is called the *join arity,* distinct from arity because it
  648 counts types as well as values. Note that a join point may return a lambda! So
  649   join j x = x + 1
  650 is different from
  651   join j = \x -> x + 1
  652 The former has join arity 1, while the latter has join arity 0.
  653 
  654 The identifier for a join point is called a join id or a *label.* An invocation
  655 is called a *jump.* We write a jump using the jump keyword:
  656 
  657   jump j 3
  658 
  659 The words *label* and *jump* are evocative of assembly code (or Cmm) for a
  660 reason: join points are indeed compiled as labeled blocks, and jumps become
  661 actual jumps (plus argument passing and stack adjustment). There is no closure
  662 allocated and only a fraction of the function-call overhead. Hence we would
  663 like as many functions as possible to become join points (see OccurAnal) and
  664 the type rules for join points ensure we preserve the properties that make them
  665 efficient.
  666 
  667 In the actual AST, a join point is indicated by the IdDetails of the binder: a
  668 local value binding gets 'VanillaId' but a join point gets a 'JoinId' with its
  669 join arity.
  670 
  671 For more details, see the paper:
  672 
  673   Luke Maurer, Paul Downen, Zena Ariola, and Simon Peyton Jones. "Compiling
  674   without continuations." Submitted to PLDI'17.
  675 
  676   https://www.microsoft.com/en-us/research/publication/compiling-without-continuations/
  677 
  678 Note [Invariants on join points]
  679 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  680 Join points must follow these invariants:
  681 
  682   1. All occurrences must be tail calls. Each of these tail calls must pass the
  683      same number of arguments, counting both types and values; we call this the
  684      "join arity" (to distinguish from regular arity, which only counts values).
  685 
  686      See Note [Join points are less general than the paper]
  687 
  688   2. For join arity n, the right-hand side must begin with at least n lambdas.
  689      No ticks, no casts, just lambdas!  C.f. GHC.Core.Utils.joinRhsArity.
  690 
  691      2a. Moreover, this same constraint applies to any unfolding of
  692          the binder.  Reason: if we want to push a continuation into
  693          the RHS we must push it into the unfolding as well.
  694 
  695      2b. The Arity (in the IdInfo) of a join point is the number of value
  696          binders in the top n lambdas, where n is the join arity.
  697 
  698          So arity <= join arity; the former counts only value binders
  699          while the latter counts all binders.
  700          e.g. Suppose $j has join arity 1
  701                let j = \x y. e in case x of { A -> j 1; B -> j 2 }
  702          Then its ordinary arity is also 1, not 2.
  703 
  704          The arity of a join point isn't very important; but short of setting
  705          it to zero, it is helpful to have an invariant.  E.g. #17294.
  706 
  707   3. If the binding is recursive, then all other bindings in the recursive group
  708      must also be join points.
  709 
  710   4. The binding's type must not be polymorphic in its return type (as defined
  711      in Note [The polymorphism rule of join points]).
  712 
  713 However, join points have simpler invariants in other ways
  714 
  715   5. A join point can have an unboxed type without the RHS being
  716      ok-for-speculation (i.e. drop the let/app invariant)
  717      e.g.  let j :: Int# = factorial x in ...
  718 
  719   6. The RHS of join point is not required to have a fixed runtime representation,
  720      e.g.  let j :: r :: TYPE l = fail void# in ...
  721      This happened in an intermediate program #13394
  722 
  723 Examples:
  724 
  725   join j1  x = 1 + x in jump j (jump j x)  -- Fails 1: non-tail call
  726   join j1' x = 1 + x in if even a
  727                           then jump j1 a
  728                           else jump j1 a b -- Fails 1: inconsistent calls
  729   join j2  x = flip (+) x in j2 1 2        -- Fails 2: not enough lambdas
  730   join j2' x = \y -> x + y in j3 1         -- Passes: extra lams ok
  731   join j @a (x :: a) = x                   -- Fails 4: polymorphic in ret type
  732 
  733 Invariant 1 applies to left-hand sides of rewrite rules, so a rule for a join
  734 point must have an exact call as its LHS.
  735 
  736 Strictly speaking, invariant 3 is redundant, since a call from inside a lazy
  737 binding isn't a tail call. Since a let-bound value can't invoke a free join
  738 point, then, they can't be mutually recursive. (A Core binding group *can*
  739 include spurious extra bindings if the occurrence analyser hasn't run, so
  740 invariant 3 does still need to be checked.) For the rigorous definition of
  741 "tail call", see Section 3 of the paper (Note [Join points]).
  742 
  743 Invariant 4 is subtle; see Note [The polymorphism rule of join points].
  744 
  745 Invariant 6 is to enable code like this:
  746 
  747   f = \(r :: RuntimeRep) (a :: TYPE r) (x :: T).
  748       join j :: a
  749            j = error @r @a "bloop"
  750       in case x of
  751            A -> j
  752            B -> j
  753            C -> error @r @a "blurp"
  754 
  755 Core Lint will check these invariants, anticipating that any binder whose
  756 OccInfo is marked AlwaysTailCalled will become a join point as soon as the
  757 simplifier (or simpleOptPgm) runs.
  758 
  759 Note [Join points are less general than the paper]
  760 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  761 In the paper "Compiling without continuations", this expression is
  762 perfectly valid:
  763 
  764     join { j = \_ -> e }
  765     in (case blah of       )
  766        (  True  -> j void# ) arg
  767        (  False -> blah    )
  768 
  769 assuming 'j' has arity 1.   Here the call to 'j' does not look like a
  770 tail call, but actually everything is fine. See Section 3, "Managing \Delta"
  771 in the paper.
  772 
  773 In GHC, however, we adopt a slightly more restrictive subset, in which
  774 join point calls must be tail calls.  I think we /could/ loosen it up, but
  775 in fact the simplifier ensures that we always get tail calls, and it makes
  776 the back end a bit easier I think.  Generally, just less to think about;
  777 nothing deeper than that.
  778 
  779 Note [The type of a join point]
  780 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  781 A join point has the same type it would have as a function. That is, if it takes
  782 an Int and a Bool and its body produces a String, its type is `Int -> Bool ->
  783 String`. Natural as this may seem, it can be awkward. A join point shouldn't be
  784 thought to "return" in the same sense a function does---a jump is one-way. This
  785 is crucial for understanding how case-of-case interacts with join points:
  786 
  787   case (join
  788           j :: Int -> Bool -> String
  789           j x y = ...
  790         in
  791           jump j z w) of
  792     "" -> True
  793     _  -> False
  794 
  795 The simplifier will pull the case into the join point (see Note [Join points
  796 and case-of-case] in GHC.Core.Opt.Simplify):
  797 
  798   join
  799     j :: Int -> Bool -> Bool -- changed!
  800     j x y = case ... of "" -> True
  801                         _  -> False
  802   in
  803     jump j z w
  804 
  805 The body of the join point now returns a Bool, so the label `j` has to
  806 have its type updated accordingly, which is done by
  807 GHC.Core.Opt.Simplify.Env.adjustJoinPointType. Inconvenient though
  808 this may be, it has the advantage that 'GHC.Core.Utils.exprType' can
  809 still return a type for any expression, including a jump.
  810 
  811 Relationship to the paper
  812 
  813 This plan differs from the paper (see Note [Invariants on join
  814 points]). In the paper, we instead give j the type `Int -> Bool ->
  815 forall a. a`. Then each jump carries the "return type" as a parameter,
  816 exactly the way other non-returning functions like `error` work:
  817 
  818   case (join
  819           j :: Int -> Bool -> forall a. a
  820           j x y = ...
  821         in
  822           jump j z w @String) of
  823     "" -> True
  824     _  -> False
  825 
  826 Now we can move the case inward and we only have to change the jump:
  827 
  828   join
  829     j :: Int -> Bool -> forall a. a
  830     j x y = case ... of "" -> True
  831                         _  -> False
  832   in
  833     jump j z w @Bool
  834 
  835 (Core Lint would still check that the body of the join point has the right type;
  836 that type would simply not be reflected in the join id.)
  837 
  838 Note [The polymorphism rule of join points]
  839 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  840 Invariant 4 of Note [Invariants on join points] forbids a join point to be
  841 polymorphic in its return type. That is, if its type is
  842 
  843   forall a1 ... ak. t1 -> ... -> tn -> r
  844 
  845 where its join arity is k+n, none of the type parameters ai may occur free in r.
  846 
  847 In some way, this falls out of the fact that given
  848 
  849   join
  850      j @a1 ... @ak x1 ... xn = e1
  851   in e2
  852 
  853 then all calls to `j` are in tail-call positions of `e`, and expressions in
  854 tail-call positions in `e` have the same type as `e`.
  855 Therefore the type of `e1` -- the return type of the join point -- must be the
  856 same as the type of e2.
  857 Since the type variables aren't bound in `e2`, its type can't include them, and
  858 thus neither can the type of `e1`.
  859 
  860 This unfortunately prevents the `go` in the following code from being a
  861 join-point:
  862 
  863   iter :: forall a. Int -> (a -> a) -> a -> a
  864   iter @a n f x = go @a n f x
  865     where
  866       go :: forall a. Int -> (a -> a) -> a -> a
  867       go @a 0 _ x = x
  868       go @a n f x = go @a (n-1) f (f x)
  869 
  870 In this case, a static argument transformation would fix that (see
  871 ticket #14620):
  872 
  873   iter :: forall a. Int -> (a -> a) -> a -> a
  874   iter @a n f x = go' @a n f x
  875     where
  876       go' :: Int -> (a -> a) -> a -> a
  877       go' 0 _ x = x
  878       go' n f x = go' (n-1) f (f x)
  879 
  880 In general, loopification could be employed to do that (see #14068.)
  881 
  882 Can we simply drop the requirement, and allow `go` to be a join-point? We
  883 could, and it would work. But we could not longer apply the case-of-join-point
  884 transformation universally. This transformation would do:
  885 
  886   case (join go @a n f x = case n of 0 -> x
  887                                      n -> go @a (n-1) f (f x)
  888         in go @Bool n neg True) of
  889     True -> e1; False -> e2
  890 
  891  ===>
  892 
  893   join go @a n f x = case n of 0 -> case x of True -> e1; False -> e2
  894                                n -> go @a (n-1) f (f x)
  895   in go @Bool n neg True
  896 
  897 but that is ill-typed, as `x` is type `a`, not `Bool`.
  898 
  899 
  900 This also justifies why we do not consider the `e` in `e |> co` to be in
  901 tail position: A cast changes the type, but the type must be the same. But
  902 operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for
  903 ideas how to fix this.
  904 
  905 ************************************************************************
  906 *                                                                      *
  907             In/Out type synonyms
  908 *                                                                      *
  909 ********************************************************************* -}
  910 
  911 {- Many passes apply a substitution, and it's very handy to have type
  912    synonyms to remind us whether or not the substitution has been applied -}
  913 
  914 -- Pre-cloning or substitution
  915 type InBndr     = CoreBndr
  916 type InType     = Type
  917 type InKind     = Kind
  918 type InBind     = CoreBind
  919 type InExpr     = CoreExpr
  920 type InAlt      = CoreAlt
  921 type InArg      = CoreArg
  922 type InCoercion = Coercion
  923 
  924 -- Post-cloning or substitution
  925 type OutBndr     = CoreBndr
  926 type OutType     = Type
  927 type OutKind     = Kind
  928 type OutCoercion = Coercion
  929 type OutBind     = CoreBind
  930 type OutExpr     = CoreExpr
  931 type OutAlt      = CoreAlt
  932 type OutArg      = CoreArg
  933 type MOutCoercion = MCoercion
  934 
  935 
  936 {-
  937 ************************************************************************
  938 *                                                                      *
  939                 Orphans
  940 *                                                                      *
  941 ************************************************************************
  942 -}
  943 
  944 -- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
  945 -- witnessing the instance's non-orphanhood.
  946 -- See Note [Orphans]
  947 data IsOrphan
  948   = IsOrphan
  949   | NotOrphan !OccName -- The OccName 'n' witnesses the instance's non-orphanhood
  950                       -- In that case, the instance is fingerprinted as part
  951                       -- of the definition of 'n's definition
  952     deriving Data
  953 
  954 -- | Returns true if 'IsOrphan' is orphan.
  955 isOrphan :: IsOrphan -> Bool
  956 isOrphan IsOrphan = True
  957 isOrphan _ = False
  958 
  959 -- | Returns true if 'IsOrphan' is not an orphan.
  960 notOrphan :: IsOrphan -> Bool
  961 notOrphan NotOrphan{} = True
  962 notOrphan _ = False
  963 
  964 chooseOrphanAnchor :: NameSet -> IsOrphan
  965 -- Something (rule, instance) is relate to all the Names in this
  966 -- list. Choose one of them to be an "anchor" for the orphan.  We make
  967 -- the choice deterministic to avoid gratuitous changes in the ABI
  968 -- hash (#4012).  Specifically, use lexicographic comparison of
  969 -- OccName rather than comparing Uniques
  970 --
  971 -- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically
  972 --
  973 chooseOrphanAnchor local_names
  974   | isEmptyNameSet local_names = IsOrphan
  975   | otherwise                  = NotOrphan (minimum occs)
  976   where
  977     occs = map nameOccName $ nonDetEltsUniqSet local_names
  978     -- It's OK to use nonDetEltsUFM here, see comments above
  979 
  980 instance Binary IsOrphan where
  981     put_ bh IsOrphan = putByte bh 0
  982     put_ bh (NotOrphan n) = do
  983         putByte bh 1
  984         put_ bh n
  985     get bh = do
  986         h <- getByte bh
  987         case h of
  988             0 -> return IsOrphan
  989             _ -> do
  990                 n <- get bh
  991                 return $ NotOrphan n
  992 
  993 {-
  994 Note [Orphans]
  995 ~~~~~~~~~~~~~~
  996 Class instances, rules, and family instances are divided into orphans
  997 and non-orphans.  Roughly speaking, an instance/rule is an orphan if
  998 its left hand side mentions nothing defined in this module.  Orphan-hood
  999 has two major consequences
 1000 
 1001  * A module that contains orphans is called an "orphan module".  If
 1002    the module being compiled depends (transitively) on an orphan
 1003    module M, then M.hi is read in regardless of whether M is otherwise
 1004    needed. This is to ensure that we don't miss any instance decls in
 1005    M.  But it's painful, because it means we need to keep track of all
 1006    the orphan modules below us.
 1007 
 1008  * A non-orphan is not finger-printed separately.  Instead, for
 1009    fingerprinting purposes it is treated as part of the entity it
 1010    mentions on the LHS.  For example
 1011       data T = T1 | T2
 1012       instance Eq T where ....
 1013    The instance (Eq T) is incorporated as part of T's fingerprint.
 1014 
 1015    In contrast, orphans are all fingerprinted together in the
 1016    mi_orph_hash field of the ModIface.
 1017 
 1018    See GHC.Iface.Recomp.addFingerprints.
 1019 
 1020 Orphan-hood is computed
 1021   * For class instances:
 1022       when we make a ClsInst
 1023     (because it is needed during instance lookup)
 1024 
 1025   * For rules and family instances:
 1026        when we generate an IfaceRule (GHC.Iface.Make.coreRuleToIfaceRule)
 1027                      or IfaceFamInst (GHC.Iface.Make.instanceToIfaceInst)
 1028 -}
 1029 
 1030 {-
 1031 ************************************************************************
 1032 *                                                                      *
 1033 \subsection{Rewrite rules}
 1034 *                                                                      *
 1035 ************************************************************************
 1036 
 1037 The CoreRule type and its friends are dealt with mainly in GHC.Core.Rules, but
 1038 GHC.Core.FVs, GHC.Core.Subst, GHC.Core.Ppr, GHC.Core.Tidy also inspect the
 1039 representation.
 1040 -}
 1041 
 1042 -- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
 1043 type RuleBase = NameEnv [CoreRule]
 1044         -- The rules are unordered;
 1045         -- we sort out any overlaps on lookup
 1046 
 1047 -- | A full rule environment which we can apply rules from.  Like a 'RuleBase',
 1048 -- but it also includes the set of visible orphans we use to filter out orphan
 1049 -- rules which are not visible (even though we can see them...)
 1050 data RuleEnv
 1051     = RuleEnv { re_base          :: RuleBase
 1052               , re_visible_orphs :: ModuleSet
 1053               }
 1054 
 1055 mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
 1056 mkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)
 1057 
 1058 emptyRuleEnv :: RuleEnv
 1059 emptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet
 1060 
 1061 -- | A 'CoreRule' is:
 1062 --
 1063 -- * \"Local\" if the function it is a rule for is defined in the
 1064 --   same module as the rule itself.
 1065 --
 1066 -- * \"Orphan\" if nothing on the LHS is defined in the same module
 1067 --   as the rule itself
 1068 data CoreRule
 1069   = Rule {
 1070         ru_name :: RuleName,            -- ^ Name of the rule, for communication with the user
 1071         ru_act  :: Activation,          -- ^ When the rule is active
 1072 
 1073         -- Rough-matching stuff
 1074         -- see comments with InstEnv.ClsInst( is_cls, is_rough )
 1075         ru_fn    :: Name,               -- ^ Name of the 'GHC.Types.Id.Id' at the head of this rule
 1076         ru_rough :: [Maybe Name],       -- ^ Name at the head of each argument to the left hand side
 1077 
 1078         -- Proper-matching stuff
 1079         -- see comments with InstEnv.ClsInst( is_tvs, is_tys )
 1080         ru_bndrs :: [CoreBndr],         -- ^ Variables quantified over
 1081         ru_args  :: [CoreExpr],         -- ^ Left hand side arguments
 1082 
 1083         -- And the right-hand side
 1084         ru_rhs   :: CoreExpr,           -- ^ Right hand side of the rule
 1085                                         -- Occurrence info is guaranteed correct
 1086                                         -- See Note [OccInfo in unfoldings and rules]
 1087 
 1088         -- Locality
 1089         ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated
 1090                            --               (notably by Specialise or SpecConstr)
 1091                            --   @False@ <=> generated at the user's behest
 1092                            -- See Note [Trimming auto-rules] in "GHC.Iface.Tidy"
 1093                            -- for the sole purpose of this field.
 1094 
 1095         ru_origin :: !Module,   -- ^ 'Module' the rule was defined in, used
 1096                                 -- to test if we should see an orphan rule.
 1097 
 1098         ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.
 1099 
 1100         ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
 1101                                 -- defined in the same module as the rule
 1102                                 -- and is not an implicit 'Id' (like a record selector,
 1103                                 -- class operation, or data constructor).  This
 1104                                 -- is different from 'ru_orphan', where a rule
 1105                                 -- can avoid being an orphan if *any* Name in
 1106                                 -- LHS of the rule was defined in the same
 1107                                 -- module as the rule.
 1108     }
 1109 
 1110   -- | Built-in rules are used for constant folding
 1111   -- and suchlike.  They have no free variables.
 1112   -- A built-in rule is always visible (there is no such thing as
 1113   -- an orphan built-in rule.)
 1114   | BuiltinRule {
 1115         ru_name  :: RuleName,   -- ^ As above
 1116         ru_fn    :: Name,       -- ^ As above
 1117         ru_nargs :: Int,        -- ^ Number of arguments that 'ru_try' consumes,
 1118                                 -- if it fires, including type arguments
 1119         ru_try   :: RuleFun
 1120                 -- ^ This function does the rewrite.  It given too many
 1121                 -- arguments, it simply discards them; the returned 'CoreExpr'
 1122                 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
 1123     }
 1124                 -- See Note [Extra args in rule matching] in GHC.Core.Rules
 1125 
 1126 -- | Rule options
 1127 data RuleOpts = RuleOpts
 1128    { roPlatform                :: !Platform -- ^ Target platform
 1129    , roNumConstantFolding      :: !Bool     -- ^ Enable more advanced numeric constant folding
 1130    , roExcessRationalPrecision :: !Bool     -- ^ Cut down precision of Rational values to that of Float/Double if disabled
 1131    , roBignumRules             :: !Bool     -- ^ Enable rules for bignums
 1132    }
 1133 
 1134 -- | The 'InScopeSet' in the 'InScopeEnv' is a /superset/ of variables that are
 1135 -- currently in scope. See Note [The InScopeSet invariant].
 1136 type RuleFun = RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
 1137 type InScopeEnv = (InScopeSet, IdUnfoldingFun)
 1138 
 1139 type IdUnfoldingFun = Id -> Unfolding
 1140 -- A function that embodies how to unfold an Id if you need
 1141 -- to do that in the Rule.  The reason we need to pass this info in
 1142 -- is that whether an Id is unfoldable depends on the simplifier phase
 1143 
 1144 isBuiltinRule :: CoreRule -> Bool
 1145 isBuiltinRule (BuiltinRule {}) = True
 1146 isBuiltinRule _                = False
 1147 
 1148 isAutoRule :: CoreRule -> Bool
 1149 isAutoRule (BuiltinRule {}) = False
 1150 isAutoRule (Rule { ru_auto = is_auto }) = is_auto
 1151 
 1152 -- | The number of arguments the 'ru_fn' must be applied
 1153 -- to before the rule can match on it
 1154 ruleArity :: CoreRule -> Int
 1155 ruleArity (BuiltinRule {ru_nargs = n}) = n
 1156 ruleArity (Rule {ru_args = args})      = length args
 1157 
 1158 ruleName :: CoreRule -> RuleName
 1159 ruleName = ru_name
 1160 
 1161 ruleModule :: CoreRule -> Maybe Module
 1162 ruleModule Rule { ru_origin } = Just ru_origin
 1163 ruleModule BuiltinRule {} = Nothing
 1164 
 1165 ruleActivation :: CoreRule -> Activation
 1166 ruleActivation (BuiltinRule { })       = AlwaysActive
 1167 ruleActivation (Rule { ru_act = act }) = act
 1168 
 1169 -- | The 'Name' of the 'GHC.Types.Id.Id' at the head of the rule left hand side
 1170 ruleIdName :: CoreRule -> Name
 1171 ruleIdName = ru_fn
 1172 
 1173 isLocalRule :: CoreRule -> Bool
 1174 isLocalRule = ru_local
 1175 
 1176 -- | Set the 'Name' of the 'GHC.Types.Id.Id' at the head of the rule left hand side
 1177 setRuleIdName :: Name -> CoreRule -> CoreRule
 1178 setRuleIdName nm ru = ru { ru_fn = nm }
 1179 
 1180 {-
 1181 ************************************************************************
 1182 *                                                                      *
 1183                 Unfoldings
 1184 *                                                                      *
 1185 ************************************************************************
 1186 
 1187 The @Unfolding@ type is declared here to avoid numerous loops
 1188 -}
 1189 
 1190 -- | Records the /unfolding/ of an identifier, which is approximately the form the
 1191 -- identifier would have if we substituted its definition in for the identifier.
 1192 -- This type should be treated as abstract everywhere except in "GHC.Core.Unfold"
 1193 data Unfolding
 1194   = NoUnfolding        -- ^ We have no information about the unfolding.
 1195 
 1196   | BootUnfolding      -- ^ We have no information about the unfolding, because
 1197                        -- this 'Id' came from an @hi-boot@ file.
 1198                        -- See Note [Inlining and hs-boot files] in "GHC.CoreToIface"
 1199                        -- for what this is used for.
 1200 
 1201   | OtherCon [AltCon]  -- ^ It ain't one of these constructors.
 1202                        -- @OtherCon xs@ also indicates that something has been evaluated
 1203                        -- and hence there's no point in re-evaluating it.
 1204                        -- @OtherCon []@ is used even for non-data-type values
 1205                        -- to indicated evaluated-ness.  Notably:
 1206                        --
 1207                        -- > data C = C !(Int -> Int)
 1208                        -- > case x of { C f -> ... }
 1209                        --
 1210                        -- Here, @f@ gets an @OtherCon []@ unfolding.
 1211 
 1212   | DFunUnfolding {     -- The Unfolding of a DFunId
 1213                         -- See Note [DFun unfoldings]
 1214                         --     df = /\a1..am. \d1..dn. MkD t1 .. tk
 1215                         --                                 (op1 a1..am d1..dn)
 1216                         --                                 (op2 a1..am d1..dn)
 1217         df_bndrs :: [Var],      -- The bound variables [a1..m],[d1..dn]
 1218         df_con   :: DataCon,    -- The dictionary data constructor (never a newtype datacon)
 1219         df_args  :: [CoreExpr]  -- Args of the data con: types, superclasses and methods,
 1220     }                           -- in positional order
 1221 
 1222   | CoreUnfolding {             -- An unfolding for an Id with no pragma,
 1223                                 -- or perhaps a NOINLINE pragma
 1224                                 -- (For NOINLINE, the phase, if any, is in the
 1225                                 -- InlinePragInfo for this Id.)
 1226         uf_tmpl       :: CoreExpr,        -- Template; occurrence info is correct
 1227         uf_src        :: UnfoldingSource, -- Where the unfolding came from
 1228         uf_is_top     :: Bool,          -- True <=> top level binding
 1229         uf_is_value   :: Bool,          -- exprIsHNF template (cached); it is ok to discard
 1230                                         --      a `seq` on this variable
 1231         uf_is_conlike :: Bool,          -- True <=> applicn of constructor or CONLIKE function
 1232                                         --      Cached version of exprIsConLike
 1233         uf_is_work_free :: Bool,                -- True <=> doesn't waste (much) work to expand
 1234                                         --          inside an inlining
 1235                                         --      Cached version of exprIsCheap
 1236         uf_expandable :: Bool,          -- True <=> can expand in RULE matching
 1237                                         --      Cached version of exprIsExpandable
 1238         uf_guidance   :: UnfoldingGuidance      -- Tells about the *size* of the template.
 1239     }
 1240   -- ^ An unfolding with redundant cached information. Parameters:
 1241   --
 1242   --  uf_tmpl: Template used to perform unfolding;
 1243   --           NB: Occurrence info is guaranteed correct:
 1244   --               see Note [OccInfo in unfoldings and rules]
 1245   --
 1246   --  uf_is_top: Is this a top level binding?
 1247   --
 1248   --  uf_is_value: 'exprIsHNF' template (cached); it is ok to discard a 'seq' on
 1249   --     this variable
 1250   --
 1251   --  uf_is_work_free:  Does this waste only a little work if we expand it inside an inlining?
 1252   --     Basically this is a cached version of 'exprIsWorkFree'
 1253   --
 1254   --  uf_guidance:  Tells us about the /size/ of the unfolding template
 1255 
 1256 
 1257 ------------------------------------------------
 1258 data UnfoldingSource
 1259   = -- See also Note [Historical note: unfoldings for wrappers]
 1260 
 1261     InlineRhs          -- The current rhs of the function
 1262                        -- Replace uf_tmpl each time around
 1263 
 1264   | InlineStable       -- From an INLINE or INLINABLE pragma
 1265                        --   INLINE     if guidance is UnfWhen
 1266                        --   INLINABLE  if guidance is UnfIfGoodArgs/UnfoldNever
 1267                        -- (well, technically an INLINABLE might be made
 1268                        -- UnfWhen if it was small enough, and then
 1269                        -- it will behave like INLINE outside the current
 1270                        -- module, but that is the way automatic unfoldings
 1271                        -- work so it is consistent with the intended
 1272                        -- meaning of INLINABLE).
 1273                        --
 1274                        -- uf_tmpl may change, but only as a result of
 1275                        -- gentle simplification, it doesn't get updated
 1276                        -- to the current RHS during compilation as with
 1277                        -- InlineRhs.
 1278                        --
 1279                        -- See Note [InlineStable]
 1280 
 1281   | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
 1282                        -- Only a few primop-like things have this property
 1283                        -- (see "GHC.Types.Id.Make", calls to mkCompulsoryUnfolding).
 1284                        -- Inline absolutely always, however boring the context.
 1285 
 1286 
 1287 
 1288 -- | 'UnfoldingGuidance' says when unfolding should take place
 1289 data UnfoldingGuidance
 1290   = UnfWhen {   -- Inline without thinking about the *size* of the uf_tmpl
 1291                 -- Used (a) for small *and* cheap unfoldings
 1292                 --      (b) for INLINE functions
 1293                 -- See Note [INLINE for small functions] in GHC.Core.Unfold
 1294       ug_arity    :: Arity,     -- Number of value arguments expected
 1295 
 1296       ug_unsat_ok  :: Bool,     -- True <=> ok to inline even if unsaturated
 1297       ug_boring_ok :: Bool      -- True <=> ok to inline even if the context is boring
 1298                 -- So True,True means "always"
 1299     }
 1300 
 1301   | UnfIfGoodArgs {     -- Arose from a normal Id; the info here is the
 1302                         -- result of a simple analysis of the RHS
 1303 
 1304       ug_args ::  [Int],  -- Discount if the argument is evaluated.
 1305                           -- (i.e., a simplification will definitely
 1306                           -- be possible).  One elt of the list per *value* arg.
 1307 
 1308       ug_size :: Int,     -- The "size" of the unfolding.
 1309 
 1310       ug_res :: Int       -- Scrutinee discount: the discount to subtract if the thing is in
 1311     }                     -- a context (case (thing args) of ...),
 1312                           -- (where there are the right number of arguments.)
 1313 
 1314   | UnfNever        -- The RHS is big, so don't inline it
 1315   deriving (Eq)
 1316 
 1317 {-
 1318 Note [Historical note: unfoldings for wrappers]
 1319 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1320 We used to have a nice clever scheme in interface files for
 1321 wrappers. A wrapper's unfolding can be reconstructed from its worker's
 1322 id and its strictness. This decreased .hi file size (sometimes
 1323 significantly, for modules like GHC.Classes with many high-arity w/w
 1324 splits) and had a slight corresponding effect on compile times.
 1325 
 1326 However, when we added the second demand analysis, this scheme lead to
 1327 some Core lint errors. The second analysis could change the strictness
 1328 signatures, which sometimes resulted in a wrapper's regenerated
 1329 unfolding applying the wrapper to too many arguments.
 1330 
 1331 Instead of repairing the clever .hi scheme, we abandoned it in favor
 1332 of simplicity. The .hi sizes are usually insignificant (excluding the
 1333 +1M for base libraries), and compile time barely increases (~+1% for
 1334 nofib). The nicer upshot is that the UnfoldingSource no longer mentions
 1335 an Id, so, eg, substitutions need not traverse them.
 1336 
 1337 
 1338 Note [DFun unfoldings]
 1339 ~~~~~~~~~~~~~~~~~~~~~~
 1340 The Arity in a DFunUnfolding is total number of args (type and value)
 1341 that the DFun needs to produce a dictionary.  That's not necessarily
 1342 related to the ordinary arity of the dfun Id, esp if the class has
 1343 one method, so the dictionary is represented by a newtype.  Example
 1344 
 1345      class C a where { op :: a -> Int }
 1346      instance C a -> C [a] where op xs = op (head xs)
 1347 
 1348 The instance translates to
 1349 
 1350      $dfCList :: forall a. C a => C [a]  -- Arity 2!
 1351      $dfCList = /\a.\d. $copList {a} d |> co
 1352 
 1353      $copList :: forall a. C a => [a] -> Int  -- Arity 2!
 1354      $copList = /\a.\d.\xs. op {a} d (head xs)
 1355 
 1356 Now we might encounter (op (dfCList {ty} d) a1 a2)
 1357 and we want the (op (dfList {ty} d)) rule to fire, because $dfCList
 1358 has all its arguments, even though its (value) arity is 2.  That's
 1359 why we record the number of expected arguments in the DFunUnfolding.
 1360 
 1361 Note that although it's an Arity, it's most convenient for it to give
 1362 the *total* number of arguments, both type and value.  See the use
 1363 site in exprIsConApp_maybe.
 1364 -}
 1365 
 1366 -- Constants for the UnfWhen constructor
 1367 needSaturated, unSaturatedOk :: Bool
 1368 needSaturated = False
 1369 unSaturatedOk = True
 1370 
 1371 boringCxtNotOk, boringCxtOk :: Bool
 1372 boringCxtOk    = True
 1373 boringCxtNotOk = False
 1374 
 1375 ------------------------------------------------
 1376 noUnfolding :: Unfolding
 1377 -- ^ There is no known 'Unfolding'
 1378 evaldUnfolding :: Unfolding
 1379 -- ^ This unfolding marks the associated thing as being evaluated
 1380 
 1381 noUnfolding    = NoUnfolding
 1382 evaldUnfolding = OtherCon []
 1383 
 1384 -- | There is no known 'Unfolding', because this came from an
 1385 -- hi-boot file.
 1386 bootUnfolding :: Unfolding
 1387 bootUnfolding = BootUnfolding
 1388 
 1389 mkOtherCon :: [AltCon] -> Unfolding
 1390 mkOtherCon = OtherCon
 1391 
 1392 isStableSource :: UnfoldingSource -> Bool
 1393 -- Keep the unfolding template
 1394 isStableSource InlineCompulsory   = True
 1395 isStableSource InlineStable       = True
 1396 isStableSource InlineRhs          = False
 1397 
 1398 -- | Retrieves the template of an unfolding: panics if none is known
 1399 unfoldingTemplate :: Unfolding -> CoreExpr
 1400 unfoldingTemplate = uf_tmpl
 1401 
 1402 -- | Retrieves the template of an unfolding if possible
 1403 -- maybeUnfoldingTemplate is used mainly wnen specialising, and we do
 1404 -- want to specialise DFuns, so it's important to return a template
 1405 -- for DFunUnfoldings
 1406 maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
 1407 maybeUnfoldingTemplate (CoreUnfolding { uf_tmpl = expr })
 1408   = Just expr
 1409 maybeUnfoldingTemplate (DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = args })
 1410   = Just (mkLams bndrs (mkApps (Var (dataConWorkId con)) args))
 1411 maybeUnfoldingTemplate _
 1412   = Nothing
 1413 
 1414 -- | The constructors that the unfolding could never be:
 1415 -- returns @[]@ if no information is available
 1416 otherCons :: Unfolding -> [AltCon]
 1417 otherCons (OtherCon cons) = cons
 1418 otherCons _               = []
 1419 
 1420 -- | Determines if it is certainly the case that the unfolding will
 1421 -- yield a value (something in HNF): returns @False@ if unsure
 1422 isValueUnfolding :: Unfolding -> Bool
 1423         -- Returns False for OtherCon
 1424 isValueUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 1425 isValueUnfolding _                                          = False
 1426 
 1427 -- | Determines if it possibly the case that the unfolding will
 1428 -- yield a value. Unlike 'isValueUnfolding' it returns @True@
 1429 -- for 'OtherCon'
 1430 isEvaldUnfolding :: Unfolding -> Bool
 1431         -- Returns True for OtherCon
 1432 isEvaldUnfolding (OtherCon _)                               = True
 1433 isEvaldUnfolding (CoreUnfolding { uf_is_value = is_evald }) = is_evald
 1434 isEvaldUnfolding _                                          = False
 1435 
 1436 -- | @True@ if the unfolding is a constructor application, the application
 1437 -- of a CONLIKE function or 'OtherCon'
 1438 isConLikeUnfolding :: Unfolding -> Bool
 1439 isConLikeUnfolding (OtherCon _)                             = True
 1440 isConLikeUnfolding (CoreUnfolding { uf_is_conlike = con })  = con
 1441 isConLikeUnfolding _                                        = False
 1442 
 1443 -- | Is the thing we will unfold into certainly cheap?
 1444 isCheapUnfolding :: Unfolding -> Bool
 1445 isCheapUnfolding (CoreUnfolding { uf_is_work_free = is_wf }) = is_wf
 1446 isCheapUnfolding _                                           = False
 1447 
 1448 isExpandableUnfolding :: Unfolding -> Bool
 1449 isExpandableUnfolding (CoreUnfolding { uf_expandable = is_expable }) = is_expable
 1450 isExpandableUnfolding _                                              = False
 1451 
 1452 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
 1453 -- Expand an expandable unfolding; this is used in rule matching
 1454 --   See Note [Expanding variables] in GHC.Core.Rules
 1455 -- The key point here is that CONLIKE things can be expanded
 1456 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
 1457 expandUnfolding_maybe _                                                       = Nothing
 1458 
 1459 isCompulsoryUnfolding :: Unfolding -> Bool
 1460 isCompulsoryUnfolding (CoreUnfolding { uf_src = InlineCompulsory }) = True
 1461 isCompulsoryUnfolding _                                             = False
 1462 
 1463 isStableUnfolding :: Unfolding -> Bool
 1464 -- True of unfoldings that should not be overwritten
 1465 -- by a CoreUnfolding for the RHS of a let-binding
 1466 isStableUnfolding (CoreUnfolding { uf_src = src }) = isStableSource src
 1467 isStableUnfolding (DFunUnfolding {})               = True
 1468 isStableUnfolding _                                = False
 1469 
 1470 isInlineUnfolding :: Unfolding -> Bool
 1471 -- ^ True of a /stable/ unfolding that is
 1472 --   (a) always inlined; that is, with an `UnfWhen` guidance, or
 1473 --   (b) a DFunUnfolding which never needs to be inlined
 1474 isInlineUnfolding (CoreUnfolding { uf_src = src, uf_guidance = guidance })
 1475   | isStableSource src
 1476   , UnfWhen {} <- guidance
 1477   = True
 1478 
 1479 isInlineUnfolding (DFunUnfolding {})
 1480   = True
 1481 
 1482 -- Default case
 1483 isInlineUnfolding _ = False
 1484 
 1485 
 1486 -- | Only returns False if there is no unfolding information available at all
 1487 hasSomeUnfolding :: Unfolding -> Bool
 1488 hasSomeUnfolding NoUnfolding   = False
 1489 hasSomeUnfolding BootUnfolding = False
 1490 hasSomeUnfolding _             = True
 1491 
 1492 isBootUnfolding :: Unfolding -> Bool
 1493 isBootUnfolding BootUnfolding = True
 1494 isBootUnfolding _             = False
 1495 
 1496 neverUnfoldGuidance :: UnfoldingGuidance -> Bool
 1497 neverUnfoldGuidance UnfNever = True
 1498 neverUnfoldGuidance _        = False
 1499 
 1500 hasCoreUnfolding :: Unfolding -> Bool
 1501 -- An unfolding "has Core" if it contains a Core expression, which
 1502 -- may mention free variables. See Note [Fragile unfoldings]
 1503 hasCoreUnfolding (CoreUnfolding {}) = True
 1504 hasCoreUnfolding (DFunUnfolding {}) = True
 1505 hasCoreUnfolding _                  = False
 1506   -- NoUnfolding, BootUnfolding, OtherCon have no Core
 1507 
 1508 canUnfold :: Unfolding -> Bool
 1509 canUnfold (CoreUnfolding { uf_guidance = g }) = not (neverUnfoldGuidance g)
 1510 canUnfold _                                   = False
 1511 
 1512 {- Note [Fragile unfoldings]
 1513 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1514 An unfolding is "fragile" if it mentions free variables (and hence would
 1515 need substitution) or might be affected by optimisation.  The non-fragile
 1516 ones are
 1517 
 1518    NoUnfolding, BootUnfolding
 1519 
 1520    OtherCon {}    If we know this binder (say a lambda binder) will be
 1521                   bound to an evaluated thing, we want to retain that
 1522                   info in simpleOptExpr; see #13077.
 1523 
 1524 We consider even a StableUnfolding as fragile, because it needs substitution.
 1525 
 1526 Note [InlineStable]
 1527 ~~~~~~~~~~~~~~~~~
 1528 When you say
 1529       {-# INLINE f #-}
 1530       f x = <rhs>
 1531 you intend that calls (f e) are replaced by <rhs>[e/x] So we
 1532 should capture (\x.<rhs>) in the Unfolding of 'f', and never meddle
 1533 with it.  Meanwhile, we can optimise <rhs> to our heart's content,
 1534 leaving the original unfolding intact in Unfolding of 'f'. For example
 1535         all xs = foldr (&&) True xs
 1536         any p = all . map p  {-# INLINE any #-}
 1537 We optimise any's RHS fully, but leave the InlineRule saying "all . map p",
 1538 which deforests well at the call site.
 1539 
 1540 So INLINE pragma gives rise to an InlineRule, which captures the original RHS.
 1541 
 1542 Moreover, it's only used when 'f' is applied to the
 1543 specified number of arguments; that is, the number of argument on
 1544 the LHS of the '=' sign in the original source definition.
 1545 For example, (.) is now defined in the libraries like this
 1546    {-# INLINE (.) #-}
 1547    (.) f g = \x -> f (g x)
 1548 so that it'll inline when applied to two arguments. If 'x' appeared
 1549 on the left, thus
 1550    (.) f g x = f (g x)
 1551 it'd only inline when applied to three arguments.  This slightly-experimental
 1552 change was requested by Roman, but it seems to make sense.
 1553 
 1554 See also Note [Inlining an InlineRule] in GHC.Core.Unfold.
 1555 
 1556 
 1557 Note [OccInfo in unfoldings and rules]
 1558 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1559 In unfoldings and rules, we guarantee that the template is occ-analysed,
 1560 so that the occurrence info on the binders is correct.  This is important,
 1561 because the Simplifier does not re-analyse the template when using it. If
 1562 the occurrence info is wrong
 1563   - We may get more simplifier iterations than necessary, because
 1564     once-occ info isn't there
 1565   - More seriously, we may get an infinite loop if there's a Rec
 1566     without a loop breaker marked
 1567 
 1568 
 1569 ************************************************************************
 1570 *                                                                      *
 1571                   AltCon
 1572 *                                                                      *
 1573 ************************************************************************
 1574 -}
 1575 
 1576 -- The Ord is needed for the FiniteMap used in the lookForConstructor
 1577 -- in GHC.Core.Opt.Simplify.Env.  If you declared that lookForConstructor
 1578 -- *ignores* constructor-applications with LitArg args, then you could get rid
 1579 -- of this Ord.
 1580 
 1581 instance Outputable AltCon where
 1582   ppr (DataAlt dc) = ppr dc
 1583   ppr (LitAlt lit) = ppr lit
 1584   ppr DEFAULT      = text "__DEFAULT"
 1585 
 1586 cmpAlt :: Alt a -> Alt a -> Ordering
 1587 cmpAlt (Alt con1 _ _) (Alt con2 _ _) = con1 `cmpAltCon` con2
 1588 
 1589 ltAlt :: Alt a -> Alt a -> Bool
 1590 ltAlt a1 a2 = (a1 `cmpAlt` a2) == LT
 1591 
 1592 cmpAltCon :: AltCon -> AltCon -> Ordering
 1593 -- ^ Compares 'AltCon's within a single list of alternatives
 1594 -- DEFAULT comes out smallest, so that sorting by AltCon puts
 1595 -- alternatives in the order required: see Note [Case expression invariants]
 1596 cmpAltCon DEFAULT      DEFAULT     = EQ
 1597 cmpAltCon DEFAULT      _           = LT
 1598 
 1599 cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
 1600 cmpAltCon (DataAlt _)  DEFAULT      = GT
 1601 cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
 1602 cmpAltCon (LitAlt _)   DEFAULT      = GT
 1603 
 1604 cmpAltCon con1 con2 = warnPprTrace True (text "Comparing incomparable AltCons" <+>
 1605                                   ppr con1 <+> ppr con2) $
 1606                       LT
 1607 
 1608 {-
 1609 ************************************************************************
 1610 *                                                                      *
 1611 \subsection{Useful synonyms}
 1612 *                                                                      *
 1613 ************************************************************************
 1614 
 1615 Note [CoreProgram]
 1616 ~~~~~~~~~~~~~~~~~~
 1617 The top level bindings of a program, a CoreProgram, are represented as
 1618 a list of CoreBind
 1619 
 1620  * Later bindings in the list can refer to earlier ones, but not vice
 1621    versa.  So this is OK
 1622       NonRec { x = 4 }
 1623       Rec { p = ...q...x...
 1624           ; q = ...p...x }
 1625       Rec { f = ...p..x..f.. }
 1626       NonRec { g = ..f..q...x.. }
 1627    But it would NOT be ok for 'f' to refer to 'g'.
 1628 
 1629  * The occurrence analyser does strongly-connected component analysis
 1630    on each Rec binding, and splits it into a sequence of smaller
 1631    bindings where possible.  So the program typically starts life as a
 1632    single giant Rec, which is then dependency-analysed into smaller
 1633    chunks.
 1634 -}
 1635 
 1636 -- If you edit this type, you may need to update the GHC formalism
 1637 -- See Note [GHC Formalism] in GHC.Core.Lint
 1638 type CoreProgram = [CoreBind]   -- See Note [CoreProgram]
 1639 
 1640 -- | The common case for the type of binders and variables when
 1641 -- we are manipulating the Core language within GHC
 1642 type CoreBndr = Var
 1643 -- | Expressions where binders are 'CoreBndr's
 1644 type CoreExpr = Expr CoreBndr
 1645 -- | Argument expressions where binders are 'CoreBndr's
 1646 type CoreArg  = Arg  CoreBndr
 1647 -- | Binding groups where binders are 'CoreBndr's
 1648 type CoreBind = Bind CoreBndr
 1649 -- | Case alternatives where binders are 'CoreBndr's
 1650 type CoreAlt  = Alt  CoreBndr
 1651 
 1652 {-
 1653 ************************************************************************
 1654 *                                                                      *
 1655 \subsection{Tagging}
 1656 *                                                                      *
 1657 ************************************************************************
 1658 -}
 1659 
 1660 -- | Binders are /tagged/ with a t
 1661 data TaggedBndr t = TB CoreBndr t       -- TB for "tagged binder"
 1662 
 1663 type TaggedBind t = Bind (TaggedBndr t)
 1664 type TaggedExpr t = Expr (TaggedBndr t)
 1665 type TaggedArg  t = Arg  (TaggedBndr t)
 1666 type TaggedAlt  t = Alt  (TaggedBndr t)
 1667 
 1668 instance Outputable b => Outputable (TaggedBndr b) where
 1669   ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
 1670 
 1671 deTagExpr :: TaggedExpr t -> CoreExpr
 1672 deTagExpr (Var v)                   = Var v
 1673 deTagExpr (Lit l)                   = Lit l
 1674 deTagExpr (Type ty)                 = Type ty
 1675 deTagExpr (Coercion co)             = Coercion co
 1676 deTagExpr (App e1 e2)               = App (deTagExpr e1) (deTagExpr e2)
 1677 deTagExpr (Lam (TB b _) e)          = Lam b (deTagExpr e)
 1678 deTagExpr (Let bind body)           = Let (deTagBind bind) (deTagExpr body)
 1679 deTagExpr (Case e (TB b _) ty alts) = Case (deTagExpr e) b ty (map deTagAlt alts)
 1680 deTagExpr (Tick t e)                = Tick t (deTagExpr e)
 1681 deTagExpr (Cast e co)               = Cast (deTagExpr e) co
 1682 
 1683 deTagBind :: TaggedBind t -> CoreBind
 1684 deTagBind (NonRec (TB b _) rhs) = NonRec b (deTagExpr rhs)
 1685 deTagBind (Rec prs)             = Rec [(b, deTagExpr rhs) | (TB b _, rhs) <- prs]
 1686 
 1687 deTagAlt :: TaggedAlt t -> CoreAlt
 1688 deTagAlt (Alt con bndrs rhs) = Alt con [b | TB b _ <- bndrs] (deTagExpr rhs)
 1689 
 1690 {-
 1691 ************************************************************************
 1692 *                                                                      *
 1693 \subsection{Core-constructing functions with checking}
 1694 *                                                                      *
 1695 ************************************************************************
 1696 -}
 1697 
 1698 -- | Apply a list of argument expressions to a function expression in a nested fashion. Prefer to
 1699 -- use 'GHC.Core.Make.mkCoreApps' if possible
 1700 mkApps    :: Expr b -> [Arg b]  -> Expr b
 1701 -- | Apply a list of type argument expressions to a function expression in a nested fashion
 1702 mkTyApps  :: Expr b -> [Type]   -> Expr b
 1703 -- | Apply a list of coercion argument expressions to a function expression in a nested fashion
 1704 mkCoApps  :: Expr b -> [Coercion] -> Expr b
 1705 -- | Apply a list of type or value variables to a function expression in a nested fashion
 1706 mkVarApps :: Expr b -> [Var] -> Expr b
 1707 -- | Apply a list of argument expressions to a data constructor in a nested fashion. Prefer to
 1708 -- use 'GHC.Core.Make.mkCoreConApps' if possible
 1709 mkConApp      :: DataCon -> [Arg b] -> Expr b
 1710 
 1711 mkApps    f args = foldl' App                       f args
 1712 mkCoApps  f args = foldl' (\ e a -> App e (Coercion a)) f args
 1713 mkVarApps f vars = foldl' (\ e a -> App e (varToCoreExpr a)) f vars
 1714 mkConApp con args = mkApps (Var (dataConWorkId con)) args
 1715 
 1716 mkTyApps  f args = foldl' (\ e a -> App e (mkTyArg a)) f args
 1717 
 1718 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
 1719 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
 1720                             `mkApps` map Type tys
 1721                             `mkApps` map varToCoreExpr arg_ids
 1722 
 1723 mkTyArg :: Type -> Expr b
 1724 mkTyArg ty
 1725   | Just co <- isCoercionTy_maybe ty = Coercion co
 1726   | otherwise                        = Type ty
 1727 
 1728 -- | Create a machine integer literal expression of type @Int#@ from an @Integer@.
 1729 -- If you want an expression of type @Int@ use 'GHC.Core.Make.mkIntExpr'
 1730 mkIntLit :: Platform -> Integer -> Expr b
 1731 mkIntLit platform n = Lit (mkLitInt platform n)
 1732 
 1733 -- | Create a machine integer literal expression of type @Int#@ from an
 1734 -- @Integer@, wrapping if necessary.
 1735 -- If you want an expression of type @Int@ use 'GHC.Core.Make.mkIntExpr'
 1736 mkIntLitWrap :: Platform -> Integer -> Expr b
 1737 mkIntLitWrap platform n = Lit (mkLitIntWrap platform n)
 1738 
 1739 -- | Create a machine word literal expression of type  @Word#@ from an @Integer@.
 1740 -- If you want an expression of type @Word@ use 'GHC.Core.Make.mkWordExpr'
 1741 mkWordLit :: Platform -> Integer -> Expr b
 1742 mkWordLit platform w = Lit (mkLitWord platform w)
 1743 
 1744 -- | Create a machine word literal expression of type  @Word#@ from an
 1745 -- @Integer@, wrapping if necessary.
 1746 -- If you want an expression of type @Word@ use 'GHC.Core.Make.mkWordExpr'
 1747 mkWordLitWrap :: Platform -> Integer -> Expr b
 1748 mkWordLitWrap platform w = Lit (mkLitWordWrap platform w)
 1749 
 1750 mkWord8Lit :: Integer -> Expr b
 1751 mkWord8Lit    w = Lit (mkLitWord8 w)
 1752 
 1753 mkWord64LitWord64 :: Word64 -> Expr b
 1754 mkWord64LitWord64 w = Lit (mkLitWord64 (toInteger w))
 1755 
 1756 mkInt64LitInt64 :: Int64 -> Expr b
 1757 mkInt64LitInt64 w = Lit (mkLitInt64 (toInteger w))
 1758 
 1759 -- | Create a machine character literal expression of type @Char#@.
 1760 -- If you want an expression of type @Char@ use 'GHC.Core.Make.mkCharExpr'
 1761 mkCharLit :: Char -> Expr b
 1762 -- | Create a machine string literal expression of type @Addr#@.
 1763 -- If you want an expression of type @String@ use 'GHC.Core.Make.mkStringExpr'
 1764 mkStringLit :: String -> Expr b
 1765 
 1766 mkCharLit   c = Lit (mkLitChar c)
 1767 mkStringLit s = Lit (mkLitString s)
 1768 
 1769 -- | Create a machine single precision literal expression of type @Float#@ from a @Rational@.
 1770 -- If you want an expression of type @Float@ use 'GHC.Core.Make.mkFloatExpr'
 1771 mkFloatLit :: Rational -> Expr b
 1772 -- | Create a machine single precision literal expression of type @Float#@ from a @Float@.
 1773 -- If you want an expression of type @Float@ use 'GHC.Core.Make.mkFloatExpr'
 1774 mkFloatLitFloat :: Float -> Expr b
 1775 
 1776 mkFloatLit      f = Lit (mkLitFloat f)
 1777 mkFloatLitFloat f = Lit (mkLitFloat (toRational f))
 1778 
 1779 -- | Create a machine double precision literal expression of type @Double#@ from a @Rational@.
 1780 -- If you want an expression of type @Double@ use 'GHC.Core.Make.mkDoubleExpr'
 1781 mkDoubleLit :: Rational -> Expr b
 1782 -- | Create a machine double precision literal expression of type @Double#@ from a @Double@.
 1783 -- If you want an expression of type @Double@ use 'GHC.Core.Make.mkDoubleExpr'
 1784 mkDoubleLitDouble :: Double -> Expr b
 1785 
 1786 mkDoubleLit       d = Lit (mkLitDouble d)
 1787 mkDoubleLitDouble d = Lit (mkLitDouble (toRational d))
 1788 
 1789 -- | Bind all supplied binding groups over an expression in a nested let expression. Assumes
 1790 -- that the rhs satisfies the let/app invariant.  Prefer to use 'GHC.Core.Make.mkCoreLets' if
 1791 -- possible, which does guarantee the invariant
 1792 mkLets        :: [Bind b] -> Expr b -> Expr b
 1793 -- | Bind all supplied binders over an expression in a nested lambda expression. Prefer to
 1794 -- use 'GHC.Core.Make.mkCoreLams' if possible
 1795 mkLams        :: [b] -> Expr b -> Expr b
 1796 
 1797 mkLams binders body = foldr Lam body binders
 1798 mkLets binds body   = foldr mkLet body binds
 1799 
 1800 mkLet :: Bind b -> Expr b -> Expr b
 1801 -- The desugarer sometimes generates an empty Rec group
 1802 -- which Lint rejects, so we kill it off right away
 1803 mkLet (Rec []) body = body
 1804 mkLet bind     body = Let bind body
 1805 
 1806 -- | @mkLetNonRec bndr rhs body@ wraps @body@ in a @let@ binding @bndr@.
 1807 mkLetNonRec :: b -> Expr b -> Expr b -> Expr b
 1808 mkLetNonRec b rhs body = Let (NonRec b rhs) body
 1809 
 1810 -- | @mkLetRec binds body@ wraps @body@ in a @let rec@ with the given set of
 1811 -- @binds@ if binds is non-empty.
 1812 mkLetRec :: [(b, Expr b)] -> Expr b -> Expr b
 1813 mkLetRec [] body = body
 1814 mkLetRec bs body = Let (Rec bs) body
 1815 
 1816 -- | Create a binding group where a type variable is bound to a type.
 1817 -- Per Note [Core type and coercion invariant],
 1818 -- this can only be used to bind something in a non-recursive @let@ expression
 1819 mkTyBind :: TyVar -> Type -> CoreBind
 1820 mkTyBind tv ty      = NonRec tv (Type ty)
 1821 
 1822 -- | Create a binding group where a type variable is bound to a type.
 1823 -- Per Note [Core type and coercion invariant],
 1824 -- this can only be used to bind something in a non-recursive @let@ expression
 1825 mkCoBind :: CoVar -> Coercion -> CoreBind
 1826 mkCoBind cv co      = NonRec cv (Coercion co)
 1827 
 1828 -- | Convert a binder into either a 'Var' or 'Type' 'Expr' appropriately
 1829 varToCoreExpr :: CoreBndr -> Expr b
 1830 varToCoreExpr v | isTyVar v = Type (mkTyVarTy v)
 1831                 | isCoVar v = Coercion (mkCoVarCo v)
 1832                 | otherwise = assert (isId v) $ Var v
 1833 
 1834 varsToCoreExprs :: [CoreBndr] -> [Expr b]
 1835 varsToCoreExprs vs = map varToCoreExpr vs
 1836 
 1837 {-
 1838 ************************************************************************
 1839 *                                                                      *
 1840    Getting a result type
 1841 *                                                                      *
 1842 ************************************************************************
 1843 
 1844 These are defined here to avoid a module loop between GHC.Core.Utils and GHC.Core.FVs
 1845 
 1846 -}
 1847 
 1848 applyTypeToArg :: Type -> CoreExpr -> Type
 1849 -- ^ Determines the type resulting from applying an expression with given type
 1850 -- to a given argument expression
 1851 applyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)
 1852 
 1853 -- | If the expression is a 'Type', converts. Otherwise,
 1854 -- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.
 1855 exprToType :: CoreExpr -> Type
 1856 exprToType (Type ty)     = ty
 1857 exprToType _bad          = pprPanic "exprToType" empty
 1858 
 1859 -- | If the expression is a 'Coercion', converts.
 1860 exprToCoercion_maybe :: CoreExpr -> Maybe Coercion
 1861 exprToCoercion_maybe (Coercion co) = Just co
 1862 exprToCoercion_maybe _             = Nothing
 1863 
 1864 {-
 1865 ************************************************************************
 1866 *                                                                      *
 1867 \subsection{Simple access functions}
 1868 *                                                                      *
 1869 ************************************************************************
 1870 -}
 1871 
 1872 -- | Extract every variable by this group
 1873 bindersOf  :: Bind b -> [b]
 1874 -- If you edit this function, you may need to update the GHC formalism
 1875 -- See Note [GHC Formalism] in GHC.Core.Lint
 1876 bindersOf (NonRec binder _) = [binder]
 1877 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 1878 
 1879 -- | 'bindersOf' applied to a list of binding groups
 1880 bindersOfBinds :: [Bind b] -> [b]
 1881 bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
 1882 
 1883 rhssOfBind :: Bind b -> [Expr b]
 1884 rhssOfBind (NonRec _ rhs) = [rhs]
 1885 rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 1886 
 1887 rhssOfAlts :: [Alt b] -> [Expr b]
 1888 rhssOfAlts alts = [e | Alt _ _ e <- alts]
 1889 
 1890 -- | Collapse all the bindings in the supplied groups into a single
 1891 -- list of lhs\/rhs pairs suitable for binding in a 'Rec' binding group
 1892 flattenBinds :: [Bind b] -> [(b, Expr b)]
 1893 flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
 1894 flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
 1895 flattenBinds []                   = []
 1896 
 1897 -- | We often want to strip off leading lambdas before getting down to
 1898 -- business. Variants are 'collectTyBinders', 'collectValBinders',
 1899 -- and 'collectTyAndValBinders'
 1900 collectBinders         :: Expr b   -> ([b],     Expr b)
 1901 collectTyBinders       :: CoreExpr -> ([TyVar], CoreExpr)
 1902 collectValBinders      :: CoreExpr -> ([Id],    CoreExpr)
 1903 collectTyAndValBinders :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 1904 -- | Strip off exactly N leading lambdas (type or value). Good for use with
 1905 -- join points.
 1906 collectNBinders        :: Int -> Expr b -> ([b], Expr b)
 1907 
 1908 collectBinders expr
 1909   = go [] expr
 1910   where
 1911     go bs (Lam b e) = go (b:bs) e
 1912     go bs e          = (reverse bs, e)
 1913 
 1914 collectTyBinders expr
 1915   = go [] expr
 1916   where
 1917     go tvs (Lam b e) | isTyVar b = go (b:tvs) e
 1918     go tvs e                     = (reverse tvs, e)
 1919 
 1920 collectValBinders expr
 1921   = go [] expr
 1922   where
 1923     go ids (Lam b e) | isId b = go (b:ids) e
 1924     go ids body               = (reverse ids, body)
 1925 
 1926 collectTyAndValBinders expr
 1927   = (tvs, ids, body)
 1928   where
 1929     (tvs, body1) = collectTyBinders expr
 1930     (ids, body)  = collectValBinders body1
 1931 
 1932 collectNBinders orig_n orig_expr
 1933   = go orig_n [] orig_expr
 1934   where
 1935     go 0 bs expr      = (reverse bs, expr)
 1936     go n bs (Lam b e) = go (n-1) (b:bs) e
 1937     go _ _  _         = pprPanic "collectNBinders" $ int orig_n
 1938 
 1939 -- | Takes a nested application expression and returns the function
 1940 -- being applied and the arguments to which it is applied
 1941 collectArgs :: Expr b -> (Expr b, [Arg b])
 1942 collectArgs expr
 1943   = go expr []
 1944   where
 1945     go (App f a) as = go f (a:as)
 1946     go e         as = (e, as)
 1947 
 1948 -- | Attempt to remove the last N arguments of a function call.
 1949 -- Strip off any ticks or coercions encountered along the way and any
 1950 -- at the end.
 1951 stripNArgs :: Word -> Expr a -> Maybe (Expr a)
 1952 stripNArgs !n (Tick _ e) = stripNArgs n e
 1953 stripNArgs n (Cast f _) = stripNArgs n f
 1954 stripNArgs 0 e = Just e
 1955 stripNArgs n (App f _) = stripNArgs (n - 1) f
 1956 stripNArgs _ _ = Nothing
 1957 
 1958 -- | Like @collectArgs@, but also collects looks through floatable
 1959 -- ticks if it means that we can find more arguments.
 1960 collectArgsTicks :: (CoreTickish -> Bool) -> Expr b
 1961                  -> (Expr b, [Arg b], [CoreTickish])
 1962 collectArgsTicks skipTick expr
 1963   = go expr [] []
 1964   where
 1965     go (App f a)  as ts = go f (a:as) ts
 1966     go (Tick t e) as ts
 1967       | skipTick t      = go e as (t:ts)
 1968     go e          as ts = (e, as, reverse ts)
 1969 
 1970 
 1971 {-
 1972 ************************************************************************
 1973 *                                                                      *
 1974 \subsection{Predicates}
 1975 *                                                                      *
 1976 ************************************************************************
 1977 
 1978 At one time we optionally carried type arguments through to runtime.
 1979 @isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
 1980 i.e. if type applications are actual lambdas because types are kept around
 1981 at runtime.  Similarly isRuntimeArg.
 1982 -}
 1983 
 1984 -- | Will this variable exist at runtime?
 1985 isRuntimeVar :: Var -> Bool
 1986 isRuntimeVar = isId
 1987 
 1988 -- | Will this argument expression exist at runtime?
 1989 isRuntimeArg :: CoreExpr -> Bool
 1990 isRuntimeArg = isValArg
 1991 
 1992 -- | Returns @True@ for value arguments, false for type args
 1993 -- NB: coercions are value arguments (zero width, to be sure,
 1994 -- like State#, but still value args).
 1995 isValArg :: Expr b -> Bool
 1996 isValArg e = not (isTypeArg e)
 1997 
 1998 -- | Returns @True@ iff the expression is a 'Type' or 'Coercion'
 1999 -- expression at its top level
 2000 isTyCoArg :: Expr b -> Bool
 2001 isTyCoArg (Type {})     = True
 2002 isTyCoArg (Coercion {}) = True
 2003 isTyCoArg _             = False
 2004 
 2005 -- | Returns @True@ iff the expression is a 'Coercion'
 2006 -- expression at its top level
 2007 isCoArg :: Expr b -> Bool
 2008 isCoArg (Coercion {}) = True
 2009 isCoArg _             = False
 2010 
 2011 -- | Returns @True@ iff the expression is a 'Type' expression at its
 2012 -- top level.  Note this does NOT include 'Coercion's.
 2013 isTypeArg :: Expr b -> Bool
 2014 isTypeArg (Type {}) = True
 2015 isTypeArg _         = False
 2016 
 2017 -- | The number of binders that bind values rather than types
 2018 valBndrCount :: [CoreBndr] -> Int
 2019 valBndrCount = count isId
 2020 
 2021 -- | The number of argument expressions that are values rather than types at their top level
 2022 valArgCount :: [Arg b] -> Int
 2023 valArgCount = count isValArg
 2024 
 2025 {-
 2026 ************************************************************************
 2027 *                                                                      *
 2028 \subsection{Annotated core}
 2029 *                                                                      *
 2030 ************************************************************************
 2031 -}
 2032 
 2033 -- | Annotated core: allows annotation at every node in the tree
 2034 type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
 2035 
 2036 -- | A clone of the 'Expr' type but allowing annotation at every tree node
 2037 data AnnExpr' bndr annot
 2038   = AnnVar      Id
 2039   | AnnLit      Literal
 2040   | AnnLam      bndr (AnnExpr bndr annot)
 2041   | AnnApp      (AnnExpr bndr annot) (AnnExpr bndr annot)
 2042   | AnnCase     (AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
 2043   | AnnLet      (AnnBind bndr annot) (AnnExpr bndr annot)
 2044   | AnnCast     (AnnExpr bndr annot) (annot, Coercion)
 2045                    -- Put an annotation on the (root of) the coercion
 2046   | AnnTick     CoreTickish (AnnExpr bndr annot)
 2047   | AnnType     Type
 2048   | AnnCoercion Coercion
 2049 
 2050 -- | A clone of the 'Alt' type but allowing annotation at every tree node
 2051 data AnnAlt bndr annot = AnnAlt AltCon [bndr] (AnnExpr bndr annot)
 2052 
 2053 -- | A clone of the 'Bind' type but allowing annotation at every tree node
 2054 data AnnBind bndr annot
 2055   = AnnNonRec bndr (AnnExpr bndr annot)
 2056   | AnnRec    [(bndr, AnnExpr bndr annot)]
 2057 
 2058 -- | Takes a nested application expression and returns the function
 2059 -- being applied and the arguments to which it is applied
 2060 collectAnnArgs :: AnnExpr b a -> (AnnExpr b a, [AnnExpr b a])
 2061 collectAnnArgs expr
 2062   = go expr []
 2063   where
 2064     go (_, AnnApp f a) as = go f (a:as)
 2065     go e               as = (e, as)
 2066 
 2067 collectAnnArgsTicks :: (CoreTickish -> Bool) -> AnnExpr b a
 2068                        -> (AnnExpr b a, [AnnExpr b a], [CoreTickish])
 2069 collectAnnArgsTicks tickishOk expr
 2070   = go expr [] []
 2071   where
 2072     go (_, AnnApp f a)  as ts = go f (a:as) ts
 2073     go (_, AnnTick t e) as ts | tickishOk t
 2074                               = go e as (t:ts)
 2075     go e                as ts = (e, as, reverse ts)
 2076 
 2077 deAnnotate :: AnnExpr bndr annot -> Expr bndr
 2078 deAnnotate (_, e) = deAnnotate' e
 2079 
 2080 deAnnotate' :: AnnExpr' bndr annot -> Expr bndr
 2081 deAnnotate' (AnnType t)           = Type t
 2082 deAnnotate' (AnnCoercion co)      = Coercion co
 2083 deAnnotate' (AnnVar  v)           = Var v
 2084 deAnnotate' (AnnLit  lit)         = Lit lit
 2085 deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
 2086 deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
 2087 deAnnotate' (AnnCast e (_,co))    = Cast (deAnnotate e) co
 2088 deAnnotate' (AnnTick tick body)   = Tick tick (deAnnotate body)
 2089 
 2090 deAnnotate' (AnnLet bind body)
 2091   = Let (deAnnBind bind) (deAnnotate body)
 2092 deAnnotate' (AnnCase scrut v t alts)
 2093   = Case (deAnnotate scrut) v t (map deAnnAlt alts)
 2094 
 2095 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
 2096 deAnnAlt (AnnAlt con args rhs) = Alt con args (deAnnotate rhs)
 2097 
 2098 deAnnBind  :: AnnBind b annot -> Bind b
 2099 deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
 2100 deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
 2101 
 2102 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
 2103 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
 2104 collectAnnBndrs e
 2105   = collect [] e
 2106   where
 2107     collect bs (_, AnnLam b body) = collect (b:bs) body
 2108     collect bs body               = (reverse bs, body)
 2109 
 2110 -- | As 'collectNBinders' but for 'AnnExpr' rather than 'Expr'
 2111 collectNAnnBndrs :: Int -> AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
 2112 collectNAnnBndrs orig_n e
 2113   = collect orig_n [] e
 2114   where
 2115     collect 0 bs body               = (reverse bs, body)
 2116     collect n bs (_, AnnLam b body) = collect (n-1) (b:bs) body
 2117     collect _ _  _                  = pprPanic "collectNBinders" $ int orig_n