Comments about ru_auto
[ghc.git] / compiler / coreSyn / CoreSyn.hs
index 0c6ee7c..f06097a 100644 (file)
@@ -8,7 +8,8 @@
 -- | CoreSyn holds all the main data types for use by for the Glasgow Haskell Compiler midsection
 module CoreSyn (
         -- * Main data types
-        Expr(..), Alt, Bind(..), AltCon(..), Arg, Tickish(..),
+        Expr(..), Alt, Bind(..), AltCon(..), Arg,
+        Tickish(..), TickishScoping(..), TickishPlacement(..),
         CoreProgram, CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
         TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..), deTagExpr,
 
@@ -30,14 +31,19 @@ module CoreSyn (
 
         -- ** Simple 'Expr' access functions and predicates
         bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
-        collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
-        collectArgs, flattenBinds,
+        collectBinders, collectTyAndValBinders,
+        collectArgs, collectArgsTicks, flattenBinds,
+
+        exprToType, exprToCoercion_maybe,
+        applyTypeToArg,
 
         isValArg, isTypeArg, isTyCoArg, valArgCount, valBndrCount,
         isRuntimeArg, isRuntimeVar,
 
-        tickishCounts, tickishScoped, tickishIsCode, mkNoCount, mkNoScope,
-        tickishCanSplit,
+        tickishCounts, tickishScoped, tickishScopesLike, tickishFloatable,
+        tickishCanSplit, mkNoCount, mkNoScope,
+        tickishIsCode, tickishPlace,
+        tickishContains,
 
         -- * Unfolding data types
         Unfolding(..),  UnfoldingGuidance(..), UnfoldingSource(..),
@@ -55,24 +61,25 @@ module CoreSyn (
         isClosedUnfolding, hasSomeUnfolding,
         canUnfold, neverUnfoldGuidance, isStableSource,
 
-        -- * Strictness
-        seqExpr, seqExprs, seqUnfolding,
-
         -- * Annotated expression data types
         AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt,
 
         -- ** Operations on annotated expressions
-        collectAnnArgs,
+        collectAnnArgs, collectAnnArgsTicks,
 
         -- ** Operations on annotations
         deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
 
+        -- * Orphanhood
+        IsOrphan(..), isOrphan, notOrphan, chooseOrphanAnchor,
+
         -- * Core rule data types
-        CoreRule(..),   -- CoreSubst, CoreTidy, CoreFVs, PprCore only
+        CoreRule(..), RuleBase,
         RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
+        RuleEnv(..), mkRuleEnv, emptyRuleEnv,
 
         -- ** Operations on 'CoreRule's
-        seqRules, ruleArity, ruleName, ruleIdName, ruleActivation,
+        ruleArity, ruleName, ruleIdName, ruleActivation,
         setRuleIdName,
         isBuiltinRule, isLocalRule, isAutoRule,
 
@@ -88,15 +95,17 @@ import Var
 import Type
 import Coercion
 import Name
+import NameEnv( NameEnv, emptyNameEnv )
 import Literal
 import DataCon
 import Module
 import TyCon
 import BasicTypes
 import DynFlags
-import FastString
 import Outputable
 import Util
+import SrcLoc     ( RealSrcSpan, containsSpan )
+import Binary
 
 import Data.Data hiding (TyCon)
 import Data.Int
@@ -226,6 +235,10 @@ These data types are the heart of the compiler
 --       The inner case does not need a @Red@ alternative, because @x@
 --       can't be @Red@ at that program point.
 --
+--    5. Floating-point values must not be scrutinised against literals.
+--       See Trac #9238 and Note [Rules for floating-point comparisons]
+--       in PrelRules for rationale.
+--
 -- *  Cast an expression to a particular type.
 --    This is used to implement @newtype@s (a @newtype@ constructor or
 --    destructor just becomes a 'Cast' in Core) and GADTs.
@@ -238,7 +251,7 @@ These data types are the heart of the compiler
 -- *  A coercion
 
 -- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 data Expr b
   = Var   Id
   | Lit   Literal
@@ -261,13 +274,13 @@ type Arg b = Expr b
 -- The default alternative is @(DEFAULT, [], rhs)@
 
 -- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 type Alt b = (AltCon, [b], Expr b)
 
 -- | A case alternative constructor (i.e. pattern match)
 
 -- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 data AltCon
   = DataAlt DataCon   --  ^ A plain data constructor: @case e of { Foo x -> ... }@.
                       -- Invariant: the 'DataCon' is always from a @data@ type, and never from a @newtype@
@@ -282,7 +295,7 @@ data AltCon
 -- | Binding, used for top level bindings in a module and local bindings in a @let@.
 
 -- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 data Bind b = NonRec b (Expr b)
             | Rec [(b, (Expr b))]
   deriving (Data, Typeable)
@@ -322,6 +335,9 @@ simplifier calling findAlt with argument (LitAlt 3).  No no.  Integer
 literals are an opaque encoding of an algebraic data type, not of
 an unlifted literal, like all the others.
 
+Also, we do not permit case analysis with literal patterns on floating-point
+types. See Trac #9238 and Note [Rules for floating-point comparisons] in
+PrelRules for the rationale for this restriction.
 
 -------------------------- CoreSyn INVARIANTS ---------------------------
 
@@ -336,7 +352,7 @@ See #letrec_invariant#
 Note [CoreSyn let/app invariant]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The let/app invariant
-     the right hand side of of a non-recursive 'Let', and
+     the right hand side of a non-recursive 'Let', and
      the argument of an 'App',
     /may/ be of unlifted type, but only if
     the expression is ok-for-speculation.
@@ -374,36 +390,32 @@ See #type_let#
 
 Note [Empty case alternatives]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The alternatives of a case expression should be exhaustive.  A case expression
-can have empty alternatives if (and only if) the scrutinee is bound to raise
-an exception or diverge.  So:
-   Case (error Int "Hello") b Bool []
-is fine, and has type Bool.  This is one reason we need a type on
-the case expression: if the alternatives are empty we can't get the type
-from the alternatives!  I'll write this
-   case (error Int "Hello") of Bool {}
-with the return type just before the alternatives.
-
-Here's another example:
-  data T
-  f :: T -> Bool
-  f = \(x:t). case x of Bool {}
-Since T has no data constructors, the case alternatives are of course
-empty.  However note that 'x' is not bound to a visibly-bottom value;
-it's the *type* that tells us it's going to diverge.  Its a bit of a
-degnerate situation but we do NOT want to replace
-   case x of Bool {}   -->   error Bool "Inaccessible case"
-because x might raise an exception, and *that*'s what we want to see!
-(Trac #6067 is an example.) To preserve semantics we'd have to say
-   x `seq` error Bool "Inaccessible case"
- but the 'seq' is just a case, so we are back to square 1.  Or I suppose
-we could say
-   x |> UnsafeCoerce T Bool
-but that loses all trace of the fact that this originated with an empty
-set of alternatives.
-
-We can use the empty-alternative construct to coerce error values from
-one type to another.  For example
+The alternatives of a case expression should be exhaustive.  But
+this exhaustive list can be empty!
+
+* A case expression can have empty alternatives if (and only if) the
+  scrutinee is bound to raise an exception or diverge. When do we know
+  this?  See Note [Bottoming expressions] in CoreUtils.
+
+* The possiblity of empty alternatives is one reason we need a type on
+  the case expression: if the alternatives are empty we can't get the
+  type from the alternatives!
+
+* In the case of empty types (see Note [Bottoming expressions]), say
+    data T
+  we do NOT want to replace
+    case (x::T) of Bool {}   -->   error Bool "Inaccessible case"
+  because x might raise an exception, and *that*'s what we want to see!
+  (Trac #6067 is an example.) To preserve semantics we'd have to say
+     x `seq` error Bool "Inaccessible case"
+  but the 'seq' is just a case, so we are back to square 1.  Or I suppose
+  we could say
+     x |> UnsafeCoerce T Bool
+  but that loses all trace of the fact that this originated with an empty
+  set of alternatives.
+
+* We can use the empty-alternative construct to coerce error values from
+  one type to another.  For example
 
     f :: Int -> Int
     f n = error "urk"
@@ -411,14 +423,22 @@ one type to another.  For example
     g :: Int -> (# Char, Bool #)
     g x = case f x of { 0 -> ..., n -> ... }
 
-Then if we inline f in g's RHS we get
+  Then if we inline f in g's RHS we get
     case (error Int "urk") of (# Char, Bool #) { ... }
-and we can discard the alternatives since the scrutinee is bottom to give
+  and we can discard the alternatives since the scrutinee is bottom to give
     case (error Int "urk") of (# Char, Bool #) {}
 
-This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
-if for no other reason that we don't need to instantiate the (~) at an
-unboxed type.
+  This is nicer than using an unsafe coerce between Int ~ (# Char,Bool #),
+  if for no other reason that we don't need to instantiate the (~) at an
+  unboxed type.
+
+* We treat a case expression with empty alternatives as trivial iff
+  its scrutinee is (see CoreUtils.exprIsTrivial).  This is actually
+  important; see Note [Empty case is trivial] in CoreUtils
+
+* An empty case is replaced by its scrutinee during the CoreToStg
+  conversion; remember STG is un-typed, so there is no need for
+  the empty case to do the type conversion.
 
 
 ************************************************************************
@@ -431,7 +451,7 @@ unboxed type.
 -- | Allows attaching extra information to points in expressions
 
 -- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 data Tickish id =
     -- | An @{-# SCC #-}@ profiling annotation, either automatically
     -- added by the desugarer as a result of -auto-all, or added by
@@ -466,8 +486,29 @@ data Tickish id =
                                 -- Note [substTickish] in CoreSubst.
     }
 
-  deriving (Eq, Ord, Data, Typeable)
+  -- | A source note.
+  --
+  -- Source notes are pure annotations: Their presence should neither
+  -- influence compilation nor execution. The semantics are given by
+  -- causality: The presence of a source note means that a local
+  -- change in the referenced source code span will possibly provoke
+  -- the generated code to change. On the flip-side, the functionality
+  -- of annotated code *must* be invariant against changes to all
+  -- source code *except* the spans referenced in the source notes
+  -- (see "Causality of optimized Haskell" paper for details).
+  --
+  -- Therefore extending the scope of any given source note is always
+  -- valid. Note that it is still undesirable though, as this reduces
+  -- their usefulness for debugging and profiling. Therefore we will
+  -- generally try only to make use of this property where it is
+  -- neccessary to enable optimizations.
+  | SourceNote
+    { sourceSpan :: RealSrcSpan -- ^ Source covered
+    , sourceName :: String      -- ^ Name for source location
+                                --   (uses same names as CCs)
+    }
 
+  deriving (Eq, Ord, Data, Typeable)
 
 -- | A "counting tick" (where tickishCounts is True) is one that
 -- counts evaluations in some way.  We cannot discard a counting tick,
@@ -477,41 +518,293 @@ data Tickish id =
 -- However, we still allow the simplifier to increase or decrease
 -- sharing, so in practice the actual number of ticks may vary, except
 -- that we never change the value from zero to non-zero or vice versa.
---
 tickishCounts :: Tickish id -> Bool
 tickishCounts n@ProfNote{} = profNoteCount n
 tickishCounts HpcTick{}    = True
 tickishCounts Breakpoint{} = True
-
-tickishScoped :: Tickish id -> Bool
-tickishScoped n@ProfNote{} = profNoteScope n
-tickishScoped HpcTick{}    = False
-tickishScoped Breakpoint{} = True
+tickishCounts _            = False
+
+
+-- | Specifies the scoping behaviour of ticks. This governs the
+-- behaviour of ticks that care about the covered code and the cost
+-- associated with it. Important for ticks relating to profiling.
+data TickishScoping =
+    -- | No scoping: The tick does not care about what code it
+    -- covers. Transformations can freely move code inside as well as
+    -- outside without any additional annotation obligations
+    NoScope
+
+    -- | Soft scoping: We want all code that is covered to stay
+    -- covered.  Note that this scope type does not forbid
+    -- transformations from happening, as as long as all results of
+    -- the transformations are still covered by this tick or a copy of
+    -- it. For example
+    --
+    --   let x = tick<...> (let y = foo in bar) in baz
+    --     ===>
+    --   let x = tick<...> bar; y = tick<...> foo in baz
+    --
+    -- Is a valid transformation as far as "bar" and "foo" is
+    -- concerned, because both still are scoped over by the tick.
+    --
+    -- Note though that one might object to the "let" not being
+    -- covered by the tick any more. However, we are generally lax
+    -- with this - constant costs don't matter too much, and given
+    -- that the "let" was effectively merged we can view it as having
+    -- lost its identity anyway.
+    --
+    -- Also note that this scoping behaviour allows floating a tick
+    -- "upwards" in pretty much any situation. For example:
+    --
+    --   case foo of x -> tick<...> bar
+    --     ==>
+    --   tick<...> case foo of x -> bar
+    --
+    -- While this is always leagl, we want to make a best effort to
+    -- only make us of this where it exposes transformation
+    -- opportunities.
+  | SoftScope
+
+    -- | Cost centre scoping: We don't want any costs to move to other
+    -- cost-centre stacks. This means we not only want no code or cost
+    -- to get moved out of their cost centres, but we also object to
+    -- code getting associated with new cost-centre ticks - or
+    -- changing the order in which they get applied.
+    --
+    -- A rule of thumb is that we don't want any code to gain new
+    -- annotations. However, there are notable exceptions, for
+    -- example:
+    --
+    --   let f = \y -> foo in tick<...> ... (f x) ...
+    --     ==>
+    --   tick<...> ... foo[x/y] ...
+    --
+    -- In-lining lambdas like this is always legal, because inlining a
+    -- function does not change the cost-centre stack when the
+    -- function is called.
+  | CostCentreScope
+
+  deriving (Eq)
+
+-- | Returns the intended scoping rule for a Tickish
+tickishScoped :: Tickish id -> TickishScoping
+tickishScoped n@ProfNote{}
+  | profNoteScope n        = CostCentreScope
+  | otherwise              = NoScope
+tickishScoped HpcTick{}    = NoScope
+tickishScoped Breakpoint{} = CostCentreScope
    -- Breakpoints are scoped: eventually we're going to do call
    -- stacks, but also this helps prevent the simplifier from moving
    -- breakpoints around and changing their result type (see #1531).
+tickishScoped SourceNote{} = SoftScope
+
+-- | Returns whether the tick scoping rule is at least as permissive
+-- as the given scoping rule.
+tickishScopesLike :: Tickish id -> TickishScoping -> Bool
+tickishScopesLike t scope = tickishScoped t `like` scope
+  where NoScope         `like` _               = True
+        _               `like` NoScope         = False
+        SoftScope       `like` _               = True
+        _               `like` SoftScope       = False
+        CostCentreScope `like` _               = True
+
+-- | Returns @True@ for ticks that can be floated upwards easily even
+-- where it might change execution counts, such as:
+--
+--   Just (tick<...> foo)
+--     ==>
+--   tick<...> (Just foo)
+--
+-- This is a combination of @tickishSoftScope@ and
+-- @tickishCounts@. Note that in principle splittable ticks can become
+-- floatable using @mkNoTick@ -- even though there's currently no
+-- tickish for which that is the case.
+tickishFloatable :: Tickish id -> Bool
+tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
+
+-- | Returns @True@ for a tick that is both counting /and/ scoping and
+-- can be split into its (tick, scope) parts using 'mkNoScope' and
+-- 'mkNoTick' respectively.
+tickishCanSplit :: Tickish id -> Bool
+tickishCanSplit ProfNote{profNoteScope = True, profNoteCount = True}
+                   = True
+tickishCanSplit _  = False
 
 mkNoCount :: Tickish id -> Tickish id
-mkNoCount n@ProfNote{} = n {profNoteCount = False}
-mkNoCount Breakpoint{} = panic "mkNoCount: Breakpoint" -- cannot split a BP
-mkNoCount HpcTick{}    = panic "mkNoCount: HpcTick"
+mkNoCount n | not (tickishCounts n)   = n
+            | not (tickishCanSplit n) = panic "mkNoCount: Cannot split!"
+mkNoCount n@ProfNote{}                = n {profNoteCount = False}
+mkNoCount _                           = panic "mkNoCount: Undefined split!"
 
 mkNoScope :: Tickish id -> Tickish id
-mkNoScope n@ProfNote{} = n {profNoteScope = False}
-mkNoScope Breakpoint{} = panic "mkNoScope: Breakpoint" -- cannot split a BP
-mkNoScope HpcTick{}    = panic "mkNoScope: HpcTick"
-
--- | Return True if this source annotation compiles to some code, or will
--- disappear before the backend.
+mkNoScope n | tickishScoped n == NoScope  = n
+            | not (tickishCanSplit n)     = panic "mkNoScope: Cannot split!"
+mkNoScope n@ProfNote{}                    = n {profNoteScope = False}
+mkNoScope _                               = panic "mkNoScope: Undefined split!"
+
+-- | Return @True@ if this source annotation compiles to some backend
+-- code. Without this flag, the tickish is seen as a simple annotation
+-- that does not have any associated evaluation code.
+--
+-- What this means that we are allowed to disregard the tick if doing
+-- so means that we can skip generating any code in the first place. A
+-- typical example is top-level bindings:
+--
+--   foo = tick<...> \y -> ...
+--     ==>
+--   foo = \y -> tick<...> ...
+--
+-- Here there is just no operational difference between the first and
+-- the second version. Therefore code generation should simply
+-- translate the code as if it found the latter.
 tickishIsCode :: Tickish id -> Bool
-tickishIsCode _tickish = True  -- all of them for now
+tickishIsCode SourceNote{} = False
+tickishIsCode _tickish     = True  -- all the rest for now
+
+
+-- | Governs the kind of expression that the tick gets placed on when
+-- annotating for example using @mkTick@. If we find that we want to
+-- put a tickish on an expression ruled out here, we try to float it
+-- inwards until we find a suitable expression.
+data TickishPlacement =
+
+    -- | Place ticks exactly on run-time expressions. We can still
+    -- move the tick through pure compile-time constructs such as
+    -- other ticks, casts or type lambdas. This is the most
+    -- restrictive placement rule for ticks, as all tickishs have in
+    -- common that they want to track runtime processes. The only
+    -- legal placement rule for counting ticks.
+    PlaceRuntime
+
+    -- | As @PlaceRuntime@, but we float the tick through all
+    -- lambdas. This makes sense where there is little difference
+    -- between annotating the lambda and annotating the lambda's code.
+  | PlaceNonLam
+
+    -- | In addition to floating through lambdas, cost-centre style
+    -- tickishs can also be moved from constructors, non-function
+    -- variables and literals. For example:
+    --
+    --   let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
+    --
+    -- Neither the constructor application, the variable or the
+    -- literal are likely to have any cost worth mentioning. And even
+    -- if y names a thunk, the call would not care about the
+    -- evaluation context. Therefore removing all annotations in the
+    -- above example is safe.
+  | PlaceCostCentre
+
+  deriving (Eq)
+
+-- | Placement behaviour we want for the ticks
+tickishPlace :: Tickish id -> TickishPlacement
+tickishPlace n@ProfNote{}
+  | profNoteCount n        = PlaceRuntime
+  | otherwise              = PlaceCostCentre
+tickishPlace HpcTick{}     = PlaceRuntime
+tickishPlace Breakpoint{}  = PlaceRuntime
+tickishPlace SourceNote{}  = PlaceNonLam
+
+-- | Returns whether one tick "contains" the other one, therefore
+-- making the second tick redundant.
+tickishContains :: Eq b => Tickish b -> Tickish b -> Bool
+tickishContains (SourceNote sp1 n1) (SourceNote sp2 n2)
+  = n1 == n2 && containsSpan sp1 sp2
+tickishContains t1 t2
+  = t1 == t2
 
--- | Return True if this Tick can be split into (tick,scope) parts with
--- 'mkNoScope' and 'mkNoCount' respectively.
-tickishCanSplit :: Tickish Id -> Bool
-tickishCanSplit Breakpoint{} = False
-tickishCanSplit HpcTick{}    = False
-tickishCanSplit _ = True
+{-
+************************************************************************
+*                                                                      *
+                Orphans
+*                                                                      *
+************************************************************************
+-}
+
+-- | Is this instance an orphan?  If it is not an orphan, contains an 'OccName'
+-- witnessing the instance's non-orphanhood.
+-- See Note [Orphans]
+data IsOrphan
+  = IsOrphan
+  | NotOrphan OccName -- The OccName 'n' witnesses the instance's non-orphanhood
+                      -- In that case, the instance is fingerprinted as part
+                      -- of the definition of 'n's definition
+    deriving (Data, Typeable)
+
+-- | Returns true if 'IsOrphan' is orphan.
+isOrphan :: IsOrphan -> Bool
+isOrphan IsOrphan = True
+isOrphan _ = False
+
+-- | Returns true if 'IsOrphan' is not an orphan.
+notOrphan :: IsOrphan -> Bool
+notOrphan NotOrphan{} = True
+notOrphan _ = False
+
+chooseOrphanAnchor :: [Name] -> IsOrphan
+-- Something (rule, instance) is relate to all the Names in this
+-- list. Choose one of them to be an "anchor" for the orphan.  We make
+-- the choice deterministic to avoid gratuitious changes in the ABI
+-- hash (Trac #4012).  Specficially, use lexicographic comparison of
+-- OccName rather than comparing Uniques
+--
+-- NB: 'minimum' use Ord, and (Ord OccName) works lexicographically
+--
+chooseOrphanAnchor local_names
+  | null local_names = IsOrphan
+  | otherwise        = NotOrphan (minimum occs)
+  where
+    occs = map nameOccName local_names
+
+instance Binary IsOrphan where
+    put_ bh IsOrphan = putByte bh 0
+    put_ bh (NotOrphan n) = do
+        putByte bh 1
+        put_ bh n
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> return IsOrphan
+            _ -> do
+                n <- get bh
+                return $ NotOrphan n
+
+{-
+Note [Orphans]
+~~~~~~~~~~~~~~
+Class instances, rules, and family instances are divided into orphans
+and non-orphans.  Roughly speaking, an instance/rule is an orphan if
+its left hand side mentions nothing defined in this module.  Orphan-hood
+has two major consequences
+
+ * A module that contains orphans is called an "orphan module".  If
+   the module being compiled depends (transitively) on an oprhan
+   module M, then M.hi is read in regardless of whether M is oherwise
+   needed. This is to ensure that we don't miss any instance decls in
+   M.  But it's painful, because it means we need to keep track of all
+   the orphan modules below us.
+
+ * A non-orphan is not finger-printed separately.  Instead, for
+   fingerprinting purposes it is treated as part of the entity it
+   mentions on the LHS.  For example
+      data T = T1 | T2
+      instance Eq T where ....
+   The instance (Eq T) is incorprated as part of T's fingerprint.
+
+   In constrast, orphans are all fingerprinted together in the
+   mi_orph_hash field of the ModIface.
+
+   See MkIface.addFingerprints.
+
+Orphan-hood is computed
+  * For class instances:
+      when we make a ClsInst
+    (because it is needed during instance lookup)
+
+  * For rules and family instances:
+       when we generate an IfaceRule (MkIface.coreRuleToIfaceRule)
+                     or IfaceFamInst (MkIface.instanceToIfaceInst)
+-}
 
 {-
 ************************************************************************
@@ -524,6 +817,25 @@ The CoreRule type and its friends are dealt with mainly in CoreRules,
 but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
 -}
 
+-- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
+type RuleBase = NameEnv [CoreRule]
+        -- The rules are unordered;
+        -- we sort out any overlaps on lookup
+
+-- | A full rule environment which we can apply rules from.  Like a 'RuleBase',
+-- but it also includes the set of visible orphans we use to filter out orphan
+-- rules which are not visible (even though we can see them...)
+data RuleEnv
+    = RuleEnv { re_base          :: RuleBase
+              , re_visible_orphs :: ModuleSet
+              }
+
+mkRuleEnv :: RuleBase -> [Module] -> RuleEnv
+mkRuleEnv rules vis_orphs = RuleEnv rules (mkModuleSet vis_orphs)
+
+emptyRuleEnv :: RuleEnv
+emptyRuleEnv = RuleEnv emptyNameEnv emptyModuleSet
+
 -- | A 'CoreRule' is:
 --
 -- * \"Local\" if the function it is a rule for is defined in the
@@ -552,21 +864,31 @@ data CoreRule
                                         -- See Note [OccInfo in unfoldings and rules]
 
         -- Locality
-        ru_auto :: Bool,        -- ^ @True@  <=> this rule is auto-generated
-                                --   @False@ <=> generated at the users behest
-                                --   Main effect: reporting of orphan-hood
+        ru_auto :: Bool,   -- ^ @True@  <=> this rule is auto-generated
+                           --               (notably by Specialise or SpecConstr)
+                           --   @False@ <=> generated at the users behest
+                           -- See Note [Trimming auto-rules] in TidyPgm
+                           -- for the sole purpose of this field.
+
+        ru_origin :: !Module,   -- ^ 'Module' the rule was defined in, used
+                                -- to test if we should see an orphan rule.
+
+        ru_orphan :: !IsOrphan, -- ^ Whether or not the rule is an orphan.
 
         ru_local :: Bool        -- ^ @True@ iff the fn at the head of the rule is
                                 -- defined in the same module as the rule
                                 -- and is not an implicit 'Id' (like a record selector,
-                                -- class operation, or data constructor)
-
-                -- NB: ru_local is *not* used to decide orphan-hood
-                --      c.g. MkIface.coreRuleToIfaceRule
+                                -- class operation, or data constructor).  This
+                                -- is different from 'ru_orphan', where a rule
+                                -- can avoid being an orphan if *any* Name in
+                                -- LHS of the rule was defined in the same
+                                -- module as the rule.
     }
 
   -- | Built-in rules are used for constant folding
   -- and suchlike.  They have no free variables.
+  -- A built-in rule is always visible (there is no such thing as
+  -- an orphan built-in rule.)
   | BuiltinRule {
         ru_name  :: RuleName,   -- ^ As above
         ru_fn    :: Name,       -- ^ As above
@@ -577,7 +899,7 @@ data CoreRule
                 -- arguments, it simply discards them; the returned 'CoreExpr'
                 -- is just the rewrite of 'ru_fn' applied to the first 'ru_nargs' args
     }
-                -- See Note [Extra args in rule matching] in Rules.lhs
+                -- See Note [Extra args in rule matching] in Rules.hs
 
 type RuleFun = DynFlags -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
 type InScopeEnv = (InScopeSet, IdUnfoldingFun)
@@ -734,7 +1056,7 @@ data UnfoldingSource
 
   | InlineCompulsory   -- Something that *has* no binding, so you *must* inline it
                        -- Only a few primop-like things have this property
-                       -- (see MkId.lhs, calls to mkCompulsoryUnfolding).
+                       -- (see MkId.hs, calls to mkCompulsoryUnfolding).
                        -- Inline absolutely always, however boring the context.
 
 
@@ -766,6 +1088,7 @@ data UnfoldingGuidance
                           -- (where there are the right number of arguments.)
 
   | UnfNever        -- The RHS is big, so don't inline it
+  deriving (Eq)
 
 {-
 Note [Historical note: unfoldings for wrappers]
@@ -837,19 +1160,6 @@ evaldUnfolding = OtherCon []
 mkOtherCon :: [AltCon] -> Unfolding
 mkOtherCon = OtherCon
 
-seqUnfolding :: Unfolding -> ()
-seqUnfolding (CoreUnfolding { uf_tmpl = e, uf_is_top = top,
-                uf_is_value = b1, uf_is_work_free = b2,
-                uf_expandable = b3, uf_is_conlike = b4,
-                uf_guidance = g})
-  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` b3 `seq` b4 `seq` seqGuidance g
-
-seqUnfolding _ = ()
-
-seqGuidance :: UnfoldingGuidance -> ()
-seqGuidance (UnfIfGoodArgs ns n b) = n `seq` sum ns `seq` b `seq` ()
-seqGuidance _                      = ()
-
 isStableSource :: UnfoldingSource -> Bool
 -- Keep the unfolding template
 isStableSource InlineCompulsory   = True
@@ -912,7 +1222,7 @@ isExpandableUnfolding _                                              = False
 
 expandUnfolding_maybe :: Unfolding -> Maybe CoreExpr
 -- Expand an expandable unfolding; this is used in rule matching
---   See Note [Expanding variables] in Rules.lhs
+--   See Note [Expanding variables] in Rules.hs
 -- The key point here is that CONLIKE things can be expanded
 expandUnfolding_maybe (CoreUnfolding { uf_expandable = True, uf_tmpl = rhs }) = Just rhs
 expandUnfolding_maybe _                                                       = Nothing
@@ -1017,7 +1327,7 @@ the occurrence info is wrong
 instance Outputable AltCon where
   ppr (DataAlt dc) = ppr dc
   ppr (LitAlt lit) = ppr lit
-  ppr DEFAULT      = ptext (sLit "__DEFAULT")
+  ppr DEFAULT      = text "__DEFAULT"
 
 cmpAlt :: (AltCon, a, b) -> (AltCon, a, b) -> Ordering
 cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
@@ -1068,7 +1378,7 @@ a list of CoreBind
 -}
 
 -- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 type CoreProgram = [CoreBind]   -- See Note [CoreProgram]
 
 -- | The common case for the type of binders and variables when
@@ -1148,11 +1458,16 @@ mkVarApps :: Expr b -> [Var] -> Expr b
 mkConApp      :: DataCon -> [Arg b] -> Expr b
 
 mkApps    f args = foldl App                       f args
-mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
 mkCoApps  f args = foldl (\ e a -> App e (Coercion a)) f args
 mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
 mkConApp con args = mkApps (Var (dataConWorkId con)) args
 
+mkTyApps  f args = foldl (\ e a -> App e (typeOrCoercion a)) f args
+  where
+    typeOrCoercion ty
+      | Just co <- isCoercionTy_maybe ty = Coercion co
+      | otherwise                        = Type ty
+
 mkConApp2 :: DataCon -> [Type] -> [Var] -> Expr b
 mkConApp2 con tys arg_ids = Var (dataConWorkId con)
                             `mkApps` map Type tys
@@ -1249,6 +1564,33 @@ varsToCoreExprs vs = map varToCoreExpr vs
 {-
 ************************************************************************
 *                                                                      *
+   Getting a result type
+*                                                                      *
+************************************************************************
+
+These are defined here to avoid a module loop between CoreUtils and CoreFVs
+
+-}
+
+applyTypeToArg :: Type -> CoreExpr -> Type
+-- ^ Determines the type resulting from applying an expression with given type
+-- to a given argument expression
+applyTypeToArg fun_ty arg = piResultTy fun_ty (exprToType arg)
+
+-- | If the expression is a 'Type', converts. Otherwise,
+-- panics. NB: This does /not/ convert 'Coercion' to 'CoercionTy'.
+exprToType :: CoreExpr -> Type
+exprToType (Type ty)     = ty
+exprToType _bad          = pprPanic "exprToType" empty
+
+-- | If the expression is a 'Coercion', converts.
+exprToCoercion_maybe :: CoreExpr -> Maybe Coercion
+exprToCoercion_maybe (Coercion co) = Just co
+exprToCoercion_maybe _             = Nothing
+
+{-
+************************************************************************
+*                                                                      *
 \subsection{Simple access functions}
 *                                                                      *
 ************************************************************************
@@ -1257,7 +1599,7 @@ varsToCoreExprs vs = map varToCoreExpr vs
 -- | Extract every variable by this group
 bindersOf  :: Bind b -> [b]
 -- If you edit this function, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs
 bindersOf (NonRec binder _) = [binder]
 bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
 
@@ -1282,13 +1624,11 @@ flattenBinds []                   = []
 -- | We often want to strip off leading lambdas before getting down to
 -- business. This function is your friend.
 collectBinders               :: Expr b -> ([b],         Expr b)
--- | Collect as many type bindings as possible from the front of a nested lambda
-collectTyBinders             :: CoreExpr -> ([TyVar],     CoreExpr)
--- | Collect as many value bindings as possible from the front of a nested lambda
-collectValBinders            :: CoreExpr -> ([Id],        CoreExpr)
--- | Collect type binders from the front of the lambda first,
--- then follow up by collecting as many value bindings as possible
--- from the resulting stripped expression
+-- | Collect type and value binders from nested lambdas, stopping
+-- right before any "forall"s within a non-forall. For example,
+-- forall (a :: *) (b :: Foo ~ Bar) (c :: *). Baz -> forall (d :: *). Blob
+-- will pull out the binders for a, b, c, and Baz, but not for d or anything
+-- within Blob. This is to coordinate with tcSplitSigmaTy.
 collectTyAndValBinders       :: CoreExpr -> ([TyVar], [Id], CoreExpr)
 
 collectBinders expr
@@ -1298,22 +1638,15 @@ collectBinders expr
     go bs e          = (reverse bs, e)
 
 collectTyAndValBinders expr
-  = (tvs, ids, body)
-  where
-    (tvs, body1) = collectTyBinders expr
-    (ids, body)  = collectValBinders body1
+  = go_forall [] [] expr
+  where go_forall tvs ids (Lam b e)
+          | isTyVar b       = go_forall (b:tvs) ids e
+          | isCoVar b       = go_forall tvs (b:ids) e
+        go_forall tvs ids e = go_fun tvs ids e
 
-collectTyBinders expr
-  = go [] expr
-  where
-    go tvs (Lam b e) | isTyVar b = go (b:tvs) e
-    go tvs e                     = (reverse tvs, e)
-
-collectValBinders expr
-  = go [] expr
-  where
-    go ids (Lam b e) | isId b = go (b:ids) e
-    go ids body               = (reverse ids, body)
+        go_fun tvs ids (Lam b e)
+          | isId b          = go_fun tvs (b:ids) e
+        go_fun tvs ids e    = (reverse tvs, reverse ids, e)
 
 -- | Takes a nested application expression and returns the the function
 -- being applied and the arguments to which it is applied
@@ -1324,6 +1657,19 @@ collectArgs expr
     go (App f a) as = go f (a:as)
     go e         as = (e, as)
 
+-- | Like @collectArgs@, but also collects looks through floatable
+-- ticks if it means that we can find more arguments.
+collectArgsTicks :: (Tickish Id -> Bool) -> Expr b
+                 -> (Expr b, [Arg b], [Tickish Id])
+collectArgsTicks skipTick expr
+  = go expr [] []
+  where
+    go (App f a)  as ts = go f (a:as) ts
+    go (Tick t e) as ts
+      | skipTick t      = go e as (t:ts)
+    go e          as ts = (e, as, reverse ts)
+
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1375,60 +1721,6 @@ valArgCount = count isValArg
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Seq stuff}
-*                                                                      *
-************************************************************************
--}
-
-seqExpr :: CoreExpr -> ()
-seqExpr (Var v)         = v `seq` ()
-seqExpr (Lit lit)       = lit `seq` ()
-seqExpr (App f a)       = seqExpr f `seq` seqExpr a
-seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
-seqExpr (Let b e)       = seqBind b `seq` seqExpr e
-seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
-seqExpr (Cast e co)     = seqExpr e `seq` seqCo co
-seqExpr (Tick n e)    = seqTickish n `seq` seqExpr e
-seqExpr (Type t)       = seqType t
-seqExpr (Coercion co)   = seqCo co
-
-seqExprs :: [CoreExpr] -> ()
-seqExprs [] = ()
-seqExprs (e:es) = seqExpr e `seq` seqExprs es
-
-seqTickish :: Tickish Id -> ()
-seqTickish ProfNote{ profNoteCC = cc } = cc `seq` ()
-seqTickish HpcTick{} = ()
-seqTickish Breakpoint{ breakpointFVs = ids } = seqBndrs ids
-
-seqBndr :: CoreBndr -> ()
-seqBndr b = b `seq` ()
-
-seqBndrs :: [CoreBndr] -> ()
-seqBndrs [] = ()
-seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
-
-seqBind :: Bind CoreBndr -> ()
-seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
-seqBind (Rec prs)    = seqPairs prs
-
-seqPairs :: [(CoreBndr, CoreExpr)] -> ()
-seqPairs [] = ()
-seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
-
-seqAlts :: [CoreAlt] -> ()
-seqAlts [] = ()
-seqAlts ((c,bs,e):alts) = c `seq` seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
-
-seqRules :: [CoreRule] -> ()
-seqRules [] = ()
-seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules)
-  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
-seqRules (BuiltinRule {} : rules) = seqRules rules
-
-{-
-************************************************************************
-*                                                                      *
 \subsection{Annotated core}
 *                                                                      *
 ************************************************************************
@@ -1468,6 +1760,16 @@ collectAnnArgs expr
     go (_, AnnApp f a) as = go f (a:as)
     go e               as = (e, as)
 
+collectAnnArgsTicks :: (Tickish Var -> Bool) -> AnnExpr b a
+                       -> (AnnExpr b a, [AnnExpr b a], [Tickish Var])
+collectAnnArgsTicks tickishOk expr
+  = go expr [] []
+  where
+    go (_, AnnApp f a)  as ts = go f (a:as) ts
+    go (_, AnnTick t e) as ts | tickishOk t
+                              = go e as (t:ts)
+    go e                as ts = (e, as, reverse ts)
+
 deAnnotate :: AnnExpr bndr annot -> Expr bndr
 deAnnotate (_, e) = deAnnotate' e