Modules: Types (#13009)

Update Haddock submodule Metric Increase: haddock.compiler
author: Sylvain Henry <sylvain@haskus.fr> 2020-03-18 10:44:56 +0100
committer: Marge Bot <ben+marge-bot@smart-cactus.org> 2020-03-29 17:28:51 -0400
commit: 1941ef4f050c0dfcb68229641fcbbde3a10f1072 (patch)
tree: 8e25a61af77696d3022d35cc277b5db5af540f03 /compiler/GHC
parent: 1c446220250dcada51d4bb33a0cc7d8ce572e8b6 (diff)
download: haskell-1941ef4f050c0dfcb68229641fcbbde3a10f1072.tar.gz
305 files changed, 20569 insertions, 1457 deletions
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index 264dcdf980..f957215d38 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -24,9 +24,9 @@ import GHCi.RemoteTypes
 import GHC.Runtime.Interpreter
 
 import GHC.Driver.Types
-import Name
-import NameSet
-import Literal
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Literal
 import GHC.Core.TyCon
 import FastString
 import GHC.StgToCmm.Layout     ( ArgRep(..) )
@@ -35,8 +35,8 @@ import GHC.Driver.Session
 import Outputable
 import GHC.Platform
 import Util
-import Unique
-import UniqDSet
+import GHC.Types.Unique
+import GHC.Types.Unique.DSet
 
 -- From iserv
 import SizedSeq
diff --git a/compiler/GHC/ByteCode/InfoTable.hs b/compiler/GHC/ByteCode/InfoTable.hs
index f5082717f3..93fc4970c4 100644
--- a/compiler/GHC/ByteCode/InfoTable.hs
+++ b/compiler/GHC/ByteCode/InfoTable.hs
@@ -15,8 +15,8 @@ import GHC.ByteCode.Types
 import GHC.Runtime.Interpreter
 import GHC.Driver.Session
 import GHC.Driver.Types
-import Name             ( Name, getName )
-import NameEnv
+import GHC.Types.Name       ( Name, getName )
+import GHC.Types.Name.Env
 import GHC.Core.DataCon     ( DataCon, dataConRepArgTys, dataConIdentity )
 import GHC.Core.TyCon       ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
 import GHC.Types.RepType
diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index 8643752e2b..be1da0a2ef 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -20,13 +20,13 @@ import GHC.StgToCmm.Layout     ( ArgRep(..) )
 import GHC.Core.Ppr
 import Outputable
 import FastString
-import Name
-import Unique
-import Id
+import GHC.Types.Name
+import GHC.Types.Unique
+import GHC.Types.Id
 import GHC.Core
-import Literal
+import GHC.Types.Literal
 import GHC.Core.DataCon
-import VarSet
+import GHC.Types.Var.Set
 import PrimOp
 import GHC.Runtime.Heap.Layout
 
diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 1e77b0967e..0e0dc3ca92 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -28,10 +28,10 @@ import SizedSeq
 import GHC.Runtime.Interpreter
 import GHC.ByteCode.Types
 import GHC.Driver.Types
-import Name
-import NameEnv
+import GHC.Types.Name
+import GHC.Types.Name.Env
 import PrimOp
-import Module
+import GHC.Types.Module
 import FastString
 import Panic
 import Outputable
diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index 491c4f99f9..dbd5152b5c 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -16,14 +16,14 @@ module GHC.ByteCode.Types
 import GhcPrelude
 
 import FastString
-import Id
-import Name
-import NameEnv
+import GHC.Types.Id
+import GHC.Types.Name
+import GHC.Types.Name.Env
 import Outputable
 import PrimOp
 import SizedSeq
 import GHC.Core.Type
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHCi.BreakArray
 import GHCi.RemoteTypes
 import GHCi.FFI
diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index f8cf5789d7..d52c3ad801 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -26,8 +26,8 @@ module GHC.Cmm (
 
 import GhcPrelude
 
-import Id
-import CostCentre
+import GHC.Types.Id
+import GHC.Types.CostCentre
 import GHC.Cmm.CLabel
 import GHC.Cmm.BlockId
 import GHC.Cmm.Node
diff --git a/compiler/GHC/Cmm/BlockId.hs b/compiler/GHC/Cmm/BlockId.hs
index f7f369551b..e458c29902 100644
--- a/compiler/GHC/Cmm/BlockId.hs
+++ b/compiler/GHC/Cmm/BlockId.hs
@@ -11,10 +11,10 @@ module GHC.Cmm.BlockId
 import GhcPrelude
 
 import GHC.Cmm.CLabel
-import IdInfo
-import Name
-import Unique
-import UniqSupply
+import GHC.Types.Id.Info
+import GHC.Types.Name
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 
 import GHC.Cmm.Dataflow.Label (Label, mkHooplLabel)
 
diff --git a/compiler/GHC/Cmm/BlockId.hs-boot b/compiler/GHC/Cmm/BlockId.hs-boot
index 76fd6180a9..4588ce1282 100644
--- a/compiler/GHC/Cmm/BlockId.hs-boot
+++ b/compiler/GHC/Cmm/BlockId.hs-boot
@@ -1,7 +1,7 @@
 module GHC.Cmm.BlockId (BlockId, mkBlockId) where
 
 import GHC.Cmm.Dataflow.Label (Label)
-import Unique (Unique)
+import GHC.Types.Unique (Unique)
 
 type BlockId = Label
 
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index eea71d0ce9..89fa2f8867 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -115,20 +115,20 @@ module GHC.Cmm.CLabel (
 
 import GhcPrelude
 
-import IdInfo
-import BasicTypes
+import GHC.Types.Id.Info
+import GHC.Types.Basic
 import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
 import GHC.Driver.Packages
-import Module
-import Name
-import Unique
+import GHC.Types.Module
+import GHC.Types.Name
+import GHC.Types.Unique
 import PrimOp
-import CostCentre
+import GHC.Types.CostCentre
 import Outputable
 import FastString
 import GHC.Driver.Session
 import GHC.Platform
-import UniqSet
+import GHC.Types.Unique.Set
 import Util
 import GHC.Core.Ppr ( {- instances -} )
 
diff --git a/compiler/GHC/Cmm/CommonBlockElim.hs b/compiler/GHC/Cmm/CommonBlockElim.hs
index 29f019fa15..575e041e73 100644
--- a/compiler/GHC/Cmm/CommonBlockElim.hs
+++ b/compiler/GHC/Cmm/CommonBlockElim.hs
@@ -25,8 +25,8 @@ import Data.Word
 import qualified Data.Map as M
 import Outputable
 import qualified TrieMap as TM
-import UniqFM
-import Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
 import Control.Arrow (first, second)
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Cmm/Dataflow.hs b/compiler/GHC/Cmm/Dataflow.hs
index 4f900c32ac..d697240191 100644
--- a/compiler/GHC/Cmm/Dataflow.hs
+++ b/compiler/GHC/Cmm/Dataflow.hs
@@ -37,7 +37,7 @@ where
 import GhcPrelude
 
 import GHC.Cmm
-import UniqSupply
+import GHC.Types.Unique.Supply
 
 import Data.Array
 import Data.Maybe
diff --git a/compiler/GHC/Cmm/Dataflow/Label.hs b/compiler/GHC/Cmm/Dataflow/Label.hs
index b27ff341e5..70027570d3 100644
--- a/compiler/GHC/Cmm/Dataflow/Label.hs
+++ b/compiler/GHC/Cmm/Dataflow/Label.hs
@@ -20,7 +20,7 @@ import Outputable
 -- TODO: This should really just use GHC's Unique and Uniq{Set,FM}
 import GHC.Cmm.Dataflow.Collections
 
-import Unique (Uniquable(..))
+import GHC.Types.Unique (Uniquable(..))
 import TrieMap
 
 
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 9d2da26b93..2129b3e7aa 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -34,10 +34,10 @@ import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Core
 import FastString      ( nilFS, mkFastString )
-import Module
+import GHC.Types.Module
 import Outputable
 import GHC.Cmm.Ppr.Expr ( pprExpr )
-import SrcLoc
+import GHC.Types.SrcLoc
 import Util            ( seqList )
 
 import GHC.Cmm.Dataflow.Block
diff --git a/compiler/GHC/Cmm/Expr.hs b/compiler/GHC/Cmm/Expr.hs
index 3c92c1e61b..1600588e2c 100644
--- a/compiler/GHC/Cmm/Expr.hs
+++ b/compiler/GHC/Cmm/Expr.hs
@@ -40,12 +40,12 @@ import GHC.Cmm.MachOp
 import GHC.Cmm.Type
 import GHC.Driver.Session
 import Outputable (panic)
-import Unique
+import GHC.Types.Unique
 
 import Data.Set (Set)
 import qualified Data.Set as Set
 
-import BasicTypes (Alignment, mkAlignment, alignmentOf)
+import GHC.Types.Basic (Alignment, mkAlignment, alignmentOf)
 
 -----------------------------------------------------------------------------
 --              CmmExpr
diff --git a/compiler/GHC/Cmm/Graph.hs b/compiler/GHC/Cmm/Graph.hs
index 413bce3f1e..01fa4dc955 100644
--- a/compiler/GHC/Cmm/Graph.hs
+++ b/compiler/GHC/Cmm/Graph.hs
@@ -33,10 +33,10 @@ import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Driver.Session
 import FastString
-import ForeignCall
+import GHC.Types.ForeignCall
 import OrdList
 import GHC.Runtime.Heap.Layout (ByteOff)
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Util
 import Panic
 
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 7a1bc2d3d1..6da996ad45 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -49,7 +49,7 @@ import Maybes
 import GHC.Driver.Session
 import ErrUtils (withTimingSilent)
 import Panic
-import UniqSupply
+import GHC.Types.Unique.Supply
 import MonadUtils
 import Util
 import Outputable
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 274345ab7a..6c8551587b 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -10,15 +10,15 @@ module GHC.Cmm.Info.Build
 
 import GhcPrelude hiding (succ)
 
-import Id
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
-import Module
+import GHC.Types.Module
 import GHC.Platform
 import Digraph
 import GHC.Cmm.CLabel
@@ -28,8 +28,8 @@ import GHC.Driver.Session
 import Maybes
 import Outputable
 import GHC.Runtime.Heap.Layout
-import UniqSupply
-import CostCentre
+import GHC.Types.Unique.Supply
+import GHC.Types.CostCentre
 import GHC.StgToCmm.Heap
 
 import Control.Monad
@@ -41,7 +41,7 @@ import Control.Monad.Trans.State
 import Control.Monad.Trans.Class
 import Data.List (unzip4)
 
-import NameSet
+import GHC.Types.Name.Set
 
 {- Note [SRTs]
 
diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index ba480a25b7..4cf7fcfdc1 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -8,14 +8,14 @@ import GhcPrelude hiding ((<*>))
 import GHC.StgToCmm.Utils      ( callerSaveVolatileRegs, newTemp  ) -- XXX layering violation
 import GHC.StgToCmm.Foreign    ( saveThreadState, loadThreadState ) -- XXX layering violation
 
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Cmm
 import GHC.Cmm.Info
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm.Utils
 import GHC.Cmm.Graph
-import ForeignCall
+import GHC.Types.ForeignCall
 import GHC.Cmm.Liveness
 import GHC.Cmm.ProcPoint
 import GHC.Runtime.Heap.Layout
@@ -24,9 +24,9 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Maybes
-import UniqFM
+import GHC.Types.Unique.FM
 import Util
 
 import GHC.Platform
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x
index be2f676608..a1aebc9fb9 100644
--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -21,8 +21,8 @@ import GHC.Cmm.Expr
 
 import Lexer
 import GHC.Cmm.Monad
-import SrcLoc
-import UniqFM
+import GHC.Types.SrcLoc
+import GHC.Types.Unique.FM
 import StringBuffer
 import FastString
 import Ctype
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index c809a99136..98314a8da3 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -33,11 +33,11 @@ import GHC.Cmm.Expr
 import GHC.Cmm.Switch
 import GHC.Driver.Session
 import FastString
-import ForeignCall
+import GHC.Types.ForeignCall
 import Outputable
 import GHC.Runtime.Heap.Layout
 import GHC.Core (Tickish)
-import qualified Unique as U
+import qualified GHC.Types.Unique as U
 
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
@@ -45,7 +45,7 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import Data.Maybe
 import Data.List (tails,sortBy)
-import Unique (nonDetCmpUnique)
+import GHC.Types.Unique (nonDetCmpUnique)
 import Util
 
 
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 6b07af8859..cb34fbc52f 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -234,14 +234,14 @@ import GHC.Cmm.Monad
 import GHC.Runtime.Heap.Layout
 import Lexer
 
-import CostCentre
-import ForeignCall
-import Module
+import GHC.Types.CostCentre
+import GHC.Types.ForeignCall
+import GHC.Types.Module
 import GHC.Platform
-import Literal
-import Unique
-import UniqFM
-import SrcLoc
+import GHC.Types.Literal
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.SrcLoc
 import GHC.Driver.Session
 import ErrUtils
 import StringBuffer
@@ -249,9 +249,9 @@ import FastString
 import Panic
 import Constants
 import Outputable
-import BasicTypes
+import GHC.Types.Basic
 import Bag              ( emptyBag, unitBag )
-import Var
+import GHC.Types.Var
 
 import Control.Monad
 import Data.Array
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index a2d47b3d48..e730cfda40 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -22,7 +22,7 @@ import GHC.Cmm.LayoutStack
 import GHC.Cmm.Sink
 import GHC.Cmm.Dataflow.Collections
 
-import UniqSupply
+import GHC.Types.Unique.Supply
 import GHC.Driver.Session
 import ErrUtils
 import GHC.Driver.Types
diff --git a/compiler/GHC/Cmm/Ppr.hs b/compiler/GHC/Cmm/Ppr.hs
index 324fc8f1b1..d37b960c80 100644
--- a/compiler/GHC/Cmm/Ppr.hs
+++ b/compiler/GHC/Cmm/Ppr.hs
@@ -54,7 +54,7 @@ import GHC.Cmm.Ppr.Decl
 import GHC.Cmm.Ppr.Expr
 import Util
 
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
 
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 42bd342e86..9017c0eb0c 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -25,7 +25,7 @@ import Maybes
 import Control.Monad
 import Outputable
 import GHC.Platform
-import UniqSupply
+import GHC.Types.Unique.Supply
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
diff --git a/compiler/GHC/Cmm/Sink.hs b/compiler/GHC/Cmm/Sink.hs
index 5dd7fac1d0..3ca4fe9c75 100644
--- a/compiler/GHC/Cmm/Sink.hs
+++ b/compiler/GHC/Cmm/Sink.hs
@@ -17,8 +17,8 @@ import GHC.Platform.Regs
 
 import GHC.Platform
 import GHC.Driver.Session
-import Unique
-import UniqFM
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
 
 import qualified Data.IntSet as IntSet
 import Data.List (partition)
diff --git a/compiler/GHC/Cmm/Switch/Implement.hs b/compiler/GHC/Cmm/Switch/Implement.hs
index 7df32dd2e8..b098917711 100644
--- a/compiler/GHC/Cmm/Switch/Implement.hs
+++ b/compiler/GHC/Cmm/Switch/Implement.hs
@@ -12,7 +12,7 @@ import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
-import UniqSupply
+import GHC.Types.Unique.Supply
 import GHC.Driver.Session
 import MonadUtils (concatMapM)
 
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index 90cbaffd5f..82cb75a904 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -83,7 +83,7 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import Outputable
 import GHC.Driver.Session
-import Unique
+import GHC.Types.Unique
 import GHC.Platform.Regs
 
 import Data.ByteString (ByteString)
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 5b1847013c..4ccdad826d 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -83,19 +83,19 @@ import GHC.Cmm.Opt           ( cmmMachOpFold )
 import GHC.Cmm.Ppr
 import GHC.Cmm.CLabel
 
-import UniqFM
-import UniqSupply
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
 import GHC.Driver.Session
 import Util
 
-import BasicTypes       ( Alignment )
+import GHC.Types.Basic       ( Alignment )
 import qualified Pretty
 import BufWrite
 import Outputable
 import FastString
-import UniqSet
+import GHC.Types.Unique.Set
 import ErrUtils
-import Module
+import GHC.Types.Module
 import Stream (Stream)
 import qualified Stream
 
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index 0665e71433..7ff90e8c40 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -27,9 +27,9 @@ import GHC.Cmm.Dataflow.Label
 
 import GHC.Platform
 import GHC.Driver.Session (gopt, GeneralFlag(..), DynFlags, targetPlatform)
-import UniqFM
+import GHC.Types.Unique.FM
 import Util
-import Unique
+import GHC.Types.Unique
 
 import Digraph
 import Outputable
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index 0995ecab61..dca02b0eb5 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -60,7 +60,7 @@ import Util
 import Digraph
 import Maybes
 
-import Unique
+import GHC.Types.Unique
 import qualified GHC.CmmToAsm.CFG.Dominators as Dom
 import Data.IntMap.Strict (IntMap)
 import Data.IntSet (IntSet)
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 9270a308a8..8075bdd27e 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -10,11 +10,11 @@ import Config          ( cProjectName, cProjectVersion )
 import GHC.Core        ( Tickish(..) )
 import GHC.Cmm.DebugBlock
 import GHC.Driver.Session
-import Module
+import GHC.Types.Module
 import Outputable
 import GHC.Platform
-import Unique
-import UniqSupply
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 
 import GHC.CmmToAsm.Dwarf.Constants
 import GHC.CmmToAsm.Dwarf.Types
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index c54815aff7..eaeb570595 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -31,9 +31,9 @@ import Encoding
 import FastString
 import Outputable
 import GHC.Platform
-import Unique
+import GHC.Types.Unique
 import GHC.Platform.Reg
-import SrcLoc
+import GHC.Types.SrcLoc
 import Util
 
 import GHC.CmmToAsm.Dwarf.Constants
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 89e64d5e79..f6e5515705 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -60,11 +60,11 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.CLabel           ( CLabel )
 import GHC.Cmm.DebugBlock
 import FastString       ( FastString )
-import UniqFM
-import UniqSupply
-import Unique           ( Unique )
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
+import GHC.Types.Unique         ( Unique )
 import GHC.Driver.Session
-import Module
+import GHC.Types.Module
 
 import Control.Monad    ( ap )
 
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index a9668133fc..cb7d82a6c5 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -70,8 +70,8 @@ import GHC.Cmm.CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
 import GHC.Cmm.CLabel           ( mkForeignLabel )
 
 
-import BasicTypes
-import Module
+import GHC.Types.Basic
+import GHC.Types.Module
 
 import Outputable
 
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index d597051b54..e5177b80b3 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -63,7 +63,7 @@ import Control.Monad    ( mapAndUnzipM, when )
 import Data.Bits
 import Data.Word
 
-import BasicTypes
+import GHC.Types.Basic
 import FastString
 import Util
 
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index 26742b5a17..e622d801a8 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
@@ -45,8 +45,8 @@ import FastString
 import GHC.Cmm.CLabel
 import Outputable
 import GHC.Platform
-import UniqFM (listToUFM, lookupUFM)
-import UniqSupply
+import GHC.Types.Unique.FM (listToUFM, lookupUFM)
+import GHC.Types.Unique.Supply
 
 import Control.Monad (replicateM)
 import Data.Maybe (fromMaybe)
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index a66d1c2f99..90b85023a2 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -30,7 +30,7 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm.Ppr.Expr () -- For Outputable instances
 
-import Unique                ( pprUniqueAlways, getUnique )
+import GHC.Types.Unique ( pprUniqueAlways, getUnique )
 import GHC.Platform
 import FastString
 import Outputable
diff --git a/compiler/GHC/CmmToAsm/PPC/RegInfo.hs b/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
index a75040d703..5a48ed28e0 100644
--- a/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
+++ b/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
@@ -27,7 +27,7 @@ import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Cmm.CLabel
 
-import Unique
+import GHC.Types.Unique
 import Outputable (ppr, text, Outputable, (<>))
 
 data JumpDest = DestBlockId BlockId
diff --git a/compiler/GHC/CmmToAsm/PPC/Regs.hs b/compiler/GHC/CmmToAsm/PPC/Regs.hs
index 90f8a62ab7..86675daf5f 100644
--- a/compiler/GHC/CmmToAsm/PPC/Regs.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Regs.hs
@@ -57,7 +57,7 @@ import GHC.CmmToAsm.Format
 
 import GHC.Cmm
 import GHC.Cmm.CLabel           ( CLabel )
-import Unique
+import GHC.Types.Unique
 
 import GHC.Platform.Regs
 import Outputable
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs
index 7f0cacfcb4..443072b246 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs
@@ -23,9 +23,9 @@ import GHC.Platform.Reg
 import Bag
 import Outputable
 import GHC.Platform
-import UniqFM
-import UniqSet
-import UniqSupply
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.Supply
 import Util (seqList)
 import GHC.CmmToAsm.CFG
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs
index 95fa174415..ba3f825149 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs
@@ -24,9 +24,9 @@ module GHC.CmmToAsm.Reg.Graph.Base (
 
 import GhcPrelude
 
-import UniqSet
-import UniqFM
-import Unique
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
 import MonadUtils (concatMapM)
 
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
index d223137dd0..dd28981261 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
@@ -12,9 +12,9 @@ import GHC.Platform.Reg
 import GHC.Cmm
 import Bag
 import Digraph
-import UniqFM
-import UniqSet
-import UniqSupply
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.Supply
 
 
 -- | Do register coalescing on this top level thing
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
index a0e11433f7..5ae55334a2 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
@@ -18,10 +18,10 @@ import GHC.Cmm.Dataflow.Collections
 
 import MonadUtils
 import State
-import Unique
-import UniqFM
-import UniqSet
-import UniqSupply
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.Supply
 import Outputable
 import GHC.Platform
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
index 6d14c7194b..ac784582e7 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
@@ -37,9 +37,9 @@ import GHC.Platform.Reg
 
 import GHC.Cmm.BlockId
 import GHC.Cmm
-import UniqSet
-import UniqFM
-import Unique
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
 import State
 import Outputable
 import GHC.Platform
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
index e3e456e98d..6484a38d79 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
@@ -25,8 +25,8 @@ import GraphBase
 import GHC.Cmm.Dataflow.Collections (mapLookup)
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
-import UniqFM
-import UniqSet
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
 import Digraph          (flattenSCCs)
 import Outputable
 import GHC.Platform
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
index 2285d3e908..a06a22fa05 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
@@ -30,8 +30,8 @@ import GHC.CmmToAsm.Reg.Target
 import GHC.Platform
 
 import Outputable
-import UniqFM
-import UniqSet
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
 import State
 
 -- | Holds interesting statistics from the register allocator.
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs b/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
index ec7c5ad13e..4cf3d98eb1 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
@@ -15,7 +15,7 @@ import GHC.Platform.Reg
 
 import GraphBase
 
-import UniqSet
+import GHC.Types.Unique.Set
 import GHC.Platform
 import Panic
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs b/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs
index 0d4c56ba21..c673c69c1d 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs
@@ -18,7 +18,7 @@ module GHC.CmmToAsm.Reg.Graph.X86 (
 import GhcPrelude
 
 import GHC.CmmToAsm.Reg.Graph.Base  (Reg(..), RegSub(..), RegClass(..))
-import UniqSet
+import GHC.Types.Unique.Set
 
 import qualified Data.Array as A
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs
index 155d67c2c2..a093bad83a 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs
@@ -127,10 +127,10 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm hiding (RegSet)
 
 import Digraph
-import Unique
-import UniqSet
-import UniqFM
-import UniqSupply
+import GHC.Types.Unique
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
 import Outputable
 import GHC.Platform
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
index 92b3ee19a3..95036adb26 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
@@ -25,9 +25,9 @@ import GHC.CmmToAsm.Config
 import GHC.Platform.Reg
 
 import Outputable
-import Unique
-import UniqFM
-import UniqSupply
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
 import GHC.Cmm.BlockId
 
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index 0874cd0dbf..55735913d4 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -24,9 +24,9 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
 import Digraph
 import Outputable
-import Unique
-import UniqFM
-import UniqSet
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
 
 -- | For a jump instruction at the end of a block, generate fixup code so its
 --      vregs are in the correct regs for its destination.
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
index 00fcfd91c8..c2477fc18f 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
@@ -22,8 +22,8 @@ where
 
 import GhcPrelude
 
-import UniqFM
-import Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
 
 
 -- | Identifier for a stack slot.
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/State.hs b/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
index 5a1e3a4c3f..cf8913e211 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
@@ -50,8 +50,8 @@ import GHC.Platform.Reg
 import GHC.Cmm.BlockId
 
 import GHC.Platform
-import Unique
-import UniqSupply
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 
 import Control.Monad (ap)
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
index 1176b220a3..84acc3a417 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
@@ -12,7 +12,7 @@ import GHC.CmmToAsm.Reg.Linear.Base
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
 
-import UniqFM
+import GHC.Types.Unique.FM
 import Outputable
 
 import State
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index d1c4c8f498..5f5d4c8ff3 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -53,9 +53,9 @@ import Digraph
 import MonadUtils
 import Outputable
 import GHC.Platform
-import UniqSet
-import UniqFM
-import UniqSupply
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
 import Bag
 import State
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Target.hs b/compiler/GHC/CmmToAsm/Reg/Target.hs
index a45d70c826..183d329790 100644
--- a/compiler/GHC/CmmToAsm/Reg/Target.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Target.hs
@@ -28,7 +28,7 @@ import GHC.Platform.Reg.Class
 import GHC.CmmToAsm.Format
 
 import Outputable
-import Unique
+import GHC.Types.Unique
 import GHC.Platform
 
 import qualified GHC.CmmToAsm.X86.Regs       as X86
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index 67177ea0c6..ec7d59fe02 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -52,7 +52,7 @@ import GHC.Cmm.CLabel
 import GHC.CmmToAsm.CPrim
 
 -- The rest:
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Driver.Session
 import FastString
 import OrdList
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 566b23c1d6..a65ac03458 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -45,7 +45,7 @@ import GHC.Cmm.CLabel
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Dataflow.Collections
 
-import Unique           ( pprUniqueAlways )
+import GHC.Types.Unique ( pprUniqueAlways )
 import Outputable
 import GHC.Platform
 import FastString
diff --git a/compiler/GHC/CmmToAsm/SPARC/Regs.hs b/compiler/GHC/CmmToAsm/SPARC/Regs.hs
index ba22470912..d6d5d87bf6 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Regs.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Regs.hs
@@ -39,7 +39,7 @@ import GHC.Platform.Reg
 import GHC.Platform.Reg.Class
 import GHC.CmmToAsm.Format
 
-import Unique
+import GHC.Types.Unique
 import Outputable
 
 {-
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index deabf01425..1a22fc27f0 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -65,9 +65,9 @@ import GHC.Platform.Reg
 import GHC.Platform
 
 -- Our intermediate code:
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Cmm.BlockId
-import Module           ( primUnitId )
+import GHC.Types.Module ( primUnitId )
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
 import GHC.Cmm
@@ -77,16 +77,16 @@ import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.CLabel
 import GHC.Core          ( Tickish(..) )
-import SrcLoc           ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
+import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 
 -- The rest:
-import ForeignCall      ( CCallConv(..) )
+import GHC.Types.ForeignCall ( CCallConv(..) )
 import OrdList
 import Outputable
 import FastString
 import GHC.Driver.Session
 import Util
-import UniqSupply       ( getUniqueM )
+import GHC.Types.Unique.Supply ( getUniqueM )
 
 import Control.Monad
 import Data.Bits
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 71ee322516..846ef9b72f 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -38,11 +38,11 @@ import FastString
 import Outputable
 import GHC.Platform
 
-import BasicTypes       (Alignment)
+import GHC.Types.Basic (Alignment)
 import GHC.Cmm.CLabel
-import UniqSet
-import Unique
-import UniqSupply
+import GHC.Types.Unique.Set
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 import GHC.Cmm.DebugBlock (UnwindTable)
 
 import Control.Monad
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 0dfd394d8e..357e24a9cc 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -36,12 +36,12 @@ import GHC.CmmToAsm.Ppr
 
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
-import BasicTypes       (Alignment, mkAlignment, alignmentBytes)
+import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
 import GHC.Driver.Session
 import GHC.Cmm              hiding (topInfoTable)
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import Unique           ( pprUniqueAlways )
+import GHC.Types.Unique ( pprUniqueAlways )
 import GHC.Platform
 import FastString
 import Outputable
diff --git a/compiler/GHC/CmmToAsm/X86/RegInfo.hs b/compiler/GHC/CmmToAsm/X86/RegInfo.hs
index 597efe1c3e..5b2464c415 100644
--- a/compiler/GHC/CmmToAsm/X86/RegInfo.hs
+++ b/compiler/GHC/CmmToAsm/X86/RegInfo.hs
@@ -15,9 +15,9 @@ import GHC.Platform.Reg
 
 import Outputable
 import GHC.Platform
-import Unique
+import GHC.Types.Unique
 
-import UniqFM
+import GHC.Types.Unique.FM
 import GHC.CmmToAsm.X86.Regs
 
 
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index 71b0793057..8b130afc7c 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -30,7 +30,7 @@ import GhcPrelude
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import ForeignCall
+import GHC.Types.ForeignCall
 import GHC.Cmm hiding (pprBBlock)
 import GHC.Cmm.Ppr () -- For Outputable instances
 import GHC.Cmm.Dataflow.Block
@@ -45,9 +45,9 @@ import GHC.Driver.Session
 import FastString
 import Outputable
 import GHC.Platform
-import UniqSet
-import UniqFM
-import Unique
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
 import Util
 
 -- The rest
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index b16e4cd00b..981535e993 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -54,11 +54,11 @@ import GHC.Cmm              hiding ( succ )
 import GHC.Cmm.Utils (regsOverlap)
 import Outputable as Outp
 import GHC.Platform
-import UniqFM
-import Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
 import BufWrite   ( BufHandle )
-import UniqSet
-import UniqSupply
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.Supply
 import ErrUtils
 import qualified Stream
 
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index a3f40ce306..7b3d198fa9 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -27,13 +27,13 @@ import GHC.Cmm.Dataflow.Collections
 
 import GHC.Driver.Session
 import FastString
-import ForeignCall
+import GHC.Types.ForeignCall
 import Outputable hiding (panic, pprPanic)
 import qualified Outputable
 import GHC.Platform
 import OrdList
-import UniqSupply
-import Unique
+import GHC.Types.Unique.Supply
+import GHC.Types.Unique
 import Util
 
 import Control.Monad.Trans.Class
diff --git a/compiler/GHC/CmmToLlvm/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs
index f4540c212c..fea3d351fa 100644
--- a/compiler/GHC/CmmToLlvm/Ppr.hs
+++ b/compiler/GHC/CmmToLlvm/Ppr.hs
@@ -20,7 +20,7 @@ import GHC.Cmm
 
 import FastString
 import Outputable
-import Unique
+import GHC.Types.Unique
 
 -- ----------------------------------------------------------------------------
 -- * Top level
diff --git a/compiler/GHC/CmmToLlvm/Regs.hs b/compiler/GHC/CmmToLlvm/Regs.hs
index 82a4ae18e2..6e9be62937 100644
--- a/compiler/GHC/CmmToLlvm/Regs.hs
+++ b/compiler/GHC/CmmToLlvm/Regs.hs
@@ -19,7 +19,7 @@ import GHC.Cmm.Expr
 import GHC.Platform
 import FastString
 import Outputable ( panic )
-import Unique
+import GHC.Types.Unique
 
 -- | Get the LlvmVar function variable storing the real register
 lmGlobalRegVar :: Platform -> GlobalReg -> LlvmVar
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 931fa5ae86..8c354b5298 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -102,22 +102,22 @@ module GHC.Core (
 import GhcPrelude
 import GHC.Platform
 
-import CostCentre
-import VarEnv( InScopeSet )
-import Var
+import GHC.Types.CostCentre
+import GHC.Types.Var.Env( InScopeSet )
+import GHC.Types.Var
 import GHC.Core.Type
 import GHC.Core.Coercion
-import Name
-import NameSet
-import NameEnv( NameEnv, emptyNameEnv )
-import Literal
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env( NameEnv, emptyNameEnv )
+import GHC.Types.Literal
 import GHC.Core.DataCon
-import Module
-import BasicTypes
+import GHC.Types.Module
+import GHC.Types.Basic
 import Outputable
 import Util
-import UniqSet
-import SrcLoc     ( RealSrcSpan, containsSpan )
+import GHC.Types.Unique.Set
+import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
 import Binary
 
 import Data.Data hiding (TyCon)
diff --git a/compiler/GHC/Core/Arity.hs b/compiler/GHC/Core/Arity.hs
index df16701396..23e2eaf734 100644
--- a/compiler/GHC/Core/Arity.hs
+++ b/compiler/GHC/Core/Arity.hs
@@ -27,16 +27,16 @@ import GHC.Core
 import GHC.Core.FVs
 import GHC.Core.Utils
 import GHC.Core.Subst
-import Demand
-import Var
-import VarEnv
-import Id
+import GHC.Types.Demand
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Id
 import GHC.Core.Type as Type
 import GHC.Core.TyCon     ( initRecTc, checkRecTc )
 import GHC.Core.Predicate ( isDictTy )
 import GHC.Core.Coercion as Coercion
-import BasicTypes
-import Unique
+import GHC.Types.Basic
+import GHC.Types.Unique
 import GHC.Driver.Session ( DynFlags, GeneralFlag(..), gopt )
 import Outputable
 import FastString
diff --git a/compiler/GHC/Core/Class.hs b/compiler/GHC/Core/Class.hs
index 5020ce6617..454f7015dd 100644
--- a/compiler/GHC/Core/Class.hs
+++ b/compiler/GHC/Core/Class.hs
@@ -28,12 +28,12 @@ import GhcPrelude
 import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )
 import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, PredType )
 import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType )
-import Var
-import Name
-import BasicTypes
-import Unique
+import GHC.Types.Var
+import GHC.Types.Name
+import GHC.Types.Basic
+import GHC.Types.Unique
 import Util
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
 import BooleanFormula (BooleanFormula, mkTrue)
 
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index 06dfa2e02b..06de44f65b 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -132,21 +132,21 @@ import GHC.Core.TyCo.Tidy
 import GHC.Core.Type
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
-import Var
-import VarEnv
-import VarSet
-import Name hiding ( varName )
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Name hiding ( varName )
 import Util
-import BasicTypes
+import GHC.Types.Basic
 import Outputable
-import Unique
+import GHC.Types.Unique
 import Pair
-import SrcLoc
+import GHC.Types.SrcLoc
 import PrelNames
 import TysPrim
 import ListSetOps
 import Maybes
-import UniqFM
+import GHC.Types.Unique.FM
 
 import Control.Monad (foldM, zipWithM)
 import Data.Function ( on )
diff --git a/compiler/GHC/Core/Coercion.hs-boot b/compiler/GHC/Core/Coercion.hs-boot
index 8354cf1ad4..8a10e09268 100644
--- a/compiler/GHC/Core/Coercion.hs-boot
+++ b/compiler/GHC/Core/Coercion.hs-boot
@@ -7,9 +7,9 @@ import GhcPrelude
 import {-# SOURCE #-} GHC.Core.TyCo.Rep
 import {-# SOURCE #-} GHC.Core.TyCon
 
-import BasicTypes ( LeftOrRight )
+import GHC.Types.Basic ( LeftOrRight )
 import GHC.Core.Coercion.Axiom
-import Var
+import GHC.Types.Var
 import Pair
 import Util
 
diff --git a/compiler/GHC/Core/Coercion/Axiom.hs b/compiler/GHC/Core/Coercion/Axiom.hs
index b2a66033ac..9b8fb6e067 100644
--- a/compiler/GHC/Core/Coercion/Axiom.hs
+++ b/compiler/GHC/Core/Coercion/Axiom.hs
@@ -36,15 +36,15 @@ import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType )
 import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )
 import Outputable
 import FastString
-import Name
-import Unique
-import Var
+import GHC.Types.Name
+import GHC.Types.Unique
+import GHC.Types.Var
 import Util
 import Binary
 import Pair
-import BasicTypes
+import GHC.Types.Basic
 import Data.Typeable ( Typeable )
-import SrcLoc
+import GHC.Types.SrcLoc
 import qualified Data.Data as Data
 import Data.Array
 import Data.List ( mapAccumL )
diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs
index 685d3a278c..c5de884963 100644
--- a/compiler/GHC/Core/Coercion/Opt.hs
+++ b/compiler/GHC/Core/Coercion/Opt.hs
@@ -16,8 +16,8 @@ import GHC.Core.Type as Type hiding( substTyVarBndr, substTy )
 import TcType       ( exactTyCoVarsOfType )
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
-import VarSet
-import VarEnv
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import Outputable
 import GHC.Core.FamInstEnv ( flattenTys )
 import Pair
diff --git a/compiler/GHC/Core/ConLike.hs b/compiler/GHC/Core/ConLike.hs
index 14e859acd6..0d538af40a 100644
--- a/compiler/GHC/Core/ConLike.hs
+++ b/compiler/GHC/Core/ConLike.hs
@@ -31,12 +31,12 @@ import GhcPrelude
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
 import Outputable
-import Unique
+import GHC.Types.Unique
 import Util
-import Name
-import BasicTypes
+import GHC.Types.Name
+import GHC.Types.Basic
 import GHC.Core.TyCo.Rep (Type, ThetaType)
-import Var
+import GHC.Types.Var
 import GHC.Core.Type(mkTyConApp)
 
 import qualified Data.Data as Data
@@ -69,7 +69,7 @@ eqConLike x y = getUnique x == getUnique y
 
 -- There used to be an Ord ConLike instance here that used Unique for ordering.
 -- It was intentionally removed to prevent determinism problems.
--- See Note [Unique Determinism] in Unique.
+-- See Note [Unique Determinism] in GHC.Types.Unique.
 
 instance Uniquable ConLike where
     getUnique (RealDataCon dc) = getUnique dc
diff --git a/compiler/GHC/Core/ConLike.hs-boot b/compiler/GHC/Core/ConLike.hs-boot
index 8b007a2e0d..0a6e732d88 100644
--- a/compiler/GHC/Core/ConLike.hs-boot
+++ b/compiler/GHC/Core/ConLike.hs-boot
@@ -1,7 +1,7 @@
 module GHC.Core.ConLike where
 import {-# SOURCE #-} GHC.Core.DataCon (DataCon)
 import {-# SOURCE #-} GHC.Core.PatSyn (PatSyn)
-import Name ( Name )
+import GHC.Types.Name ( Name )
 
 data ConLike = RealDataCon DataCon
              | PatSynCon PatSyn
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index 5b3501b3a9..13470c93af 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -63,25 +63,25 @@ module GHC.Core.DataCon (
 
 import GhcPrelude
 
-import {-# SOURCE #-} MkId( DataConBoxer )
+import {-# SOURCE #-} GHC.Types.Id.Make ( DataConBoxer )
 import GHC.Core.Type as Type
 import GHC.Core.Coercion
 import GHC.Core.Unify
 import GHC.Core.TyCon
-import FieldLabel
+import GHC.Types.FieldLabel
 import GHC.Core.Class
-import Name
+import GHC.Types.Name
 import PrelNames
 import GHC.Core.Predicate
-import Var
+import GHC.Types.Var
 import Outputable
 import Util
-import BasicTypes
+import GHC.Types.Basic
 import FastString
-import Module
+import GHC.Types.Module
 import Binary
-import UniqSet
-import Unique( mkAlphaTyVarUnique )
+import GHC.Types.Unique.Set
+import GHC.Types.Unique( mkAlphaTyVarUnique )
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Builder as BSB
@@ -204,7 +204,7 @@ Note [Data constructor workers and wrappers]
 Note [The need for a wrapper]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Why might the wrapper have anything to do?  The full story is
-in wrapper_reqd in MkId.mkDataConRep.
+in wrapper_reqd in GHC.Types.Id.Make.mkDataConRep.
 
 * Unboxing strict fields (with -funbox-strict-fields)
         data T = MkT !(Int,Int)
@@ -614,7 +614,7 @@ data DataConRep
                                  -- and *including* all evidence args
 
         , dcr_stricts :: [StrictnessMark]  -- 1-1 with dcr_arg_tys
-                -- See also Note [Data-con worker strictness] in MkId.hs
+                -- See also Note [Data-con worker strictness] in GHC.Types.Id.Make
 
         , dcr_bangs :: [HsImplBang]  -- The actual decisions made (including failures)
                                      -- about the original arguments; 1-1 with orig_arg_tys
@@ -634,7 +634,7 @@ data DataConRep
 -- emit a warning (in checkValidDataCon) and treat it like
 -- @(HsSrcBang _ NoSrcUnpack SrcLazy)@
 data HsSrcBang =
-  HsSrcBang SourceText -- Note [Pragma source text] in BasicTypes
+  HsSrcBang SourceText -- Note [Pragma source text] in GHC.Types.Basic
             SrcUnpackedness
             SrcStrictness
   deriving Data.Data
@@ -740,7 +740,7 @@ Terminology:
 * However, if T was defined in an imported module, the importing module
   must follow the decisions made in the original module, regardless of
   the flag settings in the importing module.
-  Also see Note [Bangs on imported data constructors] in MkId
+  Also see Note [Bangs on imported data constructors] in GHC.Types.Id.Make
 
 * The dcr_bangs field of the dcRep field records the [HsImplBang]
   If T was defined in this module, Without -O the dcr_bangs might be
diff --git a/compiler/GHC/Core/DataCon.hs-boot b/compiler/GHC/Core/DataCon.hs-boot
index 0d8957ea60..ab83a75117 100644
--- a/compiler/GHC/Core/DataCon.hs-boot
+++ b/compiler/GHC/Core/DataCon.hs-boot
@@ -1,13 +1,13 @@
 module GHC.Core.DataCon where
 
 import GhcPrelude
-import Var( TyVar, TyCoVar, TyVarBinder )
-import Name( Name, NamedThing )
+import GHC.Types.Var( TyVar, TyCoVar, TyVarBinder )
+import GHC.Types.Name( Name, NamedThing )
 import {-# SOURCE #-} GHC.Core.TyCon( TyCon )
-import FieldLabel ( FieldLabel )
-import Unique ( Uniquable )
+import GHC.Types.FieldLabel ( FieldLabel )
+import GHC.Types.Unique ( Uniquable )
 import Outputable ( Outputable, OutputableBndr )
-import BasicTypes (Arity)
+import GHC.Types.Basic (Arity)
 import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, ThetaType )
 
 data DataCon
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index 31c10045d6..67577bcd9b 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -62,14 +62,14 @@ module GHC.Core.FVs (
 import GhcPrelude
 
 import GHC.Core
-import Id
-import IdInfo
-import NameSet
-import UniqSet
-import Unique (Uniquable (..))
-import Name
-import VarSet
-import Var
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Name.Set
+import GHC.Types.Unique.Set
+import GHC.Types.Unique (Uniquable (..))
+import GHC.Types.Name
+import GHC.Types.Var.Set
+import GHC.Types.Var
 import GHC.Core.Type
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs
@@ -79,7 +79,7 @@ import GHC.Core.FamInstEnv
 import TysPrim( funTyConName )
 import Maybes( orElse )
 import Util
-import BasicTypes( Activation )
+import GHC.Types.Basic( Activation )
 import Outputable
 import FV
 
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs
index 1343544612..8ac78035bd 100644
--- a/compiler/GHC/Core/FamInstEnv.hs
+++ b/compiler/GHC/Core/FamInstEnv.hs
@@ -49,17 +49,17 @@ import GHC.Core.TyCo.Rep
 import GHC.Core.TyCon
 import GHC.Core.Coercion
 import GHC.Core.Coercion.Axiom
-import VarSet
-import VarEnv
-import Name
-import UniqDFM
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+import GHC.Types.Name
+import GHC.Types.Unique.DFM
 import Outputable
 import Maybes
 import GHC.Core.Map
-import Unique
+import GHC.Types.Unique
 import Util
-import Var
-import SrcLoc
+import GHC.Types.Var
+import GHC.Types.SrcLoc
 import FastString
 import Control.Monad
 import Data.List( mapAccumL )
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs
index 51c1db1b25..7fcea8433e 100644
--- a/compiler/GHC/Core/InstEnv.hs
+++ b/compiler/GHC/Core/InstEnv.hs
@@ -36,19 +36,19 @@ import GhcPrelude
 import TcType -- InstEnv is really part of the type checker,
               -- and depends on TcType in many ways
 import GHC.Core ( IsOrphan(..), isOrphan, chooseOrphanAnchor )
-import Module
+import GHC.Types.Module
 import GHC.Core.Class
-import Var
-import VarSet
-import Name
-import NameSet
+import GHC.Types.Var
+import GHC.Types.Var.Set
+import GHC.Types.Name
+import GHC.Types.Name.Set
 import GHC.Core.Unify
 import Outputable
 import ErrUtils
-import BasicTypes
-import UniqDFM
+import GHC.Types.Basic
+import GHC.Types.Unique.DFM
 import Util
-import Id
+import GHC.Types.Id
 import Data.Data        ( Data )
 import Data.Maybe       ( isJust, isNothing )
 
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 47a0a9cd2d..86c7ebdeea 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -31,22 +31,22 @@ import GHC.Core.Utils
 import GHC.Core.Stats ( coreBindsStats )
 import GHC.Core.Op.Monad
 import Bag
-import Literal
+import GHC.Types.Literal
 import GHC.Core.DataCon
 import TysWiredIn
 import TysPrim
 import TcType ( isFloatingTy )
-import Var
-import VarEnv
-import VarSet
-import UniqSet( nonDetEltsUniqSet )
-import Name
-import Id
-import IdInfo
+import GHC.Types.Var as Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Unique.Set( nonDetEltsUniqSet )
+import GHC.Types.Name
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core.Ppr
 import ErrUtils
 import GHC.Core.Coercion
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Core.Type as Type
 import GHC.Types.RepType
 import GHC.Core.TyCo.Rep   -- checks validity of types/coercions
@@ -55,7 +55,7 @@ import GHC.Core.TyCo.FVs
 import GHC.Core.TyCo.Ppr ( pprTyVar )
 import GHC.Core.TyCon as TyCon
 import GHC.Core.Coercion.Axiom
-import BasicTypes
+import GHC.Types.Basic
 import ErrUtils as Err
 import ListSetOps
 import PrelNames
@@ -65,7 +65,7 @@ import Util
 import GHC.Core.InstEnv      ( instanceDFunId )
 import GHC.Core.Coercion.Opt ( checkAxInstCo )
 import GHC.Core.Arity        ( typeArity )
-import Demand ( splitStrictSig, isBotDiv )
+import GHC.Types.Demand ( splitStrictSig, isBotDiv )
 
 import GHC.Driver.Types
 import GHC.Driver.Session
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index d1fe1b0aa1..b3622a7644 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -56,31 +56,31 @@ module GHC.Core.Make (
 
 import GhcPrelude
 
-import Id
-import Var      ( EvVar, setTyVarUnique )
+import GHC.Types.Id
+import GHC.Types.Var  ( EvVar, setTyVarUnique )
 
 import GHC.Core
 import GHC.Core.Utils ( exprType, needsCaseBinding, mkSingleAltCase, bindNonRec )
-import Literal
+import GHC.Types.Literal
 import GHC.Driver.Types
 import GHC.Platform
 
 import TysWiredIn
 import PrelNames
 
-import GHC.Hs.Utils     ( mkChunkified, chunkify )
+import GHC.Hs.Utils      ( mkChunkified, chunkify )
 import GHC.Core.Type
 import GHC.Core.Coercion ( isCoVar )
 import GHC.Core.DataCon  ( DataCon, dataConWorkId )
 import TysPrim
-import IdInfo
-import Demand
-import Cpr
-import Name      hiding ( varName )
+import GHC.Types.Id.Info
+import GHC.Types.Demand
+import GHC.Types.Cpr
+import GHC.Types.Name      hiding ( varName )
 import Outputable
 import FastString
-import UniqSupply
-import BasicTypes
+import GHC.Types.Unique.Supply
+import GHC.Types.Basic
 import Util
 import Data.List
 
@@ -101,7 +101,7 @@ sortQuantVars :: [Var] -> [Var]
 -- and then other Ids
 -- It is a deterministic sort, meaining it doesn't look at the values of
 -- Uniques. For explanation why it's important See Note [Unique Determinism]
--- in Unique.
+-- in GHC.Types.Unique.
 sortQuantVars vs = sorted_tcvs ++ ids
   where
     (tcvs, ids) = partition (isTyVar <||> isCoVar) vs
diff --git a/compiler/GHC/Core/Map.hs b/compiler/GHC/Core/Map.hs
index c3e765ff2b..bb4eeb0fff 100644
--- a/compiler/GHC/Core/Map.hs
+++ b/compiler/GHC/Core/Map.hs
@@ -42,17 +42,17 @@ import GhcPrelude
 import TrieMap
 import GHC.Core
 import GHC.Core.Coercion
-import Name
+import GHC.Types.Name
 import GHC.Core.Type
 import GHC.Core.TyCo.Rep
-import Var
+import GHC.Types.Var
 import FastString(FastString)
 import Util
 
 import qualified Data.Map    as Map
 import qualified Data.IntMap as IntMap
-import VarEnv
-import NameEnv
+import GHC.Types.Var.Env
+import GHC.Types.Name.Env
 import Outputable
 import Control.Monad( (>=>) )
 
diff --git a/compiler/GHC/Core/Op/CSE.hs b/compiler/GHC/Core/Op/CSE.hs
index dc93dacf07..790e9b97d3 100644
--- a/compiler/GHC/Core/Op/CSE.hs
+++ b/compiler/GHC/Core/Op/CSE.hs
@@ -16,9 +16,9 @@ module GHC.Core.Op.CSE (cseProgram, cseOneExpr) where
 import GhcPrelude
 
 import GHC.Core.Subst
-import Var              ( Var )
-import VarEnv           ( mkInScopeSet )
-import Id               ( Id, idType, idHasRules
+import GHC.Types.Var    ( Var )
+import GHC.Types.Var.Env ( mkInScopeSet )
+import GHC.Types.Id     ( Id, idType, idHasRules
                         , idInlineActivation, setInlineActivation
                         , zapIdOccInfo, zapIdUsageInfo, idInlinePragma
                         , isJoinId, isJoinId_maybe )
@@ -29,7 +29,7 @@ import GHC.Core.FVs     ( exprFreeVars )
 import GHC.Core.Type    ( tyConAppArgs )
 import GHC.Core
 import Outputable
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core.Map
 import Util             ( filterOut, equalLength, debugIsOn )
 import Data.List        ( mapAccumL )
diff --git a/compiler/GHC/Core/Op/CallArity.hs b/compiler/GHC/Core/Op/CallArity.hs
index aaf3372071..2ad5f169d8 100644
--- a/compiler/GHC/Core/Op/CallArity.hs
+++ b/compiler/GHC/Core/Op/CallArity.hs
@@ -9,17 +9,17 @@ module GHC.Core.Op.CallArity
 
 import GhcPrelude
 
-import VarSet
-import VarEnv
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import GHC.Driver.Session ( DynFlags )
 
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core
-import Id
+import GHC.Types.Id
 import GHC.Core.Arity ( typeArity )
 import GHC.Core.Utils ( exprIsCheap, exprIsTrivial )
 import UnVarGraph
-import Demand
+import GHC.Types.Demand
 import Util
 
 import Control.Arrow ( first, second )
diff --git a/compiler/GHC/Core/Op/ConstantFold.hs b/compiler/GHC/Core/Op/ConstantFold.hs
index 126666a509..9b897f8efd 100644
--- a/compiler/GHC/Core/Op/ConstantFold.hs
+++ b/compiler/GHC/Core/Op/ConstantFold.hs
@@ -28,12 +28,12 @@ where
 
 import GhcPrelude
 
-import {-# SOURCE #-} MkId ( mkPrimOpId, magicDictId )
+import {-# SOURCE #-} GHC.Types.Id.Make ( mkPrimOpId, magicDictId )
 
 import GHC.Core
 import GHC.Core.Make
-import Id
-import Literal
+import GHC.Types.Id
+import GHC.Types.Literal
 import GHC.Core.SimpleOpt ( exprIsLiteral_maybe )
 import PrimOp             ( PrimOp(..), tagToEnumKey )
 import TysWiredIn
@@ -47,13 +47,13 @@ import GHC.Core.Utils  ( cheapEqExpr, cheapEqExpr', exprIsHNF, exprType
                        , stripTicksTop, stripTicksTopT, mkTicks )
 import GHC.Core.Unfold ( exprIsConApp_maybe )
 import GHC.Core.Type
-import OccName     ( occNameFS )
+import GHC.Types.Name.Occurrence ( occNameFS )
 import PrelNames
 import Maybes      ( orElse )
-import Name        ( Name, nameOccName )
+import GHC.Types.Name ( Name, nameOccName )
 import Outputable
 import FastString
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Platform
 import Util
 import GHC.Core.Coercion   (mkUnbranchedAxInstCo,mkSymCo,Role(..))
@@ -2123,7 +2123,7 @@ tx_lit_con platform adjust (LitAlt l) = Just $ LitAlt (mapLitValue platform adju
 tx_lit_con _        _      alt        = pprPanic "caseRules" (ppr alt)
    -- NB: mapLitValue uses mkLitIntWrap etc, to ensure that the
    -- literal alternatives remain in Word/Int target ranges
-   -- (See Note [Word/Int underflow/overflow] in Literal and #13172).
+   -- (See Note [Word/Int underflow/overflow] in GHC.Types.Literal and #13172).
 
 adjustDyadicRight :: PrimOp -> Integer -> Maybe (Integer -> Integer)
 -- Given (x `op` lit) return a function 'f' s.t.  f (x `op` lit) = x
diff --git a/compiler/GHC/Core/Op/CprAnal.hs b/compiler/GHC/Core/Op/CprAnal.hs
index c8f7e314e9..8016c2c13d 100644
--- a/compiler/GHC/Core/Op/CprAnal.hs
+++ b/compiler/GHC/Core/Op/CprAnal.hs
@@ -15,17 +15,17 @@ import GhcPrelude
 
 import GHC.Core.Op.WorkWrap.Lib ( deepSplitProductType_maybe )
 import GHC.Driver.Session
-import Demand
-import Cpr
+import GHC.Types.Demand
+import GHC.Types.Cpr
 import GHC.Core
 import GHC.Core.Seq
 import Outputable
-import VarEnv
-import BasicTypes
+import GHC.Types.Var.Env
+import GHC.Types.Basic
 import Data.List
 import GHC.Core.DataCon
-import Id
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core.Utils   ( exprIsHNF, dumpIdInfoOfProgram )
 import GHC.Core.TyCon
 import GHC.Core.Type
diff --git a/compiler/GHC/Core/Op/DmdAnal.hs b/compiler/GHC/Core/Op/DmdAnal.hs
index eb9f277f8a..88e96773ac 100644
--- a/compiler/GHC/Core/Op/DmdAnal.hs
+++ b/compiler/GHC/Core/Op/DmdAnal.hs
@@ -17,16 +17,16 @@ import GhcPrelude
 
 import GHC.Driver.Session
 import GHC.Core.Op.WorkWrap.Lib ( findTypeShape )
-import Demand   -- All of it
+import GHC.Types.Demand   -- All of it
 import GHC.Core
 import GHC.Core.Seq     ( seqBinds )
 import Outputable
-import VarEnv
-import BasicTypes
+import GHC.Types.Var.Env
+import GHC.Types.Basic
 import Data.List        ( mapAccumL )
 import GHC.Core.DataCon
-import Id
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core.Utils
 import GHC.Core.TyCon
 import GHC.Core.Type
@@ -37,7 +37,7 @@ import Maybes           ( isJust )
 import TysWiredIn
 import TysPrim          ( realWorldStatePrimTy )
 import ErrUtils         ( dumpIfSet_dyn, DumpFormat (..) )
-import UniqSet
+import GHC.Types.Unique.Set
 
 {-
 ************************************************************************
@@ -136,7 +136,7 @@ dmdAnalStar env dmd e
   , (dmd_ty, e')    <- dmdAnal env cd e
   = ASSERT2( not (isUnliftedType (exprType e)) || exprOkForSpeculation e, ppr e )
     -- The argument 'e' should satisfy the let/app invariant
-    -- See Note [Analysing with absent demand] in Demand.hs
+    -- See Note [Analysing with absent demand] in GHC.Types.Demand
     (postProcessDmdType dmd_shell dmd_ty, e')
 
 -- Main Demand Analsysis machinery
@@ -389,7 +389,7 @@ Note [Demand on the scrutinee of a product case]
 When figuring out the demand on the scrutinee of a product case,
 we use the demands of the case alternative, i.e. id_dmds.
 But note that these include the demand on the case binder;
-see Note [Demand on case-alternative binders] in Demand.hs.
+see Note [Demand on case-alternative binders] in GHC.Types.Demand.
 This is crucial. Example:
    f x = case x of y { (a,b) -> k y a }
 If we just take scrut_demand = U(L,A), then we won't pass x to the
@@ -730,7 +730,7 @@ trivial RHS (see Note [Demand analysis for trivial right-hand sides]).
 Because idArity of a function varies independently of its cardinality properties
 (cf. Note [idArity varies independently of dmdTypeDepth]), we implicitly encode
 the arity for when a demand signature is sound to unleash in its 'dmdTypeDepth'
-(cf. Note [Understanding DmdType and StrictSig] in Demand). It is unsound to
+(cf. Note [Understanding DmdType and StrictSig] in GHC.Types.Demand). It is unsound to
 unleash a demand signature when the incoming number of arguments is less than
 that. See Note [What are demand signatures?] for more details on soundness.
 
@@ -777,7 +777,7 @@ reset or decrease arity. That's an unnecessary dependency, because
   * idArity is analysis information itself, thus volatile
   * We already *have* dmdTypeDepth, wo why not just use it to encode the
     threshold for when to unleash the signature
-    (cf. Note [Understanding DmdType and StrictSig] in Demand)
+    (cf. Note [Understanding DmdType and StrictSig] in GHC.Types.Demand)
 
 Consider the following expression, for example:
 
@@ -1167,7 +1167,7 @@ findBndrsDmds env dmd_ty bndrs
       | otherwise = go dmd_ty bs
 
 findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand)
--- See Note [Trimming a demand to a type] in Demand.hs
+-- See Note [Trimming a demand to a type] in GHC.Types.Demand
 findBndrDmd env arg_of_dfun dmd_ty id
   = (dmd_ty', dmd')
   where
diff --git a/compiler/GHC/Core/Op/Exitify.hs b/compiler/GHC/Core/Op/Exitify.hs
index 45f9451787..bc6bca21e9 100644
--- a/compiler/GHC/Core/Op/Exitify.hs
+++ b/compiler/GHC/Core/Op/Exitify.hs
@@ -36,15 +36,15 @@ Now `t` is no longer in a recursive function, and good things happen!
 -}
 
 import GhcPrelude
-import Var
-import Id
-import IdInfo
+import GHC.Types.Var
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core
 import GHC.Core.Utils
 import State
-import Unique
-import VarSet
-import VarEnv
+import GHC.Types.Unique
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import GHC.Core.FVs
 import FastString
 import GHC.Core.Type
diff --git a/compiler/GHC/Core/Op/FloatIn.hs b/compiler/GHC/Core/Op/FloatIn.hs
index 454ce39dfb..381dd0ddba 100644
--- a/compiler/GHC/Core/Op/FloatIn.hs
+++ b/compiler/GHC/Core/Op/FloatIn.hs
@@ -28,16 +28,16 @@ import GHC.Core.Make hiding ( wrapFloats )
 import GHC.Driver.Types     ( ModGuts(..) )
 import GHC.Core.Utils
 import GHC.Core.FVs
-import GHC.Core.Op.Monad        ( CoreM )
-import Id               ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
-import Var
+import GHC.Core.Op.Monad    ( CoreM )
+import GHC.Types.Id         ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
+import GHC.Types.Var
 import GHC.Core.Type
-import VarSet
+import GHC.Types.Var.Set
 import Util
 import GHC.Driver.Session
 import Outputable
 -- import Data.List        ( mapAccumL )
-import BasicTypes       ( RecFlag(..), isRec )
+import GHC.Types.Basic      ( RecFlag(..), isRec )
 
 {-
 Top-level interface function, @floatInwards@.  Note that we do not
diff --git a/compiler/GHC/Core/Op/FloatOut.hs b/compiler/GHC/Core/Op/FloatOut.hs
index fb47b2b3ed..f4a9649f98 100644
--- a/compiler/GHC/Core/Op/FloatOut.hs
+++ b/compiler/GHC/Core/Op/FloatOut.hs
@@ -19,11 +19,11 @@ import GHC.Core.Arity    ( etaExpand )
 import GHC.Core.Op.Monad ( FloatOutSwitches(..) )
 
 import GHC.Driver.Session
-import ErrUtils         ( dumpIfSet_dyn, DumpFormat (..) )
-import Id               ( Id, idArity, idType, isBottomingId,
-                          isJoinId, isJoinId_maybe )
+import ErrUtils          ( dumpIfSet_dyn, DumpFormat (..) )
+import GHC.Types.Id      ( Id, idArity, idType, isBottomingId,
+                           isJoinId, isJoinId_maybe )
 import GHC.Core.Op.SetLevels
-import UniqSupply       ( UniqSupply )
+import GHC.Types.Unique.Supply ( UniqSupply )
 import Bag
 import Util
 import Maybes
diff --git a/compiler/GHC/Core/Op/LiberateCase.hs b/compiler/GHC/Core/Op/LiberateCase.hs
index 399abf4c67..e753815736 100644
--- a/compiler/GHC/Core/Op/LiberateCase.hs
+++ b/compiler/GHC/Core/Op/LiberateCase.hs
@@ -15,8 +15,8 @@ import GHC.Driver.Session
 import GHC.Core
 import GHC.Core.Unfold  ( couldBeSmallEnoughToInline )
 import TysWiredIn       ( unitDataConId )
-import Id
-import VarEnv
+import GHC.Types.Id
+import GHC.Types.Var.Env
 import Util             ( notNull )
 
 {-
diff --git a/compiler/GHC/Core/Op/Monad.hs b/compiler/GHC/Core/Op/Monad.hs
index a0a15bba6f..a2c12d638f 100644
--- a/compiler/GHC/Core/Op/Monad.hs
+++ b/compiler/GHC/Core/Op/Monad.hs
@@ -52,21 +52,21 @@ import GhcPrelude hiding ( read )
 
 import GHC.Core
 import GHC.Driver.Types
-import Module
+import GHC.Types.Module
 import GHC.Driver.Session
-import BasicTypes       ( CompilerPhase(..) )
-import Annotations
+import GHC.Types.Basic  ( CompilerPhase(..) )
+import GHC.Types.Annotations
 
 import IOEnv hiding     ( liftIO, failM, failWithM )
 import qualified IOEnv  ( liftIO )
-import Var
+import GHC.Types.Var
 import Outputable
 import FastString
 import ErrUtils( Severity(..), DumpFormat (..), dumpOptionsFromFlag )
-import UniqSupply
+import GHC.Types.Unique.Supply
 import MonadUtils
-import NameEnv
-import SrcLoc
+import GHC.Types.Name.Env
+import GHC.Types.SrcLoc
 import Data.Bifunctor ( bimap )
 import ErrUtils (dumpAction)
 import Data.List (intersperse, groupBy, sortBy)
diff --git a/compiler/GHC/Core/Op/OccurAnal.hs b/compiler/GHC/Core/Op/OccurAnal.hs
index b676be38ae..ac1c665e1e 100644
--- a/compiler/GHC/Core/Op/OccurAnal.hs
+++ b/compiler/GHC/Core/Op/OccurAnal.hs
@@ -28,24 +28,24 @@ import GHC.Core.FVs
 import GHC.Core.Utils   ( exprIsTrivial, isDefaultAlt, isExpandableApp,
                           stripTicksTopE, mkTicks )
 import GHC.Core.Arity   ( joinRhsArity )
-import Id
-import IdInfo
-import Name( localiseName )
-import BasicTypes
-import Module( Module )
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Name( localiseName )
+import GHC.Types.Basic
+import GHC.Types.Module( Module )
 import GHC.Core.Coercion
 import GHC.Core.Type
 
-import VarSet
-import VarEnv
-import Var
-import Demand           ( argOneShots, argsOneShots )
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+import GHC.Types.Var
+import GHC.Types.Demand ( argOneShots, argsOneShots )
 import Digraph          ( SCC(..), Node(..)
                         , stronglyConnCompFromEdgedVerticesUniq
                         , stronglyConnCompFromEdgedVerticesUniqR )
-import Unique
-import UniqFM
-import UniqSet
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
 import Util
 import Outputable
 import Data.List
@@ -1870,7 +1870,7 @@ occAnalApp env (Var fun, args, ticks)
     n_args     = length args
     fun_uds    = mkOneOcc env fun (if n_val_args > 0 then IsInteresting else NotInteresting) n_args
     is_exp     = isExpandableApp fun n_val_args
-        -- See Note [CONLIKE pragma] in BasicTypes
+        -- See Note [CONLIKE pragma] in GHC.Types.Basic
         -- The definition of is_exp should match that in GHC.Core.Op.Simplify.prepareRhs
 
     one_shots  = argsOneShots (idStrictness fun) guaranteed_val_args
diff --git a/compiler/GHC/Core/Op/SetLevels.hs b/compiler/GHC/Core/Op/SetLevels.hs
index a3b1fd75b3..0ac49a0c1c 100644
--- a/compiler/GHC/Core/Op/SetLevels.hs
+++ b/compiler/GHC/Core/Op/SetLevels.hs
@@ -79,28 +79,28 @@ import GHC.Core.FVs     -- all of it
 import GHC.Core.Subst
 import GHC.Core.Make    ( sortQuantVars )
 
-import Id
-import IdInfo
-import Var
-import VarSet
-import UniqSet          ( nonDetFoldUniqSet )
-import UniqDSet         ( getUniqDSet )
-import VarEnv
-import Literal          ( litIsTrivial )
-import Demand           ( StrictSig, Demand, isStrictDmd, splitStrictSig, increaseStrictSigArity )
-import Cpr              ( mkCprSig, botCpr )
-import Name             ( getOccName, mkSystemVarName )
-import OccName          ( occNameString )
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Var
+import GHC.Types.Var.Set
+import GHC.Types.Unique.Set   ( nonDetFoldUniqSet )
+import GHC.Types.Unique.DSet  ( getUniqDSet )
+import GHC.Types.Var.Env
+import GHC.Types.Literal      ( litIsTrivial )
+import GHC.Types.Demand       ( StrictSig, Demand, isStrictDmd, splitStrictSig, increaseStrictSigArity )
+import GHC.Types.Cpr          ( mkCprSig, botCpr )
+import GHC.Types.Name         ( getOccName, mkSystemVarName )
+import GHC.Types.Name.Occurrence ( occNameString )
 import GHC.Core.Type    ( Type, mkLamTypes, splitTyConApp_maybe, tyCoVarsOfType
                         , mightBeUnliftedType, closeOverKindsDSet )
-import BasicTypes       ( Arity, RecFlag(..), isRec )
+import GHC.Types.Basic  ( Arity, RecFlag(..), isRec )
 import GHC.Core.DataCon ( dataConOrigResTy )
 import TysWiredIn
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Util
 import Outputable
 import FastString
-import UniqDFM
+import GHC.Types.Unique.DFM
 import FV
 import Data.Maybe
 import MonadUtils       ( mapAccumLM )
@@ -1352,7 +1352,7 @@ lvlLamBndrs env lvl bndrs
     is_major bndr = isId bndr && not (isProbablyOneShotLambda bndr)
        -- The "probably" part says "don't float things out of a
        -- probable one-shot lambda"
-       -- See Note [Computing one-shot info] in Demand.hs
+       -- See Note [Computing one-shot info] in GHC.Types.Demand
 
 lvlJoinBndrs :: LevelEnv -> Level -> RecFlag -> [OutVar]
              -> (LevelEnv, [LevelledBndr])
@@ -1619,7 +1619,7 @@ abstractVars :: Level -> LevelEnv -> DVarSet -> [OutVar]
         -- abstracted in deterministic order, not dependent on the values of
         -- Uniques. This is achieved by using DVarSets, deterministic free
         -- variable computation and deterministic sort.
-        -- See Note [Unique Determinism] in Unique for explanation of why
+        -- See Note [Unique Determinism] in GHC.Types.Unique for explanation of why
         -- Uniques are not deterministic.
 abstractVars dest_lvl (LE { le_subst = subst, le_lvl_env = lvl_env }) in_fvs
   =  -- NB: sortQuantVars might not put duplicates next to each other
@@ -1667,7 +1667,7 @@ newPolyBndrs dest_lvl
     add_subst env (v, v') = extendIdSubst env v (mkVarApps (Var v') abs_vars)
     add_id    env (v, v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)
 
-    mk_poly_bndr bndr uniq = transferPolyIdInfo bndr abs_vars $         -- Note [transferPolyIdInfo] in Id.hs
+    mk_poly_bndr bndr uniq = transferPolyIdInfo bndr abs_vars $ -- Note [transferPolyIdInfo] in GHC.Types.Id
                              transfer_join_info bndr $
                              mkSysLocal (mkFastString str) uniq poly_ty
                            where
diff --git a/compiler/GHC/Core/Op/Simplify.hs b/compiler/GHC/Core/Op/Simplify.hs
index 760beeddb2..5d7d91a37f 100644
--- a/compiler/GHC/Core/Op/Simplify.hs
+++ b/compiler/GHC/Core/Op/Simplify.hs
@@ -21,13 +21,13 @@ import GHC.Core.Op.Simplify.Env
 import GHC.Core.Op.Simplify.Utils
 import GHC.Core.Op.OccurAnal ( occurAnalyseExpr )
 import GHC.Core.FamInstEnv ( FamInstEnv )
-import Literal          ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326
-import Id
-import MkId             ( seqId )
-import GHC.Core.Make    ( FloatBind, mkImpossibleExpr, castBottomExpr )
+import GHC.Types.Literal   ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326
+import GHC.Types.Id
+import GHC.Types.Id.Make   ( seqId )
+import GHC.Core.Make       ( FloatBind, mkImpossibleExpr, castBottomExpr )
 import qualified GHC.Core.Make
-import IdInfo
-import Name             ( mkSystemVarName, isExternalName, getOccFS )
+import GHC.Types.Id.Info
+import GHC.Types.Name           ( mkSystemVarName, isExternalName, getOccFS )
 import GHC.Core.Coercion hiding ( substCo, substCoVar )
 import GHC.Core.Coercion.Opt    ( optCoercion )
 import GHC.Core.FamInstEnv      ( topNormaliseType_maybe )
@@ -37,27 +37,27 @@ import GHC.Core.DataCon
    , StrictnessMark (..) )
 import GHC.Core.Op.Monad ( Tick(..), SimplMode(..) )
 import GHC.Core
-import Demand           ( StrictSig(..), dmdTypeDepth, isStrictDmd
+import GHC.Types.Demand ( StrictSig(..), dmdTypeDepth, isStrictDmd
                         , mkClosedStrictSig, topDmd, botDiv )
-import Cpr              ( mkCprSig, botCpr )
+import GHC.Types.Cpr    ( mkCprSig, botCpr )
 import GHC.Core.Ppr     ( pprCoreExpr )
 import GHC.Core.Unfold
 import GHC.Core.Utils
 import GHC.Core.SimpleOpt ( pushCoTyArg, pushCoValArg
                           , joinPointBinding_maybe, joinPointBindings_maybe )
 import GHC.Core.Rules   ( mkRuleInfo, lookupRule, getRules )
-import BasicTypes       ( TopLevelFlag(..), isNotTopLevel, isTopLevel,
+import GHC.Types.Basic  ( TopLevelFlag(..), isNotTopLevel, isTopLevel,
                           RecFlag(..), Arity )
 import MonadUtils       ( mapAccumLM, liftIO )
-import Var              ( isTyCoVar )
+import GHC.Types.Var    ( isTyCoVar )
 import Maybes           ( orElse )
 import Control.Monad
 import Outputable
 import FastString
 import Util
 import ErrUtils
-import Module          ( moduleName, pprModuleName )
-import PrimOp          ( PrimOp (SeqOp) )
+import GHC.Types.Module ( moduleName, pprModuleName )
+import PrimOp           ( PrimOp (SeqOp) )
 
 
 {-
@@ -474,7 +474,7 @@ prepareRhs mode top_lvl occ _ rhs0
         = return (is_exp, emptyLetFloats, Var fun)
         where
           is_exp = isExpandableApp fun n_val_args   -- The fun a constructor or PAP
-                        -- See Note [CONLIKE pragma] in BasicTypes
+                        -- See Note [CONLIKE pragma] in GHC.Types.Basic
                         -- The definition of is_exp should match that in
                         -- OccurAnal.occAnalApp
 
@@ -2139,7 +2139,7 @@ If you find a match, rewrite it, and apply to 'rhs'.
 Notice that we can simply drop casts on the fly here, which
 makes it more likely that a rule will match.
 
-See Note [User-defined RULES for seq] in MkId.
+See Note [User-defined RULES for seq] in GHC.Types.Id.Make.
 
 Note [Occurrence-analyse after rule firing]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2533,7 +2533,7 @@ rebuildCase env scrut case_bndr alts@[(_, bndrs, rhs)] cont
   -- 2c. Try the seq rules if
   --     a) it binds only the case binder
   --     b) a rule for seq applies
-  -- See Note [User-defined RULES for seq] in MkId
+  -- See Note [User-defined RULES for seq] in GHC.Types.Id.Make
   | is_plain_seq
   = do { mb_rule <- trySeqRules env scrut rhs cont
        ; case mb_rule of
@@ -2757,7 +2757,7 @@ a case pattern.  This is *important*.  Consider
 
 We really must record that b is already evaluated so that we don't
 go and re-evaluate it when constructing the result.
-See Note [Data-con worker strictness] in MkId.hs
+See Note [Data-con worker strictness] in GHC.Types.Id.Make
 
 NB: simplLamBndrs preserves this eval info
 
diff --git a/compiler/GHC/Core/Op/Simplify/Driver.hs b/compiler/GHC/Core/Op/Simplify/Driver.hs
index b6ec392599..1b7bb0d1e3 100644
--- a/compiler/GHC/Core/Op/Simplify/Driver.hs
+++ b/compiler/GHC/Core/Op/Simplify/Driver.hs
@@ -21,7 +21,7 @@ import GHC.Core.Rules   ( mkRuleBase, unionRuleBase,
                           getRules )
 import GHC.Core.Ppr     ( pprCoreBindings, pprCoreExpr )
 import GHC.Core.Op.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
-import IdInfo
+import GHC.Types.Id.Info
 import GHC.Core.Stats   ( coreBindsSize, coreBindsStats, exprSize )
 import GHC.Core.Utils   ( mkTicks, stripTicksTop )
 import GHC.Core.Lint    ( endPass, lintPassResult, dumpPassResult,
@@ -35,11 +35,11 @@ import qualified ErrUtils as Err
 import GHC.Core.Op.FloatIn  ( floatInwards )
 import GHC.Core.Op.FloatOut ( floatOutwards )
 import GHC.Core.FamInstEnv
-import Id
+import GHC.Types.Id
 import ErrUtils         ( withTiming, withTimingD, DumpFormat (..) )
-import BasicTypes       ( CompilerPhase(..), isDefaultInlinePragma, defaultInlinePragma )
-import VarSet
-import VarEnv
+import GHC.Types.Basic  ( CompilerPhase(..), isDefaultInlinePragma, defaultInlinePragma )
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import GHC.Core.Op.LiberateCase ( liberateCase )
 import GHC.Core.Op.StaticArgs   ( doStaticArgs )
 import GHC.Core.Op.Specialise   ( specProgram)
@@ -49,14 +49,14 @@ import GHC.Core.Op.CprAnal      ( cprAnalProgram )
 import GHC.Core.Op.CallArity    ( callArityAnalProgram )
 import GHC.Core.Op.Exitify      ( exitifyProgram )
 import GHC.Core.Op.WorkWrap     ( wwTopBinds )
-import SrcLoc
+import GHC.Types.SrcLoc
 import Util
-import Module
+import GHC.Types.Module
 import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
 import GHC.Runtime.Loader -- ( initializePlugins )
 
-import UniqSupply       ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
-import UniqFM
+import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
+import GHC.Types.Unique.FM
 import Outputable
 import Control.Monad
 import qualified GHC.LanguageExtensions as LangExt
diff --git a/compiler/GHC/Core/Op/Simplify/Env.hs b/compiler/GHC/Core/Op/Simplify/Env.hs
index 0e94f734af..47b95da59e 100644
--- a/compiler/GHC/Core/Op/Simplify/Env.hs
+++ b/compiler/GHC/Core/Op/Simplify/Env.hs
@@ -51,11 +51,11 @@ import GHC.Core.Op.Simplify.Monad
 import GHC.Core.Op.Monad        ( SimplMode(..) )
 import GHC.Core
 import GHC.Core.Utils
-import Var
-import VarEnv
-import VarSet
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
 import OrdList
-import Id
+import GHC.Types.Id as Id
 import GHC.Core.Make            ( mkWildValBinder )
 import GHC.Driver.Session       ( DynFlags )
 import TysWiredIn
@@ -63,11 +63,11 @@ import qualified GHC.Core.Type as Type
 import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst )
 import qualified GHC.Core.Coercion as Coercion
 import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
-import BasicTypes
+import GHC.Types.Basic
 import MonadUtils
 import Outputable
 import Util
-import UniqFM                   ( pprUniqFM )
+import GHC.Types.Unique.FM      ( pprUniqFM )
 
 import Data.List (mapAccumL)
 
diff --git a/compiler/GHC/Core/Op/Simplify/Monad.hs b/compiler/GHC/Core/Op/Simplify/Monad.hs
index e6b23734c4..d45dd13510 100644
--- a/compiler/GHC/Core/Op/Simplify/Monad.hs
+++ b/compiler/GHC/Core/Op/Simplify/Monad.hs
@@ -22,14 +22,14 @@ module GHC.Core.Op.Simplify.Monad (
 
 import GhcPrelude
 
-import Var              ( Var, isId, mkLocalVar )
-import Name             ( mkSystemVarName )
-import Id               ( Id, mkSysLocalOrCoVar )
-import IdInfo           ( IdDetails(..), vanillaIdInfo, setArityInfo )
+import GHC.Types.Var       ( Var, isId, mkLocalVar )
+import GHC.Types.Name      ( mkSystemVarName )
+import GHC.Types.Id        ( Id, mkSysLocalOrCoVar )
+import GHC.Types.Id.Info   ( IdDetails(..), vanillaIdInfo, setArityInfo )
 import GHC.Core.Type       ( Type, mkLamTypes )
 import GHC.Core.FamInstEnv ( FamInstEnv )
 import GHC.Core            ( RuleEnv(..) )
-import UniqSupply
+import GHC.Types.Unique.Supply
 import GHC.Driver.Session
 import GHC.Core.Op.Monad
 import Outputable
@@ -38,7 +38,7 @@ import MonadUtils
 import ErrUtils as Err
 import Util                ( count )
 import Panic               (throwGhcExceptionIO, GhcException (..))
-import BasicTypes          ( IntWithInf, treatZeroAsInf, mkIntWithInf )
+import GHC.Types.Basic     ( IntWithInf, treatZeroAsInf, mkIntWithInf )
 import Control.Monad       ( ap )
 
 {-
diff --git a/compiler/GHC/Core/Op/Simplify/Utils.hs b/compiler/GHC/Core/Op/Simplify/Utils.hs
index 5fb9ddcee4..4b85bff280 100644
--- a/compiler/GHC/Core/Op/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Op/Simplify/Utils.hs
@@ -51,17 +51,17 @@ import GHC.Core.FVs
 import GHC.Core.Utils
 import GHC.Core.Arity
 import GHC.Core.Unfold
-import Name
-import Id
-import IdInfo
-import Var
-import Demand
+import GHC.Types.Name
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Var
+import GHC.Types.Demand
 import GHC.Core.Op.Simplify.Monad
 import GHC.Core.Type     hiding( substTy )
 import GHC.Core.Coercion hiding( substCo )
 import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon )
-import VarSet
-import BasicTypes
+import GHC.Types.Var.Set
+import GHC.Types.Basic
 import Util
 import OrdList          ( isNilOL )
 import MonadUtils
@@ -1801,9 +1801,9 @@ abstractFloats dflags top_lvl main_tvs floats body
     mk_poly1 :: [TyVar] -> Id -> SimplM (Id, CoreExpr)
     mk_poly1 tvs_here var
       = do { uniq <- getUniqueM
-           ; let  poly_name = setNameUnique (idName var) uniq           -- Keep same name
+           ; let  poly_name = setNameUnique (idName var) uniq      -- Keep same name
                   poly_ty   = mkInvForAllTys tvs_here (idType var) -- But new type of course
-                  poly_id   = transferPolyIdInfo var tvs_here $ -- Note [transferPolyIdInfo] in Id.hs
+                  poly_id   = transferPolyIdInfo var tvs_here $ -- Note [transferPolyIdInfo] in GHC.Types.Id
                               mkLocalId poly_name poly_ty
            ; return (poly_id, mkTyApps (Var poly_id) (mkTyVarTys tvs_here)) }
                 -- In the olden days, it was crucial to copy the occInfo of the original var,
diff --git a/compiler/GHC/Core/Op/SpecConstr.hs b/compiler/GHC/Core/Op/SpecConstr.hs
index 4522e2d23c..0a72edce8d 100644
--- a/compiler/GHC/Core/Op/SpecConstr.hs
+++ b/compiler/GHC/Core/Op/SpecConstr.hs
@@ -29,7 +29,7 @@ import GHC.Core.Utils
 import GHC.Core.Unfold  ( couldBeSmallEnoughToInline )
 import GHC.Core.FVs     ( exprsFreeVarsList )
 import GHC.Core.Op.Monad
-import Literal          ( litIsLifted )
+import GHC.Types.Literal ( litIsLifted )
 import GHC.Driver.Types ( ModGuts(..) )
 import GHC.Core.Op.WorkWrap.Lib ( isWorkerSmallEnough, mkWorkerArgs )
 import GHC.Core.DataCon
@@ -37,30 +37,30 @@ import GHC.Core.Coercion hiding( substCo )
 import GHC.Core.Rules
 import GHC.Core.Type     hiding ( substTy )
 import GHC.Core.TyCon   ( tyConName )
-import Id
+import GHC.Types.Id
 import GHC.Core.Ppr     ( pprParendExpr )
 import GHC.Core.Make    ( mkImpossibleExpr )
-import VarEnv
-import VarSet
-import Name
-import BasicTypes
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Name
+import GHC.Types.Basic
 import GHC.Driver.Session ( DynFlags(..), GeneralFlag( Opt_SpecConstrKeen )
                           , gopt, hasPprDebug )
 import Maybes           ( orElse, catMaybes, isJust, isNothing )
-import Demand
-import Cpr
+import GHC.Types.Demand
+import GHC.Types.Cpr
 import GHC.Serialized   ( deserializeWithData )
 import Util
 import Pair
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Outputable
 import FastString
-import UniqFM
+import GHC.Types.Unique.FM
 import MonadUtils
 import Control.Monad    ( zipWithM )
 import Data.List
 import PrelNames        ( specTyConName )
-import Module
+import GHC.Types.Module
 import GHC.Core.TyCon ( TyCon )
 import GHC.Exts( SpecConstrAnnotation(..) )
 import Data.Ord( comparing )
@@ -2084,7 +2084,7 @@ callToPats env bndr_occs call@(Call _ args con_env)
                 -- lambdas with different argument orders. See
                 -- determinism/simplCore/should_compile/spec-inline-determ.hs
                 -- for an example. For explanation of determinism
-                -- considerations See Note [Unique Determinism] in Unique.
+                -- considerations See Note [Unique Determinism] in GHC.Types.Unique.
 
               in_scope_vars = getInScopeVars in_scope
               is_in_scope v = v `elemVarSet` in_scope_vars
diff --git a/compiler/GHC/Core/Op/Specialise.hs b/compiler/GHC/Core/Op/Specialise.hs
index 250a0f7313..b43bc90ef1 100644
--- a/compiler/GHC/Core/Op/Specialise.hs
+++ b/compiler/GHC/Core/Op/Specialise.hs
@@ -15,30 +15,30 @@ module GHC.Core.Op.Specialise ( specProgram, specUnfolding ) where
 
 import GhcPrelude
 
-import Id
+import GHC.Types.Id
 import TcType hiding( substTy )
 import GHC.Core.Type  hiding( substTy, extendTvSubstList )
 import GHC.Core.Predicate
-import Module( Module, HasModule(..) )
+import GHC.Types.Module( Module, HasModule(..) )
 import GHC.Core.Coercion( Coercion )
 import GHC.Core.Op.Monad
 import qualified GHC.Core.Subst
 import GHC.Core.Unfold
-import Var              ( isLocalVar )
-import VarSet
-import VarEnv
+import GHC.Types.Var      ( isLocalVar )
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import GHC.Core
 import GHC.Core.Rules
 import GHC.Core.SimpleOpt ( collectBindersPushingCo )
 import GHC.Core.Utils     ( exprIsTrivial, mkCast, exprType )
 import GHC.Core.FVs
 import GHC.Core.Arity     ( etaExpandToJoinPointRule )
-import UniqSupply
-import Name
-import MkId             ( voidArgId, voidPrimId )
+import GHC.Types.Unique.Supply
+import GHC.Types.Name
+import GHC.Types.Id.Make  ( voidArgId, voidPrimId )
 import Maybes           ( mapMaybe, isJust )
 import MonadUtils       ( foldlM )
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Driver.Types
 import Bag
 import GHC.Driver.Session
@@ -46,7 +46,7 @@ import Util
 import Outputable
 import FastString
 import State
-import UniqDFM
+import GHC.Types.Unique.DFM
 import GHC.Core.TyCo.Rep (TyCoBinder (..))
 
 import Control.Monad
@@ -2129,7 +2129,7 @@ emptyUDs = MkUD { ud_binds = emptyBag, ud_calls = emptyDVarEnv }
 type CallDetails  = DIdEnv CallInfoSet
   -- The order of specialized binds and rules depends on how we linearize
   -- CallDetails, so to get determinism we must use a deterministic set here.
-  -- See Note [Deterministic UniqFM] in UniqDFM
+  -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM
 
 data CallInfoSet = CIS Id (Bag CallInfo)
   -- The list of types and dictionaries is guaranteed to
diff --git a/compiler/GHC/Core/Op/StaticArgs.hs b/compiler/GHC/Core/Op/StaticArgs.hs
index e550fabfd9..835f1ffbaa 100644
--- a/compiler/GHC/Core/Op/StaticArgs.hs
+++ b/compiler/GHC/Core/Op/StaticArgs.hs
@@ -53,20 +53,20 @@ module GHC.Core.Op.StaticArgs ( doStaticArgs ) where
 
 import GhcPrelude
 
-import Var
+import GHC.Types.Var
 import GHC.Core
 import GHC.Core.Utils
 import GHC.Core.Type
 import GHC.Core.Coercion
-import Id
-import Name
-import VarEnv
-import UniqSupply
+import GHC.Types.Id
+import GHC.Types.Name
+import GHC.Types.Var.Env
+import GHC.Types.Unique.Supply
 import Util
-import UniqFM
-import VarSet
-import Unique
-import UniqSet
+import GHC.Types.Unique.FM
+import GHC.Types.Var.Set
+import GHC.Types.Unique
+import GHC.Types.Unique.Set
 import Outputable
 
 import Data.List (mapAccumL)
diff --git a/compiler/GHC/Core/Op/Tidy.hs b/compiler/GHC/Core/Op/Tidy.hs
index 758c1daf6c..4759efa0e9 100644
--- a/compiler/GHC/Core/Op/Tidy.hs
+++ b/compiler/GHC/Core/Op/Tidy.hs
@@ -19,16 +19,16 @@ import GhcPrelude
 
 import GHC.Core
 import GHC.Core.Seq ( seqUnfolding )
-import Id
-import IdInfo
-import Demand ( zapUsageEnvSig )
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Demand ( zapUsageEnvSig )
 import GHC.Core.Type     ( tidyType, tidyVarBndr )
 import GHC.Core.Coercion ( tidyCo )
-import Var
-import VarEnv
-import UniqFM
-import Name hiding (tidyNameOcc)
-import SrcLoc
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Unique.FM
+import GHC.Types.Name hiding (tidyNameOcc)
+import GHC.Types.SrcLoc
 import Maybes
 import Data.List
 
@@ -277,7 +277,7 @@ We keep the OneShotInfo because we want it to propagate into the interface.
 Not all OneShotInfo is determined by a compiler analysis; some is added by a
 call of GHC.Exts.oneShot, which is then discarded before the end of the
 optimisation pipeline, leaving only the OneShotInfo on the lambda. Hence we
-must preserve this info in inlinings. See Note [The oneShot function] in MkId.
+must preserve this info in inlinings. See Note [The oneShot function] in GHC.Types.Id.Make.
 
 This applies to lambda binders only, hence it is stored in IfaceLamBndr.
 -}
diff --git a/compiler/GHC/Core/Op/WorkWrap.hs b/compiler/GHC/Core/Op/WorkWrap.hs
index 241a295899..6abfb4733c 100644
--- a/compiler/GHC/Core/Op/WorkWrap.hs
+++ b/compiler/GHC/Core/Op/WorkWrap.hs
@@ -14,15 +14,15 @@ import GHC.Core
 import GHC.Core.Unfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding )
 import GHC.Core.Utils  ( exprType, exprIsHNF )
 import GHC.Core.FVs    ( exprFreeVars )
-import Var
-import Id
-import IdInfo
+import GHC.Types.Var
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core.Type
-import UniqSupply
-import BasicTypes
+import GHC.Types.Unique.Supply
+import GHC.Types.Basic
 import GHC.Driver.Session
-import Demand
-import Cpr
+import GHC.Types.Demand
+import GHC.Types.Cpr
 import GHC.Core.Op.WorkWrap.Lib
 import Util
 import Outputable
diff --git a/compiler/GHC/Core/Op/WorkWrap/Lib.hs b/compiler/GHC/Core/Op/WorkWrap/Lib.hs
index 3ce454e7a2..6245bb9099 100644
--- a/compiler/GHC/Core/Op/WorkWrap/Lib.hs
+++ b/compiler/GHC/Core/Op/WorkWrap/Lib.hs
@@ -19,28 +19,28 @@ import GhcPrelude
 
 import GHC.Core
 import GHC.Core.Utils   ( exprType, mkCast, mkDefaultCase, mkSingleAltCase )
-import Id
-import IdInfo           ( JoinArity )
+import GHC.Types.Id
+import GHC.Types.Id.Info ( JoinArity )
 import GHC.Core.DataCon
-import Demand
-import Cpr
+import GHC.Types.Demand
+import GHC.Types.Cpr
 import GHC.Core.Make    ( mkAbsentErrorApp, mkCoreUbxTup
                         , mkCoreApp, mkCoreLet )
-import MkId             ( voidArgId, voidPrimId )
+import GHC.Types.Id.Make ( voidArgId, voidPrimId )
 import TysWiredIn       ( tupleDataCon )
 import TysPrim          ( voidPrimTy )
-import Literal          ( absentLiteralOf, rubbishLit )
-import VarEnv           ( mkInScopeSet )
-import VarSet           ( VarSet )
+import GHC.Types.Literal ( absentLiteralOf, rubbishLit )
+import GHC.Types.Var.Env ( mkInScopeSet )
+import GHC.Types.Var.Set ( VarSet )
 import GHC.Core.Type
 import GHC.Core.Predicate ( isClassPred )
 import GHC.Types.RepType  ( isVoidTy, typePrimRep )
 import GHC.Core.Coercion
 import GHC.Core.FamInstEnv
-import BasicTypes       ( Boxity(..) )
+import GHC.Types.Basic       ( Boxity(..) )
 import GHC.Core.TyCon
-import UniqSupply
-import Unique
+import GHC.Types.Unique.Supply
+import GHC.Types.Unique
 import Maybes
 import Util
 import Outputable
@@ -957,8 +957,8 @@ deepSplitCprType_maybe _ _ _ = Nothing
 
 findTypeShape :: FamInstEnvs -> Type -> TypeShape
 -- Uncover the arrow and product shape of a type
--- The data type TypeShape is defined in Demand
--- See Note [Trimming a demand to a type] in Demand
+-- The data type TypeShape is defined in GHC.Types.Demand
+-- See Note [Trimming a demand to a type] in GHC.Types.Demand
 findTypeShape fam_envs ty
   | Just (tc, tc_args)  <- splitTyConApp_maybe ty
   , Just con <- isDataProductTyCon_maybe tc
@@ -1197,7 +1197,7 @@ mk_absent_let dflags fam_envs arg
               -- determinism, because with different uniques the strings
               -- will have different lengths and hence different costs for
               -- the inliner leading to different inlining.
-              -- See also Note [Unique Determinism] in Unique
+              -- See also Note [Unique Determinism] in GHC.Types.Unique
     unlifted_rhs = mkTyApps (Lit rubbishLit) [arg_ty]
 
 mk_ww_local :: Unique -> (Type, StrictnessMark) -> Id
diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs
index 7f84e92e3f..cf2aaf1ad0 100644
--- a/compiler/GHC/Core/PatSyn.hs
+++ b/compiler/GHC/Core/PatSyn.hs
@@ -28,13 +28,13 @@ import GhcPrelude
 
 import GHC.Core.Type
 import GHC.Core.TyCo.Ppr
-import Name
+import GHC.Types.Name
 import Outputable
-import Unique
+import GHC.Types.Unique
 import Util
-import BasicTypes
-import Var
-import FieldLabel
+import GHC.Types.Basic
+import GHC.Types.Var
+import GHC.Types.FieldLabel
 
 import qualified Data.Data as Data
 import Data.Function
diff --git a/compiler/GHC/Core/PatSyn.hs-boot b/compiler/GHC/Core/PatSyn.hs-boot
index 8ce7621450..d4f816d13d 100644
--- a/compiler/GHC/Core/PatSyn.hs-boot
+++ b/compiler/GHC/Core/PatSyn.hs-boot
@@ -1,9 +1,9 @@
 module GHC.Core.PatSyn where
 
-import BasicTypes (Arity)
+import GHC.Types.Basic (Arity)
 import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type)
-import Var (TyVar)
-import Name (Name)
+import GHC.Types.Var (TyVar)
+import GHC.Types.Name (Name)
 
 data PatSyn
 
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index 0ab98c3208..df12815e6c 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -21,23 +21,23 @@ import GhcPrelude
 
 import GHC.Core
 import GHC.Core.Stats (exprStats)
-import Literal( pprLiteral )
-import Name( pprInfixName, pprPrefixName )
-import Var
-import Id
-import IdInfo
-import Demand
-import Cpr
+import GHC.Types.Literal( pprLiteral )
+import GHC.Types.Name( pprInfixName, pprPrefixName )
+import GHC.Types.Var
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Demand
+import GHC.Types.Cpr
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Ppr
 import GHC.Core.Coercion
-import BasicTypes
+import GHC.Types.Basic
 import Maybes
 import Util
 import Outputable
 import FastString
-import SrcLoc      ( pprUserRealSpan )
+import GHC.Types.SrcLoc ( pprUserRealSpan )
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Core/Ppr/TyThing.hs b/compiler/GHC/Core/Ppr/TyThing.hs
index bf3450c447..6782ba1518 100644
--- a/compiler/GHC/Core/Ppr/TyThing.hs
+++ b/compiler/GHC/Core/Ppr/TyThing.hs
@@ -29,8 +29,8 @@ import GHC.Driver.Types( tyThingParent_maybe )
 import GHC.Iface.Make ( tyThingToIfaceDecl )
 import GHC.Core.FamInstEnv( FamInst(..), FamFlavor(..) )
 import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp, pprSigmaType )
-import Name
-import VarEnv( emptyTidyEnv )
+import GHC.Types.Name
+import GHC.Types.Var.Env( emptyTidyEnv )
 import Outputable
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs
index e84333283d..b57278fba2 100644
--- a/compiler/GHC/Core/Predicate.hs
+++ b/compiler/GHC/Core/Predicate.hs
@@ -33,7 +33,7 @@ import GhcPrelude
 import GHC.Core.Type
 import GHC.Core.Class
 import GHC.Core.TyCon
-import Var
+import GHC.Types.Var
 import GHC.Core.Coercion
 
 import PrelNames
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 30b652655d..0b1c0cccb9 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -31,7 +31,7 @@ module GHC.Core.Rules (
 import GhcPrelude
 
 import GHC.Core         -- All of it
-import Module           ( Module, ModuleSet, elemModuleSet )
+import GHC.Types.Module   ( Module, ModuleSet, elemModuleSet )
 import GHC.Core.Subst
 import GHC.Core.SimpleOpt ( exprIsLambda_maybe )
 import GHC.Core.FVs     ( exprFreeVars, exprsFreeVars, bindFreeVars
@@ -47,18 +47,19 @@ import TcType           ( tcSplitTyConApp_maybe )
 import TysWiredIn       ( anyTypeOfKind )
 import GHC.Core.Coercion as Coercion
 import GHC.Core.Op.Tidy ( tidyRules )
-import Id
-import IdInfo           ( RuleInfo( RuleInfo ) )
-import Var
-import VarEnv
-import VarSet
-import Name             ( Name, NamedThing(..), nameIsLocalOrFrom )
-import NameSet
-import NameEnv
-import UniqFM
+import GHC.Types.Id
+import GHC.Types.Id.Info ( RuleInfo( RuleInfo ) )
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Name    ( Name, NamedThing(..), nameIsLocalOrFrom )
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env
+import GHC.Types.Unique.FM
 import GHC.Core.Unify as Unify ( ruleMatchTyKiX )
-import BasicTypes
-import GHC.Driver.Session hiding (ruleCheck)
+import GHC.Types.Basic
+import GHC.Driver.Session      ( DynFlags, gopt, targetPlatform )
+import GHC.Driver.Flags
 import Outputable
 import FastString
 import Maybes
diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs
index 13a0841503..451a6fa4e3 100644
--- a/compiler/GHC/Core/Seq.hs
+++ b/compiler/GHC/Core/Seq.hs
@@ -13,15 +13,15 @@ module GHC.Core.Seq (
 import GhcPrelude
 
 import GHC.Core
-import IdInfo
-import Demand( seqDemand, seqStrictSig )
-import Cpr( seqCprSig )
-import BasicTypes( seqOccInfo )
-import VarSet( seqDVarSet )
-import Var( varType, tyVarKind )
+import GHC.Types.Id.Info
+import GHC.Types.Demand( seqDemand, seqStrictSig )
+import GHC.Types.Cpr( seqCprSig )
+import GHC.Types.Basic( seqOccInfo )
+import GHC.Types.Var.Set( seqDVarSet )
+import GHC.Types.Var( varType, tyVarKind )
 import GHC.Core.Type( seqType, isTyVar )
 import GHC.Core.Coercion( seqCo )
-import Id( Id, idInfo )
+import GHC.Types.Id( Id, idInfo )
 
 -- | Evaluate all the fields of the 'IdInfo' that are generally demanded by the
 -- compiler
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 3510fcc3ae..eebac97ade 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -32,14 +32,14 @@ import {-# SOURCE #-} GHC.Core.Unfold( mkUnfolding )
 import GHC.Core.Make ( FloatBind(..) )
 import GHC.Core.Ppr  ( pprCoreBindings, pprRules )
 import GHC.Core.Op.OccurAnal( occurAnalyseExpr, occurAnalysePgm )
-import Literal  ( Literal(LitString) )
-import Id
-import IdInfo   ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
-import Var      ( isNonCoVarId )
-import VarSet
-import VarEnv
+import GHC.Types.Literal  ( Literal(LitString) )
+import GHC.Types.Id
+import GHC.Types.Id.Info  ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
+import GHC.Types.Var      ( isNonCoVarId )
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import GHC.Core.DataCon
-import Demand( etaExpandStrictSig )
+import GHC.Types.Demand( etaExpandStrictSig )
 import GHC.Core.Coercion.Opt ( optCoercion )
 import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
                             , isInScope, substTyVarBndr, cloneTyVarBndr )
@@ -47,8 +47,8 @@ import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
 import GHC.Core.TyCon ( tyConArity )
 import TysWiredIn
 import PrelNames
-import BasicTypes
-import Module       ( Module )
+import GHC.Types.Basic
+import GHC.Types.Module ( Module )
 import ErrUtils
 import GHC.Driver.Session
 import Outputable
@@ -673,7 +673,7 @@ unfolding. Also see Note [Desugaring coerce as cast] in GHC.HsToCore.
 
 However, we don't want to inline 'seq', which happens to also have a
 compulsory unfolding, so we only do this unfolding only for things
-that are always-active.  See Note [User-defined RULES for seq] in MkId.
+that are always-active.  See Note [User-defined RULES for seq] in GHC.Types.Id.Make.
 
 Note [Getting the map/coerce RULE to work]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -965,7 +965,7 @@ data ConCont = CC [CoreExpr] Coercion
 -- [exprIsConApp_maybe on data constructors with wrappers]. Data constructor wrappers
 -- are unfolded late, but we really want to trigger case-of-known-constructor as
 -- early as possible. See also Note [Activation for data constructor wrappers]
--- in MkId.
+-- in GHC.Types.Id.Make.
 --
 -- We also return the incoming InScopeSet, augmented with
 -- the binders from any [FloatBind] that we return
diff --git a/compiler/GHC/Core/Stats.hs b/compiler/GHC/Core/Stats.hs
index 148255e140..29f2f44df4 100644
--- a/compiler/GHC/Core/Stats.hs
+++ b/compiler/GHC/Core/Stats.hs
@@ -13,13 +13,13 @@ module GHC.Core.Stats (
 
 import GhcPrelude
 
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core
 import Outputable
 import GHC.Core.Coercion
-import Var
+import GHC.Types.Var
 import GHC.Core.Type(Type, typeSize)
-import Id (isJoinId)
+import GHC.Types.Id (isJoinId)
 
 data CoreStats = CS { cs_tm :: !Int    -- Terms
                     , cs_ty :: !Int    -- Types
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 672786aaa6..e36e4fb289 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -53,13 +53,13 @@ import GHC.Core.Type hiding
 import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
 
 import PrelNames
-import VarSet
-import VarEnv
-import Id
-import Name     ( Name )
-import Var
-import IdInfo
-import UniqSupply
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+import GHC.Types.Id
+import GHC.Types.Name     ( Name )
+import GHC.Types.Var
+import GHC.Types.Id.Info
+import GHC.Types.Unique.Supply
 import Maybes
 import Util
 import Outputable
diff --git a/compiler/GHC/Core/TyCo/FVs.hs b/compiler/GHC/Core/TyCo/FVs.hs
index 82d7699ed3..30d16c1faf 100644
--- a/compiler/GHC/Core/TyCo/FVs.hs
+++ b/compiler/GHC/Core/TyCo/FVs.hs
@@ -50,12 +50,12 @@ import {-# SOURCE #-} GHC.Core.Type (coreView, partitionInvisibleTypes)
 import Data.Monoid as DM ( Endo(..), All(..) )
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCon
-import Var
+import GHC.Types.Var
 import FV
 
-import UniqFM
-import VarSet
-import VarEnv
+import GHC.Types.Unique.FM
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 import Util
 import Panic
 
diff --git a/compiler/GHC/Core/TyCo/Ppr.hs b/compiler/GHC/Core/TyCo/Ppr.hs
index 3d4c065aba..bc4e9b48e5 100644
--- a/compiler/GHC/Core/TyCo/Ppr.hs
+++ b/compiler/GHC/Core/TyCo/Ppr.hs
@@ -43,16 +43,16 @@ import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Tidy
 import GHC.Core.TyCo.FVs
 import GHC.Core.Class
-import Var
+import GHC.Types.Var
 
 import GHC.Iface.Type
 
-import VarSet
-import VarEnv
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 
 import Outputable
-import BasicTypes ( PprPrec(..), topPrec, sigPrec, opPrec
-                  , funPrec, appPrec, maybeParen )
+import GHC.Types.Basic ( PprPrec(..), topPrec, sigPrec, opPrec
+                       , funPrec, appPrec, maybeParen )
 
 {-
 %************************************************************************
@@ -71,7 +71,7 @@ works just by setting the initial context precedence very high.
 Note that any function which pretty-prints a @Type@ first converts the @Type@
 to an @IfaceType@. See Note [IfaceType and pretty-printing] in GHC.Iface.Type.
 
-See Note [Precedence in types] in BasicTypes.
+See Note [Precedence in types] in GHC.Types.Basic.
 -}
 
 --------------------------------------------------------
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index 1f2fd6cf19..1f96dd563b 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -80,14 +80,14 @@ import {-# SOURCE #-} GHC.Core.ConLike ( ConLike(..), conLikeName )
 
 -- friends:
 import GHC.Iface.Type
-import Var
-import VarSet
-import Name hiding ( varName )
+import GHC.Types.Var
+import GHC.Types.Var.Set
+import GHC.Types.Name hiding ( varName )
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 
 -- others
-import BasicTypes ( LeftOrRight(..), pickLR )
+import GHC.Types.Basic ( LeftOrRight(..), pickLR )
 import Outputable
 import FastString
 import Util
diff --git a/compiler/GHC/Core/TyCo/Rep.hs-boot b/compiler/GHC/Core/TyCo/Rep.hs-boot
index 2ffc19795c..c7ce05f0a6 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs-boot
+++ b/compiler/GHC/Core/TyCo/Rep.hs-boot
@@ -1,7 +1,7 @@
 module GHC.Core.TyCo.Rep where
 
 import Data.Data  ( Data )
-import {-# SOURCE #-} Var( Var, ArgFlag, AnonArgFlag )
+import {-# SOURCE #-} GHC.Types.Var( Var, ArgFlag, AnonArgFlag )
 
 data Type
 data TyThing
diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs
index 14eee30633..a4d0c49b46 100644
--- a/compiler/GHC/Core/TyCo/Subst.hs
+++ b/compiler/GHC/Core/TyCo/Subst.hs
@@ -70,16 +70,16 @@ import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs
 import GHC.Core.TyCo.Ppr
 
-import Var
-import VarSet
-import VarEnv
+import GHC.Types.Var
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
 
 import Pair
 import Util
-import UniqSupply
-import Unique
-import UniqFM
-import UniqSet
+import GHC.Types.Unique.Supply
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
 import Outputable
 
 import Data.List (mapAccumL)
diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs
index 3e41e922cc..f18ee4f132 100644
--- a/compiler/GHC/Core/TyCo/Tidy.hs
+++ b/compiler/GHC/Core/TyCo/Tidy.hs
@@ -23,9 +23,9 @@ import GhcPrelude
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList)
 
-import Name hiding (varName)
-import Var
-import VarEnv
+import GHC.Types.Name hiding (varName)
+import GHC.Types.Var
+import GHC.Types.Var.Env
 import Util (seqList)
 
 import Data.List (mapAccumL)
@@ -59,7 +59,7 @@ tidyVarBndr tidy_env@(occ_env, subst) var
 
 avoidNameClashes :: [TyCoVar] -> TidyEnv -> TidyEnv
 -- Seed the occ_env with clashes among the names, see
--- Note [Tidying multiple names at once] in OccName
+-- Note [Tidying multiple names at once] in GHC.Types.Names.OccName
 avoidNameClashes tvs (occ_env, subst)
   = (avoidClashesOccEnv occ_env occs, subst)
   where
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index e99f840bb9..11fd1cf5a9 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -150,24 +150,24 @@ import {-# SOURCE #-} GHC.Core.DataCon
    , isUnboxedSumCon )
 
 import Binary
-import Var
-import VarSet
+import GHC.Types.Var
+import GHC.Types.Var.Set
 import GHC.Core.Class
-import BasicTypes
-import ForeignCall
-import Name
-import NameEnv
+import GHC.Types.Basic
+import GHC.Types.ForeignCall
+import GHC.Types.Name
+import GHC.Types.Name.Env
 import GHC.Core.Coercion.Axiom
 import PrelNames
 import Maybes
 import Outputable
 import FastStringEnv
-import FieldLabel
+import GHC.Types.FieldLabel
 import Constants
 import Util
-import Unique( tyConRepNameUnique, dataConTyRepNameUnique )
-import UniqSet
-import Module
+import GHC.Types.Unique( tyConRepNameUnique, dataConTyRepNameUnique )
+import GHC.Types.Unique.Set
+import GHC.Types.Module
 
 import qualified Data.Data as Data
 
@@ -213,7 +213,7 @@ We also support injective type families -- see Note [Injective type families]
 
 Note [Data type families]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
-See also Note [Wrappers for data instance tycons] in MkId.hs
+See also Note [Wrappers for data instance tycons] in GHC.Types.Id.Make
 
 * Data type families are declared thus
         data family T a :: *
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index 3e86e86cf4..03e71ad915 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -223,7 +223,7 @@ module GHC.Core.Type (
 
 import GhcPrelude
 
-import BasicTypes
+import GHC.Types.Basic
 
 -- We import the representation and primitive functions from GHC.Core.TyCo.Rep.
 -- Many things are reexported, but not the representation!
@@ -234,10 +234,10 @@ import GHC.Core.TyCo.Tidy
 import GHC.Core.TyCo.FVs
 
 -- friends:
-import Var
-import VarEnv
-import VarSet
-import UniqSet
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Unique.Set
 
 import GHC.Core.TyCon
 import TysPrim
@@ -245,7 +245,7 @@ import {-# SOURCE #-} TysWiredIn ( listTyCon, typeNatKind
                                  , typeSymbolKind, liftedTypeKind
                                  , liftedTypeKindTyCon
                                  , constraintKind )
-import Name( Name )
+import GHC.Types.Name( Name )
 import PrelNames
 import GHC.Core.Coercion.Axiom
 import {-# SOURCE #-} GHC.Core.Coercion
@@ -265,7 +265,7 @@ import Outputable
 import FastString
 import Pair
 import ListSetOps
-import Unique ( nonDetCmpUnique )
+import GHC.Types.Unique ( nonDetCmpUnique )
 
 import Maybes           ( orElse )
 import Data.Maybe       ( isJust )
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 49006c66b6..411a954428 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -50,23 +50,23 @@ import GHC.Driver.Session
 import GHC.Core
 import GHC.Core.Op.OccurAnal ( occurAnalyseExpr_NoBinderSwap )
 import GHC.Core.SimpleOpt
-import GHC.Core.Arity     ( manifestArity )
+import GHC.Core.Arity   ( manifestArity )
 import GHC.Core.Utils
-import Id
-import Demand          ( isBottomingSig )
+import GHC.Types.Id
+import GHC.Types.Demand ( isBottomingSig )
 import GHC.Core.DataCon
-import Literal
+import GHC.Types.Literal
 import PrimOp
-import IdInfo
-import BasicTypes       ( Arity, InlineSpec(..), inlinePragmaSpec )
+import GHC.Types.Id.Info
+import GHC.Types.Basic  ( Arity, InlineSpec(..), inlinePragmaSpec )
 import GHC.Core.Type
 import PrelNames
 import TysPrim          ( realWorldStatePrimTy )
 import Bag
 import Util
 import Outputable
-import ForeignCall
-import Name
+import GHC.Types.ForeignCall
+import GHC.Types.Name
 import ErrUtils
 
 import qualified Data.ByteString as BS
diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs
index 10b1a85342..99c206472c 100644
--- a/compiler/GHC/Core/Unify.hs
+++ b/compiler/GHC/Core/Unify.hs
@@ -28,10 +28,10 @@ module GHC.Core.Unify (
 
 import GhcPrelude
 
-import Var
-import VarEnv
-import VarSet
-import Name( Name )
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Name( Name )
 import GHC.Core.Type     hiding ( getTvSubstEnv )
 import GHC.Core.Coercion hiding ( getCvSubstEnv )
 import GHC.Core.TyCon
@@ -42,8 +42,8 @@ import FV( FV, fvVarSet, fvVarList )
 import Util
 import Pair
 import Outputable
-import UniqFM
-import UniqSet
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
 
 import Control.Monad
 import qualified Control.Monad.Fail as MonadFail
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index e10029c988..4663f54b26 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -69,29 +69,29 @@ import GHC.Core
 import PrelNames ( makeStaticName )
 import GHC.Core.Ppr
 import GHC.Core.FVs( exprFreeVars )
-import Var
-import SrcLoc
-import VarEnv
-import VarSet
-import Name
-import Literal
+import GHC.Types.Var
+import GHC.Types.SrcLoc
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Name
+import GHC.Types.Literal
 import GHC.Core.DataCon
 import PrimOp
-import Id
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import PrelNames( absentErrorIdKey )
 import GHC.Core.Type as Type
 import GHC.Core.Predicate
 import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder )
 import GHC.Core.Coercion
 import GHC.Core.TyCon
-import Unique
+import GHC.Types.Unique
 import Outputable
 import TysPrim
 import FastString
 import Maybes
 import ListSetOps       ( minusList )
-import BasicTypes       ( Arity, isConLike )
+import GHC.Types.Basic     ( Arity, isConLike )
 import Util
 import Pair
 import Data.ByteString     ( ByteString )
@@ -100,7 +100,7 @@ import Data.List
 import Data.Ord            ( comparing )
 import OrdList
 import qualified Data.Set as Set
-import UniqSet
+import GHC.Types.Unique.Set
 
 {-
 ************************************************************************
@@ -1332,7 +1332,7 @@ expansion.  Specifically:
 
 * True of constructor applications (K a b)
 
-* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in BasicTypes.
+* True of applications of a "CONLIKE" Id; see Note [CONLIKE pragma] in GHC.Types.Basic.
   (NB: exprIsCheap might not be true of this)
 
 * False of case-expressions.  If we have
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index f16d77f782..75a2110e1d 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -21,20 +21,20 @@ import GHC.ByteCode.Types
 import GHC.Runtime.Interpreter
 import GHCi.FFI
 import GHCi.RemoteTypes
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Driver.Session
 import Outputable
 import GHC.Platform
-import Name
-import MkId
-import Id
-import Var             ( updateVarType )
-import ForeignCall
+import GHC.Types.Name
+import GHC.Types.Id.Make
+import GHC.Types.Id
+import GHC.Types.Var ( updateVarType )
+import GHC.Types.ForeignCall
 import GHC.Driver.Types
 import GHC.Core.Utils
 import GHC.Core
 import GHC.Core.Ppr
-import Literal
+import GHC.Types.Literal
 import PrimOp
 import GHC.Core.FVs
 import GHC.Core.Type
@@ -42,20 +42,20 @@ import GHC.Types.RepType
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import Util
-import VarSet
+import GHC.Types.Var.Set
 import TysPrim
 import GHC.Core.TyCo.Ppr ( pprType )
 import ErrUtils
-import Unique
+import GHC.Types.Unique
 import FastString
 import Panic
-import GHC.StgToCmm.Closure    ( NonVoid(..), fromNonVoid, nonVoidIds )
+import GHC.StgToCmm.Closure ( NonVoid(..), fromNonVoid, nonVoidIds )
 import GHC.StgToCmm.Layout
 import GHC.Runtime.Heap.Layout hiding (WordOff, ByteOff, wordsToBytes)
 import GHC.Data.Bitmap
 import OrdList
 import Maybes
-import VarEnv
+import GHC.Types.Var.Env
 import PrelNames ( unsafeEqualityProofName )
 
 import Data.List
@@ -63,8 +63,8 @@ import Foreign
 import Control.Monad
 import Data.Char
 
-import UniqSupply
-import Module
+import GHC.Types.Unique.Supply
+import GHC.Types.Module
 
 import Control.Exception
 import Data.Array
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index ee24c60bee..7b54138925 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -49,29 +49,29 @@ import GhcPrelude
 
 import GHC.Iface.Syntax
 import GHC.Core.DataCon
-import Id
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core
 import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
 import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )
 import TysWiredIn ( heqTyCon )
-import MkId ( noinlineIdName )
+import GHC.Types.Id.Make ( noinlineIdName )
 import PrelNames
-import Name
-import BasicTypes
+import GHC.Types.Name
+import GHC.Types.Basic
 import GHC.Core.Type
 import GHC.Core.PatSyn
 import Outputable
 import FastString
 import Util
-import Var
-import VarEnv
-import VarSet
+import GHC.Types.Var
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Tidy ( tidyCo )
-import Demand ( isTopSig )
-import Cpr ( topCprSig )
+import GHC.Types.Demand ( isTopSig )
+import GHC.Types.Cpr ( topCprSig )
 
 import Data.Maybe ( catMaybes )
 
diff --git a/compiler/GHC/CoreToIface.hs-boot b/compiler/GHC/CoreToIface.hs-boot
index 7daa190405..431d2b0aa5 100644
--- a/compiler/GHC/CoreToIface.hs-boot
+++ b/compiler/GHC/CoreToIface.hs-boot
@@ -3,10 +3,10 @@ module GHC.CoreToIface where
 import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, TyLit, Coercion )
 import {-# SOURCE #-} GHC.Iface.Type( IfaceType, IfaceTyCon, IfaceForAllBndr
                                     , IfaceCoercion, IfaceTyLit, IfaceAppArgs )
-import Var ( TyCoVarBinder )
-import VarEnv ( TidyEnv )
+import GHC.Types.Var ( TyCoVarBinder )
+import GHC.Types.Var.Env ( TidyEnv )
 import GHC.Core.TyCon ( TyCon )
-import VarSet( VarSet )
+import GHC.Types.Var.Set( VarSet )
 
 -- For GHC.Core.TyCo.Rep
 toIfaceTypeX :: VarSet -> Type -> IfaceType
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index a866f57b6b..0ebe4a8f90 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -26,27 +26,27 @@ import GHC.Stg.Syntax
 import GHC.Core.Type
 import GHC.Types.RepType
 import GHC.Core.TyCon
-import MkId             ( coercionTokenId )
-import Id
-import IdInfo
+import GHC.Types.Id.Make ( coercionTokenId )
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core.DataCon
-import CostCentre
-import VarEnv
-import Module
-import Name             ( isExternalName, nameModule_maybe )
-import BasicTypes       ( Arity )
+import GHC.Types.CostCentre
+import GHC.Types.Var.Env
+import GHC.Types.Module
+import GHC.Types.Name   ( isExternalName, nameModule_maybe )
+import GHC.Types.Basic  ( Arity )
 import TysWiredIn       ( unboxedUnitDataCon, unitDataConId )
-import Literal
+import GHC.Types.Literal
 import Outputable
 import MonadUtils
 import FastString
 import Util
 import GHC.Driver.Session
 import GHC.Driver.Ways
-import ForeignCall
-import Demand           ( isUsedOnce )
+import GHC.Types.ForeignCall
+import GHC.Types.Demand ( isUsedOnce )
 import PrimOp           ( PrimCall(..), primOpWrapperId )
-import SrcLoc           ( mkGeneralSrcSpan )
+import GHC.Types.SrcLoc ( mkGeneralSrcSpan )
 import PrelNames        ( unsafeEqualityProofName )
 
 import Data.List.NonEmpty (nonEmpty, toList)
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index fb46438049..b6a14b4af5 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -24,30 +24,30 @@ import GHC.Core.Op.OccurAnal
 
 import GHC.Driver.Types
 import PrelNames
-import MkId             ( realWorldPrimId )
+import GHC.Types.Id.Make ( realWorldPrimId )
 import GHC.Core.Utils
 import GHC.Core.Arity
 import GHC.Core.FVs
-import GHC.Core.Op.Monad        ( CoreToDo(..) )
+import GHC.Core.Op.Monad ( CoreToDo(..) )
 import GHC.Core.Lint    ( endPassIO )
 import GHC.Core
 import GHC.Core.Make hiding( FloatBind(..) )   -- We use our own FloatBind here
 import GHC.Core.Type
-import Literal
+import GHC.Types.Literal
 import GHC.Core.Coercion
 import TcEnv
 import GHC.Core.TyCon
-import Demand
-import Var
-import VarSet
-import VarEnv
-import Id
-import IdInfo
+import GHC.Types.Demand
+import GHC.Types.Var
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import TysWiredIn
 import GHC.Core.DataCon
-import BasicTypes
-import Module
-import UniqSupply
+import GHC.Types.Basic
+import GHC.Types.Module
+import GHC.Types.Unique.Supply
 import Maybes
 import OrdList
 import ErrUtils
@@ -56,12 +56,12 @@ import GHC.Driver.Ways
 import Util
 import Outputable
 import FastString
-import Name             ( NamedThing(..), nameSrcSpan, isInternalName )
-import SrcLoc           ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
+import GHC.Types.Name   ( NamedThing(..), nameSrcSpan, isInternalName )
+import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
 import Data.Bits
 import MonadUtils       ( mapAccumLM )
 import Control.Monad
-import CostCentre       ( CostCentre, ccFromThisModule )
+import GHC.Types.CostCentre ( CostCentre, ccFromThisModule )
 import qualified Data.Set as S
 
 {-
@@ -112,7 +112,7 @@ The goal of this pass is to prepare for code generation.
     We want curried definitions for all of these in case they
     aren't inlined by some caller.
 
-9.  Replace (lazy e) by e.  See Note [lazyId magic] in MkId.hs
+9.  Replace (lazy e) by e.  See Note [lazyId magic] in GHC.Types.Id.Make
     Also replace (noinline e) by e.
 
 10. Convert (LitInteger i t) into the core representation
@@ -658,7 +658,7 @@ cvtLitInteger :: Platform -> Id -> Maybe DataCon -> Integer -> CoreExpr
 -- representation. Exactly how we do this depends on the
 -- library that implements Integer.  If it's GMP we
 -- use the S# data constructor for small literals.
--- See Note [Integer literals] in Literal
+-- See Note [Integer literals] in GHC.Types.Literal
 cvtLitInteger platform _ (Just sdatacon) i
   | platformInIntRange platform i -- Special case for small integers
     = mkConApp sdatacon [Lit (mkLitInt platform i)]
@@ -678,7 +678,7 @@ cvtLitInteger platform mk_integer _ i
 cvtLitNatural :: Platform -> Id -> Maybe DataCon -> Integer -> CoreExpr
 -- Here we convert a literal Natural to the low-level
 -- representation.
--- See Note [Natural literals] in Literal
+-- See Note [Natural literals] in GHC.Types.Literal
 cvtLitNatural platform _ (Just sdatacon) i
   | platformInWordRange platform i -- Special case for small naturals
     = mkConApp sdatacon [Lit (mkLitWord platform i)]
@@ -771,7 +771,7 @@ which happened in #11291, we do /not/ want to turn it into
    (case bot of {}) realWorldPrimId#
 because that gives a panic in CoreToStg.myCollectArgs, which expects
 only variables in function position.  But if we are sure to make
-runRW# strict (which we do in MkId), this can't happen
+runRW# strict (which we do in GHC.Types.Id.Make), this can't happen
 -}
 
 cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
@@ -899,7 +899,7 @@ cpeApp top_env expr
       CpeApp arg@(Coercion {}) ->
         rebuild_app as (App fun' arg) (funResultTy fun_ty) floats ss
       CpeApp arg -> do
-        let (ss1, ss_rest)  -- See Note [lazyId magic] in MkId
+        let (ss1, ss_rest)  -- See Note [lazyId magic] in GHC.Types.Id.Make
                = case (ss, isLazyExpr arg) of
                    (_   : ss_rest, True)  -> (topDmd, ss_rest)
                    (ss1 : ss_rest, False) -> (ss1,    ss_rest)
@@ -918,7 +918,7 @@ cpeApp top_env expr
         rebuild_app as fun' fun_ty (addFloat floats (FloatTick tickish)) ss
 
 isLazyExpr :: CoreExpr -> Bool
--- See Note [lazyId magic] in MkId
+-- See Note [lazyId magic] in GHC.Types.Id.Make
 isLazyExpr (Cast e _)              = isLazyExpr e
 isLazyExpr (Tick _ e)              = isLazyExpr e
 isLazyExpr (Var f `App` _ `App` _) = f `hasKey` lazyIdKey
@@ -1411,7 +1411,7 @@ The solution is CorePrep to have a miniature inlining pass which deals
 with cases like this.  We can then drop the let-binding altogether.
 
 Why does the removal of 'lazy' have to occur in CorePrep?
-The gory details are in Note [lazyId magic] in MkId, but the
+The gory details are in Note [lazyId magic] in GHC.Types.Id.Make, but the
 main reason is that lazy must appear in unfoldings (optimizer
 output) and it must prevent call-by-value for catch# (which
 is implemented by CorePrep.)
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index a82c9c562f..61cac8bb40 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -32,23 +32,23 @@ import GHC.Driver.Monad
 import GHC.Driver.Session
 import TcRnMonad
 import TcRnDriver
-import Module
+import GHC.Types.Module
 import GHC.Driver.Types
 import StringBuffer
 import FastString
 import ErrUtils
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Driver.Main
-import UniqFM
-import UniqDFM
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
 import Outputable
 import Maybes
 import HeaderInfo
 import GHC.Iface.Recomp
 import GHC.Driver.Make
-import UniqDSet
+import GHC.Types.Unique.DSet
 import PrelNames
-import BasicTypes hiding (SuccessFlag(..))
+import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Driver.Finder
 import Util
 
diff --git a/compiler/GHC/Driver/Backpack/Syntax.hs b/compiler/GHC/Driver/Backpack/Syntax.hs
index 709427ebd0..7a119907da 100644
--- a/compiler/GHC/Driver/Backpack/Syntax.hs
+++ b/compiler/GHC/Driver/Backpack/Syntax.hs
@@ -20,9 +20,9 @@ import GhcPrelude
 
 import GHC.Driver.Phases
 import GHC.Hs
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
-import Module
+import GHC.Types.Module
 import UnitInfo
 
 {-
diff --git a/compiler/GHC/Driver/CmdLine.hs b/compiler/GHC/Driver/CmdLine.hs
index 9b71e3d3fb..243831cfc5 100644
--- a/compiler/GHC/Driver/CmdLine.hs
+++ b/compiler/GHC/Driver/CmdLine.hs
@@ -32,7 +32,7 @@ import Util
 import Outputable
 import Panic
 import Bag
-import SrcLoc
+import GHC.Types.SrcLoc
 import Json
 
 import Data.Function
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 507311c039..45c40d2c30 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -15,7 +15,7 @@ import GhcPrelude
 import GHC.CmmToAsm     ( nativeCodeGen )
 import GHC.CmmToLlvm    ( llvmCodeGen )
 
-import UniqSupply       ( mkSplitUniqSupply )
+import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
 
 import GHC.Driver.Finder    ( mkStubPaths )
 import GHC.CmmToC           ( writeC )
@@ -30,8 +30,8 @@ import FileCleanup
 
 import ErrUtils
 import Outputable
-import Module
-import SrcLoc
+import GHC.Types.Module
+import GHC.Types.SrcLoc
 
 import Control.Exception
 import System.Directory
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index c7c9c1af1f..a9f0fda13e 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -35,7 +35,7 @@ module GHC.Driver.Finder (
 
 import GhcPrelude
 
-import Module
+import GHC.Types.Module
 import GHC.Driver.Types
 import GHC.Driver.Packages
 import FastString
diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs
index 0fbb10bb89..51ea03dac1 100644
--- a/compiler/GHC/Driver/Hooks.hs
+++ b/compiler/GHC/Driver/Hooks.hs
@@ -39,18 +39,18 @@ import GHC.Hs.Expr
 import OrdList
 import TcRnTypes
 import Bag
-import RdrName
-import Name
-import Id
+import GHC.Types.Name.Reader
+import GHC.Types.Name
+import GHC.Types.Id
 import GHC.Core
 import GHCi.RemoteTypes
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Core.Type
 import System.Process
-import BasicTypes
-import Module
+import GHC.Types.Basic
+import GHC.Types.Module
 import GHC.Core.TyCon
-import CostCentre
+import GHC.Types.CostCentre
 import GHC.Stg.Syntax
 import Stream
 import GHC.Cmm
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 083bfd279a..1b35e34aff 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -88,7 +88,7 @@ import GhcPrelude
 
 import Data.Data hiding (Fixity, TyCon)
 import Data.Maybe       ( fromJust )
-import Id
+import GHC.Types.Id
 import GHC.Runtime.Interpreter ( addSptEntry )
 import GHCi.RemoteTypes        ( ForeignHValue )
 import GHC.CoreToByteCode      ( byteCodeGen, coreExprToBCOs )
@@ -96,26 +96,26 @@ import GHC.Runtime.Linker
 import GHC.Core.Op.Tidy        ( tidyExpr )
 import GHC.Core.Type           ( Type, Kind )
 import GHC.Core.Lint           ( lintInteractiveExpr )
-import VarEnv                  ( emptyTidyEnv )
+import GHC.Types.Var.Env       ( emptyTidyEnv )
 import Panic
 import GHC.Core.ConLike
 
 import ApiAnnotation
-import Module
+import GHC.Types.Module
 import GHC.Driver.Packages
-import RdrName
+import GHC.Types.Name.Reader
 import GHC.Hs
 import GHC.Hs.Dump
 import GHC.Core
 import StringBuffer
 import Parser
 import Lexer
-import SrcLoc
+import GHC.Types.SrcLoc
 import TcRnDriver
 import GHC.IfaceToCore  ( typecheckIface )
 import TcRnMonad
 import TcHsSyn          ( ZonkFlexi (DefaultFlexi) )
-import NameCache        ( initNameCache )
+import GHC.Types.Name.Cache ( initNameCache )
 import PrelInfo
 import GHC.Core.Op.Simplify.Driver
 import GHC.HsToCore
@@ -129,11 +129,11 @@ import GHC.Stg.Syntax
 import GHC.Stg.FVs      ( annTopBindingsFreeVars )
 import GHC.Stg.Pipeline ( stg2stg )
 import qualified GHC.StgToCmm as StgToCmm ( codeGen )
-import CostCentre
-import ProfInit
+import GHC.Types.CostCentre
+import GHC.Types.CostCentre.Init
 import GHC.Core.TyCon
-import Name
-import NameSet
+import GHC.Types.Name
+import GHC.Types.Name.Set
 import GHC.Cmm
 import GHC.Cmm.Parser         ( parseCmmFile )
 import GHC.Cmm.Info.Build
@@ -153,11 +153,11 @@ import GHC.Driver.Session
 import ErrUtils
 
 import Outputable
-import NameEnv
+import GHC.Types.Name.Env
 import HscStats         ( ppSourceStats )
 import GHC.Driver.Types
 import FastString
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Bag
 import Exception
 import qualified Stream
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index e1aa392771..051e9d56ce 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -45,31 +45,31 @@ import GHC.Driver.Finder
 import GHC.Driver.Monad
 import HeaderInfo
 import GHC.Driver.Types
-import Module
+import GHC.Types.Module
 import GHC.IfaceToCore  ( typecheckIface )
 import TcRnMonad        ( initIfaceCheck )
 import GHC.Driver.Main
 
 import Bag              ( unitBag, listToBag, unionManyBags, isEmptyBag )
-import BasicTypes
+import GHC.Types.Basic
 import Digraph
 import Exception        ( tryIO, gbracket, gfinally )
 import FastString
 import Maybes           ( expectJust )
-import Name
+import GHC.Types.Name
 import MonadUtils       ( allM )
 import Outputable
 import Panic
-import SrcLoc
+import GHC.Types.SrcLoc
 import StringBuffer
-import UniqFM
-import UniqDSet
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DSet
 import TcBackpack
 import GHC.Driver.Packages
-import UniqSet
+import GHC.Types.Unique.Set
 import Util
 import qualified GHC.LanguageExtensions as LangExt
-import NameEnv
+import GHC.Types.Name.Env
 import FileCleanup
 
 import Data.Either ( rights, partitionEithers )
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 7b621ca3c4..385b1de791 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -24,12 +24,12 @@ import GHC.Driver.Ways
 import Util
 import GHC.Driver.Types
 import qualified SysTools
-import Module
+import GHC.Types.Module
 import Digraph          ( SCC(..) )
 import GHC.Driver.Finder
 import Outputable
 import Panic
-import SrcLoc
+import GHC.Types.SrcLoc
 import Data.List
 import FastString
 import FileCleanup
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs
index e8bed631ff..1f61d5df97 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Driver/Packages.hs
@@ -72,11 +72,11 @@ import GHC.PackageDb
 import UnitInfo
 import GHC.Driver.Session
 import GHC.Driver.Ways
-import Name             ( Name, nameModule_maybe )
-import UniqFM
-import UniqDFM
-import UniqSet
-import Module
+import GHC.Types.Name       ( Name, nameModule_maybe )
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import GHC.Types.Unique.Set
+import GHC.Types.Module
 import Util
 import Panic
 import GHC.Platform
@@ -995,7 +995,7 @@ pprTrustFlag flag = case flag of
 -- -----------------------------------------------------------------------------
 -- Wired-in packages
 --
--- See Note [Wired-in packages] in Module
+-- See Note [Wired-in packages] in GHC.Types.Module
 
 type WiredInUnitId = String
 type WiredPackagesMap = Map WiredUnitId WiredUnitId
@@ -1015,7 +1015,7 @@ findWiredInPackages
 findWiredInPackages dflags prec_map pkgs vis_map = do
   -- Now we must find our wired-in packages, and rename them to
   -- their canonical names (eg. base-1.0 ==> base), as described
-  -- in Note [Wired-in packages] in Module
+  -- in Note [Wired-in packages] in GHC.Types.Module
   let
         matches :: UnitInfo -> WiredInUnitId -> Bool
         pc `matches` pid
@@ -1119,7 +1119,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
 
 -- Helper functions for rewiring Module and UnitId.  These
 -- rewrite UnitIds of modules in wired-in packages to the form known to the
--- compiler, as described in Note [Wired-in packages] in Module.
+-- compiler, as described in Note [Wired-in packages] in GHC.Types.Module.
 --
 -- For instance, base-4.9.0.0 will be rewritten to just base, to match
 -- what appears in PrelNames.
diff --git a/compiler/GHC/Driver/Packages.hs-boot b/compiler/GHC/Driver/Packages.hs-boot
index 89fb2a1c18..73823c0d3b 100644
--- a/compiler/GHC/Driver/Packages.hs-boot
+++ b/compiler/GHC/Driver/Packages.hs-boot
@@ -1,7 +1,7 @@
 module GHC.Driver.Packages where
 import GhcPrelude
 import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
-import {-# SOURCE #-} Module(ComponentId, UnitId, InstalledUnitId)
+import {-# SOURCE #-} GHC.Types.Module(ComponentId, UnitId, InstalledUnitId)
 data PackageState
 data UnitInfoMap
 data PackageDatabase
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 627efeeb41..01e89b5fbe 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -49,15 +49,15 @@ import GHC.Driver.Main
 import GHC.Driver.Finder
 import GHC.Driver.Types hiding ( Hsc )
 import Outputable
-import Module
+import GHC.Types.Module
 import ErrUtils
 import GHC.Driver.Session
 import Panic
 import Util
 import StringBuffer     ( hGetStringBuffer, hPutStringBuffer )
-import BasicTypes       ( SuccessFlag(..) )
+import GHC.Types.Basic  ( SuccessFlag(..) )
 import Maybes           ( expectJust )
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.CmmToLlvm    ( llvmFixupAsm, llvmVersionList )
 import MonadUtils
 import GHC.Platform
@@ -69,7 +69,7 @@ import FileCleanup
 import Ar
 import Bag              ( unitBag )
 import FastString       ( mkFastString )
-import GHC.Iface.Make  ( mkFullIface )
+import GHC.Iface.Make   ( mkFullIface )
 import UpdateCafInfos   ( updateModDetailsCafInfos )
 
 import Exception
diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs
index 5831f923ea..6e07924d1e 100644
--- a/compiler/GHC/Driver/Pipeline/Monad.hs
+++ b/compiler/GHC/Driver/Pipeline/Monad.hs
@@ -18,7 +18,7 @@ import Outputable
 import GHC.Driver.Session
 import GHC.Driver.Phases
 import GHC.Driver.Types
-import Module
+import GHC.Types.Module
 import FileCleanup (TempFileLifetime)
 
 import Control.Monad
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index 437e68af71..bf2e9fe759 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -58,7 +58,7 @@ import GHC.Driver.Session
 import GHC.Driver.Types
 import GHC.Driver.Monad
 import GHC.Driver.Phases
-import Module ( ModuleName, Module(moduleName))
+import GHC.Types.Module ( ModuleName, Module(moduleName))
 import Fingerprint
 import Data.List (sort)
 import Outputable (Outputable(..), text, (<+>))
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index d511701ea1..56d53838f6 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -243,7 +243,7 @@ import GhcPrelude
 import GHC.Platform
 import GHC.UniqueSubdir (uniqueSubdir)
 import PlatformConstants
-import Module
+import GHC.Types.Module
 import {-# SOURCE #-} GHC.Driver.Plugins
 import {-# SOURCE #-} GHC.Driver.Hooks
 import {-# SOURCE #-} PrelNames ( mAIN )
@@ -263,8 +263,8 @@ import Util
 import Maybes
 import MonadUtils
 import qualified Pretty
-import SrcLoc
-import BasicTypes       ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
+import GHC.Types.SrcLoc
+import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
 import FastString
 import Fingerprint
 import FileSettings
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index c2699f23e9..64e031e0f5 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -159,24 +159,24 @@ import GHC.Runtime.Eval.Types ( Resume )
 import GHC.Runtime.Interpreter.Types (Interp)
 import GHC.ForeignSrcLang
 
-import UniqFM
+import GHC.Types.Unique.FM
 import GHC.Hs
-import RdrName
-import Avail
-import Module
+import GHC.Types.Name.Reader
+import GHC.Types.Avail
+import GHC.Types.Module
 import GHC.Core.InstEnv ( InstEnv, ClsInst, identicalClsInstHead )
 import GHC.Core.FamInstEnv
 import GHC.Core         ( CoreProgram, RuleBase, CoreRule )
-import Name
-import NameEnv
-import VarSet
-import Var
-import Id
-import IdInfo           ( IdDetails(..), RecSelParent(..))
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Var.Set
+import GHC.Types.Var
+import GHC.Types.Id
+import GHC.Types.Id.Info ( IdDetails(..), RecSelParent(..))
 import GHC.Core.Type
 
 import ApiAnnotation    ( ApiAnns )
-import Annotations      ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
+import GHC.Types.Annotations ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
 import GHC.Core.Class
 import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
@@ -193,13 +193,13 @@ import GHC.Driver.Phases
    ( Phase, HscSource(..), hscSourceString
    , isHsBootOrSig, isHsigFile )
 import qualified GHC.Driver.Phases as Phase
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Iface.Syntax
 import Maybes
 import Outputable
-import SrcLoc
-import Unique
-import UniqDFM
+import GHC.Types.SrcLoc
+import GHC.Types.Unique
+import GHC.Types.Unique.DFM
 import FastString
 import StringBuffer     ( StringBuffer )
 import Fingerprint
@@ -207,10 +207,10 @@ import MonadUtils
 import Bag
 import Binary
 import ErrUtils
-import NameCache
+import GHC.Types.Name.Cache
 import GHC.Platform
 import Util
-import UniqDSet
+import GHC.Types.Unique.DSet
 import GHC.Serialized   ( Serialized )
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -1611,7 +1611,7 @@ The Ids bound by previous Stmts in GHCi are currently
      global.
 
  (b) Having an External Name is important because of Note
-     [GlobalRdrEnv shadowing] in RdrName
+     [GlobalRdrEnv shadowing] in GHC.Types.Names.RdrName
 
  (c) Their types are tidied. This is important, because :info may ask
      to look at them, and :info expects the things it looks up to have
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 999d59ea7a..98509398aa 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -45,15 +45,15 @@ import GHC.Hs.Lit
 import GHC.Hs.Extension
 import GHC.Hs.Pat
 import GHC.Hs.Types
-import BasicTypes       ( Fixity, WarningTxt )
+import GHC.Types.Basic ( Fixity, WarningTxt )
 import GHC.Hs.Utils
 import GHC.Hs.Doc
 import GHC.Hs.Instances () -- For Data instances
 
 -- others:
 import Outputable
-import SrcLoc
-import Module           ( ModuleName )
+import GHC.Types.SrcLoc
+import GHC.Types.Module ( ModuleName )
 
 -- libraries:
 import Data.Data hiding ( Fixity )
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 70da7903fc..efd4b7cd95 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -35,11 +35,11 @@ import GHC.Hs.Types
 import GHC.Core
 import TcEvidence
 import GHC.Core.Type
-import NameSet
-import BasicTypes
+import GHC.Types.Name.Set
+import GHC.Types.Basic
 import Outputable
-import SrcLoc
-import Var
+import GHC.Types.SrcLoc as SrcLoc
+import GHC.Types.Var
 import Bag
 import FastString
 import BooleanFormula (LBooleanFormula)
@@ -992,7 +992,7 @@ data Sig pass
 
         -- For details on above see note [Api annotations] in ApiAnnotation
   | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
-                  -- Note [Pragma source text] in BasicTypes
+                  -- Note [Pragma source text] in GHC.Types.Basic
 
         -- | A minimal complete definition pragma
         --
@@ -1005,7 +1005,7 @@ data Sig pass
         -- For details on above see note [Api annotations] in ApiAnnotation
   | MinimalSig (XMinimalSig pass)
                SourceText (LBooleanFormula (Located (IdP pass)))
-               -- Note [Pragma source text] in BasicTypes
+               -- Note [Pragma source text] in GHC.Types.Basic
 
         -- | A "set cost centre" pragma for declarations
         --
@@ -1016,7 +1016,7 @@ data Sig pass
         -- > {-# SCC funName "cost_centre_name" #-}
 
   | SCCFunSig  (XSCCFunSig pass)
-               SourceText      -- Note [Pragma source text] in BasicTypes
+               SourceText      -- Note [Pragma source text] in GHC.Types.Basic
                (Located (IdP pass))  -- Function name
                (Maybe (Located StringLiteral))
        -- | A complete match pragma
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 84a9bb4dca..07cdb82a91 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -104,17 +104,17 @@ import GHC.Hs.Binds
 import GHC.Hs.Types
 import GHC.Hs.Doc
 import GHC.Core.TyCon
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core.Coercion
-import ForeignCall
+import GHC.Types.ForeignCall
 import GHC.Hs.Extension
-import NameSet
+import GHC.Types.Name.Set
 
 -- others:
 import GHC.Core.Class
 import Outputable
 import Util
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Core.Type
 
 import Bag
@@ -438,7 +438,7 @@ Plan of attack:
    to ensure correct module and provenance is set
 
 These are the two places that we have to conjure up the magic derived
-names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
+names.  (The actual magic is in GHC.Types.Name.Occurrence.mkWorkerOcc, etc.)
 
 Default methods
 ~~~~~~~~~~~~~~~
@@ -2241,7 +2241,7 @@ instance Outputable ForeignExport where
 -- | Located Rule Declarations
 type LRuleDecls pass = Located (RuleDecls pass)
 
-  -- Note [Pragma source text] in BasicTypes
+  -- Note [Pragma source text] in GHC.Types.Basic
 -- | Rule Declarations
 data RuleDecls pass = HsRules { rds_ext   :: XCRuleDecls pass
                               , rds_src   :: SourceText
@@ -2260,7 +2260,7 @@ data RuleDecl pass
        { rd_ext  :: XHsRule pass
            -- ^ After renamer, free-vars from the LHS and RHS
        , rd_name :: Located (SourceText,RuleName)
-           -- ^ Note [Pragma source text] in BasicTypes
+           -- ^ Note [Pragma source text] in GHC.Types.Basic
        , rd_act  :: Activation
        , rd_tyvs :: Maybe [LHsTyVarBndr (NoGhcTc pass)]
            -- ^ Forall'd type vars
@@ -2387,7 +2387,7 @@ We use exported entities for things to deprecate.
 -- | Located Warning Declarations
 type LWarnDecls pass = Located (WarnDecls pass)
 
- -- Note [Pragma source text] in BasicTypes
+ -- Note [Pragma source text] in GHC.Types.Basic
 -- | Warning pragma Declarations
 data WarnDecls pass = Warnings { wd_ext      :: XWarnings pass
                                , wd_src      :: SourceText
@@ -2437,7 +2437,7 @@ type LAnnDecl pass = Located (AnnDecl pass)
 -- | Annotation Declaration
 data AnnDecl pass = HsAnnotation
                       (XHsAnnotation pass)
-                      SourceText -- Note [Pragma source text] in BasicTypes
+                      SourceText -- Note [Pragma source text] in GHC.Types.Basic
                       (AnnProvenance (IdP pass)) (Located (HsExpr pass))
       -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
       --           'ApiAnnotation.AnnType'
diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs
index 18a820fa6e..7da56b1524 100644
--- a/compiler/GHC/Hs/Doc.hs
+++ b/compiler/GHC/Hs/Doc.hs
@@ -28,9 +28,9 @@ import GhcPrelude
 import Binary
 import Encoding
 import FastFunctions
-import Name
+import GHC.Types.Name
 import Outputable
-import SrcLoc
+import GHC.Types.SrcLoc
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index 71a951a30a..2fe8711570 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -19,16 +19,15 @@ import GhcPrelude
 
 import Data.Data hiding (Fixity)
 import Bag
-import BasicTypes
+import GHC.Types.Basic
 import FastString
-import NameSet
-import Name
+import GHC.Types.Name.Set
+import GHC.Types.Name
 import GHC.Core.DataCon
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Hs
-import OccName hiding (occName)
-import Var
-import Module
+import GHC.Types.Var
+import GHC.Types.Module
 import Outputable
 
 import qualified Data.ByteString as B
@@ -110,7 +109,7 @@ showAstData b a0 = blankLine $$ showAstData' a0
 
             occName n  =  braces $
                           text "OccName: "
-                       <> text (OccName.occNameString n)
+                       <> text (occNameString n)
 
             moduleName :: ModuleName -> SDoc
             moduleName m = braces $ text "ModuleName: " <> ppr m
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 52162a09c8..c34e7eb809 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -38,11 +38,11 @@ import GHC.Hs.Binds
 -- others:
 import TcEvidence
 import GHC.Core
-import Name
-import NameSet
-import BasicTypes
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Basic
 import GHC.Core.ConLike
-import SrcLoc
+import GHC.Types.SrcLoc
 import Util
 import Outputable
 import FastString
@@ -675,7 +675,7 @@ type instance XXExpr         GhcTc       = HsWrap HsExpr
 -- | A pragma, written as {-# ... #-}, that may appear within an expression.
 data HsPragE p
   = HsPragSCC   (XSCC p)
-                SourceText            -- Note [Pragma source text] in BasicTypes
+                SourceText            -- Note [Pragma source text] in GHC.Types.Basic
                 StringLiteral         -- "set cost centre" SCC pragma
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CORE'@,
@@ -683,7 +683,7 @@ data HsPragE p
 
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsPragCore  (XCoreAnn p)
-                SourceText            -- Note [Pragma source text] in BasicTypes
+                SourceText            -- Note [Pragma source text] in GHC.Types.Basic
                 StringLiteral         -- hdaume: core annotation
 
   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
@@ -698,12 +698,12 @@ data HsPragE p
   -- For details on above see note [Api annotations] in ApiAnnotation
   | HsPragTick                        -- A pragma introduced tick
      (XTickPragma p)
-     SourceText                       -- Note [Pragma source text] in BasicTypes
+     SourceText                       -- Note [Pragma source text] in GHC.Types.Basic
      (StringLiteral,(Int,Int),(Int,Int))
                                       -- external span for this tick
      ((SourceText,SourceText),(SourceText,SourceText))
         -- Source text for the four integers used in the span.
-        -- See note [Pragma source text] in BasicTypes
+        -- See note [Pragma source text] in GHC.Types.Basic
 
   | XHsPragE (XXPragE p)
 
diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot
index 0fdbf773b2..87a4a2b38e 100644
--- a/compiler/GHC/Hs/Expr.hs-boot
+++ b/compiler/GHC/Hs/Expr.hs-boot
@@ -10,10 +10,10 @@
 
 module GHC.Hs.Expr where
 
-import SrcLoc     ( Located )
+import GHC.Types.SrcLoc     ( Located )
 import Outputable ( SDoc, Outputable )
 import {-# SOURCE #-} GHC.Hs.Pat  ( LPat )
-import BasicTypes ( SpliceExplicitFlag(..))
+import GHC.Types.Basic  ( SpliceExplicitFlag(..))
 import GHC.Hs.Extension ( OutputableBndrId, GhcPass )
 import Data.Kind  ( Type )
 
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index 31e6a20f5d..45753eaf47 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -28,11 +28,11 @@ module GHC.Hs.Extension where
 import GhcPrelude
 
 import Data.Data hiding ( Fixity )
-import Name
-import RdrName
-import Var
+import GHC.Types.Name
+import GHC.Types.Name.Reader
+import GHC.Types.Var
 import Outputable
-import SrcLoc (Located)
+import GHC.Types.SrcLoc (Located)
 
 import Data.Kind
 
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 58a310a0c0..aa85a98564 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -18,15 +18,15 @@ module GHC.Hs.ImpExp where
 
 import GhcPrelude
 
-import Module           ( ModuleName )
-import GHC.Hs.Doc       ( HsDocString )
-import OccName          ( HasOccName(..), isTcOcc, isSymOcc )
-import BasicTypes       ( SourceText(..), StringLiteral(..), pprWithSourceText )
-import FieldLabel       ( FieldLbl(..) )
+import GHC.Types.Module       ( ModuleName )
+import GHC.Hs.Doc             ( HsDocString )
+import GHC.Types.Name.Occurrence ( HasOccName(..), isTcOcc, isSymOcc )
+import GHC.Types.Basic        ( SourceText(..), StringLiteral(..), pprWithSourceText )
+import GHC.Types.FieldLabel   ( FieldLbl(..) )
 
 import Outputable
 import FastString
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Hs.Extension
 
 import Data.Data
@@ -80,7 +80,7 @@ data ImportDecl pass
   = ImportDecl {
       ideclExt       :: XCImportDecl pass,
       ideclSourceSrc :: SourceText,
-                                 -- Note [Pragma source text] in BasicTypes
+                                 -- Note [Pragma source text] in GHC.Types.Basic
       ideclName      :: Located ModuleName, -- ^ Module name.
       ideclPkgQual   :: Maybe StringLiteral,  -- ^ Package qualifier.
       ideclSource    :: Bool,          -- ^ True <=> {-\# SOURCE \#-} import
@@ -282,7 +282,7 @@ gives rise to
     IEThingWith T [MkT] [FieldLabel "x" False x)]           (without DuplicateRecordFields)
     IEThingWith T [MkT] [FieldLabel "x" True $sel:x:MkT)]   (with    DuplicateRecordFields)
 
-See Note [Representing fields in AvailInfo] in Avail for more details.
+See Note [Representing fields in AvailInfo] in GHC.Types.Avail for more details.
 -}
 
 ieName :: IE (GhcPass p) -> IdP (GhcPass p)
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index fa538f3089..a0e95c973d 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -22,9 +22,10 @@ module GHC.Hs.Lit where
 import GhcPrelude
 
 import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, pprExpr )
-import BasicTypes ( IntegralLit(..),FractionalLit(..),negateIntegralLit,
-                    negateFractionalLit,SourceText(..),pprWithSourceText,
-                    PprPrec(..), topPrec )
+import GHC.Types.Basic
+   ( IntegralLit(..), FractionalLit(..), negateIntegralLit
+   , negateFractionalLit, SourceText(..), pprWithSourceText
+   , PprPrec(..), topPrec )
 import GHC.Core.Type
 import Outputable
 import FastString
@@ -41,7 +42,7 @@ import Data.Data hiding ( Fixity )
 ************************************************************************
 -}
 
--- Note [Literal source text] in BasicTypes for SourceText fields in
+-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
 -- the following
 -- Note [Trees that grow] in GHC.Hs.Extension for the Xxxxx fields in the following
 -- | Haskell Literal
@@ -133,7 +134,7 @@ type instance XOverLit GhcTc = OverLitTc
 
 type instance XXOverLit (GhcPass _) = NoExtCon
 
--- Note [Literal source text] in BasicTypes for SourceText fields in
+-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
 -- the following
 -- | Overloaded Literal Value
 data OverLitVal
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 1bddfa2c71..f8505875bf 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -56,19 +56,19 @@ import GHC.Hs.Lit
 import GHC.Hs.Extension
 import GHC.Hs.Types
 import TcEvidence
-import BasicTypes
+import GHC.Types.Basic
 -- others:
 import GHC.Core.Ppr ( {- instance OutputableBndr TyVar -} )
 import GHC.Driver.Session ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) )
 import TysWiredIn
-import Var
-import RdrName ( RdrName )
+import GHC.Types.Var
+import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import Outputable
 import GHC.Core.Type
-import SrcLoc
+import GHC.Types.SrcLoc
 import Bag -- collect ev vars from pats
 import Maybes
 -- libraries:
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index 354611836c..21f9f38abf 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -78,16 +78,16 @@ import {-# SOURCE #-} GHC.Hs.Expr ( HsSplice, pprSplice )
 
 import GHC.Hs.Extension
 
-import Id ( Id )
-import Name( Name, NamedThing(getName) )
-import RdrName ( RdrName )
+import GHC.Types.Id ( Id )
+import GHC.Types.Name( Name, NamedThing(getName) )
+import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.DataCon( HsSrcBang(..), HsImplBang(..),
                          SrcStrictness(..), SrcUnpackedness(..) )
 import TysWiredIn( mkTupleStr )
 import GHC.Core.Type
 import GHC.Hs.Doc
-import BasicTypes
-import SrcLoc
+import GHC.Types.Basic
+import GHC.Types.SrcLoc
 import Outputable
 import FastString
 import Maybes( isJust )
@@ -750,7 +750,7 @@ type instance XWildCardTy      (GhcPass _) = NoExtField
 type instance XXType         (GhcPass _) = NewHsTypeX
 
 
--- Note [Literal source text] in BasicTypes for SourceText fields in
+-- Note [Literal source text] in GHC.Types.Basic for SourceText fields in
 -- the following
 -- | Haskell Type Literal
 data HsTyLit
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index d7f37dac86..99763d25a3 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -110,20 +110,20 @@ import GHC.Hs.Lit
 import GHC.Hs.Extension
 
 import TcEvidence
-import RdrName
-import Var
+import GHC.Types.Name.Reader
+import GHC.Types.Var
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig )
 import TysWiredIn ( unitTy )
 import TcType
 import GHC.Core.DataCon
 import GHC.Core.ConLike
-import Id
-import Name
-import NameSet hiding ( unitFV )
-import NameEnv
-import BasicTypes
-import SrcLoc
+import GHC.Types.Id
+import GHC.Types.Name
+import GHC.Types.Name.Set hiding ( unitFV )
+import GHC.Types.Name.Env
+import GHC.Types.Basic
+import GHC.Types.SrcLoc
 import FastString
 import Util
 import Bag
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 145b7ade55..16d64ff5ff 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -27,12 +27,12 @@ import GHC.Hs
 import TcRnTypes
 import TcRnMonad  ( finalSafeMode, fixSafeInstances )
 import TcRnDriver ( runTcInteractive )
-import Id
-import IdInfo
-import Name
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Name
 import GHC.Core.Type
 import GHC.Core.TyCon     ( tyConDataCons )
-import Avail
+import GHC.Types.Avail
 import GHC.Core
 import GHC.Core.FVs       ( exprsSomeFreeVarsList )
 import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr )
@@ -49,18 +49,18 @@ import GHC.Core.Coercion
 import TysWiredIn
 import GHC.Core.DataCon ( dataConWrapId )
 import GHC.Core.Make
-import Module
-import NameSet
-import NameEnv
+import GHC.Types.Module
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env
 import GHC.Core.Rules
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core.Op.Monad ( CoreToDo(..) )
 import GHC.Core.Lint     ( endPassIO )
-import VarSet
+import GHC.Types.Var.Set
 import FastString
 import ErrUtils
 import Outputable
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.HsToCore.Coverage
 import Util
 import MonadUtils
@@ -560,7 +560,7 @@ Note [Patching magic definitions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We sometimes need to have access to defined Ids in pure contexts. Usually, we
 simply "wire in" these entities, as we do for types in TysWiredIn and for Ids
-in MkId. See Note [Wired-in Ids] in MkId.
+in GHC.Types.Id.Make. See Note [Wired-in Ids] in GHC.Types.Id.Make.
 
 However, it is sometimes *much* easier to define entities in Haskell,
 even if we need pure access; note that wiring-in an Id requires all
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 27502bfda4..4d1dab9dc4 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -45,18 +45,18 @@ import GHC.Core.Utils
 import GHC.Core.Make
 import GHC.HsToCore.Binds (dsHsWrapper)
 
-import Id
+import GHC.Types.Id
 import GHC.Core.ConLike
 import TysWiredIn
-import BasicTypes
+import GHC.Types.Basic
 import PrelNames
 import Outputable
-import VarSet
-import SrcLoc
+import GHC.Types.Var.Set
+import GHC.Types.SrcLoc
 import ListSetOps( assocMaybe )
 import Data.List
 import Util
-import UniqDSet
+import GHC.Types.Unique.DSet
 
 data DsCmdEnv = DsCmdEnv {
         arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 3becf64ca4..8dd04c5095 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -54,24 +54,24 @@ import TcType
 import GHC.Core.Type
 import GHC.Core.Coercion
 import TysWiredIn ( typeNatKind, typeSymbolKind )
-import Id
-import MkId(proxyHashId)
-import Name
-import VarSet
+import GHC.Types.Id
+import GHC.Types.Id.Make(proxyHashId)
+import GHC.Types.Name
+import GHC.Types.Var.Set
 import GHC.Core.Rules
-import VarEnv
-import Var( EvVar )
+import GHC.Types.Var.Env
+import GHC.Types.Var( EvVar )
 import Outputable
-import Module
-import SrcLoc
+import GHC.Types.Module
+import GHC.Types.SrcLoc
 import Maybes
 import OrdList
 import Bag
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Driver.Session
 import FastString
 import Util
-import UniqSet( nonDetEltsUniqSet )
+import GHC.Types.Unique.Set( nonDetEltsUniqSet )
 import MonadUtils
 import qualified GHC.LanguageExtensions as LangExt
 import Control.Monad
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 7bb1886bff..ba15a8b8e6 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -21,26 +21,26 @@ import GHC.ByteCode.Types
 import GHC.Stack.CCS
 import GHC.Core.Type
 import GHC.Hs
-import Module
+import GHC.Types.Module as Module
 import Outputable
 import GHC.Driver.Session
 import GHC.Core.ConLike
 import Control.Monad
-import SrcLoc
+import GHC.Types.SrcLoc
 import ErrUtils
-import NameSet hiding (FreeVars)
-import Name
+import GHC.Types.Name.Set hiding (FreeVars)
+import GHC.Types.Name
 import Bag
-import CostCentre
-import CostCentreState
+import GHC.Types.CostCentre
+import GHC.Types.CostCentre.State
 import GHC.Core
-import Id
-import VarSet
+import GHC.Types.Id
+import GHC.Types.Var.Set
 import Data.List
 import FastString
 import GHC.Driver.Types
 import GHC.Core.TyCon
-import BasicTypes
+import GHC.Types.Basic
 import MonadUtils
 import Maybes
 import GHC.Cmm.CLabel
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index a34beae019..24dba94f7a 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -16,9 +16,9 @@ import GHC.Hs.Decls
 import GHC.Hs.Extension
 import GHC.Hs.Types
 import GHC.Hs.Utils
-import Name
-import NameSet
-import SrcLoc
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.SrcLoc
 import TcRnTypes
 
 import Control.Applicative
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 147da687d0..7f29491ceb 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -33,8 +33,8 @@ import GHC.HsToCore.Utils
 import GHC.HsToCore.Arrows
 import GHC.HsToCore.Monad
 import GHC.HsToCore.PmCheck ( checkGuardMatches )
-import Name
-import NameEnv
+import GHC.Types.Name
+import GHC.Types.Name.Env
 import GHC.Core.FamInstEnv( topNormaliseType )
 import GHC.HsToCore.Quote
 import GHC.Hs
@@ -50,19 +50,19 @@ import GHC.Core.Utils
 import GHC.Core.Make
 
 import GHC.Driver.Session
-import CostCentre
-import Id
-import MkId
-import Module
+import GHC.Types.CostCentre
+import GHC.Types.Id
+import GHC.Types.Id.Make
+import GHC.Types.Module
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCo.Ppr( pprWithTYPE )
 import TysWiredIn
 import PrelNames
-import BasicTypes
+import GHC.Types.Basic
 import Maybes
-import VarEnv
-import SrcLoc
+import GHC.Types.Var.Env
+import GHC.Types.SrcLoc
 import Util
 import Bag
 import Outputable
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index 2abce51649..5cbf22f92a 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -30,21 +30,21 @@ import GHC.Core
 import GHC.HsToCore.Monad
 import GHC.Core.Utils
 import GHC.Core.Make
-import MkId
-import ForeignCall
+import GHC.Types.Id.Make
+import GHC.Types.ForeignCall
 import GHC.Core.DataCon
 import GHC.HsToCore.Utils
 
 import TcType
 import GHC.Core.Type
-import Id   ( Id )
+import GHC.Types.Id   ( Id )
 import GHC.Core.Coercion
 import PrimOp
 import TysPrim
 import GHC.Core.TyCon
 import TysWiredIn
-import BasicTypes
-import Literal
+import GHC.Types.Basic
+import GHC.Types.Literal
 import PrelNames
 import GHC.Driver.Session
 import Outputable
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index 222bcc042d..8b6d9a3974 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -28,10 +28,10 @@ import GHC.HsToCore.Monad
 import GHC.Hs
 import GHC.Core.DataCon
 import GHC.Core.Unfold
-import Id
-import Literal
-import Module
-import Name
+import GHC.Types.Id
+import GHC.Types.Literal
+import GHC.Types.Module
+import GHC.Types.Name
 import GHC.Core.Type
 import GHC.Types.RepType
 import GHC.Core.TyCon
@@ -42,12 +42,12 @@ import TcType
 import GHC.Cmm.Expr
 import GHC.Cmm.Utils
 import GHC.Driver.Types
-import ForeignCall
+import GHC.Types.ForeignCall
 import TysWiredIn
 import TysPrim
 import PrelNames
-import BasicTypes
-import SrcLoc
+import GHC.Types.Basic
+import GHC.Types.SrcLoc
 import Outputable
 import FastString
 import GHC.Driver.Session
diff --git a/compiler/GHC/HsToCore/GuardedRHSs.hs b/compiler/GHC/HsToCore/GuardedRHSs.hs
index 49beaf1da4..6a8bc53313 100644
--- a/compiler/GHC/HsToCore/GuardedRHSs.hs
+++ b/compiler/GHC/HsToCore/GuardedRHSs.hs
@@ -28,7 +28,7 @@ import GHC.HsToCore.Utils
 import GHC.HsToCore.PmCheck.Types ( Deltas, initDeltas )
 import GHC.Core.Type ( Type )
 import Util
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
 import Control.Monad ( zipWithM )
 import Data.List.NonEmpty ( NonEmpty, toList )
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 1259780573..c67f1cbf64 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -28,12 +28,12 @@ import GHC.HsToCore.Utils
 
 import GHC.Driver.Session
 import GHC.Core.Utils
-import Id
+import GHC.Types.Id
 import GHC.Core.Type
 import TysWiredIn
 import GHC.HsToCore.Match
 import PrelNames
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
 import TcType
 import ListSetOps( getNth )
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 657946ffcb..dd29a08d3e 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -28,7 +28,7 @@ import GHC.Platform
 
 import {-#SOURCE#-} GHC.HsToCore.Expr (dsLExpr, dsSyntaxExpr)
 
-import BasicTypes ( Origin(..) )
+import GHC.Types.Basic ( Origin(..) )
 import GHC.Driver.Session
 import GHC.Hs
 import TcHsSyn
@@ -36,14 +36,14 @@ import TcEvidence
 import TcRnMonad
 import GHC.HsToCore.PmCheck
 import GHC.Core
-import Literal
+import GHC.Types.Literal
 import GHC.Core.Utils
 import GHC.Core.Make
 import GHC.HsToCore.Monad
 import GHC.HsToCore.Binds
 import GHC.HsToCore.GuardedRHSs
 import GHC.HsToCore.Utils
-import Id
+import GHC.Types.Id
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
@@ -53,15 +53,15 @@ import GHC.Core.Type
 import GHC.Core.Coercion ( eqCoercion )
 import GHC.Core.TyCon    ( isNewTyCon )
 import TysWiredIn
-import SrcLoc
+import GHC.Types.SrcLoc
 import Maybes
 import Util
-import Name
+import GHC.Types.Name
 import Outputable
-import BasicTypes ( isGenerated, il_value, fl_value )
+import GHC.Types.Basic ( isGenerated, il_value, fl_value )
 import FastString
-import Unique
-import UniqDFM
+import GHC.Types.Unique
+import GHC.Types.Unique.DFM
 
 import Control.Monad( unless )
 import Data.List.NonEmpty (NonEmpty(..))
diff --git a/compiler/GHC/HsToCore/Match.hs-boot b/compiler/GHC/HsToCore/Match.hs-boot
index 6dd7729935..f1381707c8 100644
--- a/compiler/GHC/HsToCore/Match.hs-boot
+++ b/compiler/GHC/HsToCore/Match.hs-boot
@@ -1,10 +1,10 @@
 module GHC.HsToCore.Match where
 
 import GhcPrelude
-import Var      ( Id )
+import GHC.Types.Var ( Id )
 import TcType   ( Type )
-import GHC.HsToCore.Monad  ( DsM, EquationInfo, MatchResult )
-import GHC.Core  ( CoreExpr )
+import GHC.HsToCore.Monad ( DsM, EquationInfo, MatchResult )
+import GHC.Core ( CoreExpr )
 import GHC.Hs   ( LPat, HsMatchContext, MatchGroup, LHsExpr )
 import GHC.Hs.Extension ( GhcRn, GhcTc )
 
diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs
index cae2dababd..f46780aee2 100644
--- a/compiler/GHC/HsToCore/Match/Constructor.hs
+++ b/compiler/GHC/HsToCore/Match/Constructor.hs
@@ -23,16 +23,16 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( match )
 import GHC.Hs
 import GHC.HsToCore.Binds
 import GHC.Core.ConLike
-import BasicTypes ( Origin(..) )
+import GHC.Types.Basic ( Origin(..) )
 import TcType
 import GHC.HsToCore.Monad
 import GHC.HsToCore.Utils
 import GHC.Core.Make ( mkCoreLets )
 import Util
-import Id
-import NameEnv
-import FieldLabel ( flSelector )
-import SrcLoc
+import GHC.Types.Id
+import GHC.Types.Name.Env
+import GHC.Types.FieldLabel ( flSelector )
+import GHC.Types.SrcLoc
 import Outputable
 import Control.Monad(liftM)
 import Data.List (groupBy)
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index 5a5ef53655..4946c7b2ad 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -34,23 +34,23 @@ import GHC.HsToCore.Utils
 
 import GHC.Hs
 
-import Id
+import GHC.Types.Id
 import GHC.Core
 import GHC.Core.Make
 import GHC.Core.TyCon
 import GHC.Core.DataCon
 import TcHsSyn ( shortCutLit )
 import TcType
-import Name
+import GHC.Types.Name
 import GHC.Core.Type
 import PrelNames
 import TysWiredIn
 import TysPrim
-import Literal
-import SrcLoc
+import GHC.Types.Literal
+import GHC.Types.SrcLoc
 import Data.Ratio
 import Outputable
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Driver.Session
 import Util
 import FastString
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index bded17de2f..cd271b3abf 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -63,28 +63,28 @@ import GHC.Hs
 import GHC.IfaceToCore
 import TcMType ( checkForLevPolyX, formatLevPolyErr )
 import PrelNames
-import RdrName
+import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import Bag
-import BasicTypes ( Origin )
+import GHC.Types.Basic ( Origin )
 import GHC.Core.DataCon
 import GHC.Core.ConLike
 import GHC.Core.TyCon
 import GHC.HsToCore.PmCheck.Types
-import Id
-import Module
+import GHC.Types.Id
+import GHC.Types.Module
 import Outputable
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Core.Type
-import UniqSupply
-import Name
-import NameEnv
+import GHC.Types.Unique.Supply
+import GHC.Types.Name
+import GHC.Types.Name.Env
 import GHC.Driver.Session
 import ErrUtils
 import FastString
-import UniqFM ( lookupWithDefaultUFM )
-import Literal ( mkLitString )
-import CostCentreState
+import GHC.Types.Unique.FM ( lookupWithDefaultUFM )
+import GHC.Types.Literal ( mkLitString )
+import GHC.Types.CostCentre.State
 
 import Data.IORef
 
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index ee1c0d8062..327b0525b0 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -27,23 +27,23 @@ import GhcPrelude
 import GHC.HsToCore.PmCheck.Types
 import GHC.HsToCore.PmCheck.Oracle
 import GHC.HsToCore.PmCheck.Ppr
-import BasicTypes (Origin, isGenerated)
+import GHC.Types.Basic (Origin, isGenerated)
 import GHC.Core (CoreExpr, Expr(Var,App))
 import FastString (unpackFS, lengthFS)
 import GHC.Driver.Session
 import GHC.Hs
 import TcHsSyn   ( shortCutLit )
-import Id
+import GHC.Types.Id
 import GHC.Core.ConLike
-import Name
+import GHC.Types.Name
 import FamInst
 import TysWiredIn
-import SrcLoc
+import GHC.Types.SrcLoc
 import Util
 import Outputable
 import GHC.Core.DataCon
 import GHC.Core.TyCon
-import Var (EvVar)
+import GHC.Types.Var (EvVar)
 import GHC.Core.Coercion
 import TcEvidence ( HsWrapper(..), isIdHsWrapper )
 import TcType (evVarPred)
diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
index 3c7884d7a0..67d10628dc 100644
--- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
@@ -34,23 +34,23 @@ import Outputable
 import ErrUtils
 import Util
 import Bag
-import UniqSet
-import UniqDSet
-import Unique
-import Id
-import VarEnv
-import UniqDFM
-import Var           (EvVar)
-import Name
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.DSet
+import GHC.Types.Unique
+import GHC.Types.Id
+import GHC.Types.Var.Env
+import GHC.Types.Unique.DFM
+import GHC.Types.Var      (EvVar)
+import GHC.Types.Name
 import GHC.Core
 import GHC.Core.FVs       (exprFreeVars)
 import GHC.Core.Map
 import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe)
 import GHC.Core.Utils     (exprType)
 import GHC.Core.Make      (mkListExpr, mkCharExpr)
-import UniqSupply
+import GHC.Types.Unique.Supply
 import FastString
-import SrcLoc
+import GHC.Types.SrcLoc
 import Maybes
 import GHC.Core.ConLike
 import GHC.Core.DataCon
diff --git a/compiler/GHC/HsToCore/PmCheck/Ppr.hs b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
index 7ea416bde9..2f62b5e9be 100644
--- a/compiler/GHC/HsToCore/PmCheck/Ppr.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
@@ -12,10 +12,10 @@ module GHC.HsToCore.PmCheck.Ppr (
 
 import GhcPrelude
 
-import BasicTypes
-import Id
-import VarEnv
-import UniqDFM
+import GHC.Types.Basic
+import GHC.Types.Id
+import GHC.Types.Var.Env
+import GHC.Types.Unique.DFM
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import TysWiredIn
diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs b/compiler/GHC/HsToCore/PmCheck/Types.hs
index 08f31c9f13..75652ac2b6 100644
--- a/compiler/GHC/HsToCore/PmCheck/Types.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Types.hs
@@ -44,12 +44,12 @@ import GhcPrelude
 import Util
 import Bag
 import FastString
-import Var (EvVar)
-import Id
-import VarEnv
-import UniqDSet
-import UniqDFM
-import Name
+import GHC.Types.Var (EvVar)
+import GHC.Types.Id
+import GHC.Types.Var.Env
+import GHC.Types.Unique.DSet
+import GHC.Types.Unique.DFM
+import GHC.Types.Name
 import GHC.Core.DataCon
 import GHC.Core.ConLike
 import Outputable
@@ -57,7 +57,7 @@ import ListSetOps (unionLists)
 import Maybes
 import GHC.Core.Type
 import GHC.Core.TyCon
-import Literal
+import GHC.Types.Literal
 import GHC.Core
 import GHC.Core.Map
 import GHC.Core.Utils (exprType)
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 06ea9e307f..4de99748e5 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -38,31 +38,26 @@ import qualified Language.Haskell.TH as TH
 
 import GHC.Hs
 import PrelNames
--- To avoid clashes with GHC.HsToCore.Quote.varName we must make a local alias
--- for OccName.varName. We do this by removing varName from the import of OccName
--- above, making a qualified instance of OccName and using OccNameAlias.varName
--- where varName ws previously used in this file.
-import qualified OccName( isDataOcc, isVarOcc, isTcOcc )
-
-import Module
-import Id
-import Name hiding( isVarOcc, isTcOcc, varName, tcName )
+
+import GHC.Types.Module
+import GHC.Types.Id
+import GHC.Types.Name hiding( varName, tcName )
 import THNames
-import NameEnv
+import GHC.Types.Name.Env
 import TcType
 import GHC.Core.TyCon
 import TysWiredIn
 import GHC.Core
 import GHC.Core.Make
 import GHC.Core.Utils
-import SrcLoc
-import Unique
-import BasicTypes
+import GHC.Types.SrcLoc as SrcLoc
+import GHC.Types.Unique
+import GHC.Types.Basic
 import Outputable
 import Bag
 import GHC.Driver.Session
 import FastString
-import ForeignCall
+import GHC.Types.ForeignCall
 import Util
 import Maybes
 import MonadUtils
@@ -72,7 +67,7 @@ import Control.Monad.Trans.Class
 import GHC.Core.Class
 import GHC.Driver.Types ( MonadThings )
 import GHC.Core.DataCon
-import Var
+import GHC.Types.Var
 import GHC.HsToCore.Binds
 
 import GHC.TypeLits
@@ -2105,10 +2100,10 @@ globalVar name
       name_mod = moduleNameString (moduleName mod)
       name_pkg = unitIdString (moduleUnitId mod)
       name_occ = nameOccName name
-      mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
-              | OccName.isVarOcc  name_occ = mkNameG_vName
-              | OccName.isTcOcc   name_occ = mkNameG_tcName
-              | otherwise                  = pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name)
+      mk_varg | isDataOcc name_occ = mkNameG_dName
+              | isVarOcc  name_occ = mkNameG_vName
+              | isTcOcc   name_occ = mkNameG_tcName
+              | otherwise          = pprPanic "GHC.HsToCore.Quote.globalVar" (ppr name)
 
 lookupType :: Name      -- Name of type constructor (e.g. (M TH.Exp))
            -> MetaM Type  -- The type
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 1eb6079c1e..26e708dded 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -17,13 +17,13 @@ import GHC.Driver.Session
 import GHC.Driver.Ways
 import GHC.Driver.Types
 import TcRnTypes
-import Name
-import NameSet
-import Module
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Module
 import Outputable
 import Util
-import UniqSet
-import UniqFM
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
 import Fingerprint
 import Maybes
 import GHC.Driver.Packages
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 0b80959f09..f7889e01ae 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -57,9 +57,9 @@ import GHC.HsToCore.Monad
 
 import GHC.Core.Utils
 import GHC.Core.Make
-import MkId
-import Id
-import Literal
+import GHC.Types.Id.Make
+import GHC.Types.Id
+import GHC.Types.Literal
 import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
@@ -67,15 +67,15 @@ import GHC.Core.Type
 import GHC.Core.Coercion
 import TysPrim
 import TysWiredIn
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core.ConLike
-import UniqSet
-import UniqSupply
-import Module
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.Supply
+import GHC.Types.Module
 import PrelNames
-import Name( isInternalName )
+import GHC.Types.Name( isInternalName )
 import Outputable
-import SrcLoc
+import GHC.Types.SrcLoc
 import Util
 import GHC.Driver.Session
 import FastString
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index c4ddfa2ece..cc8472e040 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -39,19 +39,19 @@ import TcRnMonad
 import PrelInfo   ( isKnownKeyName, lookupKnownKeyName )
 import GHC.Iface.Env
 import GHC.Driver.Types
-import Module
-import Name
+import GHC.Types.Module
+import GHC.Types.Name
 import GHC.Driver.Session
-import UniqFM
-import UniqSupply
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
 import Panic
 import Binary
-import SrcLoc
+import GHC.Types.SrcLoc
 import ErrUtils
 import FastMutInt
-import Unique
+import GHC.Types.Unique
 import Outputable
-import NameCache
+import GHC.Types.Name.Cache
 import GHC.Platform
 import FastString
 import Constants
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index f7cea99b94..8b12f50345 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -27,16 +27,16 @@ import GhcPrelude
 import TcRnMonad
 import GHC.Driver.Types
 import GHC.Core.Type
-import Var
-import Name
-import Avail
-import Module
+import GHC.Types.Var
+import GHC.Types.Name
+import GHC.Types.Avail
+import GHC.Types.Module
 import FastString
 import FastStringEnv
 import GHC.Iface.Type
-import NameCache
-import UniqSupply
-import SrcLoc
+import GHC.Types.Name.Cache
+import GHC.Types.Unique.Supply
+import GHC.Types.SrcLoc
 
 import Outputable
 import Data.List     ( partition )
@@ -48,7 +48,7 @@ import Data.List     ( partition )
 *                                                      *
 *********************************************************
 
-See Also: Note [The Name Cache] in NameCache
+See Also: Note [The Name Cache] in GHC.Types.Name.Cache
 -}
 
 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
diff --git a/compiler/GHC/Iface/Env.hs-boot b/compiler/GHC/Iface/Env.hs-boot
index 2c326ab0ad..34d9a29960 100644
--- a/compiler/GHC/Iface/Env.hs-boot
+++ b/compiler/GHC/Iface/Env.hs-boot
@@ -1,9 +1,9 @@
 module GHC.Iface.Env where
 
-import Module
-import OccName
+import GHC.Types.Module
+import GHC.Types.Name.Occurrence
 import TcRnMonad
-import Name
-import SrcLoc
+import GHC.Types.Name
+import GHC.Types.SrcLoc
 
 newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index d726a15c7b..a1f9a3cf32 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -18,26 +18,26 @@ module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) wh
 
 import GhcPrelude
 
-import Avail                      ( Avails )
+import GHC.Types.Avail            ( Avails )
 import Bag                        ( Bag, bagToList )
-import BasicTypes
+import GHC.Types.Basic
 import BooleanFormula
 import GHC.Core.Class             ( FunDep )
 import GHC.Core.Utils             ( exprType )
 import GHC.Core.ConLike           ( conLikeName )
 import GHC.HsToCore               ( deSugarExpr )
-import FieldLabel
+import GHC.Types.FieldLabel
 import GHC.Hs
 import GHC.Driver.Types
-import Module                     ( ModuleName, ml_hs_file )
+import GHC.Types.Module           ( ModuleName, ml_hs_file )
 import MonadUtils                 ( concatMapM, liftIO )
-import Name                       ( Name, nameSrcSpan, setNameLoc )
-import NameEnv                    ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
-import SrcLoc
+import GHC.Types.Name             ( Name, nameSrcSpan, setNameLoc )
+import GHC.Types.Name.Env         ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
+import GHC.Types.SrcLoc
 import TcHsSyn                    ( hsLitType, hsPatType )
 import GHC.Core.Type              ( mkVisFunTys, Type )
 import TysWiredIn                 ( mkListTy, mkSumTy )
-import Var                        ( Id, Var, setVarName, varName, varType )
+import GHC.Types.Var              ( Id, Var, setVarName, varName, varType )
 import TcRnTypes
 import GHC.Iface.Make             ( mkIfaceExports )
 import Panic
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index d89a346d9f..1a231b95f7 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -23,15 +23,15 @@ import Binary
 import GHC.Iface.Binary           ( getDictFastString )
 import FastMutInt
 import FastString                 ( FastString )
-import Module                     ( Module )
-import Name
-import NameCache
+import GHC.Types.Module           ( Module )
+import GHC.Types.Name
+import GHC.Types.Name.Cache
 import Outputable
 import PrelInfo
-import SrcLoc
-import UniqSupply                 ( takeUniqFromSupply )
-import Unique
-import UniqFM
+import GHC.Types.SrcLoc as SrcLoc
+import GHC.Types.Unique.Supply    ( takeUniqFromSupply )
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
 import Util
 
 import qualified Data.Array as A
diff --git a/compiler/GHC/Iface/Ext/Debug.hs b/compiler/GHC/Iface/Ext/Debug.hs
index 25cc940834..e28f7ab03d 100644
--- a/compiler/GHC/Iface/Ext/Debug.hs
+++ b/compiler/GHC/Iface/Ext/Debug.hs
@@ -9,15 +9,15 @@ module GHC.Iface.Ext.Debug where
 
 import GhcPrelude
 
-import SrcLoc
-import Module
+import GHC.Types.SrcLoc
+import GHC.Types.Module
 import FastString
 import Outputable
 
 import GHC.Iface.Ext.Types
 import GHC.Iface.Ext.Binary
 import GHC.Iface.Ext.Utils
-import Name
+import GHC.Types.Name
 
 import qualified Data.Map as M
 import qualified Data.Set as S
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index e56864bc04..3f87a91d34 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -16,11 +16,11 @@ import Config
 import Binary
 import FastString                 ( FastString )
 import GHC.Iface.Type
-import Module                     ( ModuleName, Module )
-import Name                       ( Name )
+import GHC.Types.Module           ( ModuleName, Module )
+import GHC.Types.Name             ( Name )
 import Outputable hiding ( (<>) )
-import SrcLoc                     ( RealSrcSpan )
-import Avail
+import GHC.Types.SrcLoc           ( RealSrcSpan )
+import GHC.Types.Avail
 
 import qualified Data.Array as A
 import qualified Data.Map as M
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 2caffe56b3..bbbe1084f1 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -10,15 +10,15 @@ import GHC.Core.Map
 import GHC.Driver.Session         ( DynFlags )
 import FastString                 ( FastString, mkFastString )
 import GHC.Iface.Type
-import Name hiding (varName)
+import GHC.Types.Name hiding (varName)
 import Outputable                 ( renderWithStyle, ppr, defaultUserStyle, initSDocContext )
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.CoreToIface
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
-import Var
-import VarEnv
+import GHC.Types.Var
+import GHC.Types.Var.Env
 
 import GHC.Iface.Ext.Types
 
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 7858fc6ce4..9bc073b6a9 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -45,29 +45,29 @@ import GHC.Iface.Syntax
 import GHC.Iface.Env
 import GHC.Driver.Types
 
-import BasicTypes hiding (SuccessFlag(..))
+import GHC.Types.Basic hiding (SuccessFlag(..))
 import TcRnMonad
 
 import Constants
 import PrelNames
 import PrelInfo
 import PrimOp   ( allThePrimOps, primOpFixity, primOpOcc )
-import MkId     ( seqId )
+import GHC.Types.Id.Make ( seqId )
 import TysPrim  ( funTyConName )
 import GHC.Core.Rules
 import GHC.Core.TyCon
-import Annotations
+import GHC.Types.Annotations
 import GHC.Core.InstEnv
 import GHC.Core.FamInstEnv
-import Name
-import NameEnv
-import Avail
-import Module
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Avail
+import GHC.Types.Module
 import Maybes
 import ErrUtils
 import GHC.Driver.Finder
-import UniqFM
-import SrcLoc
+import GHC.Types.Unique.FM
+import GHC.Types.SrcLoc
 import Outputable
 import GHC.Iface.Binary
 import Panic
@@ -75,9 +75,9 @@ import Util
 import FastString
 import Fingerprint
 import GHC.Driver.Hooks
-import FieldLabel
+import GHC.Types.FieldLabel
 import GHC.Iface.Rename
-import UniqDSet
+import GHC.Types.Unique.DSet
 import GHC.Driver.Plugins
 
 import Control.Monad
diff --git a/compiler/GHC/Iface/Load.hs-boot b/compiler/GHC/Iface/Load.hs-boot
index a2af2a1a9a..7718eb99f3 100644
--- a/compiler/GHC/Iface/Load.hs-boot
+++ b/compiler/GHC/Iface/Load.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Iface.Load where
 
-import Module (Module)
+import GHC.Types.Module (Module)
 import TcRnMonad (IfM)
 import GHC.Driver.Types (ModIface)
 import Outputable (SDoc)
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index f903892f9a..5cf6aa5f27 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -29,8 +29,8 @@ import GHC.Iface.Load
 import GHC.CoreToIface
 
 import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames, mkDependencies )
-import Id
-import Annotations
+import GHC.Types.Id
+import GHC.Types.Annotations
 import GHC.Core
 import GHC.Core.Class
 import GHC.Core.TyCon
@@ -45,17 +45,17 @@ import TcRnMonad
 import GHC.Hs
 import GHC.Driver.Types
 import GHC.Driver.Session
-import VarEnv
-import Var
-import Name
-import Avail
-import RdrName
-import NameEnv
-import NameSet
-import Module
+import GHC.Types.Var.Env
+import GHC.Types.Var
+import GHC.Types.Name
+import GHC.Types.Avail
+import GHC.Types.Name.Reader
+import GHC.Types.Name.Env
+import GHC.Types.Name.Set
+import GHC.Types.Module
 import ErrUtils
 import Outputable
-import BasicTypes       hiding ( SuccessFlag(..) )
+import GHC.Types.Basic  hiding ( SuccessFlag(..) )
 import Util             hiding ( eqListBy )
 import FastString
 import Maybes
@@ -228,7 +228,7 @@ mkIface_ hsc_env
           [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
           -- The order of fixities returned from nameEnvElts is not
           -- deterministic, so we sort by OccName to canonicalize it.
-          -- See Note [Deterministic UniqFM] in UniqDFM for more details.
+          -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for more details.
         warns       = src_warns
         iface_rules = map coreRuleToIfaceRule rules
         iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 0890c6ffa0..12830ab20e 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -19,27 +19,27 @@ import BinFingerprint
 import GHC.Iface.Load
 import FlagChecker
 
-import Annotations
+import GHC.Types.Annotations
 import GHC.Core
 import TcRnMonad
 import GHC.Hs
 import GHC.Driver.Types
 import GHC.Driver.Finder
 import GHC.Driver.Session
-import Name
-import NameSet
-import Module
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Module
 import ErrUtils
 import Digraph
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
-import Unique
+import GHC.Types.Unique
 import Util             hiding ( eqListBy )
 import Maybes
 import Binary
 import Fingerprint
 import Exception
-import UniqSet
+import GHC.Types.Unique.Set
 import GHC.Driver.Packages
 
 import Control.Monad
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 83632434bd..5d084155db 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -19,22 +19,22 @@ module GHC.Iface.Rename (
 
 import GhcPrelude
 
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
 import GHC.Driver.Types
-import Module
-import UniqFM
-import Avail
+import GHC.Types.Module
+import GHC.Types.Unique.FM
+import GHC.Types.Avail
 import GHC.Iface.Syntax
-import FieldLabel
-import Var
+import GHC.Types.FieldLabel
+import GHC.Types.Var
 import ErrUtils
 
-import Name
+import GHC.Types.Name
 import TcRnMonad
 import Util
 import Fingerprint
-import BasicTypes
+import GHC.Types.Basic
 
 -- a bit vexing
 import {-# SOURCE #-} GHC.Iface.Load
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 1812c34d6b..1f82ccfc7f 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -47,29 +47,29 @@ import GhcPrelude
 import GHC.Iface.Type
 import BinFingerprint
 import GHC.Core( IsOrphan, isOrphan )
-import Demand
-import Cpr
+import GHC.Types.Demand
+import GHC.Types.Cpr
 import GHC.Core.Class
-import FieldLabel
-import NameSet
+import GHC.Types.FieldLabel
+import GHC.Types.Name.Set
 import GHC.Core.Coercion.Axiom ( BranchIndex )
-import Name
-import CostCentre
-import Literal
-import ForeignCall
-import Annotations( AnnPayload, AnnTarget )
-import BasicTypes
+import GHC.Types.Name
+import GHC.Types.CostCentre
+import GHC.Types.Literal
+import GHC.Types.ForeignCall
+import GHC.Types.Annotations( AnnPayload, AnnTarget )
+import GHC.Types.Basic
 import Outputable
-import Module
-import SrcLoc
+import GHC.Types.Module
+import GHC.Types.SrcLoc
 import Fingerprint
 import Binary
 import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
-import Var( VarBndr(..), binderVar )
+import GHC.Types.Var( VarBndr(..), binderVar )
 import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
 import Util( dropList, filterByList, notNull, unzipWith, debugIsOn )
 import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
-import Lexeme (isLexSym)
+import GHC.Utils.Lexeme (isLexSym)
 import TysWiredIn ( constraintKindTyConName )
 import Util (seqList)
 
@@ -262,7 +262,7 @@ data IfaceConDecl
         ifConStricts :: [IfaceBang],
           -- Empty (meaning all lazy),
           -- or 1-1 corresp with arg tys
-          -- See Note [Bangs on imported data constructors] in MkId
+          -- See Note [Bangs on imported data constructors] in GHC.Types.Id.Make
         ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts
 
 type IfaceEqSpec = [(IfLclName,IfaceType)]
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index b3fd56c4d2..6459902a52 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -31,31 +31,31 @@ import GHC.Core.PatSyn
 import GHC.Core.ConLike
 import GHC.Core.Arity   ( exprArity, exprBotStrictness_maybe )
 import StaticPtrTable
-import VarEnv
-import VarSet
-import Var
-import Id
-import MkId             ( mkDictSelRhs )
-import IdInfo
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
+import GHC.Types.Var
+import GHC.Types.Id
+import GHC.Types.Id.Make ( mkDictSelRhs )
+import GHC.Types.Id.Info
 import GHC.Core.InstEnv
-import GHC.Core.Type    ( tidyTopType )
-import Demand           ( appIsBottom, isTopSig, isBottomingSig )
-import Cpr              ( mkCprSig, botCpr )
-import BasicTypes
-import Name hiding (varName)
-import NameSet
-import NameCache
-import Avail
+import GHC.Core.Type     ( tidyTopType )
+import GHC.Types.Demand  ( appIsBottom, isTopSig, isBottomingSig )
+import GHC.Types.Cpr     ( mkCprSig, botCpr )
+import GHC.Types.Basic
+import GHC.Types.Name hiding (varName)
+import GHC.Types.Name.Set
+import GHC.Types.Name.Cache
+import GHC.Types.Avail
 import GHC.Iface.Env
 import TcEnv
 import TcRnMonad
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Core.Class
-import Module
+import GHC.Types.Module
 import GHC.Driver.Types
 import Maybes
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Outputable
 import Util( filterOut )
 import qualified ErrUtils as Err
@@ -581,7 +581,7 @@ getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc
 
 getTyConImplicitBinds :: TyCon -> [CoreBind]
 getTyConImplicitBinds tc
-  | isNewTyCon tc = []  -- See Note [Compulsory newtype unfolding] in MkId
+  | isNewTyCon tc = []  -- See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make
   | otherwise     = map get_defn (mapMaybe dataConWrapId_maybe (tyConDataCons tc))
 
 getClassImplicitBinds :: Class -> [CoreBind]
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 8b154248ab..85b1a19f40 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -68,10 +68,10 @@ import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy )
 
 import GHC.Core.TyCon hiding ( pprPromotionQuote )
 import GHC.Core.Coercion.Axiom
-import Var
+import GHC.Types.Var
 import PrelNames
-import Name
-import BasicTypes
+import GHC.Types.Name
+import GHC.Types.Basic
 import Binary
 import Outputable
 import FastString
@@ -119,7 +119,7 @@ ifaceBndrType (IfaceTvBndr (_, t)) = t
 type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
 
 data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
-  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId
+  = IfaceNoOneShot   -- and Note [The oneShot function] in GHC.Types.Id.Make
   | IfaceOneShot
 
 
diff --git a/compiler/GHC/Iface/Type.hs-boot b/compiler/GHC/Iface/Type.hs-boot
index 30a0033c86..3876cb0618 100644
--- a/compiler/GHC/Iface/Type.hs-boot
+++ b/compiler/GHC/Iface/Type.hs-boot
@@ -4,7 +4,7 @@ module GHC.Iface.Type
    )
 where
 
-import Var (VarBndr, ArgFlag)
+import GHC.Types.Var (VarBndr, ArgFlag)
 
 data IfaceAppArgs
 
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index df2457cd62..0024d92037 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -39,7 +39,7 @@ import GHC.Core.Coercion.Axiom
 import GHC.Core.TyCo.Rep    -- needs to build types & coercions in a knot
 import GHC.Core.TyCo.Subst ( substTyCoVars )
 import GHC.Driver.Types
-import Annotations
+import GHC.Types.Annotations
 import GHC.Core.InstEnv
 import GHC.Core.FamInstEnv
 import GHC.Core
@@ -47,33 +47,33 @@ import GHC.Core.Utils
 import GHC.Core.Unfold
 import GHC.Core.Lint
 import GHC.Core.Make
-import Id
-import MkId
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Make
+import GHC.Types.Id.Info
 import GHC.Core.Class
 import GHC.Core.TyCon
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import PrelNames
 import TysWiredIn
-import Literal
-import Var
-import VarSet
-import Name
-import NameEnv
-import NameSet
+import GHC.Types.Literal
+import GHC.Types.Var as Var
+import GHC.Types.Var.Set
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Name.Set
 import GHC.Core.Op.OccurAnal ( occurAnalyseExpr )
-import Demand
-import Module
-import UniqFM
-import UniqSupply
+import GHC.Types.Demand
+import GHC.Types.Module
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Supply
 import Outputable
 import Maybes
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Driver.Session
 import Util
 import FastString
-import BasicTypes hiding ( SuccessFlag(..) )
+import GHC.Types.Basic hiding ( SuccessFlag(..) )
 import ListSetOps
 import GHC.Fingerprint
 import qualified BooleanFormula as BF
@@ -963,7 +963,7 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
                        -- decisions) to buildDataCon; it'll use
                        -- these to guide the construction of a
                        -- worker.
-                       -- See Note [Bangs on imported data constructors] in MkId
+                       -- See Note [Bangs on imported data constructors] in GHC.Types.Id.Make
                        lbl_names
                        univ_tvs ex_tvs user_tv_bndrs
                        eq_spec theta
@@ -1384,13 +1384,13 @@ tcIfaceTickish (IfaceSource src name)   = return (SourceNote src name)
 tcIfaceLit :: Literal -> IfL Literal
 -- Integer literals deserialise to (LitInteger i <error thunk>)
 -- so tcIfaceLit just fills in the type.
--- See Note [Integer literals] in Literal
+-- See Note [Integer literals] in GHC.Types.Literal
 tcIfaceLit (LitNumber LitNumInteger i _)
   = do t <- tcIfaceTyConByName integerTyConName
        return (mkLitInteger i (mkTyConTy t))
 -- Natural literals deserialise to (LitNatural i <error thunk>)
 -- so tcIfaceLit just fills in the type.
--- See Note [Natural literals] in Literal
+-- See Note [Natural literals] in GHC.Types.Literal
 tcIfaceLit (LitNumber LitNumNatural i _)
   = do t <- tcIfaceTyConByName naturalTyConName
        return (mkLitNatural i (mkTyConTy t))
diff --git a/compiler/GHC/IfaceToCore.hs-boot b/compiler/GHC/IfaceToCore.hs-boot
index 32e13c80d1..b1e08e2e01 100644
--- a/compiler/GHC/IfaceToCore.hs-boot
+++ b/compiler/GHC/IfaceToCore.hs-boot
@@ -9,7 +9,7 @@ import GHC.Core.InstEnv    ( ClsInst )
 import GHC.Core.FamInstEnv ( FamInst )
 import GHC.Core         ( CoreRule )
 import GHC.Driver.Types ( CompleteMatch )
-import Annotations      ( Annotation )
+import GHC.Types.Annotations ( Annotation )
 
 tcIfaceDecl         :: Bool -> IfaceDecl -> IfL TyThing
 tcIfaceRules        :: Bool -> [IfaceRule] -> IfL [CoreRule]
diff --git a/compiler/GHC/Llvm/Ppr.hs b/compiler/GHC/Llvm/Ppr.hs
index b7c3564240..4645c89e1a 100644
--- a/compiler/GHC/Llvm/Ppr.hs
+++ b/compiler/GHC/Llvm/Ppr.hs
@@ -34,7 +34,7 @@ import GHC.Platform
 
 import Data.List ( intersperse )
 import Outputable
-import Unique
+import GHC.Types.Unique
 import FastString ( sLit )
 
 --------------------------------------------------------------------------------
diff --git a/compiler/GHC/Llvm/Syntax.hs b/compiler/GHC/Llvm/Syntax.hs
index d048215a0b..51324b396d 100644
--- a/compiler/GHC/Llvm/Syntax.hs
+++ b/compiler/GHC/Llvm/Syntax.hs
@@ -9,7 +9,7 @@ import GhcPrelude
 import GHC.Llvm.MetaData
 import GHC.Llvm.Types
 
-import Unique
+import GHC.Types.Unique
 
 -- | Block labels
 type LlvmBlockId = Unique
diff --git a/compiler/GHC/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs
index e8b4bc283a..a52e05faac 100644
--- a/compiler/GHC/Llvm/Types.hs
+++ b/compiler/GHC/Llvm/Types.hs
@@ -19,7 +19,7 @@ import GHC.Platform
 import GHC.Driver.Session
 import FastString
 import Outputable
-import Unique
+import GHC.Types.Unique
 
 -- from NCG
 import GHC.CmmToAsm.Ppr
diff --git a/compiler/GHC/Platform/Reg.hs b/compiler/GHC/Platform/Reg.hs
index b856d7c3af..00cd254630 100644
--- a/compiler/GHC/Platform/Reg.hs
+++ b/compiler/GHC/Platform/Reg.hs
@@ -29,7 +29,7 @@ where
 import GhcPrelude
 
 import Outputable
-import Unique
+import GHC.Types.Unique
 import GHC.Platform.Reg.Class
 import Data.List (intersect)
 
diff --git a/compiler/GHC/Platform/Reg/Class.hs b/compiler/GHC/Platform/Reg/Class.hs
index 225ad05be5..8aa81c2fe9 100644
--- a/compiler/GHC/Platform/Reg/Class.hs
+++ b/compiler/GHC/Platform/Reg/Class.hs
@@ -6,8 +6,8 @@ where
 
 import GhcPrelude
 
-import  Outputable
-import  Unique
+import Outputable
+import GHC.Types.Unique
 
 
 -- | The class of a register.
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index 05278f7da1..2e342100bf 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -7,39 +7,67 @@
 --
 -- Particularly interesting modules for plugin writers include
 -- "GHC.Core" and "GHC.Core.Op.Monad".
-module GHC.Plugins(
-        module GHC.Driver.Plugins,
-        module RdrName, module OccName, module Name, module Var, module Id, module IdInfo,
-        module GHC.Core.Op.Monad, module GHC.Core, module Literal, module GHC.Core.DataCon,
-        module GHC.Core.Utils, module GHC.Core.Make, module GHC.Core.FVs,
-        module GHC.Core.Subst, module GHC.Core.Rules, module Annotations,
-        module GHC.Driver.Session, module GHC.Driver.Packages,
-        module Module, module GHC.Core.Type, module GHC.Core.TyCon, module GHC.Core.Coercion,
-        module TysWiredIn, module GHC.Driver.Types, module BasicTypes,
-        module VarSet, module VarEnv, module NameSet, module NameEnv,
-        module UniqSet, module UniqFM, module FiniteMap,
-        module Util, module GHC.Serialized, module SrcLoc, module Outputable,
-        module UniqSupply, module Unique, module FastString,
-
-        -- * Getting 'Name's
-        thNameToGhcName
-    ) where
+module GHC.Plugins
+   ( module GHC.Driver.Plugins
+   , module GHC.Types.Name.Reader
+   , module GHC.Types.Name.Occurrence
+   , module GHC.Types.Name
+   , module GHC.Types.Var
+   , module GHC.Types.Id
+   , module GHC.Types.Id.Info
+   , module GHC.Core.Op.Monad
+   , module GHC.Core
+   , module GHC.Types.Literal
+   , module GHC.Core.DataCon
+   , module GHC.Core.Utils
+   , module GHC.Core.Make
+   , module GHC.Core.FVs
+   , module GHC.Core.Subst
+   , module GHC.Core.Rules
+   , module GHC.Types.Annotations
+   , module GHC.Driver.Session
+   , module GHC.Driver.Packages
+   , module GHC.Types.Module
+   , module GHC.Core.Type
+   , module GHC.Core.TyCon
+   , module GHC.Core.Coercion
+   , module TysWiredIn
+   , module GHC.Driver.Types
+   , module GHC.Types.Basic
+   , module GHC.Types.Var.Set
+   , module GHC.Types.Var.Env
+   , module GHC.Types.Name.Set
+   , module GHC.Types.Name.Env
+   , module GHC.Types.Unique
+   , module GHC.Types.Unique.Set
+   , module GHC.Types.Unique.FM
+   , module FiniteMap
+   , module Util
+   , module GHC.Serialized
+   , module GHC.Types.SrcLoc
+   , module Outputable
+   , module GHC.Types.Unique.Supply
+   , module FastString
+   , -- * Getting 'Name's
+     thNameToGhcName
+   )
+where
 
 -- Plugin stuff itself
 import GHC.Driver.Plugins
 
 -- Variable naming
-import RdrName
-import OccName  hiding  ( varName {- conflicts with Var.varName -} )
-import Name     hiding  ( varName {- reexport from OccName, conflicts with Var.varName -} )
-import Var
-import Id       hiding  ( lazySetIdInfo, setIdExported, setIdNotExported {- all three conflict with Var -} )
-import IdInfo
+import GHC.Types.Name.Reader
+import GHC.Types.Name.Occurrence  hiding  ( varName {- conflicts with Var.varName -} )
+import GHC.Types.Name     hiding  ( varName {- reexport from OccName, conflicts with Var.varName -} )
+import GHC.Types.Var
+import GHC.Types.Id       hiding  ( lazySetIdInfo, setIdExported, setIdNotExported {- all three conflict with Var -} )
+import GHC.Types.Id.Info
 
 -- Core
 import GHC.Core.Op.Monad
 import GHC.Core
-import Literal
+import GHC.Types.Literal
 import GHC.Core.DataCon
 import GHC.Core.Utils
 import GHC.Core.Make
@@ -49,14 +77,14 @@ import GHC.Core.Subst hiding( substTyVarBndr, substCoVarBndr, extendCvSubst )
 
 -- Core "extras"
 import GHC.Core.Rules
-import Annotations
+import GHC.Types.Annotations
 
 -- Pipeline-related stuff
 import GHC.Driver.Session
 import GHC.Driver.Packages
 
 -- Important GHC types
-import Module
+import GHC.Types.Module
 import GHC.Core.Type hiding {- conflict with GHC.Core.Subst -}
                 ( substTy, extendTvSubst, extendTvSubstList, isInScope )
 import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -}
@@ -64,15 +92,15 @@ import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -}
 import GHC.Core.TyCon
 import TysWiredIn
 import GHC.Driver.Types
-import BasicTypes hiding ( Version {- conflicts with Packages.Version -} )
+import GHC.Types.Basic hiding ( Version {- conflicts with Packages.Version -} )
 
 -- Collections and maps
-import VarSet
-import VarEnv
-import NameSet
-import NameEnv
-import UniqSet
-import UniqFM
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
 -- Conflicts with UniqFM:
 --import LazyUniqFM
 import FiniteMap
@@ -80,10 +108,10 @@ import FiniteMap
 -- Common utilities
 import Util
 import GHC.Serialized
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
-import UniqSupply
-import Unique           ( Unique, Uniquable(..) )
+import GHC.Types.Unique.Supply
+import GHC.Types.Unique ( Unique, Uniquable(..) )
 import FastString
 import Data.Maybe
 
diff --git a/compiler/GHC/Rename/Binds.hs b/compiler/GHC/Rename/Binds.hs
index e50c97d54c..d0e4392fb8 100644
--- a/compiler/GHC/Rename/Binds.hs
+++ b/compiler/GHC/Rename/Binds.hs
@@ -45,19 +45,19 @@ import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, extendTyVarEnvFVRn
                         , checkUnusedRecordWildcard
                         , checkDupAndShadowedNames, bindLocalNamesFV )
 import GHC.Driver.Session
-import Module
-import Name
-import NameEnv
-import NameSet
-import RdrName          ( RdrName, rdrNameOcc )
-import SrcLoc
+import GHC.Types.Module
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Name.Set
+import GHC.Types.Name.Reader ( RdrName, rdrNameOcc )
+import GHC.Types.SrcLoc as SrcLoc
 import ListSetOps       ( findDupsEq )
-import BasicTypes       ( RecFlag(..), TypeOrKind(..) )
+import GHC.Types.Basic  ( RecFlag(..), TypeOrKind(..) )
 import Digraph          ( SCC(..) )
 import Bag
 import Util
 import Outputable
-import UniqSet
+import GHC.Types.Unique.Set
 import Maybes           ( orElse )
 import OrdList
 import qualified GHC.LanguageExtensions as LangExt
@@ -577,7 +577,7 @@ depAnalBinds binds_w_dus
     sccs = depAnal (\(_, defs, _) -> defs)
                    (\(_, _, uses) -> nonDetEltsUniqSet uses)
                    -- It's OK to use nonDetEltsUniqSet here as explained in
-                   -- Note [depAnal determinism] in NameEnv.
+                   -- Note [depAnal determinism] in GHC.Types.Name.Env.
                    (bagToList binds_w_dus)
 
     get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
diff --git a/compiler/GHC/Rename/Doc.hs b/compiler/GHC/Rename/Doc.hs
index 2f6a796196..2ccf2bfe8d 100644
--- a/compiler/GHC/Rename/Doc.hs
+++ b/compiler/GHC/Rename/Doc.hs
@@ -6,7 +6,7 @@ import GhcPrelude
 
 import TcRnTypes
 import GHC.Hs
-import SrcLoc
+import GHC.Types.SrcLoc
 
 
 rnMbLHsDoc :: Maybe LHsDocString -> RnM (Maybe LHsDocString)
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index a860bdb53f..5e4a5a7ba0 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -49,26 +49,26 @@ import GhcPrelude
 import GHC.Iface.Load   ( loadInterfaceForName, loadSrcInterface_maybe )
 import GHC.Iface.Env
 import GHC.Hs
-import RdrName
+import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import TcEnv
 import TcRnMonad
 import RdrHsSyn         ( filterCTuple, setRdrNameSpace )
 import TysWiredIn
-import Name
-import NameSet
-import NameEnv
-import Avail
-import Module
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env
+import GHC.Types.Avail
+import GHC.Types.Module
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import ErrUtils         ( MsgDoc )
 import PrelNames        ( rOOT_MAIN )
-import BasicTypes       ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) )
-import SrcLoc
+import GHC.Types.Basic  ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) )
+import GHC.Types.SrcLoc as SrcLoc
 import Outputable
-import UniqSet          ( uniqSetAny )
+import GHC.Types.Unique.Set ( uniqSetAny )
 import Util
 import Maybes
 import GHC.Driver.Session
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 79df0331b3..87a98abd52 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -32,7 +32,7 @@ import GHC.Rename.Binds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBin
 import GHC.Hs
 import TcEnv            ( isBrackStage )
 import TcRnMonad
-import Module           ( getModule )
+import GHC.Types.Module ( getModule )
 import GHC.Rename.Env
 import GHC.Rename.Fixity
 import GHC.Rename.Utils ( HsDocContext(..), bindLocalNamesFV, checkDupNames
@@ -47,17 +47,17 @@ import GHC.Rename.Pat
 import GHC.Driver.Session
 import PrelNames
 
-import BasicTypes
-import Name
-import NameSet
-import RdrName
-import UniqSet
+import GHC.Types.Basic
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Name.Reader
+import GHC.Types.Unique.Set
 import Data.List
 import Util
 import ListSetOps       ( removeDups )
 import ErrUtils
 import Outputable
-import SrcLoc
+import GHC.Types.SrcLoc
 import FastString
 import Control.Monad
 import TysWiredIn       ( nilDataConName )
diff --git a/compiler/GHC/Rename/Expr.hs-boot b/compiler/GHC/Rename/Expr.hs-boot
index 77dec1b56a..a5292471d8 100644
--- a/compiler/GHC/Rename/Expr.hs-boot
+++ b/compiler/GHC/Rename/Expr.hs-boot
@@ -1,9 +1,9 @@
 module GHC.Rename.Expr where
-import Name
+import GHC.Types.Name
 import GHC.Hs
-import NameSet     ( FreeVars )
+import GHC.Types.Name.Set ( FreeVars )
 import TcRnTypes
-import SrcLoc      ( Located )
+import GHC.Types.SrcLoc   ( Located )
 import Outputable  ( Outputable )
 
 rnLExpr :: LHsExpr GhcPs
diff --git a/compiler/GHC/Rename/Fixity.hs b/compiler/GHC/Rename/Fixity.hs
index 4c55bb3e53..cf5ca883da 100644
--- a/compiler/GHC/Rename/Fixity.hs
+++ b/compiler/GHC/Rename/Fixity.hs
@@ -20,15 +20,15 @@ import GhcPrelude
 
 import GHC.Iface.Load
 import GHC.Hs
-import RdrName
+import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import TcRnMonad
-import Name
-import NameEnv
-import Module
-import BasicTypes       ( Fixity(..), FixityDirection(..), minPrecedence,
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Module
+import GHC.Types.Basic  ( Fixity(..), FixityDirection(..), minPrecedence,
                           defaultFixity, SourceText(..) )
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
 import Maybes
 import Data.List
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index b04260e3df..286de91a9e 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -44,23 +44,23 @@ import GHC.Rename.Utils ( warnUnusedTopBinds, mkFieldEnv )
 import GHC.Iface.Load   ( loadSrcInterface )
 import TcRnMonad
 import PrelNames
-import Module
-import Name
-import NameEnv
-import NameSet
-import Avail
-import FieldLabel
+import GHC.Types.Module
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Name.Set
+import GHC.Types.Avail
+import GHC.Types.FieldLabel
 import GHC.Driver.Types
-import RdrName
+import GHC.Types.Name.Reader
 import RdrHsSyn        ( setRdrNameSpace )
 import Outputable
 import Maybes
-import SrcLoc
-import BasicTypes      ( TopLevelFlag(..), StringLiteral(..) )
+import GHC.Types.SrcLoc as SrcLoc
+import GHC.Types.Basic  ( TopLevelFlag(..), StringLiteral(..) )
 import Util
 import FastString
 import FastStringEnv
-import Id
+import GHC.Types.Id
 import GHC.Core.Type
 import GHC.Core.PatSyn
 import qualified GHC.LanguageExtensions as LangExt
@@ -1065,7 +1065,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
            -- Look up the children in the sub-names of the parent
            let subnames = case ns of   -- The tc is first in ns,
                             [] -> []   -- if it is there at all
-                                       -- See the AvailTC Invariant in Avail.hs
+                                       -- See the AvailTC Invariant in
+                                       -- GHC.Types.Avail
                             (n1:ns1) | n1 == name -> ns1
                                      | otherwise  -> ns
            case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
@@ -1350,7 +1351,7 @@ This code finds which import declarations are unused.  The
 specification and implementation notes are here:
   https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/unused-imports
 
-See also Note [Choosing the best import declaration] in RdrName
+See also Note [Choosing the best import declaration] in GHC.Types.Name.Reader
 -}
 
 type ImportDeclUsage
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 34450620f0..7b83b8702d 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -63,15 +63,15 @@ import GHC.Rename.Utils    ( HsDocContext(..), newLocalBndrRn, bindLocalNames
                            , checkTupSize , unknownSubordinateErr )
 import GHC.Rename.Types
 import PrelNames
-import Name
-import NameSet
-import RdrName
-import BasicTypes
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Name.Reader
+import GHC.Types.Basic
 import Util
 import ListSetOps          ( removeDups )
 import Outputable
-import SrcLoc
-import Literal             ( inCharRange )
+import GHC.Types.SrcLoc
+import GHC.Types.Literal   ( inCharRange )
 import TysWiredIn          ( nilDataCon )
 import GHC.Core.DataCon
 import qualified GHC.LanguageExtensions as LangExt
diff --git a/compiler/GHC/Rename/Source.hs b/compiler/GHC/Rename/Source.hs
index 8237e32877..fabe5b817d 100644
--- a/compiler/GHC/Rename/Source.hs
+++ b/compiler/GHC/Rename/Source.hs
@@ -25,8 +25,8 @@ import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr )
 import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls )
 
 import GHC.Hs
-import FieldLabel
-import RdrName
+import GHC.Types.FieldLabel
+import GHC.Types.Name.Reader
 import GHC.Rename.Types
 import GHC.Rename.Binds
 import GHC.Rename.Env
@@ -41,30 +41,30 @@ import GHC.Rename.Doc   ( rnHsDoc, rnMbLHsDoc )
 import TcAnnotations    ( annCtxt )
 import TcRnMonad
 
-import ForeignCall      ( CCallTarget(..) )
-import Module
-import GHC.Driver.Types         ( Warnings(..), plusWarns )
+import GHC.Types.ForeignCall ( CCallTarget(..) )
+import GHC.Types.Module
+import GHC.Driver.Types ( Warnings(..), plusWarns )
 import PrelNames        ( applicativeClassName, pureAName, thenAName
                         , monadClassName, returnMName, thenMName
                         , semigroupClassName, sappendName
                         , monoidClassName, mappendName
                         )
-import Name
-import NameSet
-import NameEnv
-import Avail
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env
+import GHC.Types.Avail
 import Outputable
 import Bag
-import BasicTypes       ( pprRuleName, TypeOrKind(..) )
+import GHC.Types.Basic  ( pprRuleName, TypeOrKind(..) )
 import FastString
-import SrcLoc
+import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Session
 import Util             ( debugIsOn, filterOut, lengthExceeds, partitionWith )
-import GHC.Driver.Types         ( HscEnv, hsc_dflags )
+import GHC.Driver.Types ( HscEnv, hsc_dflags )
 import ListSetOps       ( findDupsEq, removeDups, equivClasses )
 import Digraph          ( SCC, flattenSCC, flattenSCCs, Node(..)
                         , stronglyConnCompFromEdgedVerticesUniq )
-import UniqSet
+import GHC.Types.Unique.Set
 import OrdList
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 12496a9fb8..2275ca6ab8 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -16,10 +16,10 @@ module GHC.Rename.Splice (
 
 import GhcPrelude
 
-import Name
-import NameSet
+import GHC.Types.Name
+import GHC.Types.Name.Set
 import GHC.Hs
-import RdrName
+import GHC.Types.Name.Reader
 import TcRnMonad
 
 import GHC.Rename.Env
@@ -27,15 +27,15 @@ import GHC.Rename.Utils   ( HsDocContext(..), newLocalBndrRn )
 import GHC.Rename.Unbound ( isUnboundName )
 import GHC.Rename.Source  ( rnSrcDecls, findSplice )
 import GHC.Rename.Pat     ( rnPat )
-import BasicTypes       ( TopLevelFlag, isTopLevel, SourceText(..) )
+import GHC.Types.Basic    ( TopLevelFlag, isTopLevel, SourceText(..) )
 import Outputable
-import Module
-import SrcLoc
+import GHC.Types.Module
+import GHC.Types.SrcLoc
 import GHC.Rename.Types ( rnLHsType )
 
 import Control.Monad    ( unless, when )
 
-import {-# SOURCE #-} GHC.Rename.Expr   ( rnLExpr )
+import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
 
 import TcEnv            ( checkWellStaged )
 import THNames          ( liftName )
diff --git a/compiler/GHC/Rename/Splice.hs-boot b/compiler/GHC/Rename/Splice.hs-boot
index b61a866331..f14be280fc 100644
--- a/compiler/GHC/Rename/Splice.hs-boot
+++ b/compiler/GHC/Rename/Splice.hs-boot
@@ -3,7 +3,7 @@ module GHC.Rename.Splice where
 import GhcPrelude
 import GHC.Hs
 import TcRnMonad
-import NameSet
+import GHC.Types.Name.Set
 
 
 rnSpliceType :: HsSplice GhcPs   -> RnM (HsType GhcRn, FreeVars)
diff --git a/compiler/GHC/Rename/Types.hs b/compiler/GHC/Rename/Types.hs
index d633ac6593..23e9fe0879 100644
--- a/compiler/GHC/Rename/Types.hs
+++ b/compiler/GHC/Rename/Types.hs
@@ -46,17 +46,17 @@ import GHC.Rename.Utils  ( HsDocContext(..), withHsDocContext, mapFvRn
 import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
                          , lookupTyFixityRn )
 import TcRnMonad
-import RdrName
+import GHC.Types.Name.Reader
 import PrelNames
 import TysPrim          ( funTyConName )
-import Name
-import SrcLoc
-import NameSet
-import FieldLabel
+import GHC.Types.Name
+import GHC.Types.SrcLoc
+import GHC.Types.Name.Set
+import GHC.Types.FieldLabel
 
 import Util
 import ListSetOps       ( deleteBys )
-import BasicTypes       ( compareFixity, funTyFixity, negateFixity
+import GHC.Types.Basic  ( compareFixity, funTyFixity, negateFixity
                         , Fixity(..), FixityDirection(..), LexicalFixity(..)
                         , TypeOrKind(..) )
 import Outputable
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index 78a49d954c..957a82e81c 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -19,12 +19,12 @@ where
 
 import GhcPrelude
 
-import RdrName
+import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import TcRnMonad
-import Name
-import Module
-import SrcLoc
+import GHC.Types.Name
+import GHC.Types.Module
+import GHC.Types.SrcLoc as SrcLoc
 import Outputable
 import PrelNames ( mkUnboundName, isUnboundName, getUnique)
 import Util
@@ -33,7 +33,7 @@ import GHC.Driver.Session
 import FastString
 import Data.List
 import Data.Function ( on )
-import UniqDFM (udfmToList)
+import GHC.Types.Unique.DFM (udfmToList)
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 45bd55b31a..32ac27d12f 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -36,18 +36,18 @@ where
 import GhcPrelude
 
 import GHC.Hs
-import RdrName
+import GHC.Types.Name.Reader
 import GHC.Driver.Types
 import TcEnv
 import TcRnMonad
-import Name
-import NameSet
-import NameEnv
+import GHC.Types.Name
+import GHC.Types.Name.Set
+import GHC.Types.Name.Env
 import GHC.Core.DataCon
-import SrcLoc
+import GHC.Types.SrcLoc as SrcLoc
 import Outputable
 import Util
-import BasicTypes       ( TopLevelFlag(..) )
+import GHC.Types.Basic  ( TopLevelFlag(..) )
 import ListSetOps       ( removeDups )
 import GHC.Driver.Session
 import FastString
diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs
index 5ad6a2c6f0..50622d8fa9 100644
--- a/compiler/GHC/Runtime/Debugger.hs
+++ b/compiler/GHC/Runtime/Debugger.hs
@@ -23,13 +23,13 @@ import GHC.Runtime.Interpreter
 import GHCi.RemoteTypes
 import GHC.Driver.Monad
 import GHC.Driver.Types
-import Id
+import GHC.Types.Id
 import GHC.Iface.Syntax ( showToHeader )
 import GHC.Iface.Env    ( newInteractiveBinder )
-import Name
-import Var hiding ( varName )
-import VarSet
-import UniqSet
+import GHC.Types.Name
+import GHC.Types.Var hiding ( varName )
+import GHC.Types.Var.Set
+import GHC.Types.Unique.Set
 import GHC.Core.Type
 import GHC
 import Outputable
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 6ef575490f..794aa30b55 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -69,27 +69,27 @@ import TcType
 import Constraint
 import TcOrigin
 import GHC.Core.Predicate
-import Var
-import Id
-import Name             hiding ( varName )
-import NameSet
-import Avail
-import RdrName
-import VarEnv
+import GHC.Types.Var
+import GHC.Types.Id as Id
+import GHC.Types.Name      hiding ( varName )
+import GHC.Types.Name.Set
+import GHC.Types.Avail
+import GHC.Types.Name.Reader
+import GHC.Types.Var.Env
 import GHC.ByteCode.Types
 import GHC.Runtime.Linker as Linker
 import GHC.Driver.Session
 import GHC.LanguageExtensions
-import Unique
-import UniqSupply
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 import MonadUtils
-import Module
+import GHC.Types.Module
 import PrelNames  ( toDynName, pretendNameIsInScope )
 import TysWiredIn ( isCTupleTyConName )
 import Panic
 import Maybes
 import ErrUtils
-import SrcLoc
+import GHC.Types.SrcLoc
 import GHC.Runtime.Heap.Inspect
 import Outputable
 import FastString
diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs
index f1e3308f70..753f776f20 100644
--- a/compiler/GHC/Runtime/Eval/Types.hs
+++ b/compiler/GHC/Runtime/Eval/Types.hs
@@ -16,12 +16,12 @@ import GhcPrelude
 
 import GHCi.RemoteTypes
 import GHCi.Message (EvalExpr, ResumeContext)
-import Id
-import Name
-import Module
-import RdrName
+import GHC.Types.Id
+import GHC.Types.Name
+import GHC.Types.Module
+import GHC.Types.Name.Reader
 import GHC.Core.Type
-import SrcLoc
+import GHC.Types.SrcLoc
 import Exception
 
 import Data.Word
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 37d9af0d8b..5f34e9d2d2 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -37,7 +37,7 @@ import GHC.Core.DataCon
 import GHC.Core.Type
 import GHC.Types.RepType
 import qualified GHC.Core.Unify as U
-import Var
+import GHC.Types.Var
 import TcRnMonad
 import TcType
 import TcMType
@@ -46,13 +46,13 @@ import TcUnify
 import TcEnv
 
 import GHC.Core.TyCon
-import Name
-import OccName
-import Module
+import GHC.Types.Name
+import GHC.Types.Name.Occurrence as OccName
+import GHC.Types.Module
 import GHC.Iface.Env
 import Util
-import VarSet
-import BasicTypes       ( Boxity(..) )
+import GHC.Types.Var.Set
+import GHC.Types.Basic ( Boxity(..) )
 import TysPrim
 import PrelNames
 import TysWiredIn
diff --git a/compiler/GHC/Runtime/Heap/Layout.hs b/compiler/GHC/Runtime/Heap/Layout.hs
index c6a159345d..c469f00cb4 100644
--- a/compiler/GHC/Runtime/Heap/Layout.hs
+++ b/compiler/GHC/Runtime/Heap/Layout.hs
@@ -46,7 +46,7 @@ module GHC.Runtime.Heap.Layout (
 
 import GhcPrelude
 
-import BasicTypes( ConTagZ )
+import GHC.Types.Basic( ConTagZ )
 import GHC.Driver.Session
 import Outputable
 import GHC.Platform
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 82f0d5ffc4..61e5297184 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -62,20 +62,20 @@ import GHCi.ResolvedBCO
 import GHCi.BreakArray (BreakArray)
 import Fingerprint
 import GHC.Driver.Types
-import UniqFM
+import GHC.Types.Unique.FM
 import Panic
 import GHC.Driver.Session
 import Exception
-import BasicTypes
+import GHC.Types.Basic
 import FastString
 import Util
 import GHC.Runtime.Eval.Types(BreakInfo(..))
 import Outputable(brackets, ppr, showSDocUnqual)
-import SrcLoc
+import GHC.Types.SrcLoc
 import Maybes
-import Module
+import GHC.Types.Module
 import GHC.ByteCode.Types
-import Unique
+import GHC.Types.Unique
 
 #if defined(HAVE_INTERNAL_INTERPRETER)
 import GHCi.Run
diff --git a/compiler/GHC/Runtime/Interpreter/Types.hs b/compiler/GHC/Runtime/Interpreter/Types.hs
index 6cbf2620ee..9decf8abb2 100644
--- a/compiler/GHC/Runtime/Interpreter/Types.hs
+++ b/compiler/GHC/Runtime/Interpreter/Types.hs
@@ -14,7 +14,7 @@ import GhcPrelude
 
 import GHCi.RemoteTypes
 import GHCi.Message         ( Pipe )
-import UniqFM
+import GHC.Types.Unique.FM
 import Foreign
 
 import Control.Concurrent
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index c8b4b63a78..10f18a8525 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -44,20 +44,20 @@ import GHC.Driver.Phases
 import GHC.Driver.Finder
 import GHC.Driver.Types
 import GHC.Driver.Ways
-import Name
-import NameEnv
-import Module
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Module
 import ListSetOps
 import GHC.Runtime.Linker.Types (DynLinker(..), LinkerUnitId, PersistentLinkerState(..))
 import GHC.Driver.Session
-import BasicTypes
+import GHC.Types.Basic
 import Outputable
 import Panic
 import Util
 import ErrUtils
-import SrcLoc
+import GHC.Types.SrcLoc
 import qualified Maybes
-import UniqDSet
+import GHC.Types.Unique.DSet
 import FastString
 import GHC.Platform
 import SysTools
diff --git a/compiler/GHC/Runtime/Linker/Types.hs b/compiler/GHC/Runtime/Linker/Types.hs
index 5b2f506c6d..d8530a1460 100644
--- a/compiler/GHC/Runtime/Linker/Types.hs
+++ b/compiler/GHC/Runtime/Linker/Types.hs
@@ -19,13 +19,13 @@ import GhcPrelude              ( FilePath, String, show )
 import Data.Time               ( UTCTime )
 import Data.Maybe              ( Maybe )
 import Control.Concurrent.MVar ( MVar )
-import Module                  ( InstalledUnitId, Module )
-import GHC.ByteCode.Types           ( ItblEnv, CompiledByteCode )
+import GHC.Types.Module        ( InstalledUnitId, Module )
+import GHC.ByteCode.Types      ( ItblEnv, CompiledByteCode )
 import Outputable
-import Var                     ( Id )
+import GHC.Types.Var           ( Id )
 import GHC.Fingerprint.Type    ( Fingerprint )
-import NameEnv                 ( NameEnv )
-import Name                    ( Name )
+import GHC.Types.Name.Env      ( NameEnv )
+import GHC.Types.Name          ( Name )
 import GHCi.RemoteTypes        ( ForeignHValue )
 
 type ClosureEnv = NameEnv (Name, ForeignHValue)
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 44737c48ed..16c965701a 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -26,26 +26,26 @@ import GHC.Driver.Session
 import GHC.Runtime.Linker      ( linkModule, getHValue )
 import GHC.Runtime.Interpreter ( wormhole, withInterp )
 import GHC.Runtime.Interpreter.Types
-import SrcLoc           ( noSrcSpan )
-import GHC.Driver.Finder( findPluginModule, cannotFindModule )
-import TcRnMonad        ( initTcInteractive, initIfaceTcRn )
-import GHC.Iface.Load   ( loadPluginInterface )
-import RdrName          ( RdrName, ImportSpec(..), ImpDeclSpec(..)
-                        , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
-                        , gre_name, mkRdrQual )
-import OccName          ( OccName, mkVarOcc )
+import GHC.Types.SrcLoc        ( noSrcSpan )
+import GHC.Driver.Finder       ( findPluginModule, cannotFindModule )
+import TcRnMonad               ( initTcInteractive, initIfaceTcRn )
+import GHC.Iface.Load          ( loadPluginInterface )
+import GHC.Types.Name.Reader  ( RdrName, ImportSpec(..), ImpDeclSpec(..)
+                               , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
+                               , gre_name, mkRdrQual )
+import GHC.Types.Name.Occurrence ( OccName, mkVarOcc )
 import GHC.Rename.Names ( gresFromAvails )
 import GHC.Driver.Plugins
 import PrelNames        ( pluginTyConName, frontendPluginTyConName )
 
 import GHC.Driver.Types
-import GHCi.RemoteTypes ( HValue )
+import GHCi.RemoteTypes  ( HValue )
 import GHC.Core.Type     ( Type, eqType, mkTyConTy )
 import GHC.Core.TyCo.Ppr ( pprTyThingCategory )
 import GHC.Core.TyCon    ( TyCon )
-import Name             ( Name, nameModule_maybe )
-import Id               ( idType )
-import Module           ( Module, ModuleName )
+import GHC.Types.Name    ( Name, nameModule_maybe )
+import GHC.Types.Id      ( idType )
+import GHC.Types.Module  ( Module, ModuleName )
 import Panic
 import FastString
 import ErrUtils
diff --git a/compiler/GHC/Stg/CSE.hs b/compiler/GHC/Stg/CSE.hs
index ea9c8e61fa..538556c6af 100644
--- a/compiler/GHC/Stg/CSE.hs
+++ b/compiler/GHC/Stg/CSE.hs
@@ -89,15 +89,15 @@ module GHC.Stg.CSE (stgCse) where
 import GhcPrelude
 
 import GHC.Core.DataCon
-import Id
+import GHC.Types.Id
 import GHC.Stg.Syntax
 import Outputable
-import VarEnv
+import GHC.Types.Var.Env
 import GHC.Core (AltCon(..))
 import Data.List (mapAccumL)
 import Data.Maybe (fromMaybe)
 import GHC.Core.Map
-import NameEnv
+import GHC.Types.Name.Env
 import Control.Monad( (>=>) )
 
 --------------
diff --git a/compiler/GHC/Stg/DepAnal.hs b/compiler/GHC/Stg/DepAnal.hs
index 5729128126..90eec24f74 100644
--- a/compiler/GHC/Stg/DepAnal.hs
+++ b/compiler/GHC/Stg/DepAnal.hs
@@ -5,13 +5,13 @@ module GHC.Stg.DepAnal (depSortStgPgm) where
 import GhcPrelude
 
 import GHC.Stg.Syntax
-import Id
-import Name (Name, nameIsLocalOrFrom)
-import NameEnv
+import GHC.Types.Id
+import GHC.Types.Name (Name, nameIsLocalOrFrom)
+import GHC.Types.Name.Env
 import Outputable
-import UniqSet (nonDetEltsUniqSet)
-import VarSet
-import Module (Module)
+import GHC.Types.Unique.Set (nonDetEltsUniqSet)
+import GHC.Types.Var.Set
+import GHC.Types.Module (Module)
 
 import Data.Graph (SCC (..))
 
diff --git a/compiler/GHC/Stg/FVs.hs b/compiler/GHC/Stg/FVs.hs
index 6bd219d7a3..e323775c5f 100644
--- a/compiler/GHC/Stg/FVs.hs
+++ b/compiler/GHC/Stg/FVs.hs
@@ -45,8 +45,8 @@ module GHC.Stg.FVs (
 import GhcPrelude
 
 import GHC.Stg.Syntax
-import Id
-import VarSet
+import GHC.Types.Id
+import GHC.Types.Var.Set
 import GHC.Core    ( Tickish(Breakpoint) )
 import Outputable
 import Util
diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs
index a0223707d7..f90ef519fe 100644
--- a/compiler/GHC/Stg/Lift.hs
+++ b/compiler/GHC/Stg/Lift.hs
@@ -19,17 +19,17 @@ where
 
 import GhcPrelude
 
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Driver.Session
-import Id
+import GHC.Types.Id
 import GHC.Stg.FVs ( annBindingFreeVars )
 import GHC.Stg.Lift.Analysis
 import GHC.Stg.Lift.Monad
 import GHC.Stg.Syntax
 import Outputable
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Util
-import VarSet
+import GHC.Types.Var.Set
 import Control.Monad ( when )
 import Data.Maybe ( isNothing )
 
diff --git a/compiler/GHC/Stg/Lift/Analysis.hs b/compiler/GHC/Stg/Lift/Analysis.hs
index cc477e0eaa..13778237ea 100644
--- a/compiler/GHC/Stg/Lift/Analysis.hs
+++ b/compiler/GHC/Stg/Lift/Analysis.hs
@@ -23,10 +23,10 @@ module GHC.Stg.Lift.Analysis (
 import GhcPrelude
 import GHC.Platform
 
-import BasicTypes
-import Demand
+import GHC.Types.Basic
+import GHC.Types.Demand
 import GHC.Driver.Session
-import Id
+import GHC.Types.Id
 import GHC.Runtime.Heap.Layout ( WordOff )
 import GHC.Stg.Syntax
 import qualified GHC.StgToCmm.ArgRep  as StgToCmm.ArgRep
@@ -34,7 +34,7 @@ import qualified GHC.StgToCmm.Closure as StgToCmm.Closure
 import qualified GHC.StgToCmm.Layout  as StgToCmm.Layout
 import Outputable
 import Util
-import VarSet
+import GHC.Types.Var.Set
 
 import Data.Maybe ( mapMaybe )
 
diff --git a/compiler/GHC/Stg/Lift/Monad.hs b/compiler/GHC/Stg/Lift/Monad.hs
index 8c0a6d27fc..28ec3e1e69 100644
--- a/compiler/GHC/Stg/Lift/Monad.hs
+++ b/compiler/GHC/Stg/Lift/Monad.hs
@@ -24,21 +24,21 @@ module GHC.Stg.Lift.Monad (
 
 import GhcPrelude
 
-import BasicTypes
-import CostCentre ( isCurrentCCS, dontCareCCS )
+import GHC.Types.Basic
+import GHC.Types.CostCentre ( isCurrentCCS, dontCareCCS )
 import GHC.Driver.Session
 import FastString
-import Id
-import Name
+import GHC.Types.Id
+import GHC.Types.Name
 import Outputable
 import OrdList
 import GHC.Stg.Subst
 import GHC.Stg.Syntax
 import GHC.Core.Type
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Util
-import VarEnv
-import VarSet
+import GHC.Types.Var.Env
+import GHC.Types.Var.Set
 
 import Control.Arrow ( second )
 import Control.Monad.Trans.Class
@@ -271,7 +271,7 @@ withLiftedBndr abs_ids bndr inner = do
   let str = "$l" ++ occNameString (getOccName bndr)
   let ty = mkLamTypes (dVarSetElems abs_ids) (idType bndr)
   let bndr'
-        -- See Note [transferPolyIdInfo] in Id.hs. We need to do this at least
+        -- See Note [transferPolyIdInfo] in GHC.Types.Id. We need to do this at least
         -- for arity information.
         = transferPolyIdInfo bndr (dVarSetElems abs_ids)
         . mkSysLocal (mkFastString str) uniq
diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs
index 3d06815832..bf4cfce443 100644
--- a/compiler/GHC/Stg/Lint.hs
+++ b/compiler/GHC/Stg/Lint.hs
@@ -42,20 +42,20 @@ import GhcPrelude
 import GHC.Stg.Syntax
 
 import GHC.Driver.Session
-import Bag              ( Bag, emptyBag, isEmptyBag, snocBag, bagToList )
-import BasicTypes       ( TopLevelFlag(..), isTopLevel )
-import CostCentre       ( isCurrentCCS )
-import Id               ( Id, idType, isJoinId, idName )
-import VarSet
+import Bag                  ( Bag, emptyBag, isEmptyBag, snocBag, bagToList )
+import GHC.Types.Basic      ( TopLevelFlag(..), isTopLevel )
+import GHC.Types.CostCentre ( isCurrentCCS )
+import GHC.Types.Id         ( Id, idType, isJoinId, idName )
+import GHC.Types.Var.Set
 import GHC.Core.DataCon
-import GHC.Core         ( AltCon(..) )
-import Name             ( getSrcLoc, nameIsLocalOrFrom )
-import ErrUtils         ( MsgDoc, Severity(..), mkLocMessage )
+import GHC.Core             ( AltCon(..) )
+import GHC.Types.Name       ( getSrcLoc, nameIsLocalOrFrom )
+import ErrUtils             ( MsgDoc, Severity(..), mkLocMessage )
 import GHC.Core.Type
 import GHC.Types.RepType
-import SrcLoc
+import GHC.Types.SrcLoc
 import Outputable
-import Module           ( Module )
+import GHC.Types.Module           ( Module )
 import qualified ErrUtils as Err
 import Control.Applicative ((<|>))
 import Control.Monad
diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs
index 457466291d..4b463cb95e 100644
--- a/compiler/GHC/Stg/Pipeline.hs
+++ b/compiler/GHC/Stg/Pipeline.hs
@@ -23,11 +23,11 @@ import GHC.Stg.DepAnal  ( depSortStgPgm )
 import GHC.Stg.Unarise  ( unarise )
 import GHC.Stg.CSE      ( stgCse )
 import GHC.Stg.Lift     ( stgLiftLams )
-import Module           ( Module )
+import GHC.Types.Module ( Module )
 
 import GHC.Driver.Session
 import ErrUtils
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Outputable
 import Control.Monad
 import Control.Monad.IO.Class
diff --git a/compiler/GHC/Stg/Stats.hs b/compiler/GHC/Stg/Stats.hs
index 8a4fa7561b..c2d546d587 100644
--- a/compiler/GHC/Stg/Stats.hs
+++ b/compiler/GHC/Stg/Stats.hs
@@ -31,7 +31,7 @@ import GhcPrelude
 
 import GHC.Stg.Syntax
 
-import Id (Id)
+import GHC.Types.Id (Id)
 import Panic
 
 import Data.Map (Map)
diff --git a/compiler/GHC/Stg/Subst.hs b/compiler/GHC/Stg/Subst.hs
index aa07c48b36..abbbfb0fd7 100644
--- a/compiler/GHC/Stg/Subst.hs
+++ b/compiler/GHC/Stg/Subst.hs
@@ -6,8 +6,8 @@ module GHC.Stg.Subst where
 
 import GhcPrelude
 
-import Id
-import VarEnv
+import GHC.Types.Id
+import GHC.Types.Var.Env
 import Control.Monad.Trans.State.Strict
 import Outputable
 import Util
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 534cdbfbcb..e31327c06c 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -64,22 +64,22 @@ module GHC.Stg.Syntax (
 import GhcPrelude
 
 import GHC.Core     ( AltCon, Tickish )
-import CostCentre  ( CostCentreStack )
+import GHC.Types.CostCentre ( CostCentreStack )
 import Data.ByteString ( ByteString )
 import Data.Data   ( Data )
 import Data.List   ( intersperse )
 import GHC.Core.DataCon
 import GHC.Driver.Session
-import ForeignCall ( ForeignCall )
-import Id
-import VarSet
-import Literal     ( Literal, literalType )
-import Module      ( Module )
+import GHC.Types.ForeignCall ( ForeignCall )
+import GHC.Types.Id
+import GHC.Types.Var.Set
+import GHC.Types.Literal     ( Literal, literalType )
+import GHC.Types.Module      ( Module )
 import Outputable
 import GHC.Driver.Packages ( isDynLinkName )
 import GHC.Platform
 import GHC.Core.Ppr( {- instances -} )
-import PrimOp      ( PrimOp, PrimCall )
+import PrimOp            ( PrimOp, PrimCall )
 import GHC.Core.TyCon    ( PrimRep(..), TyCon )
 import GHC.Core.Type     ( Type )
 import GHC.Types.RepType ( typePrimRep1 )
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 98738470b2..6e163ab3e9 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -202,14 +202,14 @@ module GHC.Stg.Unarise (unarise) where
 
 import GhcPrelude
 
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Core
 import GHC.Core.DataCon
 import FastString (FastString, mkFastString)
-import Id
-import Literal
+import GHC.Types.Id
+import GHC.Types.Literal
 import GHC.Core.Make (aBSENT_SUM_FIELD_ERROR_ID)
-import MkId (voidPrimId, voidArgId)
+import GHC.Types.Id.Make (voidPrimId, voidArgId)
 import MonadUtils (mapAccumLM)
 import Outputable
 import GHC.Types.RepType
@@ -217,9 +217,9 @@ import GHC.Stg.Syntax
 import GHC.Core.Type
 import TysPrim (intPrimTy,wordPrimTy,word64PrimTy)
 import TysWiredIn
-import UniqSupply
+import GHC.Types.Unique.Supply
 import Util
-import VarEnv
+import GHC.Types.Var.Env
 
 import Data.Bifunctor (second)
 import Data.Maybe (mapMaybe)
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 31ebdede81..4c4b5b5a9e 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -34,17 +34,17 @@ import GHC.Driver.Session
 import ErrUtils
 
 import GHC.Driver.Types
-import CostCentre
-import Id
-import IdInfo
+import GHC.Types.CostCentre
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Types.RepType
 import GHC.Core.DataCon
 import GHC.Core.TyCon
-import Module
+import GHC.Types.Module
 import Outputable
 import Stream
-import BasicTypes
-import VarSet ( isEmptyDVarSet )
+import GHC.Types.Basic
+import GHC.Types.Var.Set ( isEmptyDVarSet )
 
 import OrdList
 import GHC.Cmm.Graph
diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs
index 2839a2ff56..a36aa4c268 100644
--- a/compiler/GHC/StgToCmm/ArgRep.hs
+++ b/compiler/GHC/StgToCmm/ArgRep.hs
@@ -20,13 +20,12 @@ module GHC.StgToCmm.ArgRep (
 import GhcPrelude
 import GHC.Platform
 
-import GHC.StgToCmm.Closure ( idPrimRep )
-
+import GHC.StgToCmm.Closure    ( idPrimRep )
 import GHC.Runtime.Heap.Layout ( WordOff )
-import Id               ( Id )
-import GHC.Core.TyCon   ( PrimRep(..), primElemRepSizeB )
-import BasicTypes       ( RepArity )
-import Constants        ( wORD64_SIZE, dOUBLE_SIZE )
+import GHC.Types.Id            ( Id )
+import GHC.Core.TyCon          ( PrimRep(..), primElemRepSizeB )
+import GHC.Types.Basic         ( RepArity )
+import Constants               ( wORD64_SIZE, dOUBLE_SIZE )
 
 import Outputable
 import FastString
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index d60e2805d4..8db97d8083 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -38,15 +38,15 @@ import GHC.Cmm.Info
 import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 import GHC.Stg.Syntax
-import CostCentre
-import Id
-import IdInfo
-import Name
-import Module
+import GHC.Types.CostCentre
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Name
+import GHC.Types.Module
 import ListSetOps
 import Util
-import VarSet
-import BasicTypes
+import GHC.Types.Var.Set
+import GHC.Types.Basic
 import Outputable
 import FastString
 import GHC.Driver.Session
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index 7bb73111a9..3aa9dc8ef4 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -71,19 +71,19 @@ import GHC.Runtime.Heap.Layout
 import GHC.Cmm
 import GHC.Cmm.Ppr.Expr() -- For Outputable instances
 
-import CostCentre
+import GHC.Types.CostCentre
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import Id
-import IdInfo
+import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Core.DataCon
-import Name
+import GHC.Types.Name
 import GHC.Core.Type
 import GHC.Core.TyCo.Rep
 import TcType
 import GHC.Core.TyCon
 import GHC.Types.RepType
-import BasicTypes
+import GHC.Types.Basic
 import Outputable
 import GHC.Driver.Session
 import Util
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index 2da91879b3..abf88ffbe3 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -34,14 +34,14 @@ import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 import GHC.Cmm.Graph
 import GHC.Runtime.Heap.Layout
-import CostCentre
-import Module
+import GHC.Types.CostCentre
+import GHC.Types.Module
 import GHC.Core.DataCon
 import GHC.Driver.Session
 import FastString
-import Id
+import GHC.Types.Id
 import GHC.Types.RepType (countConRepArgs)
-import Literal
+import GHC.Types.Literal
 import PrelInfo
 import Outputable
 import GHC.Platform
diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs
index 47c46eed63..047353b89a 100644
--- a/compiler/GHC/StgToCmm/Env.hs
+++ b/compiler/GHC/StgToCmm/Env.hs
@@ -38,16 +38,16 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.Expr
 import GHC.Cmm.Utils
 import GHC.Driver.Session
-import Id
+import GHC.Types.Id
 import GHC.Cmm.Graph
-import Name
+import GHC.Types.Name
 import Outputable
 import GHC.Stg.Syntax
 import GHC.Core.Type
 import TysPrim
-import UniqFM
+import GHC.Types.Unique.FM
 import Util
-import VarEnv
+import GHC.Types.Var.Env
 
 -------------------------------------
 --        Manipulating CgIdInfo
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index f896b4d598..cb06799316 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -39,13 +39,13 @@ import GHC.Cmm.Info
 import GHC.Core
 import GHC.Core.DataCon
 import GHC.Driver.Session ( mAX_PTR_TAG )
-import ForeignCall
-import Id
+import GHC.Types.ForeignCall
+import GHC.Types.Id
 import PrimOp
 import GHC.Core.TyCon
-import GHC.Core.Type      ( isUnliftedType )
-import GHC.Types.RepType  ( isVoidTy, countConRepArgs )
-import CostCentre         ( CostCentreStack, currentCCS )
+import GHC.Core.Type        ( isUnliftedType )
+import GHC.Types.RepType    ( isVoidTy, countConRepArgs )
+import GHC.Types.CostCentre ( CostCentreStack, currentCCS )
 import Maybes
 import Util
 import FastString
diff --git a/compiler/GHC/StgToCmm/ExtCode.hs b/compiler/GHC/StgToCmm/ExtCode.hs
index 40472245ed..84195a67d2 100644
--- a/compiler/GHC/StgToCmm/ExtCode.hs
+++ b/compiler/GHC/StgToCmm/ExtCode.hs
@@ -49,10 +49,10 @@ import GHC.Cmm.Graph
 import GHC.Cmm.BlockId
 import GHC.Driver.Session
 import FastString
-import Module
-import UniqFM
-import Unique
-import UniqSupply
+import GHC.Types.Module
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 
 import Control.Monad (ap)
 
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 767e70939b..2a0578327a 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -36,13 +36,13 @@ import GHC.Core.Type
 import GHC.Types.RepType
 import GHC.Cmm.CLabel
 import GHC.Runtime.Heap.Layout
-import ForeignCall
+import GHC.Types.ForeignCall
 import GHC.Driver.Session
 import GHC.Platform
 import Maybes
 import Outputable
-import UniqSupply
-import BasicTypes
+import GHC.Types.Unique.Supply
+import GHC.Types.Basic
 
 import GHC.Core.TyCo.Rep
 import TysPrim
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 740103e3b1..9a66d77c7f 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -41,10 +41,10 @@ import GHC.Runtime.Heap.Layout
 import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Cmm.Utils
-import CostCentre
-import IdInfo( CafInfo(..), mayHaveCafRefs )
-import Id ( Id )
-import Module
+import GHC.Types.CostCentre
+import GHC.Types.Id.Info( CafInfo(..), mayHaveCafRefs )
+import GHC.Types.Id ( Id )
+import GHC.Types.Module
 import GHC.Driver.Session
 import GHC.Platform
 import FastString( mkFastString, fsLit )
diff --git a/compiler/GHC/StgToCmm/Hpc.hs b/compiler/GHC/StgToCmm/Hpc.hs
index 886c0e12e8..1b7305da4e 100644
--- a/compiler/GHC/StgToCmm/Hpc.hs
+++ b/compiler/GHC/StgToCmm/Hpc.hs
@@ -16,7 +16,7 @@ import GHC.Platform
 import GHC.Cmm.Graph
 import GHC.Cmm.Expr
 import GHC.Cmm.CLabel
-import Module
+import GHC.Types.Module
 import GHC.Cmm.Utils
 import GHC.StgToCmm.Utils
 import GHC.Driver.Types
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 08e83b84d3..14ec8445c5 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -49,12 +49,12 @@ import GHC.Cmm.Utils
 import GHC.Cmm.Info
 import GHC.Cmm.CLabel
 import GHC.Stg.Syntax
-import Id
+import GHC.Types.Id
 import GHC.Core.TyCon    ( PrimRep(..), primRepSizeB )
-import BasicTypes        ( RepArity )
+import GHC.Types.Basic   ( RepArity )
 import GHC.Driver.Session
 import GHC.Platform
-import Module
+import GHC.Types.Module
 
 import Util
 import Data.List
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index 9edff8bd66..a23d942c60 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -70,13 +70,13 @@ import GHC.Cmm.Graph as CmmGraph
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Runtime.Heap.Layout
-import Module
-import Id
-import VarEnv
+import GHC.Types.Module
+import GHC.Types.Id
+import GHC.Types.Var.Env
 import OrdList
-import BasicTypes( ConTagZ )
-import Unique
-import UniqSupply
+import GHC.Types.Basic( ConTagZ )
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
 import FastString
 import Outputable
 import Util
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 5b43837417..665fdeb21d 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -37,12 +37,12 @@ import GHC.StgToCmm.Prof ( costCentreFrom )
 
 import GHC.Driver.Session
 import GHC.Platform
-import BasicTypes
+import GHC.Types.Basic
 import GHC.Cmm.BlockId
 import GHC.Cmm.Graph
 import GHC.Stg.Syntax
 import GHC.Cmm
-import Module   ( rtsUnitId )
+import GHC.Types.Module ( rtsUnitId )
 import GHC.Core.Type    ( Type, tyConAppTyCon )
 import GHC.Core.TyCon
 import GHC.Cmm.CLabel
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index c97bd793be..54e49eee87 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -36,10 +36,10 @@ import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 
-import CostCentre
+import GHC.Types.CostCentre
 import GHC.Driver.Session
 import FastString
-import Module
+import GHC.Types.Module as Module
 import Outputable
 
 import Control.Monad
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index c472a2815b..d6cea4206c 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -120,10 +120,10 @@ import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 import GHC.Runtime.Heap.Layout
 
-import Module
-import Name
-import Id
-import BasicTypes
+import GHC.Types.Module
+import GHC.Types.Name
+import GHC.Types.Id
+import GHC.Types.Basic
 import FastString
 import Outputable
 import Util
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 178572eb64..1f439db546 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -64,22 +64,22 @@ import GHC.Cmm.Utils hiding (mkDataLits, mkRODataLits, mkByteStringCLit)
 import GHC.Cmm.Switch
 import GHC.StgToCmm.CgUtils
 
-import ForeignCall
-import IdInfo
+import GHC.Types.ForeignCall
+import GHC.Types.Id.Info
 import GHC.Core.Type
 import GHC.Core.TyCon
 import GHC.Runtime.Heap.Layout
-import Module
-import Literal
+import GHC.Types.Module
+import GHC.Types.Literal
 import Digraph
 import Util
-import Unique
-import UniqSupply (MonadUnique(..))
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply (MonadUnique(..))
 import GHC.Driver.Session
 import FastString
 import Outputable
 import GHC.Types.RepType
-import CostCentre
+import GHC.Types.CostCentre
 
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS8
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index b881186799..4eb52b4970 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -28,21 +28,21 @@ import GhcPrelude
 
 import GHC.Hs as Hs
 import PrelNames
-import RdrName
-import qualified Name
-import Module
+import GHC.Types.Name.Reader
+import qualified GHC.Types.Name as Name
+import GHC.Types.Module
 import RdrHsSyn
-import OccName
-import SrcLoc
+import GHC.Types.Name.Occurrence as OccName
+import GHC.Types.SrcLoc
 import GHC.Core.Type
 import qualified GHC.Core.Coercion as Coercion ( Role(..) )
 import TysWiredIn
-import BasicTypes as Hs
-import ForeignCall
-import Unique
+import GHC.Types.Basic as Hs
+import GHC.Types.ForeignCall
+import GHC.Types.Unique
 import ErrUtils
 import Bag
-import Lexeme
+import GHC.Utils.Lexeme
 import Util
 import FastString
 import Outputable
diff --git a/compiler/GHC/Types/Annotations.hs b/compiler/GHC/Types/Annotations.hs
new file mode 100644
index 0000000000..4dde431ab5
--- /dev/null
+++ b/compiler/GHC/Types/Annotations.hs
@@ -0,0 +1,142 @@
+-- |
+-- Support for source code annotation feature of GHC. That is the ANN pragma.
+--
+-- (c) The University of Glasgow 2006
+-- (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+--
+{-# LANGUAGE DeriveFunctor #-}
+module GHC.Types.Annotations (
+        -- * Main Annotation data types
+        Annotation(..), AnnPayload,
+        AnnTarget(..), CoreAnnTarget,
+
+        -- * AnnEnv for collecting and querying Annotations
+        AnnEnv,
+        mkAnnEnv, extendAnnEnvList, plusAnnEnv, emptyAnnEnv,
+        findAnns, findAnnsByTypeRep,
+        deserializeAnns
+    ) where
+
+import GhcPrelude
+
+import Binary
+import GHC.Types.Module ( Module
+                        , ModuleEnv, emptyModuleEnv, extendModuleEnvWith
+                        , plusModuleEnv_C, lookupWithDefaultModuleEnv
+                        , mapModuleEnv )
+import GHC.Types.Name.Env
+import GHC.Types.Name
+import Outputable
+import GHC.Serialized
+
+import Control.Monad
+import Data.Maybe
+import Data.Typeable
+import Data.Word        ( Word8 )
+
+
+-- | Represents an annotation after it has been sufficiently desugared from
+-- it's initial form of 'HsDecls.AnnDecl'
+data Annotation = Annotation {
+        ann_target :: CoreAnnTarget,    -- ^ The target of the annotation
+        ann_value  :: AnnPayload
+    }
+
+type AnnPayload = Serialized    -- ^ The "payload" of an annotation
+                                --   allows recovery of its value at a given type,
+                                --   and can be persisted to an interface file
+
+-- | An annotation target
+data AnnTarget name
+  = NamedTarget name          -- ^ We are annotating something with a name:
+                              --      a type or identifier
+  | ModuleTarget Module       -- ^ We are annotating a particular module
+  deriving (Functor)
+
+-- | The kind of annotation target found in the middle end of the compiler
+type CoreAnnTarget = AnnTarget Name
+
+instance Outputable name => Outputable (AnnTarget name) where
+    ppr (NamedTarget nm) = text "Named target" <+> ppr nm
+    ppr (ModuleTarget mod) = text "Module target" <+> ppr mod
+
+instance Binary name => Binary (AnnTarget name) where
+    put_ bh (NamedTarget a) = do
+        putByte bh 0
+        put_ bh a
+    put_ bh (ModuleTarget a) = do
+        putByte bh 1
+        put_ bh a
+    get bh = do
+        h <- getByte bh
+        case h of
+            0 -> liftM NamedTarget  $ get bh
+            _ -> liftM ModuleTarget $ get bh
+
+instance Outputable Annotation where
+    ppr ann = ppr (ann_target ann)
+
+-- | A collection of annotations
+data AnnEnv = MkAnnEnv { ann_mod_env :: !(ModuleEnv [AnnPayload])
+                       , ann_name_env :: !(NameEnv [AnnPayload])
+                       }
+
+-- | An empty annotation environment.
+emptyAnnEnv :: AnnEnv
+emptyAnnEnv = MkAnnEnv emptyModuleEnv emptyNameEnv
+
+-- | Construct a new annotation environment that contains the list of
+-- annotations provided.
+mkAnnEnv :: [Annotation] -> AnnEnv
+mkAnnEnv = extendAnnEnvList emptyAnnEnv
+
+-- | Add the given annotation to the environment.
+extendAnnEnvList :: AnnEnv -> [Annotation] -> AnnEnv
+extendAnnEnvList env =
+  foldl' extendAnnEnv env
+
+extendAnnEnv :: AnnEnv -> Annotation -> AnnEnv
+extendAnnEnv (MkAnnEnv mod_env name_env) (Annotation tgt payload) =
+  case tgt of
+    NamedTarget name -> MkAnnEnv mod_env (extendNameEnv_C (++) name_env name [payload])
+    ModuleTarget mod -> MkAnnEnv (extendModuleEnvWith (++) mod_env mod [payload]) name_env
+
+-- | Union two annotation environments.
+plusAnnEnv :: AnnEnv -> AnnEnv -> AnnEnv
+plusAnnEnv a b =
+  MkAnnEnv { ann_mod_env = plusModuleEnv_C (++) (ann_mod_env a) (ann_mod_env b)
+           , ann_name_env = plusNameEnv_C (++) (ann_name_env a) (ann_name_env b)
+           }
+
+-- | Find the annotations attached to the given target as 'Typeable'
+--   values of your choice. If no deserializer is specified,
+--   only transient annotations will be returned.
+findAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> CoreAnnTarget -> [a]
+findAnns deserialize env
+  = mapMaybe (fromSerialized deserialize) . findAnnPayloads env
+
+-- | Find the annotations attached to the given target as 'Typeable'
+--   values of your choice. If no deserializer is specified,
+--   only transient annotations will be returned.
+findAnnsByTypeRep :: AnnEnv -> CoreAnnTarget -> TypeRep -> [[Word8]]
+findAnnsByTypeRep env target tyrep
+  = [ ws | Serialized tyrep' ws <- findAnnPayloads env target
+    , tyrep' == tyrep ]
+
+-- | Find payloads for the given 'CoreAnnTarget' in an 'AnnEnv'.
+findAnnPayloads :: AnnEnv -> CoreAnnTarget -> [AnnPayload]
+findAnnPayloads env target =
+  case target of
+    ModuleTarget mod -> lookupWithDefaultModuleEnv (ann_mod_env env) [] mod
+    NamedTarget name -> fromMaybe [] $ lookupNameEnv (ann_name_env env) name
+
+-- | Deserialize all annotations of a given type. This happens lazily, that is
+--   no deserialization will take place until the [a] is actually demanded and
+--   the [a] can also be empty (the UniqFM is not filtered).
+deserializeAnns :: Typeable a => ([Word8] -> a) -> AnnEnv -> (ModuleEnv [a], NameEnv [a])
+deserializeAnns deserialize env
+  = ( mapModuleEnv deserAnns (ann_mod_env env)
+    , mapNameEnv deserAnns (ann_name_env env)
+    )
+  where deserAnns = mapMaybe (fromSerialized deserialize)
+
diff --git a/compiler/GHC/Types/Avail.hs b/compiler/GHC/Types/Avail.hs
new file mode 100644
index 0000000000..8730ce2e88
--- /dev/null
+++ b/compiler/GHC/Types/Avail.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+--
+-- (c) The University of Glasgow
+--
+
+#include "HsVersions.h"
+
+module GHC.Types.Avail (
+    Avails,
+    AvailInfo(..),
+    avail,
+    availsToNameSet,
+    availsToNameSetWithSelectors,
+    availsToNameEnv,
+    availName, availNames, availNonFldNames,
+    availNamesWithSelectors,
+    availFlds,
+    availsNamesWithOccs,
+    availNamesWithOccs,
+    stableAvailCmp,
+    plusAvail,
+    trimAvail,
+    filterAvail,
+    filterAvails,
+    nubAvails
+
+
+  ) where
+
+import GhcPrelude
+
+import GHC.Types.Name
+import GHC.Types.Name.Env
+import GHC.Types.Name.Set
+
+import GHC.Types.FieldLabel
+import Binary
+import ListSetOps
+import Outputable
+import Util
+
+import Data.Data ( Data )
+import Data.List ( find )
+import Data.Function
+
+-- -----------------------------------------------------------------------------
+-- The AvailInfo type
+
+-- | Records what things are \"available\", i.e. in scope
+data AvailInfo
+
+  -- | An ordinary identifier in scope
+  = Avail Name
+
+  -- | A type or class in scope
+  --
+  -- The __AvailTC Invariant__: If the type or class is itself to be in scope,
+  -- it must be /first/ in this list.  Thus, typically:
+  --
+  -- > AvailTC Eq [Eq, ==, \/=] []
+  | AvailTC
+       Name         -- ^ The name of the type or class
+       [Name]       -- ^ The available pieces of type or class,
+                    -- excluding field selectors.
+       [FieldLabel] -- ^ The record fields of the type
+                    -- (see Note [Representing fields in AvailInfo]).
+
+   deriving ( Eq    -- ^ Used when deciding if the interface has changed
+            , Data )
+
+-- | A collection of 'AvailInfo' - several things that are \"available\"
+type Avails = [AvailInfo]
+
+{-
+Note [Representing fields in AvailInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When -XDuplicateRecordFields is disabled (the normal case), a
+datatype like
+
+  data T = MkT { foo :: Int }
+
+gives rise to the AvailInfo
+
+  AvailTC T [T, MkT] [FieldLabel "foo" False foo]
+
+whereas if -XDuplicateRecordFields is enabled it gives
+
+  AvailTC T [T, MkT] [FieldLabel "foo" True $sel:foo:MkT]
+
+since the label does not match the selector name.
+
+The labels in a field list are not necessarily unique:
+data families allow the same parent (the family tycon) to have
+multiple distinct fields with the same label. For example,
+
+  data family F a
+  data instance F Int  = MkFInt { foo :: Int }
+  data instance F Bool = MkFBool { foo :: Bool}
+
+gives rise to
+
+  AvailTC F [ F, MkFInt, MkFBool ]
+            [ FieldLabel "foo" True $sel:foo:MkFInt
+            , FieldLabel "foo" True $sel:foo:MkFBool ]
+
+Moreover, note that the flIsOverloaded flag need not be the same for
+all the elements of the list.  In the example above, this occurs if
+the two data instances are defined in different modules, one with
+`-XDuplicateRecordFields` enabled and one with it disabled.  Thus it
+is possible to have
+
+  AvailTC F [ F, MkFInt, MkFBool ]
+            [ FieldLabel "foo" True $sel:foo:MkFInt
+            , FieldLabel "foo" False foo ]
+
+If the two data instances are defined in different modules, both
+without `-XDuplicateRecordFields`, it will be impossible to export
+them from the same module (even with `-XDuplicateRecordfields`
+enabled), because they would be represented identically.  The
+workaround here is to enable `-XDuplicateRecordFields` on the defining
+modules.
+-}
+
+-- | Compare lexicographically
+stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
+stableAvailCmp (Avail n1)       (Avail n2)   = n1 `stableNameCmp` n2
+stableAvailCmp (Avail {})         (AvailTC {})   = LT
+stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) =
+    (n `stableNameCmp` m) `thenCmp`
+    (cmpList stableNameCmp ns ms) `thenCmp`
+    (cmpList (stableNameCmp `on` flSelector) nfs mfs)
+stableAvailCmp (AvailTC {})       (Avail {})     = GT
+
+avail :: Name -> AvailInfo
+avail n = Avail n
+
+-- -----------------------------------------------------------------------------
+-- Operations on AvailInfo
+
+availsToNameSet :: [AvailInfo] -> NameSet
+availsToNameSet avails = foldr add emptyNameSet avails
+      where add avail set = extendNameSetList set (availNames avail)
+
+availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
+availsToNameSetWithSelectors avails = foldr add emptyNameSet avails
+      where add avail set = extendNameSetList set (availNamesWithSelectors avail)
+
+availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
+availsToNameEnv avails = foldr add emptyNameEnv avails
+     where add avail env = extendNameEnvList env
+                                (zip (availNames avail) (repeat avail))
+
+-- | Just the main name made available, i.e. not the available pieces
+-- of type or class brought into scope by the 'GenAvailInfo'
+availName :: AvailInfo -> Name
+availName (Avail n)     = n
+availName (AvailTC n _ _) = n
+
+-- | All names made available by the availability information (excluding overloaded selectors)
+availNames :: AvailInfo -> [Name]
+availNames (Avail n)         = [n]
+availNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ]
+
+-- | All names made available by the availability information (including overloaded selectors)
+availNamesWithSelectors :: AvailInfo -> [Name]
+availNamesWithSelectors (Avail n)         = [n]
+availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs
+
+-- | Names for non-fields made available by the availability information
+availNonFldNames :: AvailInfo -> [Name]
+availNonFldNames (Avail n)        = [n]
+availNonFldNames (AvailTC _ ns _) = ns
+
+-- | Fields made available by the availability information
+availFlds :: AvailInfo -> [FieldLabel]
+availFlds (AvailTC _ _ fs) = fs
+availFlds _                = []
+
+availsNamesWithOccs :: [AvailInfo] -> [(Name, OccName)]
+availsNamesWithOccs = concatMap availNamesWithOccs
+
+-- | 'Name's made available by the availability information, paired with
+-- the 'OccName' used to refer to each one.
+--
+-- When @DuplicateRecordFields@ is in use, the 'Name' may be the
+-- mangled name of a record selector (e.g. @$sel:foo:MkT@) while the
+-- 'OccName' will be the label of the field (e.g. @foo@).
+--
+-- See Note [Representing fields in AvailInfo].
+availNamesWithOccs :: AvailInfo -> [(Name, OccName)]
+availNamesWithOccs (Avail n) = [(n, nameOccName n)]
+availNamesWithOccs (AvailTC _ ns fs)
+  = [ (n, nameOccName n) | n <- ns ] ++
+    [ (flSelector fl, mkVarOccFS (flLabel fl)) | fl <- fs ]
+
+-- -----------------------------------------------------------------------------
+-- Utility
+
+plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
+plusAvail a1 a2
+  | debugIsOn && availName a1 /= availName a2
+  = pprPanic "GHC.Rename.Env.plusAvail names differ" (hsep [ppr a1,ppr a2])
+plusAvail a1@(Avail {})         (Avail {})        = a1
+plusAvail (AvailTC _ [] [])     a2@(AvailTC {})   = a2
+plusAvail a1@(AvailTC {})       (AvailTC _ [] []) = a1
+plusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2)
+  = case (n1==s1, n2==s2) of  -- Maintain invariant the parent is first
+       (True,True)   -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))
+                                   (fs1 `unionLists` fs2)
+       (True,False)  -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))
+                                   (fs1 `unionLists` fs2)
+       (False,True)  -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))
+                                   (fs1 `unionLists` fs2)
+       (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
+                                   (fs1 `unionLists` fs2)
+plusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2)
+  = AvailTC n1 ss1 (fs1 `unionLists` fs2)
+plusAvail (AvailTC n1 [] fs1)  (AvailTC _ ss2 fs2)
+  = AvailTC n1 ss2 (fs1 `unionLists` fs2)
+plusAvail a1 a2 = pprPanic "GHC.Rename.Env.plusAvail" (hsep [ppr a1,ppr a2])
+
+-- | trims an 'AvailInfo' to keep only a single name
+trimAvail :: AvailInfo -> Name -> AvailInfo
+trimAvail (Avail n)         _ = Avail n
+trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of
+    Just x  -> AvailTC n [] [x]
+    Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []
+
+-- | filters 'AvailInfo's by the given predicate
+filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
+filterAvails keep avails = foldr (filterAvail keep) [] avails
+
+-- | filters an 'AvailInfo' by the given predicate
+filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
+filterAvail keep ie rest =
+  case ie of
+    Avail n | keep n    -> ie : rest
+            | otherwise -> rest
+    AvailTC tc ns fs ->
+        let ns' = filter keep ns
+            fs' = filter (keep . flSelector) fs in
+        if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest
+
+
+-- | Combines 'AvailInfo's from the same family
+-- 'avails' may have several items with the same availName
+-- E.g  import Ix( Ix(..), index )
+-- will give Ix(Ix,index,range) and Ix(index)
+-- We want to combine these; addAvail does that
+nubAvails :: [AvailInfo] -> [AvailInfo]
+nubAvails avails = nameEnvElts (foldl' add emptyNameEnv avails)
+  where
+    add env avail = extendNameEnv_C plusAvail env (availName avail) avail
+
+-- -----------------------------------------------------------------------------
+-- Printing
+
+instance Outputable AvailInfo where
+   ppr = pprAvail
+
+pprAvail :: AvailInfo -> SDoc
+pprAvail (Avail n)
+  = ppr n
+pprAvail (AvailTC n ns fs)
+  = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi
+                         , fsep (punctuate comma (map (ppr . flLabel) fs))])
+
+instance Binary AvailInfo where
+    put_ bh (Avail aa) = do
+            putByte bh 0
+            put_ bh aa
+    put_ bh (AvailTC ab ac ad) = do
+            putByte bh 1
+            put_ bh ab
+            put_ bh ac
+            put_ bh ad
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do aa <- get bh
+                      return (Avail aa)
+              _ -> do ab <- get bh
+                      ac <- get bh
+                      ad <- get bh
+                      return (AvailTC ab ac ad)
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
new file mode 100644
index 0000000000..03988d9028
--- /dev/null
+++ b/compiler/GHC/Types/Basic.hs
@@ -0,0 +1,1736 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1997-1998
+
+\section[BasicTypes]{Miscellaneous types}
+
+This module defines a miscellaneously collection of very simple
+types that
+
+\begin{itemize}
+\item have no other obvious home
+\item don't depend on any other complicated types
+\item are used in more than one "part" of the compiler
+\end{itemize}
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
+
+module GHC.Types.Basic (
+        Version, bumpVersion, initialVersion,
+
+        LeftOrRight(..),
+        pickLR,
+
+        ConTag, ConTagZ, fIRST_TAG,
+
+        Arity, RepArity, JoinArity,
+
+        Alignment, mkAlignment, alignmentOf, alignmentBytes,
+
+        PromotionFlag(..), isPromoted,
+        FunctionOrData(..),
+
+        WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..),
+
+        Fixity(..), FixityDirection(..),
+        defaultFixity, maxPrecedence, minPrecedence,
+        negateFixity, funTyFixity,
+        compareFixity,
+        LexicalFixity(..),
+
+        RecFlag(..), isRec, isNonRec, boolToRecFlag,
+        Origin(..), isGenerated,
+
+        RuleName, pprRuleName,
+
+        TopLevelFlag(..), isTopLevel, isNotTopLevel,
+
+        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
+        hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,
+
+        Boxity(..), isBoxed,
+
+        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, starPrec, appPrec,
+        maybeParen,
+
+        TupleSort(..), tupleSortBoxity, boxityTupleSort,
+        tupleParens,
+
+        sumParens, pprAlternative,
+
+        -- ** The OneShotInfo type
+        OneShotInfo(..),
+        noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
+        bestOneShot, worstOneShot,
+
+        OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,
+        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
+        strongLoopBreaker, weakLoopBreaker,
+
+        InsideLam(..),
+        OneBranch(..),
+        InterestingCxt(..),
+        TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
+        isAlwaysTailCalled,
+
+        EP(..),
+
+        DefMethSpec(..),
+        SwapFlag(..), flipSwap, unSwap, isSwapped,
+
+        CompilerPhase(..), PhaseNum,
+
+        Activation(..), isActive, isActiveIn, competesWith,
+        isNeverActive, isAlwaysActive, isEarlyActive,
+        activeAfterInitial, activeDuringFinal,
+
+        RuleMatchInfo(..), isConLike, isFunLike,
+        InlineSpec(..), noUserInlineSpec,
+        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
+        neverInlinePragma, dfunInlinePragma,
+        isDefaultInlinePragma,
+        isInlinePragma, isInlinablePragma, isAnyInlinePragma,
+        inlinePragmaSpec, inlinePragmaSat,
+        inlinePragmaActivation, inlinePragmaRuleMatchInfo,
+        setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
+        pprInline, pprInlineDebug,
+
+        SuccessFlag(..), succeeded, failed, successIf,
+
+        IntegralLit(..), FractionalLit(..),
+        negateIntegralLit, negateFractionalLit,
+        mkIntegralLit, mkFractionalLit,
+        integralFractionalLit,
+
+        SourceText(..), pprWithSourceText,
+
+        IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,
+
+        SpliceExplicitFlag(..),
+
+        TypeOrKind(..), isTypeLevel, isKindLevel
+   ) where
+
+import GhcPrelude
+
+import FastString
+import Outputable
+import GHC.Types.SrcLoc ( Located,unLoc )
+import Data.Data hiding (Fixity, Prefix, Infix)
+import Data.Function (on)
+import Data.Bits
+import qualified Data.Semigroup as Semi
+
+{-
+************************************************************************
+*                                                                      *
+          Binary choice
+*                                                                      *
+************************************************************************
+-}
+
+data LeftOrRight = CLeft | CRight
+                 deriving( Eq, Data )
+
+pickLR :: LeftOrRight -> (a,a) -> a
+pickLR CLeft  (l,_) = l
+pickLR CRight (_,r) = r
+
+instance Outputable LeftOrRight where
+  ppr CLeft    = text "Left"
+  ppr CRight   = text "Right"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Arity]{Arity}
+*                                                                      *
+************************************************************************
+-}
+
+-- | The number of value arguments that can be applied to a value before it does
+-- "real work". So:
+--  fib 100     has arity 0
+--  \x -> fib x has arity 1
+-- See also Note [Definition of arity] in GHC.Core.Arity
+type Arity = Int
+
+-- | Representation Arity
+--
+-- The number of represented arguments that can be applied to a value before it does
+-- "real work". So:
+--  fib 100                    has representation arity 0
+--  \x -> fib x                has representation arity 1
+--  \(# x, y #) -> fib (x + y) has representation arity 2
+type RepArity = Int
+
+-- | The number of arguments that a join point takes. Unlike the arity of a
+-- function, this is a purely syntactic property and is fixed when the join
+-- point is created (or converted from a value). Both type and value arguments
+-- are counted.
+type JoinArity = Int
+
+{-
+************************************************************************
+*                                                                      *
+              Constructor tags
+*                                                                      *
+************************************************************************
+-}
+
+-- | Constructor Tag
+--
+-- Type of the tags associated with each constructor possibility or superclass
+-- selector
+type ConTag = Int
+
+-- | A *zero-indexed* constructor tag
+type ConTagZ = Int
+
+fIRST_TAG :: ConTag
+-- ^ Tags are allocated from here for real constructors
+--   or for superclass selectors
+fIRST_TAG =  1
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Alignment]{Alignment}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A power-of-two alignment
+newtype Alignment = Alignment { alignmentBytes :: Int } deriving (Eq, Ord)
+
+-- Builds an alignment, throws on non power of 2 input. This is not
+-- ideal, but convenient for internal use and better then silently
+-- passing incorrect data.
+mkAlignment :: Int -> Alignment
+mkAlignment n
+  | n == 1 = Alignment 1
+  | n == 2 = Alignment 2
+  | n == 4 = Alignment 4
+  | n == 8 = Alignment 8
+  | n == 16 = Alignment 16
+  | n == 32 = Alignment 32
+  | n == 64 = Alignment 64
+  | n == 128 = Alignment 128
+  | n == 256 = Alignment 256
+  | n == 512 = Alignment 512
+  | otherwise = panic "mkAlignment: received either a non power of 2 argument or > 512"
+
+-- Calculates an alignment of a number. x is aligned at N bytes means
+-- the remainder from x / N is zero. Currently, interested in N <= 8,
+-- but can be expanded to N <= 16 or N <= 32 if used within SSE or AVX
+-- context.
+alignmentOf :: Int -> Alignment
+alignmentOf x = case x .&. 7 of
+  0 -> Alignment 8
+  4 -> Alignment 4
+  2 -> Alignment 2
+  _ -> Alignment 1
+
+instance Outputable Alignment where
+  ppr (Alignment m) = ppr m
+{-
+************************************************************************
+*                                                                      *
+         One-shot information
+*                                                                      *
+************************************************************************
+-}
+
+-- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
+-- variable info. Sometimes we know whether the lambda binding this variable
+-- is a \"one-shot\" lambda; that is, whether it is applied at most once.
+--
+-- This information may be useful in optimisation, as computations may
+-- safely be floated inside such a lambda without risk of duplicating
+-- work.
+data OneShotInfo
+  = NoOneShotInfo -- ^ No information
+  | OneShotLam    -- ^ The lambda is applied at most once.
+  deriving (Eq)
+
+-- | It is always safe to assume that an 'Id' has no lambda-bound variable information
+noOneShotInfo :: OneShotInfo
+noOneShotInfo = NoOneShotInfo
+
+isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
+isOneShotInfo OneShotLam = True
+isOneShotInfo _          = False
+
+hasNoOneShotInfo NoOneShotInfo = True
+hasNoOneShotInfo _             = False
+
+worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
+worstOneShot NoOneShotInfo _             = NoOneShotInfo
+worstOneShot OneShotLam    os            = os
+
+bestOneShot NoOneShotInfo os         = os
+bestOneShot OneShotLam    _          = OneShotLam
+
+pprOneShotInfo :: OneShotInfo -> SDoc
+pprOneShotInfo NoOneShotInfo = empty
+pprOneShotInfo OneShotLam    = text "OneShot"
+
+instance Outputable OneShotInfo where
+    ppr = pprOneShotInfo
+
+{-
+************************************************************************
+*                                                                      *
+           Swap flag
+*                                                                      *
+************************************************************************
+-}
+
+data SwapFlag
+  = NotSwapped  -- Args are: actual,   expected
+  | IsSwapped   -- Args are: expected, actual
+
+instance Outputable SwapFlag where
+  ppr IsSwapped  = text "Is-swapped"
+  ppr NotSwapped = text "Not-swapped"
+
+flipSwap :: SwapFlag -> SwapFlag
+flipSwap IsSwapped  = NotSwapped
+flipSwap NotSwapped = IsSwapped
+
+isSwapped :: SwapFlag -> Bool
+isSwapped IsSwapped  = True
+isSwapped NotSwapped = False
+
+unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
+unSwap NotSwapped f a b = f a b
+unSwap IsSwapped  f a b = f b a
+
+
+{- *********************************************************************
+*                                                                      *
+           Promotion flag
+*                                                                      *
+********************************************************************* -}
+
+-- | Is a TyCon a promoted data constructor or just a normal type constructor?
+data PromotionFlag
+  = NotPromoted
+  | IsPromoted
+  deriving ( Eq, Data )
+
+isPromoted :: PromotionFlag -> Bool
+isPromoted IsPromoted  = True
+isPromoted NotPromoted = False
+
+instance Outputable PromotionFlag where
+  ppr NotPromoted = text "NotPromoted"
+  ppr IsPromoted  = text "IsPromoted"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[FunctionOrData]{FunctionOrData}
+*                                                                      *
+************************************************************************
+-}
+
+data FunctionOrData = IsFunction | IsData
+    deriving (Eq, Ord, Data)
+
+instance Outputable FunctionOrData where
+    ppr IsFunction = text "(function)"
+    ppr IsData     = text "(data)"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Version]{Module and identifier version numbers}
+*                                                                      *
+************************************************************************
+-}
+
+type Version = Int
+
+bumpVersion :: Version -> Version
+bumpVersion v = v+1
+
+initialVersion :: Version
+initialVersion = 1
+
+{-
+************************************************************************
+*                                                                      *
+                Deprecations
+*                                                                      *
+************************************************************************
+-}
+
+-- | A String Literal in the source, including its original raw format for use by
+-- source to source manipulation tools.
+data StringLiteral = StringLiteral
+                       { sl_st :: SourceText, -- literal raw source.
+                                              -- See not [Literal source text]
+                         sl_fs :: FastString  -- literal string value
+                       } deriving Data
+
+instance Eq StringLiteral where
+  (StringLiteral _ a) == (StringLiteral _ b) = a == b
+
+instance Outputable StringLiteral where
+  ppr sl = pprWithSourceText (sl_st sl) (ftext $ sl_fs sl)
+
+-- | Warning Text
+--
+-- reason/explanation from a WARNING or DEPRECATED pragma
+data WarningTxt = WarningTxt (Located SourceText)
+                             [Located StringLiteral]
+                | DeprecatedTxt (Located SourceText)
+                                [Located StringLiteral]
+    deriving (Eq, Data)
+
+instance Outputable WarningTxt where
+    ppr (WarningTxt    lsrc ws)
+      = case unLoc lsrc of
+          NoSourceText   -> pp_ws ws
+          SourceText src -> text src <+> pp_ws ws <+> text "#-}"
+
+    ppr (DeprecatedTxt lsrc  ds)
+      = case unLoc lsrc of
+          NoSourceText   -> pp_ws ds
+          SourceText src -> text src <+> pp_ws ds <+> text "#-}"
+
+pp_ws :: [Located StringLiteral] -> SDoc
+pp_ws [l] = ppr $ unLoc l
+pp_ws ws
+  = text "["
+    <+> vcat (punctuate comma (map (ppr . unLoc) ws))
+    <+> text "]"
+
+
+pprWarningTxtForMsg :: WarningTxt -> SDoc
+pprWarningTxtForMsg (WarningTxt    _ ws)
+                     = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws))
+pprWarningTxtForMsg (DeprecatedTxt _ ds)
+                     = text "Deprecated:" <+>
+                       doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds))
+
+{-
+************************************************************************
+*                                                                      *
+                Rules
+*                                                                      *
+************************************************************************
+-}
+
+type RuleName = FastString
+
+pprRuleName :: RuleName -> SDoc
+pprRuleName rn = doubleQuotes (ftext rn)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Fixity]{Fixity info}
+*                                                                      *
+************************************************************************
+-}
+
+------------------------
+data Fixity = Fixity SourceText Int FixityDirection
+  -- Note [Pragma source text]
+  deriving Data
+
+instance Outputable Fixity where
+    ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
+
+instance Eq Fixity where -- Used to determine if two fixities conflict
+  (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
+
+------------------------
+data FixityDirection = InfixL | InfixR | InfixN
+                     deriving (Eq, Data)
+
+instance Outputable FixityDirection where
+    ppr InfixL = text "infixl"
+    ppr InfixR = text "infixr"
+    ppr InfixN = text "infix"
+
+------------------------
+maxPrecedence, minPrecedence :: Int
+maxPrecedence = 9
+minPrecedence = 0
+
+defaultFixity :: Fixity
+defaultFixity = Fixity NoSourceText maxPrecedence InfixL
+
+negateFixity, funTyFixity :: Fixity
+-- Wired-in fixities
+negateFixity = Fixity NoSourceText 6 InfixL  -- Fixity of unary negate
+funTyFixity  = Fixity NoSourceText (-1) InfixR  -- Fixity of '->', see #15235
+
+{-
+Consider
+
+\begin{verbatim}
+        a `op1` b `op2` c
+\end{verbatim}
+@(compareFixity op1 op2)@ tells which way to arrange application, or
+whether there's an error.
+-}
+
+compareFixity :: Fixity -> Fixity
+              -> (Bool,         -- Error please
+                  Bool)         -- Associate to the right: a op1 (b op2 c)
+compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
+  = case prec1 `compare` prec2 of
+        GT -> left
+        LT -> right
+        EQ -> case (dir1, dir2) of
+                        (InfixR, InfixR) -> right
+                        (InfixL, InfixL) -> left
+                        _                -> error_please
+  where
+    right        = (False, True)
+    left         = (False, False)
+    error_please = (True,  False)
+
+-- |Captures the fixity of declarations as they are parsed. This is not
+-- necessarily the same as the fixity declaration, as the normal fixity may be
+-- overridden using parens or backticks.
+data LexicalFixity = Prefix | Infix deriving (Data,Eq)
+
+instance Outputable LexicalFixity where
+  ppr Prefix = text "Prefix"
+  ppr Infix  = text "Infix"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Top-level/local]{Top-level/not-top level flag}
+*                                                                      *
+************************************************************************
+-}
+
+data TopLevelFlag
+  = TopLevel
+  | NotTopLevel
+
+isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
+
+isNotTopLevel NotTopLevel = True
+isNotTopLevel TopLevel    = False
+
+isTopLevel TopLevel     = True
+isTopLevel NotTopLevel  = False
+
+instance Outputable TopLevelFlag where
+  ppr TopLevel    = text "<TopLevel>"
+  ppr NotTopLevel = text "<NotTopLevel>"
+
+{-
+************************************************************************
+*                                                                      *
+                Boxity flag
+*                                                                      *
+************************************************************************
+-}
+
+data Boxity
+  = Boxed
+  | Unboxed
+  deriving( Eq, Data )
+
+isBoxed :: Boxity -> Bool
+isBoxed Boxed   = True
+isBoxed Unboxed = False
+
+instance Outputable Boxity where
+  ppr Boxed   = text "Boxed"
+  ppr Unboxed = text "Unboxed"
+
+{-
+************************************************************************
+*                                                                      *
+                Recursive/Non-Recursive flag
+*                                                                      *
+************************************************************************
+-}
+
+-- | Recursivity Flag
+data RecFlag = Recursive
+             | NonRecursive
+             deriving( Eq, Data )
+
+isRec :: RecFlag -> Bool
+isRec Recursive    = True
+isRec NonRecursive = False
+
+isNonRec :: RecFlag -> Bool
+isNonRec Recursive    = False
+isNonRec NonRecursive = True
+
+boolToRecFlag :: Bool -> RecFlag
+boolToRecFlag True  = Recursive
+boolToRecFlag False = NonRecursive
+
+instance Outputable RecFlag where
+  ppr Recursive    = text "Recursive"
+  ppr NonRecursive = text "NonRecursive"
+
+{-
+************************************************************************
+*                                                                      *
+                Code origin
+*                                                                      *
+************************************************************************
+-}
+
+data Origin = FromSource
+            | Generated
+            deriving( Eq, Data )
+
+isGenerated :: Origin -> Bool
+isGenerated Generated = True
+isGenerated FromSource = False
+
+instance Outputable Origin where
+  ppr FromSource  = text "FromSource"
+  ppr Generated   = text "Generated"
+
+{-
+************************************************************************
+*                                                                      *
+                Instance overlap flag
+*                                                                      *
+************************************************************************
+-}
+
+-- | The semantics allowed for overlapping instances for a particular
+-- instance. See Note [Safe Haskell isSafeOverlap] (in `InstEnv.hs`) for a
+-- explanation of the `isSafeOverlap` field.
+--
+-- - 'ApiAnnotation.AnnKeywordId' :
+--      'ApiAnnotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
+--                              @'\{-\# OVERLAPPING'@ or
+--                              @'\{-\# OVERLAPS'@ or
+--                              @'\{-\# INCOHERENT'@,
+--      'ApiAnnotation.AnnClose' @`\#-\}`@,
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data OverlapFlag = OverlapFlag
+  { overlapMode   :: OverlapMode
+  , isSafeOverlap :: Bool
+  } deriving (Eq, Data)
+
+setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
+setOverlapModeMaybe f Nothing  = f
+setOverlapModeMaybe f (Just m) = f { overlapMode = m }
+
+hasIncoherentFlag :: OverlapMode -> Bool
+hasIncoherentFlag mode =
+  case mode of
+    Incoherent   _ -> True
+    _              -> False
+
+hasOverlappableFlag :: OverlapMode -> Bool
+hasOverlappableFlag mode =
+  case mode of
+    Overlappable _ -> True
+    Overlaps     _ -> True
+    Incoherent   _ -> True
+    _              -> False
+
+hasOverlappingFlag :: OverlapMode -> Bool
+hasOverlappingFlag mode =
+  case mode of
+    Overlapping  _ -> True
+    Overlaps     _ -> True
+    Incoherent   _ -> True
+    _              -> False
+
+data OverlapMode  -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
+  = NoOverlap SourceText
+                  -- See Note [Pragma source text]
+    -- ^ This instance must not overlap another `NoOverlap` instance.
+    -- However, it may be overlapped by `Overlapping` instances,
+    -- and it may overlap `Overlappable` instances.
+
+
+  | Overlappable SourceText
+                  -- See Note [Pragma source text]
+    -- ^ Silently ignore this instance if you find a
+    -- more specific one that matches the constraint
+    -- you are trying to resolve
+    --
+    -- Example: constraint (Foo [Int])
+    --   instance                      Foo [Int]
+    --   instance {-# OVERLAPPABLE #-} Foo [a]
+    --
+    -- Since the second instance has the Overlappable flag,
+    -- the first instance will be chosen (otherwise
+    -- its ambiguous which to choose)
+
+
+  | Overlapping SourceText
+                  -- See Note [Pragma source text]
+    -- ^ Silently ignore any more general instances that may be
+    --   used to solve the constraint.
+    --
+    -- Example: constraint (Foo [Int])
+    --   instance {-# OVERLAPPING #-} Foo [Int]
+    --   instance                     Foo [a]
+    --
+    -- Since the first instance has the Overlapping flag,
+    -- the second---more general---instance will be ignored (otherwise
+    -- it is ambiguous which to choose)
+
+
+  | Overlaps SourceText
+                  -- See Note [Pragma source text]
+    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
+
+  | Incoherent SourceText
+                  -- See Note [Pragma source text]
+    -- ^ Behave like Overlappable and Overlapping, and in addition pick
+    -- an an arbitrary one if there are multiple matching candidates, and
+    -- don't worry about later instantiation
+    --
+    -- Example: constraint (Foo [b])
+    -- instance {-# INCOHERENT -} Foo [Int]
+    -- instance                   Foo [a]
+    -- Without the Incoherent flag, we'd complain that
+    -- instantiating 'b' would change which instance
+    -- was chosen. See also note [Incoherent instances] in GHC.Core.InstEnv
+
+  deriving (Eq, Data)
+
+
+instance Outputable OverlapFlag where
+   ppr flag = ppr (overlapMode flag) <+> pprSafeOverlap (isSafeOverlap flag)
+
+instance Outputable OverlapMode where
+   ppr (NoOverlap    _) = empty
+   ppr (Overlappable _) = text "[overlappable]"
+   ppr (Overlapping  _) = text "[overlapping]"
+   ppr (Overlaps     _) = text "[overlap ok]"
+   ppr (Incoherent   _) = text "[incoherent]"
+
+pprSafeOverlap :: Bool -> SDoc
+pprSafeOverlap True  = text "[safe]"
+pprSafeOverlap False = empty
+
+{-
+************************************************************************
+*                                                                      *
+                Precedence
+*                                                                      *
+************************************************************************
+-}
+
+-- | A general-purpose pretty-printing precedence type.
+newtype PprPrec = PprPrec Int deriving (Eq, Ord, Show)
+-- See Note [Precedence in types]
+
+topPrec, sigPrec, funPrec, opPrec, starPrec, appPrec :: PprPrec
+topPrec = PprPrec 0 -- No parens
+sigPrec = PprPrec 1 -- Explicit type signatures
+funPrec = PprPrec 2 -- Function args; no parens for constructor apps
+                    -- See [Type operator precedence] for why both
+                    -- funPrec and opPrec exist.
+opPrec  = PprPrec 2 -- Infix operator
+starPrec = PprPrec 3 -- Star syntax for the type of types, i.e. the * in (* -> *)
+                     -- See Note [Star kind precedence]
+appPrec  = PprPrec 4 -- Constructor args; no parens for atomic
+
+maybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc
+maybeParen ctxt_prec inner_prec pretty
+  | ctxt_prec < inner_prec = pretty
+  | otherwise              = parens pretty
+
+{- Note [Precedence in types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Many pretty-printing functions have type
+    ppr_ty :: PprPrec -> Type -> SDoc
+
+The PprPrec gives the binding strength of the context.  For example, in
+   T ty1 ty2
+we will pretty-print 'ty1' and 'ty2' with the call
+  (ppr_ty appPrec ty)
+to indicate that the context is that of an argument of a TyConApp.
+
+We use this consistently for Type and HsType.
+
+Note [Type operator precedence]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't keep the fixity of type operators in the operator. So the
+pretty printer follows the following precedence order:
+
+   TyConPrec         Type constructor application
+   TyOpPrec/FunPrec  Operator application and function arrow
+
+We have funPrec and opPrec to represent the precedence of function
+arrow and type operators respectively, but currently we implement
+funPrec == opPrec, so that we don't distinguish the two. Reason:
+it's hard to parse a type like
+    a ~ b => c * d -> e - f
+
+By treating opPrec = funPrec we end up with more parens
+    (a ~ b) => (c * d) -> (e - f)
+
+But the two are different constructors of PprPrec so we could make
+(->) bind more or less tightly if we wanted.
+
+Note [Star kind precedence]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We parenthesize the (*) kind to avoid two issues:
+
+1. Printing invalid or incorrect code.
+   For example, instead of  type F @(*) x = x
+         GHC used to print  type F @*   x = x
+   However, (@*) is a type operator, not a kind application.
+
+2. Printing kinds that are correct but hard to read.
+   Should  Either * Int  be read as  Either (*) Int
+                              or as  (*) Either Int  ?
+   This depends on whether -XStarIsType is enabled, but it would be
+   easier if we didn't have to check for the flag when reading the code.
+
+At the same time, we cannot parenthesize (*) blindly.
+Consider this Haskell98 kind:          ((* -> *) -> *) -> *
+With parentheses, it is less readable: (((*) -> (*)) -> (*)) -> (*)
+
+The solution is to assign a special precedence to (*), 'starPrec', which is
+higher than 'funPrec' but lower than 'appPrec':
+
+   F * * *   becomes  F (*) (*) (*)
+   F A * B   becomes  F A (*) B
+   Proxy *   becomes  Proxy (*)
+   a * -> *  becomes  a (*) -> *
+-}
+
+{-
+************************************************************************
+*                                                                      *
+                Tuples
+*                                                                      *
+************************************************************************
+-}
+
+data TupleSort
+  = BoxedTuple
+  | UnboxedTuple
+  | ConstraintTuple
+  deriving( Eq, Data )
+
+instance Outputable TupleSort where
+  ppr ts = text $
+    case ts of
+      BoxedTuple      -> "BoxedTuple"
+      UnboxedTuple    -> "UnboxedTuple"
+      ConstraintTuple -> "ConstraintTuple"
+
+tupleSortBoxity :: TupleSort -> Boxity
+tupleSortBoxity BoxedTuple      = Boxed
+tupleSortBoxity UnboxedTuple    = Unboxed
+tupleSortBoxity ConstraintTuple = Boxed
+
+boxityTupleSort :: Boxity -> TupleSort
+boxityTupleSort Boxed   = BoxedTuple
+boxityTupleSort Unboxed = UnboxedTuple
+
+tupleParens :: TupleSort -> SDoc -> SDoc
+tupleParens BoxedTuple      p = parens p
+tupleParens UnboxedTuple    p = text "(#" <+> p <+> ptext (sLit "#)")
+tupleParens ConstraintTuple p   -- In debug-style write (% Eq a, Ord b %)
+  = ifPprDebug (text "(%" <+> p <+> ptext (sLit "%)"))
+               (parens p)
+
+{-
+************************************************************************
+*                                                                      *
+                Sums
+*                                                                      *
+************************************************************************
+-}
+
+sumParens :: SDoc -> SDoc
+sumParens p = ptext (sLit "(#") <+> p <+> ptext (sLit "#)")
+
+-- | Pretty print an alternative in an unboxed sum e.g. "| a | |".
+pprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use
+               -> a           -- ^ The things to be pretty printed
+               -> ConTag      -- ^ Alternative (one-based)
+               -> Arity       -- ^ Arity
+               -> SDoc        -- ^ 'SDoc' where the alternative havs been pretty
+                              -- printed and finally packed into a paragraph.
+pprAlternative pp x alt arity =
+    fsep (replicate (alt - 1) vbar ++ [pp x] ++ replicate (arity - alt) vbar)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Generic]{Generic flag}
+*                                                                      *
+************************************************************************
+
+This is the "Embedding-Projection pair" datatype, it contains
+two pieces of code (normally either RenamedExpr's or Id's)
+If we have a such a pair (EP from to), the idea is that 'from' and 'to'
+represents functions of type
+
+        from :: T -> Tring
+        to   :: Tring -> T
+
+And we should have
+
+        to (from x) = x
+
+T and Tring are arbitrary, but typically T is the 'main' type while
+Tring is the 'representation' type.  (This just helps us remember
+whether to use 'from' or 'to'.
+-}
+
+-- | Embedding Projection pair
+data EP a = EP { fromEP :: a,   -- :: T -> Tring
+                 toEP   :: a }  -- :: Tring -> T
+
+{-
+Embedding-projection pairs are used in several places:
+
+First of all, each type constructor has an EP associated with it, the
+code in EP converts (datatype T) from T to Tring and back again.
+
+Secondly, when we are filling in Generic methods (in the typechecker,
+tcMethodBinds), we are constructing bimaps by induction on the structure
+of the type of the method signature.
+
+
+************************************************************************
+*                                                                      *
+\subsection{Occurrence information}
+*                                                                      *
+************************************************************************
+
+This data type is used exclusively by the simplifier, but it appears in a
+SubstResult, which is currently defined in GHC.Types.Var.Env, which is pretty
+near the base of the module hierarchy.  So it seemed simpler to put the defn of
+OccInfo here, safely at the bottom
+-}
+
+-- | identifier Occurrence Information
+data OccInfo
+  = ManyOccs        { occ_tail    :: !TailCallInfo }
+                        -- ^ There are many occurrences, or unknown occurrences
+
+  | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
+                        -- lambda and case-bound variables.
+
+  | OneOcc          { occ_in_lam  :: !InsideLam
+                    , occ_one_br  :: !OneBranch
+                    , occ_int_cxt :: !InterestingCxt
+                    , occ_tail    :: !TailCallInfo }
+                        -- ^ Occurs exactly once (per branch), not inside a rule
+
+  -- | This identifier breaks a loop of mutually recursive functions. The field
+  -- marks whether it is only a loop breaker due to a reference in a rule
+  | IAmALoopBreaker { occ_rules_only :: !RulesOnly
+                    , occ_tail       :: !TailCallInfo }
+                        -- Note [LoopBreaker OccInfo]
+  deriving (Eq)
+
+type RulesOnly = Bool
+
+{-
+Note [LoopBreaker OccInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+   IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
+                             Do not preInlineUnconditionally
+
+   IAmALoopBreaker False <=> A "strong" loop breaker
+                             Do not inline at all
+
+See OccurAnal Note [Weak loop breakers]
+-}
+
+noOccInfo :: OccInfo
+noOccInfo = ManyOccs { occ_tail = NoTailCallInfo }
+
+isManyOccs :: OccInfo -> Bool
+isManyOccs ManyOccs{} = True
+isManyOccs _          = False
+
+seqOccInfo :: OccInfo -> ()
+seqOccInfo occ = occ `seq` ()
+
+-----------------
+-- | Interesting Context
+data InterestingCxt
+  = IsInteresting
+    -- ^ Function: is applied
+    --   Data value: scrutinised by a case with at least one non-DEFAULT branch
+  | NotInteresting
+  deriving (Eq)
+
+-- | If there is any 'interesting' identifier occurrence, then the
+-- aggregated occurrence info of that identifier is considered interesting.
+instance Semi.Semigroup InterestingCxt where
+  NotInteresting <> x = x
+  IsInteresting  <> _ = IsInteresting
+
+instance Monoid InterestingCxt where
+  mempty = NotInteresting
+  mappend = (Semi.<>)
+
+-----------------
+-- | Inside Lambda
+data InsideLam
+  = IsInsideLam
+    -- ^ Occurs inside a non-linear lambda
+    -- Substituting a redex for this occurrence is
+    -- dangerous because it might duplicate work.
+  | NotInsideLam
+  deriving (Eq)
+
+-- | If any occurrence of an identifier is inside a lambda, then the
+-- occurrence info of that identifier marks it as occurring inside a lambda
+instance Semi.Semigroup InsideLam where
+  NotInsideLam <> x = x
+  IsInsideLam  <> _ = IsInsideLam
+
+instance Monoid InsideLam where
+  mempty = NotInsideLam
+  mappend = (Semi.<>)
+
+-----------------
+data OneBranch
+  = InOneBranch
+    -- ^ One syntactic occurrence: Occurs in only one case branch
+    -- so no code-duplication issue to worry about
+  | MultipleBranches
+  deriving (Eq)
+
+-----------------
+data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
+                  | NoTailCallInfo
+  deriving (Eq)
+
+tailCallInfo :: OccInfo -> TailCallInfo
+tailCallInfo IAmDead   = NoTailCallInfo
+tailCallInfo other     = occ_tail other
+
+zapOccTailCallInfo :: OccInfo -> OccInfo
+zapOccTailCallInfo IAmDead   = IAmDead
+zapOccTailCallInfo occ       = occ { occ_tail = NoTailCallInfo }
+
+isAlwaysTailCalled :: OccInfo -> Bool
+isAlwaysTailCalled occ
+  = case tailCallInfo occ of AlwaysTailCalled{} -> True
+                             NoTailCallInfo     -> False
+
+instance Outputable TailCallInfo where
+  ppr (AlwaysTailCalled ar) = sep [ text "Tail", int ar ]
+  ppr _                     = empty
+
+-----------------
+strongLoopBreaker, weakLoopBreaker :: OccInfo
+strongLoopBreaker = IAmALoopBreaker False NoTailCallInfo
+weakLoopBreaker   = IAmALoopBreaker True  NoTailCallInfo
+
+isWeakLoopBreaker :: OccInfo -> Bool
+isWeakLoopBreaker (IAmALoopBreaker{}) = True
+isWeakLoopBreaker _                   = False
+
+isStrongLoopBreaker :: OccInfo -> Bool
+isStrongLoopBreaker (IAmALoopBreaker { occ_rules_only = False }) = True
+  -- Loop-breaker that breaks a non-rule cycle
+isStrongLoopBreaker _                                            = False
+
+isDeadOcc :: OccInfo -> Bool
+isDeadOcc IAmDead = True
+isDeadOcc _       = False
+
+isOneOcc :: OccInfo -> Bool
+isOneOcc (OneOcc {}) = True
+isOneOcc _           = False
+
+zapFragileOcc :: OccInfo -> OccInfo
+-- Keep only the most robust data: deadness, loop-breaker-hood
+zapFragileOcc (OneOcc {}) = noOccInfo
+zapFragileOcc occ         = zapOccTailCallInfo occ
+
+instance Outputable OccInfo where
+  -- only used for debugging; never parsed.  KSW 1999-07
+  ppr (ManyOccs tails)     = pprShortTailCallInfo tails
+  ppr IAmDead              = text "Dead"
+  ppr (IAmALoopBreaker rule_only tails)
+        = text "LoopBreaker" <> pp_ro <> pprShortTailCallInfo tails
+        where
+          pp_ro | rule_only = char '!'
+                | otherwise = empty
+  ppr (OneOcc inside_lam one_branch int_cxt tail_info)
+        = text "Once" <> pp_lam inside_lam <> pp_br one_branch <> pp_args int_cxt <> pp_tail
+        where
+          pp_lam IsInsideLam     = char 'L'
+          pp_lam NotInsideLam    = empty
+          pp_br MultipleBranches = char '*'
+          pp_br InOneBranch      = empty
+          pp_args IsInteresting  = char '!'
+          pp_args NotInteresting = empty
+          pp_tail                = pprShortTailCallInfo tail_info
+
+pprShortTailCallInfo :: TailCallInfo -> SDoc
+pprShortTailCallInfo (AlwaysTailCalled ar) = char 'T' <> brackets (int ar)
+pprShortTailCallInfo NoTailCallInfo        = empty
+
+{-
+Note [TailCallInfo]
+~~~~~~~~~~~~~~~~~~~
+The occurrence analyser determines what can be made into a join point, but it
+doesn't change the binder into a JoinId because then it would be inconsistent
+with the occurrences. Thus it's left to the simplifier (or to simpleOptExpr) to
+change the IdDetails.
+
+The AlwaysTailCalled marker actually means slightly more than simply that the
+function is always tail-called. See Note [Invariants on join points].
+
+This info is quite fragile and should not be relied upon unless the occurrence
+analyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of
+the join-point-hood of a binder; a join id itself will not be marked
+AlwaysTailCalled.
+
+Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that
+being tail-called would mean that the variable could only appear once per branch
+(thus getting a `OneOcc { occ_one_br = True }` occurrence info), but a join
+point can also be invoked from other join points, not just from case branches:
+
+  let j1 x = ...
+      j2 y = ... j1 z {- tail call -} ...
+  in case w of
+       A -> j1 v
+       B -> j2 u
+       C -> j2 q
+
+Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get
+ManyOccs and j2 will get `OneOcc { occ_one_br = True }`.
+
+************************************************************************
+*                                                                      *
+                Default method specification
+*                                                                      *
+************************************************************************
+
+The DefMethSpec enumeration just indicates what sort of default method
+is used for a class. It is generated from source code, and present in
+interface files; it is converted to Class.DefMethInfo before begin put in a
+Class object.
+-}
+
+-- | Default Method Specification
+data DefMethSpec ty
+  = VanillaDM     -- Default method given with polymorphic code
+  | GenericDM ty  -- Default method given with code of this type
+
+instance Outputable (DefMethSpec ty) where
+  ppr VanillaDM      = text "{- Has default method -}"
+  ppr (GenericDM {}) = text "{- Has generic default method -}"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Success flag}
+*                                                                      *
+************************************************************************
+-}
+
+data SuccessFlag = Succeeded | Failed
+
+instance Outputable SuccessFlag where
+    ppr Succeeded = text "Succeeded"
+    ppr Failed    = text "Failed"
+
+successIf :: Bool -> SuccessFlag
+successIf True  = Succeeded
+successIf False = Failed
+
+succeeded, failed :: SuccessFlag -> Bool
+succeeded Succeeded = True
+succeeded Failed    = False
+
+failed Succeeded = False
+failed Failed    = True
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Source Text}
+*                                                                      *
+************************************************************************
+Keeping Source Text for source to source conversions
+
+Note [Pragma source text]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+The lexer does a case-insensitive match for pragmas, as well as
+accepting both UK and US spelling variants.
+
+So
+
+  {-# SPECIALISE #-}
+  {-# SPECIALIZE #-}
+  {-# Specialize #-}
+
+will all generate ITspec_prag token for the start of the pragma.
+
+In order to be able to do source to source conversions, the original
+source text for the token needs to be preserved, hence the
+`SourceText` field.
+
+So the lexer will then generate
+
+  ITspec_prag "{ -# SPECIALISE"
+  ITspec_prag "{ -# SPECIALIZE"
+  ITspec_prag "{ -# Specialize"
+
+for the cases above.
+ [without the space between '{' and '-', otherwise this comment won't parse]
+
+
+Note [Literal source text]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+The lexer/parser converts literals from their original source text
+versions to an appropriate internal representation. This is a problem
+for tools doing source to source conversions, so the original source
+text is stored in literals where this can occur.
+
+Motivating examples for HsLit
+
+  HsChar          '\n'       == '\x20`
+  HsCharPrim      '\x41`#    == `A`
+  HsString        "\x20\x41" == " A"
+  HsStringPrim    "\x20"#    == " "#
+  HsInt           001        == 1
+  HsIntPrim       002#       == 2#
+  HsWordPrim      003##      == 3##
+  HsInt64Prim     004##      == 4##
+  HsWord64Prim    005##      == 5##
+  HsInteger       006        == 6
+
+For OverLitVal
+
+  HsIntegral      003      == 0x003
+  HsIsString      "\x41nd" == "And"
+-}
+
+ -- Note [Literal source text],[Pragma source text]
+data SourceText = SourceText String
+                | NoSourceText -- ^ For when code is generated, e.g. TH,
+                               -- deriving. The pretty printer will then make
+                               -- its own representation of the item.
+                deriving (Data, Show, Eq )
+
+instance Outputable SourceText where
+  ppr (SourceText s) = text "SourceText" <+> text s
+  ppr NoSourceText   = text "NoSourceText"
+
+-- | Special combinator for showing string literals.
+pprWithSourceText :: SourceText -> SDoc -> SDoc
+pprWithSourceText NoSourceText     d = d
+pprWithSourceText (SourceText src) _ = text src
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Activation}
+*                                                                      *
+************************************************************************
+
+When a rule or inlining is active
+-}
+
+-- | Phase Number
+type PhaseNum = Int  -- Compilation phase
+                     -- Phases decrease towards zero
+                     -- Zero is the last phase
+
+data CompilerPhase
+  = Phase PhaseNum
+  | InitialPhase    -- The first phase -- number = infinity!
+
+instance Outputable CompilerPhase where
+   ppr (Phase n)    = int n
+   ppr InitialPhase = text "InitialPhase"
+
+activeAfterInitial :: Activation
+-- Active in the first phase after the initial phase
+-- Currently we have just phases [2,1,0]
+activeAfterInitial = ActiveAfter NoSourceText 2
+
+activeDuringFinal :: Activation
+-- Active in the final simplification phase (which is repeated)
+activeDuringFinal = ActiveAfter NoSourceText 0
+
+-- See note [Pragma source text]
+data Activation = NeverActive
+                | AlwaysActive
+                | ActiveBefore SourceText PhaseNum
+                  -- Active only *strictly before* this phase
+                | ActiveAfter SourceText PhaseNum
+                  -- Active in this phase and later
+                deriving( Eq, Data )
+                  -- Eq used in comparing rules in GHC.Hs.Decls
+
+-- | Rule Match Information
+data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
+                   | FunLike
+                   deriving( Eq, Data, Show )
+        -- Show needed for Lexer.x
+
+data InlinePragma            -- Note [InlinePragma]
+  = InlinePragma
+      { inl_src    :: SourceText -- Note [Pragma source text]
+      , inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]
+
+      , inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
+                                     --            explicit (non-type, non-dictionary) args
+                                     --   That is, inl_sat describes the number of *source-code*
+                                     --   arguments the thing must be applied to.  We add on the
+                                     --   number of implicit, dictionary arguments when making
+                                     --   the Unfolding, and don't look at inl_sat further
+
+      , inl_act    :: Activation     -- Says during which phases inlining is allowed
+                                     -- See Note [inl_inline and inl_act]
+
+      , inl_rule   :: RuleMatchInfo  -- Should the function be treated like a constructor?
+    } deriving( Eq, Data )
+
+-- | Inline Specification
+data InlineSpec   -- What the user's INLINE pragma looked like
+  = Inline       -- User wrote INLINE
+  | Inlinable    -- User wrote INLINABLE
+  | NoInline     -- User wrote NOINLINE
+  | NoUserInline -- User did not write any of INLINE/INLINABLE/NOINLINE
+                 -- e.g. in `defaultInlinePragma` or when created by CSE
+  deriving( Eq, Data, Show )
+        -- Show needed for Lexer.x
+
+{- Note [InlinePragma]
+~~~~~~~~~~~~~~~~~~~~~~
+This data type mirrors what you can write in an INLINE or NOINLINE pragma in
+the source program.
+
+If you write nothing at all, you get defaultInlinePragma:
+   inl_inline = NoUserInline
+   inl_act    = AlwaysActive
+   inl_rule   = FunLike
+
+It's not possible to get that combination by *writing* something, so
+if an Id has defaultInlinePragma it means the user didn't specify anything.
+
+If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.
+
+If you want to know where InlinePragmas take effect: Look in GHC.HsToCore.Binds.makeCorePair
+
+Note [inl_inline and inl_act]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* inl_inline says what the user wrote: did she say INLINE, NOINLINE,
+  INLINABLE, or nothing at all
+
+* inl_act says in what phases the unfolding is active or inactive
+  E.g  If you write INLINE[1]    then inl_act will be set to ActiveAfter 1
+       If you write NOINLINE[1]  then inl_act will be set to ActiveBefore 1
+       If you write NOINLINE[~1] then inl_act will be set to ActiveAfter 1
+  So note that inl_act does not say what pragma you wrote: it just
+  expresses its consequences
+
+* inl_act just says when the unfolding is active; it doesn't say what
+  to inline.  If you say INLINE f, then f's inl_act will be AlwaysActive,
+  but in addition f will get a "stable unfolding" with UnfoldingGuidance
+  that tells the inliner to be pretty eager about it.
+
+Note [CONLIKE pragma]
+~~~~~~~~~~~~~~~~~~~~~
+The ConLike constructor of a RuleMatchInfo is aimed at the following.
+Consider first
+    {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
+    g b bs = let x = b:bs in ..x...x...(r x)...
+Now, the rule applies to the (r x) term, because GHC "looks through"
+the definition of 'x' to see that it is (b:bs).
+
+Now consider
+    {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
+    g v = let x = f v in ..x...x...(r x)...
+Normally the (r x) would *not* match the rule, because GHC would be
+scared about duplicating the redex (f v), so it does not "look
+through" the bindings.
+
+However the CONLIKE modifier says to treat 'f' like a constructor in
+this situation, and "look through" the unfolding for x.  So (r x)
+fires, yielding (f (v+1)).
+
+This is all controlled with a user-visible pragma:
+     {-# NOINLINE CONLIKE [1] f #-}
+
+The main effects of CONLIKE are:
+
+    - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
+      CONLIKE thing like constructors, by ANF-ing them
+
+    - New function GHC.Core.Utils.exprIsExpandable is like exprIsCheap, but
+      additionally spots applications of CONLIKE functions
+
+    - A CoreUnfolding has a field that caches exprIsExpandable
+
+    - The rule matcher consults this field.  See
+      Note [Expanding variables] in GHC.Core.Rules.
+-}
+
+isConLike :: RuleMatchInfo -> Bool
+isConLike ConLike = True
+isConLike _       = False
+
+isFunLike :: RuleMatchInfo -> Bool
+isFunLike FunLike = True
+isFunLike _       = False
+
+noUserInlineSpec :: InlineSpec -> Bool
+noUserInlineSpec NoUserInline = True
+noUserInlineSpec _            = False
+
+defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
+  :: InlinePragma
+defaultInlinePragma = InlinePragma { inl_src = SourceText "{-# INLINE"
+                                   , inl_act = AlwaysActive
+                                   , inl_rule = FunLike
+                                   , inl_inline = NoUserInline
+                                   , inl_sat = Nothing }
+
+alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }
+neverInlinePragma  = defaultInlinePragma { inl_act    = NeverActive }
+
+inlinePragmaSpec :: InlinePragma -> InlineSpec
+inlinePragmaSpec = inl_inline
+
+-- A DFun has an always-active inline activation so that
+-- exprIsConApp_maybe can "see" its unfolding
+-- (However, its actual Unfolding is a DFunUnfolding, which is
+--  never inlined other than via exprIsConApp_maybe.)
+dfunInlinePragma   = defaultInlinePragma { inl_act  = AlwaysActive
+                                         , inl_rule = ConLike }
+
+isDefaultInlinePragma :: InlinePragma -> Bool
+isDefaultInlinePragma (InlinePragma { inl_act = activation
+                                    , inl_rule = match_info
+                                    , inl_inline = inline })
+  = noUserInlineSpec inline && isAlwaysActive activation && isFunLike match_info
+
+isInlinePragma :: InlinePragma -> Bool
+isInlinePragma prag = case inl_inline prag of
+                        Inline -> True
+                        _      -> False
+
+isInlinablePragma :: InlinePragma -> Bool
+isInlinablePragma prag = case inl_inline prag of
+                           Inlinable -> True
+                           _         -> False
+
+isAnyInlinePragma :: InlinePragma -> Bool
+-- INLINE or INLINABLE
+isAnyInlinePragma prag = case inl_inline prag of
+                        Inline    -> True
+                        Inlinable -> True
+                        _         -> False
+
+inlinePragmaSat :: InlinePragma -> Maybe Arity
+inlinePragmaSat = inl_sat
+
+inlinePragmaActivation :: InlinePragma -> Activation
+inlinePragmaActivation (InlinePragma { inl_act = activation }) = activation
+
+inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
+inlinePragmaRuleMatchInfo (InlinePragma { inl_rule = info }) = info
+
+setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
+setInlinePragmaActivation prag activation = prag { inl_act = activation }
+
+setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
+setInlinePragmaRuleMatchInfo prag info = prag { inl_rule = info }
+
+instance Outputable Activation where
+   ppr AlwaysActive       = empty
+   ppr NeverActive        = brackets (text "~")
+   ppr (ActiveBefore _ n) = brackets (char '~' <> int n)
+   ppr (ActiveAfter  _ n) = brackets (int n)
+
+instance Outputable RuleMatchInfo where
+   ppr ConLike = text "CONLIKE"
+   ppr FunLike = text "FUNLIKE"
+
+instance Outputable InlineSpec where
+   ppr Inline       = text "INLINE"
+   ppr NoInline     = text "NOINLINE"
+   ppr Inlinable    = text "INLINABLE"
+   ppr NoUserInline = text "NOUSERINLINE" -- what is better?
+
+instance Outputable InlinePragma where
+  ppr = pprInline
+
+pprInline :: InlinePragma -> SDoc
+pprInline = pprInline' True
+
+pprInlineDebug :: InlinePragma -> SDoc
+pprInlineDebug = pprInline' False
+
+pprInline' :: Bool           -- True <=> do not display the inl_inline field
+           -> InlinePragma
+           -> SDoc
+pprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation
+                                    , inl_rule = info, inl_sat = mb_arity })
+    = pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info
+    where
+      pp_inl x = if emptyInline then empty else ppr x
+
+      pp_act Inline   AlwaysActive = empty
+      pp_act NoInline NeverActive  = empty
+      pp_act _        act          = ppr act
+
+      pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar)
+             | otherwise           = empty
+      pp_info | isFunLike info = empty
+              | otherwise      = ppr info
+
+isActive :: CompilerPhase -> Activation -> Bool
+isActive InitialPhase AlwaysActive      = True
+isActive InitialPhase (ActiveBefore {}) = True
+isActive InitialPhase _                 = False
+isActive (Phase p)    act               = isActiveIn p act
+
+isActiveIn :: PhaseNum -> Activation -> Bool
+isActiveIn _ NeverActive        = False
+isActiveIn _ AlwaysActive       = True
+isActiveIn p (ActiveAfter _ n)  = p <= n
+isActiveIn p (ActiveBefore _ n) = p >  n
+
+competesWith :: Activation -> Activation -> Bool
+-- See Note [Activation competition]
+competesWith NeverActive       _                = False
+competesWith _                 NeverActive      = False
+competesWith AlwaysActive      _                = True
+
+competesWith (ActiveBefore {})  AlwaysActive      = True
+competesWith (ActiveBefore {})  (ActiveBefore {}) = True
+competesWith (ActiveBefore _ a) (ActiveAfter _ b) = a < b
+
+competesWith (ActiveAfter {})  AlwaysActive      = False
+competesWith (ActiveAfter {})  (ActiveBefore {}) = False
+competesWith (ActiveAfter _ a) (ActiveAfter _ b) = a >= b
+
+{- Note [Competing activations]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Sometimes a RULE and an inlining may compete, or two RULES.
+See Note [Rules and inlining/other rules] in GHC.HsToCore.
+
+We say that act1 "competes with" act2 iff
+   act1 is active in the phase when act2 *becomes* active
+NB: remember that phases count *down*: 2, 1, 0!
+
+It's too conservative to ensure that the two are never simultaneously
+active.  For example, a rule might be always active, and an inlining
+might switch on in phase 2.  We could switch off the rule, but it does
+no harm.
+-}
+
+isNeverActive, isAlwaysActive, isEarlyActive :: Activation -> Bool
+isNeverActive NeverActive = True
+isNeverActive _           = False
+
+isAlwaysActive AlwaysActive = True
+isAlwaysActive _            = False
+
+isEarlyActive AlwaysActive      = True
+isEarlyActive (ActiveBefore {}) = True
+isEarlyActive _                 = False
+
+-- | Integral Literal
+--
+-- Used (instead of Integer) to represent negative zegative zero which is
+-- required for NegativeLiterals extension to correctly parse `-0::Double`
+-- as negative zero. See also #13211.
+data IntegralLit
+  = IL { il_text :: SourceText
+       , il_neg :: Bool -- See Note [Negative zero]
+       , il_value :: Integer
+       }
+  deriving (Data, Show)
+
+mkIntegralLit :: Integral a => a -> IntegralLit
+mkIntegralLit i = IL { il_text = SourceText (show i_integer)
+                     , il_neg = i < 0
+                     , il_value = i_integer }
+  where
+    i_integer :: Integer
+    i_integer = toInteger i
+
+negateIntegralLit :: IntegralLit -> IntegralLit
+negateIntegralLit (IL text neg value)
+  = case text of
+      SourceText ('-':src) -> IL (SourceText src)       False    (negate value)
+      SourceText      src  -> IL (SourceText ('-':src)) True     (negate value)
+      NoSourceText         -> IL NoSourceText          (not neg) (negate value)
+
+-- | Fractional Literal
+--
+-- Used (instead of Rational) to represent exactly the floating point literal that we
+-- encountered in the user's source program. This allows us to pretty-print exactly what
+-- the user wrote, which is important e.g. for floating point numbers that can't represented
+-- as Doubles (we used to via Double for pretty-printing). See also #2245.
+data FractionalLit
+  = FL { fl_text :: SourceText     -- How the value was written in the source
+       , fl_neg :: Bool            -- See Note [Negative zero]
+       , fl_value :: Rational      -- Numeric value of the literal
+       }
+  deriving (Data, Show)
+  -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on
+
+mkFractionalLit :: Real a => a -> FractionalLit
+mkFractionalLit r = FL { fl_text = SourceText (show (realToFrac r::Double))
+                           -- Converting to a Double here may technically lose
+                           -- precision (see #15502). We could alternatively
+                           -- convert to a Rational for the most accuracy, but
+                           -- it would cause Floats and Doubles to be displayed
+                           -- strangely, so we opt not to do this. (In contrast
+                           -- to mkIntegralLit, where we always convert to an
+                           -- Integer for the highest accuracy.)
+                       , fl_neg = r < 0
+                       , fl_value = toRational r }
+
+negateFractionalLit :: FractionalLit -> FractionalLit
+negateFractionalLit (FL text neg value)
+  = case text of
+      SourceText ('-':src) -> FL (SourceText src)     False value
+      SourceText      src  -> FL (SourceText ('-':src)) True  value
+      NoSourceText         -> FL NoSourceText (not neg) (negate value)
+
+integralFractionalLit :: Bool -> Integer -> FractionalLit
+integralFractionalLit neg i = FL { fl_text = SourceText (show i),
+                                   fl_neg = neg,
+                                   fl_value = fromInteger i }
+
+-- Comparison operations are needed when grouping literals
+-- for compiling pattern-matching (module GHC.HsToCore.Match.Literal)
+
+instance Eq IntegralLit where
+  (==) = (==) `on` il_value
+
+instance Ord IntegralLit where
+  compare = compare `on` il_value
+
+instance Outputable IntegralLit where
+  ppr (IL (SourceText src) _ _) = text src
+  ppr (IL NoSourceText _ value) = text (show value)
+
+instance Eq FractionalLit where
+  (==) = (==) `on` fl_value
+
+instance Ord FractionalLit where
+  compare = compare `on` fl_value
+
+instance Outputable FractionalLit where
+  ppr f = pprWithSourceText (fl_text f) (rational (fl_value f))
+
+{-
+************************************************************************
+*                                                                      *
+    IntWithInf
+*                                                                      *
+************************************************************************
+
+Represents an integer or positive infinity
+
+-}
+
+-- | An integer or infinity
+data IntWithInf = Int {-# UNPACK #-} !Int
+                | Infinity
+  deriving Eq
+
+-- | A representation of infinity
+infinity :: IntWithInf
+infinity = Infinity
+
+instance Ord IntWithInf where
+  compare Infinity Infinity = EQ
+  compare (Int _)  Infinity = LT
+  compare Infinity (Int _)  = GT
+  compare (Int a)  (Int b)  = a `compare` b
+
+instance Outputable IntWithInf where
+  ppr Infinity = char '∞'
+  ppr (Int n)  = int n
+
+instance Num IntWithInf where
+  (+) = plusWithInf
+  (*) = mulWithInf
+
+  abs Infinity = Infinity
+  abs (Int n)  = Int (abs n)
+
+  signum Infinity = Int 1
+  signum (Int n)  = Int (signum n)
+
+  fromInteger = Int . fromInteger
+
+  (-) = panic "subtracting IntWithInfs"
+
+intGtLimit :: Int -> IntWithInf -> Bool
+intGtLimit _ Infinity = False
+intGtLimit n (Int m)  = n > m
+
+-- | Add two 'IntWithInf's
+plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf
+plusWithInf Infinity _        = Infinity
+plusWithInf _        Infinity = Infinity
+plusWithInf (Int a)  (Int b)  = Int (a + b)
+
+-- | Multiply two 'IntWithInf's
+mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
+mulWithInf Infinity _        = Infinity
+mulWithInf _        Infinity = Infinity
+mulWithInf (Int a)  (Int b)  = Int (a * b)
+
+-- | Turn a positive number into an 'IntWithInf', where 0 represents infinity
+treatZeroAsInf :: Int -> IntWithInf
+treatZeroAsInf 0 = Infinity
+treatZeroAsInf n = Int n
+
+-- | Inject any integer into an 'IntWithInf'
+mkIntWithInf :: Int -> IntWithInf
+mkIntWithInf = Int
+
+data SpliceExplicitFlag
+          = ExplicitSplice | -- ^ <=> $(f x y)
+            ImplicitSplice   -- ^ <=> f x y,  i.e. a naked top level expression
+    deriving Data
+
+{- *********************************************************************
+*                                                                      *
+                        Types vs Kinds
+*                                                                      *
+********************************************************************* -}
+
+-- | Flag to see whether we're type-checking terms or kind-checking types
+data TypeOrKind = TypeLevel | KindLevel
+  deriving Eq
+
+instance Outputable TypeOrKind where
+  ppr TypeLevel = text "TypeLevel"
+  ppr KindLevel = text "KindLevel"
+
+isTypeLevel :: TypeOrKind -> Bool
+isTypeLevel TypeLevel = True
+isTypeLevel KindLevel = False
+
+isKindLevel :: TypeOrKind -> Bool
+isKindLevel TypeLevel = False
+isKindLevel KindLevel = True
diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs
new file mode 100644
index 0000000000..5280d90d31
--- /dev/null
+++ b/compiler/GHC/Types/CostCentre.hs
@@ -0,0 +1,359 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module GHC.Types.CostCentre (
+        CostCentre(..), CcName, CCFlavour(..),
+                -- All abstract except to friend: ParseIface.y
+
+        CostCentreStack,
+        CollectedCCs, emptyCollectedCCs, collectCC,
+        currentCCS, dontCareCCS,
+        isCurrentCCS,
+        maybeSingletonCCS,
+
+        mkUserCC, mkAutoCC, mkAllCafsCC,
+        mkSingletonCCS,
+        isCafCCS, isCafCC, isSccCountCC, sccAbleCC, ccFromThisModule,
+
+        pprCostCentreCore,
+        costCentreUserName, costCentreUserNameFS,
+        costCentreSrcSpan,
+
+        cmpCostCentre   -- used for removing dups in a list
+    ) where
+
+import GhcPrelude
+
+import Binary
+import GHC.Types.Var
+import GHC.Types.Name
+import GHC.Types.Module
+import GHC.Types.Unique
+import Outputable
+import GHC.Types.SrcLoc
+import FastString
+import Util
+import GHC.Types.CostCentre.State
+
+import Data.Data
+
+-----------------------------------------------------------------------------
+-- Cost Centres
+
+-- | A Cost Centre is a single @{-# SCC #-}@ annotation.
+
+data CostCentre
+  = NormalCC {
+                cc_flavour  :: CCFlavour,
+                 -- ^ Two cost centres may have the same name and
+                 -- module but different SrcSpans, so we need a way to
+                 -- distinguish them easily and give them different
+                 -- object-code labels.  So every CostCentre has an
+                 -- associated flavour that indicates how it was
+                 -- generated, and flavours that allow multiple instances
+                 -- of the same name and module have a deterministic 0-based
+                 -- index.
+                cc_name :: CcName,      -- ^ Name of the cost centre itself
+                cc_mod  :: Module,      -- ^ Name of module defining this CC.
+                cc_loc  :: SrcSpan
+    }
+
+  | AllCafsCC {
+                cc_mod  :: Module,      -- Name of module defining this CC.
+                cc_loc  :: SrcSpan
+    }
+  deriving Data
+
+type CcName = FastString
+
+-- | The flavour of a cost centre.
+--
+-- Index fields represent 0-based indices giving source-code ordering of
+-- centres with the same module, name, and flavour.
+data CCFlavour = CafCC -- ^ Auto-generated top-level thunk
+               | ExprCC !CostCentreIndex -- ^ Explicitly annotated expression
+               | DeclCC !CostCentreIndex -- ^ Explicitly annotated declaration
+               | HpcCC !CostCentreIndex -- ^ Generated by HPC for coverage
+               deriving (Eq, Ord, Data)
+
+-- | Extract the index from a flavour
+flavourIndex :: CCFlavour -> Int
+flavourIndex CafCC = 0
+flavourIndex (ExprCC x) = unCostCentreIndex x
+flavourIndex (DeclCC x) = unCostCentreIndex x
+flavourIndex (HpcCC x) = unCostCentreIndex x
+
+instance Eq CostCentre where
+        c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False }
+
+instance Ord CostCentre where
+        compare = cmpCostCentre
+
+cmpCostCentre :: CostCentre -> CostCentre -> Ordering
+
+cmpCostCentre (AllCafsCC  {cc_mod = m1}) (AllCafsCC  {cc_mod = m2})
+  = m1 `compare` m2
+
+cmpCostCentre NormalCC {cc_flavour = f1, cc_mod =  m1, cc_name = n1}
+              NormalCC {cc_flavour = f2, cc_mod =  m2, cc_name = n2}
+    -- first key is module name, then centre name, then flavour
+  = (m1 `compare` m2) `thenCmp` (n1 `compare` n2) `thenCmp` (f1 `compare` f2)
+
+cmpCostCentre other_1 other_2
+  = let
+        tag1 = tag_CC other_1
+        tag2 = tag_CC other_2
+    in
+    if tag1 < tag2 then LT else GT
+  where
+    tag_CC :: CostCentre -> Int
+    tag_CC (NormalCC   {}) = 0
+    tag_CC (AllCafsCC  {}) = 1
+
+
+-----------------------------------------------------------------------------
+-- Predicates on CostCentre
+
+isCafCC :: CostCentre -> Bool
+isCafCC (AllCafsCC {})                  = True
+isCafCC (NormalCC {cc_flavour = CafCC}) = True
+isCafCC _                               = False
+
+-- | Is this a cost-centre which records scc counts
+isSccCountCC :: CostCentre -> Bool
+isSccCountCC cc | isCafCC cc  = False
+                | otherwise   = True
+
+-- | Is this a cost-centre which can be sccd ?
+sccAbleCC :: CostCentre -> Bool
+sccAbleCC cc | isCafCC cc = False
+             | otherwise  = True
+
+ccFromThisModule :: CostCentre -> Module -> Bool
+ccFromThisModule cc m = cc_mod cc == m
+
+
+-----------------------------------------------------------------------------
+-- Building cost centres
+
+mkUserCC :: FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre
+mkUserCC cc_name mod loc flavour
+  = NormalCC { cc_name = cc_name, cc_mod =  mod, cc_loc = loc,
+               cc_flavour = flavour
+    }
+
+mkAutoCC :: Id -> Module -> CostCentre
+mkAutoCC id mod
+  = NormalCC { cc_name = str, cc_mod =  mod,
+               cc_loc = nameSrcSpan (getName id),
+               cc_flavour = CafCC
+    }
+  where
+        name = getName id
+        -- beware: only external names are guaranteed to have unique
+        -- Occnames.  If the name is not external, we must append its
+        -- Unique.
+        -- See bug #249, tests prof001, prof002,  also #2411
+        str | isExternalName name = occNameFS (getOccName id)
+            | otherwise           = occNameFS (getOccName id)
+                                    `appendFS`
+                                    mkFastString ('_' : show (getUnique name))
+mkAllCafsCC :: Module -> SrcSpan -> CostCentre
+mkAllCafsCC m loc = AllCafsCC { cc_mod = m, cc_loc = loc }
+
+-----------------------------------------------------------------------------
+-- Cost Centre Stacks
+
+-- | A Cost Centre Stack is something that can be attached to a closure.
+-- This is either:
+--
+--      * the current cost centre stack (CCCS)
+--      * a pre-defined cost centre stack (there are several
+--        pre-defined CCSs, see below).
+
+data CostCentreStack
+  = CurrentCCS          -- Pinned on a let(rec)-bound
+                        -- thunk/function/constructor, this says that the
+                        -- cost centre to be attached to the object, when it
+                        -- is allocated, is whatever is in the
+                        -- current-cost-centre-stack register.
+
+  | DontCareCCS         -- We need a CCS to stick in static closures
+                        -- (for data), but we *don't* expect them to
+                        -- accumulate any costs.  But we still need
+                        -- the placeholder.  This CCS is it.
+
+  | SingletonCCS CostCentre
+
+  deriving (Eq, Ord)    -- needed for Ord on CLabel
+
+
+-- synonym for triple which describes the cost centre info in the generated
+-- code for a module.
+type CollectedCCs
+  = ( [CostCentre]       -- local cost-centres that need to be decl'd
+    , [CostCentreStack]  -- pre-defined "singleton" cost centre stacks
+    )
+
+emptyCollectedCCs :: CollectedCCs
+emptyCollectedCCs = ([], [])
+
+collectCC :: CostCentre -> CostCentreStack -> CollectedCCs -> CollectedCCs
+collectCC cc ccs (c, cs) = (cc : c, ccs : cs)
+
+currentCCS, dontCareCCS :: CostCentreStack
+
+currentCCS              = CurrentCCS
+dontCareCCS             = DontCareCCS
+
+-----------------------------------------------------------------------------
+-- Predicates on Cost-Centre Stacks
+
+isCurrentCCS :: CostCentreStack -> Bool
+isCurrentCCS CurrentCCS                 = True
+isCurrentCCS _                          = False
+
+isCafCCS :: CostCentreStack -> Bool
+isCafCCS (SingletonCCS cc)              = isCafCC cc
+isCafCCS _                              = False
+
+maybeSingletonCCS :: CostCentreStack -> Maybe CostCentre
+maybeSingletonCCS (SingletonCCS cc)     = Just cc
+maybeSingletonCCS _                     = Nothing
+
+mkSingletonCCS :: CostCentre -> CostCentreStack
+mkSingletonCCS cc = SingletonCCS cc
+
+
+-----------------------------------------------------------------------------
+-- Printing Cost Centre Stacks.
+
+-- The outputable instance for CostCentreStack prints the CCS as a C
+-- expression.
+
+instance Outputable CostCentreStack where
+  ppr CurrentCCS        = text "CCCS"
+  ppr DontCareCCS       = text "CCS_DONT_CARE"
+  ppr (SingletonCCS cc) = ppr cc <> text "_ccs"
+
+
+-----------------------------------------------------------------------------
+-- Printing Cost Centres
+--
+-- There are several different ways in which we might want to print a
+-- cost centre:
+--
+--      - the name of the cost centre, for profiling output (a C string)
+--      - the label, i.e. C label for cost centre in .hc file.
+--      - the debugging name, for output in -ddump things
+--      - the interface name, for printing in _scc_ exprs in iface files.
+--
+-- The last 3 are derived from costCentreStr below.  The first is given
+-- by costCentreName.
+
+instance Outputable CostCentre where
+  ppr cc = getPprStyle $ \ sty ->
+           if codeStyle sty
+           then ppCostCentreLbl cc
+           else text (costCentreUserName cc)
+
+-- Printing in Core
+pprCostCentreCore :: CostCentre -> SDoc
+pprCostCentreCore (AllCafsCC {cc_mod = m})
+  = text "__sccC" <+> braces (ppr m)
+pprCostCentreCore (NormalCC {cc_flavour = flavour, cc_name = n,
+                             cc_mod = m, cc_loc = loc})
+  = text "__scc" <+> braces (hsep [
+        ppr m <> char '.' <> ftext n,
+        pprFlavourCore flavour,
+        whenPprDebug (ppr loc)
+    ])
+
+-- ^ Print a flavour in Core
+pprFlavourCore :: CCFlavour -> SDoc
+pprFlavourCore CafCC = text "__C"
+pprFlavourCore f     = pprIdxCore $ flavourIndex f
+
+-- ^ Print a flavour's index in Core
+pprIdxCore :: Int -> SDoc
+pprIdxCore 0 = empty
+pprIdxCore idx = whenPprDebug $ ppr idx
+
+-- Printing as a C label
+ppCostCentreLbl :: CostCentre -> SDoc
+ppCostCentreLbl (AllCafsCC  {cc_mod = m}) = ppr m <> text "_CAFs_cc"
+ppCostCentreLbl (NormalCC {cc_flavour = f, cc_name = n, cc_mod = m})
+  = ppr m <> char '_' <> ztext (zEncodeFS n) <> char '_' <>
+        ppFlavourLblComponent f <> text "_cc"
+
+-- ^ Print the flavour component of a C label
+ppFlavourLblComponent :: CCFlavour -> SDoc
+ppFlavourLblComponent CafCC = text "CAF"
+ppFlavourLblComponent (ExprCC i) = text "EXPR" <> ppIdxLblComponent i
+ppFlavourLblComponent (DeclCC i) = text "DECL" <> ppIdxLblComponent i
+ppFlavourLblComponent (HpcCC i) = text "HPC" <> ppIdxLblComponent i
+
+-- ^ Print the flavour index component of a C label
+ppIdxLblComponent :: CostCentreIndex -> SDoc
+ppIdxLblComponent n =
+  case unCostCentreIndex n of
+    0 -> empty
+    n -> ppr n
+
+-- This is the name to go in the user-displayed string,
+-- recorded in the cost centre declaration
+costCentreUserName :: CostCentre -> String
+costCentreUserName = unpackFS . costCentreUserNameFS
+
+costCentreUserNameFS :: CostCentre -> FastString
+costCentreUserNameFS (AllCafsCC {})  = mkFastString "CAF"
+costCentreUserNameFS (NormalCC {cc_name = name, cc_flavour = is_caf})
+  =  case is_caf of
+      CafCC -> mkFastString "CAF:" `appendFS` name
+      _     -> name
+
+costCentreSrcSpan :: CostCentre -> SrcSpan
+costCentreSrcSpan = cc_loc
+
+instance Binary CCFlavour where
+    put_ bh CafCC = do
+            putByte bh 0
+    put_ bh (ExprCC i) = do
+            putByte bh 1
+            put_ bh i
+    put_ bh (DeclCC i) = do
+            putByte bh 2
+            put_ bh i
+    put_ bh (HpcCC i) = do
+            putByte bh 3
+            put_ bh i
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return CafCC
+              1 -> ExprCC <$> get bh
+              2 -> DeclCC <$> get bh
+              _ -> HpcCC <$> get bh
+
+instance Binary CostCentre where
+    put_ bh (NormalCC aa ab ac _ad) = do
+            putByte bh 0
+            put_ bh aa
+            put_ bh ab
+            put_ bh ac
+    put_ bh (AllCafsCC ae _af) = do
+            putByte bh 1
+            put_ bh ae
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do aa <- get bh
+                      ab <- get bh
+                      ac <- get bh
+                      return (NormalCC aa ab ac noSrcSpan)
+              _ -> do ae <- get bh
+                      return (AllCafsCC ae noSrcSpan)
+
+    -- We ignore the SrcSpans in CostCentres when we serialise them,
+    -- and set the SrcSpans to noSrcSpan when deserialising.  This is
+    -- ok, because we only need the SrcSpan when declaring the
+    -- CostCentre in the original module, it is not used by importing
+    -- modules.
diff --git a/compiler/GHC/Types/CostCentre/Init.hs b/compiler/GHC/Types/CostCentre/Init.hs
new file mode 100644
index 0000000000..ad6a95e7ab
--- /dev/null
+++ b/compiler/GHC/Types/CostCentre/Init.hs
@@ -0,0 +1,64 @@
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow, 2011
+--
+-- Generate code to initialise cost centres
+--
+-- -----------------------------------------------------------------------------
+
+module GHC.Types.CostCentre.Init (profilingInitCode) where
+
+import GhcPrelude
+
+import GHC.Cmm.CLabel
+import GHC.Types.CostCentre
+import GHC.Driver.Session
+import Outputable
+import GHC.Types.Module
+
+-- -----------------------------------------------------------------------------
+-- Initialising cost centres
+
+-- We must produce declarations for the cost-centres defined in this
+-- module;
+
+profilingInitCode :: Module -> CollectedCCs -> SDoc
+profilingInitCode this_mod (local_CCs, singleton_CCSs)
+ = sdocWithDynFlags $ \dflags ->
+   if not (gopt Opt_SccProfilingOn dflags)
+   then empty
+   else vcat
+    $  map emit_cc_decl local_CCs
+    ++ map emit_ccs_decl singleton_CCSs
+    ++ [emit_cc_list local_CCs]
+    ++ [emit_ccs_list singleton_CCSs]
+    ++ [ text "static void prof_init_" <> ppr this_mod
+            <> text "(void) __attribute__((constructor));"
+       , text "static void prof_init_" <> ppr this_mod <> text "(void)"
+       , braces (vcat
+                 [ text "registerCcList" <> parens local_cc_list_label <> semi
+                 , text "registerCcsList" <> parens singleton_cc_list_label <> semi
+                 ])
+       ]
+ where
+   emit_cc_decl cc =
+       text "extern CostCentre" <+> cc_lbl <> text "[];"
+     where cc_lbl = ppr (mkCCLabel cc)
+   local_cc_list_label = text "local_cc_" <> ppr this_mod
+   emit_cc_list ccs =
+      text "static CostCentre *" <> local_cc_list_label <> text "[] ="
+      <+> braces (vcat $ [ ppr (mkCCLabel cc) <> comma
+                         | cc <- ccs
+                         ] ++ [text "NULL"])
+      <> semi
+
+   emit_ccs_decl ccs =
+       text "extern CostCentreStack" <+> ccs_lbl <> text "[];"
+     where ccs_lbl = ppr (mkCCSLabel ccs)
+   singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod
+   emit_ccs_list ccs =
+      text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] ="
+      <+> braces (vcat $ [ ppr (mkCCSLabel cc) <> comma
+                         | cc <- ccs
+                         ] ++ [text "NULL"])
+      <> semi
diff --git a/compiler/GHC/Types/CostCentre/State.hs b/compiler/GHC/Types/CostCentre/State.hs
new file mode 100644
index 0000000000..51c364f776
--- /dev/null
+++ b/compiler/GHC/Types/CostCentre/State.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module GHC.Types.CostCentre.State
+   ( CostCentreState
+   , newCostCentreState
+   , CostCentreIndex
+   , unCostCentreIndex
+   , getCCIndex
+   )
+where
+
+import GhcPrelude
+import FastString
+import FastStringEnv
+
+import Data.Data
+import Binary
+
+-- | Per-module state for tracking cost centre indices.
+--
+-- See documentation of 'CostCentre.cc_flavour' for more details.
+newtype CostCentreState = CostCentreState (FastStringEnv Int)
+
+-- | Initialize cost centre state.
+newCostCentreState :: CostCentreState
+newCostCentreState = CostCentreState emptyFsEnv
+
+-- | An index into a given cost centre module,name,flavour set
+newtype CostCentreIndex = CostCentreIndex { unCostCentreIndex :: Int }
+  deriving (Eq, Ord, Data, Binary)
+
+-- | Get a new index for a given cost centre name.
+getCCIndex :: FastString
+           -> CostCentreState
+           -> (CostCentreIndex, CostCentreState)
+getCCIndex nm (CostCentreState m) =
+    (CostCentreIndex idx, CostCentreState m')
+  where
+    m_idx = lookupFsEnv m nm
+    idx = maybe 0 id m_idx
+    m' = extendFsEnv m nm (idx + 1)
diff --git a/compiler/GHC/Types/Cpr.hs b/compiler/GHC/Types/Cpr.hs
new file mode 100644
index 0000000000..16f5f1041d
--- /dev/null
+++ b/compiler/GHC/Types/Cpr.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+-- | Types for the Constructed Product Result lattice. "GHC.Core.Op.CprAnal" and "GHC.Core.Op.WorkWrap.Lib"
+-- are its primary customers via 'idCprInfo'.
+module GHC.Types.Cpr (
+    CprResult, topCpr, botCpr, conCpr, asConCpr,
+    CprType (..), topCprType, botCprType, conCprType,
+    lubCprType, applyCprTy, abstractCprTy, ensureCprTyArity, trimCprTy,
+    CprSig (..), topCprSig, mkCprSigForArity, mkCprSig, seqCprSig
+  ) where
+
+import GhcPrelude
+
+import GHC.Types.Basic
+import Outputable
+import Binary
+
+--
+-- * CprResult
+--
+
+-- | The constructed product result lattice.
+--
+-- @
+--                    NoCPR
+--                      |
+--                 ConCPR ConTag
+--                      |
+--                    BotCPR
+-- @
+data CprResult = NoCPR          -- ^ Top of the lattice
+               | ConCPR !ConTag -- ^ Returns a constructor from a data type
+               | BotCPR         -- ^ Bottom of the lattice
+               deriving( Eq, Show )
+
+lubCpr :: CprResult -> CprResult -> CprResult
+lubCpr (ConCPR t1) (ConCPR t2)
+  | t1 == t2               = ConCPR t1
+lubCpr BotCPR      cpr     = cpr
+lubCpr cpr         BotCPR  = cpr
+lubCpr _           _       = NoCPR
+
+topCpr :: CprResult
+topCpr = NoCPR
+
+botCpr :: CprResult
+botCpr = BotCPR
+
+conCpr :: ConTag -> CprResult
+conCpr = ConCPR
+
+trimCpr :: CprResult -> CprResult
+trimCpr ConCPR{} = NoCPR
+trimCpr cpr      = cpr
+
+asConCpr :: CprResult -> Maybe ConTag
+asConCpr (ConCPR t)  = Just t
+asConCpr NoCPR       = Nothing
+asConCpr BotCPR      = Nothing
+
+--
+-- * CprType
+--
+
+-- | The abstract domain \(A_t\) from the original 'CPR for Haskell' paper.
+data CprType
+  = CprType
+  { ct_arty :: !Arity     -- ^ Number of value arguments the denoted expression
+                          --   eats before returning the 'ct_cpr'
+  , ct_cpr  :: !CprResult -- ^ 'CprResult' eventually unleashed when applied to
+                          --   'ct_arty' arguments
+  }
+
+instance Eq CprType where
+  a == b =  ct_cpr a == ct_cpr b
+         && (ct_arty a == ct_arty b || ct_cpr a == topCpr)
+
+topCprType :: CprType
+topCprType = CprType 0 topCpr
+
+botCprType :: CprType
+botCprType = CprType 0 botCpr -- TODO: Figure out if arity 0 does what we want... Yes it does: arity zero means we may unleash it under any number of incoming arguments
+
+conCprType :: ConTag -> CprType
+conCprType con_tag = CprType 0 (conCpr con_tag)
+
+lubCprType :: CprType -> CprType -> CprType
+lubCprType ty1@(CprType n1 cpr1) ty2@(CprType n2 cpr2)
+  -- The arity of bottom CPR types can be extended arbitrarily.
+  | cpr1 == botCpr && n1 <= n2 = ty2
+  | cpr2 == botCpr && n2 <= n1 = ty1
+  -- There might be non-bottom CPR types with mismatching arities.
+  -- Consider test DmdAnalGADTs. We want to return top in these cases.
+  | n1 == n2                   = CprType n1 (lubCpr cpr1 cpr2)
+  | otherwise                  = topCprType
+
+applyCprTy :: CprType -> CprType
+applyCprTy (CprType n res)
+  | n > 0         = CprType (n-1) res
+  | res == botCpr = botCprType
+  | otherwise     = topCprType
+
+abstractCprTy :: CprType -> CprType
+abstractCprTy (CprType n res)
+  | res == topCpr = topCprType
+  | otherwise     = CprType (n+1) res
+
+ensureCprTyArity :: Arity -> CprType -> CprType
+ensureCprTyArity n ty@(CprType m _)
+  | n == m    = ty
+  | otherwise = topCprType
+
+trimCprTy :: CprType -> CprType
+trimCprTy (CprType arty res) = CprType arty (trimCpr res)
+
+-- | The arity of the wrapped 'CprType' is the arity at which it is safe
+-- to unleash. See Note [Understanding DmdType and StrictSig] in GHC.Types.Demand
+newtype CprSig = CprSig { getCprSig :: CprType }
+  deriving (Eq, Binary)
+
+-- | Turns a 'CprType' computed for the particular 'Arity' into a 'CprSig'
+-- unleashable at that arity. See Note [Understanding DmdType and StrictSig] in
+-- Demand
+mkCprSigForArity :: Arity -> CprType -> CprSig
+mkCprSigForArity arty ty = CprSig (ensureCprTyArity arty ty)
+
+topCprSig :: CprSig
+topCprSig = CprSig topCprType
+
+mkCprSig :: Arity -> CprResult -> CprSig
+mkCprSig arty cpr = CprSig (CprType arty cpr)
+
+seqCprSig :: CprSig -> ()
+seqCprSig sig = sig `seq` ()
+
+instance Outputable CprResult where
+  ppr NoCPR        = empty
+  ppr (ConCPR n)   = char 'm' <> int n
+  ppr BotCPR       = char 'b'
+
+instance Outputable CprType where
+  ppr (CprType arty res) = ppr arty <> ppr res
+
+-- | Only print the CPR result
+instance Outputable CprSig where
+  ppr (CprSig ty) = ppr (ct_cpr ty)
+
+instance Binary CprResult where
+  put_ bh (ConCPR n)   = do { putByte bh 0; put_ bh n }
+  put_ bh NoCPR        = putByte bh 1
+  put_ bh BotCPR       = putByte bh 2
+
+  get  bh = do
+          h <- getByte bh
+          case h of
+            0 -> do { n <- get bh; return (ConCPR n) }
+            1 -> return NoCPR
+            _ -> return BotCPR
+
+instance Binary CprType where
+  put_ bh (CprType arty cpr) = do
+    put_ bh arty
+    put_ bh cpr
+  get  bh = CprType <$> get bh <*> get bh
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
new file mode 100644
index 0000000000..f9ca821872
--- /dev/null
+++ b/compiler/GHC/Types/Demand.hs
@@ -0,0 +1,1974 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[Demand]{@Demand@: A decoupled implementation of a demand domain}
+-}
+
+{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances, RecordWildCards #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module GHC.Types.Demand (
+        StrDmd, UseDmd(..), Count,
+
+        Demand, DmdShell, CleanDemand, getStrDmd, getUseDmd,
+        mkProdDmd, mkOnceUsedDmd, mkManyUsedDmd, mkHeadStrict, oneifyDmd,
+        toCleanDmd,
+        absDmd, topDmd, botDmd, seqDmd,
+        lubDmd, bothDmd,
+        lazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd,
+        isTopDmd, isAbsDmd, isSeqDmd,
+        peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,
+        addCaseBndrDmd,
+
+        DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
+        nopDmdType, botDmdType, mkDmdType,
+        addDemand, ensureArgs,
+        BothDmdArg, mkBothDmdArg, toBothDmdArg,
+
+        DmdEnv, emptyDmdEnv,
+        peelFV, findIdDemand,
+
+        Divergence(..), lubDivergence, isBotDiv, isTopDiv, topDiv, botDiv,
+        appIsBottom, isBottomingSig, pprIfaceStrictSig,
+        StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,
+        nopSig, botSig, cprProdSig,
+        isTopSig, hasDemandEnvSig,
+        splitStrictSig, strictSigDmdEnv,
+        increaseStrictSigArity, etaExpandStrictSig,
+
+        seqDemand, seqDemandList, seqDmdType, seqStrictSig,
+
+        evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd,
+        splitDmdTy, splitFVs,
+        deferAfterIO,
+        postProcessUnsat, postProcessDmdType,
+
+        splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds,
+        mkWorkerDemand, dmdTransformSig, dmdTransformDataConSig,
+        dmdTransformDictSelSig, argOneShots, argsOneShots, saturatedByOneShots,
+        TypeShape(..), peelTsFuns, trimToType,
+
+        useCount, isUsedOnce, reuseEnv,
+        zapUsageDemand, zapUsageEnvSig,
+        zapUsedOnceDemand, zapUsedOnceSig,
+        strictifyDictDmd, strictifyDmd
+
+     ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import Outputable
+import GHC.Types.Var ( Var )
+import GHC.Types.Var.Env
+import GHC.Types.Unique.FM
+import Util
+import GHC.Types.Basic
+import Binary
+import Maybes           ( orElse )
+
+import GHC.Core.Type    ( Type )
+import GHC.Core.TyCon   ( isNewTyCon, isClassTyCon )
+import GHC.Core.DataCon ( splitDataProductType_maybe )
+
+{-
+************************************************************************
+*                                                                      *
+        Joint domain for Strictness and Absence
+*                                                                      *
+************************************************************************
+-}
+
+data JointDmd s u = JD { sd :: s, ud :: u }
+  deriving ( Eq, Show )
+
+getStrDmd :: JointDmd s u -> s
+getStrDmd = sd
+
+getUseDmd :: JointDmd s u -> u
+getUseDmd = ud
+
+-- Pretty-printing
+instance (Outputable s, Outputable u) => Outputable (JointDmd s u) where
+  ppr (JD {sd = s, ud = u}) = angleBrackets (ppr s <> char ',' <> ppr u)
+
+-- Well-formedness preserving constructors for the joint domain
+mkJointDmd :: s -> u -> JointDmd s u
+mkJointDmd s u = JD { sd = s, ud = u }
+
+mkJointDmds :: [s] -> [u] -> [JointDmd s u]
+mkJointDmds ss as = zipWithEqual "mkJointDmds" mkJointDmd ss as
+
+
+{-
+************************************************************************
+*                                                                      *
+            Strictness domain
+*                                                                      *
+************************************************************************
+
+          Lazy
+           |
+        HeadStr
+        /     \
+    SCall      SProd
+        \     /
+        HyperStr
+
+Note [Exceptions and strictness]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We used to smart about catching exceptions, but we aren't anymore.
+See #14998 for the way it's resolved at the moment.
+
+Here's a historic breakdown:
+
+Apparently, exception handling prim-ops didn't use to have any special
+strictness signatures, thus defaulting to topSig, which assumes they use their
+arguments lazily. Joachim was the first to realise that we could provide richer
+information. Thus, in 0558911f91c (Dec 13), he added signatures to
+primops.txt.pp indicating that functions like `catch#` and `catchRetry#` call
+their argument, which is useful information for usage analysis. Still with a
+'Lazy' strictness demand (i.e. 'lazyApply1Dmd'), though, and the world was fine.
+
+In 7c0fff4 (July 15), Simon argued that giving `catch#` et al. a
+'strictApply1Dmd' leads to substantial performance gains. That was at the cost
+of correctness, as #10712 proved. So, back to 'lazyApply1Dmd' in
+28638dfe79e (Dec 15).
+
+Motivated to reproduce the gains of 7c0fff4 without the breakage of #10712,
+Ben opened #11222. Simon made the demand analyser "understand catch" in
+9915b656 (Jan 16) by adding a new 'catchArgDmd', which basically said to call
+its argument strictly, but also swallow any thrown exceptions in
+'postProcessDivergence'. This was realized by extending the 'Str' constructor of
+'ArgStr' with a 'ExnStr' field, indicating that it catches the exception, and
+adding a 'ThrowsExn' constructor to the 'Divergence' lattice as an element
+between 'Dunno' and 'Diverges'. Then along came #11555 and finally #13330,
+so we had to revert to 'lazyApply1Dmd' again in 701256df88c (Mar 17).
+
+This left the other variants like 'catchRetry#' having 'catchArgDmd', which is
+where #14998 picked up. Item 1 was concerned with measuring the impact of also
+making `catchRetry#` and `catchSTM#` have 'lazyApply1Dmd'. The result was that
+there was none. We removed the last usages of 'catchArgDmd' in 00b8ecb7
+(Apr 18). There was a lot of dead code resulting from that change, that we
+removed in ef6b283 (Jan 19): We got rid of 'ThrowsExn' and 'ExnStr' again and
+removed any code that was dealing with the peculiarities.
+
+Where did the speed-ups vanish to? In #14998, item 3 established that
+turning 'catch#' strict in its first argument didn't bring back any of the
+alleged performance benefits. Item 2 of that ticket finally found out that it
+was entirely due to 'catchException's new (since #11555) definition, which
+was simply
+
+    catchException !io handler = catch io handler
+
+While 'catchException' is arguably the saner semantics for 'catch', it is an
+internal helper function in "GHC.IO". Its use in
+"GHC.IO.Handle.Internals.do_operation" made for the huge allocation differences:
+Remove the bang and you find the regressions we originally wanted to avoid with
+'catchArgDmd'. See also #exceptions_and_strictness# in "GHC.IO".
+
+So history keeps telling us that the only possibly correct strictness annotation
+for the first argument of 'catch#' is 'lazyApply1Dmd', because 'catch#' really
+is not strict in its argument: Just try this in GHCi
+
+  :set -XScopedTypeVariables
+  import Control.Exception
+  catch undefined (\(_ :: SomeException) -> putStrLn "you'll see this")
+
+Any analysis that assumes otherwise will be broken in some way or another
+(beyond `-fno-pendantic-bottoms`).
+-}
+
+-- | Vanilla strictness domain
+data StrDmd
+  = HyperStr             -- ^ Hyper-strict (bottom of the lattice).
+                         -- See Note [HyperStr and Use demands]
+
+  | SCall StrDmd         -- ^ Call demand
+                         -- Used only for values of function type
+
+  | SProd [ArgStr]       -- ^ Product
+                         -- Used only for values of product type
+                         -- Invariant: not all components are HyperStr (use HyperStr)
+                         --            not all components are Lazy     (use HeadStr)
+
+  | HeadStr              -- ^ Head-Strict
+                         -- A polymorphic demand: used for values of all types,
+                         --                       including a type variable
+
+  deriving ( Eq, Show )
+
+-- | Strictness of a function argument.
+type ArgStr = Str StrDmd
+
+-- | Strictness demand.
+data Str s = Lazy  -- ^ Lazy (top of the lattice)
+           | Str s -- ^ Strict
+  deriving ( Eq, Show )
+
+-- Well-formedness preserving constructors for the Strictness domain
+strBot, strTop :: ArgStr
+strBot = Str HyperStr
+strTop = Lazy
+
+mkSCall :: StrDmd -> StrDmd
+mkSCall HyperStr = HyperStr
+mkSCall s        = SCall s
+
+mkSProd :: [ArgStr] -> StrDmd
+mkSProd sx
+  | any isHyperStr sx = HyperStr
+  | all isLazy     sx = HeadStr
+  | otherwise         = SProd sx
+
+isLazy :: ArgStr -> Bool
+isLazy Lazy     = True
+isLazy (Str {}) = False
+
+isHyperStr :: ArgStr -> Bool
+isHyperStr (Str HyperStr) = True
+isHyperStr _              = False
+
+-- Pretty-printing
+instance Outputable StrDmd where
+  ppr HyperStr      = char 'B'
+  ppr (SCall s)     = char 'C' <> parens (ppr s)
+  ppr HeadStr       = char 'S'
+  ppr (SProd sx)    = char 'S' <> parens (hcat (map ppr sx))
+
+instance Outputable ArgStr where
+  ppr (Str s) = ppr s
+  ppr Lazy    = char 'L'
+
+lubArgStr :: ArgStr -> ArgStr -> ArgStr
+lubArgStr Lazy     _        = Lazy
+lubArgStr _        Lazy     = Lazy
+lubArgStr (Str s1) (Str s2) = Str (s1 `lubStr` s2)
+
+lubStr :: StrDmd -> StrDmd -> StrDmd
+lubStr HyperStr s              = s
+lubStr (SCall s1) HyperStr     = SCall s1
+lubStr (SCall _)  HeadStr      = HeadStr
+lubStr (SCall s1) (SCall s2)   = SCall (s1 `lubStr` s2)
+lubStr (SCall _)  (SProd _)    = HeadStr
+lubStr (SProd sx) HyperStr     = SProd sx
+lubStr (SProd _)  HeadStr      = HeadStr
+lubStr (SProd s1) (SProd s2)
+    | s1 `equalLength` s2      = mkSProd (zipWith lubArgStr s1 s2)
+    | otherwise                = HeadStr
+lubStr (SProd _) (SCall _)     = HeadStr
+lubStr HeadStr   _             = HeadStr
+
+bothArgStr :: ArgStr -> ArgStr -> ArgStr
+bothArgStr Lazy     s        = s
+bothArgStr s        Lazy     = s
+bothArgStr (Str s1) (Str s2) = Str (s1 `bothStr` s2)
+
+bothStr :: StrDmd -> StrDmd -> StrDmd
+bothStr HyperStr _             = HyperStr
+bothStr HeadStr s              = s
+bothStr (SCall _)  HyperStr    = HyperStr
+bothStr (SCall s1) HeadStr     = SCall s1
+bothStr (SCall s1) (SCall s2)  = SCall (s1 `bothStr` s2)
+bothStr (SCall _)  (SProd _)   = HyperStr  -- Weird
+
+bothStr (SProd _)  HyperStr    = HyperStr
+bothStr (SProd s1) HeadStr     = SProd s1
+bothStr (SProd s1) (SProd s2)
+    | s1 `equalLength` s2      = mkSProd (zipWith bothArgStr s1 s2)
+    | otherwise                = HyperStr  -- Weird
+bothStr (SProd _) (SCall _)    = HyperStr
+
+-- utility functions to deal with memory leaks
+seqStrDmd :: StrDmd -> ()
+seqStrDmd (SProd ds)   = seqStrDmdList ds
+seqStrDmd (SCall s)    = seqStrDmd s
+seqStrDmd _            = ()
+
+seqStrDmdList :: [ArgStr] -> ()
+seqStrDmdList [] = ()
+seqStrDmdList (d:ds) = seqArgStr d `seq` seqStrDmdList ds
+
+seqArgStr :: ArgStr -> ()
+seqArgStr Lazy    = ()
+seqArgStr (Str s) = seqStrDmd s
+
+-- Splitting polymorphic demands
+splitArgStrProdDmd :: Int -> ArgStr -> Maybe [ArgStr]
+splitArgStrProdDmd n Lazy    = Just (replicate n Lazy)
+splitArgStrProdDmd n (Str s) = splitStrProdDmd n s
+
+splitStrProdDmd :: Int -> StrDmd -> Maybe [ArgStr]
+splitStrProdDmd n HyperStr   = Just (replicate n strBot)
+splitStrProdDmd n HeadStr    = Just (replicate n strTop)
+splitStrProdDmd n (SProd ds) = WARN( not (ds `lengthIs` n),
+                                     text "splitStrProdDmd" $$ ppr n $$ ppr ds )
+                               Just ds
+splitStrProdDmd _ (SCall {}) = Nothing
+      -- This can happen when the programmer uses unsafeCoerce,
+      -- and we don't then want to crash the compiler (#9208)
+
+{-
+************************************************************************
+*                                                                      *
+            Absence domain
+*                                                                      *
+************************************************************************
+
+         Used
+         /   \
+     UCall   UProd
+         \   /
+         UHead
+          |
+  Count x -
+        |
+       Abs
+-}
+
+-- | Domain for genuine usage
+data UseDmd
+  = UCall Count UseDmd   -- ^ Call demand for absence.
+                         -- Used only for values of function type
+
+  | UProd [ArgUse]       -- ^ Product.
+                         -- Used only for values of product type
+                         -- See Note [Don't optimise UProd(Used) to Used]
+                         --
+                         -- Invariant: Not all components are Abs
+                         -- (in that case, use UHead)
+
+  | UHead                -- ^ May be used but its sub-components are
+                         -- definitely *not* used.  For product types, UHead
+                         -- is equivalent to U(AAA); see mkUProd.
+                         --
+                         -- UHead is needed only to express the demand
+                         -- of 'seq' and 'case' which are polymorphic;
+                         -- i.e. the scrutinised value is of type 'a'
+                         -- rather than a product type. That's why we
+                         -- can't use UProd [A,A,A]
+                         --
+                         -- Since (UCall _ Abs) is ill-typed, UHead doesn't
+                         -- make sense for lambdas
+
+  | Used                 -- ^ May be used and its sub-components may be used.
+                         -- (top of the lattice)
+  deriving ( Eq, Show )
+
+-- Extended usage demand for absence and counting
+type ArgUse = Use UseDmd
+
+data Use u
+  = Abs             -- Definitely unused
+                    -- Bottom of the lattice
+
+  | Use Count u     -- May be used with some cardinality
+  deriving ( Eq, Show )
+
+-- | Abstract counting of usages
+data Count = One | Many
+  deriving ( Eq, Show )
+
+-- Pretty-printing
+instance Outputable ArgUse where
+  ppr Abs           = char 'A'
+  ppr (Use Many a)   = ppr a
+  ppr (Use One  a)   = char '1' <> char '*' <> ppr a
+
+instance Outputable UseDmd where
+  ppr Used           = char 'U'
+  ppr (UCall c a)    = char 'C' <> ppr c <> parens (ppr a)
+  ppr UHead          = char 'H'
+  ppr (UProd as)     = char 'U' <> parens (hcat (punctuate (char ',') (map ppr as)))
+
+instance Outputable Count where
+  ppr One  = char '1'
+  ppr Many = text ""
+
+useBot, useTop :: ArgUse
+useBot     = Abs
+useTop     = Use Many Used
+
+mkUCall :: Count -> UseDmd -> UseDmd
+--mkUCall c Used = Used c
+mkUCall c a  = UCall c a
+
+mkUProd :: [ArgUse] -> UseDmd
+mkUProd ux
+  | all (== Abs) ux    = UHead
+  | otherwise          = UProd ux
+
+lubCount :: Count -> Count -> Count
+lubCount _ Many = Many
+lubCount Many _ = Many
+lubCount x _    = x
+
+lubArgUse :: ArgUse -> ArgUse -> ArgUse
+lubArgUse Abs x                   = x
+lubArgUse x Abs                   = x
+lubArgUse (Use c1 a1) (Use c2 a2) = Use (lubCount c1 c2) (lubUse a1 a2)
+
+lubUse :: UseDmd -> UseDmd -> UseDmd
+lubUse UHead       u               = u
+lubUse (UCall c u) UHead           = UCall c u
+lubUse (UCall c1 u1) (UCall c2 u2) = UCall (lubCount c1 c2) (lubUse u1 u2)
+lubUse (UCall _ _) _               = Used
+lubUse (UProd ux) UHead            = UProd ux
+lubUse (UProd ux1) (UProd ux2)
+     | ux1 `equalLength` ux2       = UProd $ zipWith lubArgUse ux1 ux2
+     | otherwise                   = Used
+lubUse (UProd {}) (UCall {})       = Used
+-- lubUse (UProd {}) Used             = Used
+lubUse (UProd ux) Used             = UProd (map (`lubArgUse` useTop) ux)
+lubUse Used       (UProd ux)       = UProd (map (`lubArgUse` useTop) ux)
+lubUse Used _                      = Used  -- Note [Used should win]
+
+-- `both` is different from `lub` in its treatment of counting; if
+-- `both` is computed for two used, the result always has
+--  cardinality `Many` (except for the inner demands of UCall demand -- [TODO] explain).
+--  Also,  x `bothUse` x /= x (for anything but Abs).
+
+bothArgUse :: ArgUse -> ArgUse -> ArgUse
+bothArgUse Abs x                   = x
+bothArgUse x Abs                   = x
+bothArgUse (Use _ a1) (Use _ a2)   = Use Many (bothUse a1 a2)
+
+
+bothUse :: UseDmd -> UseDmd -> UseDmd
+bothUse UHead       u               = u
+bothUse (UCall c u) UHead           = UCall c u
+
+-- Exciting special treatment of inner demand for call demands:
+--    use `lubUse` instead of `bothUse`!
+bothUse (UCall _ u1) (UCall _ u2)   = UCall Many (u1 `lubUse` u2)
+
+bothUse (UCall {}) _                = Used
+bothUse (UProd ux) UHead            = UProd ux
+bothUse (UProd ux1) (UProd ux2)
+      | ux1 `equalLength` ux2       = UProd $ zipWith bothArgUse ux1 ux2
+      | otherwise                   = Used
+bothUse (UProd {}) (UCall {})       = Used
+-- bothUse (UProd {}) Used             = Used  -- Note [Used should win]
+bothUse Used (UProd ux)             = UProd (map (`bothArgUse` useTop) ux)
+bothUse (UProd ux) Used             = UProd (map (`bothArgUse` useTop) ux)
+bothUse Used _                      = Used  -- Note [Used should win]
+
+peelUseCall :: UseDmd -> Maybe (Count, UseDmd)
+peelUseCall (UCall c u)   = Just (c,u)
+peelUseCall _             = Nothing
+
+addCaseBndrDmd :: Demand    -- On the case binder
+               -> [Demand]  -- On the components of the constructor
+               -> [Demand]  -- Final demands for the components of the constructor
+-- See Note [Demand on case-alternative binders]
+addCaseBndrDmd (JD { sd = ms, ud = mu }) alt_dmds
+  = case mu of
+     Abs     -> alt_dmds
+     Use _ u -> zipWith bothDmd alt_dmds (mkJointDmds ss us)
+             where
+                Just ss = splitArgStrProdDmd arity ms  -- Guaranteed not to be a call
+                Just us = splitUseProdDmd      arity u   -- Ditto
+  where
+    arity = length alt_dmds
+
+{- Note [Demand on case-alternative binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The demand on a binder in a case alternative comes
+  (a) From the demand on the binder itself
+  (b) From the demand on the case binder
+Forgetting (b) led directly to #10148.
+
+Example. Source code:
+  f x@(p,_) = if p then foo x else True
+
+  foo (p,True) = True
+  foo (p,q)    = foo (q,p)
+
+After strictness analysis:
+  f = \ (x_an1 [Dmd=<S(SL),1*U(U,1*U)>] :: (Bool, Bool)) ->
+      case x_an1
+      of wild_X7 [Dmd=<L,1*U(1*U,1*U)>]
+      { (p_an2 [Dmd=<S,1*U>], ds_dnz [Dmd=<L,A>]) ->
+      case p_an2 of _ {
+        False -> GHC.Types.True;
+        True -> foo wild_X7 }
+
+It's true that ds_dnz is *itself* absent, but the use of wild_X7 means
+that it is very much alive and demanded.  See #10148 for how the
+consequences play out.
+
+This is needed even for non-product types, in case the case-binder
+is used but the components of the case alternative are not.
+
+Note [Don't optimise UProd(Used) to Used]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+These two UseDmds:
+   UProd [Used, Used]   and    Used
+are semantically equivalent, but we do not turn the former into
+the latter, for a regrettable-subtle reason.  Suppose we did.
+then
+  f (x,y) = (y,x)
+would get
+  StrDmd = Str  = SProd [Lazy, Lazy]
+  UseDmd = Used = UProd [Used, Used]
+But with the joint demand of <Str, Used> doesn't convey any clue
+that there is a product involved, and so the worthSplittingFun
+will not fire.  (We'd need to use the type as well to make it fire.)
+Moreover, consider
+  g h p@(_,_) = h p
+This too would get <Str, Used>, but this time there really isn't any
+point in w/w since the components of the pair are not used at all.
+
+So the solution is: don't aggressively collapse UProd [Used,Used] to
+Used; instead leave it as-is. In effect we are using the UseDmd to do a
+little bit of boxity analysis.  Not very nice.
+
+Note [Used should win]
+~~~~~~~~~~~~~~~~~~~~~~
+Both in lubUse and bothUse we want (Used `both` UProd us) to be Used.
+Why?  Because Used carries the implication the whole thing is used,
+box and all, so we don't want to w/w it.  If we use it both boxed and
+unboxed, then we are definitely using the box, and so we are quite
+likely to pay a reboxing cost.  So we make Used win here.
+
+Example is in the Buffer argument of GHC.IO.Handle.Internals.writeCharBuffer
+
+Baseline: (A) Not making Used win (UProd wins)
+Compare with: (B) making Used win for lub and both
+
+            Min          -0.3%     -5.6%    -10.7%    -11.0%    -33.3%
+            Max          +0.3%    +45.6%    +11.5%    +11.5%     +6.9%
+ Geometric Mean          -0.0%     +0.5%     +0.3%     +0.2%     -0.8%
+
+Baseline: (B) Making Used win for both lub and both
+Compare with: (C) making Used win for both, but UProd win for lub
+
+            Min          -0.1%     -0.3%     -7.9%     -8.0%     -6.5%
+            Max          +0.1%     +1.0%    +21.0%    +21.0%     +0.5%
+ Geometric Mean          +0.0%     +0.0%     -0.0%     -0.1%     -0.1%
+-}
+
+-- If a demand is used multiple times (i.e. reused), than any use-once
+-- mentioned there, that is not protected by a UCall, can happen many times.
+markReusedDmd :: ArgUse -> ArgUse
+markReusedDmd Abs         = Abs
+markReusedDmd (Use _ a)   = Use Many (markReused a)
+
+markReused :: UseDmd -> UseDmd
+markReused (UCall _ u)      = UCall Many u   -- No need to recurse here
+markReused (UProd ux)       = UProd (map markReusedDmd ux)
+markReused u                = u
+
+isUsedMU :: ArgUse -> Bool
+-- True <=> markReusedDmd d = d
+isUsedMU Abs          = True
+isUsedMU (Use One _)  = False
+isUsedMU (Use Many u) = isUsedU u
+
+isUsedU :: UseDmd -> Bool
+-- True <=> markReused d = d
+isUsedU Used           = True
+isUsedU UHead          = True
+isUsedU (UProd us)     = all isUsedMU us
+isUsedU (UCall One _)  = False
+isUsedU (UCall Many _) = True  -- No need to recurse
+
+-- Squashing usage demand demands
+seqUseDmd :: UseDmd -> ()
+seqUseDmd (UProd ds)   = seqArgUseList ds
+seqUseDmd (UCall c d)  = c `seq` seqUseDmd d
+seqUseDmd _            = ()
+
+seqArgUseList :: [ArgUse] -> ()
+seqArgUseList []     = ()
+seqArgUseList (d:ds) = seqArgUse d `seq` seqArgUseList ds
+
+seqArgUse :: ArgUse -> ()
+seqArgUse (Use c u)  = c `seq` seqUseDmd u
+seqArgUse _          = ()
+
+-- Splitting polymorphic Maybe-Used demands
+splitUseProdDmd :: Int -> UseDmd -> Maybe [ArgUse]
+splitUseProdDmd n Used        = Just (replicate n useTop)
+splitUseProdDmd n UHead       = Just (replicate n Abs)
+splitUseProdDmd n (UProd ds)  = WARN( not (ds `lengthIs` n),
+                                      text "splitUseProdDmd" $$ ppr n
+                                                             $$ ppr ds )
+                                Just ds
+splitUseProdDmd _ (UCall _ _) = Nothing
+      -- This can happen when the programmer uses unsafeCoerce,
+      -- and we don't then want to crash the compiler (#9208)
+
+useCount :: Use u -> Count
+useCount Abs         = One
+useCount (Use One _) = One
+useCount _           = Many
+
+
+{-
+************************************************************************
+*                                                                      *
+         Clean demand for Strictness and Usage
+*                                                                      *
+************************************************************************
+
+This domain differst from JointDemand in the sense that pure absence
+is taken away, i.e., we deal *only* with non-absent demands.
+
+Note [Strict demands]
+~~~~~~~~~~~~~~~~~~~~~
+isStrictDmd returns true only of demands that are
+   both strict
+   and  used
+In particular, it is False for <HyperStr, Abs>, which can and does
+arise in, say (#7319)
+   f x = raise# <some exception>
+Then 'x' is not used, so f gets strictness <HyperStr,Abs> -> .
+Now the w/w generates
+   fx = let x <HyperStr,Abs> = absentError "unused"
+        in raise <some exception>
+At this point we really don't want to convert to
+   fx = case absentError "unused" of x -> raise <some exception>
+Since the program is going to diverge, this swaps one error for another,
+but it's really a bad idea to *ever* evaluate an absent argument.
+In #7319 we get
+   T7319.exe: Oops!  Entered absent arg w_s1Hd{v} [lid] [base:GHC.Base.String{tc 36u}]
+
+Note [Dealing with call demands]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Call demands are constructed and deconstructed coherently for
+strictness and absence. For instance, the strictness signature for the
+following function
+
+f :: (Int -> (Int, Int)) -> (Int, Bool)
+f g = (snd (g 3), True)
+
+should be: <L,C(U(AU))>m
+-}
+
+type CleanDemand = JointDmd StrDmd UseDmd
+     -- A demand that is at least head-strict
+
+bothCleanDmd :: CleanDemand -> CleanDemand -> CleanDemand
+bothCleanDmd (JD { sd = s1, ud = a1}) (JD { sd = s2, ud = a2})
+  = JD { sd = s1 `bothStr` s2, ud = a1 `bothUse` a2 }
+
+mkHeadStrict :: CleanDemand -> CleanDemand
+mkHeadStrict cd = cd { sd = HeadStr }
+
+mkOnceUsedDmd, mkManyUsedDmd :: CleanDemand -> Demand
+mkOnceUsedDmd (JD {sd = s,ud = a}) = JD { sd = Str s, ud = Use One a }
+mkManyUsedDmd (JD {sd = s,ud = a}) = JD { sd = Str s, ud = Use Many a }
+
+evalDmd :: Demand
+-- Evaluated strictly, and used arbitrarily deeply
+evalDmd = JD { sd = Str HeadStr, ud = useTop }
+
+mkProdDmd :: [Demand] -> CleanDemand
+mkProdDmd dx
+  = JD { sd = mkSProd $ map getStrDmd dx
+       , ud = mkUProd $ map getUseDmd dx }
+
+-- | Wraps the 'CleanDemand' with a one-shot call demand: @d@ -> @C1(d)@.
+mkCallDmd :: CleanDemand -> CleanDemand
+mkCallDmd (JD {sd = d, ud = u})
+  = JD { sd = mkSCall d, ud = mkUCall One u }
+
+-- | @mkCallDmds n d@ returns @C1(C1...(C1 d))@ where there are @n@ @C1@'s.
+mkCallDmds :: Arity -> CleanDemand -> CleanDemand
+mkCallDmds arity cd = iterate mkCallDmd cd !! arity
+
+-- See Note [Demand on the worker] in GHC.Core.Op.WorkWrap
+mkWorkerDemand :: Int -> Demand
+mkWorkerDemand n = JD { sd = Lazy, ud = Use One (go n) }
+  where go 0 = Used
+        go n = mkUCall One $ go (n-1)
+
+cleanEvalDmd :: CleanDemand
+cleanEvalDmd = JD { sd = HeadStr, ud = Used }
+
+cleanEvalProdDmd :: Arity -> CleanDemand
+cleanEvalProdDmd n = JD { sd = HeadStr, ud = UProd (replicate n useTop) }
+
+
+{-
+************************************************************************
+*                                                                      *
+           Demand: Combining Strictness and Usage
+*                                                                      *
+************************************************************************
+-}
+
+type Demand = JointDmd ArgStr ArgUse
+
+lubDmd :: Demand -> Demand -> Demand
+lubDmd (JD {sd = s1, ud = a1}) (JD {sd = s2, ud = a2})
+ = JD { sd = s1 `lubArgStr` s2
+      , ud = a1 `lubArgUse` a2 }
+
+bothDmd :: Demand -> Demand -> Demand
+bothDmd (JD {sd = s1, ud = a1}) (JD {sd = s2, ud = a2})
+ = JD { sd = s1 `bothArgStr` s2
+      , ud = a1 `bothArgUse` a2 }
+
+lazyApply1Dmd, lazyApply2Dmd, strictApply1Dmd :: Demand
+
+strictApply1Dmd = JD { sd = Str (SCall HeadStr)
+                     , ud = Use Many (UCall One Used) }
+
+lazyApply1Dmd = JD { sd = Lazy
+                   , ud = Use One (UCall One Used) }
+
+-- Second argument of catch#:
+--    uses its arg at most once, applies it once
+--    but is lazy (might not be called at all)
+lazyApply2Dmd = JD { sd = Lazy
+                   , ud = Use One (UCall One (UCall One Used)) }
+
+absDmd :: Demand
+absDmd = JD { sd = Lazy, ud = Abs }
+
+topDmd :: Demand
+topDmd = JD { sd = Lazy, ud = useTop }
+
+botDmd :: Demand
+botDmd = JD { sd = strBot, ud = useBot }
+
+seqDmd :: Demand
+seqDmd = JD { sd = Str HeadStr, ud = Use One UHead }
+
+oneifyDmd :: JointDmd s (Use u) -> JointDmd s (Use u)
+oneifyDmd (JD { sd = s, ud = Use _ a }) = JD { sd = s, ud = Use One a }
+oneifyDmd jd                            = jd
+
+isTopDmd :: Demand -> Bool
+-- Used to suppress pretty-printing of an uninformative demand
+isTopDmd (JD {sd = Lazy, ud = Use Many Used}) = True
+isTopDmd _                                    = False
+
+isAbsDmd :: JointDmd (Str s) (Use u) -> Bool
+isAbsDmd (JD {ud = Abs}) = True   -- The strictness part can be HyperStr
+isAbsDmd _               = False  -- for a bottom demand
+
+isSeqDmd :: Demand -> Bool
+isSeqDmd (JD {sd = Str HeadStr, ud = Use _ UHead}) = True
+isSeqDmd _                                                = False
+
+isUsedOnce :: JointDmd (Str s) (Use u) -> Bool
+isUsedOnce (JD { ud = a }) = case useCount a of
+                               One  -> True
+                               Many -> False
+
+-- More utility functions for strictness
+seqDemand :: Demand -> ()
+seqDemand (JD {sd = s, ud = u}) = seqArgStr s `seq` seqArgUse u
+
+seqDemandList :: [Demand] -> ()
+seqDemandList [] = ()
+seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
+
+isStrictDmd :: JointDmd (Str s) (Use u) -> Bool
+-- See Note [Strict demands]
+isStrictDmd (JD {ud = Abs})  = False
+isStrictDmd (JD {sd = Lazy}) = False
+isStrictDmd _                = True
+
+isWeakDmd :: Demand -> Bool
+isWeakDmd (JD {sd = s, ud = a}) = isLazy s && isUsedMU a
+
+cleanUseDmd_maybe :: Demand -> Maybe UseDmd
+cleanUseDmd_maybe (JD { ud = Use _ u }) = Just u
+cleanUseDmd_maybe _                     = Nothing
+
+splitFVs :: Bool   -- Thunk
+         -> DmdEnv -> (DmdEnv, DmdEnv)
+splitFVs is_thunk rhs_fvs
+  | is_thunk  = nonDetFoldUFM_Directly add (emptyVarEnv, emptyVarEnv) rhs_fvs
+                -- It's OK to use nonDetFoldUFM_Directly because we
+                -- immediately forget the ordering by putting the elements
+                -- in the envs again
+  | otherwise = partitionVarEnv isWeakDmd rhs_fvs
+  where
+    add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv, sig_fv)
+      | Lazy <- s = (addToUFM_Directly lazy_fv uniq dmd, sig_fv)
+      | otherwise = ( addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })
+                    , addToUFM_Directly sig_fv  uniq (JD { sd = s,    ud = Abs }) )
+
+data TypeShape = TsFun TypeShape
+               | TsProd [TypeShape]
+               | TsUnk
+
+instance Outputable TypeShape where
+  ppr TsUnk        = text "TsUnk"
+  ppr (TsFun ts)   = text "TsFun" <> parens (ppr ts)
+  ppr (TsProd tss) = parens (hsep $ punctuate comma $ map ppr tss)
+
+-- | @peelTsFuns n ts@ tries to peel off @n@ 'TsFun' constructors from @ts@ and
+-- returns 'Just' the wrapped 'TypeShape' on success, and 'Nothing' otherwise.
+peelTsFuns :: Arity -> TypeShape -> Maybe TypeShape
+peelTsFuns 0 ts         = Just ts
+peelTsFuns n (TsFun ts) = peelTsFuns (n-1) ts
+peelTsFuns _ _          = Nothing
+
+trimToType :: Demand -> TypeShape -> Demand
+-- See Note [Trimming a demand to a type]
+trimToType (JD { sd = ms, ud = mu }) ts
+  = JD (go_ms ms ts) (go_mu mu ts)
+  where
+    go_ms :: ArgStr -> TypeShape -> ArgStr
+    go_ms Lazy    _  = Lazy
+    go_ms (Str s) ts = Str (go_s s ts)
+
+    go_s :: StrDmd -> TypeShape -> StrDmd
+    go_s HyperStr    _            = HyperStr
+    go_s (SCall s)   (TsFun ts)   = SCall (go_s s ts)
+    go_s (SProd mss) (TsProd tss)
+      | equalLength mss tss       = SProd (zipWith go_ms mss tss)
+    go_s _           _            = HeadStr
+
+    go_mu :: ArgUse -> TypeShape -> ArgUse
+    go_mu Abs _ = Abs
+    go_mu (Use c u) ts = Use c (go_u u ts)
+
+    go_u :: UseDmd -> TypeShape -> UseDmd
+    go_u UHead       _          = UHead
+    go_u (UCall c u) (TsFun ts) = UCall c (go_u u ts)
+    go_u (UProd mus) (TsProd tss)
+      | equalLength mus tss      = UProd (zipWith go_mu mus tss)
+    go_u _           _           = Used
+
+{-
+Note [Trimming a demand to a type]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this:
+
+  f :: a -> Bool
+  f x = case ... of
+          A g1 -> case (x |> g1) of (p,q) -> ...
+          B    -> error "urk"
+
+where A,B are the constructors of a GADT.  We'll get a U(U,U) demand
+on x from the A branch, but that's a stupid demand for x itself, which
+has type 'a'. Indeed we get ASSERTs going off (notably in
+splitUseProdDmd, #8569).
+
+Bottom line: we really don't want to have a binder whose demand is more
+deeply-nested than its type.  There are various ways to tackle this.
+When processing (x |> g1), we could "trim" the incoming demand U(U,U)
+to match x's type.  But I'm currently doing so just at the moment when
+we pin a demand on a binder, in GHC.Core.Op.DmdAnal.findBndrDmd.
+
+
+Note [Threshold demands]
+~~~~~~~~~~~~~~~~~~~~~~~~
+Threshold usage demand is generated to figure out if
+cardinality-instrumented demands of a binding's free variables should
+be unleashed. See also [Aggregated demand for cardinality].
+
+Note [Replicating polymorphic demands]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Some demands can be considered as polymorphic. Generally, it is
+applicable to such beasts as tops, bottoms as well as Head-Used and
+Head-stricts demands. For instance,
+
+S ~ S(L, ..., L)
+
+Also, when top or bottom is occurred as a result demand, it in fact
+can be expanded to saturate a callee's arity.
+-}
+
+splitProdDmd_maybe :: Demand -> Maybe [Demand]
+-- Split a product into its components, iff there is any
+-- useful information to be extracted thereby
+-- The demand is not necessarily strict!
+splitProdDmd_maybe (JD { sd = s, ud = u })
+  = case (s,u) of
+      (Str (SProd sx), Use _ u) | Just ux <- splitUseProdDmd (length sx) u
+                                -> Just (mkJointDmds sx ux)
+      (Str s, Use _ (UProd ux)) | Just sx <- splitStrProdDmd (length ux) s
+                                -> Just (mkJointDmds sx ux)
+      (Lazy,  Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)
+      _ -> Nothing
+
+{-
+************************************************************************
+*                                                                      *
+                   Termination
+*                                                                      *
+************************************************************************
+
+Divergence:     Dunno
+               /
+          Diverges
+
+In a fixpoint iteration, start from Diverges
+-}
+
+data Divergence
+  = Diverges    -- Definitely diverges
+  | Dunno       -- Might diverge or converge
+  deriving( Eq, Show )
+
+lubDivergence :: Divergence -> Divergence ->Divergence
+lubDivergence Diverges r        = r
+lubDivergence r        Diverges = r
+lubDivergence Dunno    Dunno    = Dunno
+-- This needs to commute with defaultDmd, i.e.
+-- defaultDmd (r1 `lubDivergence` r2) = defaultDmd r1 `lubDmd` defaultDmd r2
+-- (See Note [Default demand on free variables] for why)
+
+bothDivergence :: Divergence -> Divergence -> Divergence
+-- See Note [Asymmetry of 'both' for DmdType and Divergence]
+bothDivergence _ Diverges = Diverges
+bothDivergence r Dunno    = r
+-- This needs to commute with defaultDmd, i.e.
+-- defaultDmd (r1 `bothDivergence` r2) = defaultDmd r1 `bothDmd` defaultDmd r2
+-- (See Note [Default demand on free variables] for why)
+
+instance Outputable Divergence where
+  ppr Diverges      = char 'b'
+  ppr Dunno         = empty
+
+------------------------------------------------------------------------
+-- Combined demand result                                             --
+------------------------------------------------------------------------
+
+-- [cprRes] lets us switch off CPR analysis
+-- by making sure that everything uses TopRes
+topDiv, botDiv :: Divergence
+topDiv = Dunno
+botDiv = Diverges
+
+isTopDiv :: Divergence -> Bool
+isTopDiv Dunno = True
+isTopDiv _     = False
+
+-- | True if the result diverges or throws an exception
+isBotDiv :: Divergence -> Bool
+isBotDiv Diverges = True
+isBotDiv _        = False
+
+-- See Notes [Default demand on free variables]
+-- and [defaultDmd vs. resTypeArgDmd]
+defaultDmd :: Divergence -> Demand
+defaultDmd Dunno = absDmd
+defaultDmd _     = botDmd  -- Diverges
+
+resTypeArgDmd :: Divergence -> Demand
+-- TopRes and BotRes are polymorphic, so that
+--      BotRes === (Bot -> BotRes) === ...
+--      TopRes === (Top -> TopRes) === ...
+-- This function makes that concrete
+-- Also see Note [defaultDmd vs. resTypeArgDmd]
+resTypeArgDmd Dunno = topDmd
+resTypeArgDmd _     = botDmd   -- Diverges
+
+{-
+Note [defaultDmd and resTypeArgDmd]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+These functions are similar: They express the demand on something not
+explicitly mentioned in the environment resp. the argument list. Yet they are
+different:
+ * Variables not mentioned in the free variables environment are definitely
+   unused, so we can use absDmd there.
+ * Further arguments *can* be used, of course. Hence topDmd is used.
+
+
+************************************************************************
+*                                                                      *
+           Demand environments and types
+*                                                                      *
+************************************************************************
+-}
+
+type DmdEnv = VarEnv Demand   -- See Note [Default demand on free variables]
+
+data DmdType = DmdType
+                  DmdEnv        -- Demand on explicitly-mentioned
+                                --      free variables
+                  [Demand]      -- Demand on arguments
+                  Divergence     -- See [Nature of result demand]
+
+{-
+Note [Nature of result demand]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+A Divergence contains information about termination (currently distinguishing
+definite divergence and no information; it is possible to include definite
+convergence here), and CPR information about the result.
+
+The semantics of this depends on whether we are looking at a DmdType, i.e. the
+demand put on by an expression _under a specific incoming demand_ on its
+environment, or at a StrictSig describing a demand transformer.
+
+For a
+ * DmdType, the termination information is true given the demand it was
+   generated with, while for
+ * a StrictSig it holds after applying enough arguments.
+
+The CPR information, though, is valid after the number of arguments mentioned
+in the type is given. Therefore, when forgetting the demand on arguments, as in
+dmdAnalRhs, this needs to be considered (via removeDmdTyArgs).
+
+Consider
+  b2 x y = x `seq` y `seq` error (show x)
+this has a strictness signature of
+  <S><S>b
+meaning that "b2 `seq` ()" and "b2 1 `seq` ()" might well terminate, but
+for "b2 1 2 `seq` ()" we get definite divergence.
+
+For comparison,
+  b1 x = x `seq` error (show x)
+has a strictness signature of
+  <S>b
+and "b1 1 `seq` ()" is known to terminate.
+
+Now consider a function h with signature "<C(S)>", and the expression
+  e1 = h b1
+now h puts a demand of <C(S)> onto its argument, and the demand transformer
+turns it into
+  <S>b
+Now the Divergence "b" does apply to us, even though "b1 `seq` ()" does not
+diverge, and we do not anything being passed to b.
+
+Note [Asymmetry of 'both' for DmdType and Divergence]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+'both' for DmdTypes is *asymmetrical*, because there is only one
+result!  For example, given (e1 e2), we get a DmdType dt1 for e1, use
+its arg demand to analyse e2 giving dt2, and then do (dt1 `bothType` dt2).
+Similarly with
+  case e of { p -> rhs }
+we get dt_scrut from the scrutinee and dt_rhs from the RHS, and then
+compute (dt_rhs `bothType` dt_scrut).
+
+We
+ 1. combine the information on the free variables,
+ 2. take the demand on arguments from the first argument
+ 3. combine the termination results, but
+ 4. take CPR info from the first argument.
+
+3 and 4 are implemented in bothDivergence.
+-}
+
+-- Equality needed for fixpoints in GHC.Core.Op.DmdAnal
+instance Eq DmdType where
+  (==) (DmdType fv1 ds1 div1)
+       (DmdType fv2 ds2 div2) = nonDetUFMToList fv1 == nonDetUFMToList fv2
+         -- It's OK to use nonDetUFMToList here because we're testing for
+         -- equality and even though the lists will be in some arbitrary
+         -- Unique order, it is the same order for both
+                              && ds1 == ds2 && div1 == div2
+
+lubDmdType :: DmdType -> DmdType -> DmdType
+lubDmdType d1 d2
+  = DmdType lub_fv lub_ds lub_div
+  where
+    n = max (dmdTypeDepth d1) (dmdTypeDepth d2)
+    (DmdType fv1 ds1 r1) = ensureArgs n d1
+    (DmdType fv2 ds2 r2) = ensureArgs n d2
+
+    lub_fv  = plusVarEnv_CD lubDmd fv1 (defaultDmd r1) fv2 (defaultDmd r2)
+    lub_ds  = zipWithEqual "lubDmdType" lubDmd ds1 ds2
+    lub_div = lubDivergence r1 r2
+
+{-
+Note [The need for BothDmdArg]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Previously, the right argument to bothDmdType, as well as the return value of
+dmdAnalStar via postProcessDmdType, was a DmdType. But bothDmdType only needs
+to know about the free variables and termination information, but nothing about
+the demand put on arguments, nor cpr information. So we make that explicit by
+only passing the relevant information.
+-}
+
+type BothDmdArg = (DmdEnv, Divergence)
+
+mkBothDmdArg :: DmdEnv -> BothDmdArg
+mkBothDmdArg env = (env, Dunno)
+
+toBothDmdArg :: DmdType -> BothDmdArg
+toBothDmdArg (DmdType fv _ r) = (fv, go r)
+  where
+    go Dunno    = Dunno
+    go Diverges = Diverges
+
+bothDmdType :: DmdType -> BothDmdArg -> DmdType
+bothDmdType (DmdType fv1 ds1 r1) (fv2, t2)
+    -- See Note [Asymmetry of 'both' for DmdType and Divergence]
+    -- 'both' takes the argument/result info from its *first* arg,
+    -- using its second arg just for its free-var info.
+  = DmdType (plusVarEnv_CD bothDmd fv1 (defaultDmd r1) fv2 (defaultDmd t2))
+            ds1
+            (r1 `bothDivergence` t2)
+
+instance Outputable DmdType where
+  ppr (DmdType fv ds res)
+    = hsep [hcat (map ppr ds) <> ppr res,
+            if null fv_elts then empty
+            else braces (fsep (map pp_elt fv_elts))]
+    where
+      pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
+      fv_elts = nonDetUFMToList fv
+        -- It's OK to use nonDetUFMToList here because we only do it for
+        -- pretty printing
+
+emptyDmdEnv :: VarEnv Demand
+emptyDmdEnv = emptyVarEnv
+
+-- nopDmdType is the demand of doing nothing
+-- (lazy, absent, no CPR information, no termination information).
+-- Note that it is ''not'' the top of the lattice (which would be "may use everything"),
+-- so it is (no longer) called topDmd
+nopDmdType, botDmdType :: DmdType
+nopDmdType = DmdType emptyDmdEnv [] topDiv
+botDmdType = DmdType emptyDmdEnv [] botDiv
+
+isTopDmdType :: DmdType -> Bool
+isTopDmdType (DmdType env [] res)
+  | isTopDiv res && isEmptyVarEnv env = True
+isTopDmdType _                        = False
+
+mkDmdType :: DmdEnv -> [Demand] -> Divergence -> DmdType
+mkDmdType fv ds res = DmdType fv ds res
+
+dmdTypeDepth :: DmdType -> Arity
+dmdTypeDepth (DmdType _ ds _) = length ds
+
+-- | This makes sure we can use the demand type with n arguments.
+-- It extends the argument list with the correct resTypeArgDmd.
+-- It also adjusts the Divergence: Divergence survives additional arguments,
+-- CPR information does not (and definite converge also would not).
+ensureArgs :: Arity -> DmdType -> DmdType
+ensureArgs n d | n == depth = d
+               | otherwise  = DmdType fv ds' r'
+  where depth = dmdTypeDepth d
+        DmdType fv ds r = d
+
+        ds' = take n (ds ++ repeat (resTypeArgDmd r))
+        r' = case r of    -- See [Nature of result demand]
+              Dunno -> topDiv
+              _     -> r
+
+
+seqDmdType :: DmdType -> ()
+seqDmdType (DmdType env ds res) =
+  seqDmdEnv env `seq` seqDemandList ds `seq` res `seq` ()
+
+seqDmdEnv :: DmdEnv -> ()
+seqDmdEnv env = seqEltsUFM seqDemandList env
+
+splitDmdTy :: DmdType -> (Demand, DmdType)
+-- Split off one function argument
+-- We already have a suitable demand on all
+-- free vars, so no need to add more!
+splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)
+splitDmdTy ty@(DmdType _ [] res_ty)       = (resTypeArgDmd res_ty, ty)
+
+-- When e is evaluated after executing an IO action, and d is e's demand, then
+-- what of this demand should we consider, given that the IO action can cleanly
+-- exit?
+-- * We have to kill all strictness demands (i.e. lub with a lazy demand)
+-- * We can keep usage information (i.e. lub with an absent demand)
+-- * We have to kill definite divergence
+-- * We can keep CPR information.
+-- See Note [IO hack in the demand analyser] in GHC.Core.Op.DmdAnal
+deferAfterIO :: DmdType -> DmdType
+deferAfterIO d@(DmdType _ _ res) =
+    case d `lubDmdType` nopDmdType of
+        DmdType fv ds _ -> DmdType fv ds (defer_res res)
+  where
+  defer_res r@(Dunno {}) = r
+  defer_res _            = topDiv  -- Diverges
+
+strictenDmd :: Demand -> CleanDemand
+strictenDmd (JD { sd = s, ud = u})
+  = JD { sd = poke_s s, ud = poke_u u }
+  where
+    poke_s Lazy      = HeadStr
+    poke_s (Str s)   = s
+    poke_u Abs       = UHead
+    poke_u (Use _ u) = u
+
+-- Deferring and peeling
+
+type DmdShell   -- Describes the "outer shell"
+                -- of a Demand
+   = JointDmd (Str ()) (Use ())
+
+toCleanDmd :: Demand -> (DmdShell, CleanDemand)
+-- Splits a Demand into its "shell" and the inner "clean demand"
+toCleanDmd (JD { sd = s, ud = u })
+  = (JD { sd = ss, ud = us }, JD { sd = s', ud = u' })
+    -- See Note [Analyzing with lazy demand and lambdas]
+    -- See Note [Analysing with absent demand]
+  where
+    (ss, s') = case s of
+                Str s' -> (Str (), s')
+                Lazy   -> (Lazy,   HeadStr)
+
+    (us, u') = case u of
+                 Use c u' -> (Use c (), u')
+                 Abs      -> (Abs,      Used)
+
+-- This is used in dmdAnalStar when post-processing
+-- a function's argument demand. So we only care about what
+-- does to free variables, and whether it terminates.
+-- see Note [The need for BothDmdArg]
+postProcessDmdType :: DmdShell -> DmdType -> BothDmdArg
+postProcessDmdType du@(JD { sd = ss }) (DmdType fv _ res_ty)
+    = (postProcessDmdEnv du fv, postProcessDivergence ss res_ty)
+
+postProcessDivergence :: Str () -> Divergence -> Divergence
+postProcessDivergence Lazy _   = topDiv
+postProcessDivergence _    res = res
+
+postProcessDmdEnv :: DmdShell -> DmdEnv -> DmdEnv
+postProcessDmdEnv ds@(JD { sd = ss, ud = us }) env
+  | Abs <- us       = emptyDmdEnv
+    -- In this case (postProcessDmd ds) == id; avoid a redundant rebuild
+    -- of the environment. Be careful, bad things will happen if this doesn't
+    -- match postProcessDmd (see #13977).
+  | Str _ <- ss
+  , Use One _ <- us = env
+  | otherwise       = mapVarEnv (postProcessDmd ds) env
+  -- For the Absent case just discard all usage information
+  -- We only processed the thing at all to analyse the body
+  -- See Note [Always analyse in virgin pass]
+
+reuseEnv :: DmdEnv -> DmdEnv
+reuseEnv = mapVarEnv (postProcessDmd
+                        (JD { sd = Str (), ud = Use Many () }))
+
+postProcessUnsat :: DmdShell -> DmdType -> DmdType
+postProcessUnsat ds@(JD { sd = ss }) (DmdType fv args res_ty)
+  = DmdType (postProcessDmdEnv ds fv)
+            (map (postProcessDmd ds) args)
+            (postProcessDivergence ss res_ty)
+
+postProcessDmd :: DmdShell -> Demand -> Demand
+postProcessDmd (JD { sd = ss, ud = us }) (JD { sd = s, ud = a})
+  = JD { sd = s', ud = a' }
+  where
+    s' = case ss of
+           Lazy  -> Lazy
+           Str _ -> s
+    a' = case us of
+           Abs        -> Abs
+           Use Many _ -> markReusedDmd a
+           Use One  _ -> a
+
+-- Peels one call level from the demand, and also returns
+-- whether it was unsaturated (separately for strictness and usage)
+peelCallDmd :: CleanDemand -> (CleanDemand, DmdShell)
+-- Exploiting the fact that
+-- on the strictness side      C(B) = B
+-- and on the usage side       C(U) = U
+peelCallDmd (JD {sd = s, ud = u})
+  = (JD { sd = s', ud = u' }, JD { sd = ss, ud = us })
+  where
+    (s', ss) = case s of
+                 SCall s' -> (s',       Str ())
+                 HyperStr -> (HyperStr, Str ())
+                 _        -> (HeadStr,  Lazy)
+    (u', us) = case u of
+                 UCall c u' -> (u',   Use c    ())
+                 _          -> (Used, Use Many ())
+       -- The _ cases for usage includes UHead which seems a bit wrong
+       -- because the body isn't used at all!
+       -- c.f. the Abs case in toCleanDmd
+
+-- Peels that multiple nestings of calls clean demand and also returns
+-- whether it was unsaturated (separately for strictness and usage
+-- see Note [Demands from unsaturated function calls]
+peelManyCalls :: Int -> CleanDemand -> DmdShell
+peelManyCalls n (JD { sd = str, ud = abs })
+  = JD { sd = go_str n str, ud = go_abs n abs }
+  where
+    go_str :: Int -> StrDmd -> Str ()  -- True <=> unsaturated, defer
+    go_str 0 _          = Str ()
+    go_str _ HyperStr   = Str () -- == go_str (n-1) HyperStr, as HyperStr = Call(HyperStr)
+    go_str n (SCall d') = go_str (n-1) d'
+    go_str _ _          = Lazy
+
+    go_abs :: Int -> UseDmd -> Use ()      -- Many <=> unsaturated, or at least
+    go_abs 0 _              = Use One ()   --          one UCall Many in the demand
+    go_abs n (UCall One d') = go_abs (n-1) d'
+    go_abs _ _              = Use Many ()
+
+{-
+Note [Demands from unsaturated function calls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Consider a demand transformer d1 -> d2 -> r for f.
+If a sufficiently detailed demand is fed into this transformer,
+e.g <C(C(S)), C1(C1(S))> arising from "f x1 x2" in a strict, use-once context,
+then d1 and d2 is precisely the demand unleashed onto x1 and x2 (similar for
+the free variable environment) and furthermore the result information r is the
+one we want to use.
+
+An anonymous lambda is also an unsaturated function all (needs one argument,
+none given), so this applies to that case as well.
+
+But the demand fed into f might be less than <C(C(S)), C1(C1(S))>. There are a few cases:
+ * Not enough demand on the strictness side:
+   - In that case, we need to zap all strictness in the demand on arguments and
+     free variables.
+   - Furthermore, we remove CPR information. It could be left, but given the incoming
+     demand is not enough to evaluate so far we just do not bother.
+   - And finally termination information: If r says that f diverges for sure,
+     then this holds when the demand guarantees that two arguments are going to
+     be passed. If the demand is lower, we may just as well converge.
+     If we were tracking definite convegence, than that would still hold under
+     a weaker demand than expected by the demand transformer.
+ * Not enough demand from the usage side: The missing usage can be expanded
+   using UCall Many, therefore this is subsumed by the third case:
+ * At least one of the uses has a cardinality of Many.
+   - Even if f puts a One demand on any of its argument or free variables, if
+     we call f multiple times, we may evaluate this argument or free variable
+     multiple times. So forget about any occurrence of "One" in the demand.
+
+In dmdTransformSig, we call peelManyCalls to find out if we are in any of these
+cases, and then call postProcessUnsat to reduce the demand appropriately.
+
+Similarly, dmdTransformDictSelSig and dmdAnal, when analyzing a Lambda, use
+peelCallDmd, which peels only one level, but also returns the demand put on the
+body of the function.
+-}
+
+peelFV :: DmdType -> Var -> (DmdType, Demand)
+peelFV (DmdType fv ds res) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
+                               (DmdType fv' ds res, dmd)
+  where
+  fv' = fv `delVarEnv` id
+  -- See Note [Default demand on free variables]
+  dmd  = lookupVarEnv fv id `orElse` defaultDmd res
+
+addDemand :: Demand -> DmdType -> DmdType
+addDemand dmd (DmdType fv ds res) = DmdType fv (dmd:ds) res
+
+findIdDemand :: DmdType -> Var -> Demand
+findIdDemand (DmdType fv _ res) id
+  = lookupVarEnv fv id `orElse` defaultDmd res
+
+{-
+Note [Default demand on free variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If the variable is not mentioned in the environment of a demand type,
+its demand is taken to be a result demand of the type.
+    For the strictness component,
+     if the result demand is a Diverges, then we use HyperStr
+                                         else we use Lazy
+    For the usage component, we use Absent.
+So we use either absDmd or botDmd.
+
+Also note the equations for lubDivergence (resp. bothDivergence) noted there.
+
+Note [Always analyse in virgin pass]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Tricky point: make sure that we analyse in the 'virgin' pass. Consider
+   rec { f acc x True  = f (...rec { g y = ...g... }...)
+         f acc x False = acc }
+In the virgin pass for 'f' we'll give 'f' a very strict (bottom) type.
+That might mean that we analyse the sub-expression containing the
+E = "...rec g..." stuff in a bottom demand.  Suppose we *didn't analyse*
+E, but just returned botType.
+
+Then in the *next* (non-virgin) iteration for 'f', we might analyse E
+in a weaker demand, and that will trigger doing a fixpoint iteration
+for g.  But *because it's not the virgin pass* we won't start g's
+iteration at bottom.  Disaster.  (This happened in $sfibToList' of
+nofib/spectral/fibheaps.)
+
+So in the virgin pass we make sure that we do analyse the expression
+at least once, to initialise its signatures.
+
+Note [Analyzing with lazy demand and lambdas]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The insight for analyzing lambdas follows from the fact that for
+strictness S = C(L). This polymorphic expansion is critical for
+cardinality analysis of the following example:
+
+{-# NOINLINE build #-}
+build g = (g (:) [], g (:) [])
+
+h c z = build (\x ->
+                let z1 = z ++ z
+                 in if c
+                    then \y -> x (y ++ z1)
+                    else \y -> x (z1 ++ y))
+
+One can see that `build` assigns to `g` demand <L,C(C1(U))>.
+Therefore, when analyzing the lambda `(\x -> ...)`, we
+expect each lambda \y -> ... to be annotated as "one-shot"
+one. Therefore (\x -> \y -> x (y ++ z)) should be analyzed with a
+demand <C(C(..), C(C1(U))>.
+
+This is achieved by, first, converting the lazy demand L into the
+strict S by the second clause of the analysis.
+
+Note [Analysing with absent demand]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we analyse an expression with demand <L,A>.  The "A" means
+"absent", so this expression will never be needed.  What should happen?
+There are several wrinkles:
+
+* We *do* want to analyse the expression regardless.
+  Reason: Note [Always analyse in virgin pass]
+
+  But we can post-process the results to ignore all the usage
+  demands coming back. This is done by postProcessDmdType.
+
+* In a previous incarnation of GHC we needed to be extra careful in the
+  case of an *unlifted type*, because unlifted values are evaluated
+  even if they are not used.  Example (see #9254):
+     f :: (() -> (# Int#, () #)) -> ()
+          -- Strictness signature is
+          --    <C(S(LS)), 1*C1(U(A,1*U()))>
+          -- I.e. calls k, but discards first component of result
+     f k = case k () of (# _, r #) -> r
+
+     g :: Int -> ()
+     g y = f (\n -> (# case y of I# y2 -> y2, n #))
+
+  Here f's strictness signature says (correctly) that it calls its
+  argument function and ignores the first component of its result.
+  This is correct in the sense that it'd be fine to (say) modify the
+  function so that always returned 0# in the first component.
+
+  But in function g, we *will* evaluate the 'case y of ...', because
+  it has type Int#.  So 'y' will be evaluated.  So we must record this
+  usage of 'y', else 'g' will say 'y' is absent, and will w/w so that
+  'y' is bound to an aBSENT_ERROR thunk.
+
+  However, the argument of toCleanDmd always satisfies the let/app
+  invariant; so if it is unlifted it is also okForSpeculation, and so
+  can be evaluated in a short finite time -- and that rules out nasty
+  cases like the one above.  (I'm not quite sure why this was a
+  problem in an earlier version of GHC, but it isn't now.)
+
+
+************************************************************************
+*                                                                      *
+                     Demand signatures
+*                                                                      *
+************************************************************************
+
+In a let-bound Id we record its strictness info.
+In principle, this strictness info is a demand transformer, mapping
+a demand on the Id into a DmdType, which gives
+        a) the free vars of the Id's value
+        b) the Id's arguments
+        c) an indication of the result of applying
+           the Id to its arguments
+
+However, in fact we store in the Id an extremely emascuated demand
+transfomer, namely
+
+                a single DmdType
+(Nevertheless we dignify StrictSig as a distinct type.)
+
+This DmdType gives the demands unleashed by the Id when it is applied
+to as many arguments as are given in by the arg demands in the DmdType.
+Also see Note [Nature of result demand] for the meaning of a Divergence in a
+strictness signature.
+
+If an Id is applied to less arguments than its arity, it means that
+the demand on the function at a call site is weaker than the vanilla
+call demand, used for signature inference. Therefore we place a top
+demand on all arguments. Otherwise, the demand is specified by Id's
+signature.
+
+For example, the demand transformer described by the demand signature
+        StrictSig (DmdType {x -> <S,1*U>} <L,A><L,U(U,U)>m)
+says that when the function is applied to two arguments, it
+unleashes demand <S,1*U> on the free var x, <L,A> on the first arg,
+and <L,U(U,U)> on the second, then returning a constructor.
+
+If this same function is applied to one arg, all we can say is that it
+uses x with <L,U>, and its arg with demand <L,U>.
+
+Note [Understanding DmdType and StrictSig]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Demand types are sound approximations of an expression's semantics relative to
+the incoming demand we put the expression under. Consider the following
+expression:
+
+    \x y -> x `seq` (y, 2*x)
+
+Here is a table with demand types resulting from different incoming demands we
+put that expression under. Note the monotonicity; a stronger incoming demand
+yields a more precise demand type:
+
+    incoming demand                  |  demand type
+    ----------------------------------------------------
+    <S           ,HU              >  |  <L,U><L,U>{}
+    <C(C(S     )),C1(C1(U       ))>  |  <S,U><L,U>{}
+    <C(C(S(S,L))),C1(C1(U(1*U,A)))>  |  <S,1*HU><L,A>{}
+
+Note that in the first example, the depth of the demand type was *higher* than
+the arity of the incoming call demand due to the anonymous lambda.
+The converse is also possible and happens when we unleash demand signatures.
+In @f x y@, the incoming call demand on f has arity 2. But if all we have is a
+demand signature with depth 1 for @f@ (which we can safely unleash, see below),
+the demand type of @f@ under a call demand of arity 2 has a *lower* depth of 1.
+
+So: Demand types are elicited by putting an expression under an incoming (call)
+demand, the arity of which can be lower or higher than the depth of the
+resulting demand type.
+In contrast, a demand signature summarises a function's semantics *without*
+immediately specifying the incoming demand it was produced under. Despite StrSig
+being a newtype wrapper around DmdType, it actually encodes two things:
+
+  * The threshold (i.e., minimum arity) to unleash the signature
+  * A demand type that is sound to unleash when the minimum arity requirement is
+    met.
+
+Here comes the subtle part: The threshold is encoded in the wrapped demand
+type's depth! So in mkStrictSigForArity we make sure to trim the list of
+argument demands to the given threshold arity. Call sites will make sure that
+this corresponds to the arity of the call demand that elicited the wrapped
+demand type. See also Note [What are demand signatures?] in GHC.Core.Op.DmdAnal.
+
+Besides trimming argument demands, mkStrictSigForArity will also trim CPR
+information if necessary.
+-}
+
+-- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe
+-- to unleash. Better construct this through 'mkStrictSigForArity'.
+-- See Note [Understanding DmdType and StrictSig]
+newtype StrictSig = StrictSig DmdType
+                  deriving( Eq )
+
+instance Outputable StrictSig where
+   ppr (StrictSig ty) = ppr ty
+
+-- Used for printing top-level strictness pragmas in interface files
+pprIfaceStrictSig :: StrictSig -> SDoc
+pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
+  = hcat (map ppr dmds) <> ppr res
+
+-- | Turns a 'DmdType' computed for the particular 'Arity' into a 'StrictSig'
+-- unleashable at that arity. See Note [Understanding DmdType and StrictSig]
+mkStrictSigForArity :: Arity -> DmdType -> StrictSig
+mkStrictSigForArity arity dmd_ty = StrictSig (ensureArgs arity dmd_ty)
+
+mkClosedStrictSig :: [Demand] -> Divergence -> StrictSig
+mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv ds res)
+
+splitStrictSig :: StrictSig -> ([Demand], Divergence)
+splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
+
+increaseStrictSigArity :: Int -> StrictSig -> StrictSig
+-- ^ Add extra arguments to a strictness signature.
+-- In contrast to 'etaExpandStrictSig', this /prepends/ additional argument
+-- demands and leaves CPR info intact.
+increaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds res))
+  | isTopDmdType dmd_ty = sig
+  | arity_increase == 0 = sig
+  | arity_increase < 0  = WARN( True, text "increaseStrictSigArity:"
+                                  <+> text "negative arity increase"
+                                  <+> ppr arity_increase )
+                          nopSig
+  | otherwise           = StrictSig (DmdType env dmds' res)
+  where
+    dmds' = replicate arity_increase topDmd ++ dmds
+
+etaExpandStrictSig :: Arity -> StrictSig -> StrictSig
+-- ^ We are expanding (\x y. e) to (\x y z. e z).
+-- In contrast to 'increaseStrictSigArity', this /appends/ extra arg demands if
+-- necessary, potentially destroying the signature's CPR property.
+etaExpandStrictSig arity (StrictSig dmd_ty)
+  | arity < dmdTypeDepth dmd_ty
+  -- an arity decrease must zap the whole signature, because it was possibly
+  -- computed for a higher incoming call demand.
+  = nopSig
+  | otherwise
+  = StrictSig $ ensureArgs arity dmd_ty
+
+isTopSig :: StrictSig -> Bool
+isTopSig (StrictSig ty) = isTopDmdType ty
+
+hasDemandEnvSig :: StrictSig -> Bool
+hasDemandEnvSig (StrictSig (DmdType env _ _)) = not (isEmptyVarEnv env)
+
+strictSigDmdEnv :: StrictSig -> DmdEnv
+strictSigDmdEnv (StrictSig (DmdType env _ _)) = env
+
+-- | True if the signature diverges or throws an exception
+isBottomingSig :: StrictSig -> Bool
+isBottomingSig (StrictSig (DmdType _ _ res)) = isBotDiv res
+
+nopSig, botSig :: StrictSig
+nopSig = StrictSig nopDmdType
+botSig = StrictSig botDmdType
+
+cprProdSig :: Arity -> StrictSig
+cprProdSig _arity = nopSig
+
+seqStrictSig :: StrictSig -> ()
+seqStrictSig (StrictSig ty) = seqDmdType ty
+
+dmdTransformSig :: StrictSig -> CleanDemand -> DmdType
+-- (dmdTransformSig fun_sig dmd) considers a call to a function whose
+-- signature is fun_sig, with demand dmd.  We return the demand
+-- that the function places on its context (eg its args)
+dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _)) cd
+  = postProcessUnsat (peelManyCalls (length arg_ds) cd) dmd_ty
+    -- see Note [Demands from unsaturated function calls]
+
+dmdTransformDataConSig :: Arity -> StrictSig -> CleanDemand -> DmdType
+-- Same as dmdTransformSig but for a data constructor (worker),
+-- which has a special kind of demand transformer.
+-- If the constructor is saturated, we feed the demand on
+-- the result into the constructor arguments.
+dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))
+                             (JD { sd = str, ud = abs })
+  | Just str_dmds <- go_str arity str
+  , Just abs_dmds <- go_abs arity abs
+  = DmdType emptyDmdEnv (mkJointDmds str_dmds abs_dmds) con_res
+                -- Must remember whether it's a product, hence con_res, not TopRes
+
+  | otherwise   -- Not saturated
+  = nopDmdType
+  where
+    go_str 0 dmd        = splitStrProdDmd arity dmd
+    go_str n (SCall s') = go_str (n-1) s'
+    go_str n HyperStr   = go_str (n-1) HyperStr
+    go_str _ _          = Nothing
+
+    go_abs 0 dmd            = splitUseProdDmd arity dmd
+    go_abs n (UCall One u') = go_abs (n-1) u'
+    go_abs _ _              = Nothing
+
+dmdTransformDictSelSig :: StrictSig -> CleanDemand -> DmdType
+-- Like dmdTransformDataConSig, we have a special demand transformer
+-- for dictionary selectors.  If the selector is saturated (ie has one
+-- argument: the dictionary), we feed the demand on the result into
+-- the indicated dictionary component.
+dmdTransformDictSelSig (StrictSig (DmdType _ [dict_dmd] _)) cd
+   | (cd',defer_use) <- peelCallDmd cd
+   , Just jds <- splitProdDmd_maybe dict_dmd
+   = postProcessUnsat defer_use $
+     DmdType emptyDmdEnv [mkOnceUsedDmd $ mkProdDmd $ map (enhance cd') jds] topDiv
+   | otherwise
+   = nopDmdType              -- See Note [Demand transformer for a dictionary selector]
+  where
+    enhance cd old | isAbsDmd old = old
+                   | otherwise    = mkOnceUsedDmd cd  -- This is the one!
+
+dmdTransformDictSelSig _ _ = panic "dmdTransformDictSelSig: no args"
+
+{-
+Note [Demand transformer for a dictionary selector]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we evaluate (op dict-expr) under demand 'd', then we can push the demand 'd'
+into the appropriate field of the dictionary. What *is* the appropriate field?
+We just look at the strictness signature of the class op, which will be
+something like: U(AAASAAAAA).  Then replace the 'S' by the demand 'd'.
+
+For single-method classes, which are represented by newtypes the signature
+of 'op' won't look like U(...), so the splitProdDmd_maybe will fail.
+That's fine: if we are doing strictness analysis we are also doing inlining,
+so we'll have inlined 'op' into a cast.  So we can bale out in a conservative
+way, returning nopDmdType.
+
+It is (just.. #8329) possible to be running strictness analysis *without*
+having inlined class ops from single-method classes.  Suppose you are using
+ghc --make; and the first module has a local -O0 flag.  So you may load a class
+without interface pragmas, ie (currently) without an unfolding for the class
+ops.   Now if a subsequent module in the --make sweep has a local -O flag
+you might do strictness analysis, but there is no inlining for the class op.
+This is weird, so I'm not worried about whether this optimises brilliantly; but
+it should not fall over.
+-}
+
+argsOneShots :: StrictSig -> Arity -> [[OneShotInfo]]
+-- See Note [Computing one-shot info]
+argsOneShots (StrictSig (DmdType _ arg_ds _)) n_val_args
+  | unsaturated_call = []
+  | otherwise = go arg_ds
+  where
+    unsaturated_call = arg_ds `lengthExceeds` n_val_args
+
+    go []               = []
+    go (arg_d : arg_ds) = argOneShots arg_d `cons` go arg_ds
+
+    -- Avoid list tail like [ [], [], [] ]
+    cons [] [] = []
+    cons a  as = a:as
+
+-- saturatedByOneShots n C1(C1(...)) = True,
+--   <=>
+-- there are at least n nested C1(..) calls
+-- See Note [Demand on the worker] in GHC.Core.Op.WorkWrap
+saturatedByOneShots :: Int -> Demand -> Bool
+saturatedByOneShots n (JD { ud = usg })
+  = case usg of
+      Use _ arg_usg -> go n arg_usg
+      _             -> False
+  where
+    go 0 _             = True
+    go n (UCall One u) = go (n-1) u
+    go _ _             = False
+
+argOneShots :: Demand          -- depending on saturation
+            -> [OneShotInfo]
+argOneShots (JD { ud = usg })
+  = case usg of
+      Use _ arg_usg -> go arg_usg
+      _             -> []
+  where
+    go (UCall One  u) = OneShotLam : go u
+    go (UCall Many u) = NoOneShotInfo : go u
+    go _              = []
+
+{- Note [Computing one-shot info]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a call
+    f (\pqr. e1) (\xyz. e2) e3
+where f has usage signature
+    C1(C(C1(U))) C1(U) U
+Then argsOneShots returns a [[OneShotInfo]] of
+    [[OneShot,NoOneShotInfo,OneShot],  [OneShot]]
+The occurrence analyser propagates this one-shot infor to the
+binders \pqr and \xyz; see Note [Use one-shot information] in OccurAnal.
+-}
+
+-- | Returns true if an application to n args
+-- would diverge or throw an exception
+-- See Note [Unsaturated applications]
+appIsBottom :: StrictSig -> Int -> Bool
+appIsBottom (StrictSig (DmdType _ ds res)) n
+            | isBotDiv res                   = not $ lengthExceeds ds n
+appIsBottom _                              _ = False
+
+{-
+Note [Unsaturated applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If a function having bottom as its demand result is applied to a less
+number of arguments than its syntactic arity, we cannot say for sure
+that it is going to diverge. This is the reason why we use the
+function appIsBottom, which, given a strictness signature and a number
+of arguments, says conservatively if the function is going to diverge
+or not.
+-}
+
+zapUsageEnvSig :: StrictSig -> StrictSig
+-- Remove the usage environment from the demand
+zapUsageEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r
+
+zapUsageDemand :: Demand -> Demand
+-- Remove the usage info, but not the strictness info, from the demand
+zapUsageDemand = kill_usage $ KillFlags
+    { kf_abs         = True
+    , kf_used_once   = True
+    , kf_called_once = True
+    }
+
+-- | Remove all 1* information (but not C1 information) from the demand
+zapUsedOnceDemand :: Demand -> Demand
+zapUsedOnceDemand = kill_usage $ KillFlags
+    { kf_abs         = False
+    , kf_used_once   = True
+    , kf_called_once = False
+    }
+
+-- | Remove all 1* information (but not C1 information) from the strictness
+--   signature
+zapUsedOnceSig :: StrictSig -> StrictSig
+zapUsedOnceSig (StrictSig (DmdType env ds r))
+    = StrictSig (DmdType env (map zapUsedOnceDemand ds) r)
+
+data KillFlags = KillFlags
+    { kf_abs         :: Bool
+    , kf_used_once   :: Bool
+    , kf_called_once :: Bool
+    }
+
+kill_usage :: KillFlags -> Demand -> Demand
+kill_usage kfs (JD {sd = s, ud = u}) = JD {sd = s, ud = zap_musg kfs u}
+
+zap_musg :: KillFlags -> ArgUse -> ArgUse
+zap_musg kfs Abs
+  | kf_abs kfs = useTop
+  | otherwise  = Abs
+zap_musg kfs (Use c u)
+  | kf_used_once kfs = Use Many (zap_usg kfs u)
+  | otherwise        = Use c    (zap_usg kfs u)
+
+zap_usg :: KillFlags -> UseDmd -> UseDmd
+zap_usg kfs (UCall c u)
+    | kf_called_once kfs = UCall Many (zap_usg kfs u)
+    | otherwise          = UCall c    (zap_usg kfs u)
+zap_usg kfs (UProd us)   = UProd (map (zap_musg kfs) us)
+zap_usg _   u            = u
+
+-- If the argument is a used non-newtype dictionary, give it strict
+-- demand. Also split the product type & demand and recur in order to
+-- similarly strictify the argument's contained used non-newtype
+-- superclass dictionaries. We use the demand as our recursive measure
+-- to guarantee termination.
+strictifyDictDmd :: Type -> Demand -> Demand
+strictifyDictDmd ty dmd = case getUseDmd dmd of
+  Use n _ |
+    Just (tycon, _arg_tys, _data_con, inst_con_arg_tys)
+      <- splitDataProductType_maybe ty,
+    not (isNewTyCon tycon), isClassTyCon tycon -- is a non-newtype dictionary
+    -> seqDmd `bothDmd` -- main idea: ensure it's strict
+       case splitProdDmd_maybe dmd of
+         -- superclass cycles should not be a problem, since the demand we are
+         -- consuming would also have to be infinite in order for us to diverge
+         Nothing -> dmd -- no components have interesting demand, so stop
+                        -- looking for superclass dicts
+         Just dmds
+           | all (not . isAbsDmd) dmds -> evalDmd
+             -- abstract to strict w/ arbitrary component use, since this
+             -- smells like reboxing; results in CBV boxed
+             --
+             -- TODO revisit this if we ever do boxity analysis
+           | otherwise -> case mkProdDmd $ zipWith strictifyDictDmd inst_con_arg_tys dmds of
+               JD {sd = s,ud = a} -> JD (Str s) (Use n a)
+             -- TODO could optimize with an aborting variant of zipWith since
+             -- the superclass dicts are always a prefix
+  _ -> dmd -- unused or not a dictionary
+
+strictifyDmd :: Demand -> Demand
+strictifyDmd dmd@(JD { sd = str })
+  = dmd { sd = str `bothArgStr` Str HeadStr }
+
+{-
+Note [HyperStr and Use demands]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The information "HyperStr" needs to be in the strictness signature, and not in
+the demand signature, because we still want to know about the demand on things. Consider
+
+    f (x,y) True  = error (show x)
+    f (x,y) False = x+1
+
+The signature of f should be <S(SL),1*U(1*U(U),A)><S,1*U>m. If we were not
+distinguishing the uses on x and y in the True case, we could either not figure
+out how deeply we can unpack x, or that we do not have to pass y.
+
+
+************************************************************************
+*                                                                      *
+                     Serialisation
+*                                                                      *
+************************************************************************
+-}
+
+instance Binary StrDmd where
+  put_ bh HyperStr     = do putByte bh 0
+  put_ bh HeadStr      = do putByte bh 1
+  put_ bh (SCall s)    = do putByte bh 2
+                            put_ bh s
+  put_ bh (SProd sx)   = do putByte bh 3
+                            put_ bh sx
+  get bh = do
+         h <- getByte bh
+         case h of
+           0 -> do return HyperStr
+           1 -> do return HeadStr
+           2 -> do s  <- get bh
+                   return (SCall s)
+           _ -> do sx <- get bh
+                   return (SProd sx)
+
+instance Binary ArgStr where
+    put_ bh Lazy         = do
+            putByte bh 0
+    put_ bh (Str s)    = do
+            putByte bh 1
+            put_ bh s
+
+    get  bh = do
+            h <- getByte bh
+            case h of
+              0 -> return Lazy
+              _ -> do s  <- get bh
+                      return $ Str s
+
+instance Binary Count where
+    put_ bh One  = do putByte bh 0
+    put_ bh Many = do putByte bh 1
+
+    get  bh = do h <- getByte bh
+                 case h of
+                   0 -> return One
+                   _ -> return Many
+
+instance Binary ArgUse where
+    put_ bh Abs          = do
+            putByte bh 0
+    put_ bh (Use c u)    = do
+            putByte bh 1
+            put_ bh c
+            put_ bh u
+
+    get  bh = do
+            h <- getByte bh
+            case h of
+              0 -> return Abs
+              _ -> do c  <- get bh
+                      u  <- get bh
+                      return $ Use c u
+
+instance Binary UseDmd where
+    put_ bh Used         = do
+            putByte bh 0
+    put_ bh UHead        = do
+            putByte bh 1
+    put_ bh (UCall c u)    = do
+            putByte bh 2
+            put_ bh c
+            put_ bh u
+    put_ bh (UProd ux)   = do
+            putByte bh 3
+            put_ bh ux
+
+    get  bh = do
+            h <- getByte bh
+            case h of
+              0 -> return $ Used
+              1 -> return $ UHead
+              2 -> do c <- get bh
+                      u <- get bh
+                      return (UCall c u)
+              _ -> do ux <- get bh
+                      return (UProd ux)
+
+instance (Binary s, Binary u) => Binary (JointDmd s u) where
+    put_ bh (JD { sd = x, ud = y }) = do put_ bh x; put_ bh y
+    get  bh = do
+              x <- get bh
+              y <- get bh
+              return $ JD { sd = x, ud = y }
+
+instance Binary StrictSig where
+    put_ bh (StrictSig aa) = do
+            put_ bh aa
+    get bh = do
+          aa <- get bh
+          return (StrictSig aa)
+
+instance Binary DmdType where
+  -- Ignore DmdEnv when spitting out the DmdType
+  put_ bh (DmdType _ ds dr)
+       = do put_ bh ds
+            put_ bh dr
+  get bh
+      = do ds <- get bh
+           dr <- get bh
+           return (DmdType emptyDmdEnv ds dr)
+
+instance Binary Divergence where
+  put_ bh Dunno    = putByte bh 0
+  put_ bh Diverges = putByte bh 1
+
+  get bh = do { h <- getByte bh
+              ; case h of
+                  0 -> return Dunno
+                  _ -> return Diverges }
diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs
new file mode 100644
index 0000000000..e73877b292
--- /dev/null
+++ b/compiler/GHC/Types/FieldLabel.hs
@@ -0,0 +1,132 @@
+{-
+%
+% (c) Adam Gundry 2013-2015
+%
+
+This module defines the representation of FieldLabels as stored in
+TyCons.  As well as a selector name, these have some extra structure
+to support the DuplicateRecordFields extension.
+
+In the normal case (with NoDuplicateRecordFields), a datatype like
+
+    data T = MkT { foo :: Int }
+
+has
+
+    FieldLabel { flLabel        = "foo"
+               , flIsOverloaded = False
+               , flSelector     = foo }.
+
+In particular, the Name of the selector has the same string
+representation as the label.  If DuplicateRecordFields
+is enabled, however, the same declaration instead gives
+
+    FieldLabel { flLabel        = "foo"
+               , flIsOverloaded = True
+               , flSelector     = $sel:foo:MkT }.
+
+Now the name of the selector ($sel:foo:MkT) does not match the label of
+the field (foo).  We must be careful not to show the selector name to
+the user!  The point of mangling the selector name is to allow a
+module to define the same field label in different datatypes:
+
+    data T = MkT { foo :: Int }
+    data U = MkU { foo :: Bool }
+
+Now there will be two FieldLabel values for 'foo', one in T and one in
+U.  They share the same label (FieldLabelString), but the selector
+functions differ.
+
+See also Note [Representing fields in AvailInfo] in GHC.Types.Avail.
+
+Note [Why selector names include data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+As explained above, a selector name includes the name of the first
+data constructor in the type, so that the same label can appear
+multiple times in the same module.  (This is irrespective of whether
+the first constructor has that field, for simplicity.)
+
+We use a data constructor name, rather than the type constructor name,
+because data family instances do not have a representation type
+constructor name generated until relatively late in the typechecking
+process.
+
+Of course, datatypes with no constructors cannot have any fields.
+
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module GHC.Types.FieldLabel
+   ( FieldLabelString
+   , FieldLabelEnv
+   , FieldLbl(..)
+   , FieldLabel
+   , mkFieldLabelOccs
+   )
+where
+
+import GhcPrelude
+
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name
+
+import FastString
+import FastStringEnv
+import Outputable
+import Binary
+
+import Data.Data
+
+-- | Field labels are just represented as strings;
+-- they are not necessarily unique (even within a module)
+type FieldLabelString = FastString
+
+-- | A map from labels to all the auxiliary information
+type FieldLabelEnv = DFastStringEnv FieldLabel
+
+
+type FieldLabel = FieldLbl Name
+
+-- | Fields in an algebraic record type
+data FieldLbl a = FieldLabel {
+      flLabel        :: FieldLabelString, -- ^ User-visible label of the field
+      flIsOverloaded :: Bool,             -- ^ Was DuplicateRecordFields on
+                                          --   in the defining module for this datatype?
+      flSelector     :: a                 -- ^ Record selector function
+    }
+  deriving (Eq, Functor, Foldable, Traversable)
+deriving instance Data a => Data (FieldLbl a)
+
+instance Outputable a => Outputable (FieldLbl a) where
+    ppr fl = ppr (flLabel fl) <> braces (ppr (flSelector fl))
+
+instance Binary a => Binary (FieldLbl a) where
+    put_ bh (FieldLabel aa ab ac) = do
+        put_ bh aa
+        put_ bh ab
+        put_ bh ac
+    get bh = do
+        ab <- get bh
+        ac <- get bh
+        ad <- get bh
+        return (FieldLabel ab ac ad)
+
+
+-- | Record selector OccNames are built from the underlying field name
+-- and the name of the first data constructor of the type, to support
+-- duplicate record field names.
+-- See Note [Why selector names include data constructors].
+mkFieldLabelOccs :: FieldLabelString -> OccName -> Bool -> FieldLbl OccName
+mkFieldLabelOccs lbl dc is_overloaded
+  = FieldLabel { flLabel = lbl, flIsOverloaded = is_overloaded
+               , flSelector = sel_occ }
+  where
+    str     = ":" ++ unpackFS lbl ++ ":" ++ occNameString dc
+    sel_occ | is_overloaded = mkRecFldSelOcc str
+            | otherwise     = mkVarOccFS lbl
diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs
new file mode 100644
index 0000000000..b745a6138f
--- /dev/null
+++ b/compiler/GHC/Types/ForeignCall.hs
@@ -0,0 +1,348 @@
+{-
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[Foreign]{Foreign calls}
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module GHC.Types.ForeignCall (
+        ForeignCall(..), isSafeForeignCall,
+        Safety(..), playSafe, playInterruptible,
+
+        CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
+        CCallSpec(..),
+        CCallTarget(..), isDynamicTarget,
+        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
+
+        Header(..), CType(..),
+    ) where
+
+import GhcPrelude
+
+import FastString
+import Binary
+import Outputable
+import GHC.Types.Module
+import GHC.Types.Basic ( SourceText, pprWithSourceText )
+
+import Data.Char
+import Data.Data
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection{Data types}
+*                                                                      *
+************************************************************************
+-}
+
+newtype ForeignCall = CCall CCallSpec
+  deriving Eq
+
+isSafeForeignCall :: ForeignCall -> Bool
+isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe
+
+-- We may need more clues to distinguish foreign calls
+-- but this simple printer will do for now
+instance Outputable ForeignCall where
+  ppr (CCall cc)  = ppr cc
+
+data Safety
+  = PlaySafe            -- Might invoke Haskell GC, or do a call back, or
+                        -- switch threads, etc.  So make sure things are
+                        -- tidy before the call. Additionally, in the threaded
+                        -- RTS we arrange for the external call to be executed
+                        -- by a separate OS thread, i.e., _concurrently_ to the
+                        -- execution of other Haskell threads.
+
+  | PlayInterruptible   -- Like PlaySafe, but additionally
+                        -- the worker thread running this foreign call may
+                        -- be unceremoniously killed, so it must be scheduled
+                        -- on an unbound thread.
+
+  | PlayRisky           -- None of the above can happen; the call will return
+                        -- without interacting with the runtime system at all
+  deriving ( Eq, Show, Data )
+        -- Show used just for Show Lex.Token, I think
+
+instance Outputable Safety where
+  ppr PlaySafe = text "safe"
+  ppr PlayInterruptible = text "interruptible"
+  ppr PlayRisky = text "unsafe"
+
+playSafe :: Safety -> Bool
+playSafe PlaySafe = True
+playSafe PlayInterruptible = True
+playSafe PlayRisky = False
+
+playInterruptible :: Safety -> Bool
+playInterruptible PlayInterruptible = True
+playInterruptible _ = False
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection{Calling C}
+*                                                                      *
+************************************************************************
+-}
+
+data CExportSpec
+  = CExportStatic               -- foreign export ccall foo :: ty
+        SourceText              -- of the CLabelString.
+                                -- See note [Pragma source text] in GHC.Types.Basic
+        CLabelString            -- C Name of exported function
+        CCallConv
+  deriving Data
+
+data CCallSpec
+  =  CCallSpec  CCallTarget     -- What to call
+                CCallConv       -- Calling convention to use.
+                Safety
+  deriving( Eq )
+
+-- The call target:
+
+-- | How to call a particular function in C-land.
+data CCallTarget
+  -- An "unboxed" ccall# to named function in a particular package.
+  = StaticTarget
+        SourceText                -- of the CLabelString.
+                                  -- See note [Pragma source text] in GHC.Types.Basic
+        CLabelString                    -- C-land name of label.
+
+        (Maybe UnitId)              -- What package the function is in.
+                                        -- If Nothing, then it's taken to be in the current package.
+                                        -- Note: This information is only used for PrimCalls on Windows.
+                                        --       See CLabel.labelDynamic and CoreToStg.coreToStgApp
+                                        --       for the difference in representation between PrimCalls
+                                        --       and ForeignCalls. If the CCallTarget is representing
+                                        --       a regular ForeignCall then it's safe to set this to Nothing.
+
+  -- The first argument of the import is the name of a function pointer (an Addr#).
+  --    Used when importing a label as "foreign import ccall "dynamic" ..."
+        Bool                            -- True => really a function
+                                        -- False => a value; only
+                                        -- allowed in CAPI imports
+  | DynamicTarget
+
+  deriving( Eq, Data )
+
+isDynamicTarget :: CCallTarget -> Bool
+isDynamicTarget DynamicTarget = True
+isDynamicTarget _             = False
+
+{-
+Stuff to do with calling convention:
+
+ccall:          Caller allocates parameters, *and* deallocates them.
+
+stdcall:        Caller allocates parameters, callee deallocates.
+                Function name has @N after it, where N is number of arg bytes
+                e.g.  _Foo@8. This convention is x86 (win32) specific.
+
+See: http://www.programmersheaven.com/2/Calling-conventions
+-}
+
+-- any changes here should be replicated in  the CallConv type in template haskell
+data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv
+  deriving (Eq, Data)
+
+instance Outputable CCallConv where
+  ppr StdCallConv = text "stdcall"
+  ppr CCallConv   = text "ccall"
+  ppr CApiConv    = text "capi"
+  ppr PrimCallConv = text "prim"
+  ppr JavaScriptCallConv = text "javascript"
+
+defaultCCallConv :: CCallConv
+defaultCCallConv = CCallConv
+
+ccallConvToInt :: CCallConv -> Int
+ccallConvToInt StdCallConv = 0
+ccallConvToInt CCallConv   = 1
+ccallConvToInt CApiConv    = panic "ccallConvToInt CApiConv"
+ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv"
+ccallConvToInt JavaScriptCallConv = panic "ccallConvToInt JavaScriptCallConv"
+
+{-
+Generate the gcc attribute corresponding to the given
+calling convention (used by PprAbsC):
+-}
+
+ccallConvAttribute :: CCallConv -> SDoc
+ccallConvAttribute StdCallConv       = text "__attribute__((__stdcall__))"
+ccallConvAttribute CCallConv         = empty
+ccallConvAttribute CApiConv          = empty
+ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv"
+ccallConvAttribute JavaScriptCallConv = panic "ccallConvAttribute JavaScriptCallConv"
+
+type CLabelString = FastString          -- A C label, completely unencoded
+
+pprCLabelString :: CLabelString -> SDoc
+pprCLabelString lbl = ftext lbl
+
+isCLabelString :: CLabelString -> Bool  -- Checks to see if this is a valid C label
+isCLabelString lbl
+  = all ok (unpackFS lbl)
+  where
+    ok c = isAlphaNum c || c == '_' || c == '.'
+        -- The '.' appears in e.g. "foo.so" in the
+        -- module part of a ExtName.  Maybe it should be separate
+
+-- Printing into C files:
+
+instance Outputable CExportSpec where
+  ppr (CExportStatic _ str _) = pprCLabelString str
+
+instance Outputable CCallSpec where
+  ppr (CCallSpec fun cconv safety)
+    = hcat [ whenPprDebug callconv, ppr_fun fun ]
+    where
+      callconv = text "{-" <> ppr cconv <> text "-}"
+
+      gc_suf | playSafe safety = text "_GC"
+             | otherwise       = empty
+
+      ppr_fun (StaticTarget st _fn mPkgId isFun)
+        = text (if isFun then "__pkg_ccall"
+                         else "__pkg_ccall_value")
+       <> gc_suf
+       <+> (case mPkgId of
+            Nothing -> empty
+            Just pkgId -> ppr pkgId)
+       <+> (pprWithSourceText st empty)
+
+      ppr_fun DynamicTarget
+        = text "__dyn_ccall" <> gc_suf <+> text "\"\""
+
+-- The filename for a C header file
+-- Note [Pragma source text] in GHC.Types.Basic
+data Header = Header SourceText FastString
+    deriving (Eq, Data)
+
+instance Outputable Header where
+    ppr (Header st h) = pprWithSourceText st (doubleQuotes $ ppr h)
+
+-- | A C type, used in CAPI FFI calls
+--
+--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CTYPE'@,
+--        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',
+--        'ApiAnnotation.AnnClose' @'\#-}'@,
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data CType = CType SourceText -- Note [Pragma source text] in GHC.Types.Basic
+                   (Maybe Header) -- header to include for this type
+                   (SourceText,FastString) -- the type itself
+    deriving (Eq, Data)
+
+instance Outputable CType where
+    ppr (CType stp mh (stct,ct))
+      = pprWithSourceText stp (text "{-# CTYPE") <+> hDoc
+        <+> pprWithSourceText stct (doubleQuotes (ftext ct)) <+> text "#-}"
+        where hDoc = case mh of
+                     Nothing -> empty
+                     Just h -> ppr h
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection{Misc}
+*                                                                      *
+************************************************************************
+-}
+
+instance Binary ForeignCall where
+    put_ bh (CCall aa) = put_ bh aa
+    get bh = do aa <- get bh; return (CCall aa)
+
+instance Binary Safety where
+    put_ bh PlaySafe = do
+            putByte bh 0
+    put_ bh PlayInterruptible = do
+            putByte bh 1
+    put_ bh PlayRisky = do
+            putByte bh 2
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return PlaySafe
+              1 -> do return PlayInterruptible
+              _ -> do return PlayRisky
+
+instance Binary CExportSpec where
+    put_ bh (CExportStatic ss aa ab) = do
+            put_ bh ss
+            put_ bh aa
+            put_ bh ab
+    get bh = do
+          ss <- get bh
+          aa <- get bh
+          ab <- get bh
+          return (CExportStatic ss aa ab)
+
+instance Binary CCallSpec where
+    put_ bh (CCallSpec aa ab ac) = do
+            put_ bh aa
+            put_ bh ab
+            put_ bh ac
+    get bh = do
+          aa <- get bh
+          ab <- get bh
+          ac <- get bh
+          return (CCallSpec aa ab ac)
+
+instance Binary CCallTarget where
+    put_ bh (StaticTarget ss aa ab ac) = do
+            putByte bh 0
+            put_ bh ss
+            put_ bh aa
+            put_ bh ab
+            put_ bh ac
+    put_ bh DynamicTarget = do
+            putByte bh 1
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do ss <- get bh
+                      aa <- get bh
+                      ab <- get bh
+                      ac <- get bh
+                      return (StaticTarget ss aa ab ac)
+              _ -> do return DynamicTarget
+
+instance Binary CCallConv where
+    put_ bh CCallConv = do
+            putByte bh 0
+    put_ bh StdCallConv = do
+            putByte bh 1
+    put_ bh PrimCallConv = do
+            putByte bh 2
+    put_ bh CApiConv = do
+            putByte bh 3
+    put_ bh JavaScriptCallConv = do
+            putByte bh 4
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return CCallConv
+              1 -> do return StdCallConv
+              2 -> do return PrimCallConv
+              3 -> do return CApiConv
+              _ -> do return JavaScriptCallConv
+
+instance Binary CType where
+    put_ bh (CType s mh fs) = do put_ bh s
+                                 put_ bh mh
+                                 put_ bh fs
+    get bh = do s  <- get bh
+                mh <- get bh
+                fs <- get bh
+                return (CType s mh fs)
+
+instance Binary Header where
+    put_ bh (Header s h) = put_ bh s >> put_ bh h
+    get bh = do s <- get bh
+                h <- get bh
+                return (Header s h)
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
new file mode 100644
index 0000000000..e62113390c
--- /dev/null
+++ b/compiler/GHC/Types/Id.hs
@@ -0,0 +1,971 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[Id]{@Ids@: Value and constructor identifiers}
+-}
+
+{-# LANGUAGE CPP #-}
+
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName': see "OccName#name_types"
+--
+-- * 'RdrName.RdrName': see "RdrName#name_types"
+--
+-- * 'Name.Name': see "Name#name_types"
+--
+-- * 'Id.Id' represents names that not only have a 'Name.Name' but also a
+--   'GHC.Core.TyCo.Rep.Type' and some additional details (a 'IdInfo.IdInfo' and
+--   one of 'Var.LocalIdDetails' or 'IdInfo.GlobalIdDetails') that are added,
+--   modified and inspected by various compiler passes. These 'Var.Var' names
+--   may either be global or local, see "Var#globalvslocal"
+--
+-- * 'Var.Var': see "Var#name_types"
+
+module GHC.Types.Id (
+        -- * The main types
+        Var, Id, isId,
+
+        -- * In and Out variants
+        InVar,  InId,
+        OutVar, OutId,
+
+        -- ** Simple construction
+        mkGlobalId, mkVanillaGlobal, mkVanillaGlobalWithInfo,
+        mkLocalId, mkLocalCoVar, mkLocalIdOrCoVar,
+        mkLocalIdWithInfo, mkExportedLocalId, mkExportedVanillaId,
+        mkSysLocal, mkSysLocalM, mkSysLocalOrCoVar, mkSysLocalOrCoVarM,
+        mkUserLocal, mkUserLocalOrCoVar,
+        mkTemplateLocals, mkTemplateLocalsNum, mkTemplateLocal,
+        mkWorkerId,
+
+        -- ** Taking an Id apart
+        idName, idType, idUnique, idInfo, idDetails,
+        recordSelectorTyCon,
+
+        -- ** Modifying an Id
+        setIdName, setIdUnique, GHC.Types.Id.setIdType,
+        setIdExported, setIdNotExported,
+        globaliseId, localiseId,
+        setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
+        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
+        zapIdUsedOnceInfo, zapIdTailCallInfo,
+        zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,
+        transferPolyIdInfo,
+
+        -- ** Predicates on Ids
+        isImplicitId, isDeadBinder,
+        isStrictId,
+        isExportedId, isLocalId, isGlobalId,
+        isRecordSelector, isNaughtyRecordSelector,
+        isPatSynRecordSelector,
+        isDataConRecordSelector,
+        isClassOpId_maybe, isDFunId,
+        isPrimOpId, isPrimOpId_maybe,
+        isFCallId, isFCallId_maybe,
+        isDataConWorkId, isDataConWorkId_maybe,
+        isDataConWrapId, isDataConWrapId_maybe,
+        isDataConId_maybe,
+        idDataCon,
+        isConLikeId, isBottomingId, idIsFrom,
+        hasNoBinding,
+
+        -- ** Join variables
+        JoinId, isJoinId, isJoinId_maybe, idJoinArity,
+        asJoinId, asJoinId_maybe, zapJoinId,
+
+        -- ** Inline pragma stuff
+        idInlinePragma, setInlinePragma, modifyInlinePragma,
+        idInlineActivation, setInlineActivation, idRuleMatchInfo,
+
+        -- ** One-shot lambdas
+        isOneShotBndr, isProbablyOneShotLambda,
+        setOneShotLambda, clearOneShotLambda,
+        updOneShotInfo, setIdOneShotInfo,
+        isStateHackType, stateHackOneShot, typeOneShot,
+
+        -- ** Reading 'IdInfo' fields
+        idArity,
+        idCallArity, idFunRepArity,
+        idUnfolding, realIdUnfolding,
+        idSpecialisation, idCoreRules, idHasRules,
+        idCafInfo,
+        idOneShotInfo, idStateHackOneShotInfo,
+        idOccInfo,
+        isNeverLevPolyId,
+
+        -- ** Writing 'IdInfo' fields
+        setIdUnfolding, setCaseBndrEvald,
+        setIdArity,
+        setIdCallArity,
+
+        setIdSpecialisation,
+        setIdCafInfo,
+        setIdOccInfo, zapIdOccInfo,
+
+        setIdDemandInfo,
+        setIdStrictness,
+        setIdCprInfo,
+
+        idDemandInfo,
+        idStrictness,
+        idCprInfo,
+
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Driver.Session
+import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
+                 isCompulsoryUnfolding, Unfolding( NoUnfolding ) )
+
+import GHC.Types.Id.Info
+import GHC.Types.Basic
+
+-- Imported and re-exported
+import GHC.Types.Var( Id, CoVar, JoinId,
+            InId,  InVar,
+            OutId, OutVar,
+            idInfo, idDetails, setIdDetails, globaliseId,
+            isId, isLocalId, isGlobalId, isExportedId )
+import qualified GHC.Types.Var as Var
+
+import GHC.Core.Type
+import GHC.Types.RepType
+import TysPrim
+import GHC.Core.DataCon
+import GHC.Types.Demand
+import GHC.Types.Cpr
+import GHC.Types.Name
+import GHC.Types.Module
+import GHC.Core.Class
+import {-# SOURCE #-} PrimOp (PrimOp)
+import GHC.Types.ForeignCall
+import Maybes
+import GHC.Types.SrcLoc
+import Outputable
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
+import FastString
+import Util
+
+-- infixl so you can say (id `set` a `set` b)
+infixl  1 `setIdUnfolding`,
+          `setIdArity`,
+          `setIdCallArity`,
+          `setIdOccInfo`,
+          `setIdOneShotInfo`,
+
+          `setIdSpecialisation`,
+          `setInlinePragma`,
+          `setInlineActivation`,
+          `idCafInfo`,
+
+          `setIdDemandInfo`,
+          `setIdStrictness`,
+          `setIdCprInfo`,
+
+          `asJoinId`,
+          `asJoinId_maybe`
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Basic Id manipulation}
+*                                                                      *
+************************************************************************
+-}
+
+idName   :: Id -> Name
+idName    = Var.varName
+
+idUnique :: Id -> Unique
+idUnique  = Var.varUnique
+
+idType   :: Id -> Kind
+idType    = Var.varType
+
+setIdName :: Id -> Name -> Id
+setIdName = Var.setVarName
+
+setIdUnique :: Id -> Unique -> Id
+setIdUnique = Var.setVarUnique
+
+-- | Not only does this set the 'Id' 'Type', it also evaluates the type to try and
+-- reduce space usage
+setIdType :: Id -> Type -> Id
+setIdType id ty = seqType ty `seq` Var.setVarType id ty
+
+setIdExported :: Id -> Id
+setIdExported = Var.setIdExported
+
+setIdNotExported :: Id -> Id
+setIdNotExported = Var.setIdNotExported
+
+localiseId :: Id -> Id
+-- Make an Id with the same unique and type as the
+-- incoming Id, but with an *Internal* Name and *LocalId* flavour
+localiseId id
+  | ASSERT( isId id ) isLocalId id && isInternalName name
+  = id
+  | otherwise
+  = Var.mkLocalVar (idDetails id) (localiseName name) (idType id) (idInfo id)
+  where
+    name = idName id
+
+lazySetIdInfo :: Id -> IdInfo -> Id
+lazySetIdInfo = Var.lazySetIdInfo
+
+setIdInfo :: Id -> IdInfo -> Id
+setIdInfo id info = info `seq` (lazySetIdInfo id info)
+        -- Try to avoid space leaks by seq'ing
+
+modifyIdInfo :: HasDebugCallStack => (IdInfo -> IdInfo) -> Id -> Id
+modifyIdInfo fn id = setIdInfo id (fn (idInfo id))
+
+-- maybeModifyIdInfo tries to avoid unnecessary thrashing
+maybeModifyIdInfo :: Maybe IdInfo -> Id -> Id
+maybeModifyIdInfo (Just new_info) id = lazySetIdInfo id new_info
+maybeModifyIdInfo Nothing         id = id
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Simple Id construction}
+*                                                                      *
+************************************************************************
+
+Absolutely all Ids are made by mkId.  It is just like Var.mkId,
+but in addition it pins free-tyvar-info onto the Id's type,
+where it can easily be found.
+
+Note [Free type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+At one time we cached the free type variables of the type of an Id
+at the root of the type in a TyNote.  The idea was to avoid repeating
+the free-type-variable calculation.  But it turned out to slow down
+the compiler overall. I don't quite know why; perhaps finding free
+type variables of an Id isn't all that common whereas applying a
+substitution (which changes the free type variables) is more common.
+Anyway, we removed it in March 2008.
+-}
+
+-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
+mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkGlobalId = Var.mkGlobalVar
+
+-- | Make a global 'Id' without any extra information at all
+mkVanillaGlobal :: Name -> Type -> Id
+mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
+
+-- | Make a global 'Id' with no global information but some generic 'IdInfo'
+mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
+mkVanillaGlobalWithInfo = mkGlobalId VanillaId
+
+
+-- | For an explanation of global vs. local 'Id's, see "Var#globalvslocal"
+mkLocalId :: HasDebugCallStack => Name -> Type -> Id
+mkLocalId name ty = ASSERT( not (isCoVarType ty) )
+                    mkLocalIdWithInfo name ty vanillaIdInfo
+
+-- | Make a local CoVar
+mkLocalCoVar :: Name -> Type -> CoVar
+mkLocalCoVar name ty
+  = ASSERT( isCoVarType ty )
+    Var.mkLocalVar CoVarId name ty vanillaIdInfo
+
+-- | Like 'mkLocalId', but checks the type to see if it should make a covar
+mkLocalIdOrCoVar :: Name -> Type -> Id
+mkLocalIdOrCoVar name ty
+  | isCoVarType ty = mkLocalCoVar name ty
+  | otherwise      = mkLocalId    name ty
+
+    -- proper ids only; no covars!
+mkLocalIdWithInfo :: HasDebugCallStack => Name -> Type -> IdInfo -> Id
+mkLocalIdWithInfo name ty info = ASSERT( not (isCoVarType ty) )
+                                 Var.mkLocalVar VanillaId name ty info
+        -- Note [Free type variables]
+
+-- | Create a local 'Id' that is marked as exported.
+-- This prevents things attached to it from being removed as dead code.
+-- See Note [Exported LocalIds]
+mkExportedLocalId :: IdDetails -> Name -> Type -> Id
+mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanillaIdInfo
+        -- Note [Free type variables]
+
+mkExportedVanillaId :: Name -> Type -> Id
+mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
+        -- Note [Free type variables]
+
+
+-- | Create a system local 'Id'. These are local 'Id's (see "Var#globalvslocal")
+-- that are created by the compiler out of thin air
+mkSysLocal :: FastString -> Unique -> Type -> Id
+mkSysLocal fs uniq ty = ASSERT( not (isCoVarType ty) )
+                        mkLocalId (mkSystemVarName uniq fs) ty
+
+-- | Like 'mkSysLocal', but checks to see if we have a covar type
+mkSysLocalOrCoVar :: FastString -> Unique -> Type -> Id
+mkSysLocalOrCoVar fs uniq ty
+  = mkLocalIdOrCoVar (mkSystemVarName uniq fs) ty
+
+mkSysLocalM :: MonadUnique m => FastString -> Type -> m Id
+mkSysLocalM fs ty = getUniqueM >>= (\uniq -> return (mkSysLocal fs uniq ty))
+
+mkSysLocalOrCoVarM :: MonadUnique m => FastString -> Type -> m Id
+mkSysLocalOrCoVarM fs ty
+  = getUniqueM >>= (\uniq -> return (mkSysLocalOrCoVar fs uniq ty))
+
+-- | Create a user local 'Id'. These are local 'Id's (see "Var#globalvslocal") with a name and location that the user might recognize
+mkUserLocal :: OccName -> Unique -> Type -> SrcSpan -> Id
+mkUserLocal occ uniq ty loc = ASSERT( not (isCoVarType ty) )
+                              mkLocalId (mkInternalName uniq occ loc) ty
+
+-- | Like 'mkUserLocal', but checks if we have a coercion type
+mkUserLocalOrCoVar :: OccName -> Unique -> Type -> SrcSpan -> Id
+mkUserLocalOrCoVar occ uniq ty loc
+  = mkLocalIdOrCoVar (mkInternalName uniq occ loc) ty
+
+{-
+Make some local @Ids@ for a template @CoreExpr@.  These have bogus
+@Uniques@, but that's OK because the templates are supposed to be
+instantiated before use.
+-}
+
+-- | Workers get local names. "CoreTidy" will externalise these if necessary
+mkWorkerId :: Unique -> Id -> Type -> Id
+mkWorkerId uniq unwrkr ty
+  = mkLocalId (mkDerivedInternalName mkWorkerOcc uniq (getName unwrkr)) ty
+
+-- | Create a /template local/: a family of system local 'Id's in bijection with @Int@s, typically used in unfoldings
+mkTemplateLocal :: Int -> Type -> Id
+mkTemplateLocal i ty = mkSysLocalOrCoVar (fsLit "v") (mkBuiltinUnique i) ty
+   -- "OrCoVar" since this is used in a superclass selector,
+   -- and "~" and "~~" have coercion "superclasses".
+
+-- | Create a template local for a series of types
+mkTemplateLocals :: [Type] -> [Id]
+mkTemplateLocals = mkTemplateLocalsNum 1
+
+-- | Create a template local for a series of type, but start from a specified template local
+mkTemplateLocalsNum :: Int -> [Type] -> [Id]
+mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
+
+{- Note [Exported LocalIds]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use mkExportedLocalId for things like
+ - Dictionary functions (DFunId)
+ - Wrapper and matcher Ids for pattern synonyms
+ - Default methods for classes
+ - Pattern-synonym matcher and builder Ids
+ - etc
+
+They marked as "exported" in the sense that they should be kept alive
+even if apparently unused in other bindings, and not dropped as dead
+code by the occurrence analyser.  (But "exported" here does not mean
+"brought into lexical scope by an import declaration". Indeed these
+things are always internal Ids that the user never sees.)
+
+It's very important that they are *LocalIds*, not GlobalIds, for lots
+of reasons:
+
+ * We want to treat them as free variables for the purpose of
+   dependency analysis (e.g. GHC.Core.FVs.exprFreeVars).
+
+ * Look them up in the current substitution when we come across
+   occurrences of them (in Subst.lookupIdSubst). Lacking this we
+   can get an out-of-date unfolding, which can in turn make the
+   simplifier go into an infinite loop (#9857)
+
+ * Ensure that for dfuns that the specialiser does not float dict uses
+   above their defns, which would prevent good simplifications happening.
+
+ * The strictness analyser treats a occurrence of a GlobalId as
+   imported and assumes it contains strictness in its IdInfo, which
+   isn't true if the thing is bound in the same module as the
+   occurrence.
+
+In CoreTidy we must make all these LocalIds into GlobalIds, so that in
+importing modules (in --make mode) we treat them as properly global.
+That is what is happening in, say tidy_insts in GHC.Iface.Tidy.
+
+************************************************************************
+*                                                                      *
+\subsection{Special Ids}
+*                                                                      *
+************************************************************************
+-}
+
+-- | If the 'Id' is that for a record selector, extract the 'sel_tycon'. Panic otherwise.
+recordSelectorTyCon :: Id -> RecSelParent
+recordSelectorTyCon id
+  = case Var.idDetails id of
+        RecSelId { sel_tycon = parent } -> parent
+        _ -> panic "recordSelectorTyCon"
+
+
+isRecordSelector        :: Id -> Bool
+isNaughtyRecordSelector :: Id -> Bool
+isPatSynRecordSelector  :: Id -> Bool
+isDataConRecordSelector  :: Id -> Bool
+isPrimOpId              :: Id -> Bool
+isFCallId               :: Id -> Bool
+isDataConWorkId         :: Id -> Bool
+isDataConWrapId         :: Id -> Bool
+isDFunId                :: Id -> Bool
+
+isClassOpId_maybe       :: Id -> Maybe Class
+isPrimOpId_maybe        :: Id -> Maybe PrimOp
+isFCallId_maybe         :: Id -> Maybe ForeignCall
+isDataConWorkId_maybe   :: Id -> Maybe DataCon
+isDataConWrapId_maybe   :: Id -> Maybe DataCon
+
+isRecordSelector id = case Var.idDetails id of
+                        RecSelId {}     -> True
+                        _               -> False
+
+isDataConRecordSelector id = case Var.idDetails id of
+                        RecSelId {sel_tycon = RecSelData _} -> True
+                        _               -> False
+
+isPatSynRecordSelector id = case Var.idDetails id of
+                        RecSelId {sel_tycon = RecSelPatSyn _} -> True
+                        _               -> False
+
+isNaughtyRecordSelector id = case Var.idDetails id of
+                        RecSelId { sel_naughty = n } -> n
+                        _                               -> False
+
+isClassOpId_maybe id = case Var.idDetails id of
+                        ClassOpId cls -> Just cls
+                        _other        -> Nothing
+
+isPrimOpId id = case Var.idDetails id of
+                        PrimOpId _ -> True
+                        _          -> False
+
+isDFunId id = case Var.idDetails id of
+                        DFunId {} -> True
+                        _         -> False
+
+isPrimOpId_maybe id = case Var.idDetails id of
+                        PrimOpId op -> Just op
+                        _           -> Nothing
+
+isFCallId id = case Var.idDetails id of
+                        FCallId _ -> True
+                        _         -> False
+
+isFCallId_maybe id = case Var.idDetails id of
+                        FCallId call -> Just call
+                        _            -> Nothing
+
+isDataConWorkId id = case Var.idDetails id of
+                        DataConWorkId _ -> True
+                        _               -> False
+
+isDataConWorkId_maybe id = case Var.idDetails id of
+                        DataConWorkId con -> Just con
+                        _                 -> Nothing
+
+isDataConWrapId id = case Var.idDetails id of
+                       DataConWrapId _ -> True
+                       _               -> False
+
+isDataConWrapId_maybe id = case Var.idDetails id of
+                        DataConWrapId con -> Just con
+                        _                 -> Nothing
+
+isDataConId_maybe :: Id -> Maybe DataCon
+isDataConId_maybe id = case Var.idDetails id of
+                         DataConWorkId con -> Just con
+                         DataConWrapId con -> Just con
+                         _                 -> Nothing
+
+isJoinId :: Var -> Bool
+-- It is convenient in GHC.Core.Op.SetLevels.lvlMFE to apply isJoinId
+-- to the free vars of an expression, so it's convenient
+-- if it returns False for type variables
+isJoinId id
+  | isId id = case Var.idDetails id of
+                JoinId {} -> True
+                _         -> False
+  | otherwise = False
+
+isJoinId_maybe :: Var -> Maybe JoinArity
+isJoinId_maybe id
+ | isId id  = ASSERT2( isId id, ppr id )
+              case Var.idDetails id of
+                JoinId arity -> Just arity
+                _            -> Nothing
+ | otherwise = Nothing
+
+idDataCon :: Id -> DataCon
+-- ^ Get from either the worker or the wrapper 'Id' to the 'DataCon'. Currently used only in the desugarer.
+--
+-- INVARIANT: @idDataCon (dataConWrapId d) = d@: remember, 'dataConWrapId' can return either the wrapper or the worker
+idDataCon id = isDataConId_maybe id `orElse` pprPanic "idDataCon" (ppr id)
+
+hasNoBinding :: Id -> Bool
+-- ^ Returns @True@ of an 'Id' which may not have a
+-- binding, even though it is defined in this module.
+
+-- Data constructor workers used to be things of this kind, but
+-- they aren't any more.  Instead, we inject a binding for
+-- them at the CorePrep stage.
+--
+-- 'PrimOpId's also used to be of this kind. See Note [Primop wrappers] in PrimOp.hs.
+-- for the history of this.
+--
+-- Note that CorePrep currently eta expands things no-binding things and this
+-- can cause quite subtle bugs. See Note [Eta expansion of hasNoBinding things
+-- in CorePrep] in CorePrep for details.
+--
+-- EXCEPT: unboxed tuples, which definitely have no binding
+hasNoBinding id = case Var.idDetails id of
+                        PrimOpId _       -> False   -- See Note [Primop wrappers] in PrimOp.hs
+                        FCallId _        -> True
+                        DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc
+                        _                -> isCompulsoryUnfolding (idUnfolding id)
+                                            -- See Note [Levity-polymorphic Ids]
+
+isImplicitId :: Id -> Bool
+-- ^ 'isImplicitId' tells whether an 'Id's info is implied by other
+-- declarations, so we don't need to put its signature in an interface
+-- file, even if it's mentioned in some other interface unfolding.
+isImplicitId id
+  = case Var.idDetails id of
+        FCallId {}       -> True
+        ClassOpId {}     -> True
+        PrimOpId {}      -> True
+        DataConWorkId {} -> True
+        DataConWrapId {} -> True
+                -- These are implied by their type or class decl;
+                -- remember that all type and class decls appear in the interface file.
+                -- The dfun id is not an implicit Id; it must *not* be omitted, because
+                -- it carries version info for the instance decl
+        _               -> False
+
+idIsFrom :: Module -> Id -> Bool
+idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
+
+{- Note [Levity-polymorphic Ids]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Some levity-polymorphic Ids must be applied and inlined, not left
+un-saturated.  Example:
+  unsafeCoerceId :: forall r1 r2 (a::TYPE r1) (b::TYPE r2). a -> b
+
+This has a compulsory unfolding because we can't lambda-bind those
+arguments.  But the compulsory unfolding may leave levity-polymorphic
+lambdas if it is not applied to enough arguments; e.g. (#14561)
+  bad :: forall (a :: TYPE r). a -> a
+  bad = unsafeCoerce#
+
+The desugar has special magic to detect such cases: GHC.HsToCore.Expr.badUseOfLevPolyPrimop.
+And we want that magic to apply to levity-polymorphic compulsory-inline things.
+The easiest way to do this is for hasNoBinding to return True of all things
+that have compulsory unfolding.  Some Ids with a compulsory unfolding also
+have a binding, but it does not harm to say they don't here, and its a very
+simple way to fix #14561.
+-}
+
+isDeadBinder :: Id -> Bool
+isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
+                  | otherwise = False   -- TyVars count as not dead
+
+{-
+************************************************************************
+*                                                                      *
+              Join variables
+*                                                                      *
+************************************************************************
+-}
+
+idJoinArity :: JoinId -> JoinArity
+idJoinArity id = isJoinId_maybe id `orElse` pprPanic "idJoinArity" (ppr id)
+
+asJoinId :: Id -> JoinArity -> JoinId
+asJoinId id arity = WARN(not (isLocalId id),
+                         text "global id being marked as join var:" <+> ppr id)
+                    WARN(not (is_vanilla_or_join id),
+                         ppr id <+> pprIdDetails (idDetails id))
+                    id `setIdDetails` JoinId arity
+  where
+    is_vanilla_or_join id = case Var.idDetails id of
+                              VanillaId -> True
+                              JoinId {} -> True
+                              _         -> False
+
+zapJoinId :: Id -> Id
+-- May be a regular id already
+zapJoinId jid | isJoinId jid = zapIdTailCallInfo (jid `setIdDetails` VanillaId)
+                                 -- Core Lint may complain if still marked
+                                 -- as AlwaysTailCalled
+              | otherwise    = jid
+
+asJoinId_maybe :: Id -> Maybe JoinArity -> Id
+asJoinId_maybe id (Just arity) = asJoinId id arity
+asJoinId_maybe id Nothing      = zapJoinId id
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{IdInfo stuff}
+*                                                                      *
+************************************************************************
+-}
+
+        ---------------------------------
+        -- ARITY
+idArity :: Id -> Arity
+idArity id = arityInfo (idInfo id)
+
+setIdArity :: Id -> Arity -> Id
+setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
+
+idCallArity :: Id -> Arity
+idCallArity id = callArityInfo (idInfo id)
+
+setIdCallArity :: Id -> Arity -> Id
+setIdCallArity id arity = modifyIdInfo (`setCallArityInfo` arity) id
+
+idFunRepArity :: Id -> RepArity
+idFunRepArity x = countFunRepArgs (idArity x) (idType x)
+
+-- | Returns true if an application to n args would diverge
+isBottomingId :: Var -> Bool
+isBottomingId v
+  | isId v    = isBottomingSig (idStrictness v)
+  | otherwise = False
+
+-- | Accesses the 'Id''s 'strictnessInfo'.
+idStrictness :: Id -> StrictSig
+idStrictness id = strictnessInfo (idInfo id)
+
+setIdStrictness :: Id -> StrictSig -> Id
+setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
+
+idCprInfo :: Id -> CprSig
+idCprInfo id = cprInfo (idInfo id)
+
+setIdCprInfo :: Id -> CprSig -> Id
+setIdCprInfo id sig = modifyIdInfo (\info -> setCprInfo info sig) id
+
+zapIdStrictness :: Id -> Id
+zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
+
+-- | This predicate says whether the 'Id' has a strict demand placed on it or
+-- has a type such that it can always be evaluated strictly (i.e an
+-- unlifted type, as of GHC 7.6).  We need to
+-- check separately whether the 'Id' has a so-called \"strict type\" because if
+-- the demand for the given @id@ hasn't been computed yet but @id@ has a strict
+-- type, we still want @isStrictId id@ to be @True@.
+isStrictId :: Id -> Bool
+isStrictId id
+  = ASSERT2( isId id, text "isStrictId: not an id: " <+> ppr id )
+         not (isJoinId id) && (
+           (isStrictType (idType id)) ||
+           -- Take the best of both strictnesses - old and new
+           (isStrictDmd (idDemandInfo id))
+         )
+
+        ---------------------------------
+        -- UNFOLDING
+idUnfolding :: Id -> Unfolding
+-- Do not expose the unfolding of a loop breaker!
+idUnfolding id
+  | isStrongLoopBreaker (occInfo info) = NoUnfolding
+  | otherwise                          = unfoldingInfo info
+  where
+    info = idInfo id
+
+realIdUnfolding :: Id -> Unfolding
+-- Expose the unfolding if there is one, including for loop breakers
+realIdUnfolding id = unfoldingInfo (idInfo id)
+
+setIdUnfolding :: Id -> Unfolding -> Id
+setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
+
+idDemandInfo       :: Id -> Demand
+idDemandInfo       id = demandInfo (idInfo id)
+
+setIdDemandInfo :: Id -> Demand -> Id
+setIdDemandInfo id dmd = modifyIdInfo (`setDemandInfo` dmd) id
+
+setCaseBndrEvald :: StrictnessMark -> Id -> Id
+-- Used for variables bound by a case expressions, both the case-binder
+-- itself, and any pattern-bound variables that are argument of a
+-- strict constructor.  It just marks the variable as already-evaluated,
+-- so that (for example) a subsequent 'seq' can be dropped
+setCaseBndrEvald str id
+  | isMarkedStrict str = id `setIdUnfolding` evaldUnfolding
+  | otherwise          = id
+
+        ---------------------------------
+        -- SPECIALISATION
+
+-- See Note [Specialisations and RULES in IdInfo] in GHC.Types.Id.Info
+
+idSpecialisation :: Id -> RuleInfo
+idSpecialisation id = ruleInfo (idInfo id)
+
+idCoreRules :: Id -> [CoreRule]
+idCoreRules id = ruleInfoRules (idSpecialisation id)
+
+idHasRules :: Id -> Bool
+idHasRules id = not (isEmptyRuleInfo (idSpecialisation id))
+
+setIdSpecialisation :: Id -> RuleInfo -> Id
+setIdSpecialisation id spec_info = modifyIdInfo (`setRuleInfo` spec_info) id
+
+        ---------------------------------
+        -- CAF INFO
+idCafInfo :: Id -> CafInfo
+idCafInfo id = cafInfo (idInfo id)
+
+setIdCafInfo :: Id -> CafInfo -> Id
+setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
+
+        ---------------------------------
+        -- Occurrence INFO
+idOccInfo :: Id -> OccInfo
+idOccInfo id = occInfo (idInfo id)
+
+setIdOccInfo :: Id -> OccInfo -> Id
+setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
+
+zapIdOccInfo :: Id -> Id
+zapIdOccInfo b = b `setIdOccInfo` noOccInfo
+
+{-
+        ---------------------------------
+        -- INLINING
+The inline pragma tells us to be very keen to inline this Id, but it's still
+OK not to if optimisation is switched off.
+-}
+
+idInlinePragma :: Id -> InlinePragma
+idInlinePragma id = inlinePragInfo (idInfo id)
+
+setInlinePragma :: Id -> InlinePragma -> Id
+setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
+
+modifyInlinePragma :: Id -> (InlinePragma -> InlinePragma) -> Id
+modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
+
+idInlineActivation :: Id -> Activation
+idInlineActivation id = inlinePragmaActivation (idInlinePragma id)
+
+setInlineActivation :: Id -> Activation -> Id
+setInlineActivation id act = modifyInlinePragma id (\prag -> setInlinePragmaActivation prag act)
+
+idRuleMatchInfo :: Id -> RuleMatchInfo
+idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
+
+isConLikeId :: Id -> Bool
+isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
+
+{-
+        ---------------------------------
+        -- ONE-SHOT LAMBDAS
+-}
+
+idOneShotInfo :: Id -> OneShotInfo
+idOneShotInfo id = oneShotInfo (idInfo id)
+
+-- | Like 'idOneShotInfo', but taking the Horrible State Hack in to account
+-- See Note [The state-transformer hack] in GHC.Core.Arity
+idStateHackOneShotInfo :: Id -> OneShotInfo
+idStateHackOneShotInfo id
+    | isStateHackType (idType id) = stateHackOneShot
+    | otherwise                   = idOneShotInfo id
+
+-- | Returns whether the lambda associated with the 'Id' is certainly applied at most once
+-- This one is the "business end", called externally.
+-- It works on type variables as well as Ids, returning True
+-- Its main purpose is to encapsulate the Horrible State Hack
+-- See Note [The state-transformer hack] in GHC.Core.Arity
+isOneShotBndr :: Var -> Bool
+isOneShotBndr var
+  | isTyVar var                              = True
+  | OneShotLam <- idStateHackOneShotInfo var = True
+  | otherwise                                = False
+
+-- | Should we apply the state hack to values of this 'Type'?
+stateHackOneShot :: OneShotInfo
+stateHackOneShot = OneShotLam
+
+typeOneShot :: Type -> OneShotInfo
+typeOneShot ty
+   | isStateHackType ty = stateHackOneShot
+   | otherwise          = NoOneShotInfo
+
+isStateHackType :: Type -> Bool
+isStateHackType ty
+  | hasNoStateHack unsafeGlobalDynFlags
+  = False
+  | otherwise
+  = case tyConAppTyCon_maybe ty of
+        Just tycon -> tycon == statePrimTyCon
+        _          -> False
+        -- This is a gross hack.  It claims that
+        -- every function over realWorldStatePrimTy is a one-shot
+        -- function.  This is pretty true in practice, and makes a big
+        -- difference.  For example, consider
+        --      a `thenST` \ r -> ...E...
+        -- The early full laziness pass, if it doesn't know that r is one-shot
+        -- will pull out E (let's say it doesn't mention r) to give
+        --      let lvl = E in a `thenST` \ r -> ...lvl...
+        -- When `thenST` gets inlined, we end up with
+        --      let lvl = E in \s -> case a s of (r, s') -> ...lvl...
+        -- and we don't re-inline E.
+        --
+        -- It would be better to spot that r was one-shot to start with, but
+        -- I don't want to rely on that.
+        --
+        -- Another good example is in fill_in in PrelPack.hs.  We should be able to
+        -- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
+
+isProbablyOneShotLambda :: Id -> Bool
+isProbablyOneShotLambda id = case idStateHackOneShotInfo id of
+                               OneShotLam    -> True
+                               NoOneShotInfo -> False
+
+setOneShotLambda :: Id -> Id
+setOneShotLambda id = modifyIdInfo (`setOneShotInfo` OneShotLam) id
+
+clearOneShotLambda :: Id -> Id
+clearOneShotLambda id = modifyIdInfo (`setOneShotInfo` NoOneShotInfo) id
+
+setIdOneShotInfo :: Id -> OneShotInfo -> Id
+setIdOneShotInfo id one_shot = modifyIdInfo (`setOneShotInfo` one_shot) id
+
+updOneShotInfo :: Id -> OneShotInfo -> Id
+-- Combine the info in the Id with new info
+updOneShotInfo id one_shot
+  | do_upd    = setIdOneShotInfo id one_shot
+  | otherwise = id
+  where
+    do_upd = case (idOneShotInfo id, one_shot) of
+                (NoOneShotInfo, _) -> True
+                (OneShotLam,    _) -> False
+
+-- The OneShotLambda functions simply fiddle with the IdInfo flag
+-- But watch out: this may change the type of something else
+--      f = \x -> e
+-- If we change the one-shot-ness of x, f's type changes
+
+zapInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
+zapInfo zapper id = maybeModifyIdInfo (zapper (idInfo id)) id
+
+zapLamIdInfo :: Id -> Id
+zapLamIdInfo = zapInfo zapLamInfo
+
+zapFragileIdInfo :: Id -> Id
+zapFragileIdInfo = zapInfo zapFragileInfo
+
+zapIdDemandInfo :: Id -> Id
+zapIdDemandInfo = zapInfo zapDemandInfo
+
+zapIdUsageInfo :: Id -> Id
+zapIdUsageInfo = zapInfo zapUsageInfo
+
+zapIdUsageEnvInfo :: Id -> Id
+zapIdUsageEnvInfo = zapInfo zapUsageEnvInfo
+
+zapIdUsedOnceInfo :: Id -> Id
+zapIdUsedOnceInfo = zapInfo zapUsedOnceInfo
+
+zapIdTailCallInfo :: Id -> Id
+zapIdTailCallInfo = zapInfo zapTailCallInfo
+
+zapStableUnfolding :: Id -> Id
+zapStableUnfolding id
+ | isStableUnfolding (realIdUnfolding id) = setIdUnfolding id NoUnfolding
+ | otherwise                              = id
+
+{-
+Note [transferPolyIdInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+This transfer is used in three places:
+        FloatOut (long-distance let-floating)
+        GHC.Core.Op.Simplify.Utils.abstractFloats (short-distance let-floating)
+        StgLiftLams (selectively lambda-lift local functions to top-level)
+
+Consider the short-distance let-floating:
+
+   f = /\a. let g = rhs in ...
+
+Then if we float thus
+
+   g' = /\a. rhs
+   f = /\a. ...[g' a/g]....
+
+we *do not* want to lose g's
+  * strictness information
+  * arity
+  * inline pragma (though that is bit more debatable)
+  * occurrence info
+
+Mostly this is just an optimisation, but it's *vital* to
+transfer the occurrence info.  Consider
+
+   NonRec { f = /\a. let Rec { g* = ..g.. } in ... }
+
+where the '*' means 'LoopBreaker'.  Then if we float we must get
+
+   Rec { g'* = /\a. ...(g' a)... }
+   NonRec { f = /\a. ...[g' a/g]....}
+
+where g' is also marked as LoopBreaker.  If not, terrible things
+can happen if we re-simplify the binding (and the Simplifier does
+sometimes simplify a term twice); see #4345.
+
+It's not so simple to retain
+  * worker info
+  * rules
+so we simply discard those.  Sooner or later this may bite us.
+
+If we abstract wrt one or more *value* binders, we must modify the
+arity and strictness info before transferring it.  E.g.
+      f = \x. e
+-->
+      g' = \y. \x. e
+      + substitute (g' y) for g
+Notice that g' has an arity one more than the original g
+-}
+
+transferPolyIdInfo :: Id        -- Original Id
+                   -> [Var]     -- Abstract wrt these variables
+                   -> Id        -- New Id
+                   -> Id
+transferPolyIdInfo old_id abstract_wrt new_id
+  = modifyIdInfo transfer new_id
+  where
+    arity_increase = count isId abstract_wrt    -- Arity increases by the
+                                                -- number of value binders
+
+    old_info        = idInfo old_id
+    old_arity       = arityInfo old_info
+    old_inline_prag = inlinePragInfo old_info
+    old_occ_info    = occInfo old_info
+    new_arity       = old_arity + arity_increase
+    new_occ_info    = zapOccTailCallInfo old_occ_info
+
+    old_strictness  = strictnessInfo old_info
+    new_strictness  = increaseStrictSigArity arity_increase old_strictness
+    old_cpr         = cprInfo old_info
+
+    transfer new_info = new_info `setArityInfo` new_arity
+                                 `setInlinePragInfo` old_inline_prag
+                                 `setOccInfo` new_occ_info
+                                 `setStrictnessInfo` new_strictness
+                                 `setCprInfo` old_cpr
+
+isNeverLevPolyId :: Id -> Bool
+isNeverLevPolyId = isNeverLevPolyIdInfo . idInfo
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
new file mode 100644
index 0000000000..e731fc1449
--- /dev/null
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -0,0 +1,652 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
+
+\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
+
+(And a pretty good illustration of quite a few things wrong with
+Haskell. [WDP 94/11])
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
+
+module GHC.Types.Id.Info (
+        -- * The IdDetails type
+        IdDetails(..), pprIdDetails, coVarDetails, isCoVarDetails,
+        JoinArity, isJoinIdDetails_maybe,
+        RecSelParent(..),
+
+        -- * The IdInfo type
+        IdInfo,         -- Abstract
+        vanillaIdInfo, noCafIdInfo,
+
+        -- ** The OneShotInfo type
+        OneShotInfo(..),
+        oneShotInfo, noOneShotInfo, hasNoOneShotInfo,
+        setOneShotInfo,
+
+        -- ** Zapping various forms of Info
+        zapLamInfo, zapFragileInfo,
+        zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
+        zapTailCallInfo, zapCallArityInfo, zapUnfolding,
+
+        -- ** The ArityInfo type
+        ArityInfo,
+        unknownArity,
+        arityInfo, setArityInfo, ppArityInfo,
+
+        callArityInfo, setCallArityInfo,
+
+        -- ** Demand and strictness Info
+        strictnessInfo, setStrictnessInfo,
+        cprInfo, setCprInfo,
+        demandInfo, setDemandInfo, pprStrictness,
+
+        -- ** Unfolding Info
+        unfoldingInfo, setUnfoldingInfo,
+
+        -- ** The InlinePragInfo type
+        InlinePragInfo,
+        inlinePragInfo, setInlinePragInfo,
+
+        -- ** The OccInfo type
+        OccInfo(..),
+        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker,
+        occInfo, setOccInfo,
+
+        InsideLam(..), OneBranch(..),
+
+        TailCallInfo(..),
+        tailCallInfo, isAlwaysTailCalled,
+
+        -- ** The RuleInfo type
+        RuleInfo(..),
+        emptyRuleInfo,
+        isEmptyRuleInfo, ruleInfoFreeVars,
+        ruleInfoRules, setRuleInfoHead,
+        ruleInfo, setRuleInfo,
+
+        -- ** The CAFInfo type
+        CafInfo(..),
+        ppCafInfo, mayHaveCafRefs,
+        cafInfo, setCafInfo,
+
+        -- ** Tick-box Info
+        TickBoxOp(..), TickBoxId,
+
+        -- ** Levity info
+        LevityInfo, levityInfo, setNeverLevPoly, setLevityInfoWithType,
+        isNeverLevPolyIdInfo
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Core
+
+import GHC.Core.Class
+import {-# SOURCE #-} PrimOp (PrimOp)
+import GHC.Types.Name
+import GHC.Types.Var.Set
+import GHC.Types.Basic
+import GHC.Core.DataCon
+import GHC.Core.TyCon
+import GHC.Core.PatSyn
+import GHC.Core.Type
+import GHC.Types.ForeignCall
+import Outputable
+import GHC.Types.Module
+import GHC.Types.Demand
+import GHC.Types.Cpr
+import Util
+
+-- infixl so you can say (id `set` a `set` b)
+infixl  1 `setRuleInfo`,
+          `setArityInfo`,
+          `setInlinePragInfo`,
+          `setUnfoldingInfo`,
+          `setOneShotInfo`,
+          `setOccInfo`,
+          `setCafInfo`,
+          `setStrictnessInfo`,
+          `setCprInfo`,
+          `setDemandInfo`,
+          `setNeverLevPoly`,
+          `setLevityInfoWithType`
+
+{-
+************************************************************************
+*                                                                      *
+                     IdDetails
+*                                                                      *
+************************************************************************
+-}
+
+-- | Identifier Details
+--
+-- The 'IdDetails' of an 'Id' give stable, and necessary,
+-- information about the Id.
+data IdDetails
+  = VanillaId
+
+  -- | The 'Id' for a record selector
+  | RecSelId
+    { sel_tycon   :: RecSelParent
+    , sel_naughty :: Bool       -- True <=> a "naughty" selector which can't actually exist, for example @x@ in:
+                                --    data T = forall a. MkT { x :: a }
+    }                           -- See Note [Naughty record selectors] in TcTyClsDecls
+
+  | DataConWorkId DataCon       -- ^ The 'Id' is for a data constructor /worker/
+  | DataConWrapId DataCon       -- ^ The 'Id' is for a data constructor /wrapper/
+
+                                -- [the only reasons we need to know is so that
+                                --  a) to support isImplicitId
+                                --  b) when desugaring a RecordCon we can get
+                                --     from the Id back to the data con]
+  | ClassOpId Class             -- ^ The 'Id' is a superclass selector,
+                                -- or class operation of a class
+
+  | PrimOpId PrimOp             -- ^ The 'Id' is for a primitive operator
+  | FCallId ForeignCall         -- ^ The 'Id' is for a foreign call.
+                                -- Type will be simple: no type families, newtypes, etc
+
+  | TickBoxOpId TickBoxOp       -- ^ The 'Id' is for a HPC tick box (both traditional and binary)
+
+  | DFunId Bool                 -- ^ A dictionary function.
+       -- Bool = True <=> the class has only one method, so may be
+       --                  implemented with a newtype, so it might be bad
+       --                  to be strict on this dictionary
+
+  | CoVarId    -- ^ A coercion variable
+               -- This only covers /un-lifted/ coercions, of type
+               -- (t1 ~# t2) or (t1 ~R# t2), not their lifted variants
+  | JoinId JoinArity           -- ^ An 'Id' for a join point taking n arguments
+       -- Note [Join points] in GHC.Core
+
+-- | Recursive Selector Parent
+data RecSelParent = RecSelData TyCon | RecSelPatSyn PatSyn deriving Eq
+  -- Either `TyCon` or `PatSyn` depending
+  -- on the origin of the record selector.
+  -- For a data type family, this is the
+  -- /instance/ 'TyCon' not the family 'TyCon'
+
+instance Outputable RecSelParent where
+  ppr p = case p of
+            RecSelData ty_con -> ppr ty_con
+            RecSelPatSyn ps   -> ppr ps
+
+-- | Just a synonym for 'CoVarId'. Written separately so it can be
+-- exported in the hs-boot file.
+coVarDetails :: IdDetails
+coVarDetails = CoVarId
+
+-- | Check if an 'IdDetails' says 'CoVarId'.
+isCoVarDetails :: IdDetails -> Bool
+isCoVarDetails CoVarId = True
+isCoVarDetails _       = False
+
+isJoinIdDetails_maybe :: IdDetails -> Maybe JoinArity
+isJoinIdDetails_maybe (JoinId join_arity) = Just join_arity
+isJoinIdDetails_maybe _                   = Nothing
+
+instance Outputable IdDetails where
+    ppr = pprIdDetails
+
+pprIdDetails :: IdDetails -> SDoc
+pprIdDetails VanillaId = empty
+pprIdDetails other     = brackets (pp other)
+ where
+   pp VanillaId               = panic "pprIdDetails"
+   pp (DataConWorkId _)       = text "DataCon"
+   pp (DataConWrapId _)       = text "DataConWrapper"
+   pp (ClassOpId {})          = text "ClassOp"
+   pp (PrimOpId _)            = text "PrimOp"
+   pp (FCallId _)             = text "ForeignCall"
+   pp (TickBoxOpId _)         = text "TickBoxOp"
+   pp (DFunId nt)             = text "DFunId" <> ppWhen nt (text "(nt)")
+   pp (RecSelId { sel_naughty = is_naughty })
+                              = brackets $ text "RecSel" <>
+                                           ppWhen is_naughty (text "(naughty)")
+   pp CoVarId                 = text "CoVarId"
+   pp (JoinId arity)          = text "JoinId" <> parens (int arity)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{The main IdInfo type}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Identifier Information
+--
+-- An 'IdInfo' gives /optional/ information about an 'Id'.  If
+-- present it never lies, but it may not be present, in which case there
+-- is always a conservative assumption which can be made.
+--
+-- Two 'Id's may have different info even though they have the same
+-- 'Unique' (and are hence the same 'Id'); for example, one might lack
+-- the properties attached to the other.
+--
+-- Most of the 'IdInfo' gives information about the value, or definition, of
+-- the 'Id', independent of its usage. Exceptions to this
+-- are 'demandInfo', 'occInfo', 'oneShotInfo' and 'callArityInfo'.
+--
+-- Performance note: when we update 'IdInfo', we have to reallocate this
+-- entire record, so it is a good idea not to let this data structure get
+-- too big.
+data IdInfo
+  = IdInfo {
+        arityInfo       :: !ArityInfo,
+        -- ^ 'Id' arity, as computed by 'GHC.Core.Arity'. Specifies how many
+        -- arguments this 'Id' has to be applied to before it doesn any
+        -- meaningful work.
+        ruleInfo        :: RuleInfo,
+        -- ^ Specialisations of the 'Id's function which exist.
+        -- See Note [Specialisations and RULES in IdInfo]
+        unfoldingInfo   :: Unfolding,
+        -- ^ The 'Id's unfolding
+        cafInfo         :: CafInfo,
+        -- ^ 'Id' CAF info
+        oneShotInfo     :: OneShotInfo,
+        -- ^ Info about a lambda-bound variable, if the 'Id' is one
+        inlinePragInfo  :: InlinePragma,
+        -- ^ Any inline pragma attached to the 'Id'
+        occInfo         :: OccInfo,
+        -- ^ How the 'Id' occurs in the program
+        strictnessInfo  :: StrictSig,
+        -- ^ A strictness signature. Digests how a function uses its arguments
+        -- if applied to at least 'arityInfo' arguments.
+        cprInfo         :: CprSig,
+        -- ^ Information on whether the function will ultimately return a
+        -- freshly allocated constructor.
+        demandInfo      :: Demand,
+        -- ^ ID demand information
+        callArityInfo   :: !ArityInfo,
+        -- ^ How this is called. This is the number of arguments to which a
+        -- binding can be eta-expanded without losing any sharing.
+        -- n <=> all calls have at least n arguments
+        levityInfo      :: LevityInfo
+        -- ^ when applied, will this Id ever have a levity-polymorphic type?
+    }
+
+-- Setters
+
+setRuleInfo :: IdInfo -> RuleInfo -> IdInfo
+setRuleInfo       info sp = sp `seq` info { ruleInfo = sp }
+setInlinePragInfo :: IdInfo -> InlinePragma -> IdInfo
+setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
+setOccInfo :: IdInfo -> OccInfo -> IdInfo
+setOccInfo        info oc = oc `seq` info { occInfo = oc }
+        -- Try to avoid space leaks by seq'ing
+
+setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo
+setUnfoldingInfo info uf
+  = -- We don't seq the unfolding, as we generate intermediate
+    -- unfoldings which are just thrown away, so evaluating them is a
+    -- waste of time.
+    -- seqUnfolding uf `seq`
+    info { unfoldingInfo = uf }
+
+setArityInfo :: IdInfo -> ArityInfo -> IdInfo
+setArityInfo      info ar  = info { arityInfo = ar  }
+setCallArityInfo :: IdInfo -> ArityInfo -> IdInfo
+setCallArityInfo info ar  = info { callArityInfo = ar  }
+setCafInfo :: IdInfo -> CafInfo -> IdInfo
+setCafInfo        info caf = info { cafInfo = caf }
+
+setOneShotInfo :: IdInfo -> OneShotInfo -> IdInfo
+setOneShotInfo      info lb = {-lb `seq`-} info { oneShotInfo = lb }
+
+setDemandInfo :: IdInfo -> Demand -> IdInfo
+setDemandInfo info dd = dd `seq` info { demandInfo = dd }
+
+setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
+setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
+
+setCprInfo :: IdInfo -> CprSig -> IdInfo
+setCprInfo info cpr = cpr `seq` info { cprInfo = cpr }
+
+-- | Basic 'IdInfo' that carries no useful information whatsoever
+vanillaIdInfo :: IdInfo
+vanillaIdInfo
+  = IdInfo {
+            cafInfo             = vanillaCafInfo,
+            arityInfo           = unknownArity,
+            ruleInfo            = emptyRuleInfo,
+            unfoldingInfo       = noUnfolding,
+            oneShotInfo         = NoOneShotInfo,
+            inlinePragInfo      = defaultInlinePragma,
+            occInfo             = noOccInfo,
+            demandInfo          = topDmd,
+            strictnessInfo      = nopSig,
+            cprInfo             = topCprSig,
+            callArityInfo       = unknownArity,
+            levityInfo          = NoLevityInfo
+           }
+
+-- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
+noCafIdInfo :: IdInfo
+noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
+        -- Used for built-in type Ids in GHC.Types.Id.Make.
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[arity-IdInfo]{Arity info about an @Id@}
+*                                                                      *
+************************************************************************
+
+For locally-defined Ids, the code generator maintains its own notion
+of their arities; so it should not be asking...  (but other things
+besides the code-generator need arity info!)
+-}
+
+-- | Arity Information
+--
+-- An 'ArityInfo' of @n@ tells us that partial application of this
+-- 'Id' to up to @n-1@ value arguments does essentially no work.
+--
+-- That is not necessarily the same as saying that it has @n@ leading
+-- lambdas, because coerces may get in the way.
+--
+-- The arity might increase later in the compilation process, if
+-- an extra lambda floats up to the binding site.
+type ArityInfo = Arity
+
+-- | It is always safe to assume that an 'Id' has an arity of 0
+unknownArity :: Arity
+unknownArity = 0
+
+ppArityInfo :: Int -> SDoc
+ppArityInfo 0 = empty
+ppArityInfo n = hsep [text "Arity", int n]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Inline-pragma information}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Inline Pragma Information
+--
+-- Tells when the inlining is active.
+-- When it is active the thing may be inlined, depending on how
+-- big it is.
+--
+-- If there was an @INLINE@ pragma, then as a separate matter, the
+-- RHS will have been made to look small with a Core inline 'Note'
+--
+-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
+-- entirely as a way to inhibit inlining until we want it
+type InlinePragInfo = InlinePragma
+
+{-
+************************************************************************
+*                                                                      *
+               Strictness
+*                                                                      *
+************************************************************************
+-}
+
+pprStrictness :: StrictSig -> SDoc
+pprStrictness sig = ppr sig
+
+{-
+************************************************************************
+*                                                                      *
+        RuleInfo
+*                                                                      *
+************************************************************************
+
+Note [Specialisations and RULES in IdInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Generally speaking, a GlobalId has an *empty* RuleInfo.  All their
+RULES are contained in the globally-built rule-base.  In principle,
+one could attach the to M.f the RULES for M.f that are defined in M.
+But we don't do that for instance declarations and so we just treat
+them all uniformly.
+
+The EXCEPTION is PrimOpIds, which do have rules in their IdInfo. That is
+just for convenience really.
+
+However, LocalIds may have non-empty RuleInfo.  We treat them
+differently because:
+  a) they might be nested, in which case a global table won't work
+  b) the RULE might mention free variables, which we use to keep things alive
+
+In GHC.Iface.Tidy, when the LocalId becomes a GlobalId, its RULES are stripped off
+and put in the global list.
+-}
+
+-- | Rule Information
+--
+-- Records the specializations of this 'Id' that we know about
+-- in the form of rewrite 'CoreRule's that target them
+data RuleInfo
+  = RuleInfo
+        [CoreRule]
+        DVarSet         -- Locally-defined free vars of *both* LHS and RHS
+                        -- of rules.  I don't think it needs to include the
+                        -- ru_fn though.
+                        -- Note [Rule dependency info] in OccurAnal
+
+-- | Assume that no specializations exist: always safe
+emptyRuleInfo :: RuleInfo
+emptyRuleInfo = RuleInfo [] emptyDVarSet
+
+isEmptyRuleInfo :: RuleInfo -> Bool
+isEmptyRuleInfo (RuleInfo rs _) = null rs
+
+-- | Retrieve the locally-defined free variables of both the left and
+-- right hand sides of the specialization rules
+ruleInfoFreeVars :: RuleInfo -> DVarSet
+ruleInfoFreeVars (RuleInfo _ fvs) = fvs
+
+ruleInfoRules :: RuleInfo -> [CoreRule]
+ruleInfoRules (RuleInfo rules _) = rules
+
+-- | Change the name of the function the rule is keyed on on all of the 'CoreRule's
+setRuleInfoHead :: Name -> RuleInfo -> RuleInfo
+setRuleInfoHead fn (RuleInfo rules fvs)
+  = RuleInfo (map (setRuleIdName fn) rules) fvs
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[CG-IdInfo]{Code generator-related information}
+*                                                                      *
+************************************************************************
+-}
+
+-- CafInfo is used to build Static Reference Tables (see simplStg/SRT.hs).
+
+-- | Constant applicative form Information
+--
+-- Records whether an 'Id' makes Constant Applicative Form references
+data CafInfo
+        = MayHaveCafRefs                -- ^ Indicates that the 'Id' is for either:
+                                        --
+                                        -- 1. A function or static constructor
+                                        --    that refers to one or more CAFs, or
+                                        --
+                                        -- 2. A real live CAF
+
+        | NoCafRefs                     -- ^ A function or static constructor
+                                        -- that refers to no CAFs.
+        deriving (Eq, Ord)
+
+-- | Assumes that the 'Id' has CAF references: definitely safe
+vanillaCafInfo :: CafInfo
+vanillaCafInfo = MayHaveCafRefs
+
+mayHaveCafRefs :: CafInfo -> Bool
+mayHaveCafRefs  MayHaveCafRefs = True
+mayHaveCafRefs _               = False
+
+instance Outputable CafInfo where
+   ppr = ppCafInfo
+
+ppCafInfo :: CafInfo -> SDoc
+ppCafInfo NoCafRefs = text "NoCafRefs"
+ppCafInfo MayHaveCafRefs = empty
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Bulk operations on IdInfo}
+*                                                                      *
+************************************************************************
+-}
+
+-- | This is used to remove information on lambda binders that we have
+-- setup as part of a lambda group, assuming they will be applied all at once,
+-- but turn out to be part of an unsaturated lambda as in e.g:
+--
+-- > (\x1. \x2. e) arg1
+zapLamInfo :: IdInfo -> Maybe IdInfo
+zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
+  | is_safe_occ occ && is_safe_dmd demand
+  = Nothing
+  | otherwise
+  = Just (info {occInfo = safe_occ, demandInfo = topDmd})
+  where
+        -- The "unsafe" occ info is the ones that say I'm not in a lambda
+        -- because that might not be true for an unsaturated lambda
+    is_safe_occ occ | isAlwaysTailCalled occ           = False
+    is_safe_occ (OneOcc { occ_in_lam = NotInsideLam }) = False
+    is_safe_occ _other                                 = True
+
+    safe_occ = case occ of
+                 OneOcc{} -> occ { occ_in_lam = IsInsideLam
+                                 , occ_tail   = NoTailCallInfo }
+                 IAmALoopBreaker{}
+                          -> occ { occ_tail   = NoTailCallInfo }
+                 _other   -> occ
+
+    is_safe_dmd dmd = not (isStrictDmd dmd)
+
+-- | Remove all demand info on the 'IdInfo'
+zapDemandInfo :: IdInfo -> Maybe IdInfo
+zapDemandInfo info = Just (info {demandInfo = topDmd})
+
+-- | Remove usage (but not strictness) info on the 'IdInfo'
+zapUsageInfo :: IdInfo -> Maybe IdInfo
+zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})
+
+-- | Remove usage environment info from the strictness signature on the 'IdInfo'
+zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
+zapUsageEnvInfo info
+    | hasDemandEnvSig (strictnessInfo info)
+    = Just (info {strictnessInfo = zapUsageEnvSig (strictnessInfo info)})
+    | otherwise
+    = Nothing
+
+zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
+zapUsedOnceInfo info
+    = Just $ info { strictnessInfo = zapUsedOnceSig    (strictnessInfo info)
+                  , demandInfo     = zapUsedOnceDemand (demandInfo     info) }
+
+zapFragileInfo :: IdInfo -> Maybe IdInfo
+-- ^ Zap info that depends on free variables
+zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf })
+  = new_unf `seq`  -- The unfolding field is not (currently) strict, so we
+                   -- force it here to avoid a (zapFragileUnfolding unf) thunk
+                   -- which might leak space
+    Just (info `setRuleInfo` emptyRuleInfo
+               `setUnfoldingInfo` new_unf
+               `setOccInfo`       zapFragileOcc occ)
+  where
+    new_unf = zapFragileUnfolding unf
+
+zapFragileUnfolding :: Unfolding -> Unfolding
+zapFragileUnfolding unf
+ | isFragileUnfolding unf = noUnfolding
+ | otherwise              = unf
+
+zapUnfolding :: Unfolding -> Unfolding
+-- Squash all unfolding info, preserving only evaluated-ness
+zapUnfolding unf | isEvaldUnfolding unf = evaldUnfolding
+                 | otherwise            = noUnfolding
+
+zapTailCallInfo :: IdInfo -> Maybe IdInfo
+zapTailCallInfo info
+  = case occInfo info of
+      occ | isAlwaysTailCalled occ -> Just (info `setOccInfo` safe_occ)
+          | otherwise              -> Nothing
+        where
+          safe_occ = occ { occ_tail = NoTailCallInfo }
+
+zapCallArityInfo :: IdInfo -> IdInfo
+zapCallArityInfo info = setCallArityInfo info 0
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{TickBoxOp}
+*                                                                      *
+************************************************************************
+-}
+
+type TickBoxId = Int
+
+-- | Tick box for Hpc-style coverage
+data TickBoxOp
+   = TickBox Module {-# UNPACK #-} !TickBoxId
+
+instance Outputable TickBoxOp where
+    ppr (TickBox mod n)         = text "tick" <+> ppr (mod,n)
+
+{-
+************************************************************************
+*                                                                      *
+   Levity
+*                                                                      *
+************************************************************************
+
+Note [Levity info]
+~~~~~~~~~~~~~~~~~~
+
+Ids store whether or not they can be levity-polymorphic at any amount
+of saturation. This is helpful in optimizing the levity-polymorphism check
+done in the desugarer, where we can usually learn that something is not
+levity-polymorphic without actually figuring out its type. See
+isExprLevPoly in GHC.Core.Utils for where this info is used. Storing
+this is required to prevent perf/compiler/T5631 from blowing up.
+
+-}
+
+-- See Note [Levity info]
+data LevityInfo = NoLevityInfo  -- always safe
+                | NeverLevityPolymorphic
+  deriving Eq
+
+instance Outputable LevityInfo where
+  ppr NoLevityInfo           = text "NoLevityInfo"
+  ppr NeverLevityPolymorphic = text "NeverLevityPolymorphic"
+
+-- | Marks an IdInfo describing an Id that is never levity polymorphic (even when
+-- applied). The Type is only there for checking that it's really never levity
+-- polymorphic
+setNeverLevPoly :: HasDebugCallStack => IdInfo -> Type -> IdInfo
+setNeverLevPoly info ty
+  = ASSERT2( not (resultIsLevPoly ty), ppr ty )
+    info { levityInfo = NeverLevityPolymorphic }
+
+setLevityInfoWithType :: IdInfo -> Type -> IdInfo
+setLevityInfoWithType info ty
+  | not (resultIsLevPoly ty)
+  = info { levityInfo = NeverLevityPolymorphic }
+  | otherwise
+  = info
+
+isNeverLevPolyIdInfo :: IdInfo -> Bool
+isNeverLevPolyIdInfo info
+  | NeverLevityPolymorphic <- levityInfo info = True
+  | otherwise                                 = False
diff --git a/compiler/GHC/Types/Id/Info.hs-boot b/compiler/GHC/Types/Id/Info.hs-boot
new file mode 100644
index 0000000000..c6912344aa
--- /dev/null
+++ b/compiler/GHC/Types/Id/Info.hs-boot
@@ -0,0 +1,11 @@
+module GHC.Types.Id.Info where
+import GhcPrelude
+import Outputable
+data IdInfo
+data IdDetails
+
+vanillaIdInfo :: IdInfo
+coVarDetails :: IdDetails
+isCoVarDetails :: IdDetails -> Bool
+pprIdDetails :: IdDetails -> SDoc
+
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
new file mode 100644
index 0000000000..43b7aae72d
--- /dev/null
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -0,0 +1,1708 @@
+{-
+(c) The University of Glasgow 2006
+(c) The AQUA Project, Glasgow University, 1998
+
+
+This module contains definitions for the IdInfo for things that
+have a standard form, namely:
+
+- data constructors
+- record selectors
+- method and superclass selectors
+- primitive operations
+-}
+
+{-# LANGUAGE CPP #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module GHC.Types.Id.Make (
+        mkDictFunId, mkDictFunTy, mkDictSelId, mkDictSelRhs,
+
+        mkPrimOpId, mkFCallId,
+
+        unwrapNewTypeBody, wrapFamInstBody,
+        DataConBoxer(..), vanillaDataConBoxer,
+        mkDataConRep, mkDataConWorkId,
+
+        -- And some particular Ids; see below for why they are wired in
+        wiredInIds, ghcPrimIds,
+        realWorldPrimId,
+        voidPrimId, voidArgId,
+        nullAddrId, seqId, lazyId, lazyIdKey,
+        coercionTokenId, magicDictId, coerceId,
+        proxyHashId, noinlineId, noinlineIdName,
+        coerceName,
+
+        -- Re-export error Ids
+        module GHC.Core.Op.ConstantFold
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Core.Rules
+import TysPrim
+import TysWiredIn
+import GHC.Core.Op.ConstantFold
+import GHC.Core.Type
+import GHC.Core.TyCo.Rep
+import GHC.Core.FamInstEnv
+import GHC.Core.Coercion
+import TcType
+import GHC.Core.Make
+import GHC.Core.Utils  ( mkCast, mkDefaultCase )
+import GHC.Core.Unfold
+import GHC.Types.Literal
+import GHC.Core.TyCon
+import GHC.Core.Class
+import GHC.Types.Name.Set
+import GHC.Types.Name
+import PrimOp
+import GHC.Types.ForeignCall
+import GHC.Core.DataCon
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Demand
+import GHC.Types.Cpr
+import GHC.Core
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
+import PrelNames
+import GHC.Types.Basic       hiding ( SuccessFlag(..) )
+import Util
+import GHC.Driver.Session
+import Outputable
+import FastString
+import ListSetOps
+import GHC.Types.Var (VarBndr(Bndr))
+import qualified GHC.LanguageExtensions as LangExt
+
+import Data.Maybe       ( maybeToList )
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Wired in Ids}
+*                                                                      *
+************************************************************************
+
+Note [Wired-in Ids]
+~~~~~~~~~~~~~~~~~~~
+A "wired-in" Id can be referred to directly in GHC (e.g. 'voidPrimId')
+rather than by looking it up its name in some environment or fetching
+it from an interface file.
+
+There are several reasons why an Id might appear in the wiredInIds:
+
+* ghcPrimIds: see Note [ghcPrimIds (aka pseudoops)]
+
+* magicIds: see Note [magicIds]
+
+* errorIds, defined in GHC.Core.Make.
+  These error functions (e.g. rUNTIME_ERROR_ID) are wired in
+  because the desugarer generates code that mentions them directly
+
+In all cases except ghcPrimIds, there is a definition site in a
+library module, which may be called (e.g. in higher order situations);
+but the wired-in version means that the details are never read from
+that module's interface file; instead, the full definition is right
+here.
+
+Note [ghcPrimIds (aka pseudoops)]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The ghcPrimIds
+
+  * Are exported from GHC.Prim
+
+  * Can't be defined in Haskell, and hence no Haskell binding site,
+    but have perfectly reasonable unfoldings in Core
+
+  * Either have a CompulsoryUnfolding (hence always inlined), or
+        of an EvaldUnfolding and void representation (e.g. void#)
+
+  * Are (or should be) defined in primops.txt.pp as 'pseudoop'
+    Reason: that's how we generate documentation for them
+
+Note [magicIds]
+~~~~~~~~~~~~~~~
+The magicIds
+
+  * Are exported from GHC.Magic
+
+  * Can be defined in Haskell (and are, in ghc-prim:GHC/Magic.hs).
+    This definition at least generates Haddock documentation for them.
+
+  * May or may not have a CompulsoryUnfolding.
+
+  * But have some special behaviour that can't be done via an
+    unfolding from an interface file
+-}
+
+wiredInIds :: [Id]
+wiredInIds
+  =  magicIds
+  ++ ghcPrimIds
+  ++ errorIds           -- Defined in GHC.Core.Make
+
+magicIds :: [Id]    -- See Note [magicIds]
+magicIds = [lazyId, oneShotId, noinlineId]
+
+ghcPrimIds :: [Id]  -- See Note [ghcPrimIds (aka pseudoops)]
+ghcPrimIds
+  = [ realWorldPrimId
+    , voidPrimId
+    , nullAddrId
+    , seqId
+    , magicDictId
+    , coerceId
+    , proxyHashId
+    ]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Data constructors}
+*                                                                      *
+************************************************************************
+
+The wrapper for a constructor is an ordinary top-level binding that evaluates
+any strict args, unboxes any args that are going to be flattened, and calls
+the worker.
+
+We're going to build a constructor that looks like:
+
+        data (Data a, C b) =>  T a b = T1 !a !Int b
+
+        T1 = /\ a b ->
+             \d1::Data a, d2::C b ->
+             \p q r -> case p of { p ->
+                       case q of { q ->
+                       Con T1 [a,b] [p,q,r]}}
+
+Notice that
+
+* d2 is thrown away --- a context in a data decl is used to make sure
+  one *could* construct dictionaries at the site the constructor
+  is used, but the dictionary isn't actually used.
+
+* We have to check that we can construct Data dictionaries for
+  the types a and Int.  Once we've done that we can throw d1 away too.
+
+* We use (case p of q -> ...) to evaluate p, rather than "seq" because
+  all that matters is that the arguments are evaluated.  "seq" is
+  very careful to preserve evaluation order, which we don't need
+  to be here.
+
+  You might think that we could simply give constructors some strictness
+  info, like PrimOps, and let CoreToStg do the let-to-case transformation.
+  But we don't do that because in the case of primops and functions strictness
+  is a *property* not a *requirement*.  In the case of constructors we need to
+  do something active to evaluate the argument.
+
+  Making an explicit case expression allows the simplifier to eliminate
+  it in the (common) case where the constructor arg is already evaluated.
+
+Note [Wrappers for data instance tycons]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In the case of data instances, the wrapper also applies the coercion turning
+the representation type into the family instance type to cast the result of
+the wrapper.  For example, consider the declarations
+
+  data family Map k :: * -> *
+  data instance Map (a, b) v = MapPair (Map a (Pair b v))
+
+The tycon to which the datacon MapPair belongs gets a unique internal
+name of the form :R123Map, and we call it the representation tycon.
+In contrast, Map is the family tycon (accessible via
+tyConFamInst_maybe). A coercion allows you to move between
+representation and family type.  It is accessible from :R123Map via
+tyConFamilyCoercion_maybe and has kind
+
+  Co123Map a b v :: {Map (a, b) v ~ :R123Map a b v}
+
+The wrapper and worker of MapPair get the types
+
+        -- Wrapper
+  $WMapPair :: forall a b v. Map a (Map a b v) -> Map (a, b) v
+  $WMapPair a b v = MapPair a b v `cast` sym (Co123Map a b v)
+
+        -- Worker
+  MapPair :: forall a b v. Map a (Map a b v) -> :R123Map a b v
+
+This coercion is conditionally applied by wrapFamInstBody.
+
+It's a bit more complicated if the data instance is a GADT as well!
+
+   data instance T [a] where
+        T1 :: forall b. b -> T [Maybe b]
+
+Hence we translate to
+
+        -- Wrapper
+  $WT1 :: forall b. b -> T [Maybe b]
+  $WT1 b v = T1 (Maybe b) b (Maybe b) v
+                        `cast` sym (Co7T (Maybe b))
+
+        -- Worker
+  T1 :: forall c b. (c ~ Maybe b) => b -> :R7T c
+
+        -- Coercion from family type to representation type
+  Co7T a :: T [a] ~ :R7T a
+
+Newtype instances through an additional wrinkle into the mix. Consider the
+following example (adapted from #15318, comment:2):
+
+  data family T a
+  newtype instance T [a] = MkT [a]
+
+Within the newtype instance, there are three distinct types at play:
+
+1. The newtype's underlying type, [a].
+2. The instance's representation type, TList a (where TList is the
+   representation tycon).
+3. The family type, T [a].
+
+We need two coercions in order to cast from (1) to (3):
+
+(a) A newtype coercion axiom:
+
+      axiom coTList a :: TList a ~ [a]
+
+    (Where TList is the representation tycon of the newtype instance.)
+
+(b) A data family instance coercion axiom:
+
+      axiom coT a :: T [a] ~ TList a
+
+When we translate the newtype instance to Core, we obtain:
+
+    -- Wrapper
+  $WMkT :: forall a. [a] -> T [a]
+  $WMkT a x = MkT a x |> Sym (coT a)
+
+    -- Worker
+  MkT :: forall a. [a] -> TList [a]
+  MkT a x = x |> Sym (coTList a)
+
+Unlike for data instances, the worker for a newtype instance is actually an
+executable function which expands to a cast, but otherwise, the general
+strategy is essentially the same as for data instances. Also note that we have
+a wrapper, which is unusual for a newtype, but we make GHC produce one anyway
+for symmetry with the way data instances are handled.
+
+Note [Newtype datacons]
+~~~~~~~~~~~~~~~~~~~~~~~
+The "data constructor" for a newtype should always be vanilla.  At one
+point this wasn't true, because the newtype arising from
+     class C a => D a
+looked like
+       newtype T:D a = D:D (C a)
+so the data constructor for T:C had a single argument, namely the
+predicate (C a).  But now we treat that as an ordinary argument, not
+part of the theta-type, so all is well.
+
+Note [Newtype workers]
+~~~~~~~~~~~~~~~~~~~~~~
+A newtype does not really have a worker. Instead, newtype constructors
+just unfold into a cast. But we need *something* for, say, MkAge to refer
+to. So, we do this:
+
+* The Id used as the newtype worker will have a compulsory unfolding to
+  a cast. See Note [Compulsory newtype unfolding]
+
+* This Id is labeled as a DataConWrapId. We don't want to use a DataConWorkId,
+  as those have special treatment in the back end.
+
+* There is no top-level binding, because the compulsory unfolding
+  means that it will be inlined (to a cast) at every call site.
+
+We probably should have a NewtypeWorkId, but these Ids disappear as soon as
+we desugar anyway, so it seems a step too far.
+
+Note [Compulsory newtype unfolding]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Newtype wrappers, just like workers, have compulsory unfoldings.
+This is needed so that two optimizations involving newtypes have the same
+effect whether a wrapper is present or not:
+
+(1) Case-of-known constructor.
+    See Note [beta-reduction in exprIsConApp_maybe].
+
+(2) Matching against the map/coerce RULE. Suppose we have the RULE
+
+    {-# RULE "map/coerce" map coerce = ... #-}
+
+    As described in Note [Getting the map/coerce RULE to work],
+    the occurrence of 'coerce' is transformed into:
+
+    {-# RULE "map/coerce" forall (c :: T1 ~R# T2).
+                          map ((\v -> v) `cast` c) = ... #-}
+
+    We'd like 'map Age' to match the LHS. For this to happen, Age
+    must be unfolded, otherwise we'll be stuck. This is tested in T16208.
+
+It also allows for the posssibility of levity polymorphic newtypes
+with wrappers (with -XUnliftedNewtypes):
+
+  newtype N (a :: TYPE r) = MkN a
+
+With -XUnliftedNewtypes, this is allowed -- even though MkN is levity-
+polymorphic. It's OK because MkN evaporates in the compiled code, becoming
+just a cast. That is, it has a compulsory unfolding. As long as its
+argument is not levity-polymorphic (which it can't be, according to
+Note [Levity polymorphism invariants] in GHC.Core), and it's saturated,
+no levity-polymorphic code ends up in the code generator. The saturation
+condition is effectively checked by Note [Detecting forced eta expansion]
+in GHC.HsToCore.Expr.
+
+However, if we make a *wrapper* for a newtype, we get into trouble.
+The saturation condition is no longer checked (because hasNoBinding
+returns False) and indeed we generate a forbidden levity-polymorphic
+binding.
+
+The solution is simple, though: just make the newtype wrappers
+as ephemeral as the newtype workers. In other words, give the wrappers
+compulsory unfoldings and no bindings. The compulsory unfolding is given
+in wrap_unf in mkDataConRep, and the lack of a binding happens in
+GHC.Iface.Tidy.getTyConImplicitBinds, where we say that a newtype has no
+implicit bindings.
+
+************************************************************************
+*                                                                      *
+\subsection{Dictionary selectors}
+*                                                                      *
+************************************************************************
+
+Selecting a field for a dictionary.  If there is just one field, then
+there's nothing to do.
+
+Dictionary selectors may get nested forall-types.  Thus:
+
+        class Foo a where
+          op :: forall b. Ord b => a -> b -> b
+
+Then the top-level type for op is
+
+        op :: forall a. Foo a =>
+              forall b. Ord b =>
+              a -> b -> b
+
+-}
+
+mkDictSelId :: Name          -- Name of one of the *value* selectors
+                             -- (dictionary superclass or method)
+            -> Class -> Id
+mkDictSelId name clas
+  = mkGlobalId (ClassOpId clas) name sel_ty info
+  where
+    tycon          = classTyCon clas
+    sel_names      = map idName (classAllSelIds clas)
+    new_tycon      = isNewTyCon tycon
+    [data_con]     = tyConDataCons tycon
+    tyvars         = dataConUserTyVarBinders data_con
+    n_ty_args      = length tyvars
+    arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses
+    val_index      = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
+
+    sel_ty = mkForAllTys tyvars $
+             mkInvisFunTy (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $
+             getNth arg_tys val_index
+
+    base_info = noCafIdInfo
+                `setArityInfo`          1
+                `setStrictnessInfo`     strict_sig
+                `setCprInfo`            topCprSig
+                `setLevityInfoWithType` sel_ty
+
+    info | new_tycon
+         = base_info `setInlinePragInfo` alwaysInlinePragma
+                     `setUnfoldingInfo`  mkInlineUnfoldingWithArity 1
+                                           (mkDictSelRhs clas val_index)
+                   -- See Note [Single-method classes] in TcInstDcls
+                   -- for why alwaysInlinePragma
+
+         | otherwise
+         = base_info `setRuleInfo` mkRuleInfo [rule]
+                   -- Add a magic BuiltinRule, but no unfolding
+                   -- so that the rule is always available to fire.
+                   -- See Note [ClassOp/DFun selection] in TcInstDcls
+
+    -- This is the built-in rule that goes
+    --      op (dfT d1 d2) --->  opT d1 d2
+    rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
+                                     occNameFS (getOccName name)
+                       , ru_fn    = name
+                       , ru_nargs = n_ty_args + 1
+                       , ru_try   = dictSelRule val_index n_ty_args }
+
+        -- The strictness signature is of the form U(AAAVAAAA) -> T
+        -- where the V depends on which item we are selecting
+        -- It's worth giving one, so that absence info etc is generated
+        -- even if the selector isn't inlined
+
+    strict_sig = mkClosedStrictSig [arg_dmd] topDiv
+    arg_dmd | new_tycon = evalDmd
+            | otherwise = mkManyUsedDmd $
+                          mkProdDmd [ if name == sel_name then evalDmd else absDmd
+                                    | sel_name <- sel_names ]
+
+mkDictSelRhs :: Class
+             -> Int         -- 0-indexed selector among (superclasses ++ methods)
+             -> CoreExpr
+mkDictSelRhs clas val_index
+  = mkLams tyvars (Lam dict_id rhs_body)
+  where
+    tycon          = classTyCon clas
+    new_tycon      = isNewTyCon tycon
+    [data_con]     = tyConDataCons tycon
+    tyvars         = dataConUnivTyVars data_con
+    arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses
+
+    the_arg_id     = getNth arg_ids val_index
+    pred           = mkClassPred clas (mkTyVarTys tyvars)
+    dict_id        = mkTemplateLocal 1 pred
+    arg_ids        = mkTemplateLocalsNum 2 arg_tys
+
+    rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars)
+                                                   (Var dict_id)
+             | otherwise = mkSingleAltCase (Var dict_id) dict_id (DataAlt data_con)
+                                           arg_ids (varToCoreExpr the_arg_id)
+                                -- varToCoreExpr needed for equality superclass selectors
+                                --   sel a b d = case x of { MkC _ (g:a~b) _ -> CO g }
+
+dictSelRule :: Int -> Arity -> RuleFun
+-- Tries to persuade the argument to look like a constructor
+-- application, using exprIsConApp_maybe, and then selects
+-- from it
+--       sel_i t1..tk (D t1..tk op1 ... opm) = opi
+--
+dictSelRule val_index n_ty_args _ id_unf _ args
+  | (dict_arg : _) <- drop n_ty_args args
+  , Just (_, floats, _, _, con_args) <- exprIsConApp_maybe id_unf dict_arg
+  = Just (wrapFloats floats $ getNth con_args val_index)
+  | otherwise
+  = Nothing
+
+{-
+************************************************************************
+*                                                                      *
+        Data constructors
+*                                                                      *
+************************************************************************
+-}
+
+mkDataConWorkId :: Name -> DataCon -> Id
+mkDataConWorkId wkr_name data_con
+  | isNewTyCon tycon
+  = mkGlobalId (DataConWrapId data_con) wkr_name wkr_ty nt_work_info
+      -- See Note [Newtype workers]
+
+  | otherwise
+  = mkGlobalId (DataConWorkId data_con) wkr_name wkr_ty alg_wkr_info
+
+  where
+    tycon  = dataConTyCon data_con  -- The representation TyCon
+    wkr_ty = dataConRepType data_con
+
+        ----------- Workers for data types --------------
+    alg_wkr_info = noCafIdInfo
+                   `setArityInfo`          wkr_arity
+                   `setStrictnessInfo`     wkr_sig
+                   `setCprInfo`            mkCprSig wkr_arity (dataConCPR data_con)
+                   `setUnfoldingInfo`      evaldUnfolding  -- Record that it's evaluated,
+                                                           -- even if arity = 0
+                   `setLevityInfoWithType` wkr_ty
+                     -- NB: unboxed tuples have workers, so we can't use
+                     -- setNeverLevPoly
+
+    wkr_arity = dataConRepArity data_con
+    wkr_sig   = mkClosedStrictSig (replicate wkr_arity topDmd) topDiv
+        --      Note [Data-con worker strictness]
+        -- Notice that we do *not* say the worker Id is strict
+        -- even if the data constructor is declared strict
+        --      e.g.    data T = MkT !(Int,Int)
+        -- Why?  Because the *wrapper* $WMkT is strict (and its unfolding has
+        -- case expressions that do the evals) but the *worker* MkT itself is
+        --  not. If we pretend it is strict then when we see
+        --      case x of y -> MkT y
+        -- the simplifier thinks that y is "sure to be evaluated" (because
+        -- the worker MkT is strict) and drops the case.  No, the workerId
+        -- MkT is not strict.
+        --
+        -- However, the worker does have StrictnessMarks.  When the simplifier
+        -- sees a pattern
+        --      case e of MkT x -> ...
+        -- it uses the dataConRepStrictness of MkT to mark x as evaluated;
+        -- but that's fine... dataConRepStrictness comes from the data con
+        -- not from the worker Id.
+
+        ----------- Workers for newtypes --------------
+    univ_tvs = dataConUnivTyVars data_con
+    arg_tys  = dataConRepArgTys  data_con  -- Should be same as dataConOrigArgTys
+    nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
+                  `setArityInfo` 1      -- Arity 1
+                  `setInlinePragInfo`     alwaysInlinePragma
+                  `setUnfoldingInfo`      newtype_unf
+                  `setLevityInfoWithType` wkr_ty
+    id_arg1      = mkTemplateLocal 1 (head arg_tys)
+    res_ty_args  = mkTyCoVarTys univ_tvs
+    newtype_unf  = ASSERT2( isVanillaDataCon data_con &&
+                            isSingleton arg_tys
+                          , ppr data_con  )
+                              -- Note [Newtype datacons]
+                   mkCompulsoryUnfolding $
+                   mkLams univ_tvs $ Lam id_arg1 $
+                   wrapNewTypeBody tycon res_ty_args (Var id_arg1)
+
+dataConCPR :: DataCon -> CprResult
+dataConCPR con
+  | isDataTyCon tycon     -- Real data types only; that is,
+                          -- not unboxed tuples or newtypes
+  , null (dataConExTyCoVars con)  -- No existentials
+  , wkr_arity > 0
+  , wkr_arity <= mAX_CPR_SIZE
+  = conCpr (dataConTag con)
+  | otherwise
+  = topCpr
+  where
+    tycon     = dataConTyCon con
+    wkr_arity = dataConRepArity con
+
+    mAX_CPR_SIZE :: Arity
+    mAX_CPR_SIZE = 10
+    -- We do not treat very big tuples as CPR-ish:
+    --      a) for a start we get into trouble because there aren't
+    --         "enough" unboxed tuple types (a tiresome restriction,
+    --         but hard to fix),
+    --      b) more importantly, big unboxed tuples get returned mainly
+    --         on the stack, and are often then allocated in the heap
+    --         by the caller.  So doing CPR for them may in fact make
+    --         things worse.
+
+{-
+-------------------------------------------------
+--         Data constructor representation
+--
+-- This is where we decide how to wrap/unwrap the
+-- constructor fields
+--
+--------------------------------------------------
+-}
+
+type Unboxer = Var -> UniqSM ([Var], CoreExpr -> CoreExpr)
+  -- Unbox: bind rep vars by decomposing src var
+
+data Boxer = UnitBox | Boxer (TCvSubst -> UniqSM ([Var], CoreExpr))
+  -- Box:   build src arg using these rep vars
+
+-- | Data Constructor Boxer
+newtype DataConBoxer = DCB ([Type] -> [Var] -> UniqSM ([Var], [CoreBind]))
+                       -- Bind these src-level vars, returning the
+                       -- rep-level vars to bind in the pattern
+
+vanillaDataConBoxer :: DataConBoxer
+-- No transformation on arguments needed
+vanillaDataConBoxer = DCB (\_tys args -> return (args, []))
+
+{-
+Note [Inline partially-applied constructor wrappers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We allow the wrapper to inline when partially applied to avoid
+boxing values unnecessarily. For example, consider
+
+   data Foo a = Foo !Int a
+
+   instance Traversable Foo where
+     traverse f (Foo i a) = Foo i <$> f a
+
+This desugars to
+
+   traverse f foo = case foo of
+        Foo i# a -> let i = I# i#
+                    in map ($WFoo i) (f a)
+
+If the wrapper `$WFoo` is not inlined, we get a fruitless reboxing of `i`.
+But if we inline the wrapper, we get
+
+   map (\a. case i of I# i# a -> Foo i# a) (f a)
+
+and now case-of-known-constructor eliminates the redundant allocation.
+
+-}
+
+mkDataConRep :: DynFlags
+             -> FamInstEnvs
+             -> Name
+             -> Maybe [HsImplBang]
+                -- See Note [Bangs on imported data constructors]
+             -> DataCon
+             -> UniqSM DataConRep
+mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
+  | not wrapper_reqd
+  = return NoDataConRep
+
+  | otherwise
+  = do { wrap_args <- mapM newLocal wrap_arg_tys
+       ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers)
+                                 initial_wrap_app
+
+       ; let wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty wrap_info
+             wrap_info = noCafIdInfo
+                         `setArityInfo`         wrap_arity
+                             -- It's important to specify the arity, so that partial
+                             -- applications are treated as values
+                         `setInlinePragInfo`    wrap_prag
+                         `setUnfoldingInfo`     wrap_unf
+                         `setStrictnessInfo`    wrap_sig
+                         `setCprInfo`           mkCprSig wrap_arity (dataConCPR data_con)
+                             -- We need to get the CAF info right here because GHC.Iface.Tidy
+                             -- does not tidy the IdInfo of implicit bindings (like the wrapper)
+                             -- so it not make sure that the CAF info is sane
+                         `setLevityInfoWithType` wrap_ty
+
+             wrap_sig = mkClosedStrictSig wrap_arg_dmds topDiv
+
+             wrap_arg_dmds =
+               replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
+               -- Don't forget the dictionary arguments when building
+               -- the strictness signature (#14290).
+
+             mk_dmd str | isBanged str = evalDmd
+                        | otherwise    = topDmd
+
+             wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`
+                         activeDuringFinal
+                         -- See Note [Activation for data constructor wrappers]
+
+             -- The wrapper will usually be inlined (see wrap_unf), so its
+             -- strictness and CPR info is usually irrelevant. But this is
+             -- not always the case; GHC may choose not to inline it. In
+             -- particular, the wrapper constructor is not inlined inside
+             -- an INLINE rhs or when it is not applied to any arguments.
+             -- See Note [Inline partially-applied constructor wrappers]
+             -- Passing Nothing here allows the wrapper to inline when
+             -- unsaturated.
+             wrap_unf | isNewTyCon tycon = mkCompulsoryUnfolding wrap_rhs
+                        -- See Note [Compulsory newtype unfolding]
+                      | otherwise        = mkInlineUnfolding wrap_rhs
+             wrap_rhs = mkLams wrap_tvs $
+                        mkLams wrap_args $
+                        wrapFamInstBody tycon res_ty_args $
+                        wrap_body
+
+       ; return (DCR { dcr_wrap_id = wrap_id
+                     , dcr_boxer   = mk_boxer boxers
+                     , dcr_arg_tys = rep_tys
+                     , dcr_stricts = rep_strs
+                       -- For newtypes, dcr_bangs is always [HsLazy].
+                       -- See Note [HsImplBangs for newtypes].
+                     , dcr_bangs   = arg_ibangs }) }
+
+  where
+    (univ_tvs, ex_tvs, eq_spec, theta, orig_arg_tys, _orig_res_ty)
+      = dataConFullSig data_con
+    wrap_tvs     = dataConUserTyVars data_con
+    res_ty_args  = substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec)) univ_tvs
+
+    tycon        = dataConTyCon data_con       -- The representation TyCon (not family)
+    wrap_ty      = dataConUserType data_con
+    ev_tys       = eqSpecPreds eq_spec ++ theta
+    all_arg_tys  = ev_tys ++ orig_arg_tys
+    ev_ibangs    = map (const HsLazy) ev_tys
+    orig_bangs   = dataConSrcBangs data_con
+
+    wrap_arg_tys = theta ++ orig_arg_tys
+    wrap_arity   = count isCoVar ex_tvs + length wrap_arg_tys
+             -- The wrap_args are the arguments *other than* the eq_spec
+             -- Because we are going to apply the eq_spec args manually in the
+             -- wrapper
+
+    new_tycon = isNewTyCon tycon
+    arg_ibangs
+      | new_tycon
+      = ASSERT( isSingleton orig_arg_tys )
+        [HsLazy] -- See Note [HsImplBangs for newtypes]
+      | otherwise
+      = case mb_bangs of
+          Nothing    -> zipWith (dataConSrcToImplBang dflags fam_envs)
+                                orig_arg_tys orig_bangs
+          Just bangs -> bangs
+
+    (rep_tys_w_strs, wrappers)
+      = unzip (zipWith dataConArgRep all_arg_tys (ev_ibangs ++ arg_ibangs))
+
+    (unboxers, boxers) = unzip wrappers
+    (rep_tys, rep_strs) = unzip (concat rep_tys_w_strs)
+
+    wrapper_reqd =
+        (not new_tycon
+                     -- (Most) newtypes have only a worker, with the exception
+                     -- of some newtypes written with GADT syntax. See below.
+         && (any isBanged (ev_ibangs ++ arg_ibangs)
+                     -- Some forcing/unboxing (includes eq_spec)
+             || (not $ null eq_spec))) -- GADT
+      || isFamInstTyCon tycon -- Cast result
+      || dataConUserTyVarsArePermuted data_con
+                     -- If the data type was written with GADT syntax and
+                     -- orders the type variables differently from what the
+                     -- worker expects, it needs a data con wrapper to reorder
+                     -- the type variables.
+                     -- See Note [Data con wrappers and GADT syntax].
+
+    initial_wrap_app = Var (dataConWorkId data_con)
+                       `mkTyApps`  res_ty_args
+                       `mkVarApps` ex_tvs
+                       `mkCoApps`  map (mkReflCo Nominal . eqSpecType) eq_spec
+
+    mk_boxer :: [Boxer] -> DataConBoxer
+    mk_boxer boxers = DCB (\ ty_args src_vars ->
+                      do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars
+                               subst1 = zipTvSubst univ_tvs ty_args
+                               subst2 = extendTCvSubstList subst1 ex_tvs
+                                                           (mkTyCoVarTys ex_vars)
+                         ; (rep_ids, binds) <- go subst2 boxers term_vars
+                         ; return (ex_vars ++ rep_ids, binds) } )
+
+    go _ [] src_vars = ASSERT2( null src_vars, ppr data_con ) return ([], [])
+    go subst (UnitBox : boxers) (src_var : src_vars)
+      = do { (rep_ids2, binds) <- go subst boxers src_vars
+           ; return (src_var : rep_ids2, binds) }
+    go subst (Boxer boxer : boxers) (src_var : src_vars)
+      = do { (rep_ids1, arg)  <- boxer subst
+           ; (rep_ids2, binds) <- go subst boxers src_vars
+           ; return (rep_ids1 ++ rep_ids2, NonRec src_var arg : binds) }
+    go _ (_:_) [] = pprPanic "mk_boxer" (ppr data_con)
+
+    mk_rep_app :: [(Id,Unboxer)] -> CoreExpr -> UniqSM CoreExpr
+    mk_rep_app [] con_app
+      = return con_app
+    mk_rep_app ((wrap_arg, unboxer) : prs) con_app
+      = do { (rep_ids, unbox_fn) <- unboxer wrap_arg
+           ; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
+           ; return (unbox_fn expr) }
+
+{- Note [Activation for data constructor wrappers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The Activation on a data constructor wrapper allows it to inline only in Phase
+0. This way rules have a chance to fire if they mention a data constructor on
+the left
+   RULE "foo"  f (K a b) = ...
+Since the LHS of rules are simplified with InitialPhase, we won't
+inline the wrapper on the LHS either.
+
+On the other hand, this means that exprIsConApp_maybe must be able to deal
+with wrappers so that case-of-constructor is not delayed; see
+Note [exprIsConApp_maybe on data constructors with wrappers] for details.
+
+It used to activate in phases 2 (afterInitial) and later, but it makes it
+awkward to write a RULE[1] with a constructor on the left: it would work if a
+constructor has no wrapper, but whether a constructor has a wrapper depends, for
+instance, on the order of type argument of that constructors. Therefore changing
+the order of type argument could make previously working RULEs fail.
+
+See also https://gitlab.haskell.org/ghc/ghc/issues/15840 .
+
+
+Note [Bangs on imported data constructors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We pass Maybe [HsImplBang] to mkDataConRep to make use of HsImplBangs
+from imported modules.
+
+- Nothing <=> use HsSrcBangs
+- Just bangs <=> use HsImplBangs
+
+For imported types we can't work it all out from the HsSrcBangs,
+because we want to be very sure to follow what the original module
+(where the data type was declared) decided, and that depends on what
+flags were enabled when it was compiled. So we record the decisions in
+the interface file.
+
+The HsImplBangs passed are in 1-1 correspondence with the
+dataConOrigArgTys of the DataCon.
+
+Note [Data con wrappers and unlifted types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+   data T = MkT !Int#
+
+We certainly do not want to make a wrapper
+   $WMkT x = case x of y { DEFAULT -> MkT y }
+
+For a start, it's still to generate a no-op.  But worse, since wrappers
+are currently injected at TidyCore, we don't even optimise it away!
+So the stupid case expression stays there.  This actually happened for
+the Integer data type (see #1600 comment:66)!
+
+Note [Data con wrappers and GADT syntax]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider these two very similar data types:
+
+  data T1 a b = MkT1 b
+
+  data T2 a b where
+    MkT2 :: forall b a. b -> T2 a b
+
+Despite their similar appearance, T2 will have a data con wrapper but T1 will
+not. What sets them apart? The types of their constructors, which are:
+
+  MkT1 :: forall a b. b -> T1 a b
+  MkT2 :: forall b a. b -> T2 a b
+
+MkT2's use of GADT syntax allows it to permute the order in which `a` and `b`
+would normally appear. See Note [DataCon user type variable binders] in GHC.Core.DataCon
+for further discussion on this topic.
+
+The worker data cons for T1 and T2, however, both have types such that `a` is
+expected to come before `b` as arguments. Because MkT2 permutes this order, it
+needs a data con wrapper to swizzle around the type variables to be in the
+order the worker expects.
+
+A somewhat surprising consequence of this is that *newtypes* can have data con
+wrappers! After all, a newtype can also be written with GADT syntax:
+
+  newtype T3 a b where
+    MkT3 :: forall b a. b -> T3 a b
+
+Again, this needs a wrapper data con to reorder the type variables. It does
+mean that this newtype constructor requires another level of indirection when
+being called, but the inliner should make swift work of that.
+
+Note [HsImplBangs for newtypes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Most of the time, we use the dataConSrctoImplBang function to decide what
+strictness/unpackedness to use for the fields of a data type constructor. But
+there is an exception to this rule: newtype constructors. You might not think
+that newtypes would pose a challenge, since newtypes are seemingly forbidden
+from having strictness annotations in the first place. But consider this
+(from #16141):
+
+  {-# LANGUAGE StrictData #-}
+  {-# OPTIONS_GHC -O #-}
+  newtype T a b where
+    MkT :: forall b a. Int -> T a b
+
+Because StrictData (plus optimization) is enabled, invoking
+dataConSrcToImplBang would sneak in and unpack the field of type Int to Int#!
+This would be disastrous, since the wrapper for `MkT` uses a coercion involving
+Int, not Int#.
+
+Bottom line: dataConSrcToImplBang should never be invoked for newtypes. In the
+case of a newtype constructor, we simply hardcode its dcr_bangs field to
+[HsLazy].
+-}
+
+-------------------------
+newLocal :: Type -> UniqSM Var
+newLocal ty = do { uniq <- getUniqueM
+                 ; return (mkSysLocalOrCoVar (fsLit "dt") uniq ty) }
+                 -- We should not have "OrCoVar" here, this is a bug (#17545)
+
+
+-- | Unpack/Strictness decisions from source module.
+--
+-- This function should only ever be invoked for data constructor fields, and
+-- never on the field of a newtype constructor.
+-- See @Note [HsImplBangs for newtypes]@.
+dataConSrcToImplBang
+   :: DynFlags
+   -> FamInstEnvs
+   -> Type
+   -> HsSrcBang
+   -> HsImplBang
+
+dataConSrcToImplBang dflags fam_envs arg_ty
+                     (HsSrcBang ann unpk NoSrcStrict)
+  | xopt LangExt.StrictData dflags -- StrictData => strict field
+  = dataConSrcToImplBang dflags fam_envs arg_ty
+                  (HsSrcBang ann unpk SrcStrict)
+  | otherwise -- no StrictData => lazy field
+  = HsLazy
+
+dataConSrcToImplBang _ _ _ (HsSrcBang _ _ SrcLazy)
+  = HsLazy
+
+dataConSrcToImplBang dflags fam_envs arg_ty
+                     (HsSrcBang _ unpk_prag SrcStrict)
+  | isUnliftedType arg_ty
+  = HsLazy  -- For !Int#, say, use HsLazy
+            -- See Note [Data con wrappers and unlifted types]
+
+  | not (gopt Opt_OmitInterfacePragmas dflags) -- Don't unpack if -fomit-iface-pragmas
+          -- Don't unpack if we aren't optimising; rather arbitrarily,
+          -- we use -fomit-iface-pragmas as the indication
+  , let mb_co   = topNormaliseType_maybe fam_envs arg_ty
+                     -- Unwrap type families and newtypes
+        arg_ty' = case mb_co of { Just (_,ty) -> ty; Nothing -> arg_ty }
+  , isUnpackableType dflags fam_envs arg_ty'
+  , (rep_tys, _) <- dataConArgUnpack arg_ty'
+  , case unpk_prag of
+      NoSrcUnpack ->
+        gopt Opt_UnboxStrictFields dflags
+            || (gopt Opt_UnboxSmallStrictFields dflags
+                && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields]
+      srcUnpack -> isSrcUnpacked srcUnpack
+  = case mb_co of
+      Nothing     -> HsUnpack Nothing
+      Just (co,_) -> HsUnpack (Just co)
+
+  | otherwise -- Record the strict-but-no-unpack decision
+  = HsStrict
+
+
+-- | Wrappers/Workers and representation following Unpack/Strictness
+-- decisions
+dataConArgRep
+  :: Type
+  -> HsImplBang
+  -> ([(Type,StrictnessMark)] -- Rep types
+     ,(Unboxer,Boxer))
+
+dataConArgRep arg_ty HsLazy
+  = ([(arg_ty, NotMarkedStrict)], (unitUnboxer, unitBoxer))
+
+dataConArgRep arg_ty HsStrict
+  = ([(arg_ty, MarkedStrict)], (seqUnboxer, unitBoxer))
+
+dataConArgRep arg_ty (HsUnpack Nothing)
+  | (rep_tys, wrappers) <- dataConArgUnpack arg_ty
+  = (rep_tys, wrappers)
+
+dataConArgRep _ (HsUnpack (Just co))
+  | let co_rep_ty = coercionRKind co
+  , (rep_tys, wrappers) <- dataConArgUnpack co_rep_ty
+  = (rep_tys, wrapCo co co_rep_ty wrappers)
+
+
+-------------------------
+wrapCo :: Coercion -> Type -> (Unboxer, Boxer) -> (Unboxer, Boxer)
+wrapCo co rep_ty (unbox_rep, box_rep)  -- co :: arg_ty ~ rep_ty
+  = (unboxer, boxer)
+  where
+    unboxer arg_id = do { rep_id <- newLocal rep_ty
+                        ; (rep_ids, rep_fn) <- unbox_rep rep_id
+                        ; let co_bind = NonRec rep_id (Var arg_id `Cast` co)
+                        ; return (rep_ids, Let co_bind . rep_fn) }
+    boxer = Boxer $ \ subst ->
+            do { (rep_ids, rep_expr)
+                    <- case box_rep of
+                         UnitBox -> do { rep_id <- newLocal (TcType.substTy subst rep_ty)
+                                       ; return ([rep_id], Var rep_id) }
+                         Boxer boxer -> boxer subst
+               ; let sco = substCoUnchecked subst co
+               ; return (rep_ids, rep_expr `Cast` mkSymCo sco) }
+
+------------------------
+seqUnboxer :: Unboxer
+seqUnboxer v = return ([v], mkDefaultCase (Var v) v)
+
+unitUnboxer :: Unboxer
+unitUnboxer v = return ([v], \e -> e)
+
+unitBoxer :: Boxer
+unitBoxer = UnitBox
+
+-------------------------
+dataConArgUnpack
+   :: Type
+   ->  ( [(Type, StrictnessMark)]   -- Rep types
+       , (Unboxer, Boxer) )
+
+dataConArgUnpack arg_ty
+  | Just (tc, tc_args) <- splitTyConApp_maybe arg_ty
+  , Just con <- tyConSingleAlgDataCon_maybe tc
+      -- NB: check for an *algebraic* data type
+      -- A recursive newtype might mean that
+      -- 'arg_ty' is a newtype
+  , let rep_tys = dataConInstArgTys con tc_args
+  = ASSERT( null (dataConExTyCoVars con) )
+      -- Note [Unpacking GADTs and existentials]
+    ( rep_tys `zip` dataConRepStrictness con
+    ,( \ arg_id ->
+       do { rep_ids <- mapM newLocal rep_tys
+          ; let unbox_fn body
+                  = mkSingleAltCase (Var arg_id) arg_id
+                             (DataAlt con) rep_ids body
+          ; return (rep_ids, unbox_fn) }
+     , Boxer $ \ subst ->
+       do { rep_ids <- mapM (newLocal . TcType.substTyUnchecked subst) rep_tys
+          ; return (rep_ids, Var (dataConWorkId con)
+                             `mkTyApps` (substTysUnchecked subst tc_args)
+                             `mkVarApps` rep_ids ) } ) )
+  | otherwise
+  = pprPanic "dataConArgUnpack" (ppr arg_ty)
+    -- An interface file specified Unpacked, but we couldn't unpack it
+
+isUnpackableType :: DynFlags -> FamInstEnvs -> Type -> Bool
+-- True if we can unpack the UNPACK the argument type
+-- See Note [Recursive unboxing]
+-- We look "deeply" inside rather than relying on the DataCons
+-- we encounter on the way, because otherwise we might well
+-- end up relying on ourselves!
+isUnpackableType dflags fam_envs ty
+  | Just data_con <- unpackable_type ty
+  = ok_con_args emptyNameSet data_con
+  | otherwise
+  = False
+  where
+    ok_con_args dcs con
+       | dc_name `elemNameSet` dcs
+       = False
+       | otherwise
+       = all (ok_arg dcs')
+             (dataConOrigArgTys con `zip` dataConSrcBangs con)
+          -- NB: dataConSrcBangs gives the *user* request;
+          -- We'd get a black hole if we used dataConImplBangs
+       where
+         dc_name = getName con
+         dcs' = dcs `extendNameSet` dc_name
+
+    ok_arg dcs (ty, bang)
+      = not (attempt_unpack bang) || ok_ty dcs norm_ty
+      where
+        norm_ty = topNormaliseType fam_envs ty
+
+    ok_ty dcs ty
+      | Just data_con <- unpackable_type ty
+      = ok_con_args dcs data_con
+      | otherwise
+      = True        -- NB True here, in contrast to False at top level
+
+    attempt_unpack (HsSrcBang _ SrcUnpack NoSrcStrict)
+      = xopt LangExt.StrictData dflags
+    attempt_unpack (HsSrcBang _ SrcUnpack SrcStrict)
+      = True
+    attempt_unpack (HsSrcBang _  NoSrcUnpack SrcStrict)
+      = True  -- Be conservative
+    attempt_unpack (HsSrcBang _  NoSrcUnpack NoSrcStrict)
+      = xopt LangExt.StrictData dflags -- Be conservative
+    attempt_unpack _ = False
+
+    unpackable_type :: Type -> Maybe DataCon
+    -- Works just on a single level
+    unpackable_type ty
+      | Just (tc, _) <- splitTyConApp_maybe ty
+      , Just data_con <- tyConSingleAlgDataCon_maybe tc
+      , null (dataConExTyCoVars data_con)
+          -- See Note [Unpacking GADTs and existentials]
+      = Just data_con
+      | otherwise
+      = Nothing
+
+{-
+Note [Unpacking GADTs and existentials]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There is nothing stopping us unpacking a data type with equality
+components, like
+  data Equal a b where
+    Equal :: Equal a a
+
+And it'd be fine to unpack a product type with existential components
+too, but that would require a bit more plumbing, so currently we don't.
+
+So for now we require: null (dataConExTyCoVars data_con)
+See #14978
+
+Note [Unpack one-wide fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The flag UnboxSmallStrictFields ensures that any field that can
+(safely) be unboxed to a word-sized unboxed field, should be so unboxed.
+For example:
+
+    data A = A Int#
+    newtype B = B A
+    data C = C !B
+    data D = D !C
+    data E = E !()
+    data F = F !D
+    data G = G !F !F
+
+All of these should have an Int# as their representation, except
+G which should have two Int#s.
+
+However
+
+    data T = T !(S Int)
+    data S = S !a
+
+Here we can represent T with an Int#.
+
+Note [Recursive unboxing]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+  data R = MkR {-# UNPACK #-} !S Int
+  data S = MkS {-# UNPACK #-} !Int
+The representation arguments of MkR are the *representation* arguments
+of S (plus Int); the rep args of MkS are Int#.  This is all fine.
+
+But be careful not to try to unbox this!
+        data T = MkT {-# UNPACK #-} !T Int
+Because then we'd get an infinite number of arguments.
+
+Here is a more complicated case:
+        data S = MkS {-# UNPACK #-} !T Int
+        data T = MkT {-# UNPACK #-} !S Int
+Each of S and T must decide independently whether to unpack
+and they had better not both say yes. So they must both say no.
+
+Also behave conservatively when there is no UNPACK pragma
+        data T = MkS !T Int
+with -funbox-strict-fields or -funbox-small-strict-fields
+we need to behave as if there was an UNPACK pragma there.
+
+But it's the *argument* type that matters. This is fine:
+        data S = MkS S !Int
+because Int is non-recursive.
+
+************************************************************************
+*                                                                      *
+        Wrapping and unwrapping newtypes and type families
+*                                                                      *
+************************************************************************
+-}
+
+wrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
+-- The wrapper for the data constructor for a newtype looks like this:
+--      newtype T a = MkT (a,Int)
+--      MkT :: forall a. (a,Int) -> T a
+--      MkT = /\a. \(x:(a,Int)). x `cast` sym (CoT a)
+-- where CoT is the coercion TyCon associated with the newtype
+--
+-- The call (wrapNewTypeBody T [a] e) returns the
+-- body of the wrapper, namely
+--      e `cast` (CoT [a])
+--
+-- If a coercion constructor is provided in the newtype, then we use
+-- it, otherwise the wrap/unwrap are both no-ops
+
+wrapNewTypeBody tycon args result_expr
+  = ASSERT( isNewTyCon tycon )
+    mkCast result_expr (mkSymCo co)
+  where
+    co = mkUnbranchedAxInstCo Representational (newTyConCo tycon) args []
+
+-- When unwrapping, we do *not* apply any family coercion, because this will
+-- be done via a CoPat by the type checker.  We have to do it this way as
+-- computing the right type arguments for the coercion requires more than just
+-- a splitting operation (cf, TcPat.tcConPat).
+
+unwrapNewTypeBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
+unwrapNewTypeBody tycon args result_expr
+  = ASSERT( isNewTyCon tycon )
+    mkCast result_expr (mkUnbranchedAxInstCo Representational (newTyConCo tycon) args [])
+
+-- If the type constructor is a representation type of a data instance, wrap
+-- the expression into a cast adjusting the expression type, which is an
+-- instance of the representation type, to the corresponding instance of the
+-- family instance type.
+-- See Note [Wrappers for data instance tycons]
+wrapFamInstBody :: TyCon -> [Type] -> CoreExpr -> CoreExpr
+wrapFamInstBody tycon args body
+  | Just co_con <- tyConFamilyCoercion_maybe tycon
+  = mkCast body (mkSymCo (mkUnbranchedAxInstCo Representational co_con args []))
+  | otherwise
+  = body
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Primitive operations}
+*                                                                      *
+************************************************************************
+-}
+
+mkPrimOpId :: PrimOp -> Id
+mkPrimOpId prim_op
+  = id
+  where
+    (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
+    ty   = mkSpecForAllTys tyvars (mkVisFunTys arg_tys res_ty)
+    name = mkWiredInName gHC_PRIM (primOpOcc prim_op)
+                         (mkPrimOpIdUnique (primOpTag prim_op))
+                         (AnId id) UserSyntax
+    id   = mkGlobalId (PrimOpId prim_op) name ty info
+
+    -- PrimOps don't ever construct a product, but we want to preserve bottoms
+    cpr
+      | isBotDiv (snd (splitStrictSig strict_sig)) = botCpr
+      | otherwise                                  = topCpr
+
+    info = noCafIdInfo
+           `setRuleInfo`           mkRuleInfo (maybeToList $ primOpRules name prim_op)
+           `setArityInfo`          arity
+           `setStrictnessInfo`     strict_sig
+           `setCprInfo`            mkCprSig arity cpr
+           `setInlinePragInfo`     neverInlinePragma
+           `setLevityInfoWithType` res_ty
+               -- We give PrimOps a NOINLINE pragma so that we don't
+               -- get silly warnings from Desugar.dsRule (the inline_shadows_rule
+               -- test) about a RULE conflicting with a possible inlining
+               -- cf #7287
+
+-- For each ccall we manufacture a separate CCallOpId, giving it
+-- a fresh unique, a type that is correct for this particular ccall,
+-- and a CCall structure that gives the correct details about calling
+-- convention etc.
+--
+-- The *name* of this Id is a local name whose OccName gives the full
+-- details of the ccall, type and all.  This means that the interface
+-- file reader can reconstruct a suitable Id
+
+mkFCallId :: DynFlags -> Unique -> ForeignCall -> Type -> Id
+mkFCallId dflags uniq fcall ty
+  = ASSERT( noFreeVarsOfType ty )
+    -- A CCallOpId should have no free type variables;
+    -- when doing substitutions won't substitute over it
+    mkGlobalId (FCallId fcall) name ty info
+  where
+    occ_str = showSDoc dflags (braces (ppr fcall <+> ppr ty))
+    -- The "occurrence name" of a ccall is the full info about the
+    -- ccall; it is encoded, but may have embedded spaces etc!
+
+    name = mkFCallName uniq occ_str
+
+    info = noCafIdInfo
+           `setArityInfo`          arity
+           `setStrictnessInfo`     strict_sig
+           `setCprInfo`            topCprSig
+           `setLevityInfoWithType` ty
+
+    (bndrs, _) = tcSplitPiTys ty
+    arity      = count isAnonTyCoBinder bndrs
+    strict_sig = mkClosedStrictSig (replicate arity topDmd) topDiv
+    -- the call does not claim to be strict in its arguments, since they
+    -- may be lifted (foreign import prim) and the called code doesn't
+    -- necessarily force them. See #11076.
+{-
+************************************************************************
+*                                                                      *
+\subsection{DictFuns and default methods}
+*                                                                      *
+************************************************************************
+
+Note [Dict funs and default methods]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Dict funs and default methods are *not* ImplicitIds.  Their definition
+involves user-written code, so we can't figure out their strictness etc
+based on fixed info, as we can for constructors and record selectors (say).
+
+NB: See also Note [Exported LocalIds] in GHC.Types.Id
+-}
+
+mkDictFunId :: Name      -- Name to use for the dict fun;
+            -> [TyVar]
+            -> ThetaType
+            -> Class
+            -> [Type]
+            -> Id
+-- Implements the DFun Superclass Invariant (see TcInstDcls)
+-- See Note [Dict funs and default methods]
+
+mkDictFunId dfun_name tvs theta clas tys
+  = mkExportedLocalId (DFunId is_nt)
+                      dfun_name
+                      dfun_ty
+  where
+    is_nt = isNewTyCon (classTyCon clas)
+    dfun_ty = mkDictFunTy tvs theta clas tys
+
+mkDictFunTy :: [TyVar] -> ThetaType -> Class -> [Type] -> Type
+mkDictFunTy tvs theta clas tys
+ = mkSpecSigmaTy tvs theta (mkClassPred clas tys)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Un-definable}
+*                                                                      *
+************************************************************************
+
+These Ids can't be defined in Haskell.  They could be defined in
+unfoldings in the wired-in GHC.Prim interface file, but we'd have to
+ensure that they were definitely, definitely inlined, because there is
+no curried identifier for them.  That's what mkCompulsoryUnfolding
+does.  If we had a way to get a compulsory unfolding from an interface
+file, we could do that, but we don't right now.
+
+The type variables we use here are "open" type variables: this means
+they can unify with both unlifted and lifted types.  Hence we provide
+another gun with which to shoot yourself in the foot.
+-}
+
+nullAddrName, seqName,
+   realWorldName, voidPrimIdName, coercionTokenName,
+   magicDictName, coerceName, proxyName :: Name
+nullAddrName      = mkWiredInIdName gHC_PRIM  (fsLit "nullAddr#")      nullAddrIdKey      nullAddrId
+seqName           = mkWiredInIdName gHC_PRIM  (fsLit "seq")            seqIdKey           seqId
+realWorldName     = mkWiredInIdName gHC_PRIM  (fsLit "realWorld#")     realWorldPrimIdKey realWorldPrimId
+voidPrimIdName    = mkWiredInIdName gHC_PRIM  (fsLit "void#")          voidPrimIdKey      voidPrimId
+coercionTokenName = mkWiredInIdName gHC_PRIM  (fsLit "coercionToken#") coercionTokenIdKey coercionTokenId
+magicDictName     = mkWiredInIdName gHC_PRIM  (fsLit "magicDict")      magicDictKey       magicDictId
+coerceName        = mkWiredInIdName gHC_PRIM  (fsLit "coerce")         coerceKey          coerceId
+proxyName         = mkWiredInIdName gHC_PRIM  (fsLit "proxy#")         proxyHashKey       proxyHashId
+
+lazyIdName, oneShotName, noinlineIdName :: Name
+lazyIdName        = mkWiredInIdName gHC_MAGIC (fsLit "lazy")           lazyIdKey          lazyId
+oneShotName       = mkWiredInIdName gHC_MAGIC (fsLit "oneShot")        oneShotKey         oneShotId
+noinlineIdName    = mkWiredInIdName gHC_MAGIC (fsLit "noinline")       noinlineIdKey      noinlineId
+
+------------------------------------------------
+proxyHashId :: Id
+proxyHashId
+  = pcMiscPrelId proxyName ty
+       (noCafIdInfo `setUnfoldingInfo` evaldUnfolding -- Note [evaldUnfoldings]
+                    `setNeverLevPoly`  ty )
+  where
+    -- proxy# :: forall {k} (a:k). Proxy# k a
+    --
+    -- The visibility of the `k` binder is Inferred to match the type of the
+    -- Proxy data constructor (#16293).
+    [kv,tv] = mkTemplateKiTyVars [liftedTypeKind] id
+    kv_ty   = mkTyVarTy kv
+    tv_ty   = mkTyVarTy tv
+    ty      = mkInvForAllTy kv $ mkSpecForAllTy tv $ mkProxyPrimTy kv_ty tv_ty
+
+------------------------------------------------
+nullAddrId :: Id
+-- nullAddr# :: Addr#
+-- The reason it is here is because we don't provide
+-- a way to write this literal in Haskell.
+nullAddrId = pcMiscPrelId nullAddrName addrPrimTy info
+  where
+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding (Lit nullAddrLit)
+                       `setNeverLevPoly`   addrPrimTy
+
+------------------------------------------------
+seqId :: Id     -- See Note [seqId magic]
+seqId = pcMiscPrelId seqName ty info
+  where
+    info = noCafIdInfo `setInlinePragInfo` inline_prag
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
+
+    inline_prag
+         = alwaysInlinePragma `setInlinePragmaActivation` ActiveAfter
+                 NoSourceText 0
+                  -- Make 'seq' not inline-always, so that simpleOptExpr
+                  -- (see GHC.Core.Subst.simple_app) won't inline 'seq' on the
+                  -- LHS of rules.  That way we can have rules for 'seq';
+                  -- see Note [seqId magic]
+
+    -- seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b
+    ty  =
+      mkInvForAllTy runtimeRep2TyVar
+      $ mkSpecForAllTys [alphaTyVar, openBetaTyVar]
+      $ mkVisFunTy alphaTy (mkVisFunTy openBetaTy openBetaTy)
+
+    [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
+    rhs = mkLams ([runtimeRep2TyVar, alphaTyVar, openBetaTyVar, x, y]) $
+          Case (Var x) x openBetaTy [(DEFAULT, [], Var y)]
+
+------------------------------------------------
+lazyId :: Id    -- See Note [lazyId magic]
+lazyId = pcMiscPrelId lazyIdName ty info
+  where
+    info = noCafIdInfo `setNeverLevPoly` ty
+    ty  = mkSpecForAllTys [alphaTyVar] (mkVisFunTy alphaTy alphaTy)
+
+noinlineId :: Id -- See Note [noinlineId magic]
+noinlineId = pcMiscPrelId noinlineIdName ty info
+  where
+    info = noCafIdInfo `setNeverLevPoly` ty
+    ty  = mkSpecForAllTys [alphaTyVar] (mkVisFunTy alphaTy alphaTy)
+
+oneShotId :: Id -- See Note [The oneShot function]
+oneShotId = pcMiscPrelId oneShotName ty info
+  where
+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
+    ty  = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
+                          , openAlphaTyVar, openBetaTyVar ]
+                          (mkVisFunTy fun_ty fun_ty)
+    fun_ty = mkVisFunTy openAlphaTy openBetaTy
+    [body, x] = mkTemplateLocals [fun_ty, openAlphaTy]
+    x' = setOneShotLambda x  -- Here is the magic bit!
+    rhs = mkLams [ runtimeRep1TyVar, runtimeRep2TyVar
+                 , openAlphaTyVar, openBetaTyVar
+                 , body, x'] $
+          Var body `App` Var x
+
+--------------------------------------------------------------------------------
+magicDictId :: Id  -- See Note [magicDictId magic]
+magicDictId = pcMiscPrelId magicDictName ty info
+  where
+  info = noCafIdInfo `setInlinePragInfo` neverInlinePragma
+                     `setNeverLevPoly`   ty
+  ty   = mkSpecForAllTys [alphaTyVar] alphaTy
+
+--------------------------------------------------------------------------------
+
+coerceId :: Id
+coerceId = pcMiscPrelId coerceName ty info
+  where
+    info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
+                       `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
+    eqRTy     = mkTyConApp coercibleTyCon [ tYPE r , a, b ]
+    eqRPrimTy = mkTyConApp eqReprPrimTyCon [ tYPE r, tYPE r, a, b ]
+    ty        = mkForAllTys [ Bndr rv Inferred
+                            , Bndr av Specified
+                            , Bndr bv Specified
+                            ] $
+                mkInvisFunTy eqRTy $
+                mkVisFunTy a b
+
+    bndrs@[rv,av,bv] = mkTemplateKiTyVar runtimeRepTy
+                        (\r -> [tYPE r, tYPE r])
+
+    [r, a, b] = mkTyVarTys bndrs
+
+    [eqR,x,eq] = mkTemplateLocals [eqRTy, a, eqRPrimTy]
+    rhs = mkLams (bndrs ++ [eqR, x]) $
+          mkWildCase (Var eqR) eqRTy b $
+          [(DataAlt coercibleDataCon, [eq], Cast (Var x) (mkCoVarCo eq))]
+
+{-
+Note [seqId magic]
+~~~~~~~~~~~~~~~~~~
+'GHC.Prim.seq' is special in several ways.
+
+a) Its fixity is set in GHC.Iface.Load.ghcPrimIface
+
+b) It has quite a bit of desugaring magic.
+   See GHC.HsToCore.Utils.hs Note [Desugaring seq (1)] and (2) and (3)
+
+c) There is some special rule handing: Note [User-defined RULES for seq]
+
+Historical note:
+    In TcExpr we used to need a special typing rule for 'seq', to handle calls
+    whose second argument had an unboxed type, e.g.  x `seq` 3#
+
+    However, with levity polymorphism we can now give seq the type seq ::
+    forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b which handles this
+    case without special treatment in the typechecker.
+
+Note [User-defined RULES for seq]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Roman found situations where he had
+      case (f n) of _ -> e
+where he knew that f (which was strict in n) would terminate if n did.
+Notice that the result of (f n) is discarded. So it makes sense to
+transform to
+      case n of _ -> e
+
+Rather than attempt some general analysis to support this, I've added
+enough support that you can do this using a rewrite rule:
+
+  RULE "f/seq" forall n.  seq (f n) = seq n
+
+You write that rule.  When GHC sees a case expression that discards
+its result, it mentally transforms it to a call to 'seq' and looks for
+a RULE.  (This is done in GHC.Core.Op.Simplify.trySeqRules.)  As usual, the
+correctness of the rule is up to you.
+
+VERY IMPORTANT: to make this work, we give the RULE an arity of 1, not 2.
+If we wrote
+  RULE "f/seq" forall n e.  seq (f n) e = seq n e
+with rule arity 2, then two bad things would happen:
+
+  - The magical desugaring done in Note [seqId magic] item (b)
+    for saturated application of 'seq' would turn the LHS into
+    a case expression!
+
+  - The code in GHC.Core.Op.Simplify.rebuildCase would need to actually supply
+    the value argument, which turns out to be awkward.
+
+See also: Note [User-defined RULES for seq] in GHC.Core.Op.Simplify.
+
+
+Note [lazyId magic]
+~~~~~~~~~~~~~~~~~~~
+lazy :: forall a?. a? -> a?   (i.e. works for unboxed types too)
+
+'lazy' is used to make sure that a sub-expression, and its free variables,
+are truly used call-by-need, with no code motion.  Key examples:
+
+* pseq:    pseq a b = a `seq` lazy b
+  We want to make sure that the free vars of 'b' are not evaluated
+  before 'a', even though the expression is plainly strict in 'b'.
+
+* catch:   catch a b = catch# (lazy a) b
+  Again, it's clear that 'a' will be evaluated strictly (and indeed
+  applied to a state token) but we want to make sure that any exceptions
+  arising from the evaluation of 'a' are caught by the catch (see
+  #11555).
+
+Implementing 'lazy' is a bit tricky:
+
+* It must not have a strictness signature: by being a built-in Id,
+  all the info about lazyId comes from here, not from GHC.Base.hi.
+  This is important, because the strictness analyser will spot it as
+  strict!
+
+* It must not have an unfolding: it gets "inlined" by a HACK in
+  CorePrep. It's very important to do this inlining *after* unfoldings
+  are exposed in the interface file.  Otherwise, the unfolding for
+  (say) pseq in the interface file will not mention 'lazy', so if we
+  inline 'pseq' we'll totally miss the very thing that 'lazy' was
+  there for in the first place. See #3259 for a real world
+  example.
+
+* Suppose CorePrep sees (catch# (lazy e) b).  At all costs we must
+  avoid using call by value here:
+     case e of r -> catch# r b
+  Avoiding that is the whole point of 'lazy'.  So in CorePrep (which
+  generate the 'case' expression for a call-by-value call) we must
+  spot the 'lazy' on the arg (in CorePrep.cpeApp), and build a 'let'
+  instead.
+
+* lazyId is defined in GHC.Base, so we don't *have* to inline it.  If it
+  appears un-applied, we'll end up just calling it.
+
+Note [noinlineId magic]
+~~~~~~~~~~~~~~~~~~~~~~~
+noinline :: forall a. a -> a
+
+'noinline' is used to make sure that a function f is never inlined,
+e.g., as in 'noinline f x'.  Ordinarily, the identity function with NOINLINE
+could be used to achieve this effect; however, this has the unfortunate
+result of leaving a (useless) call to noinline at runtime.  So we have
+a little bit of magic to optimize away 'noinline' after we are done
+running the simplifier.
+
+'noinline' needs to be wired-in because it gets inserted automatically
+when we serialize an expression to the interface format. See
+Note [Inlining and hs-boot files] in GHC.CoreToIface
+
+Note that noinline as currently implemented can hide some simplifications since
+it hides strictness from the demand analyser. Specifically, the demand analyser
+will treat 'noinline f x' as lazy in 'x', even if the demand signature of 'f'
+specifies that it is strict in its argument. We considered fixing this this by adding a
+special case to the demand analyser to address #16588. However, the special
+case seemed like a large and expensive hammer to address a rare case and
+consequently we rather opted to use a more minimal solution.
+
+Note [The oneShot function]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In the context of making left-folds fuse somewhat okish (see ticket #7994
+and Note [Left folds via right fold]) it was determined that it would be useful
+if library authors could explicitly tell the compiler that a certain lambda is
+called at most once. The oneShot function allows that.
+
+'oneShot' is levity-polymorphic, i.e. the type variables can refer to unlifted
+types as well (#10744); e.g.
+   oneShot (\x:Int# -> x +# 1#)
+
+Like most magic functions it has a compulsory unfolding, so there is no need
+for a real definition somewhere. We have one in GHC.Magic for the convenience
+of putting the documentation there.
+
+It uses `setOneShotLambda` on the lambda's binder. That is the whole magic:
+
+A typical call looks like
+     oneShot (\y. e)
+after unfolding the definition `oneShot = \f \x[oneshot]. f x` we get
+     (\f \x[oneshot]. f x) (\y. e)
+ --> \x[oneshot]. ((\y.e) x)
+ --> \x[oneshot] e[x/y]
+which is what we want.
+
+It is only effective if the one-shot info survives as long as possible; in
+particular it must make it into the interface in unfoldings. See Note [Preserve
+OneShotInfo] in GHC.Core.Op.Tidy.
+
+Also see https://gitlab.haskell.org/ghc/ghc/wikis/one-shot.
+
+
+Note [magicDictId magic]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+The identifier `magicDict` is just a place-holder, which is used to
+implement a primitive that we cannot define in Haskell but we can write
+in Core.  It is declared with a place-holder type:
+
+    magicDict :: forall a. a
+
+The intention is that the identifier will be used in a very specific way,
+to create dictionaries for classes with a single method.  Consider a class
+like this:
+
+   class C a where
+     f :: T a
+
+We are going to use `magicDict`, in conjunction with a built-in Prelude
+rule, to cast values of type `T a` into dictionaries for `C a`.  To do
+this, we define a function like this in the library:
+
+  data WrapC a b = WrapC (C a => Proxy a -> b)
+
+  withT :: (C a => Proxy a -> b)
+        ->  T a -> Proxy a -> b
+  withT f x y = magicDict (WrapC f) x y
+
+The purpose of `WrapC` is to avoid having `f` instantiated.
+Also, it avoids impredicativity, because `magicDict`'s type
+cannot be instantiated with a forall.  The field of `WrapC` contains
+a `Proxy` parameter which is used to link the type of the constraint,
+`C a`, with the type of the `Wrap` value being made.
+
+Next, we add a built-in Prelude rule (see GHC.Core.Op.ConstantFold),
+which will replace the RHS of this definition with the appropriate
+definition in Core.  The rewrite rule works as follows:
+
+  magicDict @t (wrap @a @b f) x y
+---->
+  f (x `cast` co a) y
+
+The `co` coercion is the newtype-coercion extracted from the type-class.
+The type class is obtain by looking at the type of wrap.
+
+
+-------------------------------------------------------------
+@realWorld#@ used to be a magic literal, \tr{void#}.  If things get
+nasty as-is, change it back to a literal (@Literal@).
+
+voidArgId is a Local Id used simply as an argument in functions
+where we just want an arg to avoid having a thunk of unlifted type.
+E.g.
+        x = \ void :: Void# -> (# p, q #)
+
+This comes up in strictness analysis
+
+Note [evaldUnfoldings]
+~~~~~~~~~~~~~~~~~~~~~~
+The evaldUnfolding makes it look that some primitive value is
+evaluated, which in turn makes Simplify.interestingArg return True,
+which in turn makes INLINE things applied to said value likely to be
+inlined.
+-}
+
+realWorldPrimId :: Id   -- :: State# RealWorld
+realWorldPrimId = pcMiscPrelId realWorldName realWorldStatePrimTy
+                     (noCafIdInfo `setUnfoldingInfo` evaldUnfolding    -- Note [evaldUnfoldings]
+                                  `setOneShotInfo` stateHackOneShot
+                                  `setNeverLevPoly` realWorldStatePrimTy)
+
+voidPrimId :: Id     -- Global constant :: Void#
+voidPrimId  = pcMiscPrelId voidPrimIdName voidPrimTy
+                (noCafIdInfo `setUnfoldingInfo` evaldUnfolding     -- Note [evaldUnfoldings]
+                             `setNeverLevPoly`  voidPrimTy)
+
+voidArgId :: Id       -- Local lambda-bound :: Void#
+voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy
+
+coercionTokenId :: Id         -- :: () ~ ()
+coercionTokenId -- See Note [Coercion tokens] in CoreToStg.hs
+  = pcMiscPrelId coercionTokenName
+                 (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])
+                 noCafIdInfo
+
+pcMiscPrelId :: Name -> Type -> IdInfo -> Id
+pcMiscPrelId name ty info
+  = mkVanillaGlobalWithInfo name ty info
+    -- We lie and say the thing is imported; otherwise, we get into
+    -- a mess with dependency analysis; e.g., core2stg may heave in
+    -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
+    -- being compiled, then it's just a matter of luck if the definition
+    -- will be in "the right place" to be in scope.
diff --git a/compiler/GHC/Types/Id/Make.hs-boot b/compiler/GHC/Types/Id/Make.hs-boot
new file mode 100644
index 0000000000..25ae32207e
--- /dev/null
+++ b/compiler/GHC/Types/Id/Make.hs-boot
@@ -0,0 +1,15 @@
+module GHC.Types.Id.Make where
+import GHC.Types.Name( Name )
+import GHC.Types.Var( Id )
+import GHC.Core.Class( Class )
+import {-# SOURCE #-} GHC.Core.DataCon( DataCon )
+import {-# SOURCE #-} PrimOp( PrimOp )
+
+data DataConBoxer
+
+mkDataConWorkId :: Name -> DataCon -> Id
+mkDictSelId     :: Name -> Class   -> Id
+
+mkPrimOpId      :: PrimOp -> Id
+
+magicDictId :: Id
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
new file mode 100644
index 0000000000..9e6a8e4ede
--- /dev/null
+++ b/compiler/GHC/Types/Literal.hs
@@ -0,0 +1,847 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+
+\section[Literal]{@Literal@: literals}
+-}
+
+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+module GHC.Types.Literal
+        (
+        -- * Main data type
+          Literal(..)           -- Exported to ParseIface
+        , LitNumType(..)
+
+        -- ** Creating Literals
+        , mkLitInt, mkLitIntWrap, mkLitIntWrapC
+        , mkLitWord, mkLitWordWrap, mkLitWordWrapC
+        , mkLitInt64, mkLitInt64Wrap
+        , mkLitWord64, mkLitWord64Wrap
+        , mkLitFloat, mkLitDouble
+        , mkLitChar, mkLitString
+        , mkLitInteger, mkLitNatural
+        , mkLitNumber, mkLitNumberWrap
+
+        -- ** Operations on Literals
+        , literalType
+        , absentLiteralOf
+        , pprLiteral
+        , litNumIsSigned
+        , litNumCheckRange
+
+        -- ** Predicates on Literals and their contents
+        , litIsDupable, litIsTrivial, litIsLifted
+        , inCharRange
+        , isZeroLit
+        , litFitsInChar
+        , litValue, isLitValue, isLitValue_maybe, mapLitValue
+
+        -- ** Coercions
+        , word2IntLit, int2WordLit
+        , narrowLit
+        , narrow8IntLit, narrow16IntLit, narrow32IntLit
+        , narrow8WordLit, narrow16WordLit, narrow32WordLit
+        , char2IntLit, int2CharLit
+        , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
+        , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit
+        ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import TysPrim
+import PrelNames
+import GHC.Core.Type
+import GHC.Core.TyCon
+import Outputable
+import FastString
+import GHC.Types.Basic
+import Binary
+import Constants
+import GHC.Platform
+import GHC.Types.Unique.FM
+import Util
+
+import Data.ByteString (ByteString)
+import Data.Int
+import Data.Word
+import Data.Char
+import Data.Maybe ( isJust )
+import Data.Data ( Data )
+import Data.Proxy
+import Numeric ( fromRat )
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Literals}
+*                                                                      *
+************************************************************************
+-}
+
+-- | So-called 'Literal's are one of:
+--
+-- * An unboxed numeric literal or floating-point literal which is presumed
+--   to be surrounded by appropriate constructors (@Int#@, etc.), so that
+--   the overall thing makes sense.
+--
+--   We maintain the invariant that the 'Integer' in the 'LitNumber'
+--   constructor is actually in the (possibly target-dependent) range.
+--   The mkLit{Int,Word}*Wrap smart constructors ensure this by applying
+--   the target machine's wrapping semantics. Use these in situations
+--   where you know the wrapping semantics are correct.
+--
+-- * The literal derived from the label mentioned in a \"foreign label\"
+--   declaration ('LitLabel')
+--
+-- * A 'LitRubbish' to be used in place of values of 'UnliftedRep'
+--   (i.e. 'MutVar#') when the the value is never used.
+--
+-- * A character
+-- * A string
+-- * The NULL pointer
+--
+data Literal
+  = LitChar    Char             -- ^ @Char#@ - at least 31 bits. Create with
+                                -- 'mkLitChar'
+
+  | LitNumber !LitNumType !Integer Type
+                                -- ^ Any numeric literal that can be
+                                -- internally represented with an Integer.
+                                -- See Note [Types of LitNumbers] below for the
+                                -- Type field.
+
+  | LitString  ByteString       -- ^ A string-literal: stored and emitted
+                                -- UTF-8 encoded, we'll arrange to decode it
+                                -- at runtime.  Also emitted with a @\'\\0\'@
+                                -- terminator. Create with 'mkLitString'
+
+  | LitNullAddr                 -- ^ The @NULL@ pointer, the only pointer value
+                                -- that can be represented as a Literal. Create
+                                -- with 'nullAddrLit'
+
+  | LitRubbish                  -- ^ A nonsense value, used when an unlifted
+                                -- binding is absent and has type
+                                -- @forall (a :: 'TYPE' 'UnliftedRep'). a@.
+                                -- May be lowered by code-gen to any possible
+                                -- value. Also see Note [Rubbish literals]
+
+  | LitFloat   Rational         -- ^ @Float#@. Create with 'mkLitFloat'
+  | LitDouble  Rational         -- ^ @Double#@. Create with 'mkLitDouble'
+
+  | LitLabel   FastString (Maybe Int) FunctionOrData
+                                -- ^ A label literal. Parameters:
+                                --
+                                -- 1) The name of the symbol mentioned in the
+                                --    declaration
+                                --
+                                -- 2) The size (in bytes) of the arguments
+                                --    the label expects. Only applicable with
+                                --    @stdcall@ labels. @Just x@ => @\<x\>@ will
+                                --    be appended to label name when emitting
+                                --    assembly.
+                                --
+                                -- 3) Flag indicating whether the symbol
+                                --    references a function or a data
+  deriving Data
+
+-- | Numeric literal type
+data LitNumType
+  = LitNumInteger -- ^ @Integer@ (see Note [Integer literals])
+  | LitNumNatural -- ^ @Natural@ (see Note [Natural literals])
+  | LitNumInt     -- ^ @Int#@ - according to target machine
+  | LitNumInt64   -- ^ @Int64#@ - exactly 64 bits
+  | LitNumWord    -- ^ @Word#@ - according to target machine
+  | LitNumWord64  -- ^ @Word64#@ - exactly 64 bits
+  deriving (Data,Enum,Eq,Ord)
+
+-- | Indicate if a numeric literal type supports negative numbers
+litNumIsSigned :: LitNumType -> Bool
+litNumIsSigned nt = case nt of
+  LitNumInteger -> True
+  LitNumNatural -> False
+  LitNumInt     -> True
+  LitNumInt64   -> True
+  LitNumWord    -> False
+  LitNumWord64  -> False
+
+{-
+Note [Integer literals]
+~~~~~~~~~~~~~~~~~~~~~~~
+An Integer literal is represented using, well, an Integer, to make it
+easier to write RULEs for them. They also contain the Integer type, so
+that e.g. literalType can return the right Type for them.
+
+They only get converted into real Core,
+    mkInteger [c1, c2, .., cn]
+during the CorePrep phase, although GHC.Iface.Tidy looks ahead at what the
+core will be, so that it can see whether it involves CAFs.
+
+When we initially build an Integer literal, notably when
+deserialising it from an interface file (see the Binary instance
+below), we don't have convenient access to the mkInteger Id.  So we
+just use an error thunk, and fill in the real Id when we do tcIfaceLit
+in GHC.IfaceToCore.
+
+Note [Natural literals]
+~~~~~~~~~~~~~~~~~~~~~~~
+Similar to Integer literals.
+
+Note [String literals]
+~~~~~~~~~~~~~~~~~~~~~~
+
+String literals are UTF-8 encoded and stored into ByteStrings in the following
+ASTs: Haskell, Core, Stg, Cmm. TH can also emit ByteString based string literals
+with the BytesPrimL constructor (see #14741).
+
+It wasn't true before as [Word8] was used in Cmm AST and in TH which was quite
+bad for performance with large strings (see #16198 and #14741).
+
+To include string literals into output objects, the assembler code generator has
+to embed the UTF-8 encoded binary blob. See Note [Embedding large binary blobs]
+for more details.
+
+-}
+
+instance Binary LitNumType where
+   put_ bh numTyp = putByte bh (fromIntegral (fromEnum numTyp))
+   get bh = do
+      h <- getByte bh
+      return (toEnum (fromIntegral h))
+
+instance Binary Literal where
+    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa
+    put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab
+    put_ bh (LitNullAddr)    = do putByte bh 2
+    put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah
+    put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai
+    put_ bh (LitLabel aj mb fod)
+        = do putByte bh 5
+             put_ bh aj
+             put_ bh mb
+             put_ bh fod
+    put_ bh (LitNumber nt i _)
+        = do putByte bh 6
+             put_ bh nt
+             put_ bh i
+    put_ bh (LitRubbish)     = do putByte bh 7
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do
+                    aa <- get bh
+                    return (LitChar aa)
+              1 -> do
+                    ab <- get bh
+                    return (LitString ab)
+              2 -> do
+                    return (LitNullAddr)
+              3 -> do
+                    ah <- get bh
+                    return (LitFloat ah)
+              4 -> do
+                    ai <- get bh
+                    return (LitDouble ai)
+              5 -> do
+                    aj <- get bh
+                    mb <- get bh
+                    fod <- get bh
+                    return (LitLabel aj mb fod)
+              6 -> do
+                    nt <- get bh
+                    i  <- get bh
+                    -- Note [Types of LitNumbers]
+                    let t = case nt of
+                            LitNumInt     -> intPrimTy
+                            LitNumInt64   -> int64PrimTy
+                            LitNumWord    -> wordPrimTy
+                            LitNumWord64  -> word64PrimTy
+                            -- See Note [Integer literals]
+                            LitNumInteger ->
+                              panic "Evaluated the place holder for mkInteger"
+                            -- and Note [Natural literals]
+                            LitNumNatural ->
+                              panic "Evaluated the place holder for mkNatural"
+                    return (LitNumber nt i t)
+              _ -> do
+                    return (LitRubbish)
+
+instance Outputable Literal where
+    ppr = pprLiteral id
+
+instance Eq Literal where
+    a == b = compare a b == EQ
+
+-- | Needed for the @Ord@ instance of 'AltCon', which in turn is needed in
+-- 'TrieMap.CoreMap'.
+instance Ord Literal where
+    compare = cmpLit
+
+{-
+        Construction
+        ~~~~~~~~~~~~
+-}
+
+{- Note [Word/Int underflow/overflow]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+According to the Haskell Report 2010 (Sections 18.1 and 23.1 about signed and
+unsigned integral types): "All arithmetic is performed modulo 2^n, where n is
+the number of bits in the type."
+
+GHC stores Word# and Int# constant values as Integer. Core optimizations such
+as constant folding must ensure that the Integer value remains in the valid
+target Word/Int range (see #13172). The following functions are used to
+ensure this.
+
+Note that we *don't* warn the user about overflow. It's not done at runtime
+either, and compilation of completely harmless things like
+   ((124076834 :: Word32) + (2147483647 :: Word32))
+doesn't yield a warning. Instead we simply squash the value into the *target*
+Int/Word range.
+-}
+
+-- | Wrap a literal number according to its type
+wrapLitNumber :: Platform -> Literal -> Literal
+wrapLitNumber platform v@(LitNumber nt i t) = case nt of
+  LitNumInt -> case platformWordSize platform of
+    PW4 -> LitNumber nt (toInteger (fromIntegral i :: Int32)) t
+    PW8 -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
+  LitNumWord -> case platformWordSize platform of
+    PW4 -> LitNumber nt (toInteger (fromIntegral i :: Word32)) t
+    PW8 -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
+  LitNumInt64   -> LitNumber nt (toInteger (fromIntegral i :: Int64)) t
+  LitNumWord64  -> LitNumber nt (toInteger (fromIntegral i :: Word64)) t
+  LitNumInteger -> v
+  LitNumNatural -> v
+wrapLitNumber _ x = x
+
+-- | Create a numeric 'Literal' of the given type
+mkLitNumberWrap :: Platform -> LitNumType -> Integer -> Type -> Literal
+mkLitNumberWrap platform nt i t = wrapLitNumber platform (LitNumber nt i t)
+
+-- | Check that a given number is in the range of a numeric literal
+litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool
+litNumCheckRange platform nt i = case nt of
+     LitNumInt     -> platformInIntRange platform i
+     LitNumWord    -> platformInWordRange platform i
+     LitNumInt64   -> inInt64Range i
+     LitNumWord64  -> inWord64Range i
+     LitNumNatural -> i >= 0
+     LitNumInteger -> True
+
+-- | Create a numeric 'Literal' of the given type
+mkLitNumber :: Platform -> LitNumType -> Integer -> Type -> Literal
+mkLitNumber platform nt i t =
+  ASSERT2(litNumCheckRange platform nt i, integer i)
+  (LitNumber nt i t)
+
+-- | Creates a 'Literal' of type @Int#@
+mkLitInt :: Platform -> Integer -> Literal
+mkLitInt platform x = ASSERT2( platformInIntRange platform x,  integer x )
+                       (mkLitIntUnchecked x)
+
+-- | Creates a 'Literal' of type @Int#@.
+--   If the argument is out of the (target-dependent) range, it is wrapped.
+--   See Note [Word/Int underflow/overflow]
+mkLitIntWrap :: Platform -> Integer -> Literal
+mkLitIntWrap platform i = wrapLitNumber platform $ mkLitIntUnchecked i
+
+-- | Creates a 'Literal' of type @Int#@ without checking its range.
+mkLitIntUnchecked :: Integer -> Literal
+mkLitIntUnchecked i = LitNumber LitNumInt i intPrimTy
+
+-- | Creates a 'Literal' of type @Int#@, as well as a 'Bool'ean flag indicating
+--   overflow. That is, if the argument is out of the (target-dependent) range
+--   the argument is wrapped and the overflow flag will be set.
+--   See Note [Word/Int underflow/overflow]
+mkLitIntWrapC :: Platform -> Integer -> (Literal, Bool)
+mkLitIntWrapC platform i = (n, i /= i')
+  where
+    n@(LitNumber _ i' _) = mkLitIntWrap platform i
+
+-- | Creates a 'Literal' of type @Word#@
+mkLitWord :: Platform -> Integer -> Literal
+mkLitWord platform x = ASSERT2( platformInWordRange platform x, integer x )
+                        (mkLitWordUnchecked x)
+
+-- | Creates a 'Literal' of type @Word#@.
+--   If the argument is out of the (target-dependent) range, it is wrapped.
+--   See Note [Word/Int underflow/overflow]
+mkLitWordWrap :: Platform -> Integer -> Literal
+mkLitWordWrap platform i = wrapLitNumber platform $ mkLitWordUnchecked i
+
+-- | Creates a 'Literal' of type @Word#@ without checking its range.
+mkLitWordUnchecked :: Integer -> Literal
+mkLitWordUnchecked i = LitNumber LitNumWord i wordPrimTy
+
+-- | Creates a 'Literal' of type @Word#@, as well as a 'Bool'ean flag indicating
+--   carry. That is, if the argument is out of the (target-dependent) range
+--   the argument is wrapped and the carry flag will be set.
+--   See Note [Word/Int underflow/overflow]
+mkLitWordWrapC :: Platform -> Integer -> (Literal, Bool)
+mkLitWordWrapC platform i = (n, i /= i')
+  where
+    n@(LitNumber _ i' _) = mkLitWordWrap platform i
+
+-- | Creates a 'Literal' of type @Int64#@
+mkLitInt64 :: Integer -> Literal
+mkLitInt64  x = ASSERT2( inInt64Range x, integer x ) (mkLitInt64Unchecked x)
+
+-- | Creates a 'Literal' of type @Int64#@.
+--   If the argument is out of the range, it is wrapped.
+mkLitInt64Wrap :: Platform -> Integer -> Literal
+mkLitInt64Wrap platform i = wrapLitNumber platform $ mkLitInt64Unchecked i
+
+-- | Creates a 'Literal' of type @Int64#@ without checking its range.
+mkLitInt64Unchecked :: Integer -> Literal
+mkLitInt64Unchecked i = LitNumber LitNumInt64 i int64PrimTy
+
+-- | Creates a 'Literal' of type @Word64#@
+mkLitWord64 :: Integer -> Literal
+mkLitWord64 x = ASSERT2( inWord64Range x, integer x ) (mkLitWord64Unchecked x)
+
+-- | Creates a 'Literal' of type @Word64#@.
+--   If the argument is out of the range, it is wrapped.
+mkLitWord64Wrap :: Platform -> Integer -> Literal
+mkLitWord64Wrap platform i = wrapLitNumber platform $ mkLitWord64Unchecked i
+
+-- | Creates a 'Literal' of type @Word64#@ without checking its range.
+mkLitWord64Unchecked :: Integer -> Literal
+mkLitWord64Unchecked i = LitNumber LitNumWord64 i word64PrimTy
+
+-- | Creates a 'Literal' of type @Float#@
+mkLitFloat :: Rational -> Literal
+mkLitFloat = LitFloat
+
+-- | Creates a 'Literal' of type @Double#@
+mkLitDouble :: Rational -> Literal
+mkLitDouble = LitDouble
+
+-- | Creates a 'Literal' of type @Char#@
+mkLitChar :: Char -> Literal
+mkLitChar = LitChar
+
+-- | Creates a 'Literal' of type @Addr#@, which is appropriate for passing to
+-- e.g. some of the \"error\" functions in GHC.Err such as @GHC.Err.runtimeError@
+mkLitString :: String -> Literal
+-- stored UTF-8 encoded
+mkLitString s = LitString (bytesFS $ mkFastString s)
+
+mkLitInteger :: Integer -> Type -> Literal
+mkLitInteger x ty = LitNumber LitNumInteger x ty
+
+mkLitNatural :: Integer -> Type -> Literal
+mkLitNatural x ty = ASSERT2( inNaturalRange x,  integer x )
+                    (LitNumber LitNumNatural x ty)
+
+inNaturalRange :: Integer -> Bool
+inNaturalRange x = x >= 0
+
+inInt64Range, inWord64Range :: Integer -> Bool
+inInt64Range x  = x >= toInteger (minBound :: Int64) &&
+                  x <= toInteger (maxBound :: Int64)
+inWord64Range x = x >= toInteger (minBound :: Word64) &&
+                  x <= toInteger (maxBound :: Word64)
+
+inCharRange :: Char -> Bool
+inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
+
+-- | Tests whether the literal represents a zero of whatever type it is
+isZeroLit :: Literal -> Bool
+isZeroLit (LitNumber _ 0 _) = True
+isZeroLit (LitFloat  0)     = True
+isZeroLit (LitDouble 0)     = True
+isZeroLit _                 = False
+
+-- | Returns the 'Integer' contained in the 'Literal', for when that makes
+-- sense, i.e. for 'Char', 'Int', 'Word', 'LitInteger' and 'LitNatural'.
+litValue  :: Literal -> Integer
+litValue l = case isLitValue_maybe l of
+   Just x  -> x
+   Nothing -> pprPanic "litValue" (ppr l)
+
+-- | Returns the 'Integer' contained in the 'Literal', for when that makes
+-- sense, i.e. for 'Char' and numbers.
+isLitValue_maybe  :: Literal -> Maybe Integer
+isLitValue_maybe (LitChar   c)     = Just $ toInteger $ ord c
+isLitValue_maybe (LitNumber _ i _) = Just i
+isLitValue_maybe _                 = Nothing
+
+-- | Apply a function to the 'Integer' contained in the 'Literal', for when that
+-- makes sense, e.g. for 'Char' and numbers.
+-- For fixed-size integral literals, the result will be wrapped in accordance
+-- with the semantics of the target type.
+-- See Note [Word/Int underflow/overflow]
+mapLitValue  :: Platform -> (Integer -> Integer) -> Literal -> Literal
+mapLitValue _        f (LitChar   c)      = mkLitChar (fchar c)
+   where fchar = chr . fromInteger . f . toInteger . ord
+mapLitValue platform f (LitNumber nt i t) = wrapLitNumber platform
+                                                        (LitNumber nt (f i) t)
+mapLitValue _        _ l                  = pprPanic "mapLitValue" (ppr l)
+
+-- | Indicate if the `Literal` contains an 'Integer' value, e.g. 'Char',
+-- 'Int', 'Word', 'LitInteger' and 'LitNatural'.
+isLitValue  :: Literal -> Bool
+isLitValue = isJust . isLitValue_maybe
+
+{-
+        Coercions
+        ~~~~~~~~~
+-}
+
+narrow8IntLit, narrow16IntLit, narrow32IntLit,
+  narrow8WordLit, narrow16WordLit, narrow32WordLit,
+  char2IntLit, int2CharLit,
+  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
+  float2DoubleLit, double2FloatLit
+  :: Literal -> Literal
+
+word2IntLit, int2WordLit :: Platform -> Literal -> Literal
+word2IntLit platform (LitNumber LitNumWord w _)
+  -- Map Word range [max_int+1, max_word]
+  -- to Int range   [min_int  , -1]
+  -- Range [0,max_int] has the same representation with both Int and Word
+  | w > platformMaxInt platform = mkLitInt platform (w - platformMaxWord platform - 1)
+  | otherwise                   = mkLitInt platform w
+word2IntLit _ l = pprPanic "word2IntLit" (ppr l)
+
+int2WordLit platform (LitNumber LitNumInt i _)
+  -- Map Int range [min_int  , -1]
+  -- to Word range [max_int+1, max_word]
+  -- Range [0,max_int] has the same representation with both Int and Word
+  | i < 0     = mkLitWord platform (1 + platformMaxWord platform + i)
+  | otherwise = mkLitWord platform i
+int2WordLit _ l = pprPanic "int2WordLit" (ppr l)
+
+-- | Narrow a literal number (unchecked result range)
+narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal
+narrowLit _ (LitNumber nt i t) = LitNumber nt (toInteger (fromInteger i :: a)) t
+narrowLit _ l                  = pprPanic "narrowLit" (ppr l)
+
+narrow8IntLit   = narrowLit (Proxy :: Proxy Int8)
+narrow16IntLit  = narrowLit (Proxy :: Proxy Int16)
+narrow32IntLit  = narrowLit (Proxy :: Proxy Int32)
+narrow8WordLit  = narrowLit (Proxy :: Proxy Word8)
+narrow16WordLit = narrowLit (Proxy :: Proxy Word16)
+narrow32WordLit = narrowLit (Proxy :: Proxy Word32)
+
+char2IntLit (LitChar c)       = mkLitIntUnchecked (toInteger (ord c))
+char2IntLit l                 = pprPanic "char2IntLit" (ppr l)
+int2CharLit (LitNumber _ i _) = LitChar (chr (fromInteger i))
+int2CharLit l                 = pprPanic "int2CharLit" (ppr l)
+
+float2IntLit (LitFloat f)      = mkLitIntUnchecked (truncate f)
+float2IntLit l                 = pprPanic "float2IntLit" (ppr l)
+int2FloatLit (LitNumber _ i _) = LitFloat (fromInteger i)
+int2FloatLit l                 = pprPanic "int2FloatLit" (ppr l)
+
+double2IntLit (LitDouble f)     = mkLitIntUnchecked (truncate f)
+double2IntLit l                 = pprPanic "double2IntLit" (ppr l)
+int2DoubleLit (LitNumber _ i _) = LitDouble (fromInteger i)
+int2DoubleLit l                 = pprPanic "int2DoubleLit" (ppr l)
+
+float2DoubleLit (LitFloat  f) = LitDouble f
+float2DoubleLit l             = pprPanic "float2DoubleLit" (ppr l)
+double2FloatLit (LitDouble d) = LitFloat  d
+double2FloatLit l             = pprPanic "double2FloatLit" (ppr l)
+
+nullAddrLit :: Literal
+nullAddrLit = LitNullAddr
+
+-- | A nonsense literal of type @forall (a :: 'TYPE' 'UnliftedRep'). a@.
+rubbishLit :: Literal
+rubbishLit = LitRubbish
+
+{-
+        Predicates
+        ~~~~~~~~~~
+-}
+
+-- | True if there is absolutely no penalty to duplicating the literal.
+-- False principally of strings.
+--
+-- "Why?", you say? I'm glad you asked. Well, for one duplicating strings would
+-- blow up code sizes. Not only this, it's also unsafe.
+--
+-- Consider a program that wants to traverse a string. One way it might do this
+-- is to first compute the Addr# pointing to the end of the string, and then,
+-- starting from the beginning, bump a pointer using eqAddr# to determine the
+-- end. For instance,
+--
+-- @
+-- -- Given pointers to the start and end of a string, count how many zeros
+-- -- the string contains.
+-- countZeros :: Addr# -> Addr# -> -> Int
+-- countZeros start end = go start 0
+--   where
+--     go off n
+--       | off `addrEq#` end = n
+--       | otherwise         = go (off `plusAddr#` 1) n'
+--       where n' | isTrue# (indexInt8OffAddr# off 0# ==# 0#) = n + 1
+--                | otherwise                                 = n
+-- @
+--
+-- Consider what happens if we considered strings to be trivial (and therefore
+-- duplicable) and emitted a call like @countZeros "hello"# ("hello"#
+-- `plusAddr`# 5)@. The beginning and end pointers do not belong to the same
+-- string, meaning that an iteration like the above would blow up terribly.
+-- This is what happened in #12757.
+--
+-- Ultimately the solution here is to make primitive strings a bit more
+-- structured, ensuring that the compiler can't inline in ways that will break
+-- user code. One approach to this is described in #8472.
+litIsTrivial :: Literal -> Bool
+--      c.f. GHC.Core.Utils.exprIsTrivial
+litIsTrivial (LitString _)      = False
+litIsTrivial (LitNumber nt _ _) = case nt of
+  LitNumInteger -> False
+  LitNumNatural -> False
+  LitNumInt     -> True
+  LitNumInt64   -> True
+  LitNumWord    -> True
+  LitNumWord64  -> True
+litIsTrivial _                  = True
+
+-- | True if code space does not go bad if we duplicate this literal
+litIsDupable :: Platform -> Literal -> Bool
+--      c.f. GHC.Core.Utils.exprIsDupable
+litIsDupable platform x = case x of
+   (LitNumber nt i _) -> case nt of
+      LitNumInteger -> platformInIntRange platform i
+      LitNumNatural -> platformInWordRange platform i
+      LitNumInt     -> True
+      LitNumInt64   -> True
+      LitNumWord    -> True
+      LitNumWord64  -> True
+   (LitString _) -> False
+   _             -> True
+
+litFitsInChar :: Literal -> Bool
+litFitsInChar (LitNumber _ i _) = i >= toInteger (ord minBound)
+                               && i <= toInteger (ord maxBound)
+litFitsInChar _                 = False
+
+litIsLifted :: Literal -> Bool
+litIsLifted (LitNumber nt _ _) = case nt of
+  LitNumInteger -> True
+  LitNumNatural -> True
+  LitNumInt     -> False
+  LitNumInt64   -> False
+  LitNumWord    -> False
+  LitNumWord64  -> False
+litIsLifted _                  = False
+
+{-
+        Types
+        ~~~~~
+
+Note [Types of LitNumbers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A LitNumber's type is always known from its LitNumType:
+
+  LitNumInteger -> Integer
+  LitNumNatural -> Natural
+  LitNumInt     -> Int# (intPrimTy)
+  LitNumInt64   -> Int64# (int64PrimTy)
+  LitNumWord    -> Word# (wordPrimTy)
+  LitNumWord64  -> Word64# (word64PrimTy)
+
+The reason why we have a Type field is because Integer and Natural types live
+outside of GHC (in the libraries), so we have to get the actual Type via
+lookupTyCon, tcIfaceTyConByName etc. that's too inconvenient in the call sites
+of literalType, so we do that when creating these literals, and literalType
+simply reads the field.
+
+(But see also Note [Integer literals] and Note [Natural literals])
+-}
+
+-- | Find the Haskell 'Type' the literal occupies
+literalType :: Literal -> Type
+literalType LitNullAddr       = addrPrimTy
+literalType (LitChar _)       = charPrimTy
+literalType (LitString  _)    = addrPrimTy
+literalType (LitFloat _)      = floatPrimTy
+literalType (LitDouble _)     = doublePrimTy
+literalType (LitLabel _ _ _)  = addrPrimTy
+literalType (LitNumber _ _ t) = t -- Note [Types of LitNumbers]
+literalType (LitRubbish)      = mkForAllTy a Inferred (mkTyVarTy a)
+  where
+    a = alphaTyVarUnliftedRep
+
+absentLiteralOf :: TyCon -> Maybe Literal
+-- Return a literal of the appropriate primitive
+-- TyCon, to use as a placeholder when it doesn't matter
+-- Rubbish literals are handled in GHC.Core.Op.WorkWrap.Lib, because
+--  1. Looking at the TyCon is not enough, we need the actual type
+--  2. This would need to return a type application to a literal
+absentLiteralOf tc = lookupUFM absent_lits (tyConName tc)
+
+absent_lits :: UniqFM Literal
+absent_lits = listToUFM [ (addrPrimTyConKey,    LitNullAddr)
+                        , (charPrimTyConKey,    LitChar 'x')
+                        , (intPrimTyConKey,     mkLitIntUnchecked 0)
+                        , (int64PrimTyConKey,   mkLitInt64Unchecked 0)
+                        , (wordPrimTyConKey,    mkLitWordUnchecked 0)
+                        , (word64PrimTyConKey,  mkLitWord64Unchecked 0)
+                        , (floatPrimTyConKey,   LitFloat 0)
+                        , (doublePrimTyConKey,  LitDouble 0)
+                        ]
+
+{-
+        Comparison
+        ~~~~~~~~~~
+-}
+
+cmpLit :: Literal -> Literal -> Ordering
+cmpLit (LitChar      a)     (LitChar       b)     = a `compare` b
+cmpLit (LitString    a)     (LitString     b)     = a `compare` b
+cmpLit (LitNullAddr)        (LitNullAddr)         = EQ
+cmpLit (LitFloat     a)     (LitFloat      b)     = a `compare` b
+cmpLit (LitDouble    a)     (LitDouble     b)     = a `compare` b
+cmpLit (LitLabel     a _ _) (LitLabel      b _ _) = a `compare` b
+cmpLit (LitNumber nt1 a _)  (LitNumber nt2  b _)
+  | nt1 == nt2 = a   `compare` b
+  | otherwise  = nt1 `compare` nt2
+cmpLit (LitRubbish)         (LitRubbish)          = EQ
+cmpLit lit1 lit2
+  | litTag lit1 < litTag lit2 = LT
+  | otherwise                 = GT
+
+litTag :: Literal -> Int
+litTag (LitChar      _)   = 1
+litTag (LitString    _)   = 2
+litTag (LitNullAddr)      = 3
+litTag (LitFloat     _)   = 4
+litTag (LitDouble    _)   = 5
+litTag (LitLabel _ _ _)   = 6
+litTag (LitNumber  {})    = 7
+litTag (LitRubbish)       = 8
+
+{-
+        Printing
+        ~~~~~~~~
+* See Note [Printing of literals in Core]
+-}
+
+pprLiteral :: (SDoc -> SDoc) -> Literal -> SDoc
+pprLiteral _       (LitChar c)     = pprPrimChar c
+pprLiteral _       (LitString s)   = pprHsBytes s
+pprLiteral _       (LitNullAddr)   = text "__NULL"
+pprLiteral _       (LitFloat f)    = float (fromRat f) <> primFloatSuffix
+pprLiteral _       (LitDouble d)   = double (fromRat d) <> primDoubleSuffix
+pprLiteral add_par (LitNumber nt i _)
+   = case nt of
+       LitNumInteger -> pprIntegerVal add_par i
+       LitNumNatural -> pprIntegerVal add_par i
+       LitNumInt     -> pprPrimInt i
+       LitNumInt64   -> pprPrimInt64 i
+       LitNumWord    -> pprPrimWord i
+       LitNumWord64  -> pprPrimWord64 i
+pprLiteral add_par (LitLabel l mb fod) =
+    add_par (text "__label" <+> b <+> ppr fod)
+    where b = case mb of
+              Nothing -> pprHsString l
+              Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
+pprLiteral _       (LitRubbish)     = text "__RUBBISH"
+
+pprIntegerVal :: (SDoc -> SDoc) -> Integer -> SDoc
+-- See Note [Printing of literals in Core].
+pprIntegerVal add_par i | i < 0     = add_par (integer i)
+                        | otherwise = integer i
+
+{-
+Note [Printing of literals in Core]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The function `add_par` is used to wrap parenthesis around negative integers
+(`LitInteger`) and labels (`LitLabel`), if they occur in a context requiring
+an atomic thing (for example function application).
+
+Although not all Core literals would be valid Haskell, we are trying to stay
+as close as possible to Haskell syntax in the printing of Core, to make it
+easier for a Haskell user to read Core.
+
+To that end:
+  * We do print parenthesis around negative `LitInteger`, because we print
+  `LitInteger` using plain number literals (no prefix or suffix), and plain
+  number literals in Haskell require parenthesis in contexts like function
+  application (i.e. `1 - -1` is not valid Haskell).
+
+  * We don't print parenthesis around other (negative) literals, because they
+  aren't needed in GHC/Haskell either (i.e. `1# -# -1#` is accepted by GHC's
+  parser).
+
+Literal         Output             Output if context requires
+                                   an atom (if different)
+-------         -------            ----------------------
+LitChar         'a'#
+LitString       "aaa"#
+LitNullAddr     "__NULL"
+LitInt          -1#
+LitInt64        -1L#
+LitWord          1##
+LitWord64        1L##
+LitFloat        -1.0#
+LitDouble       -1.0##
+LitInteger      -1                 (-1)
+LitLabel        "__label" ...      ("__label" ...)
+LitRubbish      "__RUBBISH"
+
+Note [Rubbish literals]
+~~~~~~~~~~~~~~~~~~~~~~~
+During worker/wrapper after demand analysis, where an argument
+is unused (absent) we do the following w/w split (supposing that
+y is absent):
+
+  f x y z = e
+===>
+  f x y z = $wf x z
+  $wf x z = let y = <absent value>
+            in e
+
+Usually the binding for y is ultimately optimised away, and
+even if not it should never be evaluated -- but that's the
+way the w/w split starts off.
+
+What is <absent value>?
+* For lifted values <absent value> can be a call to 'error'.
+* For primitive types like Int# or Word# we can use any random
+  value of that type.
+* But what about /unlifted/ but /boxed/ types like MutVar# or
+  Array#?   We need a literal value of that type.
+
+That is 'LitRubbish'.  Since we need a rubbish literal for
+many boxed, unlifted types, we say that LitRubbish has type
+  LitRubbish :: forall (a :: TYPE UnliftedRep). a
+
+So we might see a w/w split like
+  $wf x z = let y :: Array# Int = LitRubbish @(Array# Int)
+            in e
+
+Recall that (TYPE UnliftedRep) is the kind of boxed, unlifted
+heap pointers.
+
+Here are the moving parts:
+
+* We define LitRubbish as a constructor in GHC.Types.Literal.Literal
+
+* It is given its polymorphic type by Literal.literalType
+
+* GHC.Core.Op.WorkWrap.Lib.mk_absent_let introduces a LitRubbish for absent
+  arguments of boxed, unlifted type.
+
+* In CoreToSTG we convert (RubishLit @t) to just ().  STG is
+  untyped, so it doesn't matter that it points to a lifted
+  value. The important thing is that it is a heap pointer,
+  which the garbage collector can follow if it encounters it.
+
+  We considered maintaining LitRubbish in STG, and lowering
+  it in the code generators, but it seems simpler to do it
+  once and for all in CoreToSTG.
+
+  In GHC.ByteCode.Asm we just lower it as a 0 literal, because
+  it's all boxed and lifted to the host GC anyway.
+-}
diff --git a/compiler/GHC/Types/Module.hs b/compiler/GHC/Types/Module.hs
new file mode 100644
index 0000000000..a73df28a9e
--- /dev/null
+++ b/compiler/GHC/Types/Module.hs
@@ -0,0 +1,1303 @@
+{-
+(c) The University of Glasgow, 2004-2006
+
+
+Module
+~~~~~~~~~~
+Simply the name of a module, represented as a FastString.
+These are Uniquable, hence we can build Maps with Modules as
+the keys.
+-}
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module GHC.Types.Module
+    (
+        -- * The ModuleName type
+        ModuleName,
+        pprModuleName,
+        moduleNameFS,
+        moduleNameString,
+        moduleNameSlashes, moduleNameColons,
+        moduleStableString,
+        moduleFreeHoles,
+        moduleIsDefinite,
+        mkModuleName,
+        mkModuleNameFS,
+        stableModuleNameCmp,
+
+        -- * The UnitId type
+        ComponentId(..),
+        UnitId(..),
+        unitIdFS,
+        unitIdKey,
+        IndefUnitId(..),
+        IndefModule(..),
+        indefUnitIdToUnitId,
+        indefModuleToModule,
+        InstalledUnitId(..),
+        toInstalledUnitId,
+        ShHoleSubst,
+
+        unitIdIsDefinite,
+        unitIdString,
+        unitIdFreeHoles,
+
+        newUnitId,
+        newIndefUnitId,
+        newSimpleUnitId,
+        hashUnitId,
+        fsToUnitId,
+        stringToUnitId,
+        stableUnitIdCmp,
+
+        -- * HOLE renaming
+        renameHoleUnitId,
+        renameHoleModule,
+        renameHoleUnitId',
+        renameHoleModule',
+
+        -- * Generalization
+        splitModuleInsts,
+        splitUnitIdInsts,
+        generalizeIndefUnitId,
+        generalizeIndefModule,
+
+        -- * Parsers
+        parseModuleName,
+        parseUnitId,
+        parseComponentId,
+        parseModuleId,
+        parseModSubst,
+
+        -- * Wired-in UnitIds
+        -- $wired_in_packages
+        primUnitId,
+        integerUnitId,
+        baseUnitId,
+        rtsUnitId,
+        thUnitId,
+        mainUnitId,
+        thisGhcUnitId,
+        isHoleModule,
+        interactiveUnitId, isInteractiveModule,
+        wiredInUnitIds,
+
+        -- * The Module type
+        Module(Module),
+        moduleUnitId, moduleName,
+        pprModule,
+        mkModule,
+        mkHoleModule,
+        stableModuleCmp,
+        HasModule(..),
+        ContainsModule(..),
+
+        -- * Installed unit ids and modules
+        InstalledModule(..),
+        InstalledModuleEnv,
+        installedModuleEq,
+        installedUnitIdEq,
+        installedUnitIdString,
+        fsToInstalledUnitId,
+        componentIdToInstalledUnitId,
+        stringToInstalledUnitId,
+        emptyInstalledModuleEnv,
+        lookupInstalledModuleEnv,
+        extendInstalledModuleEnv,
+        filterInstalledModuleEnv,
+        delInstalledModuleEnv,
+        DefUnitId(..),
+
+        -- * The ModuleLocation type
+        ModLocation(..),
+        addBootSuffix, addBootSuffix_maybe,
+        addBootSuffixLocn, addBootSuffixLocnOut,
+
+        -- * Module mappings
+        ModuleEnv,
+        elemModuleEnv, extendModuleEnv, extendModuleEnvList,
+        extendModuleEnvList_C, plusModuleEnv_C,
+        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
+        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
+        moduleEnvKeys, moduleEnvElts, moduleEnvToList,
+        unitModuleEnv, isEmptyModuleEnv,
+        extendModuleEnvWith, filterModuleEnv,
+
+        -- * ModuleName mappings
+        ModuleNameEnv, DModuleNameEnv,
+
+        -- * Sets of Modules
+        ModuleSet,
+        emptyModuleSet, mkModuleSet, moduleSetElts,
+        extendModuleSet, extendModuleSetList, delModuleSet,
+        elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet,
+        unitModuleSet
+    ) where
+
+import GhcPrelude
+
+import Outputable
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import GHC.Types.Unique.DSet
+import FastString
+import Binary
+import Util
+import Data.List (sortBy, sort)
+import Data.Ord
+import GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..))
+import Fingerprint
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS.Char8
+import Encoding
+
+import qualified Text.ParserCombinators.ReadP as Parse
+import Text.ParserCombinators.ReadP (ReadP, (<++))
+import Data.Char (isAlphaNum)
+import Control.DeepSeq
+import Data.Coerce
+import Data.Data
+import Data.Function
+import Data.Map (Map)
+import Data.Set (Set)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified FiniteMap as Map
+import System.FilePath
+
+import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
+import {-# SOURCE #-} GHC.Driver.Packages (componentIdString, improveUnitId, UnitInfoMap, getUnitInfoMap, displayInstalledUnitId)
+
+-- Note [The identifier lexicon]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Unit IDs, installed package IDs, ABI hashes, package names,
+-- versions, there are a *lot* of different identifiers for closely
+-- related things.  What do they all mean? Here's what.  (See also
+-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/packages/concepts )
+--
+-- THE IMPORTANT ONES
+--
+-- ComponentId: An opaque identifier provided by Cabal, which should
+-- uniquely identify such things as the package name, the package
+-- version, the name of the component, the hash of the source code
+-- tarball, the selected Cabal flags, GHC flags, direct dependencies of
+-- the component.  These are very similar to InstalledPackageId, but
+-- an 'InstalledPackageId' implies that it identifies a package, while
+-- a package may install multiple components with different
+-- 'ComponentId's.
+--      - Same as Distribution.Package.ComponentId
+--
+-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names
+-- (ModuleName) to Modules.  This is how the compiler identifies instantiated
+-- components, and also is the main identifier by which GHC identifies things.
+--      - When Backpack is not being used, UnitId = ComponentId.
+--        this means a useful fiction for end-users is that there are
+--        only ever ComponentIds, and some ComponentIds happen to have
+--        more information (UnitIds).
+--      - Same as Language.Haskell.TH.Syntax:PkgName, see
+--          https://gitlab.haskell.org/ghc/ghc/issues/10279
+--      - The same as PackageKey in GHC 7.10 (we renamed it because
+--        they don't necessarily identify packages anymore.)
+--      - Same as -this-package-key/-package-name flags
+--      - An InstalledUnitId corresponds to an actual package which
+--        we have installed on disk.  It could be definite or indefinite,
+--        but if it's indefinite, it has nothing instantiated (we
+--        never install partially instantiated units.)
+--
+-- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how
+-- the compiler identifies modules (e.g. a Name is a Module + OccName)
+--      - Same as Language.Haskell.TH.Syntax:Module
+--
+-- THE LESS IMPORTANT ONES
+--
+-- PackageName: The "name" field in a Cabal file, something like "lens".
+--      - Same as Distribution.Package.PackageName
+--      - DIFFERENT FROM Language.Haskell.TH.Syntax:PkgName, see
+--          https://gitlab.haskell.org/ghc/ghc/issues/10279
+--      - DIFFERENT FROM -package-name flag
+--      - DIFFERENT FROM the 'name' field in an installed package
+--        information.  This field could more accurately be described
+--        as a munged package name: when it's for the main library
+--        it is the same as the package name, but if it's an internal
+--        library it's a munged combination of the package name and
+--        the component name.
+--
+-- LEGACY ONES
+--
+-- InstalledPackageId: This is what we used to call ComponentId.
+-- It's a still pretty useful concept for packages that have only
+-- one library; in that case the logical InstalledPackageId =
+-- ComponentId.  Also, the Cabal nix-local-build continues to
+-- compute an InstalledPackageId which is then forcibly used
+-- for all components in a package.  This means that if a dependency
+-- from one component in a package changes, the InstalledPackageId
+-- changes: you don't get as fine-grained dependency tracking,
+-- but it means your builds are hermetic.  Eventually, Cabal will
+-- deal completely in components and we can get rid of this.
+--
+-- PackageKey: This is what we used to call UnitId.  We ditched
+-- "Package" from the name when we realized that you might want to
+-- assign different "PackageKeys" to components from the same package.
+-- (For a brief, non-released period of time, we also called these
+-- UnitKeys).
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Module locations}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Module Location
+--
+-- Where a module lives on the file system: the actual locations
+-- of the .hs, .hi and .o files, if we have them
+data ModLocation
+   = ModLocation {
+        ml_hs_file   :: Maybe FilePath,
+                -- The source file, if we have one.  Package modules
+                -- probably don't have source files.
+
+        ml_hi_file   :: FilePath,
+                -- Where the .hi file is, whether or not it exists
+                -- yet.  Always of form foo.hi, even if there is an
+                -- hi-boot file (we add the -boot suffix later)
+
+        ml_obj_file  :: FilePath,
+                -- Where the .o file is, whether or not it exists yet.
+                -- (might not exist either because the module hasn't
+                -- been compiled yet, or because it is part of a
+                -- package with a .a file)
+        ml_hie_file  :: FilePath
+  } deriving Show
+
+instance Outputable ModLocation where
+   ppr = text . show
+
+{-
+For a module in another package, the hs_file and obj_file
+components of ModLocation are undefined.
+
+The locations specified by a ModLocation may or may not
+correspond to actual files yet: for example, even if the object
+file doesn't exist, the ModLocation still contains the path to
+where the object file will reside if/when it is created.
+-}
+
+addBootSuffix :: FilePath -> FilePath
+-- ^ Add the @-boot@ suffix to .hs, .hi and .o files
+addBootSuffix path = path ++ "-boot"
+
+addBootSuffix_maybe :: Bool -> FilePath -> FilePath
+-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
+addBootSuffix_maybe is_boot path
+ | is_boot   = addBootSuffix path
+ | otherwise = path
+
+addBootSuffixLocn :: ModLocation -> ModLocation
+-- ^ Add the @-boot@ suffix to all file paths associated with the module
+addBootSuffixLocn locn
+  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
+         , ml_hi_file  = addBootSuffix (ml_hi_file locn)
+         , ml_obj_file = addBootSuffix (ml_obj_file locn)
+         , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+
+addBootSuffixLocnOut :: ModLocation -> ModLocation
+-- ^ Add the @-boot@ suffix to all output file paths associated with the
+-- module, not including the input file itself
+addBootSuffixLocnOut locn
+  = locn { ml_hi_file  = addBootSuffix (ml_hi_file locn)
+         , ml_obj_file = addBootSuffix (ml_obj_file locn)
+         , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{The name of a module}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
+newtype ModuleName = ModuleName FastString
+
+instance Uniquable ModuleName where
+  getUnique (ModuleName nm) = getUnique nm
+
+instance Eq ModuleName where
+  nm1 == nm2 = getUnique nm1 == getUnique nm2
+
+instance Ord ModuleName where
+  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
+
+instance Outputable ModuleName where
+  ppr = pprModuleName
+
+instance Binary ModuleName where
+  put_ bh (ModuleName fs) = put_ bh fs
+  get bh = do fs <- get bh; return (ModuleName fs)
+
+instance BinaryStringRep ModuleName where
+  fromStringRep = mkModuleNameFS . mkFastStringByteString
+  toStringRep   = bytesFS . moduleNameFS
+
+instance Data ModuleName where
+  -- don't traverse?
+  toConstr _   = abstractConstr "ModuleName"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "ModuleName"
+
+instance NFData ModuleName where
+  rnf x = x `seq` ()
+
+stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
+-- ^ Compares module names lexically, rather than by their 'Unique's
+stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
+
+pprModuleName :: ModuleName -> SDoc
+pprModuleName (ModuleName nm) =
+    getPprStyle $ \ sty ->
+    if codeStyle sty
+        then ztext (zEncodeFS nm)
+        else ftext nm
+
+moduleNameFS :: ModuleName -> FastString
+moduleNameFS (ModuleName mod) = mod
+
+moduleNameString :: ModuleName -> String
+moduleNameString (ModuleName mod) = unpackFS mod
+
+-- | Get a string representation of a 'Module' that's unique and stable
+-- across recompilations.
+-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
+moduleStableString :: Module -> String
+moduleStableString Module{..} =
+  "$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName
+
+mkModuleName :: String -> ModuleName
+mkModuleName s = ModuleName (mkFastString s)
+
+mkModuleNameFS :: FastString -> ModuleName
+mkModuleNameFS s = ModuleName s
+
+-- |Returns the string version of the module name, with dots replaced by slashes.
+--
+moduleNameSlashes :: ModuleName -> String
+moduleNameSlashes = dots_to_slashes . moduleNameString
+  where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
+
+-- |Returns the string version of the module name, with dots replaced by colons.
+--
+moduleNameColons :: ModuleName -> String
+moduleNameColons = dots_to_colons . moduleNameString
+  where dots_to_colons = map (\c -> if c == '.' then ':' else c)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{A fully qualified module}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
+--
+-- Module variables (i.e. @<H>@) which can be instantiated to a
+-- specific module at some later point in time are represented
+-- with 'moduleUnitId' set to 'holeUnitId' (this allows us to
+-- avoid having to make 'moduleUnitId' a partial operation.)
+--
+data Module = Module {
+   moduleUnitId :: !UnitId,  -- pkg-1.0
+   moduleName :: !ModuleName  -- A.B.C
+  }
+  deriving (Eq, Ord)
+
+-- | Calculate the free holes of a 'Module'.  If this set is non-empty,
+-- this module was defined in an indefinite library that had required
+-- signatures.
+--
+-- If a module has free holes, that means that substitutions can operate on it;
+-- if it has no free holes, substituting over a module has no effect.
+moduleFreeHoles :: Module -> UniqDSet ModuleName
+moduleFreeHoles m
+    | isHoleModule m = unitUniqDSet (moduleName m)
+    | otherwise = unitIdFreeHoles (moduleUnitId m)
+
+-- | A 'Module' is definite if it has no free holes.
+moduleIsDefinite :: Module -> Bool
+moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles
+
+-- | Create a module variable at some 'ModuleName'.
+-- See Note [Representation of module/name variables]
+mkHoleModule :: ModuleName -> Module
+mkHoleModule = mkModule holeUnitId
+
+instance Uniquable Module where
+  getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)
+
+instance Outputable Module where
+  ppr = pprModule
+
+instance Binary Module where
+  put_ bh (Module p n) = put_ bh p >> put_ bh n
+  get bh = do p <- get bh; n <- get bh; return (Module p n)
+
+instance Data Module where
+  -- don't traverse?
+  toConstr _   = abstractConstr "Module"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Module"
+
+instance NFData Module where
+  rnf x = x `seq` ()
+
+-- | This gives a stable ordering, as opposed to the Ord instance which
+-- gives an ordering based on the 'Unique's of the components, which may
+-- not be stable from run to run of the compiler.
+stableModuleCmp :: Module -> Module -> Ordering
+stableModuleCmp (Module p1 n1) (Module p2 n2)
+   = (p1 `stableUnitIdCmp`  p2) `thenCmp`
+     (n1 `stableModuleNameCmp` n2)
+
+mkModule :: UnitId -> ModuleName -> Module
+mkModule = Module
+
+pprModule :: Module -> SDoc
+pprModule mod@(Module p n)  = getPprStyle doc
+ where
+  doc sty
+    | codeStyle sty =
+        (if p == mainUnitId
+                then empty -- never qualify the main package in code
+                else ztext (zEncodeFS (unitIdFS p)) <> char '_')
+            <> pprModuleName n
+    | qualModule sty mod =
+        if isHoleModule mod
+            then angleBrackets (pprModuleName n)
+            else ppr (moduleUnitId mod) <> char ':' <> pprModuleName n
+    | otherwise =
+        pprModuleName n
+
+class ContainsModule t where
+    extractModule :: t -> Module
+
+class HasModule m where
+    getModule :: m Module
+
+instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where
+  fromDbModule (DbModule uid mod_name)  = mkModule uid mod_name
+  fromDbModule (DbModuleVar mod_name)   = mkHoleModule mod_name
+  fromDbUnitId (DbUnitId cid insts)     = newUnitId cid insts
+  fromDbUnitId (DbInstalledUnitId iuid) = DefiniteUnitId (DefUnitId iuid)
+  -- GHC never writes to the database, so it's not needed
+  toDbModule = error "toDbModule: not implemented"
+  toDbUnitId = error "toDbUnitId: not implemented"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{ComponentId}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A 'ComponentId' consists of the package name, package version, component
+-- ID, the transitive dependencies of the component, and other information to
+-- uniquely identify the source code and build configuration of a component.
+--
+-- This used to be known as an 'InstalledPackageId', but a package can contain
+-- multiple components and a 'ComponentId' uniquely identifies a component
+-- within a package.  When a package only has one component, the 'ComponentId'
+-- coincides with the 'InstalledPackageId'
+newtype ComponentId        = ComponentId        FastString deriving (Eq, Ord)
+
+instance BinaryStringRep ComponentId where
+  fromStringRep = ComponentId . mkFastStringByteString
+  toStringRep (ComponentId s) = bytesFS s
+
+instance Uniquable ComponentId where
+  getUnique (ComponentId n) = getUnique n
+
+instance Outputable ComponentId where
+  ppr cid@(ComponentId fs) =
+    getPprStyle $ \sty ->
+    sdocWithDynFlags $ \dflags ->
+      case componentIdString dflags cid of
+        Just str | not (debugStyle sty) -> text str
+        _ -> ftext fs
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{UnitId}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A unit identifier identifies a (possibly partially) instantiated
+-- library.  It is primarily used as part of 'Module', which in turn
+-- is used in 'Name', which is used to give names to entities when
+-- typechecking.
+--
+-- There are two possible forms for a 'UnitId'.  It can be a
+-- 'DefiniteUnitId', in which case we just have a string that uniquely
+-- identifies some fully compiled, installed library we have on disk.
+-- However, when we are typechecking a library with missing holes,
+-- we may need to instantiate a library on the fly (in which case
+-- we don't have any on-disk representation.)  In that case, you
+-- have an 'IndefiniteUnitId', which explicitly records the
+-- instantiation, so that we can substitute over it.
+data UnitId
+    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
+    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId
+
+unitIdFS :: UnitId -> FastString
+unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
+unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x
+
+unitIdKey :: UnitId -> Unique
+unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x
+unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x
+
+-- | A unit identifier which identifies an indefinite
+-- library (with holes) that has been *on-the-fly* instantiated
+-- with a substitution 'indefUnitIdInsts'.  In fact, an indefinite
+-- unit identifier could have no holes, but we haven't gotten
+-- around to compiling the actual library yet.
+--
+-- An indefinite unit identifier pretty-prints to something like
+-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the
+-- brackets enclose the module substitution).
+data IndefUnitId
+    = IndefUnitId {
+        -- | A private, uniquely identifying representation of
+        -- a UnitId.  This string is completely private to GHC
+        -- and is just used to get a unique; in particular, we don't use it for
+        -- symbols (indefinite libraries are not compiled).
+        indefUnitIdFS :: FastString,
+        -- | Cached unique of 'unitIdFS'.
+        indefUnitIdKey :: Unique,
+        -- | The component identity of the indefinite library that
+        -- is being instantiated.
+        indefUnitIdComponentId :: !ComponentId,
+        -- | The sorted (by 'ModuleName') instantiations of this library.
+        indefUnitIdInsts :: ![(ModuleName, Module)],
+        -- | A cache of the free module variables of 'unitIdInsts'.
+        -- This lets us efficiently tell if a 'UnitId' has been
+        -- fully instantiated (free module variables are empty)
+        -- and whether or not a substitution can have any effect.
+        indefUnitIdFreeHoles :: UniqDSet ModuleName
+    }
+
+instance Eq IndefUnitId where
+  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2
+
+instance Ord IndefUnitId where
+  u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2
+
+instance Binary IndefUnitId where
+  put_ bh indef = do
+    put_ bh (indefUnitIdComponentId indef)
+    put_ bh (indefUnitIdInsts indef)
+  get bh = do
+    cid   <- get bh
+    insts <- get bh
+    let fs = hashUnitId cid insts
+    return IndefUnitId {
+            indefUnitIdComponentId = cid,
+            indefUnitIdInsts = insts,
+            indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
+            indefUnitIdFS = fs,
+            indefUnitIdKey = getUnique fs
+           }
+
+-- | Create a new 'IndefUnitId' given an explicit module substitution.
+newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId
+newIndefUnitId cid insts =
+    IndefUnitId {
+        indefUnitIdComponentId = cid,
+        indefUnitIdInsts = sorted_insts,
+        indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
+        indefUnitIdFS = fs,
+        indefUnitIdKey = getUnique fs
+    }
+  where
+     fs = hashUnitId cid sorted_insts
+     sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
+
+-- | Injects an 'IndefUnitId' (indefinite library which
+-- was on-the-fly instantiated) to a 'UnitId' (either
+-- an indefinite or definite library).
+indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId
+indefUnitIdToUnitId dflags iuid =
+    -- NB: suppose that we want to compare the indefinite
+    -- unit id p[H=impl:H] against p+abcd (where p+abcd
+    -- happens to be the existing, installed version of
+    -- p[H=impl:H].  If we *only* wrap in p[H=impl:H]
+    -- IndefiniteUnitId, they won't compare equal; only
+    -- after improvement will the equality hold.
+    improveUnitId (getUnitInfoMap dflags) $
+        IndefiniteUnitId iuid
+
+data IndefModule = IndefModule {
+        indefModuleUnitId :: IndefUnitId,
+        indefModuleName   :: ModuleName
+    } deriving (Eq, Ord)
+
+instance Outputable IndefModule where
+  ppr (IndefModule uid m) =
+    ppr uid <> char ':' <> ppr m
+
+-- | Injects an 'IndefModule' to 'Module' (see also
+-- 'indefUnitIdToUnitId'.
+indefModuleToModule :: DynFlags -> IndefModule -> Module
+indefModuleToModule dflags (IndefModule iuid mod_name) =
+    mkModule (indefUnitIdToUnitId dflags iuid) mod_name
+
+-- | An installed unit identifier identifies a library which has
+-- been installed to the package database.  These strings are
+-- provided to us via the @-this-unit-id@ flag.  The library
+-- in question may be definite or indefinite; if it is indefinite,
+-- none of the holes have been filled (we never install partially
+-- instantiated libraries.)  Put another way, an installed unit id
+-- is either fully instantiated, or not instantiated at all.
+--
+-- Installed unit identifiers look something like @p+af23SAj2dZ219@,
+-- or maybe just @p@ if they don't use Backpack.
+newtype InstalledUnitId =
+    InstalledUnitId {
+      -- | The full hashed unit identifier, including the component id
+      -- and the hash.
+      installedUnitIdFS :: FastString
+    }
+
+instance Binary InstalledUnitId where
+  put_ bh (InstalledUnitId fs) = put_ bh fs
+  get bh = do fs <- get bh; return (InstalledUnitId fs)
+
+instance BinaryStringRep InstalledUnitId where
+  fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)
+  -- GHC doesn't write to database
+  toStringRep   = error "BinaryStringRep InstalledUnitId: not implemented"
+
+instance Eq InstalledUnitId where
+    uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2
+
+instance Ord InstalledUnitId where
+    u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2
+
+instance Uniquable InstalledUnitId where
+    getUnique = installedUnitIdKey
+
+instance Outputable InstalledUnitId where
+    ppr uid@(InstalledUnitId fs) =
+        getPprStyle $ \sty ->
+        sdocWithDynFlags $ \dflags ->
+          case displayInstalledUnitId dflags uid of
+            Just str | not (debugStyle sty) -> text str
+            _ -> ftext fs
+
+installedUnitIdKey :: InstalledUnitId -> Unique
+installedUnitIdKey = getUnique . installedUnitIdFS
+
+-- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.
+toInstalledUnitId :: UnitId -> InstalledUnitId
+toInstalledUnitId (DefiniteUnitId (DefUnitId iuid)) = iuid
+toInstalledUnitId (IndefiniteUnitId indef) =
+    componentIdToInstalledUnitId (indefUnitIdComponentId indef)
+
+installedUnitIdString :: InstalledUnitId -> String
+installedUnitIdString = unpackFS . installedUnitIdFS
+
+instance Outputable IndefUnitId where
+    ppr uid =
+      -- getPprStyle $ \sty ->
+      ppr cid <>
+        (if not (null insts) -- pprIf
+          then
+            brackets (hcat
+                (punctuate comma $
+                    [ ppr modname <> text "=" <> ppr m
+                    | (modname, m) <- insts]))
+          else empty)
+     where
+      cid   = indefUnitIdComponentId uid
+      insts = indefUnitIdInsts uid
+
+-- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.
+data InstalledModule = InstalledModule {
+   installedModuleUnitId :: !InstalledUnitId,
+   installedModuleName :: !ModuleName
+  }
+  deriving (Eq, Ord)
+
+instance Outputable InstalledModule where
+  ppr (InstalledModule p n) =
+    ppr p <> char ':' <> pprModuleName n
+
+fsToInstalledUnitId :: FastString -> InstalledUnitId
+fsToInstalledUnitId fs = InstalledUnitId fs
+
+componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
+componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs
+
+stringToInstalledUnitId :: String -> InstalledUnitId
+stringToInstalledUnitId = fsToInstalledUnitId . mkFastString
+
+-- | Test if a 'Module' corresponds to a given 'InstalledModule',
+-- modulo instantiation.
+installedModuleEq :: InstalledModule -> Module -> Bool
+installedModuleEq imod mod =
+    fst (splitModuleInsts mod) == imod
+
+-- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',
+-- modulo instantiation.
+installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool
+installedUnitIdEq iuid uid =
+    fst (splitUnitIdInsts uid) == iuid
+
+-- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that
+-- it only refers to a definite library; i.e., one we have generated
+-- code for.
+newtype DefUnitId = DefUnitId { unDefUnitId :: InstalledUnitId }
+    deriving (Eq, Ord)
+
+instance Outputable DefUnitId where
+    ppr (DefUnitId uid) = ppr uid
+
+instance Binary DefUnitId where
+    put_ bh (DefUnitId uid) = put_ bh uid
+    get bh = do uid <- get bh; return (DefUnitId uid)
+
+-- | A map keyed off of 'InstalledModule'
+newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
+
+emptyInstalledModuleEnv :: InstalledModuleEnv a
+emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
+
+lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
+lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
+
+extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
+extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
+
+filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
+filterInstalledModuleEnv f (InstalledModuleEnv e) =
+  InstalledModuleEnv (Map.filterWithKey f e)
+
+delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
+delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
+
+-- Note [UnitId to InstalledUnitId improvement]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Just because a UnitId is definite (has no holes) doesn't
+-- mean it's necessarily a InstalledUnitId; it could just be
+-- that over the course of renaming UnitIds on the fly
+-- while typechecking an indefinite library, we
+-- ended up with a fully instantiated unit id with no hash,
+-- since we haven't built it yet.  This is fine.
+--
+-- However, if there is a hashed unit id for this instantiation
+-- in the package database, we *better use it*, because
+-- that hashed unit id may be lurking in another interface,
+-- and chaos will ensue if we attempt to compare the two
+-- (the unitIdFS for a UnitId never corresponds to a Cabal-provided
+-- hash of a compiled instantiated library).
+--
+-- There is one last niggle: improvement based on the package database means
+-- that we might end up developing on a package that is not transitively
+-- depended upon by the packages the user specified directly via command line
+-- flags.  This could lead to strange and difficult to understand bugs if those
+-- instantiations are out of date.  The solution is to only improve a
+-- unit id if the new unit id is part of the 'preloadClosure'; i.e., the
+-- closure of all the packages which were explicitly specified.
+
+-- | Retrieve the set of free holes of a 'UnitId'.
+unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
+unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x
+-- Hashed unit ids are always fully instantiated
+unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet
+
+instance Show UnitId where
+    show = unitIdString
+
+-- | A 'UnitId' is definite if it has no free holes.
+unitIdIsDefinite :: UnitId -> Bool
+unitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles
+
+-- | Generate a uniquely identifying 'FastString' for a unit
+-- identifier.  This is a one-way function.  You can rely on one special
+-- property: if a unit identifier is in most general form, its 'FastString'
+-- coincides with its 'ComponentId'.  This hash is completely internal
+-- to GHC and is not used for symbol names or file paths.
+hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
+hashUnitId cid sorted_holes =
+    mkFastStringByteString
+  . fingerprintUnitId (toStringRep cid)
+  $ rawHashUnitId sorted_holes
+
+-- | Generate a hash for a sorted module substitution.
+rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
+rawHashUnitId sorted_holes =
+    fingerprintByteString
+  . BS.concat $ do
+        (m, b) <- sorted_holes
+        [ toStringRep m,                BS.Char8.singleton ' ',
+          bytesFS (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
+          toStringRep (moduleName b),   BS.Char8.singleton '\n']
+
+fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
+fingerprintUnitId prefix (Fingerprint a b)
+    = BS.concat
+    $ [ prefix
+      , BS.Char8.singleton '-'
+      , BS.Char8.pack (toBase62Padded a)
+      , BS.Char8.pack (toBase62Padded b) ]
+
+-- | Create a new, un-hashed unit identifier.
+newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId
+newUnitId cid [] = newSimpleUnitId cid -- TODO: this indicates some latent bug...
+newUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts
+
+pprUnitId :: UnitId -> SDoc
+pprUnitId (DefiniteUnitId uid) = ppr uid
+pprUnitId (IndefiniteUnitId uid) = ppr uid
+
+instance Eq UnitId where
+  uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2
+
+instance Uniquable UnitId where
+  getUnique = unitIdKey
+
+instance Ord UnitId where
+  nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2
+
+instance Data UnitId where
+  -- don't traverse?
+  toConstr _   = abstractConstr "UnitId"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "UnitId"
+
+instance NFData UnitId where
+  rnf x = x `seq` ()
+
+stableUnitIdCmp :: UnitId -> UnitId -> Ordering
+-- ^ Compares package ids lexically, rather than by their 'Unique's
+stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2
+
+instance Outputable UnitId where
+   ppr pk = pprUnitId pk
+
+-- Performance: would prefer to have a NameCache like thing
+instance Binary UnitId where
+  put_ bh (DefiniteUnitId def_uid) = do
+    putByte bh 0
+    put_ bh def_uid
+  put_ bh (IndefiniteUnitId indef_uid) = do
+    putByte bh 1
+    put_ bh indef_uid
+  get bh = do b <- getByte bh
+              case b of
+                0 -> fmap DefiniteUnitId   (get bh)
+                _ -> fmap IndefiniteUnitId (get bh)
+
+instance Binary ComponentId where
+  put_ bh (ComponentId fs) = put_ bh fs
+  get bh = do { fs <- get bh; return (ComponentId fs) }
+
+-- | Create a new simple unit identifier (no holes) from a 'ComponentId'.
+newSimpleUnitId :: ComponentId -> UnitId
+newSimpleUnitId (ComponentId fs) = fsToUnitId fs
+
+-- | Create a new simple unit identifier from a 'FastString'.  Internally,
+-- this is primarily used to specify wired-in unit identifiers.
+fsToUnitId :: FastString -> UnitId
+fsToUnitId = DefiniteUnitId . DefUnitId . InstalledUnitId
+
+stringToUnitId :: String -> UnitId
+stringToUnitId = fsToUnitId . mkFastString
+
+unitIdString :: UnitId -> String
+unitIdString = unpackFS . unitIdFS
+
+{-
+************************************************************************
+*                                                                      *
+                        Hole substitutions
+*                                                                      *
+************************************************************************
+-}
+
+-- | Substitution on module variables, mapping module names to module
+-- identifiers.
+type ShHoleSubst = ModuleNameEnv Module
+
+-- | Substitutes holes in a 'Module'.  NOT suitable for being called
+-- directly on a 'nameModule', see Note [Representation of module/name variable].
+-- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
+-- similarly, @<A>@ maps to @q():A@.
+renameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module
+renameHoleModule dflags = renameHoleModule' (getUnitInfoMap dflags)
+
+-- | Substitutes holes in a 'UnitId', suitable for renaming when
+-- an include occurs; see Note [Representation of module/name variable].
+--
+-- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.
+renameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId
+renameHoleUnitId dflags = renameHoleUnitId' (getUnitInfoMap dflags)
+
+-- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
+-- so it can be used by "Packages".
+renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
+renameHoleModule' pkg_map env m
+  | not (isHoleModule m) =
+        let uid = renameHoleUnitId' pkg_map env (moduleUnitId m)
+        in mkModule uid (moduleName m)
+  | Just m' <- lookupUFM env (moduleName m) = m'
+  -- NB m = <Blah>, that's what's in scope.
+  | otherwise = m
+
+-- | Like 'renameHoleUnitId, but requires only 'UnitInfoMap'
+-- so it can be used by "Packages".
+renameHoleUnitId' :: UnitInfoMap -> ShHoleSubst -> UnitId -> UnitId
+renameHoleUnitId' pkg_map env uid =
+    case uid of
+      (IndefiniteUnitId
+        IndefUnitId{ indefUnitIdComponentId = cid
+                   , indefUnitIdInsts       = insts
+                   , indefUnitIdFreeHoles   = fh })
+          -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
+                then uid
+                -- Functorially apply the substitution to the instantiation,
+                -- then check the 'UnitInfoMap' to see if there is
+                -- a compiled version of this 'UnitId' we can improve to.
+                -- See Note [UnitId to InstalledUnitId] improvement
+                else improveUnitId pkg_map $
+                        newUnitId cid
+                            (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
+      _ -> uid
+
+-- | Given a possibly on-the-fly instantiated module, split it into
+-- a 'Module' that we definitely can find on-disk, as well as an
+-- instantiation if we need to instantiate it on the fly.  If the
+-- instantiation is @Nothing@ no on-the-fly renaming is needed.
+splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)
+splitModuleInsts m =
+    let (uid, mb_iuid) = splitUnitIdInsts (moduleUnitId m)
+    in (InstalledModule uid (moduleName m),
+        fmap (\iuid -> IndefModule iuid (moduleName m)) mb_iuid)
+
+-- | See 'splitModuleInsts'.
+splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)
+splitUnitIdInsts (IndefiniteUnitId iuid) =
+    (componentIdToInstalledUnitId (indefUnitIdComponentId iuid), Just iuid)
+splitUnitIdInsts (DefiniteUnitId (DefUnitId uid)) = (uid, Nothing)
+
+generalizeIndefUnitId :: IndefUnitId -> IndefUnitId
+generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid
+                                 , indefUnitIdInsts = insts } =
+    newIndefUnitId cid (map (\(m,_) -> (m, mkHoleModule m)) insts)
+
+generalizeIndefModule :: IndefModule -> IndefModule
+generalizeIndefModule (IndefModule uid n) = IndefModule (generalizeIndefUnitId uid) n
+
+parseModuleName :: ReadP ModuleName
+parseModuleName = fmap mkModuleName
+                $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
+
+parseUnitId :: ReadP UnitId
+parseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId
+  where
+    parseFullUnitId = do
+        cid <- parseComponentId
+        insts <- parseModSubst
+        return (newUnitId cid insts)
+    parseDefiniteUnitId = do
+        s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
+        return (stringToUnitId s)
+    parseSimpleUnitId = do
+        cid <- parseComponentId
+        return (newSimpleUnitId cid)
+
+parseComponentId :: ReadP ComponentId
+parseComponentId = (ComponentId . mkFastString)  `fmap` Parse.munch1 abi_char
+   where abi_char c = isAlphaNum c || c `elem` "-_."
+
+parseModuleId :: ReadP Module
+parseModuleId = parseModuleVar <++ parseModule
+    where
+      parseModuleVar = do
+        _ <- Parse.char '<'
+        modname <- parseModuleName
+        _ <- Parse.char '>'
+        return (mkHoleModule modname)
+      parseModule = do
+        uid <- parseUnitId
+        _ <- Parse.char ':'
+        modname <- parseModuleName
+        return (mkModule uid modname)
+
+parseModSubst :: ReadP [(ModuleName, Module)]
+parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
+      . flip Parse.sepBy (Parse.char ',')
+      $ do k <- parseModuleName
+           _ <- Parse.char '='
+           v <- parseModuleId
+           return (k, v)
+
+
+{-
+Note [Wired-in packages]
+~~~~~~~~~~~~~~~~~~~~~~~~
+
+Certain packages are known to the compiler, in that we know about certain
+entities that reside in these packages, and the compiler needs to
+declare static Modules and Names that refer to these packages.  Hence
+the wired-in packages can't include version numbers in their package UnitId,
+since we don't want to bake the version numbers of these packages into GHC.
+
+So here's the plan.  Wired-in packages are still versioned as
+normal in the packages database, and you can still have multiple
+versions of them installed. To the user, everything looks normal.
+
+However, for each invocation of GHC, only a single instance of each wired-in
+package will be recognised (the desired one is selected via
+@-package@\/@-hide-package@), and GHC will internally pretend that it has the
+*unversioned* 'UnitId', including in .hi files and object file symbols.
+
+Unselected versions of wired-in packages will be ignored, as will any other
+package that depends directly or indirectly on it (much as if you
+had used @-ignore-package@).
+
+The affected packages are compiled with, e.g., @-this-unit-id base@, so that
+the symbols in the object files have the unversioned unit id in their name.
+
+Make sure you change 'Packages.findWiredInPackages' if you add an entry here.
+
+For `integer-gmp`/`integer-simple` we also change the base name to
+`integer-wired-in`, but this is fundamentally no different.
+See Note [The integer library] in PrelNames.
+-}
+
+integerUnitId, primUnitId,
+  baseUnitId, rtsUnitId,
+  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId
+primUnitId        = fsToUnitId (fsLit "ghc-prim")
+integerUnitId     = fsToUnitId (fsLit "integer-wired-in")
+   -- See Note [The integer library] in PrelNames
+baseUnitId        = fsToUnitId (fsLit "base")
+rtsUnitId         = fsToUnitId (fsLit "rts")
+thUnitId          = fsToUnitId (fsLit "template-haskell")
+thisGhcUnitId     = fsToUnitId (fsLit "ghc")
+interactiveUnitId = fsToUnitId (fsLit "interactive")
+
+-- | This is the package Id for the current program.  It is the default
+-- package Id if you don't specify a package name.  We don't add this prefix
+-- to symbol names, since there can be only one main package per program.
+mainUnitId      = fsToUnitId (fsLit "main")
+
+-- | This is a fake package id used to provide identities to any un-implemented
+-- signatures.  The set of hole identities is global over an entire compilation.
+-- Don't use this directly: use 'mkHoleModule' or 'isHoleModule' instead.
+-- See Note [Representation of module/name variables]
+holeUnitId :: UnitId
+holeUnitId      = fsToUnitId (fsLit "hole")
+
+isInteractiveModule :: Module -> Bool
+isInteractiveModule mod = moduleUnitId mod == interactiveUnitId
+
+-- Note [Representation of module/name variables]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent
+-- name holes.  This could have been represented by adding some new cases
+-- to the core data types, but this would have made the existing 'nameModule'
+-- and 'moduleUnitId' partial, which would have required a lot of modifications
+-- to existing code.
+--
+-- Instead, we adopted the following encoding scheme:
+--
+--      <A>   ===> hole:A
+--      {A.T} ===> hole:A.T
+--
+-- This encoding is quite convenient, but it is also a bit dangerous too,
+-- because if you have a 'hole:A' you need to know if it's actually a
+-- 'Module' or just a module stored in a 'Name'; these two cases must be
+-- treated differently when doing substitutions.  'renameHoleModule'
+-- and 'renameHoleUnitId' assume they are NOT operating on a
+-- 'Name'; 'NameShape' handles name substitutions exclusively.
+
+isHoleModule :: Module -> Bool
+isHoleModule mod = moduleUnitId mod == holeUnitId
+
+wiredInUnitIds :: [UnitId]
+wiredInUnitIds = [ primUnitId,
+                       integerUnitId,
+                       baseUnitId,
+                       rtsUnitId,
+                       thUnitId,
+                       thisGhcUnitId ]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{@ModuleEnv@s}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A map keyed off of 'Module's
+newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
+
+{-
+Note [ModuleEnv performance and determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To prevent accidental reintroduction of nondeterminism the Ord instance
+for Module was changed to not depend on Unique ordering and to use the
+lexicographic order. This is potentially expensive, but when measured
+there was no difference in performance.
+
+To be on the safe side and not pessimize ModuleEnv uses nondeterministic
+ordering on Module and normalizes by doing the lexicographic sort when
+turning the env to a list.
+See Note [Unique Determinism] for more information about the source of
+nondeterminismand and Note [Deterministic UniqFM] for explanation of why
+it matters for maps.
+-}
+
+newtype NDModule = NDModule { unNDModule :: Module }
+  deriving Eq
+  -- A wrapper for Module with faster nondeterministic Ord.
+  -- Don't export, See [ModuleEnv performance and determinism]
+
+instance Ord NDModule where
+  compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
+    (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
+    (getUnique n1 `nonDetCmpUnique` getUnique n2)
+
+filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
+filterModuleEnv f (ModuleEnv e) =
+  ModuleEnv (Map.filterWithKey (f . unNDModule) e)
+
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
+
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
+
+extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
+                    -> ModuleEnv a
+extendModuleEnvWith f (ModuleEnv e) m x =
+  ModuleEnv (Map.insertWith f (NDModule m) x e)
+
+extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
+extendModuleEnvList (ModuleEnv e) xs =
+  ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
+
+extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
+                      -> ModuleEnv a
+extendModuleEnvList_C f (ModuleEnv e) xs =
+  ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
+
+plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
+  ModuleEnv (Map.unionWith f e1 e2)
+
+delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
+delModuleEnvList (ModuleEnv e) ms =
+  ModuleEnv (Map.deleteList (map NDModule ms) e)
+
+delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
+delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
+
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
+
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
+
+lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
+lookupWithDefaultModuleEnv (ModuleEnv e) x m =
+  Map.findWithDefault x (NDModule m) e
+
+mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
+mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
+
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
+
+emptyModuleEnv :: ModuleEnv a
+emptyModuleEnv = ModuleEnv Map.empty
+
+moduleEnvKeys :: ModuleEnv a -> [Module]
+moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
+  -- See Note [ModuleEnv performance and determinism]
+
+moduleEnvElts :: ModuleEnv a -> [a]
+moduleEnvElts e = map snd $ moduleEnvToList e
+  -- See Note [ModuleEnv performance and determinism]
+
+moduleEnvToList :: ModuleEnv a -> [(Module, a)]
+moduleEnvToList (ModuleEnv e) =
+  sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
+  -- See Note [ModuleEnv performance and determinism]
+
+unitModuleEnv :: Module -> a -> ModuleEnv a
+unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+isEmptyModuleEnv (ModuleEnv e) = Map.null e
+
+-- | A set of 'Module's
+type ModuleSet = Set NDModule
+
+mkModuleSet :: [Module] -> ModuleSet
+mkModuleSet = Set.fromList . coerce
+
+extendModuleSet :: ModuleSet -> Module -> ModuleSet
+extendModuleSet s m = Set.insert (NDModule m) s
+
+extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
+extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
+
+emptyModuleSet :: ModuleSet
+emptyModuleSet = Set.empty
+
+moduleSetElts :: ModuleSet -> [Module]
+moduleSetElts = sort . coerce . Set.toList
+
+elemModuleSet :: Module -> ModuleSet -> Bool
+elemModuleSet = Set.member . coerce
+
+intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
+intersectModuleSet = coerce Set.intersection
+
+minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
+minusModuleSet = coerce Set.difference
+
+delModuleSet :: ModuleSet -> Module -> ModuleSet
+delModuleSet = coerce (flip Set.delete)
+
+unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
+unionModuleSet = coerce Set.union
+
+unitModuleSet :: Module -> ModuleSet
+unitModuleSet = coerce Set.singleton
+
+{-
+A ModuleName has a Unique, so we can build mappings of these using
+UniqFM.
+-}
+
+-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
+type ModuleNameEnv elt = UniqFM elt
+
+
+-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
+-- Has deterministic folds and can be deterministically converted to a list
+type DModuleNameEnv elt = UniqDFM elt
diff --git a/compiler/GHC/Types/Module.hs-boot b/compiler/GHC/Types/Module.hs-boot
new file mode 100644
index 0000000000..1f2fec56d7
--- /dev/null
+++ b/compiler/GHC/Types/Module.hs-boot
@@ -0,0 +1,14 @@
+module GHC.Types.Module where
+
+import GhcPrelude
+import FastString
+
+data Module
+data ModuleName
+data UnitId
+data InstalledUnitId
+newtype ComponentId = ComponentId FastString
+
+moduleName :: Module -> ModuleName
+moduleUnitId :: Module -> UnitId
+unitIdString :: UnitId -> String
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
new file mode 100644
index 0000000000..60aee23af8
--- /dev/null
+++ b/compiler/GHC/Types/Name.hs
@@ -0,0 +1,693 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[Name]{@Name@: to transmit name info from renamer to typechecker}
+-}
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName': see "OccName#name_types"
+--
+-- * 'RdrName.RdrName': see "RdrName#name_types"
+--
+-- *  'Name.Name' is the type of names that have had their scoping and binding resolved. They
+--   have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have
+--   the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names
+--   also contain information about where they originated from, see "Name#name_sorts"
+--
+-- * 'Id.Id': see "Id#name_types"
+--
+-- * 'Var.Var': see "Var#name_types"
+--
+-- #name_sorts#
+-- Names are one of:
+--
+--  * External, if they name things declared in other modules. Some external
+--    Names are wired in, i.e. they name primitives defined in the compiler itself
+--
+--  * Internal, if they name things in the module being compiled. Some internal
+--    Names are system names, if they are names manufactured by the compiler
+
+module GHC.Types.Name (
+        -- * The main types
+        Name,                                   -- Abstract
+        BuiltInSyntax(..),
+
+        -- ** Creating 'Name's
+        mkSystemName, mkSystemNameAt,
+        mkInternalName, mkClonedInternalName, mkDerivedInternalName,
+        mkSystemVarName, mkSysTvName,
+        mkFCallName,
+        mkExternalName, mkWiredInName,
+
+        -- ** Manipulating and deconstructing 'Name's
+        nameUnique, setNameUnique,
+        nameOccName, nameNameSpace, nameModule, nameModule_maybe,
+        setNameLoc,
+        tidyNameOcc,
+        localiseName,
+
+        nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
+
+        -- ** Predicates on 'Name's
+        isSystemName, isInternalName, isExternalName,
+        isTyVarName, isTyConName, isDataConName,
+        isValName, isVarName,
+        isWiredInName, isWiredIn, isBuiltInSyntax,
+        isHoleName,
+        wiredInNameTyThing_maybe,
+        nameIsLocalOrFrom, nameIsHomePackage,
+        nameIsHomePackageImport, nameIsFromExternalPackage,
+        stableNameCmp,
+
+        -- * Class 'NamedThing' and overloaded friends
+        NamedThing(..),
+        getSrcLoc, getSrcSpan, getOccString, getOccFS,
+
+        pprInfixName, pprPrefixName, pprModulePrefix, pprNameUnqualified,
+        nameStableString,
+
+        -- Re-export the OccName stuff
+        module GHC.Types.Name.Occurrence
+    ) where
+
+import GhcPrelude
+
+import {-# SOURCE #-} GHC.Core.TyCo.Rep( TyThing )
+
+import GHC.Types.Name.Occurrence
+import GHC.Types.Module
+import GHC.Types.SrcLoc
+import GHC.Types.Unique
+import Util
+import Maybes
+import Binary
+import FastString
+import Outputable
+
+import Control.DeepSeq
+import Data.Data
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Name-datatype]{The @Name@ datatype, and name construction}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A unique, unambiguous name for something, containing information about where
+-- that thing originated.
+data Name = Name {
+                n_sort :: NameSort,     -- What sort of name it is
+                n_occ  :: !OccName,     -- Its occurrence name
+                n_uniq :: {-# UNPACK #-} !Unique,
+                n_loc  :: !SrcSpan      -- Definition site
+            }
+
+-- NOTE: we make the n_loc field strict to eliminate some potential
+-- (and real!) space leaks, due to the fact that we don't look at
+-- the SrcLoc in a Name all that often.
+
+-- See Note [About the NameSorts]
+data NameSort
+  = External Module
+
+  | WiredIn Module TyThing BuiltInSyntax
+        -- A variant of External, for wired-in things
+
+  | Internal            -- A user-defined Id or TyVar
+                        -- defined in the module being compiled
+
+  | System              -- A system-defined Id or TyVar.  Typically the
+                        -- OccName is very uninformative (like 's')
+
+instance Outputable NameSort where
+  ppr (External _)    = text "external"
+  ppr (WiredIn _ _ _) = text "wired-in"
+  ppr  Internal       = text "internal"
+  ppr  System         = text "system"
+
+instance NFData Name where
+  rnf Name{..} = rnf n_sort
+
+instance NFData NameSort where
+  rnf (External m) = rnf m
+  rnf (WiredIn m t b) = rnf m `seq` t `seq` b `seq` ()
+    -- XXX this is a *lie*, we're not going to rnf the TyThing, but
+    -- since the TyThings for WiredIn Names are all static they can't
+    -- be hiding space leaks or errors.
+  rnf Internal = ()
+  rnf System = ()
+
+-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples,
+-- which have special syntactic forms.  They aren't in scope
+-- as such.
+data BuiltInSyntax = BuiltInSyntax | UserSyntax
+
+{-
+Note [About the NameSorts]
+
+1.  Initially, top-level Ids (including locally-defined ones) get External names,
+    and all other local Ids get Internal names
+
+2.  In any invocation of GHC, an External Name for "M.x" has one and only one
+    unique.  This unique association is ensured via the Name Cache;
+    see Note [The Name Cache] in GHC.Iface.Env.
+
+3.  Things with a External name are given C static labels, so they finally
+    appear in the .o file's symbol table.  They appear in the symbol table
+    in the form M.n.  If originally-local things have this property they
+    must be made @External@ first.
+
+4.  In the tidy-core phase, a External that is not visible to an importer
+    is changed to Internal, and a Internal that is visible is changed to External
+
+5.  A System Name differs in the following ways:
+        a) has unique attached when printing dumps
+        b) unifier eliminates sys tyvars in favour of user provs where possible
+
+    Before anything gets printed in interface files or output code, it's
+    fed through a 'tidy' processor, which zaps the OccNames to have
+    unique names; and converts all sys-locals to user locals
+    If any desugarer sys-locals have survived that far, they get changed to
+    "ds1", "ds2", etc.
+
+Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])
+
+Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler,
+                   not read from an interface file.
+                   E.g. Bool, True, Int, Float, and many others
+
+All built-in syntax is for wired-in things.
+-}
+
+instance HasOccName Name where
+  occName = nameOccName
+
+nameUnique              :: Name -> Unique
+nameOccName             :: Name -> OccName
+nameNameSpace           :: Name -> NameSpace
+nameModule              :: HasDebugCallStack => Name -> Module
+nameSrcLoc              :: Name -> SrcLoc
+nameSrcSpan             :: Name -> SrcSpan
+
+nameUnique    name = n_uniq name
+nameOccName   name = n_occ  name
+nameNameSpace name = occNameSpace (n_occ name)
+nameSrcLoc    name = srcSpanStart (n_loc name)
+nameSrcSpan   name = n_loc  name
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Predicates on names}
+*                                                                      *
+************************************************************************
+-}
+
+isInternalName    :: Name -> Bool
+isExternalName    :: Name -> Bool
+isSystemName      :: Name -> Bool
+isWiredInName     :: Name -> Bool
+
+isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
+isWiredInName _                               = False
+
+isWiredIn :: NamedThing thing => thing -> Bool
+isWiredIn = isWiredInName . getName
+
+wiredInNameTyThing_maybe :: Name -> Maybe TyThing
+wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
+wiredInNameTyThing_maybe _                                   = Nothing
+
+isBuiltInSyntax :: Name -> Bool
+isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
+isBuiltInSyntax _                                           = False
+
+isExternalName (Name {n_sort = External _})    = True
+isExternalName (Name {n_sort = WiredIn _ _ _}) = True
+isExternalName _                               = False
+
+isInternalName name = not (isExternalName name)
+
+isHoleName :: Name -> Bool
+isHoleName = isHoleModule . nameModule
+
+nameModule name =
+  nameModule_maybe name `orElse`
+  pprPanic "nameModule" (ppr (n_sort name) <+> ppr name)
+
+nameModule_maybe :: Name -> Maybe Module
+nameModule_maybe (Name { n_sort = External mod})    = Just mod
+nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
+nameModule_maybe _                                  = Nothing
+
+nameIsLocalOrFrom :: Module -> Name -> Bool
+-- ^ Returns True if the name is
+--   (a) Internal
+--   (b) External but from the specified module
+--   (c) External but from the 'interactive' package
+--
+-- The key idea is that
+--    False means: the entity is defined in some other module
+--                 you can find the details (type, fixity, instances)
+--                     in some interface file
+--                 those details will be stored in the EPT or HPT
+--
+--    True means:  the entity is defined in this module or earlier in
+--                     the GHCi session
+--                 you can find details (type, fixity, instances) in the
+--                     TcGblEnv or TcLclEnv
+--
+-- The isInteractiveModule part is because successive interactions of a GHCi session
+-- each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come
+-- from the magic 'interactive' package; and all the details are kept in the
+-- TcLclEnv, TcGblEnv, NOT in the HPT or EPT.
+-- See Note [The interactive package] in GHC.Driver.Types
+
+nameIsLocalOrFrom from name
+  | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod
+  | otherwise                         = True
+
+nameIsHomePackage :: Module -> Name -> Bool
+-- True if the Name is defined in module of this package
+nameIsHomePackage this_mod
+  = \nm -> case n_sort nm of
+              External nm_mod    -> moduleUnitId nm_mod == this_pkg
+              WiredIn nm_mod _ _ -> moduleUnitId nm_mod == this_pkg
+              Internal -> True
+              System   -> False
+  where
+    this_pkg = moduleUnitId this_mod
+
+nameIsHomePackageImport :: Module -> Name -> Bool
+-- True if the Name is defined in module of this package
+-- /other than/ the this_mod
+nameIsHomePackageImport this_mod
+  = \nm -> case nameModule_maybe nm of
+              Nothing -> False
+              Just nm_mod -> nm_mod /= this_mod
+                          && moduleUnitId nm_mod == this_pkg
+  where
+    this_pkg = moduleUnitId this_mod
+
+-- | Returns True if the Name comes from some other package: neither this
+-- package nor the interactive package.
+nameIsFromExternalPackage :: UnitId -> Name -> Bool
+nameIsFromExternalPackage this_pkg name
+  | Just mod <- nameModule_maybe name
+  , moduleUnitId mod /= this_pkg    -- Not this package
+  , not (isInteractiveModule mod)       -- Not the 'interactive' package
+  = True
+  | otherwise
+  = False
+
+isTyVarName :: Name -> Bool
+isTyVarName name = isTvOcc (nameOccName name)
+
+isTyConName :: Name -> Bool
+isTyConName name = isTcOcc (nameOccName name)
+
+isDataConName :: Name -> Bool
+isDataConName name = isDataOcc (nameOccName name)
+
+isValName :: Name -> Bool
+isValName name = isValOcc (nameOccName name)
+
+isVarName :: Name -> Bool
+isVarName = isVarOcc . nameOccName
+
+isSystemName (Name {n_sort = System}) = True
+isSystemName _                        = False
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Making names}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Create a name which is (for now at least) local to the current module and hence
+-- does not need a 'Module' to disambiguate it from other 'Name's
+mkInternalName :: Unique -> OccName -> SrcSpan -> Name
+mkInternalName uniq occ loc = Name { n_uniq = uniq
+                                   , n_sort = Internal
+                                   , n_occ = occ
+                                   , n_loc = loc }
+        -- NB: You might worry that after lots of huffing and
+        -- puffing we might end up with two local names with distinct
+        -- uniques, but the same OccName.  Indeed we can, but that's ok
+        --      * the insides of the compiler don't care: they use the Unique
+        --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the
+        --        uniques if you get confused
+        --      * for interface files we tidyCore first, which makes
+        --        the OccNames distinct when they need to be
+
+mkClonedInternalName :: Unique -> Name -> Name
+mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })
+  = Name { n_uniq = uniq, n_sort = Internal
+         , n_occ = occ, n_loc = loc }
+
+mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
+mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
+  = Name { n_uniq = uniq, n_sort = Internal
+         , n_occ = derive_occ occ, n_loc = loc }
+
+-- | Create a name which definitely originates in the given module
+mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
+-- WATCH OUT! External Names should be in the Name Cache
+-- (see Note [The Name Cache] in GHC.Iface.Env), so don't just call mkExternalName
+-- with some fresh unique without populating the Name Cache
+mkExternalName uniq mod occ loc
+  = Name { n_uniq = uniq, n_sort = External mod,
+           n_occ = occ, n_loc = loc }
+
+-- | Create a name which is actually defined by the compiler itself
+mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
+mkWiredInName mod occ uniq thing built_in
+  = Name { n_uniq = uniq,
+           n_sort = WiredIn mod thing built_in,
+           n_occ = occ, n_loc = wiredInSrcSpan }
+
+-- | Create a name brought into being by the compiler
+mkSystemName :: Unique -> OccName -> Name
+mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan
+
+mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
+mkSystemNameAt uniq occ loc = Name { n_uniq = uniq, n_sort = System
+                                   , n_occ = occ, n_loc = loc }
+
+mkSystemVarName :: Unique -> FastString -> Name
+mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
+
+mkSysTvName :: Unique -> FastString -> Name
+mkSysTvName uniq fs = mkSystemName uniq (mkTyVarOccFS fs)
+
+-- | Make a name for a foreign call
+mkFCallName :: Unique -> String -> Name
+mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan
+   -- The encoded string completely describes the ccall
+
+-- When we renumber/rename things, we need to be
+-- able to change a Name's Unique to match the cached
+-- one in the thing it's the name of.  If you know what I mean.
+setNameUnique :: Name -> Unique -> Name
+setNameUnique name uniq = name {n_uniq = uniq}
+
+-- This is used for hsigs: we want to use the name of the originally exported
+-- entity, but edit the location to refer to the reexport site
+setNameLoc :: Name -> SrcSpan -> Name
+setNameLoc name loc = name {n_loc = loc}
+
+tidyNameOcc :: Name -> OccName -> Name
+-- We set the OccName of a Name when tidying
+-- In doing so, we change System --> Internal, so that when we print
+-- it we don't get the unique by default.  It's tidy now!
+tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
+tidyNameOcc name                            occ = name { n_occ = occ }
+
+-- | Make the 'Name' into an internal name, regardless of what it was to begin with
+localiseName :: Name -> Name
+localiseName n = n { n_sort = Internal }
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Hashing and comparison}
+*                                                                      *
+************************************************************************
+-}
+
+cmpName :: Name -> Name -> Ordering
+cmpName n1 n2 = n_uniq n1 `nonDetCmpUnique` n_uniq n2
+
+-- | Compare Names lexicographically
+-- This only works for Names that originate in the source code or have been
+-- tidied.
+stableNameCmp :: Name -> Name -> Ordering
+stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
+              (Name { n_sort = s2, n_occ = occ2 })
+  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)
+    -- The ordinary compare on OccNames is lexicographic
+  where
+    -- Later constructors are bigger
+    sort_cmp (External m1) (External m2)       = m1 `stableModuleCmp` m2
+    sort_cmp (External {}) _                   = LT
+    sort_cmp (WiredIn {}) (External {})        = GT
+    sort_cmp (WiredIn m1 _ _) (WiredIn m2 _ _) = m1 `stableModuleCmp` m2
+    sort_cmp (WiredIn {})     _                = LT
+    sort_cmp Internal         (External {})    = GT
+    sort_cmp Internal         (WiredIn {})     = GT
+    sort_cmp Internal         Internal         = EQ
+    sort_cmp Internal         System           = LT
+    sort_cmp System           System           = EQ
+    sort_cmp System           _                = GT
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Name-instances]{Instance declarations}
+*                                                                      *
+************************************************************************
+-}
+
+-- | The same comments as for `Name`'s `Ord` instance apply.
+instance Eq Name where
+    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
+    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
+
+-- | __Caution__: This instance is implemented via `nonDetCmpUnique`, which
+-- means that the ordering is not stable across deserialization or rebuilds.
+--
+-- See `nonDetCmpUnique` for further information, and trac #15240 for a bug
+-- caused by improper use of this instance.
+
+-- For a deterministic lexicographic ordering, use `stableNameCmp`.
+instance Ord Name where
+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
+    compare a b = cmpName a b
+
+instance Uniquable Name where
+    getUnique = nameUnique
+
+instance NamedThing Name where
+    getName n = n
+
+instance Data Name where
+  -- don't traverse?
+  toConstr _   = abstractConstr "Name"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Name"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Binary}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Assumes that the 'Name' is a non-binding one. See
+-- 'GHC.Iface.Syntax.putIfaceTopBndr' and 'GHC.Iface.Syntax.getIfaceTopBndr' for
+-- serializing binding 'Name's. See 'UserData' for the rationale for this
+-- distinction.
+instance Binary Name where
+   put_ bh name =
+      case getUserData bh of
+        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name
+
+   get bh =
+      case getUserData bh of
+        UserData { ud_get_name = get_name } -> get_name bh
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Pretty printing}
+*                                                                      *
+************************************************************************
+-}
+
+instance Outputable Name where
+    ppr name = pprName name
+
+instance OutputableBndr Name where
+    pprBndr _ name = pprName name
+    pprInfixOcc  = pprInfixName
+    pprPrefixOcc = pprPrefixName
+
+pprName :: Name -> SDoc
+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+  = getPprStyle $ \ sty ->
+    case sort of
+      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
+      External mod            -> pprExternal sty uniq mod occ False UserSyntax
+      System                  -> pprSystem sty uniq occ
+      Internal                -> pprInternal sty uniq occ
+
+-- | Print the string of Name unqualifiedly directly.
+pprNameUnqualified :: Name -> SDoc
+pprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ
+
+pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
+pprExternal sty uniq mod occ is_wired is_builtin
+  | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
+        -- In code style, always qualify
+        -- ToDo: maybe we could print all wired-in things unqualified
+        --       in code style, to reduce symbol table bloat?
+  | debugStyle sty = pp_mod <> ppr_occ_name occ
+                     <> braces (hsep [if is_wired then text "(w)" else empty,
+                                      pprNameSpaceBrief (occNameSpace occ),
+                                      pprUnique uniq])
+  | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
+  | otherwise                   =
+        if isHoleModule mod
+            then case qualName sty mod occ of
+                    NameUnqual -> ppr_occ_name occ
+                    _ -> braces (ppr (moduleName mod) <> dot <> ppr_occ_name occ)
+            else pprModulePrefix sty mod occ <> ppr_occ_name occ
+  where
+    pp_mod = ppUnlessOption sdocSuppressModulePrefixes
+               (ppr mod <> dot)
+
+pprInternal :: PprStyle -> Unique -> OccName -> SDoc
+pprInternal sty uniq occ
+  | codeStyle sty  = pprUniqueAlways uniq
+  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
+                                                       pprUnique uniq])
+  | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq
+                        -- For debug dumps, we're not necessarily dumping
+                        -- tidied code, so we need to print the uniques.
+  | otherwise      = ppr_occ_name occ   -- User style
+
+-- Like Internal, except that we only omit the unique in Iface style
+pprSystem :: PprStyle -> Unique -> OccName -> SDoc
+pprSystem sty uniq occ
+  | codeStyle sty  = pprUniqueAlways uniq
+  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
+                     <> braces (pprNameSpaceBrief (occNameSpace occ))
+  | otherwise      = ppr_occ_name occ <> ppr_underscore_unique uniq
+                                -- If the tidy phase hasn't run, the OccName
+                                -- is unlikely to be informative (like 's'),
+                                -- so print the unique
+
+
+pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
+-- Print the "M." part of a name, based on whether it's in scope or not
+-- See Note [Printing original names] in GHC.Driver.Types
+pprModulePrefix sty mod occ = ppUnlessOption sdocSuppressModulePrefixes $
+    case qualName sty mod occ of              -- See Outputable.QualifyName:
+      NameQual modname -> ppr modname <> dot       -- Name is in scope
+      NameNotInScope1  -> ppr mod <> dot           -- Not in scope
+      NameNotInScope2  -> ppr (moduleUnitId mod) <> colon     -- Module not in
+                          <> ppr (moduleName mod) <> dot          -- scope either
+      NameUnqual       -> empty                   -- In scope unqualified
+
+pprUnique :: Unique -> SDoc
+-- Print a unique unless we are suppressing them
+pprUnique uniq
+  = ppUnlessOption sdocSuppressUniques $
+      pprUniqueAlways uniq
+
+ppr_underscore_unique :: Unique -> SDoc
+-- Print an underscore separating the name from its unique
+-- But suppress it if we aren't printing the uniques anyway
+ppr_underscore_unique uniq
+  = ppUnlessOption sdocSuppressUniques $
+      char '_' <> pprUniqueAlways uniq
+
+ppr_occ_name :: OccName -> SDoc
+ppr_occ_name occ = ftext (occNameFS occ)
+        -- Don't use pprOccName; instead, just print the string of the OccName;
+        -- we print the namespace in the debug stuff above
+
+-- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
+-- cached behind the scenes in the FastString implementation.
+ppr_z_occ_name :: OccName -> SDoc
+ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))
+
+-- Prints (if mod information is available) "Defined at <loc>" or
+--  "Defined in <mod>" information for a Name.
+pprDefinedAt :: Name -> SDoc
+pprDefinedAt name = text "Defined" <+> pprNameDefnLoc name
+
+pprNameDefnLoc :: Name -> SDoc
+-- Prints "at <loc>" or
+--     or "in <mod>" depending on what info is available
+pprNameDefnLoc name
+  = case nameSrcLoc name of
+         -- nameSrcLoc rather than nameSrcSpan
+         -- It seems less cluttered to show a location
+         -- rather than a span for the definition point
+       RealSrcLoc s _ -> text "at" <+> ppr s
+       UnhelpfulLoc s
+         | isInternalName name || isSystemName name
+         -> text "at" <+> ftext s
+         | otherwise
+         -> text "in" <+> quotes (ppr (nameModule name))
+
+
+-- | Get a string representation of a 'Name' that's unique and stable
+-- across recompilations. Used for deterministic generation of binds for
+-- derived instances.
+-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal$String"
+nameStableString :: Name -> String
+nameStableString Name{..} =
+  nameSortStableString n_sort ++ "$" ++ occNameString n_occ
+
+nameSortStableString :: NameSort -> String
+nameSortStableString System = "$_sys"
+nameSortStableString Internal = "$_in"
+nameSortStableString (External mod) = moduleStableString mod
+nameSortStableString (WiredIn mod _ _) = moduleStableString mod
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Overloaded functions related to Names}
+*                                                                      *
+************************************************************************
+-}
+
+-- | A class allowing convenient access to the 'Name' of various datatypes
+class NamedThing a where
+    getOccName :: a -> OccName
+    getName    :: a -> Name
+
+    getOccName n = nameOccName (getName n)      -- Default method
+
+instance NamedThing e => NamedThing (Located e) where
+    getName = getName . unLoc
+
+getSrcLoc           :: NamedThing a => a -> SrcLoc
+getSrcSpan          :: NamedThing a => a -> SrcSpan
+getOccString        :: NamedThing a => a -> String
+getOccFS            :: NamedThing a => a -> FastString
+
+getSrcLoc           = nameSrcLoc           . getName
+getSrcSpan          = nameSrcSpan          . getName
+getOccString        = occNameString        . getOccName
+getOccFS            = occNameFS            . getOccName
+
+pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc
+-- See Outputable.pprPrefixVar, pprInfixVar;
+-- add parens or back-quotes as appropriate
+pprInfixName  n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)
+
+pprPrefixName :: NamedThing a => a -> SDoc
+pprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)
+ where
+   name = getName thing
diff --git a/compiler/GHC/Types/Name.hs-boot b/compiler/GHC/Types/Name.hs-boot
new file mode 100644
index 0000000000..fdd2f62b8d
--- /dev/null
+++ b/compiler/GHC/Types/Name.hs-boot
@@ -0,0 +1,5 @@
+module GHC.Types.Name where
+
+import GhcPrelude ()
+
+data Name
diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs
new file mode 100644
index 0000000000..abf7bc89b5
--- /dev/null
+++ b/compiler/GHC/Types/Name/Cache.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
+
+-- | The Name Cache
+module GHC.Types.Name.Cache
+    ( lookupOrigNameCache
+    , extendOrigNameCache
+    , extendNameCache
+    , initNameCache
+    , NameCache(..), OrigNameCache
+    ) where
+
+import GhcPrelude
+
+import GHC.Types.Module
+import GHC.Types.Name
+import GHC.Types.Unique.Supply
+import TysWiredIn
+import Util
+import Outputable
+import PrelNames
+
+#include "HsVersions.h"
+
+{-
+
+Note [The Name Cache]
+~~~~~~~~~~~~~~~~~~~~~
+The Name Cache makes sure that, during any invocation of GHC, each
+External Name "M.x" has one, and only one globally-agreed Unique.
+
+* The first time we come across M.x we make up a Unique and record that
+  association in the Name Cache.
+
+* When we come across "M.x" again, we look it up in the Name Cache,
+  and get a hit.
+
+The functions newGlobalBinder, allocateGlobalBinder do the main work.
+When you make an External name, you should probably be calling one
+of them.
+
+
+Note [Built-in syntax and the OrigNameCache]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Built-in syntax like tuples and unboxed sums are quite ubiquitous. To lower
+their cost we use two tricks,
+
+  a. We specially encode tuple and sum Names in interface files' symbol tables
+     to avoid having to look up their names while loading interface files.
+     Namely these names are encoded as by their Uniques. We know how to get from
+     a Unique back to the Name which it represents via the mapping defined in
+     the SumTupleUniques module. See Note [Symbol table representation of names]
+     in GHC.Iface.Binary and for details.
+
+  b. We don't include them in the Orig name cache but instead parse their
+     OccNames (in isBuiltInOcc_maybe) to avoid bloating the name cache with
+     them.
+
+Why is the second measure necessary? Good question; afterall, 1) the parser
+emits built-in syntax directly as Exact RdrNames, and 2) built-in syntax never
+needs to looked-up during interface loading due to (a). It turns out that there
+are two reasons why we might look up an Orig RdrName for built-in syntax,
+
+  * If you use setRdrNameSpace on an Exact RdrName it may be
+    turned into an Orig RdrName.
+
+  * Template Haskell turns a BuiltInSyntax Name into a TH.NameG
+    (GHC.HsToCore.Quote.globalVar), and parses a NameG into an Orig RdrName
+    (GHC.ThToHs.thRdrName).  So, e.g. $(do { reify '(,); ... }) will
+    go this route (#8954).
+
+-}
+
+-- | Per-module cache of original 'OccName's given 'Name's
+type OrigNameCache   = ModuleEnv (OccEnv Name)
+
+lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
+lookupOrigNameCache nc mod occ
+  | mod == gHC_TYPES || mod == gHC_PRIM || mod == gHC_TUPLE
+  , Just name <- isBuiltInOcc_maybe occ
+  =     -- See Note [Known-key names], 3(c) in PrelNames
+        -- Special case for tuples; there are too many
+        -- of them to pre-populate the original-name cache
+    Just name
+
+  | otherwise
+  = case lookupModuleEnv nc mod of
+        Nothing      -> Nothing
+        Just occ_env -> lookupOccEnv occ_env occ
+
+extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
+extendOrigNameCache nc name
+  = ASSERT2( isExternalName name, ppr name )
+    extendNameCache nc (nameModule name) (nameOccName name) name
+
+extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
+extendNameCache nc mod occ name
+  = extendModuleEnvWith combine nc mod (unitOccEnv occ name)
+  where
+    combine _ occ_env = extendOccEnv occ_env occ name
+
+-- | The NameCache makes sure that there is just one Unique assigned for
+-- each original name; i.e. (module-name, occ-name) pair and provides
+-- something of a lookup mechanism for those names.
+data NameCache
+ = NameCache {  nsUniqs :: !UniqSupply,
+                -- ^ Supply of uniques
+                nsNames :: !OrigNameCache
+                -- ^ Ensures that one original name gets one unique
+   }
+
+-- | Return a function to atomically update the name cache.
+initNameCache :: UniqSupply -> [Name] -> NameCache
+initNameCache us names
+  = NameCache { nsUniqs = us,
+                nsNames = initOrigNames names }
+
+initOrigNames :: [Name] -> OrigNameCache
+initOrigNames names = foldl' extendOrigNameCache emptyModuleEnv names
diff --git a/compiler/GHC/Types/Name/Env.hs b/compiler/GHC/Types/Name/Env.hs
new file mode 100644
index 0000000000..25842ab3f1
--- /dev/null
+++ b/compiler/GHC/Types/Name/Env.hs
@@ -0,0 +1,175 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[NameEnv]{@NameEnv@: name environments}
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module GHC.Types.Name.Env (
+        -- * Var, Id and TyVar environments (maps)
+        NameEnv,
+
+        -- ** Manipulating these environments
+        mkNameEnv, mkNameEnvWith,
+        emptyNameEnv, isEmptyNameEnv,
+        unitNameEnv, nameEnvElts,
+        extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
+        extendNameEnvList, extendNameEnvList_C,
+        filterNameEnv, anyNameEnv,
+        plusNameEnv, plusNameEnv_C, alterNameEnv,
+        lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
+        elemNameEnv, mapNameEnv, disjointNameEnv,
+
+        DNameEnv,
+
+        emptyDNameEnv,
+        lookupDNameEnv,
+        delFromDNameEnv, filterDNameEnv,
+        mapDNameEnv,
+        adjustDNameEnv, alterDNameEnv, extendDNameEnv,
+        -- ** Dependency analysis
+        depAnal
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import Digraph
+import GHC.Types.Name
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import Maybes
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Name environment}
+*                                                                      *
+************************************************************************
+-}
+
+{-
+Note [depAnal determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+depAnal is deterministic provided it gets the nodes in a deterministic order.
+The order of lists that get_defs and get_uses return doesn't matter, as these
+are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
+deterministic even when the edges are not in deterministic order as explained
+in Note [Deterministic SCC] in Digraph.
+-}
+
+depAnal :: forall node.
+           (node -> [Name])      -- Defs
+        -> (node -> [Name])      -- Uses
+        -> [node]
+        -> [SCC node]
+-- Perform dependency analysis on a group of definitions,
+-- where each definition may define more than one Name
+--
+-- The get_defs and get_uses functions are called only once per node
+depAnal get_defs get_uses nodes
+  = stronglyConnCompFromEdgedVerticesUniq graph_nodes
+  where
+    graph_nodes = (map mk_node keyed_nodes) :: [Node Int node]
+    keyed_nodes = nodes `zip` [(1::Int)..]
+    mk_node (node, key) =
+      let !edges = (mapMaybe (lookupNameEnv key_map) (get_uses node))
+      in DigraphNode node key edges
+
+    key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
+    key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Name environment}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Name Environment
+type NameEnv a = UniqFM a       -- Domain is Name
+
+emptyNameEnv       :: NameEnv a
+isEmptyNameEnv     :: NameEnv a -> Bool
+mkNameEnv          :: [(Name,a)] -> NameEnv a
+mkNameEnvWith      :: (a -> Name) -> [a] -> NameEnv a
+nameEnvElts        :: NameEnv a -> [a]
+alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
+extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
+extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
+extendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a
+plusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a
+plusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
+extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
+extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
+delFromNameEnv     :: NameEnv a -> Name -> NameEnv a
+delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
+elemNameEnv        :: Name -> NameEnv a -> Bool
+unitNameEnv        :: Name -> a -> NameEnv a
+lookupNameEnv      :: NameEnv a -> Name -> Maybe a
+lookupNameEnv_NF   :: NameEnv a -> Name -> a
+filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
+anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
+mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
+disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool
+
+nameEnvElts x         = eltsUFM x
+emptyNameEnv          = emptyUFM
+isEmptyNameEnv        = isNullUFM
+unitNameEnv x y       = unitUFM x y
+extendNameEnv x y z   = addToUFM x y z
+extendNameEnvList x l = addListToUFM x l
+lookupNameEnv x y     = lookupUFM x y
+alterNameEnv          = alterUFM
+mkNameEnv     l       = listToUFM l
+mkNameEnvWith f       = mkNameEnv . map (\a -> (f a, a))
+elemNameEnv x y          = elemUFM x y
+plusNameEnv x y          = plusUFM x y
+plusNameEnv_C f x y      = plusUFM_C f x y
+extendNameEnv_C f x y z  = addToUFM_C f x y z
+mapNameEnv f x           = mapUFM f x
+extendNameEnv_Acc x y z a b  = addToUFM_Acc x y z a b
+extendNameEnvList_C x y z = addListToUFM_C x y z
+delFromNameEnv x y      = delFromUFM x y
+delListFromNameEnv x y  = delListFromUFM x y
+filterNameEnv x y       = filterUFM x y
+anyNameEnv f x          = foldUFM ((||) . f) False x
+disjointNameEnv x y     = isNullUFM (intersectUFM x y)
+
+lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
+
+-- | Deterministic Name Environment
+--
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why
+-- we need DNameEnv.
+type DNameEnv a = UniqDFM a
+
+emptyDNameEnv :: DNameEnv a
+emptyDNameEnv = emptyUDFM
+
+lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
+lookupDNameEnv = lookupUDFM
+
+delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a
+delFromDNameEnv = delFromUDFM
+
+filterDNameEnv :: (a -> Bool) -> DNameEnv a -> DNameEnv a
+filterDNameEnv = filterUDFM
+
+mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
+mapDNameEnv = mapUDFM
+
+adjustDNameEnv :: (a -> a) -> DNameEnv a -> Name -> DNameEnv a
+adjustDNameEnv = adjustUDFM
+
+alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
+alterDNameEnv = alterUDFM
+
+extendDNameEnv :: DNameEnv a -> Name -> a -> DNameEnv a
+extendDNameEnv = addToUDFM
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
new file mode 100644
index 0000000000..d57924e121
--- /dev/null
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -0,0 +1,927 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName' represents names as strings with just a little more information:
+--   the \"namespace\" that the name came from, e.g. the namespace of value, type constructors or
+--   data constructors
+--
+-- * 'RdrName.RdrName': see "RdrName#name_types"
+--
+-- * 'Name.Name': see "Name#name_types"
+--
+-- * 'Id.Id': see "Id#name_types"
+--
+-- * 'Var.Var': see "Var#name_types"
+
+module GHC.Types.Name.Occurrence (
+        -- * The 'NameSpace' type
+        NameSpace, -- Abstract
+
+        nameSpacesRelated,
+
+        -- ** Construction
+        -- $real_vs_source_data_constructors
+        tcName, clsName, tcClsName, dataName, varName,
+        tvName, srcDataName,
+
+        -- ** Pretty Printing
+        pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,
+
+        -- * The 'OccName' type
+        OccName,        -- Abstract, instance of Outputable
+        pprOccName,
+
+        -- ** Construction
+        mkOccName, mkOccNameFS,
+        mkVarOcc, mkVarOccFS,
+        mkDataOcc, mkDataOccFS,
+        mkTyVarOcc, mkTyVarOccFS,
+        mkTcOcc, mkTcOccFS,
+        mkClsOcc, mkClsOccFS,
+        mkDFunOcc,
+        setOccNameSpace,
+        demoteOccName,
+        HasOccName(..),
+
+        -- ** Derived 'OccName's
+        isDerivedOccName,
+        mkDataConWrapperOcc, mkWorkerOcc,
+        mkMatcherOcc, mkBuilderOcc,
+        mkDefaultMethodOcc, isDefaultMethodOcc, isTypeableBindOcc,
+        mkNewTyCoOcc, mkClassOpAuxOcc,
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
+        mkClassDataConOcc, mkDictOcc, mkIPOcc,
+        mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
+        mkGenR, mkGen1R,
+        mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
+        mkSuperDictSelOcc, mkSuperDictAuxOcc,
+        mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
+        mkInstTyCoOcc, mkEqPredCoOcc,
+        mkRecFldSelOcc,
+        mkTyConRepOcc,
+
+        -- ** Deconstruction
+        occNameFS, occNameString, occNameSpace,
+
+        isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
+        parenSymOcc, startsWithUnderscore,
+
+        isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
+
+        -- * The 'OccEnv' type
+        OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
+        lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
+        occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
+        extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
+        alterOccEnv, pprOccEnv,
+
+        -- * The 'OccSet' type
+        OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
+        extendOccSetList,
+        unionOccSets, unionManyOccSets, minusOccSet, elemOccSet,
+        isEmptyOccSet, intersectOccSet, intersectsOccSet,
+        filterOccSet,
+
+        -- * Tidying up
+        TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,
+        tidyOccName, avoidClashesOccEnv, delTidyOccEnvList,
+
+        -- FsEnv
+        FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
+    ) where
+
+import GhcPrelude
+
+import Util
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
+import FastString
+import FastStringEnv
+import Outputable
+import GHC.Utils.Lexeme
+import Binary
+import Control.DeepSeq
+import Data.Char
+import Data.Data
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Name space}
+*                                                                      *
+************************************************************************
+-}
+
+data NameSpace = VarName        -- Variables, including "real" data constructors
+               | DataName       -- "Source" data constructors
+               | TvName         -- Type variables
+               | TcClsName      -- Type constructors and classes; Haskell has them
+                                -- in the same name space for now.
+               deriving( Eq, Ord )
+
+-- Note [Data Constructors]
+-- see also: Note [Data Constructor Naming] in GHC.Core.DataCon
+--
+-- $real_vs_source_data_constructors
+-- There are two forms of data constructor:
+--
+--      [Source data constructors] The data constructors mentioned in Haskell source code
+--
+--      [Real data constructors] The data constructors of the representation type, which may not be the same as the source type
+--
+-- For example:
+--
+-- > data T = T !(Int, Int)
+--
+-- The source datacon has type @(Int, Int) -> T@
+-- The real   datacon has type @Int -> Int -> T@
+--
+-- GHC chooses a representation based on the strictness etc.
+
+tcName, clsName, tcClsName :: NameSpace
+dataName, srcDataName      :: NameSpace
+tvName, varName            :: NameSpace
+
+-- Though type constructors and classes are in the same name space now,
+-- the NameSpace type is abstract, so we can easily separate them later
+tcName    = TcClsName           -- Type constructors
+clsName   = TcClsName           -- Classes
+tcClsName = TcClsName           -- Not sure which!
+
+dataName    = DataName
+srcDataName = DataName  -- Haskell-source data constructors should be
+                        -- in the Data name space
+
+tvName      = TvName
+varName     = VarName
+
+isDataConNameSpace :: NameSpace -> Bool
+isDataConNameSpace DataName = True
+isDataConNameSpace _        = False
+
+isTcClsNameSpace :: NameSpace -> Bool
+isTcClsNameSpace TcClsName = True
+isTcClsNameSpace _         = False
+
+isTvNameSpace :: NameSpace -> Bool
+isTvNameSpace TvName = True
+isTvNameSpace _      = False
+
+isVarNameSpace :: NameSpace -> Bool     -- Variables or type variables, but not constructors
+isVarNameSpace TvName  = True
+isVarNameSpace VarName = True
+isVarNameSpace _       = False
+
+isValNameSpace :: NameSpace -> Bool
+isValNameSpace DataName = True
+isValNameSpace VarName  = True
+isValNameSpace _        = False
+
+pprNameSpace :: NameSpace -> SDoc
+pprNameSpace DataName  = text "data constructor"
+pprNameSpace VarName   = text "variable"
+pprNameSpace TvName    = text "type variable"
+pprNameSpace TcClsName = text "type constructor or class"
+
+pprNonVarNameSpace :: NameSpace -> SDoc
+pprNonVarNameSpace VarName = empty
+pprNonVarNameSpace ns = pprNameSpace ns
+
+pprNameSpaceBrief :: NameSpace -> SDoc
+pprNameSpaceBrief DataName  = char 'd'
+pprNameSpaceBrief VarName   = char 'v'
+pprNameSpaceBrief TvName    = text "tv"
+pprNameSpaceBrief TcClsName = text "tc"
+
+-- demoteNameSpace lowers the NameSpace if possible.  We can not know
+-- in advance, since a TvName can appear in an HsTyVar.
+-- See Note [Demotion] in GHC.Rename.Env
+demoteNameSpace :: NameSpace -> Maybe NameSpace
+demoteNameSpace VarName = Nothing
+demoteNameSpace DataName = Nothing
+demoteNameSpace TvName = Nothing
+demoteNameSpace TcClsName = Just DataName
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Occurrence Name
+--
+-- In this context that means:
+-- "classified (i.e. as a type name, value name, etc) but not qualified
+-- and not yet resolved"
+data OccName = OccName
+    { occNameSpace  :: !NameSpace
+    , occNameFS     :: !FastString
+    }
+
+instance Eq OccName where
+    (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
+
+instance Ord OccName where
+        -- Compares lexicographically, *not* by Unique of the string
+    compare (OccName sp1 s1) (OccName sp2 s2)
+        = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
+
+instance Data OccName where
+  -- don't traverse?
+  toConstr _   = abstractConstr "OccName"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "OccName"
+
+instance HasOccName OccName where
+  occName = id
+
+instance NFData OccName where
+  rnf x = x `seq` ()
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Printing}
+*                                                                      *
+************************************************************************
+-}
+
+instance Outputable OccName where
+    ppr = pprOccName
+
+instance OutputableBndr OccName where
+    pprBndr _ = ppr
+    pprInfixOcc n = pprInfixVar (isSymOcc n) (ppr n)
+    pprPrefixOcc n = pprPrefixVar (isSymOcc n) (ppr n)
+
+pprOccName :: OccName -> SDoc
+pprOccName (OccName sp occ)
+  = getPprStyle $ \ sty ->
+    if codeStyle sty
+    then ztext (zEncodeFS occ)
+    else pp_occ <> pp_debug sty
+  where
+    pp_debug sty | debugStyle sty = braces (pprNameSpaceBrief sp)
+                 | otherwise      = empty
+
+    pp_occ = sdocOption sdocSuppressUniques $ \case
+               True  -> text (strip_th_unique (unpackFS occ))
+               False -> ftext occ
+
+        -- See Note [Suppressing uniques in OccNames]
+    strip_th_unique ('[' : c : _) | isAlphaNum c = []
+    strip_th_unique (c : cs) = c : strip_th_unique cs
+    strip_th_unique []       = []
+
+{-
+Note [Suppressing uniques in OccNames]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+This is a hack to de-wobblify the OccNames that contain uniques from
+Template Haskell that have been turned into a string in the OccName.
+See Note [Unique OccNames from Template Haskell] in Convert.hs
+
+************************************************************************
+*                                                                      *
+\subsection{Construction}
+*                                                                      *
+************************************************************************
+-}
+
+mkOccName :: NameSpace -> String -> OccName
+mkOccName occ_sp str = OccName occ_sp (mkFastString str)
+
+mkOccNameFS :: NameSpace -> FastString -> OccName
+mkOccNameFS occ_sp fs = OccName occ_sp fs
+
+mkVarOcc :: String -> OccName
+mkVarOcc s = mkOccName varName s
+
+mkVarOccFS :: FastString -> OccName
+mkVarOccFS fs = mkOccNameFS varName fs
+
+mkDataOcc :: String -> OccName
+mkDataOcc = mkOccName dataName
+
+mkDataOccFS :: FastString -> OccName
+mkDataOccFS = mkOccNameFS dataName
+
+mkTyVarOcc :: String -> OccName
+mkTyVarOcc = mkOccName tvName
+
+mkTyVarOccFS :: FastString -> OccName
+mkTyVarOccFS fs = mkOccNameFS tvName fs
+
+mkTcOcc :: String -> OccName
+mkTcOcc = mkOccName tcName
+
+mkTcOccFS :: FastString -> OccName
+mkTcOccFS = mkOccNameFS tcName
+
+mkClsOcc :: String -> OccName
+mkClsOcc = mkOccName clsName
+
+mkClsOccFS :: FastString -> OccName
+mkClsOccFS = mkOccNameFS clsName
+
+-- demoteOccName lowers the Namespace of OccName.
+-- see Note [Demotion]
+demoteOccName :: OccName -> Maybe OccName
+demoteOccName (OccName space name) = do
+  space' <- demoteNameSpace space
+  return $ OccName space' name
+
+-- Name spaces are related if there is a chance to mean the one when one writes
+-- the other, i.e. variables <-> data constructors and type variables <-> type constructors
+nameSpacesRelated :: NameSpace -> NameSpace -> Bool
+nameSpacesRelated ns1 ns2 = ns1 == ns2 || otherNameSpace ns1 == ns2
+
+otherNameSpace :: NameSpace -> NameSpace
+otherNameSpace VarName = DataName
+otherNameSpace DataName = VarName
+otherNameSpace TvName = TcClsName
+otherNameSpace TcClsName = TvName
+
+
+
+{- | Other names in the compiler add additional information to an OccName.
+This class provides a consistent way to access the underlying OccName. -}
+class HasOccName name where
+  occName :: name -> OccName
+
+{-
+************************************************************************
+*                                                                      *
+                Environments
+*                                                                      *
+************************************************************************
+
+OccEnvs are used mainly for the envts in ModIfaces.
+
+Note [The Unique of an OccName]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+They are efficient, because FastStrings have unique Int# keys.  We assume
+this key is less than 2^24, and indeed FastStrings are allocated keys
+sequentially starting at 0.
+
+So we can make a Unique using
+        mkUnique ns key  :: Unique
+where 'ns' is a Char representing the name space.  This in turn makes it
+easy to build an OccEnv.
+-}
+
+instance Uniquable OccName where
+      -- See Note [The Unique of an OccName]
+  getUnique (OccName VarName   fs) = mkVarOccUnique  fs
+  getUnique (OccName DataName  fs) = mkDataOccUnique fs
+  getUnique (OccName TvName    fs) = mkTvOccUnique   fs
+  getUnique (OccName TcClsName fs) = mkTcOccUnique   fs
+
+newtype OccEnv a = A (UniqFM a)
+  deriving Data
+
+emptyOccEnv :: OccEnv a
+unitOccEnv  :: OccName -> a -> OccEnv a
+extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
+extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
+lookupOccEnv :: OccEnv a -> OccName -> Maybe a
+mkOccEnv     :: [(OccName,a)] -> OccEnv a
+mkOccEnv_C   :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a
+elemOccEnv   :: OccName -> OccEnv a -> Bool
+foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
+occEnvElts   :: OccEnv a -> [a]
+extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
+extendOccEnv_Acc :: (a->b->b) -> (a->b) -> OccEnv b -> OccName -> a -> OccEnv b
+plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
+plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
+mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b
+delFromOccEnv      :: OccEnv a -> OccName -> OccEnv a
+delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
+filterOccEnv       :: (elt -> Bool) -> OccEnv elt -> OccEnv elt
+alterOccEnv        :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt
+
+emptyOccEnv      = A emptyUFM
+unitOccEnv x y = A $ unitUFM x y
+extendOccEnv (A x) y z = A $ addToUFM x y z
+extendOccEnvList (A x) l = A $ addListToUFM x l
+lookupOccEnv (A x) y = lookupUFM x y
+mkOccEnv     l    = A $ listToUFM l
+elemOccEnv x (A y)       = elemUFM x y
+foldOccEnv a b (A c)     = foldUFM a b c
+occEnvElts (A x)         = eltsUFM x
+plusOccEnv (A x) (A y)   = A $ plusUFM x y
+plusOccEnv_C f (A x) (A y)       = A $ plusUFM_C f x y
+extendOccEnv_C f (A x) y z   = A $ addToUFM_C f x y z
+extendOccEnv_Acc f g (A x) y z   = A $ addToUFM_Acc f g x y z
+mapOccEnv f (A x)        = A $ mapUFM f x
+mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l
+delFromOccEnv (A x) y    = A $ delFromUFM x y
+delListFromOccEnv (A x) y  = A $ delListFromUFM x y
+filterOccEnv x (A y)       = A $ filterUFM x y
+alterOccEnv fn (A y) k     = A $ alterUFM fn y k
+
+instance Outputable a => Outputable (OccEnv a) where
+    ppr x = pprOccEnv ppr x
+
+pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc
+pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env
+
+type OccSet = UniqSet OccName
+
+emptyOccSet       :: OccSet
+unitOccSet        :: OccName -> OccSet
+mkOccSet          :: [OccName] -> OccSet
+extendOccSet      :: OccSet -> OccName -> OccSet
+extendOccSetList  :: OccSet -> [OccName] -> OccSet
+unionOccSets      :: OccSet -> OccSet -> OccSet
+unionManyOccSets  :: [OccSet] -> OccSet
+minusOccSet       :: OccSet -> OccSet -> OccSet
+elemOccSet        :: OccName -> OccSet -> Bool
+isEmptyOccSet     :: OccSet -> Bool
+intersectOccSet   :: OccSet -> OccSet -> OccSet
+intersectsOccSet  :: OccSet -> OccSet -> Bool
+filterOccSet      :: (OccName -> Bool) -> OccSet -> OccSet
+
+emptyOccSet       = emptyUniqSet
+unitOccSet        = unitUniqSet
+mkOccSet          = mkUniqSet
+extendOccSet      = addOneToUniqSet
+extendOccSetList  = addListToUniqSet
+unionOccSets      = unionUniqSets
+unionManyOccSets  = unionManyUniqSets
+minusOccSet       = minusUniqSet
+elemOccSet        = elementOfUniqSet
+isEmptyOccSet     = isEmptyUniqSet
+intersectOccSet   = intersectUniqSets
+intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
+filterOccSet      = filterUniqSet
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Predicates and taking them apart}
+*                                                                      *
+************************************************************************
+-}
+
+occNameString :: OccName -> String
+occNameString (OccName _ s) = unpackFS s
+
+setOccNameSpace :: NameSpace -> OccName -> OccName
+setOccNameSpace sp (OccName _ occ) = OccName sp occ
+
+isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool
+
+isVarOcc (OccName VarName _) = True
+isVarOcc _                   = False
+
+isTvOcc (OccName TvName _) = True
+isTvOcc _                  = False
+
+isTcOcc (OccName TcClsName _) = True
+isTcOcc _                     = False
+
+-- | /Value/ 'OccNames's are those that are either in
+-- the variable or data constructor namespaces
+isValOcc :: OccName -> Bool
+isValOcc (OccName VarName  _) = True
+isValOcc (OccName DataName _) = True
+isValOcc _                    = False
+
+isDataOcc (OccName DataName _) = True
+isDataOcc _                    = False
+
+-- | Test if the 'OccName' is a data constructor that starts with
+-- a symbol (e.g. @:@, or @[]@)
+isDataSymOcc :: OccName -> Bool
+isDataSymOcc (OccName DataName s) = isLexConSym s
+isDataSymOcc _                    = False
+-- Pretty inefficient!
+
+-- | Test if the 'OccName' is that for any operator (whether
+-- it is a data constructor or variable or whatever)
+isSymOcc :: OccName -> Bool
+isSymOcc (OccName DataName s)  = isLexConSym s
+isSymOcc (OccName TcClsName s) = isLexSym s
+isSymOcc (OccName VarName s)   = isLexSym s
+isSymOcc (OccName TvName s)    = isLexSym s
+-- Pretty inefficient!
+
+parenSymOcc :: OccName -> SDoc -> SDoc
+-- ^ Wrap parens around an operator
+parenSymOcc occ doc | isSymOcc occ = parens doc
+                    | otherwise    = doc
+
+startsWithUnderscore :: OccName -> Bool
+-- ^ Haskell 98 encourages compilers to suppress warnings about unused
+-- names in a pattern if they start with @_@: this implements that test
+startsWithUnderscore occ = headFS (occNameFS occ) == '_'
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Making system names}
+*                                                                      *
+************************************************************************
+
+Here's our convention for splitting up the interface file name space:
+
+   d...         dictionary identifiers
+                (local variables, so no name-clash worries)
+
+All of these other OccNames contain a mixture of alphabetic
+and symbolic characters, and hence cannot possibly clash with
+a user-written type or function name
+
+   $f...        Dict-fun identifiers (from inst decls)
+   $dmop        Default method for 'op'
+   $pnC         n'th superclass selector for class C
+   $wf          Worker for function 'f'
+   $sf..        Specialised version of f
+   D:C          Data constructor for dictionary for class C
+   NTCo:T       Coercion connecting newtype T with its representation type
+   TFCo:R       Coercion connecting a data family to its representation type R
+
+In encoded form these appear as Zdfxxx etc
+
+        :...            keywords (export:, letrec: etc.)
+--- I THINK THIS IS WRONG!
+
+This knowledge is encoded in the following functions.
+
+@mk_deriv@ generates an @OccName@ from the prefix and a string.
+NB: The string must already be encoded!
+-}
+
+-- | Build an 'OccName' derived from another 'OccName'.
+--
+-- Note that the pieces of the name are passed in as a @[FastString]@ so that
+-- the whole name can be constructed with a single 'concatFS', minimizing
+-- unnecessary intermediate allocations.
+mk_deriv :: NameSpace
+         -> FastString      -- ^ A prefix which distinguishes one sort of
+                            -- derived name from another
+         -> [FastString]    -- ^ The name we are deriving from in pieces which
+                            -- will be concatenated.
+         -> OccName
+mk_deriv occ_sp sys_prefix str =
+    mkOccNameFS occ_sp (concatFS $ sys_prefix : str)
+
+isDerivedOccName :: OccName -> Bool
+-- ^ Test for definitions internally generated by GHC.  This predicate
+-- is used to suppress printing of internal definitions in some debug prints
+isDerivedOccName occ =
+   case occNameString occ of
+     '$':c:_ | isAlphaNum c -> True   -- E.g.  $wfoo
+     c:':':_ | isAlphaNum c -> True   -- E.g.  N:blah   newtype coercions
+     _other                 -> False
+
+isDefaultMethodOcc :: OccName -> Bool
+isDefaultMethodOcc occ =
+   case occNameString occ of
+     '$':'d':'m':_ -> True
+     _ -> False
+
+-- | Is an 'OccName' one of a Typeable @TyCon@ or @Module@ binding?
+-- This is needed as these bindings are renamed differently.
+-- See Note [Grand plan for Typeable] in TcTypeable.
+isTypeableBindOcc :: OccName -> Bool
+isTypeableBindOcc occ =
+   case occNameString occ of
+     '$':'t':'c':_ -> True  -- mkTyConRepOcc
+     '$':'t':'r':_ -> True  -- Module binding
+     _ -> False
+
+mkDataConWrapperOcc, mkWorkerOcc,
+        mkMatcherOcc, mkBuilderOcc,
+        mkDefaultMethodOcc,
+        mkClassDataConOcc, mkDictOcc,
+        mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
+        mkGenR, mkGen1R,
+        mkDataConWorkerOcc, mkNewTyCoOcc,
+        mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
+        mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
+        mkTyConRepOcc
+   :: OccName -> OccName
+
+-- These derived variables have a prefix that no Haskell value could have
+mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
+mkWorkerOcc         = mk_simple_deriv varName  "$w"
+mkMatcherOcc        = mk_simple_deriv varName  "$m"
+mkBuilderOcc        = mk_simple_deriv varName  "$b"
+mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
+mkClassOpAuxOcc     = mk_simple_deriv varName  "$c"
+mkDictOcc           = mk_simple_deriv varName  "$d"
+mkIPOcc             = mk_simple_deriv varName  "$i"
+mkSpecOcc           = mk_simple_deriv varName  "$s"
+mkForeignExportOcc  = mk_simple_deriv varName  "$f"
+mkRepEqOcc          = mk_simple_deriv tvName   "$r"   -- In RULES involving Coercible
+mkClassDataConOcc   = mk_simple_deriv dataName "C:"     -- Data con for a class
+mkNewTyCoOcc        = mk_simple_deriv tcName   "N:"   -- Coercion for newtypes
+mkInstTyCoOcc       = mk_simple_deriv tcName   "D:"   -- Coercion for type functions
+mkEqPredCoOcc       = mk_simple_deriv tcName   "$co"
+
+-- Used in derived instances
+mkCon2TagOcc        = mk_simple_deriv varName  "$con2tag_"
+mkTag2ConOcc        = mk_simple_deriv varName  "$tag2con_"
+mkMaxTagOcc         = mk_simple_deriv varName  "$maxtag_"
+
+-- TyConRepName stuff; see Note [Grand plan for Typeable] in TcTypeable
+mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
+  where
+    prefix | isDataOcc occ = "$tc'"
+           | otherwise     = "$tc"
+
+-- Generic deriving mechanism
+mkGenR   = mk_simple_deriv tcName "Rep_"
+mkGen1R  = mk_simple_deriv tcName "Rep1_"
+
+-- Overloaded record field selectors
+mkRecFldSelOcc :: String -> OccName
+mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s]
+
+mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
+mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ]
+
+-- Data constructor workers are made by setting the name space
+-- of the data constructor OccName (which should be a DataName)
+-- to VarName
+mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
+
+mkSuperDictAuxOcc :: Int -> OccName -> OccName
+mkSuperDictAuxOcc index cls_tc_occ
+  = mk_deriv varName "$cp" [fsLit $ show index, occNameFS cls_tc_occ]
+
+mkSuperDictSelOcc :: Int        -- ^ Index of superclass, e.g. 3
+                  -> OccName    -- ^ Class, e.g. @Ord@
+                  -> OccName    -- ^ Derived 'Occname', e.g. @$p3Ord@
+mkSuperDictSelOcc index cls_tc_occ
+  = mk_deriv varName "$p" [fsLit $ show index, occNameFS cls_tc_occ]
+
+mkLocalOcc :: Unique            -- ^ Unique to combine with the 'OccName'
+           -> OccName           -- ^ Local name, e.g. @sat@
+           -> OccName           -- ^ Nice unique version, e.g. @$L23sat@
+mkLocalOcc uniq occ
+   = mk_deriv varName "$L" [fsLit $ show uniq, occNameFS occ]
+        -- The Unique might print with characters
+        -- that need encoding (e.g. 'z'!)
+
+-- | Derive a name for the representation type constructor of a
+-- @data@\/@newtype@ instance.
+mkInstTyTcOcc :: String                 -- ^ Family name, e.g. @Map@
+              -> OccSet                 -- ^ avoid these Occs
+              -> OccName                -- ^ @R:Map@
+mkInstTyTcOcc str = chooseUniqueOcc tcName ('R' : ':' : str)
+
+mkDFunOcc :: String             -- ^ Typically the class and type glommed together e.g. @OrdMaybe@.
+                                -- Only used in debug mode, for extra clarity
+          -> Bool               -- ^ Is this a hs-boot instance DFun?
+          -> OccSet             -- ^ avoid these Occs
+          -> OccName            -- ^ E.g. @$f3OrdMaybe@
+
+-- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
+-- thing when we compile the mother module. Reason: we don't know exactly
+-- what the  mother module will call it.
+
+mkDFunOcc info_str is_boot set
+  = chooseUniqueOcc VarName (prefix ++ info_str) set
+  where
+    prefix | is_boot   = "$fx"
+           | otherwise = "$f"
+
+mkDataTOcc, mkDataCOcc
+  :: OccName            -- ^ TyCon or data con string
+  -> OccSet             -- ^ avoid these Occs
+  -> OccName            -- ^ E.g. @$f3OrdMaybe@
+-- data T = MkT ... deriving( Data ) needs definitions for
+--      $tT   :: Data.Generics.Basics.DataType
+--      $cMkT :: Data.Generics.Basics.Constr
+mkDataTOcc occ = chooseUniqueOcc VarName ("$t" ++ occNameString occ)
+mkDataCOcc occ = chooseUniqueOcc VarName ("$c" ++ occNameString occ)
+
+{-
+Sometimes we need to pick an OccName that has not already been used,
+given a set of in-use OccNames.
+-}
+
+chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
+chooseUniqueOcc ns str set = loop (mkOccName ns str) (0::Int)
+  where
+  loop occ n
+   | occ `elemOccSet` set = loop (mkOccName ns (str ++ show n)) (n+1)
+   | otherwise            = occ
+
+{-
+We used to add a '$m' to indicate a method, but that gives rise to bad
+error messages from the type checker when we print the function name or pattern
+of an instance-decl binding.  Why? Because the binding is zapped
+to use the method name in place of the selector name.
+(See TcClassDcl.tcMethodBind)
+
+The way it is now, -ddump-xx output may look confusing, but
+you can always say -dppr-debug to get the uniques.
+
+However, we *do* have to zap the first character to be lower case,
+because overloaded constructors (blarg) generate methods too.
+And convert to VarName space
+
+e.g. a call to constructor MkFoo where
+        data (Ord a) => Foo a = MkFoo a
+
+If this is necessary, we do it by prefixing '$m'.  These
+guys never show up in error messages.  What a hack.
+-}
+
+mkMethodOcc :: OccName -> OccName
+mkMethodOcc occ@(OccName VarName _) = occ
+mkMethodOcc occ                     = mk_simple_deriv varName "$m" occ
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Tidying them up}
+*                                                                      *
+************************************************************************
+
+Before we print chunks of code we like to rename it so that
+we don't have to print lots of silly uniques in it.  But we mustn't
+accidentally introduce name clashes!  So the idea is that we leave the
+OccName alone unless it accidentally clashes with one that is already
+in scope; if so, we tack on '1' at the end and try again, then '2', and
+so on till we find a unique one.
+
+There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1'
+because that isn't a single lexeme.  So we encode it to 'lle' and *then*
+tack on the '1', if necessary.
+
+Note [TidyOccEnv]
+~~~~~~~~~~~~~~~~~
+type TidyOccEnv = UniqFM Int
+
+* Domain = The OccName's FastString. These FastStrings are "taken";
+           make sure that we don't re-use
+
+* Int, n = A plausible starting point for new guesses
+           There is no guarantee that "FSn" is available;
+           you must look that up in the TidyOccEnv.  But
+           it's a good place to start looking.
+
+* When looking for a renaming for "foo2" we strip off the "2" and start
+  with "foo".  Otherwise if we tidy twice we get silly names like foo23.
+
+  However, if it started with digits at the end, we always make a name
+  with digits at the end, rather than shortening "foo2" to just "foo",
+  even if "foo" is unused.  Reasons:
+     - Plain "foo" might be used later
+     - We use trailing digits to subtly indicate a unification variable
+       in typechecker error message; see TypeRep.tidyTyVarBndr
+
+We have to take care though! Consider a machine-generated module (#10370)
+  module Foo where
+     a1 = e1
+     a2 = e2
+     ...
+     a2000 = e2000
+Then "a1", "a2" etc are all marked taken.  But now if we come across "a7" again,
+we have to do a linear search to find a free one, "a2001".  That might just be
+acceptable once.  But if we now come across "a8" again, we don't want to repeat
+that search.
+
+So we use the TidyOccEnv mapping for "a" (not "a7" or "a8") as our base for
+starting the search; and we make sure to update the starting point for "a"
+after we allocate a new one.
+
+
+Note [Tidying multiple names at once]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Consider
+
+    > :t (id,id,id)
+
+Every id contributes a type variable to the type signature, and all of them are
+"a". If we tidy them one by one, we get
+
+    (id,id,id) :: (a2 -> a2, a1 -> a1, a -> a)
+
+which is a bit unfortunate, as it unfairly renames only two of them. What we
+would like to see is
+
+    (id,id,id) :: (a3 -> a3, a2 -> a2, a1 -> a1)
+
+To achieve this, the function avoidClashesOccEnv can be used to prepare the
+TidyEnv, by “blocking” every name that occurs twice in the map. This way, none
+of the "a"s will get the privilege of keeping this name, and all of them will
+get a suitable number by tidyOccName.
+
+This prepared TidyEnv can then be used with tidyOccName. See tidyTyCoVarBndrs
+for an example where this is used.
+
+This is #12382.
+
+-}
+
+type TidyOccEnv = UniqFM Int    -- The in-scope OccNames
+  -- See Note [TidyOccEnv]
+
+emptyTidyOccEnv :: TidyOccEnv
+emptyTidyOccEnv = emptyUFM
+
+initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
+initTidyOccEnv = foldl' add emptyUFM
+  where
+    add env (OccName _ fs) = addToUFM env fs 1
+
+delTidyOccEnvList :: TidyOccEnv -> [FastString] -> TidyOccEnv
+delTidyOccEnvList = delListFromUFM
+
+-- see Note [Tidying multiple names at once]
+avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
+avoidClashesOccEnv env occs = go env emptyUFM occs
+  where
+    go env _        [] = env
+    go env seenOnce ((OccName _ fs):occs)
+      | fs `elemUFM` env      = go env seenOnce                  occs
+      | fs `elemUFM` seenOnce = go (addToUFM env fs 1) seenOnce  occs
+      | otherwise             = go env (addToUFM seenOnce fs ()) occs
+
+tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
+tidyOccName env occ@(OccName occ_sp fs)
+  | not (fs `elemUFM` env)
+  = -- Desired OccName is free, so use it,
+    -- and record in 'env' that it's no longer available
+    (addToUFM env fs 1, occ)
+
+  | otherwise
+  = case lookupUFM env base1 of
+       Nothing -> (addToUFM env base1 2, OccName occ_sp base1)
+       Just n  -> find 1 n
+  where
+    base :: String  -- Drop trailing digits (see Note [TidyOccEnv])
+    base  = dropWhileEndLE isDigit (unpackFS fs)
+    base1 = mkFastString (base ++ "1")
+
+    find !k !n
+      = case lookupUFM env new_fs of
+          Just {} -> find (k+1 :: Int) (n+k)
+                       -- By using n+k, the n argument to find goes
+                       --    1, add 1, add 2, add 3, etc which
+                       -- moves at quadratic speed through a dense patch
+
+          Nothing -> (new_env, OccName occ_sp new_fs)
+       where
+         new_fs = mkFastString (base ++ show n)
+         new_env = addToUFM (addToUFM env new_fs 1) base1 (n+1)
+                     -- Update:  base1,  so that next time we'll start where we left off
+                     --          new_fs, so that we know it is taken
+                     -- If they are the same (n==1), the former wins
+                     -- See Note [TidyOccEnv]
+
+
+{-
+************************************************************************
+*                                                                      *
+                Binary instance
+    Here rather than in GHC.Iface.Binary because OccName is abstract
+*                                                                      *
+************************************************************************
+-}
+
+instance Binary NameSpace where
+    put_ bh VarName = do
+            putByte bh 0
+    put_ bh DataName = do
+            putByte bh 1
+    put_ bh TvName = do
+            putByte bh 2
+    put_ bh TcClsName = do
+            putByte bh 3
+    get bh = do
+            h <- getByte bh
+            case h of
+              0 -> do return VarName
+              1 -> do return DataName
+              2 -> do return TvName
+              _ -> do return TcClsName
+
+instance Binary OccName where
+    put_ bh (OccName aa ab) = do
+            put_ bh aa
+            put_ bh ab
+    get bh = do
+          aa <- get bh
+          ab <- get bh
+          return (OccName aa ab)
diff --git a/compiler/GHC/Types/Name/Occurrence.hs-boot b/compiler/GHC/Types/Name/Occurrence.hs-boot
new file mode 100644
index 0000000000..212b58b8e6
--- /dev/null
+++ b/compiler/GHC/Types/Name/Occurrence.hs-boot
@@ -0,0 +1,5 @@
+module GHC.Types.Name.Occurrence where
+
+import GhcPrelude ()
+
+data OccName
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
new file mode 100644
index 0000000000..d183979372
--- /dev/null
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -0,0 +1,1387 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE CPP, DeriveDataTypeable #-}
+
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName': see "OccName#name_types"
+--
+-- * 'RdrName.RdrName' is the type of names that come directly from the parser. They
+--   have not yet had their scoping and binding resolved by the renamer and can be
+--   thought of to a first approximation as an 'OccName.OccName' with an optional module
+--   qualifier
+--
+-- * 'Name.Name': see "Name#name_types"
+--
+-- * 'Id.Id': see "Id#name_types"
+--
+-- * 'Var.Var': see "Var#name_types"
+
+module GHC.Types.Name.Reader (
+        -- * The main type
+        RdrName(..),    -- Constructors exported only to GHC.Iface.Binary
+
+        -- ** Construction
+        mkRdrUnqual, mkRdrQual,
+        mkUnqual, mkVarUnqual, mkQual, mkOrig,
+        nameRdrName, getRdrName,
+
+        -- ** Destruction
+        rdrNameOcc, rdrNameSpace, demoteRdrName,
+        isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
+        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
+
+        -- * Local mapping of 'RdrName' to 'Name.Name'
+        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
+        lookupLocalRdrEnv, lookupLocalRdrOcc,
+        elemLocalRdrEnv, inLocalRdrEnvScope,
+        localRdrEnvElts, delLocalRdrEnvList,
+
+        -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
+        GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
+        lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,
+        pprGlobalRdrEnv, globalRdrEnvElts,
+        lookupGRE_RdrName, lookupGRE_Name, lookupGRE_FieldLabel,
+        lookupGRE_Name_OccName,
+        getGRE_NameQualifier_maybes,
+        transformGREs, pickGREs, pickGREsModExp,
+
+        -- * GlobalRdrElts
+        gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,
+        greRdrNames, greSrcSpan, greQualModName,
+        gresToAvailInfo,
+
+        -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
+        GlobalRdrElt(..), isLocalGRE, isRecFldGRE, greLabel,
+        unQualOK, qualSpecOK, unQualSpecOK,
+        pprNameProvenance,
+        Parent(..), greParent_maybe,
+        ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
+        importSpecLoc, importSpecModule, isExplicitItem, bestImport,
+
+        -- * Utils for StarIsType
+        starInfo
+  ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Types.Module
+import GHC.Types.Name
+import GHC.Types.Avail
+import GHC.Types.Name.Set
+import Maybes
+import GHC.Types.SrcLoc as SrcLoc
+import FastString
+import GHC.Types.FieldLabel
+import Outputable
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.Set
+import Util
+import GHC.Types.Name.Env
+
+import Data.Data
+import Data.List( sortBy )
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{The main data type}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Reader Name
+--
+-- Do not use the data constructors of RdrName directly: prefer the family
+-- of functions that creates them, such as 'mkRdrUnqual'
+--
+-- - Note: A Located RdrName will only have API Annotations if it is a
+--         compound one,
+--   e.g.
+--
+-- > `bar`
+-- > ( ~ )
+--
+-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnType',
+--           'ApiAnnotation.AnnOpen'  @'('@ or @'['@ or @'[:'@,
+--           'ApiAnnotation.AnnClose' @')'@ or @']'@ or @':]'@,,
+--           'ApiAnnotation.AnnBackquote' @'`'@,
+--           'ApiAnnotation.AnnVal'
+--           'ApiAnnotation.AnnTilde',
+
+-- For details on above see note [Api annotations] in ApiAnnotation
+data RdrName
+  = Unqual OccName
+        -- ^ Unqualified  name
+        --
+        -- Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
+        -- Create such a 'RdrName' with 'mkRdrUnqual'
+
+  | Qual ModuleName OccName
+        -- ^ Qualified name
+        --
+        -- A qualified name written by the user in
+        -- /source/ code.  The module isn't necessarily
+        -- the module where the thing is defined;
+        -- just the one from which it is imported.
+        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.
+        -- Create such a 'RdrName' with 'mkRdrQual'
+
+  | Orig Module OccName
+        -- ^ Original name
+        --
+        -- An original name; the module is the /defining/ module.
+        -- This is used when GHC generates code that will be fed
+        -- into the renamer (e.g. from deriving clauses), but where
+        -- we want to say \"Use Prelude.map dammit\". One of these
+        -- can be created with 'mkOrig'
+
+  | Exact Name
+        -- ^ Exact name
+        --
+        -- We know exactly the 'Name'. This is used:
+        --
+        --  (1) When the parser parses built-in syntax like @[]@
+        --      and @(,)@, but wants a 'RdrName' from it
+        --
+        --  (2) By Template Haskell, when TH has generated a unique name
+        --
+        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
+  deriving Data
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Simple functions}
+*                                                                      *
+************************************************************************
+-}
+
+instance HasOccName RdrName where
+  occName = rdrNameOcc
+
+rdrNameOcc :: RdrName -> OccName
+rdrNameOcc (Qual _ occ) = occ
+rdrNameOcc (Unqual occ) = occ
+rdrNameOcc (Orig _ occ) = occ
+rdrNameOcc (Exact name) = nameOccName name
+
+rdrNameSpace :: RdrName -> NameSpace
+rdrNameSpace = occNameSpace . rdrNameOcc
+
+-- demoteRdrName lowers the NameSpace of RdrName.
+-- see Note [Demotion] in GHC.Types.Name.Occurrence
+demoteRdrName :: RdrName -> Maybe RdrName
+demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
+demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
+demoteRdrName (Orig _ _) = panic "demoteRdrName"
+demoteRdrName (Exact _) = panic "demoteRdrName"
+
+        -- These two are the basic constructors
+mkRdrUnqual :: OccName -> RdrName
+mkRdrUnqual occ = Unqual occ
+
+mkRdrQual :: ModuleName -> OccName -> RdrName
+mkRdrQual mod occ = Qual mod occ
+
+mkOrig :: Module -> OccName -> RdrName
+mkOrig mod occ = Orig mod occ
+
+---------------
+        -- These two are used when parsing source files
+        -- They do encode the module and occurrence names
+mkUnqual :: NameSpace -> FastString -> RdrName
+mkUnqual sp n = Unqual (mkOccNameFS sp n)
+
+mkVarUnqual :: FastString -> RdrName
+mkVarUnqual n = Unqual (mkVarOccFS n)
+
+-- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and
+-- the 'OccName' are taken from the first and second elements of the tuple respectively
+mkQual :: NameSpace -> (FastString, FastString) -> RdrName
+mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
+
+getRdrName :: NamedThing thing => thing -> RdrName
+getRdrName name = nameRdrName (getName name)
+
+nameRdrName :: Name -> RdrName
+nameRdrName name = Exact name
+-- Keep the Name even for Internal names, so that the
+-- unique is still there for debug printing, particularly
+-- of Types (which are converted to IfaceTypes before printing)
+
+nukeExact :: Name -> RdrName
+nukeExact n
+  | isExternalName n = Orig (nameModule n) (nameOccName n)
+  | otherwise        = Unqual (nameOccName n)
+
+isRdrDataCon :: RdrName -> Bool
+isRdrTyVar   :: RdrName -> Bool
+isRdrTc      :: RdrName -> Bool
+
+isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
+isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
+isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
+
+isSrcRdrName :: RdrName -> Bool
+isSrcRdrName (Unqual _) = True
+isSrcRdrName (Qual _ _) = True
+isSrcRdrName _          = False
+
+isUnqual :: RdrName -> Bool
+isUnqual (Unqual _) = True
+isUnqual _          = False
+
+isQual :: RdrName -> Bool
+isQual (Qual _ _) = True
+isQual _          = False
+
+isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
+isQual_maybe (Qual m n) = Just (m,n)
+isQual_maybe _          = Nothing
+
+isOrig :: RdrName -> Bool
+isOrig (Orig _ _) = True
+isOrig _          = False
+
+isOrig_maybe :: RdrName -> Maybe (Module, OccName)
+isOrig_maybe (Orig m n) = Just (m,n)
+isOrig_maybe _          = Nothing
+
+isExact :: RdrName -> Bool
+isExact (Exact _) = True
+isExact _         = False
+
+isExact_maybe :: RdrName -> Maybe Name
+isExact_maybe (Exact n) = Just n
+isExact_maybe _         = Nothing
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Instances}
+*                                                                      *
+************************************************************************
+-}
+
+instance Outputable RdrName where
+    ppr (Exact name)   = ppr name
+    ppr (Unqual occ)   = ppr occ
+    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
+    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
+
+instance OutputableBndr RdrName where
+    pprBndr _ n
+        | isTvOcc (rdrNameOcc n) = char '@' <> ppr n
+        | otherwise              = ppr n
+
+    pprInfixOcc  rdr = pprInfixVar  (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
+    pprPrefixOcc rdr
+      | Just name <- isExact_maybe rdr = pprPrefixName name
+             -- pprPrefixName has some special cases, so
+             -- we delegate to them rather than reproduce them
+      | otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
+
+instance Eq RdrName where
+    (Exact n1)    == (Exact n2)    = n1==n2
+        -- Convert exact to orig
+    (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2
+    r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2
+
+    (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2
+    (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2
+    (Unqual o1)   == (Unqual o2)   = o1==o2
+    _             == _             = False
+
+instance Ord RdrName where
+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
+    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
+    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
+
+        -- Exact < Unqual < Qual < Orig
+        -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig
+        --      before comparing so that Prelude.map == the exact Prelude.map, but
+        --      that meant that we reported duplicates when renaming bindings
+        --      generated by Template Haskell; e.g
+        --      do { n1 <- newName "foo"; n2 <- newName "foo";
+        --           <decl involving n1,n2> }
+        --      I think we can do without this conversion
+    compare (Exact n1) (Exact n2) = n1 `compare` n2
+    compare (Exact _)  _          = LT
+
+    compare (Unqual _)   (Exact _)    = GT
+    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
+    compare (Unqual _)   _            = LT
+
+    compare (Qual _ _)   (Exact _)    = GT
+    compare (Qual _ _)   (Unqual _)   = GT
+    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
+    compare (Qual _ _)   (Orig _ _)   = LT
+
+    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
+    compare (Orig _ _)   _            = GT
+
+{-
+************************************************************************
+*                                                                      *
+                        LocalRdrEnv
+*                                                                      *
+************************************************************************
+-}
+
+-- | Local Reader Environment
+--
+-- This environment is used to store local bindings
+-- (@let@, @where@, lambda, @case@).
+-- It is keyed by OccName, because we never use it for qualified names
+-- We keep the current mapping, *and* the set of all Names in scope
+-- Reason: see Note [Splicing Exact names] in GHC.Rename.Env
+data LocalRdrEnv = LRE { lre_env      :: OccEnv Name
+                       , lre_in_scope :: NameSet }
+
+instance Outputable LocalRdrEnv where
+  ppr (LRE {lre_env = env, lre_in_scope = ns})
+    = hang (text "LocalRdrEnv {")
+         2 (vcat [ text "env =" <+> pprOccEnv ppr_elt env
+                 , text "in_scope ="
+                    <+> pprUFM (getUniqSet ns) (braces . pprWithCommas ppr)
+                 ] <+> char '}')
+    where
+      ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
+                     -- So we can see if the keys line up correctly
+
+emptyLocalRdrEnv :: LocalRdrEnv
+emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv
+                       , lre_in_scope = emptyNameSet }
+
+extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
+-- The Name should be a non-top-level thing
+extendLocalRdrEnv lre@(LRE { lre_env = env, lre_in_scope = ns }) name
+  = WARN( isExternalName name, ppr name )
+    lre { lre_env      = extendOccEnv env (nameOccName name) name
+        , lre_in_scope = extendNameSet ns name }
+
+extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnvList lre@(LRE { lre_env = env, lre_in_scope = ns }) names
+  = WARN( any isExternalName names, ppr names )
+    lre { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
+        , lre_in_scope = extendNameSetList ns names }
+
+lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
+lookupLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) rdr
+  | Unqual occ <- rdr
+  = lookupOccEnv env occ
+
+  -- See Note [Local bindings with Exact Names]
+  | Exact name <- rdr
+  , name `elemNameSet` ns
+  = Just name
+
+  | otherwise
+  = Nothing
+
+lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
+lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ
+
+elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
+elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })
+  = case rdr_name of
+      Unqual occ -> occ  `elemOccEnv` env
+      Exact name -> name `elemNameSet` ns  -- See Note [Local bindings with Exact Names]
+      Qual {} -> False
+      Orig {} -> False
+
+localRdrEnvElts :: LocalRdrEnv -> [Name]
+localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env
+
+inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
+-- This is the point of the NameSet
+inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
+
+delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
+delLocalRdrEnvList lre@(LRE { lre_env = env }) occs
+  = lre { lre_env = delListFromOccEnv env occs }
+
+{-
+Note [Local bindings with Exact Names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+With Template Haskell we can make local bindings that have Exact Names.
+Computing shadowing etc may use elemLocalRdrEnv (at least it certainly
+does so in GHC.Rename.Types.bindHsQTyVars), so for an Exact Name we must consult
+the in-scope-name-set.
+
+
+************************************************************************
+*                                                                      *
+                        GlobalRdrEnv
+*                                                                      *
+************************************************************************
+-}
+
+-- | Global Reader Environment
+type GlobalRdrEnv = OccEnv [GlobalRdrElt]
+-- ^ Keyed by 'OccName'; when looking up a qualified name
+-- we look up the 'OccName' part, and then check the 'Provenance'
+-- to see if the appropriate qualification is valid.  This
+-- saves routinely doubling the size of the env by adding both
+-- qualified and unqualified names to the domain.
+--
+-- The list in the codomain is required because there may be name clashes
+-- These only get reported on lookup, not on construction
+--
+-- INVARIANT 1: All the members of the list have distinct
+--              'gre_name' fields; that is, no duplicate Names
+--
+-- INVARIANT 2: Imported provenance => Name is an ExternalName
+--              However LocalDefs can have an InternalName.  This
+--              happens only when type-checking a [d| ... |] Template
+--              Haskell quotation; see this note in GHC.Rename.Names
+--              Note [Top-level Names in Template Haskell decl quotes]
+--
+-- INVARIANT 3: If the GlobalRdrEnv maps [occ -> gre], then
+--                 greOccName gre = occ
+--
+--              NB: greOccName gre is usually the same as
+--                  nameOccName (gre_name gre), but not always in the
+--                  case of record selectors; see greOccName
+
+-- | Global Reader Element
+--
+-- An element of the 'GlobalRdrEnv'
+data GlobalRdrElt
+  = GRE { gre_name :: Name
+        , gre_par  :: Parent
+        , gre_lcl :: Bool          -- ^ True <=> the thing was defined locally
+        , gre_imp :: [ImportSpec]  -- ^ In scope through these imports
+    } deriving (Data, Eq)
+         -- INVARIANT: either gre_lcl = True or gre_imp is non-empty
+         -- See Note [GlobalRdrElt provenance]
+
+-- | The children of a Name are the things that are abbreviated by the ".."
+--   notation in export lists.  See Note [Parents]
+data Parent = NoParent
+            | ParentIs  { par_is :: Name }
+            | FldParent { par_is :: Name, par_lbl :: Maybe FieldLabelString }
+              -- ^ See Note [Parents for record fields]
+            deriving (Eq, Data)
+
+instance Outputable Parent where
+   ppr NoParent        = empty
+   ppr (ParentIs n)    = text "parent:" <> ppr n
+   ppr (FldParent n f) = text "fldparent:"
+                             <> ppr n <> colon <> ppr f
+
+plusParent :: Parent -> Parent -> Parent
+-- See Note [Combining parents]
+plusParent p1@(ParentIs _)    p2 = hasParent p1 p2
+plusParent p1@(FldParent _ _) p2 = hasParent p1 p2
+plusParent p1 p2@(ParentIs _)    = hasParent p2 p1
+plusParent p1 p2@(FldParent _ _) = hasParent p2 p1
+plusParent _ _                   = NoParent
+
+hasParent :: Parent -> Parent -> Parent
+#if defined(DEBUG)
+hasParent p NoParent = p
+hasParent p p'
+  | p /= p' = pprPanic "hasParent" (ppr p <+> ppr p')  -- Parents should agree
+#endif
+hasParent p _  = p
+
+
+{- Note [GlobalRdrElt provenance]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance",
+i.e. how the Name came to be in scope.  It can be in scope two ways:
+  - gre_lcl = True: it is bound in this module
+  - gre_imp: a list of all the imports that brought it into scope
+
+It's an INVARIANT that you have one or the other; that is, either
+gre_lcl is True, or gre_imp is non-empty.
+
+It is just possible to have *both* if there is a module loop: a Name
+is defined locally in A, and also brought into scope by importing a
+module that SOURCE-imported A.  Example (#7672):
+
+ A.hs-boot   module A where
+               data T
+
+ B.hs        module B(Decl.T) where
+               import {-# SOURCE #-} qualified A as Decl
+
+ A.hs        module A where
+               import qualified B
+               data T = Z | S B.T
+
+In A.hs, 'T' is locally bound, *and* imported as B.T.
+
+Note [Parents]
+~~~~~~~~~~~~~~~~~
+  Parent           Children
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+  data T           Data constructors
+                   Record-field ids
+
+  data family T    Data constructors and record-field ids
+                   of all visible data instances of T
+
+  class C          Class operations
+                   Associated type constructors
+
+~~~~~~~~~~~~~~~~~~~~~~~~~
+ Constructor      Meaning
+ ~~~~~~~~~~~~~~~~~~~~~~~~
+  NoParent        Can not be bundled with a type constructor.
+  ParentIs n      Can be bundled with the type constructor corresponding to
+                  n.
+  FldParent       See Note [Parents for record fields]
+
+
+
+
+Note [Parents for record fields]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For record fields, in addition to the Name of the type constructor
+(stored in par_is), we use FldParent to store the field label.  This
+extra information is used for identifying overloaded record fields
+during renaming.
+
+In a definition arising from a normal module (without
+-XDuplicateRecordFields), par_lbl will be Nothing, meaning that the
+field's label is the same as the OccName of the selector's Name.  The
+GlobalRdrEnv will contain an entry like this:
+
+    "x" |->  GRE x (FldParent T Nothing) LocalDef
+
+When -XDuplicateRecordFields is enabled for the module that contains
+T, the selector's Name will be mangled (see comments in GHC.Types.FieldLabel).
+Thus we store the actual field label in par_lbl, and the GlobalRdrEnv
+entry looks like this:
+
+    "x" |->  GRE $sel:x:MkT (FldParent T (Just "x")) LocalDef
+
+Note that the OccName used when adding a GRE to the environment
+(greOccName) now depends on the parent field: for FldParent it is the
+field label, if present, rather than the selector name.
+
+~~
+
+Record pattern synonym selectors are treated differently. Their parent
+information is `NoParent` in the module in which they are defined. This is because
+a pattern synonym `P` has no parent constructor either.
+
+However, if `f` is bundled with a type constructor `T` then whenever `f` is
+imported the parent will use the `Parent` constructor so the parent of `f` is
+now `T`.
+
+
+Note [Combining parents]
+~~~~~~~~~~~~~~~~~~~~~~~~
+With an associated type we might have
+   module M where
+     class C a where
+       data T a
+       op :: T a -> a
+     instance C Int where
+       data T Int = TInt
+     instance C Bool where
+       data T Bool = TBool
+
+Then:   C is the parent of T
+        T is the parent of TInt and TBool
+So: in an export list
+    C(..) is short for C( op, T )
+    T(..) is short for T( TInt, TBool )
+
+Module M exports everything, so its exports will be
+   AvailTC C [C,T,op]
+   AvailTC T [T,TInt,TBool]
+On import we convert to GlobalRdrElt and then combine
+those.  For T that will mean we have
+  one GRE with Parent C
+  one GRE with NoParent
+That's why plusParent picks the "best" case.
+-}
+
+-- | make a 'GlobalRdrEnv' where all the elements point to the same
+-- Provenance (useful for "hiding" imports, or imports with no details).
+gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
+-- prov = Nothing   => locally bound
+--        Just spec => imported as described by spec
+gresFromAvails prov avails
+  = concatMap (gresFromAvail (const prov)) avails
+
+localGREsFromAvail :: AvailInfo -> [GlobalRdrElt]
+-- Turn an Avail into a list of LocalDef GlobalRdrElts
+localGREsFromAvail = gresFromAvail (const Nothing)
+
+gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
+gresFromAvail prov_fn avail
+  = map mk_gre (availNonFldNames avail) ++ map mk_fld_gre (availFlds avail)
+  where
+    mk_gre n
+      = case prov_fn n of  -- Nothing => bound locally
+                           -- Just is => imported from 'is'
+          Nothing -> GRE { gre_name = n, gre_par = mkParent n avail
+                         , gre_lcl = True, gre_imp = [] }
+          Just is -> GRE { gre_name = n, gre_par = mkParent n avail
+                         , gre_lcl = False, gre_imp = [is] }
+
+    mk_fld_gre (FieldLabel { flLabel = lbl, flIsOverloaded = is_overloaded
+                           , flSelector = n })
+      = case prov_fn n of  -- Nothing => bound locally
+                           -- Just is => imported from 'is'
+          Nothing -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl
+                         , gre_lcl = True, gre_imp = [] }
+          Just is -> GRE { gre_name = n, gre_par = FldParent (availName avail) mb_lbl
+                         , gre_lcl = False, gre_imp = [is] }
+      where
+        mb_lbl | is_overloaded = Just lbl
+               | otherwise     = Nothing
+
+
+greQualModName :: GlobalRdrElt -> ModuleName
+-- Get a suitable module qualifier for the GRE
+-- (used in mkPrintUnqualified)
+-- Prerecondition: the gre_name is always External
+greQualModName gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })
+ | lcl, Just mod <- nameModule_maybe name = moduleName mod
+ | (is:_) <- iss                          = is_as (is_decl is)
+ | otherwise                              = pprPanic "greQualModName" (ppr gre)
+
+greRdrNames :: GlobalRdrElt -> [RdrName]
+greRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss }
+  = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss)
+  where
+    occ    = greOccName gre
+    unqual = Unqual occ
+    do_spec decl_spec
+        | is_qual decl_spec = [qual]
+        | otherwise         = [unqual,qual]
+        where qual = Qual (is_as decl_spec) occ
+
+-- the SrcSpan that pprNameProvenance prints out depends on whether
+-- the Name is defined locally or not: for a local definition the
+-- definition site is used, otherwise the location of the import
+-- declaration.  We want to sort the export locations in
+-- exportClashErr by this SrcSpan, we need to extract it:
+greSrcSpan :: GlobalRdrElt -> SrcSpan
+greSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } )
+  | lcl           = nameSrcSpan name
+  | (is:_) <- iss = is_dloc (is_decl is)
+  | otherwise     = pprPanic "greSrcSpan" (ppr gre)
+
+mkParent :: Name -> AvailInfo -> Parent
+mkParent _ (Avail _)           = NoParent
+mkParent n (AvailTC m _ _) | n == m    = NoParent
+                         | otherwise = ParentIs m
+
+greParent_maybe :: GlobalRdrElt -> Maybe Name
+greParent_maybe gre = case gre_par gre of
+                        NoParent      -> Nothing
+                        ParentIs n    -> Just n
+                        FldParent n _ -> Just n
+
+-- | Takes a list of distinct GREs and folds them
+-- into AvailInfos. This is more efficient than mapping each individual
+-- GRE to an AvailInfo and the folding using `plusAvail` but needs the
+-- uniqueness assumption.
+gresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]
+gresToAvailInfo gres
+  = nameEnvElts avail_env
+  where
+    avail_env :: NameEnv AvailInfo -- Keyed by the parent
+    (avail_env, _) = foldl' add (emptyNameEnv, emptyNameSet) gres
+
+    add :: (NameEnv AvailInfo, NameSet)
+        -> GlobalRdrElt
+        -> (NameEnv AvailInfo, NameSet)
+    add (env, done) gre
+      | name `elemNameSet` done
+      = (env, done)  -- Don't insert twice into the AvailInfo
+      | otherwise
+      = ( extendNameEnv_Acc comb availFromGRE env key gre
+        , done `extendNameSet` name )
+      where
+        name = gre_name gre
+        key = case greParent_maybe gre of
+                 Just parent -> parent
+                 Nothing     -> gre_name gre
+
+        -- We want to insert the child `k` into a list of children but
+        -- need to maintain the invariant that the parent is first.
+        --
+        -- We also use the invariant that `k` is not already in `ns`.
+        insertChildIntoChildren :: Name -> [Name] -> Name -> [Name]
+        insertChildIntoChildren _ [] k = [k]
+        insertChildIntoChildren p (n:ns) k
+          | p == k = k:n:ns
+          | otherwise = n:k:ns
+
+        comb :: GlobalRdrElt -> AvailInfo -> AvailInfo
+        comb _ (Avail n) = Avail n -- Duplicated name, should not happen
+        comb gre (AvailTC m ns fls)
+          = case gre_par gre of
+              NoParent    -> AvailTC m (name:ns) fls -- Not sure this ever happens
+              ParentIs {} -> AvailTC m (insertChildIntoChildren m ns name) fls
+              FldParent _ mb_lbl -> AvailTC m ns (mkFieldLabel name mb_lbl : fls)
+
+availFromGRE :: GlobalRdrElt -> AvailInfo
+availFromGRE (GRE { gre_name = me, gre_par = parent })
+  = case parent of
+      ParentIs p                  -> AvailTC p [me] []
+      NoParent   | isTyConName me -> AvailTC me [me] []
+                 | otherwise      -> avail   me
+      FldParent p mb_lbl -> AvailTC p [] [mkFieldLabel me mb_lbl]
+
+mkFieldLabel :: Name -> Maybe FastString -> FieldLabel
+mkFieldLabel me mb_lbl =
+          case mb_lbl of
+                 Nothing  -> FieldLabel { flLabel = occNameFS (nameOccName me)
+                                        , flIsOverloaded = False
+                                        , flSelector = me }
+                 Just lbl -> FieldLabel { flLabel = lbl
+                                        , flIsOverloaded = True
+                                        , flSelector = me }
+
+emptyGlobalRdrEnv :: GlobalRdrEnv
+emptyGlobalRdrEnv = emptyOccEnv
+
+globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
+globalRdrEnvElts env = foldOccEnv (++) [] env
+
+instance Outputable GlobalRdrElt where
+  ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))
+               2 (pprNameProvenance gre)
+
+pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
+pprGlobalRdrEnv locals_only env
+  = vcat [ text "GlobalRdrEnv" <+> ppWhen locals_only (ptext (sLit "(locals only)"))
+             <+> lbrace
+         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]
+             <+> rbrace) ]
+  where
+    remove_locals gres | locals_only = filter isLocalGRE gres
+                       | otherwise   = gres
+    pp []   = empty
+    pp gres = hang (ppr occ
+                     <+> parens (text "unique" <+> ppr (getUnique occ))
+                     <> colon)
+                 2 (vcat (map ppr gres))
+      where
+        occ = nameOccName (gre_name (head gres))
+
+lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
+lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
+                                  Nothing   -> []
+                                  Just gres -> gres
+
+greOccName :: GlobalRdrElt -> OccName
+greOccName (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = mkVarOccFS lbl
+greOccName gre                                            = nameOccName (gre_name gre)
+
+lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
+lookupGRE_RdrName rdr_name env
+  = case lookupOccEnv env (rdrNameOcc rdr_name) of
+    Nothing   -> []
+    Just gres -> pickGREs rdr_name gres
+
+lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
+-- ^ Look for precisely this 'Name' in the environment.  This tests
+-- whether it is in scope, ignoring anything else that might be in
+-- scope with the same 'OccName'.
+lookupGRE_Name env name
+  = lookupGRE_Name_OccName env name (nameOccName name)
+
+lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
+-- ^ Look for a particular record field selector in the environment, where the
+-- selector name and field label may be different: the GlobalRdrEnv is keyed on
+-- the label.  See Note [Parents for record fields] for why this happens.
+lookupGRE_FieldLabel env fl
+  = lookupGRE_Name_OccName env (flSelector fl) (mkVarOccFS (flLabel fl))
+
+lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
+-- ^ Look for precisely this 'Name' in the environment, but with an 'OccName'
+-- that might differ from that of the 'Name'.  See 'lookupGRE_FieldLabel' and
+-- Note [Parents for record fields].
+lookupGRE_Name_OccName env name occ
+  = case [ gre | gre <- lookupGlobalRdrEnv env occ
+               , gre_name gre == name ] of
+      []    -> Nothing
+      [gre] -> Just gre
+      gres  -> pprPanic "lookupGRE_Name_OccName"
+                        (ppr name $$ ppr occ $$ ppr gres)
+               -- See INVARIANT 1 on GlobalRdrEnv
+
+
+getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
+-- Returns all the qualifiers by which 'x' is in scope
+-- Nothing means "the unqualified version is in scope"
+-- [] means the thing is not in scope at all
+getGRE_NameQualifier_maybes env name
+  = case lookupGRE_Name env name of
+      Just gre -> [qualifier_maybe gre]
+      Nothing  -> []
+  where
+    qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss })
+      | lcl       = Nothing
+      | otherwise = Just $ map (is_as . is_decl) iss
+
+isLocalGRE :: GlobalRdrElt -> Bool
+isLocalGRE (GRE {gre_lcl = lcl }) = lcl
+
+isRecFldGRE :: GlobalRdrElt -> Bool
+isRecFldGRE (GRE {gre_par = FldParent{}}) = True
+isRecFldGRE _                             = False
+
+-- Returns the field label of this GRE, if it has one
+greLabel :: GlobalRdrElt -> Maybe FieldLabelString
+greLabel (GRE{gre_par = FldParent{par_lbl = Just lbl}}) = Just lbl
+greLabel (GRE{gre_name = n, gre_par = FldParent{}})     = Just (occNameFS (nameOccName n))
+greLabel _                                              = Nothing
+
+unQualOK :: GlobalRdrElt -> Bool
+-- ^ Test if an unqualified version of this thing would be in scope
+unQualOK (GRE {gre_lcl = lcl, gre_imp = iss })
+  | lcl = True
+  | otherwise = any unQualSpecOK iss
+
+{- Note [GRE filtering]
+~~~~~~~~~~~~~~~~~~~~~~~
+(pickGREs rdr gres) takes a list of GREs which have the same OccName
+as 'rdr', say "x".  It does two things:
+
+(a) filters the GREs to a subset that are in scope
+    * Qualified,   as 'M.x'  if want_qual    is Qual M _
+    * Unqualified, as 'x'    if want_unqual  is Unqual _
+
+(b) for that subset, filter the provenance field (gre_lcl and gre_imp)
+    to ones that brought it into scope qualified or unqualified resp.
+
+Example:
+      module A ( f ) where
+      import qualified Foo( f )
+      import Baz( f )
+      f = undefined
+
+Let's suppose that Foo.f and Baz.f are the same entity really, but the local
+'f' is different, so there will be two GREs matching "f":
+   gre1:  gre_lcl = True,  gre_imp = []
+   gre2:  gre_lcl = False, gre_imp = [ imported from Foo, imported from Bar ]
+
+The use of "f" in the export list is ambiguous because it's in scope
+from the local def and the import Baz(f); but *not* the import qualified Foo.
+pickGREs returns two GRE
+   gre1:   gre_lcl = True,  gre_imp = []
+   gre2:   gre_lcl = False, gre_imp = [ imported from Bar ]
+
+Now the "ambiguous occurrence" message can correctly report how the
+ambiguity arises.
+-}
+
+pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
+-- ^ Takes a list of GREs which have the right OccName 'x'
+-- Pick those GREs that are in scope
+--    * Qualified,   as 'M.x'  if want_qual    is Qual M _
+--    * Unqualified, as 'x'    if want_unqual  is Unqual _
+--
+-- Return each such GRE, with its ImportSpecs filtered, to reflect
+-- how it is in scope qualified or unqualified respectively.
+-- See Note [GRE filtering]
+pickGREs (Unqual {})  gres = mapMaybe pickUnqualGRE     gres
+pickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) gres
+pickGREs _            _    = []  -- I don't think this actually happens
+
+pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt
+pickUnqualGRE gre@(GRE { gre_lcl = lcl, gre_imp = iss })
+  | not lcl, null iss' = Nothing
+  | otherwise          = Just (gre { gre_imp = iss' })
+  where
+    iss' = filter unQualSpecOK iss
+
+pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
+pickQualGRE mod gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss })
+  | not lcl', null iss' = Nothing
+  | otherwise           = Just (gre { gre_lcl = lcl', gre_imp = iss' })
+  where
+    iss' = filter (qualSpecOK mod) iss
+    lcl' = lcl && name_is_from mod n
+
+    name_is_from :: ModuleName -> Name -> Bool
+    name_is_from mod name = case nameModule_maybe name of
+                              Just n_mod -> moduleName n_mod == mod
+                              Nothing    -> False
+
+pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)]
+-- ^ Pick GREs that are in scope *both* qualified *and* unqualified
+-- Return each GRE that is, as a pair
+--    (qual_gre, unqual_gre)
+-- These two GREs are the original GRE with imports filtered to express how
+-- it is in scope qualified an unqualified respectively
+--
+-- Used only for the 'module M' item in export list;
+--   see GHC.Rename.Names.exports_from_avail
+pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres
+
+pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)
+pickBothGRE mod gre@(GRE { gre_name = n })
+  | isBuiltInSyntax n                = Nothing
+  | Just gre1 <- pickQualGRE mod gre
+  , Just gre2 <- pickUnqualGRE   gre = Just (gre1, gre2)
+  | otherwise                        = Nothing
+  where
+        -- isBuiltInSyntax filter out names for built-in syntax They
+        -- just clutter up the environment (esp tuples), and the
+        -- parser will generate Exact RdrNames for them, so the
+        -- cluttered envt is no use.  Really, it's only useful for
+        -- GHC.Base and GHC.Tuple.
+
+-- Building GlobalRdrEnvs
+
+plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
+plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
+
+mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
+mkGlobalRdrEnv gres
+  = foldr add emptyGlobalRdrEnv gres
+  where
+    add gre env = extendOccEnv_Acc insertGRE singleton env
+                                   (greOccName gre)
+                                   gre
+
+insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
+insertGRE new_g [] = [new_g]
+insertGRE new_g (old_g : old_gs)
+        | gre_name new_g == gre_name old_g
+        = new_g `plusGRE` old_g : old_gs
+        | otherwise
+        = old_g : insertGRE new_g old_gs
+
+plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
+-- Used when the gre_name fields match
+plusGRE g1 g2
+  = GRE { gre_name = gre_name g1
+        , gre_lcl  = gre_lcl g1 || gre_lcl g2
+        , gre_imp  = gre_imp g1 ++ gre_imp g2
+        , gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
+
+transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
+              -> [OccName]
+              -> GlobalRdrEnv -> GlobalRdrEnv
+-- ^ Apply a transformation function to the GREs for these OccNames
+transformGREs trans_gre occs rdr_env
+  = foldr trans rdr_env occs
+  where
+    trans occ env
+      = case lookupOccEnv env occ of
+           Just gres -> extendOccEnv env occ (map trans_gre gres)
+           Nothing   -> env
+
+extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
+extendGlobalRdrEnv env gre
+  = extendOccEnv_Acc insertGRE singleton env
+                     (greOccName gre) gre
+
+shadowNames :: GlobalRdrEnv -> [Name] -> GlobalRdrEnv
+shadowNames = foldl' shadowName
+
+{- Note [GlobalRdrEnv shadowing]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Before adding new names to the GlobalRdrEnv we nuke some existing entries;
+this is "shadowing".  The actual work is done by RdrEnv.shadowName.
+Suppose
+   env' = shadowName env M.f
+
+Then:
+   * Looking up (Unqual f) in env' should succeed, returning M.f,
+     even if env contains existing unqualified bindings for f.
+     They are shadowed
+
+   * Looking up (Qual M.f) in env' should succeed, returning M.f
+
+   * Looking up (Qual X.f) in env', where X /= M, should be the same as
+     looking up (Qual X.f) in env.
+     That is, shadowName does /not/ delete earlier qualified bindings
+
+There are two reasons for shadowing:
+
+* The GHCi REPL
+
+  - Ids bought into scope on the command line (eg let x = True) have
+    External Names, like Ghci4.x.  We want a new binding for 'x' (say)
+    to override the existing binding for 'x'.  Example:
+
+           ghci> :load M    -- Brings `x` and `M.x` into scope
+           ghci> x
+           ghci> "Hello"
+           ghci> M.x
+           ghci> "hello"
+           ghci> let x = True  -- Shadows `x`
+           ghci> x             -- The locally bound `x`
+                               -- NOT an ambiguous reference
+           ghci> True
+           ghci> M.x           -- M.x is still in scope!
+           ghci> "Hello"
+    So when we add `x = True` we must not delete the `M.x` from the
+    `GlobalRdrEnv`; rather we just want to make it "qualified only";
+    hence the `mk_fake-imp_spec` in `shadowName`.  See also Note
+    [Interactively-bound Ids in GHCi] in GHC.Driver.Types
+
+  - Data types also have External Names, like Ghci4.T; but we still want
+    'T' to mean the newly-declared 'T', not an old one.
+
+* Nested Template Haskell declaration brackets
+  See Note [Top-level Names in Template Haskell decl quotes] in GHC.Rename.Names
+
+  Consider a TH decl quote:
+      module M where
+        f x = h [d| f = ...f...M.f... |]
+  We must shadow the outer unqualified binding of 'f', else we'll get
+  a complaint when extending the GlobalRdrEnv, saying that there are
+  two bindings for 'f'.  There are several tricky points:
+
+    - This shadowing applies even if the binding for 'f' is in a
+      where-clause, and hence is in the *local* RdrEnv not the *global*
+      RdrEnv.  This is done in lcl_env_TH in extendGlobalRdrEnvRn.
+
+    - The External Name M.f from the enclosing module must certainly
+      still be available.  So we don't nuke it entirely; we just make
+      it seem like qualified import.
+
+    - We only shadow *External* names (which come from the main module),
+      or from earlier GHCi commands. Do not shadow *Internal* names
+      because in the bracket
+          [d| class C a where f :: a
+              f = 4 |]
+      rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the
+      class decl, and *separately* extend the envt with the value binding.
+      At that stage, the class op 'f' will have an Internal name.
+-}
+
+shadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv
+-- Remove certain old GREs that share the same OccName as this new Name.
+-- See Note [GlobalRdrEnv shadowing] for details
+shadowName env name
+  = alterOccEnv (fmap alter_fn) env (nameOccName name)
+  where
+    alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
+    alter_fn gres = mapMaybe (shadow_with name) gres
+
+    shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
+    shadow_with new_name
+       old_gre@(GRE { gre_name = old_name, gre_lcl = lcl, gre_imp = iss })
+       = case nameModule_maybe old_name of
+           Nothing -> Just old_gre   -- Old name is Internal; do not shadow
+           Just old_mod
+              | Just new_mod <- nameModule_maybe new_name
+              , new_mod == old_mod   -- Old name same as new name; shadow completely
+              -> Nothing
+
+              | null iss'            -- Nothing remains
+              -> Nothing
+
+              | otherwise
+              -> Just (old_gre { gre_lcl = False, gre_imp = iss' })
+
+              where
+                iss' = lcl_imp ++ mapMaybe (shadow_is new_name) iss
+                lcl_imp | lcl       = [mk_fake_imp_spec old_name old_mod]
+                        | otherwise = []
+
+    mk_fake_imp_spec old_name old_mod    -- Urgh!
+      = ImpSpec id_spec ImpAll
+      where
+        old_mod_name = moduleName old_mod
+        id_spec      = ImpDeclSpec { is_mod = old_mod_name
+                                   , is_as = old_mod_name
+                                   , is_qual = True
+                                   , is_dloc = nameSrcSpan old_name }
+
+    shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
+    shadow_is new_name is@(ImpSpec { is_decl = id_spec })
+       | Just new_mod <- nameModule_maybe new_name
+       , is_as id_spec == moduleName new_mod
+       = Nothing   -- Shadow both qualified and unqualified
+       | otherwise -- Shadow unqualified only
+       = Just (is { is_decl = id_spec { is_qual = True } })
+
+
+{-
+************************************************************************
+*                                                                      *
+                        ImportSpec
+*                                                                      *
+************************************************************************
+-}
+
+-- | Import Specification
+--
+-- The 'ImportSpec' of something says how it came to be imported
+-- It's quite elaborate so that we can give accurate unused-name warnings.
+data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
+                            is_item :: ImpItemSpec }
+                deriving( Eq, Data )
+
+-- | Import Declaration Specification
+--
+-- Describes a particular import declaration and is
+-- shared among all the 'Provenance's for that decl
+data ImpDeclSpec
+  = ImpDeclSpec {
+        is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@
+                                   -- Note the @Muggle@ may well not be
+                                   -- the defining module for this thing!
+
+                                   -- TODO: either should be Module, or there
+                                   -- should be a Maybe UnitId here too.
+        is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
+        is_qual     :: Bool,       -- ^ Was this import qualified?
+        is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration
+    } deriving (Eq, Data)
+
+-- | Import Item Specification
+--
+-- Describes import info a particular Name
+data ImpItemSpec
+  = ImpAll              -- ^ The import had no import list,
+                        -- or had a hiding list
+
+  | ImpSome {
+        is_explicit :: Bool,
+        is_iloc     :: SrcSpan  -- Location of the import item
+    }   -- ^ The import had an import list.
+        -- The 'is_explicit' field is @True@ iff the thing was named
+        -- /explicitly/ in the import specs rather
+        -- than being imported as part of a "..." group. Consider:
+        --
+        -- > import C( T(..) )
+        --
+        -- Here the constructors of @T@ are not named explicitly;
+        -- only @T@ is named explicitly.
+  deriving (Eq, Data)
+
+bestImport :: [ImportSpec] -> ImportSpec
+-- See Note [Choosing the best import declaration]
+bestImport iss
+  = case sortBy best iss of
+      (is:_) -> is
+      []     -> pprPanic "bestImport" (ppr iss)
+  where
+    best :: ImportSpec -> ImportSpec -> Ordering
+    -- Less means better
+    -- Unqualified always wins over qualified; then
+    -- import-all wins over import-some; then
+    -- earlier declaration wins over later
+    best (ImpSpec { is_item = item1, is_decl = d1 })
+         (ImpSpec { is_item = item2, is_decl = d2 })
+      = (is_qual d1 `compare` is_qual d2) `thenCmp`
+        (best_item item1 item2)           `thenCmp`
+        SrcLoc.leftmost_smallest (is_dloc d1) (is_dloc d2)
+
+    best_item :: ImpItemSpec -> ImpItemSpec -> Ordering
+    best_item ImpAll ImpAll = EQ
+    best_item ImpAll (ImpSome {}) = LT
+    best_item (ImpSome {}) ImpAll = GT
+    best_item (ImpSome { is_explicit = e1 })
+              (ImpSome { is_explicit = e2 }) = e1 `compare` e2
+     -- False < True, so if e1 is explicit and e2 is not, we get GT
+
+{- Note [Choosing the best import declaration]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When reporting unused import declarations we use the following rules.
+   (see [wiki:commentary/compiler/unused-imports])
+
+Say that an import-item is either
+  * an entire import-all decl (eg import Foo), or
+  * a particular item in an import list (eg import Foo( ..., x, ...)).
+The general idea is that for each /occurrence/ of an imported name, we will
+attribute that use to one import-item. Once we have processed all the
+occurrences, any import items with no uses attributed to them are unused,
+and are warned about. More precisely:
+
+1. For every RdrName in the program text, find its GlobalRdrElt.
+
+2. Then, from the [ImportSpec] (gre_imp) of that GRE, choose one
+   the "chosen import-item", and mark it "used". This is done
+   by 'bestImport'
+
+3. After processing all the RdrNames, bleat about any
+   import-items that are unused.
+   This is done in GHC.Rename.Names.warnUnusedImportDecls.
+
+The function 'bestImport' returns the dominant import among the
+ImportSpecs it is given, implementing Step 2.  We say import-item A
+dominates import-item B if we choose A over B. In general, we try to
+choose the import that is most likely to render other imports
+unnecessary.  Here is the dominance relationship we choose:
+
+    a) import Foo dominates import qualified Foo.
+
+    b) import Foo dominates import Foo(x).
+
+    c) Otherwise choose the textually first one.
+
+Rationale for (a).  Consider
+   import qualified M  -- Import #1
+   import M( x )       -- Import #2
+   foo = M.x + x
+
+The unqualified 'x' can only come from import #2.  The qualified 'M.x'
+could come from either, but bestImport picks import #2, because it is
+more likely to be useful in other imports, as indeed it is in this
+case (see #5211 for a concrete example).
+
+But the rules are not perfect; consider
+   import qualified M  -- Import #1
+   import M( x )       -- Import #2
+   foo = M.x + M.y
+
+The M.x will use import #2, but M.y can only use import #1.
+-}
+
+
+unQualSpecOK :: ImportSpec -> Bool
+-- ^ Is in scope unqualified?
+unQualSpecOK is = not (is_qual (is_decl is))
+
+qualSpecOK :: ModuleName -> ImportSpec -> Bool
+-- ^ Is in scope qualified with the given module?
+qualSpecOK mod is = mod == is_as (is_decl is)
+
+importSpecLoc :: ImportSpec -> SrcSpan
+importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
+importSpecLoc (ImpSpec _    item)   = is_iloc item
+
+importSpecModule :: ImportSpec -> ModuleName
+importSpecModule is = is_mod (is_decl is)
+
+isExplicitItem :: ImpItemSpec -> Bool
+isExplicitItem ImpAll                        = False
+isExplicitItem (ImpSome {is_explicit = exp}) = exp
+
+pprNameProvenance :: GlobalRdrElt -> SDoc
+-- ^ Print out one place where the name was define/imported
+-- (With -dppr-debug, print them all)
+pprNameProvenance (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })
+  = ifPprDebug (vcat pp_provs)
+               (head pp_provs)
+  where
+    pp_provs = pp_lcl ++ map pp_is iss
+    pp_lcl = if lcl then [text "defined at" <+> ppr (nameSrcLoc name)]
+                    else []
+    pp_is is = sep [ppr is, ppr_defn_site is name]
+
+-- If we know the exact definition point (which we may do with GHCi)
+-- then show that too.  But not if it's just "imported from X".
+ppr_defn_site :: ImportSpec -> Name -> SDoc
+ppr_defn_site imp_spec name
+  | same_module && not (isGoodSrcSpan loc)
+  = empty              -- Nothing interesting to say
+  | otherwise
+  = parens $ hang (text "and originally defined" <+> pp_mod)
+                2 (pprLoc loc)
+  where
+    loc = nameSrcSpan name
+    defining_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
+    same_module = importSpecModule imp_spec == moduleName defining_mod
+    pp_mod | same_module = empty
+           | otherwise   = text "in" <+> quotes (ppr defining_mod)
+
+
+instance Outputable ImportSpec where
+   ppr imp_spec
+     = text "imported" <+> qual
+        <+> text "from" <+> quotes (ppr (importSpecModule imp_spec))
+        <+> pprLoc (importSpecLoc imp_spec)
+     where
+       qual | is_qual (is_decl imp_spec) = text "qualified"
+            | otherwise                  = empty
+
+pprLoc :: SrcSpan -> SDoc
+pprLoc (RealSrcSpan s _)  = text "at" <+> ppr s
+pprLoc (UnhelpfulSpan {}) = empty
+
+-- | Display info about the treatment of '*' under NoStarIsType.
+--
+-- With StarIsType, three properties of '*' hold:
+--
+--   (a) it is not an infix operator
+--   (b) it is always in scope
+--   (c) it is a synonym for Data.Kind.Type
+--
+-- However, the user might not know that he's working on a module with
+-- NoStarIsType and write code that still assumes (a), (b), and (c), which
+-- actually do not hold in that module.
+--
+-- Violation of (a) shows up in the parser. For instance, in the following
+-- examples, we have '*' not applied to enough arguments:
+--
+--   data A :: *
+--   data F :: * -> *
+--
+-- Violation of (b) or (c) show up in the renamer and the typechecker
+-- respectively. For instance:
+--
+--   type K = Either * Bool
+--
+-- This will parse differently depending on whether StarIsType is enabled,
+-- but it will parse nonetheless. With NoStarIsType it is parsed as a type
+-- operator, thus we have ((*) Either Bool). Now there are two cases to
+-- consider:
+--
+--   1. There is no definition of (*) in scope. In this case the renamer will
+--      fail to look it up. This is a violation of assumption (b).
+--
+--   2. There is a definition of the (*) type operator in scope (for example
+--      coming from GHC.TypeNats). In this case the user will get a kind
+--      mismatch error. This is a violation of assumption (c).
+--
+-- The user might unknowingly be working on a module with NoStarIsType
+-- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
+-- hint whenever an assumption about '*' is violated. Unfortunately, it is
+-- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
+--
+-- 'starInfo' generates an appropriate hint to the user depending on the
+-- extensions enabled in the module and the name that triggered the error.
+-- That is, if we have NoStarIsType and the error is related to '*' or its
+-- Unicode variant, the resulting SDoc will contain a helpful suggestion.
+-- Otherwise it is empty.
+--
+starInfo :: Bool -> RdrName -> SDoc
+starInfo star_is_type rdr_name =
+  -- One might ask: if can use `sdocOption sdocStarIsType` here, why bother to
+  -- take star_is_type as input? Why not refactor?
+  --
+  -- The reason is that `sdocOption sdocStarIsType` would indicate that
+  -- StarIsType is enabled in the module that tries to load the problematic
+  -- definition, not in the module that is being loaded.
+  --
+  -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
+  -- must be displayed even if we load this definition from a module (or GHCi)
+  -- with StarIsType enabled!
+  --
+  if isUnqualStar && not star_is_type
+     then text "With NoStarIsType, " <>
+          quotes (ppr rdr_name) <>
+          text " is treated as a regular type operator. "
+        $$
+          text "Did you mean to use " <> quotes (text "Type") <>
+          text " from Data.Kind instead?"
+      else empty
+  where
+    -- Does rdr_name look like the user might have meant the '*' kind by it?
+    -- We focus on unqualified stars specifically, because qualified stars are
+    -- treated as type operators even under StarIsType.
+    isUnqualStar
+      | Unqual occName <- rdr_name
+      = let fs = occNameFS occName
+        in fs == fsLit "*" || fs == fsLit "★"
+      | otherwise = False
diff --git a/compiler/GHC/Types/Name/Set.hs b/compiler/GHC/Types/Name/Set.hs
new file mode 100644
index 0000000000..04a8f1effa
--- /dev/null
+++ b/compiler/GHC/Types/Name/Set.hs
@@ -0,0 +1,215 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1998
+-}
+
+{-# LANGUAGE CPP #-}
+module GHC.Types.Name.Set (
+        -- * Names set type
+        NameSet,
+
+        -- ** Manipulating these sets
+        emptyNameSet, unitNameSet, mkNameSet, unionNameSet, unionNameSets,
+        minusNameSet, elemNameSet, extendNameSet, extendNameSetList,
+        delFromNameSet, delListFromNameSet, isEmptyNameSet, filterNameSet,
+        intersectsNameSet, intersectNameSet,
+        nameSetAny, nameSetAll, nameSetElemsStable,
+
+        -- * Free variables
+        FreeVars,
+
+        -- ** Manipulating sets of free variables
+        isEmptyFVs, emptyFVs, plusFVs, plusFV,
+        mkFVs, addOneFV, unitFV, delFV, delFVs,
+        intersectFVs,
+
+        -- * Defs and uses
+        Defs, Uses, DefUse, DefUses,
+
+        -- ** Manipulating defs and uses
+        emptyDUs, usesOnly, mkDUs, plusDU,
+        findUses, duDefs, duUses, allUses
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Types.Name
+import OrdList
+import GHC.Types.Unique.Set
+import Data.List (sortBy)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Sets of names}
+*                                                                      *
+************************************************************************
+-}
+
+type NameSet = UniqSet Name
+
+emptyNameSet       :: NameSet
+unitNameSet        :: Name -> NameSet
+extendNameSetList   :: NameSet -> [Name] -> NameSet
+extendNameSet    :: NameSet -> Name -> NameSet
+mkNameSet          :: [Name] -> NameSet
+unionNameSet      :: NameSet -> NameSet -> NameSet
+unionNameSets  :: [NameSet] -> NameSet
+minusNameSet       :: NameSet -> NameSet -> NameSet
+elemNameSet        :: Name -> NameSet -> Bool
+isEmptyNameSet     :: NameSet -> Bool
+delFromNameSet     :: NameSet -> Name -> NameSet
+delListFromNameSet :: NameSet -> [Name] -> NameSet
+filterNameSet      :: (Name -> Bool) -> NameSet -> NameSet
+intersectNameSet   :: NameSet -> NameSet -> NameSet
+intersectsNameSet  :: NameSet -> NameSet -> Bool
+-- ^ True if there is a non-empty intersection.
+-- @s1 `intersectsNameSet` s2@ doesn't compute @s2@ if @s1@ is empty
+
+isEmptyNameSet    = isEmptyUniqSet
+emptyNameSet      = emptyUniqSet
+unitNameSet       = unitUniqSet
+mkNameSet         = mkUniqSet
+extendNameSetList  = addListToUniqSet
+extendNameSet   = addOneToUniqSet
+unionNameSet     = unionUniqSets
+unionNameSets = unionManyUniqSets
+minusNameSet      = minusUniqSet
+elemNameSet       = elementOfUniqSet
+delFromNameSet    = delOneFromUniqSet
+filterNameSet     = filterUniqSet
+intersectNameSet  = intersectUniqSets
+
+delListFromNameSet set ns = foldl' delFromNameSet set ns
+
+intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
+
+nameSetAny :: (Name -> Bool) -> NameSet -> Bool
+nameSetAny = uniqSetAny
+
+nameSetAll :: (Name -> Bool) -> NameSet -> Bool
+nameSetAll = uniqSetAll
+
+-- | Get the elements of a NameSet with some stable ordering.
+-- This only works for Names that originate in the source code or have been
+-- tidied.
+-- See Note [Deterministic UniqFM] to learn about nondeterminism
+nameSetElemsStable :: NameSet -> [Name]
+nameSetElemsStable ns =
+  sortBy stableNameCmp $ nonDetEltsUniqSet ns
+  -- It's OK to use nonDetEltsUniqSet here because we immediately sort
+  -- with stableNameCmp
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Free variables}
+*                                                                      *
+************************************************************************
+
+These synonyms are useful when we are thinking of free variables
+-}
+
+type FreeVars   = NameSet
+
+plusFV   :: FreeVars -> FreeVars -> FreeVars
+addOneFV :: FreeVars -> Name -> FreeVars
+unitFV   :: Name -> FreeVars
+emptyFVs :: FreeVars
+plusFVs  :: [FreeVars] -> FreeVars
+mkFVs    :: [Name] -> FreeVars
+delFV    :: Name -> FreeVars -> FreeVars
+delFVs   :: [Name] -> FreeVars -> FreeVars
+intersectFVs :: FreeVars -> FreeVars -> FreeVars
+
+isEmptyFVs :: NameSet -> Bool
+isEmptyFVs  = isEmptyNameSet
+emptyFVs    = emptyNameSet
+plusFVs     = unionNameSets
+plusFV      = unionNameSet
+mkFVs       = mkNameSet
+addOneFV    = extendNameSet
+unitFV      = unitNameSet
+delFV n s   = delFromNameSet s n
+delFVs ns s = delListFromNameSet s ns
+intersectFVs = intersectNameSet
+
+{-
+************************************************************************
+*                                                                      *
+                Defs and uses
+*                                                                      *
+************************************************************************
+-}
+
+-- | A set of names that are defined somewhere
+type Defs = NameSet
+
+-- | A set of names that are used somewhere
+type Uses = NameSet
+
+-- | @(Just ds, us) =>@ The use of any member of the @ds@
+--                      implies that all the @us@ are used too.
+--                      Also, @us@ may mention @ds@.
+--
+-- @Nothing =>@ Nothing is defined in this group, but
+--              nevertheless all the uses are essential.
+--              Used for instance declarations, for example
+type DefUse  = (Maybe Defs, Uses)
+
+-- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses'
+--   In a single (def, use) pair, the defs also scope over the uses
+type DefUses = OrdList DefUse
+
+emptyDUs :: DefUses
+emptyDUs = nilOL
+
+usesOnly :: Uses -> DefUses
+usesOnly uses = unitOL (Nothing, uses)
+
+mkDUs :: [(Defs,Uses)] -> DefUses
+mkDUs pairs = toOL [(Just defs, uses) | (defs,uses) <- pairs]
+
+plusDU :: DefUses -> DefUses -> DefUses
+plusDU = appOL
+
+duDefs :: DefUses -> Defs
+duDefs dus = foldr get emptyNameSet dus
+  where
+    get (Nothing, _u1) d2 = d2
+    get (Just d1, _u1) d2 = d1 `unionNameSet` d2
+
+allUses :: DefUses -> Uses
+-- ^ Just like 'duUses', but 'Defs' are not eliminated from the 'Uses' returned
+allUses dus = foldr get emptyNameSet dus
+  where
+    get (_d1, u1) u2 = u1 `unionNameSet` u2
+
+duUses :: DefUses -> Uses
+-- ^ Collect all 'Uses', regardless of whether the group is itself used,
+-- but remove 'Defs' on the way
+duUses dus = foldr get emptyNameSet dus
+  where
+    get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSet` uses
+    get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSet` uses)
+                                     `minusNameSet` defs
+
+findUses :: DefUses -> Uses -> Uses
+-- ^ Given some 'DefUses' and some 'Uses', find all the uses, transitively.
+-- The result is a superset of the input 'Uses'; and includes things defined
+-- in the input 'DefUses' (but only if they are used)
+findUses dus uses
+  = foldr get uses dus
+  where
+    get (Nothing, rhs_uses) uses
+        = rhs_uses `unionNameSet` uses
+    get (Just defs, rhs_uses) uses
+        | defs `intersectsNameSet` uses         -- Used
+        || nameSetAny (startsWithUnderscore . nameOccName) defs
+                -- At least one starts with an "_",
+                -- so treat the group as used
+        = rhs_uses `unionNameSet` uses
+        | otherwise     -- No def is used
+        = uses
diff --git a/compiler/GHC/Types/Name/Shape.hs b/compiler/GHC/Types/Name/Shape.hs
index aa1879220f..39a25c1ad6 100644
--- a/compiler/GHC/Types/Name/Shape.hs
+++ b/compiler/GHC/Types/Name/Shape.hs
@@ -1,14 +1,15 @@
 {-# LANGUAGE CPP #-}
 
-module GHC.Types.Name.Shape(
-    NameShape(..),
-    emptyNameShape,
-    mkNameShape,
-    extendNameShape,
-    nameShapeExports,
-    substNameShape,
-    maybeSubstNameShape,
-    ) where
+module GHC.Types.Name.Shape
+   ( NameShape(..)
+   , emptyNameShape
+   , mkNameShape
+   , extendNameShape
+   , nameShapeExports
+   , substNameShape
+   , maybeSubstNameShape
+   )
+where
 
 #include "HsVersions.h"
 
@@ -16,13 +17,13 @@ import GhcPrelude
 
 import Outputable
 import GHC.Driver.Types
-import Module
-import UniqFM
-import Avail
-import FieldLabel
+import GHC.Types.Module
+import GHC.Types.Unique.FM
+import GHC.Types.Avail
+import GHC.Types.FieldLabel
 
-import Name
-import NameEnv
+import GHC.Types.Name
+import GHC.Types.Name.Env
 import TcRnMonad
 import Util
 import GHC.Iface.Env
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index 3a76dde256..645d2af7c8 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -25,7 +25,7 @@ module GHC.Types.RepType
 
 import GhcPrelude
 
-import BasicTypes (Arity, RepArity)
+import GHC.Types.Basic (Arity, RepArity)
 import GHC.Core.DataCon
 import Outputable
 import PrelNames
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
new file mode 100644
index 0000000000..0488d4d882
--- /dev/null
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -0,0 +1,741 @@
+-- (c) The University of Glasgow, 1992-2006
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveFunctor      #-}
+{-# LANGUAGE DeriveFoldable     #-}
+{-# LANGUAGE DeriveTraversable  #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE RecordWildCards    #-}
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE ViewPatterns       #-}
+{-# LANGUAGE FlexibleContexts   #-}
+{-# LANGUAGE PatternSynonyms    #-}
+
+
+-- | This module contains types that relate to the positions of things
+-- in source files, and allow tagging of those things with locations
+module GHC.Types.SrcLoc (
+        -- * SrcLoc
+        RealSrcLoc,             -- Abstract
+        SrcLoc(..),
+
+        -- ** Constructing SrcLoc
+        mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
+
+        noSrcLoc,               -- "I'm sorry, I haven't a clue"
+        generatedSrcLoc,        -- Code generated within the compiler
+        interactiveSrcLoc,      -- Code from an interactive session
+
+        advanceSrcLoc,
+        advanceBufPos,
+
+        -- ** Unsafely deconstructing SrcLoc
+        -- These are dubious exports, because they crash on some inputs
+        srcLocFile,             -- return the file name part
+        srcLocLine,             -- return the line part
+        srcLocCol,              -- return the column part
+
+        -- * SrcSpan
+        RealSrcSpan,            -- Abstract
+        SrcSpan(..),
+
+        -- ** Constructing SrcSpan
+        mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
+        noSrcSpan,
+        wiredInSrcSpan,         -- Something wired into the compiler
+        interactiveSrcSpan,
+        srcLocSpan, realSrcLocSpan,
+        combineSrcSpans,
+        srcSpanFirstCharacter,
+
+        -- ** Deconstructing SrcSpan
+        srcSpanStart, srcSpanEnd,
+        realSrcSpanStart, realSrcSpanEnd,
+        srcSpanFileName_maybe,
+        pprUserRealSpan,
+
+        -- ** Unsafely deconstructing SrcSpan
+        -- These are dubious exports, because they crash on some inputs
+        srcSpanFile,
+        srcSpanStartLine, srcSpanEndLine,
+        srcSpanStartCol, srcSpanEndCol,
+
+        -- ** Predicates on SrcSpan
+        isGoodSrcSpan, isOneLineSpan,
+        containsSpan,
+
+        -- * StringBuffer locations
+        BufPos(..),
+        BufSpan(..),
+
+        -- * Located
+        Located,
+        RealLocated,
+        GenLocated(..),
+
+        -- ** Constructing Located
+        noLoc,
+        mkGeneralLocated,
+
+        -- ** Deconstructing Located
+        getLoc, unLoc,
+        unRealSrcSpan, getRealSrcSpan,
+
+        -- ** Modifying Located
+        mapLoc,
+
+        -- ** Combining and comparing Located values
+        eqLocated, cmpLocated, combineLocs, addCLoc,
+        leftmost_smallest, leftmost_largest, rightmost_smallest,
+        spans, isSubspanOf, isRealSubspanOf, sortLocated,
+        sortRealLocated,
+        lookupSrcLoc, lookupSrcSpan,
+
+        liftL,
+
+        -- * Parser locations
+        PsLoc(..),
+        PsSpan(..),
+        PsLocated,
+        advancePsLoc,
+        mkPsSpan,
+        psSpanStart,
+        psSpanEnd,
+        mkSrcSpanPs,
+
+    ) where
+
+import GhcPrelude
+
+import Util
+import Json
+import Outputable
+import FastString
+
+import Control.DeepSeq
+import Control.Applicative (liftA2)
+import Data.Bits
+import Data.Data
+import Data.List (sortBy, intercalate)
+import Data.Function (on)
+import qualified Data.Map as Map
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcLoc-SrcLocations]{Source-location information}
+*                                                                      *
+************************************************************************
+
+We keep information about the {\em definition} point for each entity;
+this is the obvious stuff:
+-}
+
+-- | Real Source Location
+--
+-- Represents a single point within a file
+data RealSrcLoc
+  = SrcLoc      FastString              -- A precise location (file name)
+                {-# UNPACK #-} !Int     -- line number, begins at 1
+                {-# UNPACK #-} !Int     -- column number, begins at 1
+  deriving (Eq, Ord)
+
+-- | 0-based index identifying the raw location in the StringBuffer.
+--
+-- Unlike 'RealSrcLoc', it is not affected by #line and {-# LINE ... #-}
+-- pragmas. In particular, notice how 'setSrcLoc' and 'resetAlrLastLoc' in
+-- Lexer.x update 'PsLoc' preserving 'BufPos'.
+--
+-- The parser guarantees that 'BufPos' are monotonic. See #17632.
+newtype BufPos = BufPos { bufPos :: Int }
+  deriving (Eq, Ord, Show)
+
+-- | Source Location
+data SrcLoc
+  = RealSrcLoc !RealSrcLoc !(Maybe BufPos)  -- See Note [Why Maybe BufPos]
+  | UnhelpfulLoc FastString     -- Just a general indication
+  deriving (Eq, Show)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcLoc-access-fns]{Access functions}
+*                                                                      *
+************************************************************************
+-}
+
+mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
+mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col) Nothing
+
+mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
+mkRealSrcLoc x line col = SrcLoc x line col
+
+-- | Built-in "bad" 'SrcLoc' values for particular locations
+noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
+noSrcLoc          = UnhelpfulLoc (fsLit "<no location info>")
+generatedSrcLoc   = UnhelpfulLoc (fsLit "<compiler-generated code>")
+interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive>")
+
+-- | Creates a "bad" 'SrcLoc' that has no detailed information about its location
+mkGeneralSrcLoc :: FastString -> SrcLoc
+mkGeneralSrcLoc = UnhelpfulLoc
+
+-- | Gives the filename of the 'RealSrcLoc'
+srcLocFile :: RealSrcLoc -> FastString
+srcLocFile (SrcLoc fname _ _) = fname
+
+-- | Raises an error when used on a "bad" 'SrcLoc'
+srcLocLine :: RealSrcLoc -> Int
+srcLocLine (SrcLoc _ l _) = l
+
+-- | Raises an error when used on a "bad" 'SrcLoc'
+srcLocCol :: RealSrcLoc -> Int
+srcLocCol (SrcLoc _ _ c) = c
+
+-- | Move the 'SrcLoc' down by one line if the character is a newline,
+-- to the next 8-char tabstop if it is a tab, and across by one
+-- character in any other case
+advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
+advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1
+advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (advance_tabstop c)
+advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
+
+advance_tabstop :: Int -> Int
+advance_tabstop c = ((((c - 1) `shiftR` 3) + 1) `shiftL` 3) + 1
+
+advanceBufPos :: BufPos -> BufPos
+advanceBufPos (BufPos i) = BufPos (i+1)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcLoc-instances]{Instance declarations for various names}
+*                                                                      *
+************************************************************************
+-}
+
+sortLocated :: [Located a] -> [Located a]
+sortLocated = sortBy (leftmost_smallest `on` getLoc)
+
+sortRealLocated :: [RealLocated a] -> [RealLocated a]
+sortRealLocated = sortBy (compare `on` getLoc)
+
+lookupSrcLoc :: SrcLoc -> Map.Map RealSrcLoc a -> Maybe a
+lookupSrcLoc (RealSrcLoc l _) = Map.lookup l
+lookupSrcLoc (UnhelpfulLoc _) = const Nothing
+
+lookupSrcSpan :: SrcSpan -> Map.Map RealSrcSpan a -> Maybe a
+lookupSrcSpan (RealSrcSpan l _) = Map.lookup l
+lookupSrcSpan (UnhelpfulSpan _) = const Nothing
+
+instance Outputable RealSrcLoc where
+    ppr (SrcLoc src_path src_line src_col)
+      = hcat [ pprFastFilePath src_path <> colon
+             , int src_line <> colon
+             , int src_col ]
+
+-- I don't know why there is this style-based difference
+--        if userStyle sty || debugStyle sty then
+--            hcat [ pprFastFilePath src_path, char ':',
+--                   int src_line,
+--                   char ':', int src_col
+--                 ]
+--        else
+--            hcat [text "{-# LINE ", int src_line, space,
+--                  char '\"', pprFastFilePath src_path, text " #-}"]
+
+instance Outputable SrcLoc where
+    ppr (RealSrcLoc l _) = ppr l
+    ppr (UnhelpfulLoc s)  = ftext s
+
+instance Data RealSrcSpan where
+  -- don't traverse?
+  toConstr _   = abstractConstr "RealSrcSpan"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "RealSrcSpan"
+
+instance Data SrcSpan where
+  -- don't traverse?
+  toConstr _   = abstractConstr "SrcSpan"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "SrcSpan"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcSpan]{Source Spans}
+*                                                                      *
+************************************************************************
+-}
+
+{- |
+A 'RealSrcSpan' delimits a portion of a text file.  It could be represented
+by a pair of (line,column) coordinates, but in fact we optimise
+slightly by using more compact representations for single-line and
+zero-length spans, both of which are quite common.
+
+The end position is defined to be the column /after/ the end of the
+span.  That is, a span of (1,1)-(1,2) is one character long, and a
+span of (1,1)-(1,1) is zero characters long.
+-}
+
+-- | Real Source Span
+data RealSrcSpan
+  = RealSrcSpan'
+        { srcSpanFile     :: !FastString,
+          srcSpanSLine    :: {-# UNPACK #-} !Int,
+          srcSpanSCol     :: {-# UNPACK #-} !Int,
+          srcSpanELine    :: {-# UNPACK #-} !Int,
+          srcSpanECol     :: {-# UNPACK #-} !Int
+        }
+  deriving Eq
+
+-- | StringBuffer Source Span
+data BufSpan =
+  BufSpan { bufSpanStart, bufSpanEnd :: {-# UNPACK #-} !BufPos }
+  deriving (Eq, Ord, Show)
+
+-- | Source Span
+--
+-- A 'SrcSpan' identifies either a specific portion of a text file
+-- or a human-readable description of a location.
+data SrcSpan =
+    RealSrcSpan !RealSrcSpan !(Maybe BufSpan)  -- See Note [Why Maybe BufPos]
+  | UnhelpfulSpan !FastString   -- Just a general indication
+                                -- also used to indicate an empty span
+
+  deriving (Eq, Show) -- Show is used by Lexer.x, because we
+                      -- derive Show for Token
+
+{- Note [Why Maybe BufPos]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+In SrcLoc we store (Maybe BufPos); in SrcSpan we store (Maybe BufSpan).
+Why the Maybe?
+
+Surely, the lexer can always fill in the buffer position, and it guarantees to do so.
+However, sometimes the SrcLoc/SrcSpan is constructed in a different context
+where the buffer location is not available, and then we use Nothing instead of
+a fake value like BufPos (-1).
+
+Perhaps the compiler could be re-engineered to pass around BufPos more
+carefully and never discard it, and this 'Maybe' could be removed. If you're
+interested in doing so, you may find this ripgrep query useful:
+
+  rg "RealSrc(Loc|Span).*?Nothing"
+
+For example, it is not uncommon to whip up source locations for e.g. error
+messages, constructing a SrcSpan without a BufSpan.
+-}
+
+instance ToJson SrcSpan where
+  json (UnhelpfulSpan {} ) = JSNull --JSObject [( "type", "unhelpful")]
+  json (RealSrcSpan rss _) = json rss
+
+instance ToJson RealSrcSpan where
+  json (RealSrcSpan'{..}) = JSObject [ ("file", JSString (unpackFS srcSpanFile))
+                                     , ("startLine", JSInt srcSpanSLine)
+                                     , ("startCol", JSInt srcSpanSCol)
+                                     , ("endLine", JSInt srcSpanELine)
+                                     , ("endCol", JSInt srcSpanECol)
+                                     ]
+
+instance NFData SrcSpan where
+  rnf x = x `seq` ()
+
+-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
+noSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
+noSrcSpan          = UnhelpfulSpan (fsLit "<no location info>")
+wiredInSrcSpan     = UnhelpfulSpan (fsLit "<wired into compiler>")
+interactiveSrcSpan = UnhelpfulSpan (fsLit "<interactive>")
+
+-- | Create a "bad" 'SrcSpan' that has not location information
+mkGeneralSrcSpan :: FastString -> SrcSpan
+mkGeneralSrcSpan = UnhelpfulSpan
+
+-- | Create a 'SrcSpan' corresponding to a single point
+srcLocSpan :: SrcLoc -> SrcSpan
+srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
+srcLocSpan (RealSrcLoc l mb) = RealSrcSpan (realSrcLocSpan l) (fmap (\b -> BufSpan b b) mb)
+
+realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
+realSrcLocSpan (SrcLoc file line col) = RealSrcSpan' file line col line col
+
+-- | Create a 'SrcSpan' between two points in a file
+mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
+mkRealSrcSpan loc1 loc2 = RealSrcSpan' file line1 col1 line2 col2
+  where
+        line1 = srcLocLine loc1
+        line2 = srcLocLine loc2
+        col1 = srcLocCol loc1
+        col2 = srcLocCol loc2
+        file = srcLocFile loc1
+
+-- | 'True' if the span is known to straddle only one line.
+isOneLineRealSpan :: RealSrcSpan -> Bool
+isOneLineRealSpan (RealSrcSpan' _ line1 _ line2 _)
+  = line1 == line2
+
+-- | 'True' if the span is a single point
+isPointRealSpan :: RealSrcSpan -> Bool
+isPointRealSpan (RealSrcSpan' _ line1 col1 line2 col2)
+  = line1 == line2 && col1 == col2
+
+-- | Create a 'SrcSpan' between two points in a file
+mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
+mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
+mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
+mkSrcSpan (RealSrcLoc loc1 mbpos1) (RealSrcLoc loc2 mbpos2)
+    = RealSrcSpan (mkRealSrcSpan loc1 loc2) (liftA2 BufSpan mbpos1 mbpos2)
+
+-- | Combines two 'SrcSpan' into one that spans at least all the characters
+-- within both spans. Returns UnhelpfulSpan if the files differ.
+combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
+combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
+combineSrcSpans l (UnhelpfulSpan _) = l
+combineSrcSpans (RealSrcSpan span1 mbspan1) (RealSrcSpan span2 mbspan2)
+  | srcSpanFile span1 == srcSpanFile span2
+      = RealSrcSpan (combineRealSrcSpans span1 span2) (liftA2 combineBufSpans mbspan1 mbspan2)
+  | otherwise = UnhelpfulSpan (fsLit "<combineSrcSpans: files differ>")
+
+-- | Combines two 'SrcSpan' into one that spans at least all the characters
+-- within both spans. Assumes the "file" part is the same in both inputs
+combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
+combineRealSrcSpans span1 span2
+  = RealSrcSpan' file line_start col_start line_end col_end
+  where
+    (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
+                                  (srcSpanStartLine span2, srcSpanStartCol span2)
+    (line_end, col_end)     = max (srcSpanEndLine span1, srcSpanEndCol span1)
+                                  (srcSpanEndLine span2, srcSpanEndCol span2)
+    file = srcSpanFile span1
+
+combineBufSpans :: BufSpan -> BufSpan -> BufSpan
+combineBufSpans span1 span2 = BufSpan start end
+  where
+    start = min (bufSpanStart span1) (bufSpanStart span2)
+    end   = max (bufSpanEnd   span1) (bufSpanEnd   span2)
+
+
+-- | Convert a SrcSpan into one that represents only its first character
+srcSpanFirstCharacter :: SrcSpan -> SrcSpan
+srcSpanFirstCharacter l@(UnhelpfulSpan {}) = l
+srcSpanFirstCharacter (RealSrcSpan span mbspan) =
+    RealSrcSpan (mkRealSrcSpan loc1 loc2) (fmap mkBufSpan mbspan)
+  where
+    loc1@(SrcLoc f l c) = realSrcSpanStart span
+    loc2 = SrcLoc f l (c+1)
+    mkBufSpan bspan =
+      let bpos1@(BufPos i) = bufSpanStart bspan
+          bpos2 = BufPos (i+1)
+      in BufSpan bpos1 bpos2
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcSpan-predicates]{Predicates}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Test if a 'SrcSpan' is "good", i.e. has precise location information
+isGoodSrcSpan :: SrcSpan -> Bool
+isGoodSrcSpan (RealSrcSpan _ _) = True
+isGoodSrcSpan (UnhelpfulSpan _) = False
+
+isOneLineSpan :: SrcSpan -> Bool
+-- ^ True if the span is known to straddle only one line.
+-- For "bad" 'SrcSpan', it returns False
+isOneLineSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s
+isOneLineSpan (UnhelpfulSpan _) = False
+
+-- | Tests whether the first span "contains" the other span, meaning
+-- that it covers at least as much source code. True where spans are equal.
+containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
+containsSpan s1 s2
+  = (srcSpanStartLine s1, srcSpanStartCol s1)
+       <= (srcSpanStartLine s2, srcSpanStartCol s2)
+    && (srcSpanEndLine s1, srcSpanEndCol s1)
+       >= (srcSpanEndLine s2, srcSpanEndCol s2)
+    && (srcSpanFile s1 == srcSpanFile s2)
+    -- We check file equality last because it is (presumably?) least
+    -- likely to fail.
+{-
+%************************************************************************
+%*                                                                      *
+\subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions}
+*                                                                      *
+************************************************************************
+-}
+
+srcSpanStartLine :: RealSrcSpan -> Int
+srcSpanEndLine :: RealSrcSpan -> Int
+srcSpanStartCol :: RealSrcSpan -> Int
+srcSpanEndCol :: RealSrcSpan -> Int
+
+srcSpanStartLine RealSrcSpan'{ srcSpanSLine=l } = l
+srcSpanEndLine RealSrcSpan'{ srcSpanELine=l } = l
+srcSpanStartCol RealSrcSpan'{ srcSpanSCol=l } = l
+srcSpanEndCol RealSrcSpan'{ srcSpanECol=c } = c
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcSpan-access-fns]{Access functions}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
+srcSpanStart :: SrcSpan -> SrcLoc
+srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
+srcSpanStart (RealSrcSpan s b) = RealSrcLoc (realSrcSpanStart s) (fmap bufSpanStart b)
+
+-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable
+srcSpanEnd :: SrcSpan -> SrcLoc
+srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
+srcSpanEnd (RealSrcSpan s b) = RealSrcLoc (realSrcSpanEnd s) (fmap bufSpanEnd b)
+
+realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
+realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
+                                  (srcSpanStartLine s)
+                                  (srcSpanStartCol s)
+
+realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
+realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
+                                (srcSpanEndLine s)
+                                (srcSpanEndCol s)
+
+-- | Obtains the filename for a 'SrcSpan' if it is "good"
+srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
+srcSpanFileName_maybe (RealSrcSpan s _) = Just (srcSpanFile s)
+srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[SrcSpan-instances]{Instances}
+*                                                                      *
+************************************************************************
+-}
+
+-- We want to order RealSrcSpans first by the start point, then by the
+-- end point.
+instance Ord RealSrcSpan where
+  a `compare` b =
+     (realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`
+     (realSrcSpanEnd   a `compare` realSrcSpanEnd   b)
+
+instance Show RealSrcLoc where
+  show (SrcLoc filename row col)
+      = "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col
+
+-- Show is used by Lexer.x, because we derive Show for Token
+instance Show RealSrcSpan where
+  show span@(RealSrcSpan' file sl sc el ec)
+    | isPointRealSpan span
+    = "SrcSpanPoint " ++ show file ++ " " ++ intercalate " " (map show [sl,sc])
+
+    | isOneLineRealSpan span
+    = "SrcSpanOneLine " ++ show file ++ " "
+                        ++ intercalate " " (map show [sl,sc,ec])
+
+    | otherwise
+    = "SrcSpanMultiLine " ++ show file ++ " "
+                          ++ intercalate " " (map show [sl,sc,el,ec])
+
+
+instance Outputable RealSrcSpan where
+    ppr span = pprUserRealSpan True span
+
+-- I don't know why there is this style-based difference
+--      = getPprStyle $ \ sty ->
+--        if userStyle sty || debugStyle sty then
+--           text (showUserRealSpan True span)
+--        else
+--           hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
+--                 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
+
+instance Outputable SrcSpan where
+    ppr span = pprUserSpan True span
+
+-- I don't know why there is this style-based difference
+--      = getPprStyle $ \ sty ->
+--        if userStyle sty || debugStyle sty then
+--           pprUserSpan True span
+--        else
+--           case span of
+--           UnhelpfulSpan _ -> panic "Outputable UnhelpfulSpan"
+--           RealSrcSpan s -> ppr s
+
+pprUserSpan :: Bool -> SrcSpan -> SDoc
+pprUserSpan _         (UnhelpfulSpan s) = ftext s
+pprUserSpan show_path (RealSrcSpan s _) = pprUserRealSpan show_path s
+
+pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
+pprUserRealSpan show_path span@(RealSrcSpan' src_path line col _ _)
+  | isPointRealSpan span
+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
+         , int line <> colon
+         , int col ]
+
+pprUserRealSpan show_path span@(RealSrcSpan' src_path line scol _ ecol)
+  | isOneLineRealSpan span
+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
+         , int line <> colon
+         , int scol
+         , ppUnless (ecol - scol <= 1) (char '-' <> int (ecol - 1)) ]
+            -- For single-character or point spans, we just
+            -- output the starting column number
+
+pprUserRealSpan show_path (RealSrcSpan' src_path sline scol eline ecol)
+  = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
+         , parens (int sline <> comma <> int scol)
+         , char '-'
+         , parens (int eline <> comma <> int ecol') ]
+ where
+   ecol' = if ecol == 0 then ecol else ecol - 1
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Located]{Attaching SrcSpans to things}
+*                                                                      *
+************************************************************************
+-}
+
+-- | We attach SrcSpans to lots of things, so let's have a datatype for it.
+data GenLocated l e = L l e
+  deriving (Eq, Ord, Data, Functor, Foldable, Traversable)
+
+type Located = GenLocated SrcSpan
+type RealLocated = GenLocated RealSrcSpan
+
+mapLoc :: (a -> b) -> GenLocated l a -> GenLocated l b
+mapLoc = fmap
+
+unLoc :: GenLocated l e -> e
+unLoc (L _ e) = e
+
+getLoc :: GenLocated l e -> l
+getLoc (L l _) = l
+
+noLoc :: e -> Located e
+noLoc e = L noSrcSpan e
+
+mkGeneralLocated :: String -> e -> Located e
+mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e
+
+combineLocs :: Located a -> Located b -> SrcSpan
+combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
+
+-- | Combine locations from two 'Located' things and add them to a third thing
+addCLoc :: Located a -> Located b -> c -> Located c
+addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
+
+-- not clear whether to add a general Eq instance, but this is useful sometimes:
+
+-- | Tests whether the two located things are equal
+eqLocated :: Eq a => GenLocated l a -> GenLocated l a -> Bool
+eqLocated a b = unLoc a == unLoc b
+
+-- not clear whether to add a general Ord instance, but this is useful sometimes:
+
+-- | Tests the ordering of the two located things
+cmpLocated :: Ord a => GenLocated l a -> GenLocated l a -> Ordering
+cmpLocated a b = unLoc a `compare` unLoc b
+
+instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
+  ppr (L l e) = -- TODO: We can't do this since Located was refactored into
+                -- GenLocated:
+                -- Print spans without the file name etc
+                -- ifPprDebug (braces (pprUserSpan False l))
+                whenPprDebug (braces (ppr l))
+             $$ ppr e
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Ordering SrcSpans for InteractiveUI}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Strategies for ordering 'SrcSpan's
+leftmost_smallest, leftmost_largest, rightmost_smallest :: SrcSpan -> SrcSpan -> Ordering
+rightmost_smallest = compareSrcSpanBy (flip compare)
+leftmost_smallest = compareSrcSpanBy compare
+leftmost_largest = compareSrcSpanBy $ \a b ->
+  (realSrcSpanStart a `compare` realSrcSpanStart b)
+    `thenCmp`
+  (realSrcSpanEnd b `compare` realSrcSpanEnd a)
+
+compareSrcSpanBy :: (RealSrcSpan -> RealSrcSpan -> Ordering) -> SrcSpan -> SrcSpan -> Ordering
+compareSrcSpanBy cmp (RealSrcSpan a _) (RealSrcSpan b _) = cmp a b
+compareSrcSpanBy _   (RealSrcSpan _ _) (UnhelpfulSpan _) = LT
+compareSrcSpanBy _   (UnhelpfulSpan _) (RealSrcSpan _ _) = GT
+compareSrcSpanBy _   (UnhelpfulSpan _) (UnhelpfulSpan _) = EQ
+
+-- | Determines whether a span encloses a given line and column index
+spans :: SrcSpan -> (Int, Int) -> Bool
+spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
+spans (RealSrcSpan span _) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
+   where loc = mkRealSrcLoc (srcSpanFile span) l c
+
+-- | Determines whether a span is enclosed by another one
+isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other
+            -> SrcSpan -- ^ The span it may be enclosed by
+            -> Bool
+isSubspanOf (RealSrcSpan src _) (RealSrcSpan parent _) = isRealSubspanOf src parent
+isSubspanOf _ _ = False
+
+-- | Determines whether a span is enclosed by another one
+isRealSubspanOf :: RealSrcSpan -- ^ The span that may be enclosed by the other
+                -> RealSrcSpan -- ^ The span it may be enclosed by
+                -> Bool
+isRealSubspanOf src parent
+    | srcSpanFile parent /= srcSpanFile src = False
+    | otherwise = realSrcSpanStart parent <= realSrcSpanStart src &&
+                  realSrcSpanEnd parent   >= realSrcSpanEnd src
+
+liftL :: Monad m => (a -> m b) -> GenLocated l a -> m (GenLocated l b)
+liftL f (L loc a) = do
+  a' <- f a
+  return $ L loc a'
+
+getRealSrcSpan :: RealLocated a -> RealSrcSpan
+getRealSrcSpan (L l _) = l
+
+unRealSrcSpan :: RealLocated a -> a
+unRealSrcSpan  (L _ e) = e
+
+
+-- | A location as produced by the parser. Consists of two components:
+--
+-- * The location in the file, adjusted for #line and {-# LINE ... #-} pragmas (RealSrcLoc)
+-- * The location in the string buffer (BufPos) with monotonicity guarantees (see #17632)
+data PsLoc
+  = PsLoc { psRealLoc :: !RealSrcLoc, psBufPos :: !BufPos }
+  deriving (Eq, Ord, Show)
+
+data PsSpan
+  = PsSpan { psRealSpan :: !RealSrcSpan, psBufSpan :: !BufSpan }
+  deriving (Eq, Ord, Show)
+
+type PsLocated = GenLocated PsSpan
+
+advancePsLoc :: PsLoc -> Char -> PsLoc
+advancePsLoc (PsLoc real_loc buf_loc) c =
+  PsLoc (advanceSrcLoc real_loc c) (advanceBufPos buf_loc)
+
+mkPsSpan :: PsLoc -> PsLoc -> PsSpan
+mkPsSpan (PsLoc r1 b1) (PsLoc r2 b2) = PsSpan (mkRealSrcSpan r1 r2) (BufSpan b1 b2)
+
+psSpanStart :: PsSpan -> PsLoc
+psSpanStart (PsSpan r b) = PsLoc (realSrcSpanStart r) (bufSpanStart b)
+
+psSpanEnd :: PsSpan -> PsLoc
+psSpanEnd (PsSpan r b) = PsLoc (realSrcSpanEnd r) (bufSpanEnd b)
+
+mkSrcSpanPs :: PsSpan -> SrcSpan
+mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Just b)
diff --git a/compiler/GHC/Types/Unique.hs b/compiler/GHC/Types/Unique.hs
new file mode 100644
index 0000000000..d031f70072
--- /dev/null
+++ b/compiler/GHC/Types/Unique.hs
@@ -0,0 +1,448 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+
+@Uniques@ are used to distinguish entities in the compiler (@Ids@,
+@Classes@, etc.) from each other.  Thus, @Uniques@ are the basic
+comparison key in the compiler.
+
+If there is any single operation that needs to be fast, it is @Unique@
+
+comparison.  Unsurprisingly, there is quite a bit of huff-and-puff
+directed to that end.
+
+Some of the other hair in this code is to be able to use a
+``splittable @UniqueSupply@'' if requested/possible (not standard
+Haskell).
+-}
+
+{-# LANGUAGE CPP, BangPatterns, MagicHash #-}
+
+module GHC.Types.Unique (
+        -- * Main data types
+        Unique, Uniquable(..),
+        uNIQUE_BITS,
+
+        -- ** Constructors, destructors and operations on 'Unique's
+        hasKey,
+
+        pprUniqueAlways,
+
+        mkUniqueGrimily,
+        getKey,
+        mkUnique, unpkUnique,
+        eqUnique, ltUnique,
+        incrUnique,
+
+        newTagUnique,
+        initTyVarUnique,
+        initExitJoinUnique,
+        nonDetCmpUnique,
+        isValidKnownKeyUnique,
+
+        -- ** Making built-in uniques
+
+        -- now all the built-in GHC.Types.Uniques (and functions to make them)
+        -- [the Oh-So-Wonderful Haskell module system wins again...]
+        mkAlphaTyVarUnique,
+        mkPrimOpIdUnique, mkPrimOpWrapperUnique,
+        mkPreludeMiscIdUnique, mkPreludeDataConUnique,
+        mkPreludeTyConUnique, mkPreludeClassUnique,
+        mkCoVarUnique,
+
+        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
+        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
+        mkCostCentreUnique,
+
+        mkBuiltinUnique,
+        mkPseudoUniqueD,
+        mkPseudoUniqueE,
+        mkPseudoUniqueH,
+
+        -- ** Deriving uniques
+        -- *** From TyCon name uniques
+        tyConRepNameUnique,
+        -- *** From DataCon name uniques
+        dataConWorkerUnique, dataConTyRepNameUnique,
+
+        -- ** Local uniques
+        -- | These are exposed exclusively for use by 'VarEnv.uniqAway', which
+        -- has rather peculiar needs. See Note [Local uniques].
+        mkLocalUnique, minLocalUnique, maxLocalUnique
+    ) where
+
+#include "HsVersions.h"
+#include "Unique.h"
+
+import GhcPrelude
+
+import GHC.Types.Basic
+import FastString
+import Outputable
+import Util
+
+-- just for implementing a fast [0,61) -> Char function
+import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
+
+import Data.Char        ( chr, ord )
+import Data.Bits
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Unique-type]{@Unique@ type and operations}
+*                                                                      *
+************************************************************************
+
+The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
+Fast comparison is everything on @Uniques@:
+-}
+
+-- | Unique identifier.
+--
+-- The type of unique identifiers that are used in many places in GHC
+-- for fast ordering and equality tests. You should generate these with
+-- the functions from the 'UniqSupply' module
+--
+-- These are sometimes also referred to as \"keys\" in comments in GHC.
+newtype Unique = MkUnique Int
+
+{-# INLINE uNIQUE_BITS #-}
+uNIQUE_BITS :: Int
+uNIQUE_BITS = finiteBitSize (0 :: Int) - UNIQUE_TAG_BITS
+
+{-
+Now come the functions which construct uniques from their pieces, and vice versa.
+The stuff about unique *supplies* is handled further down this module.
+-}
+
+unpkUnique      :: Unique -> (Char, Int)        -- The reverse
+
+mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
+getKey          :: Unique -> Int                -- for Var
+
+incrUnique   :: Unique -> Unique
+stepUnique   :: Unique -> Int -> Unique
+newTagUnique :: Unique -> Char -> Unique
+
+mkUniqueGrimily = MkUnique
+
+{-# INLINE getKey #-}
+getKey (MkUnique x) = x
+
+incrUnique (MkUnique i) = MkUnique (i + 1)
+stepUnique (MkUnique i) n = MkUnique (i + n)
+
+mkLocalUnique :: Int -> Unique
+mkLocalUnique i = mkUnique 'X' i
+
+minLocalUnique :: Unique
+minLocalUnique = mkLocalUnique 0
+
+maxLocalUnique :: Unique
+maxLocalUnique = mkLocalUnique uniqueMask
+
+-- newTagUnique changes the "domain" of a unique to a different char
+newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
+
+-- | How many bits are devoted to the unique index (as opposed to the class
+-- character).
+uniqueMask :: Int
+uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1
+
+-- pop the Char in the top 8 bits of the Unique(Supply)
+
+-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
+
+-- and as long as the Char fits in 8 bits, which we assume anyway!
+
+mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces
+-- NOT EXPORTED, so that we can see all the Chars that
+--               are used in this one module
+mkUnique c i
+  = MkUnique (tag .|. bits)
+  where
+    tag  = ord c `shiftL` uNIQUE_BITS
+    bits = i .&. uniqueMask
+
+unpkUnique (MkUnique u)
+  = let
+        -- as long as the Char may have its eighth bit set, we
+        -- really do need the logical right-shift here!
+        tag = chr (u `shiftR` uNIQUE_BITS)
+        i   = u .&. uniqueMask
+    in
+    (tag, i)
+
+-- | The interface file symbol-table encoding assumes that known-key uniques fit
+-- in 30-bits; verify this.
+--
+-- See Note [Symbol table representation of names] in GHC.Iface.Binary for details.
+isValidKnownKeyUnique :: Unique -> Bool
+isValidKnownKeyUnique u =
+    case unpkUnique u of
+      (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Uniquable-class]{The @Uniquable@ class}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Class of things that we can obtain a 'Unique' from
+class Uniquable a where
+    getUnique :: a -> Unique
+
+hasKey          :: Uniquable a => a -> Unique -> Bool
+x `hasKey` k    = getUnique x == k
+
+instance Uniquable FastString where
+ getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
+
+instance Uniquable Int where
+ getUnique i = mkUniqueGrimily i
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Unique-instances]{Instance declarations for @Unique@}
+*                                                                      *
+************************************************************************
+
+And the whole point (besides uniqueness) is fast equality.  We don't
+use `deriving' because we want {\em precise} control of ordering
+(equality on @Uniques@ is v common).
+-}
+
+-- Note [Unique Determinism]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The order of allocated @Uniques@ is not stable across rebuilds.
+-- The main reason for that is that typechecking interface files pulls
+-- @Uniques@ from @UniqSupply@ and the interface file for the module being
+-- currently compiled can, but doesn't have to exist.
+--
+-- It gets more complicated if you take into account that the interface
+-- files are loaded lazily and that building multiple files at once has to
+-- work for any subset of interface files present. When you add parallelism
+-- this makes @Uniques@ hopelessly random.
+--
+-- As such, to get deterministic builds, the order of the allocated
+-- @Uniques@ should not affect the final result.
+-- see also wiki/deterministic-builds
+--
+-- Note [Unique Determinism and code generation]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- The goal of the deterministic builds (wiki/deterministic-builds, #4012)
+-- is to get ABI compatible binaries given the same inputs and environment.
+-- The motivation behind that is that if the ABI doesn't change the
+-- binaries can be safely reused.
+-- Note that this is weaker than bit-for-bit identical binaries and getting
+-- bit-for-bit identical binaries is not a goal for now.
+-- This means that we don't care about nondeterminism that happens after
+-- the interface files are created, in particular we don't care about
+-- register allocation and code generation.
+-- To track progress on bit-for-bit determinism see #12262.
+
+eqUnique :: Unique -> Unique -> Bool
+eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
+
+ltUnique :: Unique -> Unique -> Bool
+ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2
+
+-- Provided here to make it explicit at the call-site that it can
+-- introduce non-determinism.
+-- See Note [Unique Determinism]
+-- See Note [No Ord for Unique]
+nonDetCmpUnique :: Unique -> Unique -> Ordering
+nonDetCmpUnique (MkUnique u1) (MkUnique u2)
+  = if u1 == u2 then EQ else if u1 < u2 then LT else GT
+
+{-
+Note [No Ord for Unique]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+As explained in Note [Unique Determinism] the relative order of Uniques
+is nondeterministic. To prevent from accidental use the Ord Unique
+instance has been removed.
+This makes it easier to maintain deterministic builds, but comes with some
+drawbacks.
+The biggest drawback is that Maps keyed by Uniques can't directly be used.
+The alternatives are:
+
+  1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which
+  2) Create a newtype wrapper based on Unique ordering where nondeterminism
+     is controlled. See Module.ModuleEnv
+  3) Change the algorithm to use nonDetCmpUnique and document why it's still
+     deterministic
+  4) Use TrieMap as done in GHC.Cmm.CommonBlockElim.groupByLabel
+-}
+
+instance Eq Unique where
+    a == b = eqUnique a b
+    a /= b = not (eqUnique a b)
+
+instance Uniquable Unique where
+    getUnique u = u
+
+-- We do sometimes make strings with @Uniques@ in them:
+
+showUnique :: Unique -> String
+showUnique uniq
+  = case unpkUnique uniq of
+      (tag, u) -> finish_show tag u (iToBase62 u)
+
+finish_show :: Char -> Int -> String -> String
+finish_show 't' u _pp_u | u < 26
+  = -- Special case to make v common tyvars, t1, t2, ...
+    -- come out as a, b, ... (shorter, easier to read)
+    [chr (ord 'a' + u)]
+finish_show tag _ pp_u = tag : pp_u
+
+pprUniqueAlways :: Unique -> SDoc
+-- The "always" means regardless of -dsuppress-uniques
+-- It replaces the old pprUnique to remind callers that
+-- they should consider whether they want to consult
+-- Opt_SuppressUniques
+pprUniqueAlways u
+  = text (showUnique u)
+
+instance Outputable Unique where
+    ppr = pprUniqueAlways
+
+instance Show Unique where
+    show uniq = showUnique uniq
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Utils-base62]{Base-62 numbers}
+*                                                                      *
+************************************************************************
+
+A character-stingy way to read/write numbers (notably Uniques).
+The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
+Code stolen from Lennart.
+-}
+
+iToBase62 :: Int -> String
+iToBase62 n_
+  = ASSERT(n_ >= 0) go n_ ""
+  where
+    go n cs | n < 62
+            = let !c = chooseChar62 n in c : cs
+            | otherwise
+            = go q (c : cs) where (!q, r) = quotRem n 62
+                                  !c = chooseChar62 r
+
+    chooseChar62 :: Int -> Char
+    {-# INLINE chooseChar62 #-}
+    chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
+    chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
+
+{-
+************************************************************************
+*                                                                      *
+\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
+*                                                                      *
+************************************************************************
+
+Allocation of unique supply characters:
+        v,t,u : for renumbering value-, type- and usage- vars.
+        B:   builtin
+        C-E: pseudo uniques     (used in native-code generator)
+        X:   uniques from mkLocalUnique
+        _:   unifiable tyvars   (above)
+        0-9: prelude things below
+             (no numbers left any more..)
+        ::   (prelude) parallel array data constructors
+
+        other a-z: lower case chars for unique supplies.  Used so far:
+
+        d       desugarer
+        f       AbsC flattener
+        g       SimplStg
+        k       constraint tuple tycons
+        m       constraint tuple datacons
+        n       Native codegen
+        r       Hsc name cache
+        s       simplifier
+        z       anonymous sums
+-}
+
+mkAlphaTyVarUnique     :: Int -> Unique
+mkPreludeClassUnique   :: Int -> Unique
+mkPreludeTyConUnique   :: Int -> Unique
+mkPreludeDataConUnique :: Arity -> Unique
+mkPrimOpIdUnique       :: Int -> Unique
+-- See Note [Primop wrappers] in PrimOp.hs.
+mkPrimOpWrapperUnique  :: Int -> Unique
+mkPreludeMiscIdUnique  :: Int -> Unique
+mkCoVarUnique          :: Int -> Unique
+
+mkAlphaTyVarUnique   i = mkUnique '1' i
+mkCoVarUnique        i = mkUnique 'g' i
+mkPreludeClassUnique i = mkUnique '2' i
+
+--------------------------------------------------
+-- Wired-in type constructor keys occupy *two* slots:
+--    * u: the TyCon itself
+--    * u+1: the TyConRepName of the TyCon
+mkPreludeTyConUnique i                = mkUnique '3' (2*i)
+
+tyConRepNameUnique :: Unique -> Unique
+tyConRepNameUnique  u = incrUnique u
+
+--------------------------------------------------
+-- Wired-in data constructor keys occupy *three* slots:
+--    * u: the DataCon itself
+--    * u+1: its worker Id
+--    * u+2: the TyConRepName of the promoted TyCon
+-- Prelude data constructors are too simple to need wrappers.
+
+mkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic
+
+--------------------------------------------------
+dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique
+dataConWorkerUnique  u = incrUnique u
+dataConTyRepNameUnique u = stepUnique u 2
+
+--------------------------------------------------
+mkPrimOpIdUnique op         = mkUnique '9' (2*op)
+mkPrimOpWrapperUnique op    = mkUnique '9' (2*op+1)
+mkPreludeMiscIdUnique  i    = mkUnique '0' i
+
+-- The "tyvar uniques" print specially nicely: a, b, c, etc.
+-- See pprUnique for details
+
+initTyVarUnique :: Unique
+initTyVarUnique = mkUnique 't' 0
+
+mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
+   mkBuiltinUnique :: Int -> Unique
+
+mkBuiltinUnique i = mkUnique 'B' i
+mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
+mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
+mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
+
+mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
+mkRegSingleUnique = mkUnique 'R'
+mkRegSubUnique    = mkUnique 'S'
+mkRegPairUnique   = mkUnique 'P'
+mkRegClassUnique  = mkUnique 'L'
+
+mkCostCentreUnique :: Int -> Unique
+mkCostCentreUnique = mkUnique 'C'
+
+mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
+-- See Note [The Unique of an OccName] in GHC.Types.Name.Occurrence
+mkVarOccUnique  fs = mkUnique 'i' (uniqueOfFS fs)
+mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)
+mkTvOccUnique   fs = mkUnique 'v' (uniqueOfFS fs)
+mkTcOccUnique   fs = mkUnique 'c' (uniqueOfFS fs)
+
+initExitJoinUnique :: Unique
+initExitJoinUnique = mkUnique 's' 0
+
diff --git a/compiler/GHC/Types/Unique/DFM.hs b/compiler/GHC/Types/Unique/DFM.hs
new file mode 100644
index 0000000000..21e2f8249b
--- /dev/null
+++ b/compiler/GHC/Types/Unique/DFM.hs
@@ -0,0 +1,420 @@
+{-
+(c) Bartosz Nitka, Facebook, 2015
+
+UniqDFM: Specialised deterministic finite maps, for things with @Uniques@.
+
+Basically, the things need to be in class @Uniquable@, and we use the
+@getUnique@ method to grab their @Uniques@.
+
+This is very similar to @UniqFM@, the major difference being that the order of
+folding is not dependent on @Unique@ ordering, giving determinism.
+Currently the ordering is determined by insertion order.
+
+See Note [Unique Determinism] in GHC.Types.Unique for explanation why @Unique@ ordering
+is not deterministic.
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module GHC.Types.Unique.DFM (
+        -- * Unique-keyed deterministic mappings
+        UniqDFM,       -- abstract type
+
+        -- ** Manipulating those mappings
+        emptyUDFM,
+        unitUDFM,
+        addToUDFM,
+        addToUDFM_C,
+        addListToUDFM,
+        delFromUDFM,
+        delListFromUDFM,
+        adjustUDFM,
+        alterUDFM,
+        mapUDFM,
+        plusUDFM,
+        plusUDFM_C,
+        lookupUDFM, lookupUDFM_Directly,
+        elemUDFM,
+        foldUDFM,
+        eltsUDFM,
+        filterUDFM, filterUDFM_Directly,
+        isNullUDFM,
+        sizeUDFM,
+        intersectUDFM, udfmIntersectUFM,
+        intersectsUDFM,
+        disjointUDFM, disjointUdfmUfm,
+        equalKeysUDFM,
+        minusUDFM,
+        listToUDFM,
+        udfmMinusUFM,
+        partitionUDFM,
+        anyUDFM, allUDFM,
+        pprUniqDFM, pprUDFM,
+
+        udfmToList,
+        udfmToUfm,
+        nonDetFoldUDFM,
+        alwaysUnsafeUfmToUdfm,
+    ) where
+
+import GhcPrelude
+
+import GHC.Types.Unique ( Uniquable(..), Unique, getKey )
+import Outputable
+
+import qualified Data.IntMap as M
+import Data.Data
+import Data.Functor.Classes (Eq1 (..))
+import Data.List (sortBy)
+import Data.Function (on)
+import qualified Data.Semigroup as Semi
+import GHC.Types.Unique.FM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)
+
+-- Note [Deterministic UniqFM]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- A @UniqDFM@ is just like @UniqFM@ with the following additional
+-- property: the function `udfmToList` returns the elements in some
+-- deterministic order not depending on the Unique key for those elements.
+--
+-- If the client of the map performs operations on the map in deterministic
+-- order then `udfmToList` returns them in deterministic order.
+--
+-- There is an implementation cost: each element is given a serial number
+-- as it is added, and `udfmToList` sorts it's result by this serial
+-- number. So you should only use `UniqDFM` if you need the deterministic
+-- property.
+--
+-- `foldUDFM` also preserves determinism.
+--
+-- Normal @UniqFM@ when you turn it into a list will use
+-- Data.IntMap.toList function that returns the elements in the order of
+-- the keys. The keys in @UniqFM@ are always @Uniques@, so you end up with
+-- with a list ordered by @Uniques@.
+-- The order of @Uniques@ is known to be not stable across rebuilds.
+-- See Note [Unique Determinism] in GHC.Types.Unique.
+--
+--
+-- There's more than one way to implement this. The implementation here tags
+-- every value with the insertion time that can later be used to sort the
+-- values when asked to convert to a list.
+--
+-- An alternative would be to have
+--
+--   data UniqDFM ele = UDFM (M.IntMap ele) [ele]
+--
+-- where the list determines the order. This makes deletion tricky as we'd
+-- only accumulate elements in that list, but makes merging easier as you
+-- can just merge both structures independently.
+-- Deletion can probably be done in amortized fashion when the size of the
+-- list is twice the size of the set.
+
+-- | A type of values tagged with insertion time
+data TaggedVal val =
+  TaggedVal
+    val
+    {-# UNPACK #-} !Int -- ^ insertion time
+  deriving (Data, Functor)
+
+taggedFst :: TaggedVal val -> val
+taggedFst (TaggedVal v _) = v
+
+taggedSnd :: TaggedVal val -> Int
+taggedSnd (TaggedVal _ i) = i
+
+instance Eq val => Eq (TaggedVal val) where
+  (TaggedVal v1 _) == (TaggedVal v2 _) = v1 == v2
+
+-- | Type of unique deterministic finite maps
+data UniqDFM ele =
+  UDFM
+    !(M.IntMap (TaggedVal ele)) -- A map where keys are Unique's values and
+                                -- values are tagged with insertion time.
+                                -- The invariant is that all the tags will
+                                -- be distinct within a single map
+    {-# UNPACK #-} !Int         -- Upper bound on the values' insertion
+                                -- time. See Note [Overflow on plusUDFM]
+  deriving (Data, Functor)
+
+-- | Deterministic, in O(n log n).
+instance Foldable UniqDFM where
+  foldr = foldUDFM
+
+-- | Deterministic, in O(n log n).
+instance Traversable UniqDFM where
+  traverse f = fmap listToUDFM_Directly
+             . traverse (\(u,a) -> (u,) <$> f a)
+             . udfmToList
+
+emptyUDFM :: UniqDFM elt
+emptyUDFM = UDFM M.empty 0
+
+unitUDFM :: Uniquable key => key -> elt -> UniqDFM elt
+unitUDFM k v = UDFM (M.singleton (getKey $ getUnique k) (TaggedVal v 0)) 1
+
+-- The new binding always goes to the right of existing ones
+addToUDFM :: Uniquable key => UniqDFM elt -> key -> elt  -> UniqDFM elt
+addToUDFM m k v = addToUDFM_Directly m (getUnique k) v
+
+-- The new binding always goes to the right of existing ones
+addToUDFM_Directly :: UniqDFM elt -> Unique -> elt -> UniqDFM elt
+addToUDFM_Directly (UDFM m i) u v
+  = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
+  where
+    tf (TaggedVal new_v _) (TaggedVal _ old_i) = TaggedVal new_v old_i
+      -- Keep the old tag, but insert the new value
+      -- This means that udfmToList typically returns elements
+      -- in the order of insertion, rather than the reverse
+
+addToUDFM_Directly_C
+  :: (elt -> elt -> elt)   -- old -> new -> result
+  -> UniqDFM elt
+  -> Unique -> elt
+  -> UniqDFM elt
+addToUDFM_Directly_C f (UDFM m i) u v
+  = UDFM (M.insertWith tf (getKey u) (TaggedVal v i) m) (i + 1)
+    where
+      tf (TaggedVal new_v _) (TaggedVal old_v old_i)
+         = TaggedVal (f old_v new_v) old_i
+          -- Flip the arguments, because M.insertWith uses  (new->old->result)
+          --                         but f            needs (old->new->result)
+          -- Like addToUDFM_Directly, keep the old tag
+
+addToUDFM_C
+  :: Uniquable key => (elt -> elt -> elt) -- old -> new -> result
+  -> UniqDFM elt -- old
+  -> key -> elt -- new
+  -> UniqDFM elt -- result
+addToUDFM_C f m k v = addToUDFM_Directly_C f m (getUnique k) v
+
+addListToUDFM :: Uniquable key => UniqDFM elt -> [(key,elt)] -> UniqDFM elt
+addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v)
+
+addListToUDFM_Directly :: UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt
+addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v)
+
+addListToUDFM_Directly_C
+  :: (elt -> elt -> elt) -> UniqDFM elt -> [(Unique,elt)] -> UniqDFM elt
+addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_Directly_C f m k v)
+
+delFromUDFM :: Uniquable key => UniqDFM elt -> key -> UniqDFM elt
+delFromUDFM (UDFM m i) k = UDFM (M.delete (getKey $ getUnique k) m) i
+
+plusUDFM_C :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+plusUDFM_C f udfml@(UDFM _ i) udfmr@(UDFM _ j)
+  -- we will use the upper bound on the tag as a proxy for the set size,
+  -- to insert the smaller one into the bigger one
+  | i > j = insertUDFMIntoLeft_C f udfml udfmr
+  | otherwise = insertUDFMIntoLeft_C f udfmr udfml
+
+-- Note [Overflow on plusUDFM]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- There are multiple ways of implementing plusUDFM.
+-- The main problem that needs to be solved is overlap on times of
+-- insertion between different keys in two maps.
+-- Consider:
+--
+-- A = fromList [(a, (x, 1))]
+-- B = fromList [(b, (y, 1))]
+--
+-- If you merge them naively you end up with:
+--
+-- C = fromList [(a, (x, 1)), (b, (y, 1))]
+--
+-- Which loses information about ordering and brings us back into
+-- non-deterministic world.
+--
+-- The solution I considered before would increment the tags on one of the
+-- sets by the upper bound of the other set. The problem with this approach
+-- is that you'll run out of tags for some merge patterns.
+-- Say you start with A with upper bound 1, you merge A with A to get A' and
+-- the upper bound becomes 2. You merge A' with A' and the upper bound
+-- doubles again. After 64 merges you overflow.
+-- This solution would have the same time complexity as plusUFM, namely O(n+m).
+--
+-- The solution I ended up with has time complexity of
+-- O(m log m + m * min (n+m, W)) where m is the smaller set.
+-- It simply inserts the elements of the smaller set into the larger
+-- set in the order that they were inserted into the smaller set. That's
+-- O(m log m) for extracting the elements from the smaller set in the
+-- insertion order and O(m * min(n+m, W)) to insert them into the bigger
+-- set.
+
+plusUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+plusUDFM udfml@(UDFM _ i) udfmr@(UDFM _ j)
+  -- we will use the upper bound on the tag as a proxy for the set size,
+  -- to insert the smaller one into the bigger one
+  | i > j = insertUDFMIntoLeft udfml udfmr
+  | otherwise = insertUDFMIntoLeft udfmr udfml
+
+insertUDFMIntoLeft :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+insertUDFMIntoLeft udfml udfmr = addListToUDFM_Directly udfml $ udfmToList udfmr
+
+insertUDFMIntoLeft_C
+  :: (elt -> elt -> elt) -> UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+insertUDFMIntoLeft_C f udfml udfmr =
+  addListToUDFM_Directly_C f udfml $ udfmToList udfmr
+
+lookupUDFM :: Uniquable key => UniqDFM elt -> key -> Maybe elt
+lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m
+
+lookupUDFM_Directly :: UniqDFM elt -> Unique -> Maybe elt
+lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m
+
+elemUDFM :: Uniquable key => key -> UniqDFM elt -> Bool
+elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m
+
+-- | Performs a deterministic fold over the UniqDFM.
+-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).
+foldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
+foldUDFM k z m = foldr k z (eltsUDFM m)
+
+-- | Performs a nondeterministic fold over the UniqDFM.
+-- It's O(n), same as the corresponding function on `UniqFM`.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUDFM :: (elt -> a -> a) -> a -> UniqDFM elt -> a
+nonDetFoldUDFM k z (UDFM m _i) = foldr k z $ map taggedFst $ M.elems m
+
+eltsUDFM :: UniqDFM elt -> [elt]
+eltsUDFM (UDFM m _i) =
+  map taggedFst $ sortBy (compare `on` taggedSnd) $ M.elems m
+
+filterUDFM :: (elt -> Bool) -> UniqDFM elt -> UniqDFM elt
+filterUDFM p (UDFM m i) = UDFM (M.filter (\(TaggedVal v _) -> p v) m) i
+
+filterUDFM_Directly :: (Unique -> elt -> Bool) -> UniqDFM elt -> UniqDFM elt
+filterUDFM_Directly p (UDFM m i) = UDFM (M.filterWithKey p' m) i
+  where
+  p' k (TaggedVal v _) = p (getUnique k) v
+
+-- | Converts `UniqDFM` to a list, with elements in deterministic order.
+-- It's O(n log n) while the corresponding function on `UniqFM` is O(n).
+udfmToList :: UniqDFM elt -> [(Unique, elt)]
+udfmToList (UDFM m _i) =
+  [ (getUnique k, taggedFst v)
+  | (k, v) <- sortBy (compare `on` (taggedSnd . snd)) $ M.toList m ]
+
+-- Determines whether two 'UniqDFM's contain the same keys.
+equalKeysUDFM :: UniqDFM a -> UniqDFM b -> Bool
+equalKeysUDFM (UDFM m1 _) (UDFM m2 _) = liftEq (\_ _ -> True) m1 m2
+
+isNullUDFM :: UniqDFM elt -> Bool
+isNullUDFM (UDFM m _) = M.null m
+
+sizeUDFM :: UniqDFM elt -> Int
+sizeUDFM (UDFM m _i) = M.size m
+
+intersectUDFM :: UniqDFM elt -> UniqDFM elt -> UniqDFM elt
+intersectUDFM (UDFM x i) (UDFM y _j) = UDFM (M.intersection x y) i
+  -- M.intersection is left biased, that means the result will only have
+  -- a subset of elements from the left set, so `i` is a good upper bound.
+
+udfmIntersectUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1
+udfmIntersectUFM (UDFM x i) y = UDFM (M.intersection x (ufmToIntMap y)) i
+  -- M.intersection is left biased, that means the result will only have
+  -- a subset of elements from the left set, so `i` is a good upper bound.
+
+intersectsUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
+intersectsUDFM x y = isNullUDFM (x `intersectUDFM` y)
+
+disjointUDFM :: UniqDFM elt -> UniqDFM elt -> Bool
+disjointUDFM (UDFM x _i) (UDFM y _j) = M.null (M.intersection x y)
+
+disjointUdfmUfm :: UniqDFM elt -> UniqFM elt2 -> Bool
+disjointUdfmUfm (UDFM x _i) y = M.null (M.intersection x (ufmToIntMap y))
+
+minusUDFM :: UniqDFM elt1 -> UniqDFM elt2 -> UniqDFM elt1
+minusUDFM (UDFM x i) (UDFM y _j) = UDFM (M.difference x y) i
+  -- M.difference returns a subset of a left set, so `i` is a good upper
+  -- bound.
+
+udfmMinusUFM :: UniqDFM elt1 -> UniqFM elt2 -> UniqDFM elt1
+udfmMinusUFM (UDFM x i) y = UDFM (M.difference x (ufmToIntMap y)) i
+  -- M.difference returns a subset of a left set, so `i` is a good upper
+  -- bound.
+
+-- | Partition UniqDFM into two UniqDFMs according to the predicate
+partitionUDFM :: (elt -> Bool) -> UniqDFM elt -> (UniqDFM elt, UniqDFM elt)
+partitionUDFM p (UDFM m i) =
+  case M.partition (p . taggedFst) m of
+    (left, right) -> (UDFM left i, UDFM right i)
+
+-- | Delete a list of elements from a UniqDFM
+delListFromUDFM  :: Uniquable key => UniqDFM elt -> [key] -> UniqDFM elt
+delListFromUDFM = foldl' delFromUDFM
+
+-- | This allows for lossy conversion from UniqDFM to UniqFM
+udfmToUfm :: UniqDFM elt -> UniqFM elt
+udfmToUfm (UDFM m _i) =
+  listToUFM_Directly [(getUnique k, taggedFst tv) | (k, tv) <- M.toList m]
+
+listToUDFM :: Uniquable key => [(key,elt)] -> UniqDFM elt
+listToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) emptyUDFM
+
+listToUDFM_Directly :: [(Unique, elt)] -> UniqDFM elt
+listToUDFM_Directly = foldl' (\m (u, v) -> addToUDFM_Directly m u v) emptyUDFM
+
+-- | Apply a function to a particular element
+adjustUDFM :: Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt
+adjustUDFM f (UDFM m i) k = UDFM (M.adjust (fmap f) (getKey $ getUnique k) m) i
+
+-- | The expression (alterUDFM f k map) alters value x at k, or absence
+-- thereof. alterUDFM can be used to insert, delete, or update a value in
+-- UniqDFM. Use addToUDFM, delFromUDFM or adjustUDFM when possible, they are
+-- more efficient.
+alterUDFM
+  :: Uniquable key
+  => (Maybe elt -> Maybe elt)  -- How to adjust
+  -> UniqDFM elt               -- old
+  -> key                       -- new
+  -> UniqDFM elt               -- result
+alterUDFM f (UDFM m i) k =
+  UDFM (M.alter alterf (getKey $ getUnique k) m) (i + 1)
+  where
+  alterf Nothing = inject $ f Nothing
+  alterf (Just (TaggedVal v _)) = inject $ f (Just v)
+  inject Nothing = Nothing
+  inject (Just v) = Just $ TaggedVal v i
+
+-- | Map a function over every value in a UniqDFM
+mapUDFM :: (elt1 -> elt2) -> UniqDFM elt1 -> UniqDFM elt2
+mapUDFM f (UDFM m i) = UDFM (M.map (fmap f) m) i
+
+anyUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
+anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m
+
+allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
+allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m
+
+instance Semi.Semigroup (UniqDFM a) where
+  (<>) = plusUDFM
+
+instance Monoid (UniqDFM a) where
+  mempty = emptyUDFM
+  mappend = (Semi.<>)
+
+-- This should not be used in committed code, provided for convenience to
+-- make ad-hoc conversions when developing
+alwaysUnsafeUfmToUdfm :: UniqFM elt -> UniqDFM elt
+alwaysUnsafeUfmToUdfm = listToUDFM_Directly . nonDetUFMToList
+
+-- Output-ery
+
+instance Outputable a => Outputable (UniqDFM a) where
+    ppr ufm = pprUniqDFM ppr ufm
+
+pprUniqDFM :: (a -> SDoc) -> UniqDFM a -> SDoc
+pprUniqDFM ppr_elt ufm
+  = brackets $ fsep $ punctuate comma $
+    [ ppr uq <+> text ":->" <+> ppr_elt elt
+    | (uq, elt) <- udfmToList ufm ]
+
+pprUDFM :: UniqDFM a    -- ^ The things to be pretty printed
+       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc          -- ^ 'SDoc' where the things have been pretty
+                        -- printed
+pprUDFM ufm pp = pp (eltsUDFM ufm)
diff --git a/compiler/GHC/Types/Unique/DSet.hs b/compiler/GHC/Types/Unique/DSet.hs
new file mode 100644
index 0000000000..32d32536df
--- /dev/null
+++ b/compiler/GHC/Types/Unique/DSet.hs
@@ -0,0 +1,141 @@
+-- (c) Bartosz Nitka, Facebook, 2015
+
+-- |
+-- Specialised deterministic sets, for things with @Uniques@
+--
+-- Based on 'UniqDFM's (as you would expect).
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why we need it.
+--
+-- Basically, the things need to be in class 'Uniquable'.
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module GHC.Types.Unique.DSet (
+        -- * Unique set type
+        UniqDSet,    -- type synonym for UniqFM a
+        getUniqDSet,
+        pprUniqDSet,
+
+        -- ** Manipulating these sets
+        delOneFromUniqDSet, delListFromUniqDSet,
+        emptyUniqDSet,
+        unitUniqDSet,
+        mkUniqDSet,
+        addOneToUniqDSet, addListToUniqDSet,
+        unionUniqDSets, unionManyUniqDSets,
+        minusUniqDSet, uniqDSetMinusUniqSet,
+        intersectUniqDSets, uniqDSetIntersectUniqSet,
+        foldUniqDSet,
+        elementOfUniqDSet,
+        filterUniqDSet,
+        sizeUniqDSet,
+        isEmptyUniqDSet,
+        lookupUniqDSet,
+        uniqDSetToList,
+        partitionUniqDSet,
+        mapUniqDSet
+    ) where
+
+import GhcPrelude
+
+import Outputable
+import GHC.Types.Unique.DFM
+import GHC.Types.Unique.Set
+import GHC.Types.Unique
+
+import Data.Coerce
+import Data.Data
+import qualified Data.Semigroup as Semi
+
+-- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here.
+-- Beyond preserving invariants, we may also want to 'override' typeclass
+-- instances.
+
+newtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a}
+                   deriving (Data, Semi.Semigroup, Monoid)
+
+emptyUniqDSet :: UniqDSet a
+emptyUniqDSet = UniqDSet emptyUDFM
+
+unitUniqDSet :: Uniquable a => a -> UniqDSet a
+unitUniqDSet x = UniqDSet (unitUDFM x x)
+
+mkUniqDSet :: Uniquable a => [a] -> UniqDSet a
+mkUniqDSet = foldl' addOneToUniqDSet emptyUniqDSet
+
+-- The new element always goes to the right of existing ones.
+addOneToUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a
+addOneToUniqDSet (UniqDSet set) x = UniqDSet (addToUDFM set x x)
+
+addListToUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a
+addListToUniqDSet = foldl' addOneToUniqDSet
+
+delOneFromUniqDSet :: Uniquable a => UniqDSet a -> a -> UniqDSet a
+delOneFromUniqDSet (UniqDSet s) = UniqDSet . delFromUDFM s
+
+delListFromUniqDSet :: Uniquable a => UniqDSet a -> [a] -> UniqDSet a
+delListFromUniqDSet (UniqDSet s) = UniqDSet . delListFromUDFM s
+
+unionUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a
+unionUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (plusUDFM s t)
+
+unionManyUniqDSets :: [UniqDSet a] -> UniqDSet a
+unionManyUniqDSets [] = emptyUniqDSet
+unionManyUniqDSets sets = foldr1 unionUniqDSets sets
+
+minusUniqDSet :: UniqDSet a -> UniqDSet a -> UniqDSet a
+minusUniqDSet (UniqDSet s) (UniqDSet t) = UniqDSet (minusUDFM s t)
+
+uniqDSetMinusUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
+uniqDSetMinusUniqSet xs ys
+  = UniqDSet (udfmMinusUFM (getUniqDSet xs) (getUniqSet ys))
+
+intersectUniqDSets :: UniqDSet a -> UniqDSet a -> UniqDSet a
+intersectUniqDSets (UniqDSet s) (UniqDSet t) = UniqDSet (intersectUDFM s t)
+
+uniqDSetIntersectUniqSet :: UniqDSet a -> UniqSet b -> UniqDSet a
+uniqDSetIntersectUniqSet xs ys
+  = UniqDSet (udfmIntersectUFM (getUniqDSet xs) (getUniqSet ys))
+
+foldUniqDSet :: (a -> b -> b) -> b -> UniqDSet a -> b
+foldUniqDSet c n (UniqDSet s) = foldUDFM c n s
+
+elementOfUniqDSet :: Uniquable a => a -> UniqDSet a -> Bool
+elementOfUniqDSet k = elemUDFM k . getUniqDSet
+
+filterUniqDSet :: (a -> Bool) -> UniqDSet a -> UniqDSet a
+filterUniqDSet p (UniqDSet s) = UniqDSet (filterUDFM p s)
+
+sizeUniqDSet :: UniqDSet a -> Int
+sizeUniqDSet = sizeUDFM . getUniqDSet
+
+isEmptyUniqDSet :: UniqDSet a -> Bool
+isEmptyUniqDSet = isNullUDFM . getUniqDSet
+
+lookupUniqDSet :: Uniquable a => UniqDSet a -> a -> Maybe a
+lookupUniqDSet = lookupUDFM . getUniqDSet
+
+uniqDSetToList :: UniqDSet a -> [a]
+uniqDSetToList = eltsUDFM . getUniqDSet
+
+partitionUniqDSet :: (a -> Bool) -> UniqDSet a -> (UniqDSet a, UniqDSet a)
+partitionUniqDSet p = coerce . partitionUDFM p . getUniqDSet
+
+-- See Note [UniqSet invariant] in GHC.Types.Unique.Set
+mapUniqDSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b
+mapUniqDSet f = mkUniqDSet . map f . uniqDSetToList
+
+-- Two 'UniqDSet's are considered equal if they contain the same
+-- uniques.
+instance Eq (UniqDSet a) where
+  UniqDSet a == UniqDSet b = equalKeysUDFM a b
+
+getUniqDSet :: UniqDSet a -> UniqDFM a
+getUniqDSet = getUniqDSet'
+
+instance Outputable a => Outputable (UniqDSet a) where
+  ppr = pprUniqDSet ppr
+
+pprUniqDSet :: (a -> SDoc) -> UniqDSet a -> SDoc
+pprUniqDSet f = braces . pprWithCommas f . uniqDSetToList
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
new file mode 100644
index 0000000000..01ab645783
--- /dev/null
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -0,0 +1,416 @@
+{-
+(c) The University of Glasgow 2006
+(c) The AQUA Project, Glasgow University, 1994-1998
+
+
+UniqFM: Specialised finite maps, for things with @Uniques@.
+
+Basically, the things need to be in class @Uniquable@, and we use the
+@getUnique@ method to grab their @Uniques@.
+
+(A similar thing to @UniqSet@, as opposed to @Set@.)
+
+The interface is based on @FiniteMap@s, but the implementation uses
+@Data.IntMap@, which is both maintained and faster than the past
+implementation (see commit log).
+
+The @UniqFM@ interface maps directly to Data.IntMap, only
+``Data.IntMap.union'' is left-biased and ``plusUFM'' right-biased
+and ``addToUFM\_C'' and ``Data.IntMap.insertWith'' differ in the order
+of arguments of combining function.
+-}
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -Wall #-}
+
+module GHC.Types.Unique.FM (
+        -- * Unique-keyed mappings
+        UniqFM,           -- abstract type
+        NonDetUniqFM(..), -- wrapper for opting into nondeterminism
+
+        -- ** Manipulating those mappings
+        emptyUFM,
+        unitUFM,
+        unitDirectlyUFM,
+        listToUFM,
+        listToUFM_Directly,
+        listToUFM_C,
+        addToUFM,addToUFM_C,addToUFM_Acc,
+        addListToUFM,addListToUFM_C,
+        addToUFM_Directly,
+        addListToUFM_Directly,
+        adjustUFM, alterUFM,
+        adjustUFM_Directly,
+        delFromUFM,
+        delFromUFM_Directly,
+        delListFromUFM,
+        delListFromUFM_Directly,
+        plusUFM,
+        plusUFM_C,
+        plusUFM_CD,
+        plusMaybeUFM_C,
+        plusUFMList,
+        minusUFM,
+        intersectUFM,
+        intersectUFM_C,
+        disjointUFM,
+        equalKeysUFM,
+        nonDetFoldUFM, foldUFM, nonDetFoldUFM_Directly,
+        anyUFM, allUFM, seqEltsUFM,
+        mapUFM, mapUFM_Directly,
+        elemUFM, elemUFM_Directly,
+        filterUFM, filterUFM_Directly, partitionUFM,
+        sizeUFM,
+        isNullUFM,
+        lookupUFM, lookupUFM_Directly,
+        lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
+        nonDetEltsUFM, eltsUFM, nonDetKeysUFM,
+        ufmToSet_Directly,
+        nonDetUFMToList, ufmToIntMap,
+        pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
+    ) where
+
+import GhcPrelude
+
+import GHC.Types.Unique ( Uniquable(..), Unique, getKey )
+import Outputable
+
+import qualified Data.IntMap as M
+import qualified Data.IntSet as S
+import Data.Data
+import qualified Data.Semigroup as Semi
+import Data.Functor.Classes (Eq1 (..))
+
+
+newtype UniqFM ele = UFM (M.IntMap ele)
+  deriving (Data, Eq, Functor)
+  -- Nondeterministic Foldable and Traversable instances are accessible through
+  -- use of the 'NonDetUniqFM' wrapper.
+  -- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
+
+emptyUFM :: UniqFM elt
+emptyUFM = UFM M.empty
+
+isNullUFM :: UniqFM elt -> Bool
+isNullUFM (UFM m) = M.null m
+
+unitUFM :: Uniquable key => key -> elt -> UniqFM elt
+unitUFM k v = UFM (M.singleton (getKey $ getUnique k) v)
+
+-- when you've got the Unique already
+unitDirectlyUFM :: Unique -> elt -> UniqFM elt
+unitDirectlyUFM u v = UFM (M.singleton (getKey u) v)
+
+listToUFM :: Uniquable key => [(key,elt)] -> UniqFM elt
+listToUFM = foldl' (\m (k, v) -> addToUFM m k v) emptyUFM
+
+listToUFM_Directly :: [(Unique, elt)] -> UniqFM elt
+listToUFM_Directly = foldl' (\m (u, v) -> addToUFM_Directly m u v) emptyUFM
+
+listToUFM_C
+  :: Uniquable key
+  => (elt -> elt -> elt)
+  -> [(key, elt)]
+  -> UniqFM elt
+listToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v) emptyUFM
+
+addToUFM :: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
+addToUFM (UFM m) k v = UFM (M.insert (getKey $ getUnique k) v m)
+
+addListToUFM :: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
+addListToUFM = foldl' (\m (k, v) -> addToUFM m k v)
+
+addListToUFM_Directly :: UniqFM elt -> [(Unique,elt)] -> UniqFM elt
+addListToUFM_Directly = foldl' (\m (k, v) -> addToUFM_Directly m k v)
+
+addToUFM_Directly :: UniqFM elt -> Unique -> elt -> UniqFM elt
+addToUFM_Directly (UFM m) u v = UFM (M.insert (getKey u) v m)
+
+addToUFM_C
+  :: Uniquable key
+  => (elt -> elt -> elt)  -- old -> new -> result
+  -> UniqFM elt           -- old
+  -> key -> elt           -- new
+  -> UniqFM elt           -- result
+-- Arguments of combining function of M.insertWith and addToUFM_C are flipped.
+addToUFM_C f (UFM m) k v =
+  UFM (M.insertWith (flip f) (getKey $ getUnique k) v m)
+
+addToUFM_Acc
+  :: Uniquable key
+  => (elt -> elts -> elts)  -- Add to existing
+  -> (elt -> elts)          -- New element
+  -> UniqFM elts            -- old
+  -> key -> elt             -- new
+  -> UniqFM elts            -- result
+addToUFM_Acc exi new (UFM m) k v =
+  UFM (M.insertWith (\_new old -> exi v old) (getKey $ getUnique k) (new v) m)
+
+alterUFM
+  :: Uniquable key
+  => (Maybe elt -> Maybe elt)  -- How to adjust
+  -> UniqFM elt                -- old
+  -> key                       -- new
+  -> UniqFM elt                -- result
+alterUFM f (UFM m) k = UFM (M.alter f (getKey $ getUnique k) m)
+
+addListToUFM_C
+  :: Uniquable key
+  => (elt -> elt -> elt)
+  -> UniqFM elt -> [(key,elt)]
+  -> UniqFM elt
+addListToUFM_C f = foldl' (\m (k, v) -> addToUFM_C f m k v)
+
+adjustUFM :: Uniquable key => (elt -> elt) -> UniqFM elt -> key -> UniqFM elt
+adjustUFM f (UFM m) k = UFM (M.adjust f (getKey $ getUnique k) m)
+
+adjustUFM_Directly :: (elt -> elt) -> UniqFM elt -> Unique -> UniqFM elt
+adjustUFM_Directly f (UFM m) u = UFM (M.adjust f (getKey u) m)
+
+delFromUFM :: Uniquable key => UniqFM elt -> key    -> UniqFM elt
+delFromUFM (UFM m) k = UFM (M.delete (getKey $ getUnique k) m)
+
+delListFromUFM :: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
+delListFromUFM = foldl' delFromUFM
+
+delListFromUFM_Directly :: UniqFM elt -> [Unique] -> UniqFM elt
+delListFromUFM_Directly = foldl' delFromUFM_Directly
+
+delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
+delFromUFM_Directly (UFM m) u = UFM (M.delete (getKey u) m)
+
+-- Bindings in right argument shadow those in the left
+plusUFM :: UniqFM elt -> UniqFM elt -> UniqFM elt
+-- M.union is left-biased, plusUFM should be right-biased.
+plusUFM (UFM x) (UFM y) = UFM (M.union y x)
+     -- Note (M.union y x), with arguments flipped
+     -- M.union is left-biased, plusUFM should be right-biased.
+
+plusUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> UniqFM elt -> UniqFM elt
+plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
+
+-- | `plusUFM_CD f m1 d1 m2 d2` merges the maps using `f` as the
+-- combinding function and `d1` resp. `d2` as the default value if
+-- there is no entry in `m1` reps. `m2`. The domain is the union of
+-- the domains of `m1` and `m2`.
+--
+-- Representative example:
+--
+-- @
+-- plusUFM_CD f {A: 1, B: 2} 23 {B: 3, C: 4} 42
+--    == {A: f 1 42, B: f 2 3, C: f 23 4 }
+-- @
+plusUFM_CD
+  :: (elt -> elt -> elt)
+  -> UniqFM elt  -- map X
+  -> elt         -- default for X
+  -> UniqFM elt  -- map Y
+  -> elt         -- default for Y
+  -> UniqFM elt
+plusUFM_CD f (UFM xm) dx (UFM ym) dy
+  = UFM $ M.mergeWithKey
+      (\_ x y -> Just (x `f` y))
+      (M.map (\x -> x `f` dy))
+      (M.map (\y -> dx `f` y))
+      xm ym
+
+plusMaybeUFM_C :: (elt -> elt -> Maybe elt)
+               -> UniqFM elt -> UniqFM elt -> UniqFM elt
+plusMaybeUFM_C f (UFM xm) (UFM ym)
+    = UFM $ M.mergeWithKey
+        (\_ x y -> x `f` y)
+        id
+        id
+        xm ym
+
+plusUFMList :: [UniqFM elt] -> UniqFM elt
+plusUFMList = foldl' plusUFM emptyUFM
+
+minusUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
+minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
+
+intersectUFM :: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
+intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
+
+intersectUFM_C
+  :: (elt1 -> elt2 -> elt3)
+  -> UniqFM elt1
+  -> UniqFM elt2
+  -> UniqFM elt3
+intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
+
+disjointUFM :: UniqFM elt1 -> UniqFM elt2 -> Bool
+disjointUFM (UFM x) (UFM y) = M.null (M.intersection x y)
+
+foldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+foldUFM k z (UFM m) = M.foldr k z m
+
+mapUFM :: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
+mapUFM f (UFM m) = UFM (M.map f m)
+
+mapUFM_Directly :: (Unique -> elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
+mapUFM_Directly f (UFM m) = UFM (M.mapWithKey (f . getUnique) m)
+
+filterUFM :: (elt -> Bool) -> UniqFM elt -> UniqFM elt
+filterUFM p (UFM m) = UFM (M.filter p m)
+
+filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
+filterUFM_Directly p (UFM m) = UFM (M.filterWithKey (p . getUnique) m)
+
+partitionUFM :: (elt -> Bool) -> UniqFM elt -> (UniqFM elt, UniqFM elt)
+partitionUFM p (UFM m) =
+  case M.partition p m of
+    (left, right) -> (UFM left, UFM right)
+
+sizeUFM :: UniqFM elt -> Int
+sizeUFM (UFM m) = M.size m
+
+elemUFM :: Uniquable key => key -> UniqFM elt -> Bool
+elemUFM k (UFM m) = M.member (getKey $ getUnique k) m
+
+elemUFM_Directly :: Unique -> UniqFM elt -> Bool
+elemUFM_Directly u (UFM m) = M.member (getKey u) m
+
+lookupUFM :: Uniquable key => UniqFM elt -> key -> Maybe elt
+lookupUFM (UFM m) k = M.lookup (getKey $ getUnique k) m
+
+-- when you've got the Unique already
+lookupUFM_Directly :: UniqFM elt -> Unique -> Maybe elt
+lookupUFM_Directly (UFM m) u = M.lookup (getKey u) m
+
+lookupWithDefaultUFM :: Uniquable key => UniqFM elt -> elt -> key -> elt
+lookupWithDefaultUFM (UFM m) v k = M.findWithDefault v (getKey $ getUnique k) m
+
+lookupWithDefaultUFM_Directly :: UniqFM elt -> elt -> Unique -> elt
+lookupWithDefaultUFM_Directly (UFM m) v u = M.findWithDefault v (getKey u) m
+
+eltsUFM :: UniqFM elt -> [elt]
+eltsUFM (UFM m) = M.elems m
+
+ufmToSet_Directly :: UniqFM elt -> S.IntSet
+ufmToSet_Directly (UFM m) = M.keysSet m
+
+anyUFM :: (elt -> Bool) -> UniqFM elt -> Bool
+anyUFM p (UFM m) = M.foldr ((||) . p) False m
+
+allUFM :: (elt -> Bool) -> UniqFM elt -> Bool
+allUFM p (UFM m) = M.foldr ((&&) . p) True m
+
+seqEltsUFM :: ([elt] -> ()) -> UniqFM elt -> ()
+seqEltsUFM seqList = seqList . nonDetEltsUFM
+  -- It's OK to use nonDetEltsUFM here because the type guarantees that
+  -- the only interesting thing this function can do is to force the
+  -- elements.
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetEltsUFM :: UniqFM elt -> [elt]
+nonDetEltsUFM (UFM m) = M.elems m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetKeysUFM :: UniqFM elt -> [Unique]
+nonDetKeysUFM (UFM m) = map getUnique $ M.keys m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUFM :: (elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetFoldUFM k z (UFM m) = M.foldr k z m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUFM_Directly:: (Unique -> elt -> a -> a) -> a -> UniqFM elt -> a
+nonDetFoldUFM_Directly k z (UFM m) = M.foldrWithKey (k . getUnique) z m
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetUFMToList :: UniqFM elt -> [(Unique, elt)]
+nonDetUFMToList (UFM m) = map (\(k, v) -> (getUnique k, v)) $ M.toList m
+
+-- | A wrapper around 'UniqFM' with the sole purpose of informing call sites
+-- that the provided 'Foldable' and 'Traversable' instances are
+-- nondeterministic.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
+newtype NonDetUniqFM ele = NonDetUniqFM { getNonDet :: UniqFM ele }
+  deriving (Functor)
+
+-- | Inherently nondeterministic.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
+instance Foldable NonDetUniqFM where
+  foldr f z (NonDetUniqFM (UFM m)) = foldr f z m
+
+-- | Inherently nondeterministic.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM to learn about determinism.
+instance Traversable NonDetUniqFM where
+  traverse f (NonDetUniqFM (UFM m)) = NonDetUniqFM . UFM <$> traverse f m
+
+ufmToIntMap :: UniqFM elt -> M.IntMap elt
+ufmToIntMap (UFM m) = m
+
+-- Determines whether two 'UniqFM's contain the same keys.
+equalKeysUFM :: UniqFM a -> UniqFM b -> Bool
+equalKeysUFM (UFM m1) (UFM m2) = liftEq (\_ _ -> True) m1 m2
+
+-- Instances
+
+instance Semi.Semigroup (UniqFM a) where
+  (<>) = plusUFM
+
+instance Monoid (UniqFM a) where
+    mempty = emptyUFM
+    mappend = (Semi.<>)
+
+-- Output-ery
+
+instance Outputable a => Outputable (UniqFM a) where
+    ppr ufm = pprUniqFM ppr ufm
+
+pprUniqFM :: (a -> SDoc) -> UniqFM a -> SDoc
+pprUniqFM ppr_elt ufm
+  = brackets $ fsep $ punctuate comma $
+    [ ppr uq <+> text ":->" <+> ppr_elt elt
+    | (uq, elt) <- nonDetUFMToList ufm ]
+  -- It's OK to use nonDetUFMToList here because we only use it for
+  -- pretty-printing.
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- nonDetEltsUFM.
+pprUFM :: UniqFM a      -- ^ The things to be pretty printed
+       -> ([a] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc          -- ^ 'SDoc' where the things have been pretty
+                        -- printed
+pprUFM ufm pp = pp (nonDetEltsUFM ufm)
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- nonDetUFMToList.
+pprUFMWithKeys
+       :: UniqFM a                -- ^ The things to be pretty printed
+       -> ([(Unique, a)] -> SDoc) -- ^ The pretty printing function to use on the elements
+       -> SDoc                    -- ^ 'SDoc' where the things have been pretty
+                                  -- printed
+pprUFMWithKeys ufm pp = pp (nonDetUFMToList ufm)
+
+-- | Determines the pluralisation suffix appropriate for the length of a set
+-- in the same way that plural from Outputable does for lists.
+pluralUFM :: UniqFM a -> SDoc
+pluralUFM ufm
+  | sizeUFM ufm == 1 = empty
+  | otherwise = char 's'
diff --git a/compiler/GHC/Types/Unique/Map.hs b/compiler/GHC/Types/Unique/Map.hs
new file mode 100644
index 0000000000..5b06864629
--- /dev/null
+++ b/compiler/GHC/Types/Unique/Map.hs
@@ -0,0 +1,206 @@
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# OPTIONS_GHC -Wall #-}
+
+-- Like 'UniqFM', these are maps for keys which are Uniquable.
+-- Unlike 'UniqFM', these maps also remember their keys, which
+-- makes them a much better drop in replacement for 'Data.Map.Map'.
+--
+-- Key preservation is right-biased.
+module GHC.Types.Unique.Map (
+    UniqMap,
+    emptyUniqMap,
+    isNullUniqMap,
+    unitUniqMap,
+    listToUniqMap,
+    listToUniqMap_C,
+    addToUniqMap,
+    addListToUniqMap,
+    addToUniqMap_C,
+    addToUniqMap_Acc,
+    alterUniqMap,
+    addListToUniqMap_C,
+    adjustUniqMap,
+    delFromUniqMap,
+    delListFromUniqMap,
+    plusUniqMap,
+    plusUniqMap_C,
+    plusMaybeUniqMap_C,
+    plusUniqMapList,
+    minusUniqMap,
+    intersectUniqMap,
+    disjointUniqMap,
+    mapUniqMap,
+    filterUniqMap,
+    partitionUniqMap,
+    sizeUniqMap,
+    elemUniqMap,
+    lookupUniqMap,
+    lookupWithDefaultUniqMap,
+    anyUniqMap,
+    allUniqMap,
+    -- Non-deterministic functions omitted
+) where
+
+import GhcPrelude
+
+import GHC.Types.Unique.FM
+
+import GHC.Types.Unique
+import Outputable
+
+import Data.Semigroup as Semi ( Semigroup(..) )
+import Data.Coerce
+import Data.Maybe
+import Data.Data
+
+-- | Maps indexed by 'Uniquable' keys
+newtype UniqMap k a = UniqMap (UniqFM (k, a))
+    deriving (Data, Eq, Functor)
+type role UniqMap nominal representational
+
+instance Semigroup (UniqMap k a) where
+  (<>) = plusUniqMap
+
+instance Monoid (UniqMap k a) where
+    mempty = emptyUniqMap
+    mappend = (Semi.<>)
+
+instance (Outputable k, Outputable a) => Outputable (UniqMap k a) where
+    ppr (UniqMap m) =
+        brackets $ fsep $ punctuate comma $
+        [ ppr k <+> text "->" <+> ppr v
+        | (k, v) <- eltsUFM m ]
+
+liftC :: (a -> a -> a) -> (k, a) -> (k, a) -> (k, a)
+liftC f (_, v) (k', v') = (k', f v v')
+
+emptyUniqMap :: UniqMap k a
+emptyUniqMap = UniqMap emptyUFM
+
+isNullUniqMap :: UniqMap k a -> Bool
+isNullUniqMap (UniqMap m) = isNullUFM m
+
+unitUniqMap :: Uniquable k => k -> a -> UniqMap k a
+unitUniqMap k v = UniqMap (unitUFM k (k, v))
+
+listToUniqMap :: Uniquable k => [(k,a)] -> UniqMap k a
+listToUniqMap kvs = UniqMap (listToUFM [ (k,(k,v)) | (k,v) <- kvs])
+
+listToUniqMap_C :: Uniquable k => (a -> a -> a) -> [(k,a)] -> UniqMap k a
+listToUniqMap_C f kvs = UniqMap $
+    listToUFM_C (liftC f) [ (k,(k,v)) | (k,v) <- kvs]
+
+addToUniqMap :: Uniquable k => UniqMap k a -> k -> a -> UniqMap k a
+addToUniqMap (UniqMap m) k v = UniqMap $ addToUFM m k (k, v)
+
+addListToUniqMap :: Uniquable k => UniqMap k a -> [(k,a)] -> UniqMap k a
+addListToUniqMap (UniqMap m) kvs = UniqMap $
+    addListToUFM m [(k,(k,v)) | (k,v) <- kvs]
+
+addToUniqMap_C :: Uniquable k
+               => (a -> a -> a)
+               -> UniqMap k a
+               -> k
+               -> a
+               -> UniqMap k a
+addToUniqMap_C f (UniqMap m) k v = UniqMap $
+    addToUFM_C (liftC f) m k (k, v)
+
+addToUniqMap_Acc :: Uniquable k
+                 => (b -> a -> a)
+                 -> (b -> a)
+                 -> UniqMap k a
+                 -> k
+                 -> b
+                 -> UniqMap k a
+addToUniqMap_Acc exi new (UniqMap m) k0 v0 = UniqMap $
+    addToUFM_Acc (\b (k, v) -> (k, exi b v))
+                 (\b -> (k0, new b))
+                 m k0 v0
+
+alterUniqMap :: Uniquable k
+             => (Maybe a -> Maybe a)
+             -> UniqMap k a
+             -> k
+             -> UniqMap k a
+alterUniqMap f (UniqMap m) k = UniqMap $
+    alterUFM (fmap (k,) . f . fmap snd) m k
+
+addListToUniqMap_C
+    :: Uniquable k
+    => (a -> a -> a)
+    -> UniqMap k a
+    -> [(k, a)]
+    -> UniqMap k a
+addListToUniqMap_C f (UniqMap m) kvs = UniqMap $
+    addListToUFM_C (liftC f) m
+        [(k,(k,v)) | (k,v) <- kvs]
+
+adjustUniqMap
+    :: Uniquable k
+    => (a -> a)
+    -> UniqMap k a
+    -> k
+    -> UniqMap k a
+adjustUniqMap f (UniqMap m) k = UniqMap $
+    adjustUFM (\(_,v) -> (k,f v)) m k
+
+delFromUniqMap :: Uniquable k => UniqMap k a -> k -> UniqMap k a
+delFromUniqMap (UniqMap m) k = UniqMap $ delFromUFM m k
+
+delListFromUniqMap :: Uniquable k => UniqMap k a -> [k] -> UniqMap k a
+delListFromUniqMap (UniqMap m) ks = UniqMap $ delListFromUFM m ks
+
+plusUniqMap :: UniqMap k a -> UniqMap k a -> UniqMap k a
+plusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ plusUFM m1 m2
+
+plusUniqMap_C :: (a -> a -> a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
+plusUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $
+    plusUFM_C (liftC f) m1 m2
+
+plusMaybeUniqMap_C :: (a -> a -> Maybe a) -> UniqMap k a -> UniqMap k a -> UniqMap k a
+plusMaybeUniqMap_C f (UniqMap m1) (UniqMap m2) = UniqMap $
+    plusMaybeUFM_C (\(_, v) (k', v') -> fmap (k',) (f v v')) m1 m2
+
+plusUniqMapList :: [UniqMap k a] -> UniqMap k a
+plusUniqMapList xs = UniqMap $ plusUFMList (coerce xs)
+
+minusUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a
+minusUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ minusUFM m1 m2
+
+intersectUniqMap :: UniqMap k a -> UniqMap k b -> UniqMap k a
+intersectUniqMap (UniqMap m1) (UniqMap m2) = UniqMap $ intersectUFM m1 m2
+
+disjointUniqMap :: UniqMap k a -> UniqMap k b -> Bool
+disjointUniqMap (UniqMap m1) (UniqMap m2) = disjointUFM m1 m2
+
+mapUniqMap :: (a -> b) -> UniqMap k a -> UniqMap k b
+mapUniqMap f (UniqMap m) = UniqMap $ mapUFM (fmap f) m -- (,) k instance
+
+filterUniqMap :: (a -> Bool) -> UniqMap k a -> UniqMap k a
+filterUniqMap f (UniqMap m) = UniqMap $ filterUFM (f . snd) m
+
+partitionUniqMap :: (a -> Bool) -> UniqMap k a -> (UniqMap k a, UniqMap k a)
+partitionUniqMap f (UniqMap m) =
+    coerce $ partitionUFM (f . snd) m
+
+sizeUniqMap :: UniqMap k a -> Int
+sizeUniqMap (UniqMap m) = sizeUFM m
+
+elemUniqMap :: Uniquable k => k -> UniqMap k a -> Bool
+elemUniqMap k (UniqMap m) = elemUFM k m
+
+lookupUniqMap :: Uniquable k => UniqMap k a -> k -> Maybe a
+lookupUniqMap (UniqMap m) k = fmap snd (lookupUFM m k)
+
+lookupWithDefaultUniqMap :: Uniquable k => UniqMap k a -> a -> k -> a
+lookupWithDefaultUniqMap (UniqMap m) a k = fromMaybe a (fmap snd (lookupUFM m k))
+
+anyUniqMap :: (a -> Bool) -> UniqMap k a -> Bool
+anyUniqMap f (UniqMap m) = anyUFM (f . snd) m
+
+allUniqMap :: (a -> Bool) -> UniqMap k a -> Bool
+allUniqMap f (UniqMap m) = allUFM (f . snd) m
diff --git a/compiler/GHC/Types/Unique/Set.hs b/compiler/GHC/Types/Unique/Set.hs
new file mode 100644
index 0000000000..1c52a66732
--- /dev/null
+++ b/compiler/GHC/Types/Unique/Set.hs
@@ -0,0 +1,195 @@
+{-
+(c) The University of Glasgow 2006
+(c) The AQUA Project, Glasgow University, 1994-1998
+
+\section[UniqSet]{Specialised sets, for things with @Uniques@}
+
+Based on @UniqFMs@ (as you would expect).
+
+Basically, the things need to be in class @Uniquable@.
+-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module GHC.Types.Unique.Set (
+        -- * Unique set type
+        UniqSet,    -- type synonym for UniqFM a
+        getUniqSet,
+        pprUniqSet,
+
+        -- ** Manipulating these sets
+        emptyUniqSet,
+        unitUniqSet,
+        mkUniqSet,
+        addOneToUniqSet, addListToUniqSet,
+        delOneFromUniqSet, delOneFromUniqSet_Directly, delListFromUniqSet,
+        delListFromUniqSet_Directly,
+        unionUniqSets, unionManyUniqSets,
+        minusUniqSet, uniqSetMinusUFM,
+        intersectUniqSets,
+        restrictUniqSetToUFM,
+        uniqSetAny, uniqSetAll,
+        elementOfUniqSet,
+        elemUniqSet_Directly,
+        filterUniqSet,
+        filterUniqSet_Directly,
+        sizeUniqSet,
+        isEmptyUniqSet,
+        lookupUniqSet,
+        lookupUniqSet_Directly,
+        partitionUniqSet,
+        mapUniqSet,
+        unsafeUFMToUniqSet,
+        nonDetEltsUniqSet,
+        nonDetKeysUniqSet,
+        nonDetFoldUniqSet,
+        nonDetFoldUniqSet_Directly
+    ) where
+
+import GhcPrelude
+
+import GHC.Types.Unique.FM
+import GHC.Types.Unique
+import Data.Coerce
+import Outputable
+import Data.Data
+import qualified Data.Semigroup as Semi
+
+-- Note [UniqSet invariant]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~
+-- UniqSet has the following invariant:
+--   The keys in the map are the uniques of the values
+-- It means that to implement mapUniqSet you have to update
+-- both the keys and the values.
+
+newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a}
+                  deriving (Data, Semi.Semigroup, Monoid)
+
+emptyUniqSet :: UniqSet a
+emptyUniqSet = UniqSet emptyUFM
+
+unitUniqSet :: Uniquable a => a -> UniqSet a
+unitUniqSet x = UniqSet $ unitUFM x x
+
+mkUniqSet :: Uniquable a => [a]  -> UniqSet a
+mkUniqSet = foldl' addOneToUniqSet emptyUniqSet
+
+addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
+addOneToUniqSet (UniqSet set) x = UniqSet (addToUFM set x x)
+
+addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
+addListToUniqSet = foldl' addOneToUniqSet
+
+delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
+delOneFromUniqSet (UniqSet s) a = UniqSet (delFromUFM s a)
+
+delOneFromUniqSet_Directly :: UniqSet a -> Unique -> UniqSet a
+delOneFromUniqSet_Directly (UniqSet s) u = UniqSet (delFromUFM_Directly s u)
+
+delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
+delListFromUniqSet (UniqSet s) l = UniqSet (delListFromUFM s l)
+
+delListFromUniqSet_Directly :: UniqSet a -> [Unique] -> UniqSet a
+delListFromUniqSet_Directly (UniqSet s) l =
+    UniqSet (delListFromUFM_Directly s l)
+
+unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
+unionUniqSets (UniqSet s) (UniqSet t) = UniqSet (plusUFM s t)
+
+unionManyUniqSets :: [UniqSet a] -> UniqSet a
+unionManyUniqSets = foldl' (flip unionUniqSets) emptyUniqSet
+
+minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
+minusUniqSet (UniqSet s) (UniqSet t) = UniqSet (minusUFM s t)
+
+intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
+intersectUniqSets (UniqSet s) (UniqSet t) = UniqSet (intersectUFM s t)
+
+restrictUniqSetToUFM :: UniqSet a -> UniqFM b -> UniqSet a
+restrictUniqSetToUFM (UniqSet s) m = UniqSet (intersectUFM s m)
+
+uniqSetMinusUFM :: UniqSet a -> UniqFM b -> UniqSet a
+uniqSetMinusUFM (UniqSet s) t = UniqSet (minusUFM s t)
+
+elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
+elementOfUniqSet a (UniqSet s) = elemUFM a s
+
+elemUniqSet_Directly :: Unique -> UniqSet a -> Bool
+elemUniqSet_Directly a (UniqSet s) = elemUFM_Directly a s
+
+filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
+filterUniqSet p (UniqSet s) = UniqSet (filterUFM p s)
+
+filterUniqSet_Directly :: (Unique -> elt -> Bool) -> UniqSet elt -> UniqSet elt
+filterUniqSet_Directly f (UniqSet s) = UniqSet (filterUFM_Directly f s)
+
+partitionUniqSet :: (a -> Bool) -> UniqSet a -> (UniqSet a, UniqSet a)
+partitionUniqSet p (UniqSet s) = coerce (partitionUFM p s)
+
+uniqSetAny :: (a -> Bool) -> UniqSet a -> Bool
+uniqSetAny p (UniqSet s) = anyUFM p s
+
+uniqSetAll :: (a -> Bool) -> UniqSet a -> Bool
+uniqSetAll p (UniqSet s) = allUFM p s
+
+sizeUniqSet :: UniqSet a -> Int
+sizeUniqSet (UniqSet s) = sizeUFM s
+
+isEmptyUniqSet :: UniqSet a -> Bool
+isEmptyUniqSet (UniqSet s) = isNullUFM s
+
+lookupUniqSet :: Uniquable a => UniqSet b -> a -> Maybe b
+lookupUniqSet (UniqSet s) k = lookupUFM s k
+
+lookupUniqSet_Directly :: UniqSet a -> Unique -> Maybe a
+lookupUniqSet_Directly (UniqSet s) k = lookupUFM_Directly s k
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetEltsUniqSet :: UniqSet elt -> [elt]
+nonDetEltsUniqSet = nonDetEltsUFM . getUniqSet'
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetKeysUniqSet :: UniqSet elt -> [Unique]
+nonDetKeysUniqSet = nonDetKeysUFM . getUniqSet'
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUniqSet :: (elt -> a -> a) -> a -> UniqSet elt -> a
+nonDetFoldUniqSet c n (UniqSet s) = nonDetFoldUFM c n s
+
+-- See Note [Deterministic UniqFM] to learn about nondeterminism.
+-- If you use this please provide a justification why it doesn't introduce
+-- nondeterminism.
+nonDetFoldUniqSet_Directly:: (Unique -> elt -> a -> a) -> a -> UniqSet elt -> a
+nonDetFoldUniqSet_Directly f n (UniqSet s) = nonDetFoldUFM_Directly f n s
+
+-- See Note [UniqSet invariant]
+mapUniqSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
+mapUniqSet f = mkUniqSet . map f . nonDetEltsUniqSet
+
+-- Two 'UniqSet's are considered equal if they contain the same
+-- uniques.
+instance Eq (UniqSet a) where
+  UniqSet a == UniqSet b = equalKeysUFM a b
+
+getUniqSet :: UniqSet a -> UniqFM a
+getUniqSet = getUniqSet'
+
+-- | 'unsafeUFMToUniqSet' converts a @'UniqFM' a@ into a @'UniqSet' a@
+-- assuming, without checking, that it maps each 'Unique' to a value
+-- that has that 'Unique'. See Note [UniqSet invariant].
+unsafeUFMToUniqSet :: UniqFM a -> UniqSet a
+unsafeUFMToUniqSet = UniqSet
+
+instance Outputable a => Outputable (UniqSet a) where
+    ppr = pprUniqSet ppr
+
+pprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc
+-- It's OK to use nonDetUFMToList here because we only use it for
+-- pretty-printing.
+pprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet
diff --git a/compiler/GHC/Types/Unique/Supply.hs b/compiler/GHC/Types/Unique/Supply.hs
new file mode 100644
index 0000000000..56c85efcce
--- /dev/null
+++ b/compiler/GHC/Types/Unique/Supply.hs
@@ -0,0 +1,224 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE BangPatterns #-}
+
+#if !defined(GHC_LOADED_INTO_GHCI)
+{-# LANGUAGE UnboxedTuples #-}
+#endif
+
+module GHC.Types.Unique.Supply (
+        -- * Main data type
+        UniqSupply, -- Abstractly
+
+        -- ** Operations on supplies
+        uniqFromSupply, uniqsFromSupply, -- basic ops
+        takeUniqFromSupply, uniqFromMask,
+
+        mkSplitUniqSupply,
+        splitUniqSupply, listSplitUniqSupply,
+
+        -- * Unique supply monad and its abstraction
+        UniqSM, MonadUnique(..),
+
+        -- ** Operations on the monad
+        initUs, initUs_,
+
+        -- * Set supply strategy
+        initUniqSupply
+  ) where
+
+import GhcPrelude
+
+import GHC.Types.Unique
+import PlainPanic (panic)
+
+import GHC.IO
+
+import MonadUtils
+import Control.Monad
+import Data.Bits
+import Data.Char
+import Control.Monad.Fail as Fail
+
+#include "Unique.h"
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Splittable Unique supply: @UniqSupply@}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Unique Supply
+--
+-- A value of type 'UniqSupply' is unique, and it can
+-- supply /one/ distinct 'Unique'.  Also, from the supply, one can
+-- also manufacture an arbitrary number of further 'UniqueSupply' values,
+-- which will be distinct from the first and from all others.
+data UniqSupply
+  = MkSplitUniqSupply {-# UNPACK #-} !Int -- make the Unique with this
+                   UniqSupply UniqSupply
+                                -- when split => these two supplies
+
+mkSplitUniqSupply :: Char -> IO UniqSupply
+-- ^ Create a unique supply out of thin air. The character given must
+-- be distinct from those of all calls to this function in the compiler
+-- for the values generated to be truly unique.
+
+splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
+-- ^ Build two 'UniqSupply' from a single one, each of which
+-- can supply its own 'Unique'.
+listSplitUniqSupply :: UniqSupply -> [UniqSupply]
+-- ^ Create an infinite list of 'UniqSupply' from a single one
+uniqFromSupply  :: UniqSupply -> Unique
+-- ^ Obtain the 'Unique' from this particular 'UniqSupply'
+uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite
+-- ^ Obtain an infinite list of 'Unique' that can be generated by constant splitting of the supply
+takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
+-- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply
+
+uniqFromMask :: Char -> IO Unique
+uniqFromMask mask
+  = do { uqNum <- genSym
+       ; return $! mkUnique mask uqNum }
+
+mkSplitUniqSupply c
+  = case ord c `shiftL` uNIQUE_BITS of
+     !mask -> let
+        -- here comes THE MAGIC:
+
+        -- This is one of the most hammered bits in the whole compiler
+        mk_supply
+          -- NB: Use unsafeInterleaveIO for thread-safety.
+          = unsafeInterleaveIO (
+                genSym      >>= \ u ->
+                mk_supply   >>= \ s1 ->
+                mk_supply   >>= \ s2 ->
+                return (MkSplitUniqSupply (mask .|. u) s1 s2)
+            )
+       in
+       mk_supply
+
+foreign import ccall unsafe "genSym" genSym :: IO Int
+foreign import ccall unsafe "initGenSym" initUniqSupply :: Int -> Int -> IO ()
+
+splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
+listSplitUniqSupply  (MkSplitUniqSupply _ s1 s2) = s1 : listSplitUniqSupply s2
+
+uniqFromSupply  (MkSplitUniqSupply n _ _)  = mkUniqueGrimily n
+uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2
+takeUniqFromSupply (MkSplitUniqSupply n s1 _) = (mkUniqueGrimily n, s1)
+
+{-
+************************************************************************
+*                                                                      *
+\subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}
+*                                                                      *
+************************************************************************
+-}
+
+-- Avoids using unboxed tuples when loading into GHCi
+#if !defined(GHC_LOADED_INTO_GHCI)
+
+type UniqResult result = (# result, UniqSupply #)
+
+pattern UniqResult :: a -> b -> (# a, b #)
+pattern UniqResult x y = (# x, y #)
+{-# COMPLETE UniqResult #-}
+
+#else
+
+data UniqResult result = UniqResult !result {-# UNPACK #-} !UniqSupply
+  deriving (Functor)
+
+#endif
+
+-- | A monad which just gives the ability to obtain 'Unique's
+newtype UniqSM result = USM { unUSM :: UniqSupply -> UniqResult result }
+    deriving (Functor)
+
+instance Monad UniqSM where
+  (>>=) = thenUs
+  (>>)  = (*>)
+
+instance Applicative UniqSM where
+    pure = returnUs
+    (USM f) <*> (USM x) = USM $ \us0 -> case f us0 of
+                            UniqResult ff us1 -> case x us1 of
+                              UniqResult xx us2 -> UniqResult (ff xx) us2
+    (*>) = thenUs_
+
+-- TODO: try to get rid of this instance
+instance Fail.MonadFail UniqSM where
+    fail = panic
+
+-- | Run the 'UniqSM' action, returning the final 'UniqSupply'
+initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)
+initUs init_us m = case unUSM m init_us of { UniqResult r us -> (r, us) }
+
+-- | Run the 'UniqSM' action, discarding the final 'UniqSupply'
+initUs_ :: UniqSupply -> UniqSM a -> a
+initUs_ init_us m = case unUSM m init_us of { UniqResult r _ -> r }
+
+{-# INLINE thenUs #-}
+{-# INLINE returnUs #-}
+{-# INLINE splitUniqSupply #-}
+
+-- @thenUs@ is where we split the @UniqSupply@.
+
+liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)
+liftUSM (USM m) us0 = case m us0 of UniqResult a us1 -> (a, us1)
+
+instance MonadFix UniqSM where
+    mfix m = USM (\us0 -> let (r,us1) = liftUSM (m r) us0 in UniqResult r us1)
+
+thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
+thenUs (USM expr) cont
+  = USM (\us0 -> case (expr us0) of
+                   UniqResult result us1 -> unUSM (cont result) us1)
+
+thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b
+thenUs_ (USM expr) (USM cont)
+  = USM (\us0 -> case (expr us0) of { UniqResult _ us1 -> cont us1 })
+
+returnUs :: a -> UniqSM a
+returnUs result = USM (\us -> UniqResult result us)
+
+getUs :: UniqSM UniqSupply
+getUs = USM (\us0 -> case splitUniqSupply us0 of (us1,us2) -> UniqResult us1 us2)
+
+-- | A monad for generating unique identifiers
+class Monad m => MonadUnique m where
+    -- | Get a new UniqueSupply
+    getUniqueSupplyM :: m UniqSupply
+    -- | Get a new unique identifier
+    getUniqueM  :: m Unique
+    -- | Get an infinite list of new unique identifiers
+    getUniquesM :: m [Unique]
+
+    -- This default definition of getUniqueM, while correct, is not as
+    -- efficient as it could be since it needlessly generates and throws away
+    -- an extra Unique. For your instances consider providing an explicit
+    -- definition for 'getUniqueM' which uses 'takeUniqFromSupply' directly.
+    getUniqueM  = liftM uniqFromSupply  getUniqueSupplyM
+    getUniquesM = liftM uniqsFromSupply getUniqueSupplyM
+
+instance MonadUnique UniqSM where
+    getUniqueSupplyM = getUs
+    getUniqueM  = getUniqueUs
+    getUniquesM = getUniquesUs
+
+getUniqueUs :: UniqSM Unique
+getUniqueUs = USM (\us0 -> case takeUniqFromSupply us0 of
+                           (u,us1) -> UniqResult u us1)
+
+getUniquesUs :: UniqSM [Unique]
+getUniquesUs = USM (\us0 -> case splitUniqSupply us0 of
+                            (us1,us2) -> UniqResult (uniqsFromSupply us1) us2)
diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs
new file mode 100644
index 0000000000..267d0fc786
--- /dev/null
+++ b/compiler/GHC/Types/Var.hs
@@ -0,0 +1,763 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section{@Vars@: Variables}
+-}
+
+{-# LANGUAGE CPP, FlexibleContexts, MultiWayIf, FlexibleInstances, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
+{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
+
+-- |
+-- #name_types#
+-- GHC uses several kinds of name internally:
+--
+-- * 'OccName.OccName': see "OccName#name_types"
+--
+-- * 'RdrName.RdrName': see "RdrName#name_types"
+--
+-- * 'Name.Name': see "Name#name_types"
+--
+-- * 'Id.Id': see "Id#name_types"
+--
+-- * 'Var.Var' is a synonym for the 'Id.Id' type but it may additionally
+--   potentially contain type variables, which have a 'GHC.Core.TyCo.Rep.Kind'
+--   rather than a 'GHC.Core.TyCo.Rep.Type' and only contain some extra
+--   details during typechecking.
+--
+--   These 'Var.Var' names may either be global or local, see "Var#globalvslocal"
+--
+-- #globalvslocal#
+-- Global 'Id's and 'Var's are those that are imported or correspond
+--    to a data constructor, primitive operation, or record selectors.
+-- Local 'Id's and 'Var's are those bound within an expression
+--    (e.g. by a lambda) or at the top level of the module being compiled.
+
+module GHC.Types.Var (
+        -- * The main data type and synonyms
+        Var, CoVar, Id, NcId, DictId, DFunId, EvVar, EqVar, EvId, IpId, JoinId,
+        TyVar, TcTyVar, TypeVar, KindVar, TKVar, TyCoVar,
+
+        -- * In and Out variants
+        InVar,  InCoVar,  InId,  InTyVar,
+        OutVar, OutCoVar, OutId, OutTyVar,
+
+        -- ** Taking 'Var's apart
+        varName, varUnique, varType,
+
+        -- ** Modifying 'Var's
+        setVarName, setVarUnique, setVarType, updateVarType,
+        updateVarTypeM,
+
+        -- ** Constructing, taking apart, modifying 'Id's
+        mkGlobalVar, mkLocalVar, mkExportedLocalVar, mkCoVar,
+        idInfo, idDetails,
+        lazySetIdInfo, setIdDetails, globaliseId,
+        setIdExported, setIdNotExported,
+
+        -- ** Predicates
+        isId, isTyVar, isTcTyVar,
+        isLocalVar, isLocalId, isCoVar, isNonCoVarId, isTyCoVar,
+        isGlobalId, isExportedId,
+        mustHaveLocalBinding,
+
+        -- * ArgFlags
+        ArgFlag(..), isVisibleArgFlag, isInvisibleArgFlag, sameVis,
+        AnonArgFlag(..), ForallVisFlag(..), argToForallVisFlag,
+
+        -- * TyVar's
+        VarBndr(..), TyCoVarBinder, TyVarBinder,
+        binderVar, binderVars, binderArgFlag, binderType,
+        mkTyCoVarBinder, mkTyCoVarBinders,
+        mkTyVarBinder, mkTyVarBinders,
+        isTyVarBinder,
+
+        -- ** Constructing TyVar's
+        mkTyVar, mkTcTyVar,
+
+        -- ** Taking 'TyVar's apart
+        tyVarName, tyVarKind, tcTyVarDetails, setTcTyVarDetails,
+
+        -- ** Modifying 'TyVar's
+        setTyVarName, setTyVarUnique, setTyVarKind, updateTyVarKind,
+        updateTyVarKindM,
+
+        nonDetCmpVar
+
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import {-# SOURCE #-}   GHC.Core.TyCo.Rep( Type, Kind )
+import {-# SOURCE #-}   GHC.Core.TyCo.Ppr( pprKind )
+import {-# SOURCE #-}   TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv )
+import {-# SOURCE #-}   GHC.Types.Id.Info( IdDetails, IdInfo, coVarDetails, isCoVarDetails,
+                                           vanillaIdInfo, pprIdDetails )
+
+import GHC.Types.Name hiding (varName)
+import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique
+                        , mkUniqueGrimily, nonDetCmpUnique )
+import Util
+import Binary
+import Outputable
+
+import Data.Data
+
+{-
+************************************************************************
+*                                                                      *
+                     Synonyms
+*                                                                      *
+************************************************************************
+-- These synonyms are here and not in Id because otherwise we need a very
+-- large number of SOURCE imports of Id.hs :-(
+-}
+
+-- | Identifier
+type Id    = Var       -- A term-level identifier
+                       --  predicate: isId
+
+-- | Coercion Variable
+type CoVar = Id        -- See Note [Evidence: EvIds and CoVars]
+                       --   predicate: isCoVar
+
+-- |
+type NcId  = Id        -- A term-level (value) variable that is
+                       -- /not/ an (unlifted) coercion
+                       --    predicate: isNonCoVarId
+
+-- | Type or kind Variable
+type TyVar   = Var     -- Type *or* kind variable (historical)
+
+-- | Type or Kind Variable
+type TKVar   = Var     -- Type *or* kind variable (historical)
+
+-- | Type variable that might be a metavariable
+type TcTyVar = Var
+
+-- | Type Variable
+type TypeVar = Var     -- Definitely a type variable
+
+-- | Kind Variable
+type KindVar = Var     -- Definitely a kind variable
+                       -- See Note [Kind and type variables]
+
+-- See Note [Evidence: EvIds and CoVars]
+-- | Evidence Identifier
+type EvId   = Id        -- Term-level evidence: DictId, IpId, or EqVar
+
+-- | Evidence Variable
+type EvVar  = EvId      -- ...historical name for EvId
+
+-- | Dictionary Function Identifier
+type DFunId = Id        -- A dictionary function
+
+-- | Dictionary Identifier
+type DictId = EvId      -- A dictionary variable
+
+-- | Implicit parameter Identifier
+type IpId   = EvId      -- A term-level implicit parameter
+
+-- | Equality Variable
+type EqVar  = EvId      -- Boxed equality evidence
+type JoinId = Id        -- A join variable
+
+-- | Type or Coercion Variable
+type TyCoVar = Id       -- Type, *or* coercion variable
+                        --   predicate: isTyCoVar
+
+
+{- Many passes apply a substitution, and it's very handy to have type
+   synonyms to remind us whether or not the substitution has been applied -}
+
+type InVar      = Var
+type InTyVar    = TyVar
+type InCoVar    = CoVar
+type InId       = Id
+type OutVar     = Var
+type OutTyVar   = TyVar
+type OutCoVar   = CoVar
+type OutId      = Id
+
+
+
+{- Note [Evidence: EvIds and CoVars]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* An EvId (evidence Id) is a term-level evidence variable
+  (dictionary, implicit parameter, or equality). Could be boxed or unboxed.
+
+* DictId, IpId, and EqVar are synonyms when we know what kind of
+  evidence we are talking about.  For example, an EqVar has type (t1 ~ t2).
+
+* A CoVar is always an un-lifted coercion, of type (t1 ~# t2) or (t1 ~R# t2)
+
+Note [Kind and type variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Before kind polymorphism, TyVar were used to mean type variables. Now
+they are used to mean kind *or* type variables. KindVar is used when we
+know for sure that it is a kind variable. In future, we might want to
+go over the whole compiler code to use:
+   - TKVar   to mean kind or type variables
+   - TypeVar to mean         type variables only
+   - KindVar to mean kind         variables
+
+
+************************************************************************
+*                                                                      *
+\subsection{The main data type declarations}
+*                                                                      *
+************************************************************************
+
+
+Every @Var@ has a @Unique@, to uniquify it and for fast comparison, a
+@Type@, and an @IdInfo@ (non-essential info about it, e.g.,
+strictness).  The essential info about different kinds of @Vars@ is
+in its @VarDetails@.
+-}
+
+-- | Variable
+--
+-- Essentially a typed 'Name', that may also contain some additional information
+-- about the 'Var' and its use sites.
+data Var
+  = TyVar {  -- Type and kind variables
+             -- see Note [Kind and type variables]
+        varName    :: !Name,
+        realUnique :: {-# UNPACK #-} !Int,
+                                     -- ^ Key for fast comparison
+                                     -- Identical to the Unique in the name,
+                                     -- cached here for speed
+        varType    :: Kind           -- ^ The type or kind of the 'Var' in question
+ }
+
+  | TcTyVar {                           -- Used only during type inference
+                                        -- Used for kind variables during
+                                        -- inference, as well
+        varName        :: !Name,
+        realUnique     :: {-# UNPACK #-} !Int,
+        varType        :: Kind,
+        tc_tv_details  :: TcTyVarDetails
+  }
+
+  | Id {
+        varName    :: !Name,
+        realUnique :: {-# UNPACK #-} !Int,
+        varType    :: Type,
+        idScope    :: IdScope,
+        id_details :: IdDetails,        -- Stable, doesn't change
+        id_info    :: IdInfo }          -- Unstable, updated by simplifier
+
+-- | Identifier Scope
+data IdScope    -- See Note [GlobalId/LocalId]
+  = GlobalId
+  | LocalId ExportFlag
+
+data ExportFlag   -- See Note [ExportFlag on binders]
+  = NotExported   -- ^ Not exported: may be discarded as dead code.
+  | Exported      -- ^ Exported: kept alive
+
+{- Note [ExportFlag on binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+An ExportFlag of "Exported" on a top-level binder says "keep this
+binding alive; do not drop it as dead code".  This transitively
+keeps alive all the other top-level bindings that this binding refers
+to.  This property is persisted all the way down the pipeline, so that
+the binding will be compiled all the way to object code, and its
+symbols will appear in the linker symbol table.
+
+However, note that this use of "exported" is quite different to the
+export list on a Haskell module.  Setting the ExportFlag on an Id does
+/not/ mean that if you import the module (in Haskell source code) you
+will see this Id.  Of course, things that appear in the export list
+of the source Haskell module do indeed have their ExportFlag set.
+But many other things, such as dictionary functions, are kept alive
+by having their ExportFlag set, even though they are not exported
+in the source-code sense.
+
+We should probably use a different term for ExportFlag, like
+KeepAlive.
+
+Note [GlobalId/LocalId]
+~~~~~~~~~~~~~~~~~~~~~~~
+A GlobalId is
+  * always a constant (top-level)
+  * imported, or data constructor, or primop, or record selector
+  * has a Unique that is globally unique across the whole
+    GHC invocation (a single invocation may compile multiple modules)
+  * never treated as a candidate by the free-variable finder;
+        it's a constant!
+
+A LocalId is
+  * bound within an expression (lambda, case, local let(rec))
+  * or defined at top level in the module being compiled
+  * always treated as a candidate by the free-variable finder
+
+After CoreTidy, top-level LocalIds are turned into GlobalIds
+-}
+
+instance Outputable Var where
+  ppr var = sdocOption sdocSuppressVarKinds $ \supp_var_kinds ->
+            getPprStyle $ \ppr_style ->
+            if |  debugStyle ppr_style && (not supp_var_kinds)
+                 -> parens (ppr (varName var) <+> ppr_debug var ppr_style <+>
+                          dcolon <+> pprKind (tyVarKind var))
+               |  otherwise
+                 -> ppr (varName var) <> ppr_debug var ppr_style
+
+ppr_debug :: Var -> PprStyle -> SDoc
+ppr_debug (TyVar {}) sty
+  | debugStyle sty = brackets (text "tv")
+ppr_debug (TcTyVar {tc_tv_details = d}) sty
+  | dumpStyle sty || debugStyle sty = brackets (pprTcTyVarDetails d)
+ppr_debug (Id { idScope = s, id_details = d }) sty
+  | debugStyle sty = brackets (ppr_id_scope s <> pprIdDetails d)
+ppr_debug _ _ = empty
+
+ppr_id_scope :: IdScope -> SDoc
+ppr_id_scope GlobalId              = text "gid"
+ppr_id_scope (LocalId Exported)    = text "lidx"
+ppr_id_scope (LocalId NotExported) = text "lid"
+
+instance NamedThing Var where
+  getName = varName
+
+instance Uniquable Var where
+  getUnique = varUnique
+
+instance Eq Var where
+    a == b = realUnique a == realUnique b
+
+instance Ord Var where
+    a <= b = realUnique a <= realUnique b
+    a <  b = realUnique a <  realUnique b
+    a >= b = realUnique a >= realUnique b
+    a >  b = realUnique a >  realUnique b
+    a `compare` b = a `nonDetCmpVar` b
+
+-- | Compare Vars by their Uniques.
+-- This is what Ord Var does, provided here to make it explicit at the
+-- call-site that it can introduce non-determinism.
+-- See Note [Unique Determinism]
+nonDetCmpVar :: Var -> Var -> Ordering
+nonDetCmpVar a b = varUnique a `nonDetCmpUnique` varUnique b
+
+instance Data Var where
+  -- don't traverse?
+  toConstr _   = abstractConstr "Var"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "Var"
+
+instance HasOccName Var where
+  occName = nameOccName . varName
+
+varUnique :: Var -> Unique
+varUnique var = mkUniqueGrimily (realUnique var)
+
+setVarUnique :: Var -> Unique -> Var
+setVarUnique var uniq
+  = var { realUnique = getKey uniq,
+          varName = setNameUnique (varName var) uniq }
+
+setVarName :: Var -> Name -> Var
+setVarName var new_name
+  = var { realUnique = getKey (getUnique new_name),
+          varName = new_name }
+
+setVarType :: Id -> Type -> Id
+setVarType id ty = id { varType = ty }
+
+updateVarType :: (Type -> Type) -> Id -> Id
+updateVarType f id = id { varType = f (varType id) }
+
+updateVarTypeM :: Monad m => (Type -> m Type) -> Id -> m Id
+updateVarTypeM f id = do { ty' <- f (varType id)
+                         ; return (id { varType = ty' }) }
+
+{- *********************************************************************
+*                                                                      *
+*                   ArgFlag
+*                                                                      *
+********************************************************************* -}
+
+-- | Argument Flag
+--
+-- Is something required to appear in source Haskell ('Required'),
+-- permitted by request ('Specified') (visible type application), or
+-- prohibited entirely from appearing in source Haskell ('Inferred')?
+-- See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep
+data ArgFlag = Inferred | Specified | Required
+  deriving (Eq, Ord, Data)
+  -- (<) on ArgFlag means "is less visible than"
+
+-- | Does this 'ArgFlag' classify an argument that is written in Haskell?
+isVisibleArgFlag :: ArgFlag -> Bool
+isVisibleArgFlag Required = True
+isVisibleArgFlag _        = False
+
+-- | Does this 'ArgFlag' classify an argument that is not written in Haskell?
+isInvisibleArgFlag :: ArgFlag -> Bool
+isInvisibleArgFlag = not . isVisibleArgFlag
+
+-- | Do these denote the same level of visibility? 'Required'
+-- arguments are visible, others are not. So this function
+-- equates 'Specified' and 'Inferred'. Used for printing.
+sameVis :: ArgFlag -> ArgFlag -> Bool
+sameVis Required Required = True
+sameVis Required _        = False
+sameVis _        Required = False
+sameVis _        _        = True
+
+instance Outputable ArgFlag where
+  ppr Required  = text "[req]"
+  ppr Specified = text "[spec]"
+  ppr Inferred  = text "[infrd]"
+
+instance Binary ArgFlag where
+  put_ bh Required  = putByte bh 0
+  put_ bh Specified = putByte bh 1
+  put_ bh Inferred  = putByte bh 2
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> return Required
+      1 -> return Specified
+      _ -> return Inferred
+
+-- | The non-dependent version of 'ArgFlag'.
+
+-- Appears here partly so that it's together with its friend ArgFlag,
+-- but also because it is used in IfaceType, rather early in the
+-- compilation chain
+-- See Note [AnonArgFlag vs. ForallVisFlag]
+data AnonArgFlag
+  = VisArg    -- ^ Used for @(->)@: an ordinary non-dependent arrow.
+              --   The argument is visible in source code.
+  | InvisArg  -- ^ Used for @(=>)@: a non-dependent predicate arrow.
+              --   The argument is invisible in source code.
+  deriving (Eq, Ord, Data)
+
+instance Outputable AnonArgFlag where
+  ppr VisArg   = text "[vis]"
+  ppr InvisArg = text "[invis]"
+
+instance Binary AnonArgFlag where
+  put_ bh VisArg   = putByte bh 0
+  put_ bh InvisArg = putByte bh 1
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> return VisArg
+      _ -> return InvisArg
+
+-- | Is a @forall@ invisible (e.g., @forall a b. {...}@, with a dot) or visible
+-- (e.g., @forall a b -> {...}@, with an arrow)?
+
+-- See Note [AnonArgFlag vs. ForallVisFlag]
+data ForallVisFlag
+  = ForallVis   -- ^ A visible @forall@ (with an arrow)
+  | ForallInvis -- ^ An invisible @forall@ (with a dot)
+  deriving (Eq, Ord, Data)
+
+instance Outputable ForallVisFlag where
+  ppr f = text $ case f of
+                   ForallVis   -> "ForallVis"
+                   ForallInvis -> "ForallInvis"
+
+-- | Convert an 'ArgFlag' to its corresponding 'ForallVisFlag'.
+argToForallVisFlag :: ArgFlag -> ForallVisFlag
+argToForallVisFlag Required  = ForallVis
+argToForallVisFlag Specified = ForallInvis
+argToForallVisFlag Inferred  = ForallInvis
+
+{-
+Note [AnonArgFlag vs. ForallVisFlag]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The AnonArgFlag and ForallVisFlag data types are quite similar at a first
+glance:
+
+  data AnonArgFlag   = VisArg    | InvisArg
+  data ForallVisFlag = ForallVis | ForallInvis
+
+Both data types keep track of visibility of some sort. AnonArgFlag tracks
+whether a FunTy has a visible argument (->) or an invisible predicate argument
+(=>). ForallVisFlag tracks whether a `forall` quantifier is visible
+(forall a -> {...}) or invisible (forall a. {...}).
+
+Given their similarities, it's tempting to want to combine these two data types
+into one, but they actually represent distinct concepts. AnonArgFlag reflects a
+property of *Core* types, whereas ForallVisFlag reflects a property of the GHC
+AST. In other words, AnonArgFlag is all about internals, whereas ForallVisFlag
+is all about surface syntax. Therefore, they are kept as separate data types.
+-}
+
+{- *********************************************************************
+*                                                                      *
+*                   VarBndr, TyCoVarBinder
+*                                                                      *
+********************************************************************* -}
+
+-- Variable Binder
+--
+-- VarBndr is polymorphic in both var and visibility fields.
+-- Currently there are six different uses of 'VarBndr':
+--   * Var.TyVarBinder   = VarBndr TyVar ArgFlag
+--   * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag
+--   * TyCon.TyConBinder     = VarBndr TyVar TyConBndrVis
+--   * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis
+--   * IfaceType.IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag
+--   * IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
+data VarBndr var argf = Bndr var argf
+  deriving( Data )
+
+-- | Variable Binder
+--
+-- A 'TyCoVarBinder' is the binder of a ForAllTy
+-- It's convenient to define this synonym here rather its natural
+-- home in GHC.Core.TyCo.Rep, because it's used in GHC.Core.DataCon.hs-boot
+--
+-- A 'TyVarBinder' is a binder with only TyVar
+type TyCoVarBinder = VarBndr TyCoVar ArgFlag
+type TyVarBinder   = VarBndr TyVar ArgFlag
+
+binderVar :: VarBndr tv argf -> tv
+binderVar (Bndr v _) = v
+
+binderVars :: [VarBndr tv argf] -> [tv]
+binderVars tvbs = map binderVar tvbs
+
+binderArgFlag :: VarBndr tv argf -> argf
+binderArgFlag (Bndr _ argf) = argf
+
+binderType :: VarBndr TyCoVar argf -> Type
+binderType (Bndr tv _) = varType tv
+
+-- | Make a named binder
+mkTyCoVarBinder :: ArgFlag -> TyCoVar -> TyCoVarBinder
+mkTyCoVarBinder vis var = Bndr var vis
+
+-- | Make a named binder
+-- 'var' should be a type variable
+mkTyVarBinder :: ArgFlag -> TyVar -> TyVarBinder
+mkTyVarBinder vis var
+  = ASSERT( isTyVar var )
+    Bndr var vis
+
+-- | Make many named binders
+mkTyCoVarBinders :: ArgFlag -> [TyCoVar] -> [TyCoVarBinder]
+mkTyCoVarBinders vis = map (mkTyCoVarBinder vis)
+
+-- | Make many named binders
+-- Input vars should be type variables
+mkTyVarBinders :: ArgFlag -> [TyVar] -> [TyVarBinder]
+mkTyVarBinders vis = map (mkTyVarBinder vis)
+
+isTyVarBinder :: TyCoVarBinder -> Bool
+isTyVarBinder (Bndr v _) = isTyVar v
+
+instance Outputable tv => Outputable (VarBndr tv ArgFlag) where
+  ppr (Bndr v Required)  = ppr v
+  ppr (Bndr v Specified) = char '@' <> ppr v
+  ppr (Bndr v Inferred)  = braces (ppr v)
+
+instance (Binary tv, Binary vis) => Binary (VarBndr tv vis) where
+  put_ bh (Bndr tv vis) = do { put_ bh tv; put_ bh vis }
+
+  get bh = do { tv <- get bh; vis <- get bh; return (Bndr tv vis) }
+
+instance NamedThing tv => NamedThing (VarBndr tv flag) where
+  getName (Bndr tv _) = getName tv
+
+{-
+************************************************************************
+*                                                                      *
+*                 Type and kind variables                              *
+*                                                                      *
+************************************************************************
+-}
+
+tyVarName :: TyVar -> Name
+tyVarName = varName
+
+tyVarKind :: TyVar -> Kind
+tyVarKind = varType
+
+setTyVarUnique :: TyVar -> Unique -> TyVar
+setTyVarUnique = setVarUnique
+
+setTyVarName :: TyVar -> Name -> TyVar
+setTyVarName   = setVarName
+
+setTyVarKind :: TyVar -> Kind -> TyVar
+setTyVarKind tv k = tv {varType = k}
+
+updateTyVarKind :: (Kind -> Kind) -> TyVar -> TyVar
+updateTyVarKind update tv = tv {varType = update (tyVarKind tv)}
+
+updateTyVarKindM :: (Monad m) => (Kind -> m Kind) -> TyVar -> m TyVar
+updateTyVarKindM update tv
+  = do { k' <- update (tyVarKind tv)
+       ; return $ tv {varType = k'} }
+
+mkTyVar :: Name -> Kind -> TyVar
+mkTyVar name kind = TyVar { varName    = name
+                          , realUnique = getKey (nameUnique name)
+                          , varType  = kind
+                          }
+
+mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
+mkTcTyVar name kind details
+  = -- NB: 'kind' may be a coercion kind; cf, 'TcMType.newMetaCoVar'
+    TcTyVar {   varName    = name,
+                realUnique = getKey (nameUnique name),
+                varType  = kind,
+                tc_tv_details = details
+        }
+
+tcTyVarDetails :: TyVar -> TcTyVarDetails
+-- See Note [TcTyVars in the typechecker] in TcType
+tcTyVarDetails (TcTyVar { tc_tv_details = details }) = details
+tcTyVarDetails (TyVar {})                            = vanillaSkolemTv
+tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var <+> dcolon <+> pprKind (tyVarKind var))
+
+setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
+setTcTyVarDetails tv details = tv { tc_tv_details = details }
+
+{-
+%************************************************************************
+%*                                                                      *
+\subsection{Ids}
+*                                                                      *
+************************************************************************
+-}
+
+idInfo :: HasDebugCallStack => Id -> IdInfo
+idInfo (Id { id_info = info }) = info
+idInfo other                   = pprPanic "idInfo" (ppr other)
+
+idDetails :: Id -> IdDetails
+idDetails (Id { id_details = details }) = details
+idDetails other                         = pprPanic "idDetails" (ppr other)
+
+-- The next three have a 'Var' suffix even though they always build
+-- Ids, because Id.hs uses 'mkGlobalId' etc with different types
+mkGlobalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkGlobalVar details name ty info
+  = mk_id name ty GlobalId details info
+
+mkLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkLocalVar details name ty info
+  = mk_id name ty (LocalId NotExported) details  info
+
+mkCoVar :: Name -> Type -> CoVar
+-- Coercion variables have no IdInfo
+mkCoVar name ty = mk_id name ty (LocalId NotExported) coVarDetails vanillaIdInfo
+
+-- | Exported 'Var's will not be removed as dead code
+mkExportedLocalVar :: IdDetails -> Name -> Type -> IdInfo -> Id
+mkExportedLocalVar details name ty info
+  = mk_id name ty (LocalId Exported) details info
+
+mk_id :: Name -> Type -> IdScope -> IdDetails -> IdInfo -> Id
+mk_id name ty scope details info
+  = Id { varName    = name,
+         realUnique = getKey (nameUnique name),
+         varType    = ty,
+         idScope    = scope,
+         id_details = details,
+         id_info    = info }
+
+-------------------
+lazySetIdInfo :: Id -> IdInfo -> Var
+lazySetIdInfo id info = id { id_info = info }
+
+setIdDetails :: Id -> IdDetails -> Id
+setIdDetails id details = id { id_details = details }
+
+globaliseId :: Id -> Id
+-- ^ If it's a local, make it global
+globaliseId id = id { idScope = GlobalId }
+
+setIdExported :: Id -> Id
+-- ^ Exports the given local 'Id'. Can also be called on global 'Id's, such as data constructors
+-- and class operations, which are born as global 'Id's and automatically exported
+setIdExported id@(Id { idScope = LocalId {} }) = id { idScope = LocalId Exported }
+setIdExported id@(Id { idScope = GlobalId })   = id
+setIdExported tv                               = pprPanic "setIdExported" (ppr tv)
+
+setIdNotExported :: Id -> Id
+-- ^ We can only do this to LocalIds
+setIdNotExported id = ASSERT( isLocalId id )
+                      id { idScope = LocalId NotExported }
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Predicates over variables}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Is this a type-level (i.e., computationally irrelevant, thus erasable)
+-- variable? Satisfies @isTyVar = not . isId@.
+isTyVar :: Var -> Bool        -- True of both TyVar and TcTyVar
+isTyVar (TyVar {})   = True
+isTyVar (TcTyVar {}) = True
+isTyVar _            = False
+
+isTcTyVar :: Var -> Bool      -- True of TcTyVar only
+isTcTyVar (TcTyVar {}) = True
+isTcTyVar _            = False
+
+isTyCoVar :: Var -> Bool
+isTyCoVar v = isTyVar v || isCoVar v
+
+-- | Is this a value-level (i.e., computationally relevant) 'Id'entifier?
+-- Satisfies @isId = not . isTyVar@.
+isId :: Var -> Bool
+isId (Id {}) = True
+isId _       = False
+
+-- | Is this a coercion variable?
+-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@.
+isCoVar :: Var -> Bool
+isCoVar (Id { id_details = details }) = isCoVarDetails details
+isCoVar _                             = False
+
+-- | Is this a term variable ('Id') that is /not/ a coercion variable?
+-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@.
+isNonCoVarId :: Var -> Bool
+isNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details)
+isNonCoVarId _                             = False
+
+isLocalId :: Var -> Bool
+isLocalId (Id { idScope = LocalId _ }) = True
+isLocalId _                            = False
+
+-- | 'isLocalVar' returns @True@ for type variables as well as local 'Id's
+-- These are the variables that we need to pay attention to when finding free
+-- variables, or doing dependency analysis.
+isLocalVar :: Var -> Bool
+isLocalVar v = not (isGlobalId v)
+
+isGlobalId :: Var -> Bool
+isGlobalId (Id { idScope = GlobalId }) = True
+isGlobalId _                           = False
+
+-- | 'mustHaveLocalBinding' returns @True@ of 'Id's and 'TyVar's
+-- that must have a binding in this module.  The converse
+-- is not quite right: there are some global 'Id's that must have
+-- bindings, such as record selectors.  But that doesn't matter,
+-- because it's only used for assertions
+mustHaveLocalBinding        :: Var -> Bool
+mustHaveLocalBinding var = isLocalVar var
+
+-- | 'isExportedIdVar' means \"don't throw this away\"
+isExportedId :: Var -> Bool
+isExportedId (Id { idScope = GlobalId })        = True
+isExportedId (Id { idScope = LocalId Exported}) = True
+isExportedId _ = False
diff --git a/compiler/GHC/Types/Var.hs-boot b/compiler/GHC/Types/Var.hs-boot
new file mode 100644
index 0000000000..bf83f8cda6
--- /dev/null
+++ b/compiler/GHC/Types/Var.hs-boot
@@ -0,0 +1,14 @@
+module GHC.Types.Var where
+
+import GhcPrelude ()
+  -- We compile this module with -XNoImplicitPrelude (for some
+  -- reason), so if there are no imports it does not seem to
+  -- depend on anything.  But it does! We must, for example,
+  -- compile GHC.Types in the ghc-prim library first.
+  -- So this otherwise-unnecessary import tells the build system
+  -- that this module depends on GhcPrelude, which ensures
+  -- that GHC.Type is built first.
+
+data ArgFlag
+data AnonArgFlag
+data Var
diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs
new file mode 100644
index 0000000000..fff3dc897d
--- /dev/null
+++ b/compiler/GHC/Types/Var/Env.hs
@@ -0,0 +1,632 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+module GHC.Types.Var.Env (
+        -- * Var, Id and TyVar environments (maps)
+        VarEnv, IdEnv, TyVarEnv, CoVarEnv, TyCoVarEnv,
+
+        -- ** Manipulating these environments
+        emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
+        elemVarEnv, disjointVarEnv,
+        extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
+        extendVarEnvList,
+        plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
+        plusVarEnvList, alterVarEnv,
+        delVarEnvList, delVarEnv, delVarEnv_Directly,
+        minusVarEnv, intersectsVarEnv,
+        lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
+        mapVarEnv, zipVarEnv,
+        modifyVarEnv, modifyVarEnv_Directly,
+        isEmptyVarEnv,
+        elemVarEnvByKey, lookupVarEnv_Directly,
+        filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
+        partitionVarEnv,
+
+        -- * Deterministic Var environments (maps)
+        DVarEnv, DIdEnv, DTyVarEnv,
+
+        -- ** Manipulating these environments
+        emptyDVarEnv, mkDVarEnv,
+        dVarEnvElts,
+        extendDVarEnv, extendDVarEnv_C,
+        extendDVarEnvList,
+        lookupDVarEnv, elemDVarEnv,
+        isEmptyDVarEnv, foldDVarEnv,
+        mapDVarEnv, filterDVarEnv,
+        modifyDVarEnv,
+        alterDVarEnv,
+        plusDVarEnv, plusDVarEnv_C,
+        unitDVarEnv,
+        delDVarEnv,
+        delDVarEnvList,
+        minusDVarEnv,
+        partitionDVarEnv,
+        anyDVarEnv,
+
+        -- * The InScopeSet type
+        InScopeSet,
+
+        -- ** Operations on InScopeSets
+        emptyInScopeSet, mkInScopeSet, delInScopeSet,
+        extendInScopeSet, extendInScopeSetList, extendInScopeSetSet,
+        getInScopeVars, lookupInScope, lookupInScope_Directly,
+        unionInScope, elemInScopeSet, uniqAway,
+        varSetInScope,
+        unsafeGetFreshLocalUnique,
+
+        -- * The RnEnv2 type
+        RnEnv2,
+
+        -- ** Operations on RnEnv2s
+        mkRnEnv2, rnBndr2, rnBndrs2, rnBndr2_var,
+        rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe,
+        rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap,
+        delBndrL, delBndrR, delBndrsL, delBndrsR,
+        addRnInScopeSet,
+        rnEtaL, rnEtaR,
+        rnInScope, rnInScopeSet, lookupRnInScope,
+        rnEnvL, rnEnvR,
+
+        -- * TidyEnv and its operation
+        TidyEnv,
+        emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList
+    ) where
+
+import GhcPrelude
+import qualified Data.IntMap.Strict as IntMap -- TODO: Move this to UniqFM
+
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name
+import GHC.Types.Var as Var
+import GHC.Types.Var.Set
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import GHC.Types.Unique
+import Util
+import Maybes
+import Outputable
+
+{-
+************************************************************************
+*                                                                      *
+                In-scope sets
+*                                                                      *
+************************************************************************
+-}
+
+-- | A set of variables that are in scope at some point
+-- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides
+-- the motivation for this abstraction.
+newtype InScopeSet = InScope VarSet
+        -- Note [Lookups in in-scope set]
+        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+        -- We store a VarSet here, but we use this for lookups rather than just
+        -- membership tests. Typically the InScopeSet contains the canonical
+        -- version of the variable (e.g. with an informative unfolding), so this
+        -- lookup is useful (see, for instance, Note [In-scope set as a
+        -- substitution]).
+
+instance Outputable InScopeSet where
+  ppr (InScope s) =
+    text "InScope" <+>
+    braces (fsep (map (ppr . Var.varName) (nonDetEltsUniqSet s)))
+                      -- It's OK to use nonDetEltsUniqSet here because it's
+                      -- only for pretty printing
+                      -- In-scope sets get big, and with -dppr-debug
+                      -- the output is overwhelming
+
+emptyInScopeSet :: InScopeSet
+emptyInScopeSet = InScope emptyVarSet
+
+getInScopeVars ::  InScopeSet -> VarSet
+getInScopeVars (InScope vs) = vs
+
+mkInScopeSet :: VarSet -> InScopeSet
+mkInScopeSet in_scope = InScope in_scope
+
+extendInScopeSet :: InScopeSet -> Var -> InScopeSet
+extendInScopeSet (InScope in_scope) v
+   = InScope (extendVarSet in_scope v)
+
+extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
+extendInScopeSetList (InScope in_scope) vs
+   = InScope $ foldl' extendVarSet in_scope vs
+
+extendInScopeSetSet :: InScopeSet -> VarSet -> InScopeSet
+extendInScopeSetSet (InScope in_scope) vs
+   = InScope (in_scope `unionVarSet` vs)
+
+delInScopeSet :: InScopeSet -> Var -> InScopeSet
+delInScopeSet (InScope in_scope) v = InScope (in_scope `delVarSet` v)
+
+elemInScopeSet :: Var -> InScopeSet -> Bool
+elemInScopeSet v (InScope in_scope) = v `elemVarSet` in_scope
+
+-- | Look up a variable the 'InScopeSet'.  This lets you map from
+-- the variable's identity (unique) to its full value.
+lookupInScope :: InScopeSet -> Var -> Maybe Var
+lookupInScope (InScope in_scope) v  = lookupVarSet in_scope v
+
+lookupInScope_Directly :: InScopeSet -> Unique -> Maybe Var
+lookupInScope_Directly (InScope in_scope) uniq
+  = lookupVarSet_Directly in_scope uniq
+
+unionInScope :: InScopeSet -> InScopeSet -> InScopeSet
+unionInScope (InScope s1) (InScope s2)
+  = InScope (s1 `unionVarSet` s2)
+
+varSetInScope :: VarSet -> InScopeSet -> Bool
+varSetInScope vars (InScope s1) = vars `subVarSet` s1
+
+{-
+Note [Local uniques]
+~~~~~~~~~~~~~~~~~~~~
+Sometimes one must create conjure up a unique which is unique in a particular
+context (but not necessarily globally unique). For instance, one might need to
+create a fresh local identifier which does not shadow any of the locally
+in-scope variables.  For this we purpose we provide 'uniqAway'.
+
+'uniqAway' is implemented in terms of the 'unsafeGetFreshLocalUnique'
+operation, which generates an unclaimed 'Unique' from an 'InScopeSet'. To
+ensure that we do not conflict with uniques allocated by future allocations
+from 'UniqSupply's, Uniques generated by 'unsafeGetFreshLocalUnique' are
+allocated into a dedicated region of the unique space (namely the X tag).
+
+Note that one must be quite carefully when using uniques generated in this way
+since they are only locally unique. In particular, two successive calls to
+'uniqAway' on the same 'InScopeSet' will produce the same unique.
+ -}
+
+-- | @uniqAway in_scope v@ finds a unique that is not used in the
+-- in-scope set, and gives that to v. See Note [Local uniques].
+uniqAway :: InScopeSet -> Var -> Var
+-- It starts with v's current unique, of course, in the hope that it won't
+-- have to change, and thereafter uses the successor to the last derived unique
+-- found in the in-scope set.
+uniqAway in_scope var
+  | var `elemInScopeSet` in_scope = uniqAway' in_scope var      -- Make a new one
+  | otherwise                     = var                         -- Nothing to do
+
+uniqAway' :: InScopeSet -> Var -> Var
+-- This one *always* makes up a new variable
+uniqAway' in_scope var
+  = setVarUnique var (unsafeGetFreshLocalUnique in_scope)
+
+-- | @unsafeGetFreshUnique in_scope@ finds a unique that is not in-scope in the
+-- given 'InScopeSet'. This must be used very carefully since one can very easily
+-- introduce non-unique 'Unique's this way. See Note [Local uniques].
+unsafeGetFreshLocalUnique :: InScopeSet -> Unique
+unsafeGetFreshLocalUnique (InScope set)
+  | Just (uniq,_) <- IntMap.lookupLT (getKey maxLocalUnique) (ufmToIntMap $ getUniqSet set)
+  , let uniq' = mkLocalUnique uniq
+  , not $ uniq' `ltUnique` minLocalUnique
+  = incrUnique uniq'
+
+  | otherwise
+  = minLocalUnique
+
+{-
+************************************************************************
+*                                                                      *
+                Dual renaming
+*                                                                      *
+************************************************************************
+-}
+
+-- | Rename Environment 2
+--
+-- When we are comparing (or matching) types or terms, we are faced with
+-- \"going under\" corresponding binders.  E.g. when comparing:
+--
+-- > \x. e1     ~   \y. e2
+--
+-- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of
+-- things we must be careful of.  In particular, @x@ might be free in @e2@, or
+-- y in @e1@.  So the idea is that we come up with a fresh binder that is free
+-- in neither, and rename @x@ and @y@ respectively.  That means we must maintain:
+--
+-- 1. A renaming for the left-hand expression
+--
+-- 2. A renaming for the right-hand expressions
+--
+-- 3. An in-scope set
+--
+-- Furthermore, when matching, we want to be able to have an 'occurs check',
+-- to prevent:
+--
+-- > \x. f   ~   \y. y
+--
+-- matching with [@f@ -> @y@].  So for each expression we want to know that set of
+-- locally-bound variables. That is precisely the domain of the mappings 1.
+-- and 2., but we must ensure that we always extend the mappings as we go in.
+--
+-- All of this information is bundled up in the 'RnEnv2'
+data RnEnv2
+  = RV2 { envL     :: VarEnv Var        -- Renaming for Left term
+        , envR     :: VarEnv Var        -- Renaming for Right term
+        , in_scope :: InScopeSet }      -- In scope in left or right terms
+
+-- The renamings envL and envR are *guaranteed* to contain a binding
+-- for every variable bound as we go into the term, even if it is not
+-- renamed.  That way we can ask what variables are locally bound
+-- (inRnEnvL, inRnEnvR)
+
+mkRnEnv2 :: InScopeSet -> RnEnv2
+mkRnEnv2 vars = RV2     { envL     = emptyVarEnv
+                        , envR     = emptyVarEnv
+                        , in_scope = vars }
+
+addRnInScopeSet :: RnEnv2 -> VarSet -> RnEnv2
+addRnInScopeSet env vs
+  | isEmptyVarSet vs = env
+  | otherwise        = env { in_scope = extendInScopeSetSet (in_scope env) vs }
+
+rnInScope :: Var -> RnEnv2 -> Bool
+rnInScope x env = x `elemInScopeSet` in_scope env
+
+rnInScopeSet :: RnEnv2 -> InScopeSet
+rnInScopeSet = in_scope
+
+-- | Retrieve the left mapping
+rnEnvL :: RnEnv2 -> VarEnv Var
+rnEnvL = envL
+
+-- | Retrieve the right mapping
+rnEnvR :: RnEnv2 -> VarEnv Var
+rnEnvR = envR
+
+rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
+-- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal length
+rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR
+
+rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
+-- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,
+--                       and binder @bR@ in the Right term.
+-- It finds a new binder, @new_b@,
+-- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@
+rnBndr2 env bL bR = fst $ rnBndr2_var env bL bR
+
+rnBndr2_var :: RnEnv2 -> Var -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but returns the new variable as well as the
+-- new environment
+rnBndr2_var (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
+  = (RV2 { envL            = extendVarEnv envL bL new_b   -- See Note
+         , envR            = extendVarEnv envR bR new_b   -- [Rebinding]
+         , in_scope = extendInScopeSet in_scope new_b }, new_b)
+  where
+        -- Find a new binder not in scope in either term
+    new_b | not (bL `elemInScopeSet` in_scope) = bL
+          | not (bR `elemInScopeSet` in_scope) = bR
+          | otherwise                          = uniqAway' in_scope bL
+
+        -- Note [Rebinding]
+        -- If the new var is the same as the old one, note that
+        -- the extendVarEnv *deletes* any current renaming
+        -- E.g.   (\x. \x. ...)  ~  (\y. \z. ...)
+        --
+        --   Inside \x  \y      { [x->y], [y->y],       {y} }
+        --       \x  \z         { [x->x], [y->y, z->x], {y,x} }
+
+rnBndrL :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but used when there's a binder on the left
+-- side only.
+rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
+  = (RV2 { envL     = extendVarEnv envL bL new_b
+         , envR     = envR
+         , in_scope = extendInScopeSet in_scope new_b }, new_b)
+  where
+    new_b = uniqAway in_scope bL
+
+rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but used when there's a binder on the right
+-- side only.
+rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
+  = (RV2 { envR     = extendVarEnv envR bR new_b
+         , envL     = envL
+         , in_scope = extendInScopeSet in_scope new_b }, new_b)
+  where
+    new_b = uniqAway in_scope bR
+
+rnEtaL :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndrL' but used for eta expansion
+-- See Note [Eta expansion]
+rnEtaL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
+  = (RV2 { envL     = extendVarEnv envL bL new_b
+         , envR     = extendVarEnv envR new_b new_b     -- Note [Eta expansion]
+         , in_scope = extendInScopeSet in_scope new_b }, new_b)
+  where
+    new_b = uniqAway in_scope bL
+
+rnEtaR :: RnEnv2 -> Var -> (RnEnv2, Var)
+-- ^ Similar to 'rnBndr2' but used for eta expansion
+-- See Note [Eta expansion]
+rnEtaR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
+  = (RV2 { envL     = extendVarEnv envL new_b new_b     -- Note [Eta expansion]
+         , envR     = extendVarEnv envR bR new_b
+         , in_scope = extendInScopeSet in_scope new_b }, new_b)
+  where
+    new_b = uniqAway in_scope bR
+
+delBndrL, delBndrR :: RnEnv2 -> Var -> RnEnv2
+delBndrL rn@(RV2 { envL = env, in_scope = in_scope }) v
+  = rn { envL = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
+delBndrR rn@(RV2 { envR = env, in_scope = in_scope }) v
+  = rn { envR = env `delVarEnv` v, in_scope = in_scope `extendInScopeSet` v }
+
+delBndrsL, delBndrsR :: RnEnv2 -> [Var] -> RnEnv2
+delBndrsL rn@(RV2 { envL = env, in_scope = in_scope }) v
+  = rn { envL = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
+delBndrsR rn@(RV2 { envR = env, in_scope = in_scope }) v
+  = rn { envR = env `delVarEnvList` v, in_scope = in_scope `extendInScopeSetList` v }
+
+rnOccL, rnOccR :: RnEnv2 -> Var -> Var
+-- ^ Look up the renaming of an occurrence in the left or right term
+rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
+rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
+
+rnOccL_maybe, rnOccR_maybe :: RnEnv2 -> Var -> Maybe Var
+-- ^ Look up the renaming of an occurrence in the left or right term
+rnOccL_maybe (RV2 { envL = env }) v = lookupVarEnv env v
+rnOccR_maybe (RV2 { envR = env }) v = lookupVarEnv env v
+
+inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
+-- ^ Tells whether a variable is locally bound
+inRnEnvL (RV2 { envL = env }) v = v `elemVarEnv` env
+inRnEnvR (RV2 { envR = env }) v = v `elemVarEnv` env
+
+lookupRnInScope :: RnEnv2 -> Var -> Var
+lookupRnInScope env v = lookupInScope (in_scope env) v `orElse` v
+
+nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
+-- ^ Wipe the left or right side renaming
+nukeRnEnvL env = env { envL = emptyVarEnv }
+nukeRnEnvR env = env { envR = emptyVarEnv }
+
+rnSwap :: RnEnv2 -> RnEnv2
+-- ^ swap the meaning of left and right
+rnSwap (RV2 { envL = envL, envR = envR, in_scope = in_scope })
+  = RV2 { envL = envR, envR = envL, in_scope = in_scope }
+
+{-
+Note [Eta expansion]
+~~~~~~~~~~~~~~~~~~~~
+When matching
+     (\x.M) ~ N
+we rename x to x' with, where x' is not in scope in
+either term.  Then we want to behave as if we'd seen
+     (\x'.M) ~ (\x'.N x')
+Since x' isn't in scope in N, the form (\x'. N x') doesn't
+capture any variables in N.  But we must nevertheless extend
+the envR with a binding [x' -> x'], to support the occurs check.
+For example, if we don't do this, we can get silly matches like
+        forall a.  (\y.a)  ~   v
+succeeding with [a -> v y], which is bogus of course.
+
+
+************************************************************************
+*                                                                      *
+                Tidying
+*                                                                      *
+************************************************************************
+-}
+
+-- | Tidy Environment
+--
+-- When tidying up print names, we keep a mapping of in-scope occ-names
+-- (the 'TidyOccEnv') and a Var-to-Var of the current renamings
+type TidyEnv = (TidyOccEnv, VarEnv Var)
+
+emptyTidyEnv :: TidyEnv
+emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
+
+mkEmptyTidyEnv :: TidyOccEnv -> TidyEnv
+mkEmptyTidyEnv occ_env = (occ_env, emptyVarEnv)
+
+delTidyEnvList :: TidyEnv -> [Var] -> TidyEnv
+delTidyEnvList (occ_env, var_env) vs = (occ_env', var_env')
+  where
+    occ_env' = occ_env `delTidyOccEnvList` map (occNameFS . getOccName) vs
+    var_env' = var_env `delVarEnvList` vs
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{@VarEnv@s}
+*                                                                      *
+************************************************************************
+-}
+
+-- | Variable Environment
+type VarEnv elt     = UniqFM elt
+
+-- | Identifier Environment
+type IdEnv elt      = VarEnv elt
+
+-- | Type Variable Environment
+type TyVarEnv elt   = VarEnv elt
+
+-- | Type or Coercion Variable Environment
+type TyCoVarEnv elt = VarEnv elt
+
+-- | Coercion Variable Environment
+type CoVarEnv elt   = VarEnv elt
+
+emptyVarEnv       :: VarEnv a
+mkVarEnv          :: [(Var, a)] -> VarEnv a
+mkVarEnv_Directly :: [(Unique, a)] -> VarEnv a
+zipVarEnv         :: [Var] -> [a] -> VarEnv a
+unitVarEnv        :: Var -> a -> VarEnv a
+alterVarEnv       :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
+extendVarEnv      :: VarEnv a -> Var -> a -> VarEnv a
+extendVarEnv_C    :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
+extendVarEnv_Acc  :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
+extendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a
+plusVarEnv        :: VarEnv a -> VarEnv a -> VarEnv a
+plusVarEnvList    :: [VarEnv a] -> VarEnv a
+extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
+
+lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
+filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
+delVarEnv_Directly    :: VarEnv a -> Unique -> VarEnv a
+partitionVarEnv   :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
+restrictVarEnv    :: VarEnv a -> VarSet -> VarEnv a
+delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
+delVarEnv         :: VarEnv a -> Var -> VarEnv a
+minusVarEnv       :: VarEnv a -> VarEnv b -> VarEnv a
+intersectsVarEnv  :: VarEnv a -> VarEnv a -> Bool
+plusVarEnv_C      :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
+plusVarEnv_CD     :: (a -> a -> a) -> VarEnv a -> a -> VarEnv a -> a -> VarEnv a
+plusMaybeVarEnv_C :: (a -> a -> Maybe a) -> VarEnv a -> VarEnv a -> VarEnv a
+mapVarEnv         :: (a -> b) -> VarEnv a -> VarEnv b
+modifyVarEnv      :: (a -> a) -> VarEnv a -> Var -> VarEnv a
+
+isEmptyVarEnv     :: VarEnv a -> Bool
+lookupVarEnv      :: VarEnv a -> Var -> Maybe a
+filterVarEnv      :: (a -> Bool) -> VarEnv a -> VarEnv a
+lookupVarEnv_NF   :: VarEnv a -> Var -> a
+lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
+elemVarEnv        :: Var -> VarEnv a -> Bool
+elemVarEnvByKey   :: Unique -> VarEnv a -> Bool
+disjointVarEnv    :: VarEnv a -> VarEnv a -> Bool
+
+elemVarEnv       = elemUFM
+elemVarEnvByKey  = elemUFM_Directly
+disjointVarEnv   = disjointUFM
+alterVarEnv      = alterUFM
+extendVarEnv     = addToUFM
+extendVarEnv_C   = addToUFM_C
+extendVarEnv_Acc = addToUFM_Acc
+extendVarEnv_Directly = addToUFM_Directly
+extendVarEnvList = addListToUFM
+plusVarEnv_C     = plusUFM_C
+plusVarEnv_CD    = plusUFM_CD
+plusMaybeVarEnv_C = plusMaybeUFM_C
+delVarEnvList    = delListFromUFM
+delVarEnv        = delFromUFM
+minusVarEnv      = minusUFM
+intersectsVarEnv e1 e2 = not (isEmptyVarEnv (e1 `intersectUFM` e2))
+plusVarEnv       = plusUFM
+plusVarEnvList   = plusUFMList
+lookupVarEnv     = lookupUFM
+filterVarEnv     = filterUFM
+lookupWithDefaultVarEnv = lookupWithDefaultUFM
+mapVarEnv        = mapUFM
+mkVarEnv         = listToUFM
+mkVarEnv_Directly= listToUFM_Directly
+emptyVarEnv      = emptyUFM
+unitVarEnv       = unitUFM
+isEmptyVarEnv    = isNullUFM
+lookupVarEnv_Directly = lookupUFM_Directly
+filterVarEnv_Directly = filterUFM_Directly
+delVarEnv_Directly    = delFromUFM_Directly
+partitionVarEnv       = partitionUFM
+
+restrictVarEnv env vs = filterVarEnv_Directly keep env
+  where
+    keep u _ = u `elemVarSetByKey` vs
+
+zipVarEnv tyvars tys   = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
+lookupVarEnv_NF env id = case lookupVarEnv env id of
+                         Just xx -> xx
+                         Nothing -> panic "lookupVarEnv_NF: Nothing"
+
+{-
+@modifyVarEnv@: Look up a thing in the VarEnv,
+then mash it with the modify function, and put it back.
+-}
+
+modifyVarEnv mangle_fn env key
+  = case (lookupVarEnv env key) of
+      Nothing -> env
+      Just xx -> extendVarEnv env key (mangle_fn xx)
+
+modifyVarEnv_Directly :: (a -> a) -> UniqFM a -> Unique -> UniqFM a
+modifyVarEnv_Directly mangle_fn env key
+  = case (lookupUFM_Directly env key) of
+      Nothing -> env
+      Just xx -> addToUFM_Directly env key (mangle_fn xx)
+
+-- Deterministic VarEnv
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why we need
+-- DVarEnv.
+
+-- | Deterministic Variable Environment
+type DVarEnv elt = UniqDFM elt
+
+-- | Deterministic Identifier Environment
+type DIdEnv elt = DVarEnv elt
+
+-- | Deterministic Type Variable Environment
+type DTyVarEnv elt = DVarEnv elt
+
+emptyDVarEnv :: DVarEnv a
+emptyDVarEnv = emptyUDFM
+
+dVarEnvElts :: DVarEnv a -> [a]
+dVarEnvElts = eltsUDFM
+
+mkDVarEnv :: [(Var, a)] -> DVarEnv a
+mkDVarEnv = listToUDFM
+
+extendDVarEnv :: DVarEnv a -> Var -> a -> DVarEnv a
+extendDVarEnv = addToUDFM
+
+minusDVarEnv :: DVarEnv a -> DVarEnv a' -> DVarEnv a
+minusDVarEnv = minusUDFM
+
+lookupDVarEnv :: DVarEnv a -> Var -> Maybe a
+lookupDVarEnv = lookupUDFM
+
+foldDVarEnv :: (a -> b -> b) -> b -> DVarEnv a -> b
+foldDVarEnv = foldUDFM
+
+mapDVarEnv :: (a -> b) -> DVarEnv a -> DVarEnv b
+mapDVarEnv = mapUDFM
+
+filterDVarEnv      :: (a -> Bool) -> DVarEnv a -> DVarEnv a
+filterDVarEnv = filterUDFM
+
+alterDVarEnv :: (Maybe a -> Maybe a) -> DVarEnv a -> Var -> DVarEnv a
+alterDVarEnv = alterUDFM
+
+plusDVarEnv :: DVarEnv a -> DVarEnv a -> DVarEnv a
+plusDVarEnv = plusUDFM
+
+plusDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> DVarEnv a -> DVarEnv a
+plusDVarEnv_C = plusUDFM_C
+
+unitDVarEnv :: Var -> a -> DVarEnv a
+unitDVarEnv = unitUDFM
+
+delDVarEnv :: DVarEnv a -> Var -> DVarEnv a
+delDVarEnv = delFromUDFM
+
+delDVarEnvList :: DVarEnv a -> [Var] -> DVarEnv a
+delDVarEnvList = delListFromUDFM
+
+isEmptyDVarEnv :: DVarEnv a -> Bool
+isEmptyDVarEnv = isNullUDFM
+
+elemDVarEnv :: Var -> DVarEnv a -> Bool
+elemDVarEnv = elemUDFM
+
+extendDVarEnv_C :: (a -> a -> a) -> DVarEnv a -> Var -> a -> DVarEnv a
+extendDVarEnv_C = addToUDFM_C
+
+modifyDVarEnv :: (a -> a) -> DVarEnv a -> Var -> DVarEnv a
+modifyDVarEnv mangle_fn env key
+  = case (lookupDVarEnv env key) of
+      Nothing -> env
+      Just xx -> extendDVarEnv env key (mangle_fn xx)
+
+partitionDVarEnv :: (a -> Bool) -> DVarEnv a -> (DVarEnv a, DVarEnv a)
+partitionDVarEnv = partitionUDFM
+
+extendDVarEnvList :: DVarEnv a -> [(Var, a)] -> DVarEnv a
+extendDVarEnvList = addListToUDFM
+
+anyDVarEnv :: (a -> Bool) -> DVarEnv a -> Bool
+anyDVarEnv = anyUDFM
diff --git a/compiler/GHC/Types/Var/Set.hs b/compiler/GHC/Types/Var/Set.hs
new file mode 100644
index 0000000000..5126988a2c
--- /dev/null
+++ b/compiler/GHC/Types/Var/Set.hs
@@ -0,0 +1,354 @@
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+{-# LANGUAGE CPP #-}
+
+module GHC.Types.Var.Set (
+        -- * Var, Id and TyVar set types
+        VarSet, IdSet, TyVarSet, CoVarSet, TyCoVarSet,
+
+        -- ** Manipulating these sets
+        emptyVarSet, unitVarSet, mkVarSet,
+        extendVarSet, extendVarSetList,
+        elemVarSet, subVarSet,
+        unionVarSet, unionVarSets, mapUnionVarSet,
+        intersectVarSet, intersectsVarSet, disjointVarSet,
+        isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
+        minusVarSet, filterVarSet, mapVarSet,
+        anyVarSet, allVarSet,
+        transCloVarSet, fixVarSet,
+        lookupVarSet_Directly, lookupVarSet, lookupVarSetByName,
+        sizeVarSet, seqVarSet,
+        elemVarSetByKey, partitionVarSet,
+        pluralVarSet, pprVarSet,
+        nonDetFoldVarSet,
+
+        -- * Deterministic Var set types
+        DVarSet, DIdSet, DTyVarSet, DTyCoVarSet,
+
+        -- ** Manipulating these sets
+        emptyDVarSet, unitDVarSet, mkDVarSet,
+        extendDVarSet, extendDVarSetList,
+        elemDVarSet, dVarSetElems, subDVarSet,
+        unionDVarSet, unionDVarSets, mapUnionDVarSet,
+        intersectDVarSet, dVarSetIntersectVarSet,
+        intersectsDVarSet, disjointDVarSet,
+        isEmptyDVarSet, delDVarSet, delDVarSetList,
+        minusDVarSet, foldDVarSet, filterDVarSet, mapDVarSet,
+        dVarSetMinusVarSet, anyDVarSet, allDVarSet,
+        transCloDVarSet,
+        sizeDVarSet, seqDVarSet,
+        partitionDVarSet,
+        dVarSetToVarSet,
+    ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Types.Var      ( Var, TyVar, CoVar, TyCoVar, Id )
+import GHC.Types.Unique
+import GHC.Types.Name     ( Name )
+import GHC.Types.Unique.Set
+import GHC.Types.Unique.DSet
+import GHC.Types.Unique.FM( disjointUFM, pluralUFM, pprUFM )
+import GHC.Types.Unique.DFM( disjointUDFM, udfmToUfm, anyUDFM, allUDFM )
+import Outputable (SDoc)
+
+-- | A non-deterministic Variable Set
+--
+-- A non-deterministic set of variables.
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why it's not
+-- deterministic and why it matters. Use DVarSet if the set eventually
+-- gets converted into a list or folded over in a way where the order
+-- changes the generated code, for example when abstracting variables.
+type VarSet       = UniqSet Var
+
+-- | Identifier Set
+type IdSet        = UniqSet Id
+
+-- | Type Variable Set
+type TyVarSet     = UniqSet TyVar
+
+-- | Coercion Variable Set
+type CoVarSet     = UniqSet CoVar
+
+-- | Type or Coercion Variable Set
+type TyCoVarSet   = UniqSet TyCoVar
+
+emptyVarSet     :: VarSet
+intersectVarSet :: VarSet -> VarSet -> VarSet
+unionVarSet     :: VarSet -> VarSet -> VarSet
+unionVarSets    :: [VarSet] -> VarSet
+
+mapUnionVarSet  :: (a -> VarSet) -> [a] -> VarSet
+-- ^ map the function over the list, and union the results
+
+unitVarSet      :: Var -> VarSet
+extendVarSet    :: VarSet -> Var -> VarSet
+extendVarSetList:: VarSet -> [Var] -> VarSet
+elemVarSet      :: Var -> VarSet -> Bool
+delVarSet       :: VarSet -> Var -> VarSet
+delVarSetList   :: VarSet -> [Var] -> VarSet
+minusVarSet     :: VarSet -> VarSet -> VarSet
+isEmptyVarSet   :: VarSet -> Bool
+mkVarSet        :: [Var] -> VarSet
+lookupVarSet_Directly :: VarSet -> Unique -> Maybe Var
+lookupVarSet    :: VarSet -> Var -> Maybe Var
+                        -- Returns the set element, which may be
+                        -- (==) to the argument, but not the same as
+lookupVarSetByName :: VarSet -> Name -> Maybe Var
+sizeVarSet      :: VarSet -> Int
+filterVarSet    :: (Var -> Bool) -> VarSet -> VarSet
+
+delVarSetByKey  :: VarSet -> Unique -> VarSet
+elemVarSetByKey :: Unique -> VarSet -> Bool
+partitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)
+
+emptyVarSet     = emptyUniqSet
+unitVarSet      = unitUniqSet
+extendVarSet    = addOneToUniqSet
+extendVarSetList= addListToUniqSet
+intersectVarSet = intersectUniqSets
+
+intersectsVarSet:: VarSet -> VarSet -> Bool     -- True if non-empty intersection
+disjointVarSet  :: VarSet -> VarSet -> Bool     -- True if empty intersection
+subVarSet       :: VarSet -> VarSet -> Bool     -- True if first arg is subset of second
+        -- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty;
+        -- ditto disjointVarSet, subVarSet
+
+unionVarSet     = unionUniqSets
+unionVarSets    = unionManyUniqSets
+elemVarSet      = elementOfUniqSet
+minusVarSet     = minusUniqSet
+delVarSet       = delOneFromUniqSet
+delVarSetList   = delListFromUniqSet
+isEmptyVarSet   = isEmptyUniqSet
+mkVarSet        = mkUniqSet
+lookupVarSet_Directly = lookupUniqSet_Directly
+lookupVarSet    = lookupUniqSet
+lookupVarSetByName = lookupUniqSet
+sizeVarSet      = sizeUniqSet
+filterVarSet    = filterUniqSet
+delVarSetByKey  = delOneFromUniqSet_Directly
+elemVarSetByKey = elemUniqSet_Directly
+partitionVarSet = partitionUniqSet
+
+mapUnionVarSet get_set xs = foldr (unionVarSet . get_set) emptyVarSet xs
+
+-- See comments with type signatures
+intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
+disjointVarSet   s1 s2 = disjointUFM (getUniqSet s1) (getUniqSet s2)
+subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
+
+anyVarSet :: (Var -> Bool) -> VarSet -> Bool
+anyVarSet = uniqSetAny
+
+allVarSet :: (Var -> Bool) -> VarSet -> Bool
+allVarSet = uniqSetAll
+
+mapVarSet :: Uniquable b => (a -> b) -> UniqSet a -> UniqSet b
+mapVarSet = mapUniqSet
+
+nonDetFoldVarSet :: (Var -> a -> a) -> a -> VarSet -> a
+nonDetFoldVarSet = nonDetFoldUniqSet
+
+fixVarSet :: (VarSet -> VarSet)   -- Map the current set to a new set
+          -> VarSet -> VarSet
+-- (fixVarSet f s) repeatedly applies f to the set s,
+-- until it reaches a fixed point.
+fixVarSet fn vars
+  | new_vars `subVarSet` vars = vars
+  | otherwise                 = fixVarSet fn new_vars
+  where
+    new_vars = fn vars
+
+transCloVarSet :: (VarSet -> VarSet)
+                  -- Map some variables in the set to
+                  -- extra variables that should be in it
+               -> VarSet -> VarSet
+-- (transCloVarSet f s) repeatedly applies f to new candidates, adding any
+-- new variables to s that it finds thereby, until it reaches a fixed point.
+--
+-- The function fn could be (Var -> VarSet), but we use (VarSet -> VarSet)
+-- for efficiency, so that the test can be batched up.
+-- It's essential that fn will work fine if given new candidates
+-- one at a time; ie  fn {v1,v2} = fn v1 `union` fn v2
+-- Use fixVarSet if the function needs to see the whole set all at once
+transCloVarSet fn seeds
+  = go seeds seeds
+  where
+    go :: VarSet  -- Accumulating result
+       -> VarSet  -- Work-list; un-processed subset of accumulating result
+       -> VarSet
+    -- Specification: go acc vs = acc `union` transClo fn vs
+
+    go acc candidates
+       | isEmptyVarSet new_vs = acc
+       | otherwise            = go (acc `unionVarSet` new_vs) new_vs
+       where
+         new_vs = fn candidates `minusVarSet` acc
+
+seqVarSet :: VarSet -> ()
+seqVarSet s = sizeVarSet s `seq` ()
+
+-- | Determines the pluralisation suffix appropriate for the length of a set
+-- in the same way that plural from Outputable does for lists.
+pluralVarSet :: VarSet -> SDoc
+pluralVarSet = pluralUFM . getUniqSet
+
+-- | Pretty-print a non-deterministic set.
+-- The order of variables is non-deterministic and for pretty-printing that
+-- shouldn't be a problem.
+-- Having this function helps contain the non-determinism created with
+-- nonDetEltsUFM.
+-- Passing a list to the pretty-printing function allows the caller
+-- to decide on the order of Vars (eg. toposort them) without them having
+-- to use nonDetEltsUFM at the call site. This prevents from let-binding
+-- non-deterministically ordered lists and reusing them where determinism
+-- matters.
+pprVarSet :: VarSet          -- ^ The things to be pretty printed
+          -> ([Var] -> SDoc) -- ^ The pretty printing function to use on the
+                             -- elements
+          -> SDoc            -- ^ 'SDoc' where the things have been pretty
+                             -- printed
+pprVarSet = pprUFM . getUniqSet
+
+-- Deterministic VarSet
+-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why we need
+-- DVarSet.
+
+-- | Deterministic Variable Set
+type DVarSet     = UniqDSet Var
+
+-- | Deterministic Identifier Set
+type DIdSet      = UniqDSet Id
+
+-- | Deterministic Type Variable Set
+type DTyVarSet   = UniqDSet TyVar
+
+-- | Deterministic Type or Coercion Variable Set
+type DTyCoVarSet = UniqDSet TyCoVar
+
+emptyDVarSet :: DVarSet
+emptyDVarSet = emptyUniqDSet
+
+unitDVarSet :: Var -> DVarSet
+unitDVarSet = unitUniqDSet
+
+mkDVarSet :: [Var] -> DVarSet
+mkDVarSet = mkUniqDSet
+
+-- The new element always goes to the right of existing ones.
+extendDVarSet :: DVarSet -> Var -> DVarSet
+extendDVarSet = addOneToUniqDSet
+
+elemDVarSet :: Var -> DVarSet -> Bool
+elemDVarSet = elementOfUniqDSet
+
+dVarSetElems :: DVarSet -> [Var]
+dVarSetElems = uniqDSetToList
+
+subDVarSet :: DVarSet -> DVarSet -> Bool
+subDVarSet s1 s2 = isEmptyDVarSet (s1 `minusDVarSet` s2)
+
+unionDVarSet :: DVarSet -> DVarSet -> DVarSet
+unionDVarSet = unionUniqDSets
+
+unionDVarSets :: [DVarSet] -> DVarSet
+unionDVarSets = unionManyUniqDSets
+
+-- | Map the function over the list, and union the results
+mapUnionDVarSet  :: (a -> DVarSet) -> [a] -> DVarSet
+mapUnionDVarSet get_set xs = foldr (unionDVarSet . get_set) emptyDVarSet xs
+
+intersectDVarSet :: DVarSet -> DVarSet -> DVarSet
+intersectDVarSet = intersectUniqDSets
+
+dVarSetIntersectVarSet :: DVarSet -> VarSet -> DVarSet
+dVarSetIntersectVarSet = uniqDSetIntersectUniqSet
+
+-- | True if empty intersection
+disjointDVarSet :: DVarSet -> DVarSet -> Bool
+disjointDVarSet s1 s2 = disjointUDFM (getUniqDSet s1) (getUniqDSet s2)
+
+-- | True if non-empty intersection
+intersectsDVarSet :: DVarSet -> DVarSet -> Bool
+intersectsDVarSet s1 s2 = not (s1 `disjointDVarSet` s2)
+
+isEmptyDVarSet :: DVarSet -> Bool
+isEmptyDVarSet = isEmptyUniqDSet
+
+delDVarSet :: DVarSet -> Var -> DVarSet
+delDVarSet = delOneFromUniqDSet
+
+minusDVarSet :: DVarSet -> DVarSet -> DVarSet
+minusDVarSet = minusUniqDSet
+
+dVarSetMinusVarSet :: DVarSet -> VarSet -> DVarSet
+dVarSetMinusVarSet = uniqDSetMinusUniqSet
+
+foldDVarSet :: (Var -> a -> a) -> a -> DVarSet -> a
+foldDVarSet = foldUniqDSet
+
+anyDVarSet :: (Var -> Bool) -> DVarSet -> Bool
+anyDVarSet p = anyUDFM p . getUniqDSet
+
+allDVarSet :: (Var -> Bool) -> DVarSet -> Bool
+allDVarSet p = allUDFM p . getUniqDSet
+
+mapDVarSet :: Uniquable b => (a -> b) -> UniqDSet a -> UniqDSet b
+mapDVarSet = mapUniqDSet
+
+filterDVarSet :: (Var -> Bool) -> DVarSet -> DVarSet
+filterDVarSet = filterUniqDSet
+
+sizeDVarSet :: DVarSet -> Int
+sizeDVarSet = sizeUniqDSet
+
+-- | Partition DVarSet according to the predicate given
+partitionDVarSet :: (Var -> Bool) -> DVarSet -> (DVarSet, DVarSet)
+partitionDVarSet = partitionUniqDSet
+
+-- | Delete a list of variables from DVarSet
+delDVarSetList :: DVarSet -> [Var] -> DVarSet
+delDVarSetList = delListFromUniqDSet
+
+seqDVarSet :: DVarSet -> ()
+seqDVarSet s = sizeDVarSet s `seq` ()
+
+-- | Add a list of variables to DVarSet
+extendDVarSetList :: DVarSet -> [Var] -> DVarSet
+extendDVarSetList = addListToUniqDSet
+
+-- | Convert a DVarSet to a VarSet by forgetting the order of insertion
+dVarSetToVarSet :: DVarSet -> VarSet
+dVarSetToVarSet = unsafeUFMToUniqSet . udfmToUfm . getUniqDSet
+
+-- | transCloVarSet for DVarSet
+transCloDVarSet :: (DVarSet -> DVarSet)
+                  -- Map some variables in the set to
+                  -- extra variables that should be in it
+                -> DVarSet -> DVarSet
+-- (transCloDVarSet f s) repeatedly applies f to new candidates, adding any
+-- new variables to s that it finds thereby, until it reaches a fixed point.
+--
+-- The function fn could be (Var -> DVarSet), but we use (DVarSet -> DVarSet)
+-- for efficiency, so that the test can be batched up.
+-- It's essential that fn will work fine if given new candidates
+-- one at a time; ie  fn {v1,v2} = fn v1 `union` fn v2
+transCloDVarSet fn seeds
+  = go seeds seeds
+  where
+    go :: DVarSet  -- Accumulating result
+       -> DVarSet  -- Work-list; un-processed subset of accumulating result
+       -> DVarSet
+    -- Specification: go acc vs = acc `union` transClo fn vs
+
+    go acc candidates
+       | isEmptyDVarSet new_vs = acc
+       | otherwise            = go (acc `unionDVarSet` new_vs) new_vs
+       where
+         new_vs = fn candidates `minusDVarSet` acc
diff --git a/compiler/GHC/Utils/Lexeme.hs b/compiler/GHC/Utils/Lexeme.hs
new file mode 100644
index 0000000000..2ea773a2f0
--- /dev/null
+++ b/compiler/GHC/Utils/Lexeme.hs
@@ -0,0 +1,240 @@
+-- (c) The GHC Team
+--
+-- Functions to evaluate whether or not a string is a valid identifier.
+-- There is considerable overlap between the logic here and the logic
+-- in Lexer.x, but sadly there seems to be no way to merge them.
+
+module GHC.Utils.Lexeme (
+          -- * Lexical characteristics of Haskell names
+
+          -- | Use these functions to figure what kind of name a 'FastString'
+          -- represents; these functions do /not/ check that the identifier
+          -- is valid.
+
+        isLexCon, isLexVar, isLexId, isLexSym,
+        isLexConId, isLexConSym, isLexVarId, isLexVarSym,
+        startsVarSym, startsVarId, startsConSym, startsConId,
+
+          -- * Validating identifiers
+
+          -- | These functions (working over plain old 'String's) check
+          -- to make sure that the identifier is valid.
+        okVarOcc, okConOcc, okTcOcc,
+        okVarIdOcc, okVarSymOcc, okConIdOcc, okConSymOcc
+
+        -- Some of the exports above are not used within GHC, but may
+        -- be of value to GHC API users.
+
+  ) where
+
+import GhcPrelude
+
+import FastString
+
+import Data.Char
+import qualified Data.Set as Set
+
+import GHC.Lexeme
+
+{-
+
+************************************************************************
+*                                                                      *
+    Lexical categories
+*                                                                      *
+************************************************************************
+
+These functions test strings to see if they fit the lexical categories
+defined in the Haskell report.
+
+Note [Classification of generated names]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Some names generated for internal use can show up in debugging output,
+e.g.  when using -ddump-simpl. These generated names start with a $
+but should still be pretty-printed using prefix notation. We make sure
+this is the case in isLexVarSym by only classifying a name as a symbol
+if all its characters are symbols, not just its first one.
+-}
+
+isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
+isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
+
+isLexCon cs = isLexConId  cs || isLexConSym cs
+isLexVar cs = isLexVarId  cs || isLexVarSym cs
+
+isLexId  cs = isLexConId  cs || isLexVarId  cs
+isLexSym cs = isLexConSym cs || isLexVarSym cs
+
+-------------
+isLexConId cs                           -- Prefix type or data constructors
+  | nullFS cs          = False          --      e.g. "Foo", "[]", "(,)"
+  | cs == (fsLit "[]") = True
+  | otherwise          = startsConId (headFS cs)
+
+isLexVarId cs                           -- Ordinary prefix identifiers
+  | nullFS cs         = False           --      e.g. "x", "_x"
+  | otherwise         = startsVarId (headFS cs)
+
+isLexConSym cs                          -- Infix type or data constructors
+  | nullFS cs          = False          --      e.g. ":-:", ":", "->"
+  | cs == (fsLit "->") = True
+  | otherwise          = startsConSym (headFS cs)
+
+isLexVarSym fs                          -- Infix identifiers e.g. "+"
+  | fs == (fsLit "~R#") = True
+  | otherwise
+  = case (if nullFS fs then [] else unpackFS fs) of
+      [] -> False
+      (c:cs) -> startsVarSym c && all isVarSymChar cs
+        -- See Note [Classification of generated names]
+
+{-
+
+************************************************************************
+*                                                                      *
+    Detecting valid names for Template Haskell
+*                                                                      *
+************************************************************************
+
+-}
+
+----------------------
+-- External interface
+----------------------
+
+-- | Is this an acceptable variable name?
+okVarOcc :: String -> Bool
+okVarOcc str@(c:_)
+  | startsVarId c
+  = okVarIdOcc str
+  | startsVarSym c
+  = okVarSymOcc str
+okVarOcc _ = False
+
+-- | Is this an acceptable constructor name?
+okConOcc :: String -> Bool
+okConOcc str@(c:_)
+  | startsConId c
+  = okConIdOcc str
+  | startsConSym c
+  = okConSymOcc str
+  | str == "[]"
+  = True
+okConOcc _ = False
+
+-- | Is this an acceptable type name?
+okTcOcc :: String -> Bool
+okTcOcc "[]" = True
+okTcOcc "->" = True
+okTcOcc "~"  = True
+okTcOcc str@(c:_)
+  | startsConId c
+  = okConIdOcc str
+  | startsConSym c
+  = okConSymOcc str
+  | startsVarSym c
+  = okVarSymOcc str
+okTcOcc _ = False
+
+-- | Is this an acceptable alphanumeric variable name, assuming it starts
+-- with an acceptable letter?
+okVarIdOcc :: String -> Bool
+okVarIdOcc str = okIdOcc str &&
+                 -- admit "_" as a valid identifier.  Required to support typed
+                 -- holes in Template Haskell.  See #10267
+                 (str == "_" || not (str `Set.member` reservedIds))
+
+-- | Is this an acceptable symbolic variable name, assuming it starts
+-- with an acceptable character?
+okVarSymOcc :: String -> Bool
+okVarSymOcc str = all okSymChar str &&
+                  not (str `Set.member` reservedOps) &&
+                  not (isDashes str)
+
+-- | Is this an acceptable alphanumeric constructor name, assuming it
+-- starts with an acceptable letter?
+okConIdOcc :: String -> Bool
+okConIdOcc str = okIdOcc str ||
+                 is_tuple_name1 True  str ||
+                   -- Is it a boxed tuple...
+                 is_tuple_name1 False str ||
+                   -- ...or an unboxed tuple (#12407)...
+                 is_sum_name1 str
+                   -- ...or an unboxed sum (#12514)?
+  where
+    -- check for tuple name, starting at the beginning
+    is_tuple_name1 True  ('(' : rest)       = is_tuple_name2 True  rest
+    is_tuple_name1 False ('(' : '#' : rest) = is_tuple_name2 False rest
+    is_tuple_name1 _     _                  = False
+
+    -- check for tuple tail
+    is_tuple_name2 True  ")"          = True
+    is_tuple_name2 False "#)"         = True
+    is_tuple_name2 boxed (',' : rest) = is_tuple_name2 boxed rest
+    is_tuple_name2 boxed (ws  : rest)
+      | isSpace ws                    = is_tuple_name2 boxed rest
+    is_tuple_name2 _     _            = False
+
+    -- check for sum name, starting at the beginning
+    is_sum_name1 ('(' : '#' : rest) = is_sum_name2 False rest
+    is_sum_name1 _                  = False
+
+    -- check for sum tail, only allowing at most one underscore
+    is_sum_name2 _          "#)"         = True
+    is_sum_name2 underscore ('|' : rest) = is_sum_name2 underscore rest
+    is_sum_name2 False      ('_' : rest) = is_sum_name2 True rest
+    is_sum_name2 underscore (ws  : rest)
+      | isSpace ws                       = is_sum_name2 underscore rest
+    is_sum_name2 _          _            = False
+
+-- | Is this an acceptable symbolic constructor name, assuming it
+-- starts with an acceptable character?
+okConSymOcc :: String -> Bool
+okConSymOcc ":" = True
+okConSymOcc str = all okSymChar str &&
+                  not (str `Set.member` reservedOps)
+
+----------------------
+-- Internal functions
+----------------------
+
+-- | Is this string an acceptable id, possibly with a suffix of hashes,
+-- but not worrying about case or clashing with reserved words?
+okIdOcc :: String -> Bool
+okIdOcc str
+  = let hashes = dropWhile okIdChar str in
+    all (== '#') hashes   -- -XMagicHash allows a suffix of hashes
+                          -- of course, `all` says "True" to an empty list
+
+-- | Is this character acceptable in an identifier (after the first letter)?
+-- See alexGetByte in Lexer.x
+okIdChar :: Char -> Bool
+okIdChar c = case generalCategory c of
+  UppercaseLetter -> True
+  LowercaseLetter -> True
+  TitlecaseLetter -> True
+  ModifierLetter  -> True -- See #10196
+  OtherLetter     -> True -- See #1103
+  NonSpacingMark  -> True -- See #7650
+  DecimalNumber   -> True
+  OtherNumber     -> True -- See #4373
+  _               -> c == '\'' || c == '_'
+
+-- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
+reservedIds :: Set.Set String
+reservedIds = Set.fromList [ "case", "class", "data", "default", "deriving"
+                           , "do", "else", "foreign", "if", "import", "in"
+                           , "infix", "infixl", "infixr", "instance", "let"
+                           , "module", "newtype", "of", "then", "type", "where"
+                           , "_" ]
+
+-- | All reserved operators. Taken from section 2.4 of the 2010 Report.
+reservedOps :: Set.Set String
+reservedOps = Set.fromList [ "..", ":", "::", "=", "\\", "|", "<-", "->"
+                           , "@", "~", "=>" ]
+
+-- | Does this string contain only dashes and has at least 2 of them?
+isDashes :: String -> Bool
+isDashes ('-' : '-' : rest) = all (== '-') rest
+isDashes _                  = False
author	Sylvain Henry <sylvain@haskus.fr>	2020-03-18 10:44:56 +0100
committer	Marge Bot <ben+marge-bot@smart-cactus.org>	2020-03-29 17:28:51 -0400
commit	1941ef4f050c0dfcb68229641fcbbde3a10f1072 (patch)
tree	8e25a61af77696d3022d35cc277b5db5af540f03 /compiler/GHC
parent	1c446220250dcada51d4bb33a0cc7d8ce572e8b6 (diff)
download	haskell-1941ef4f050c0dfcb68229641fcbbde3a10f1072.tar.gz