diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index b78883c42e20a2aef963476d2cda7a5ee7c56970..a46218665a03cd3d8cac9de9072f4386e9f24201 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -293,7 +293,7 @@ module GHC (
 
 #include "HsVersions.h"
 
-import GhcPrelude hiding (init)
+import GHC.Prelude hiding (init)
 
 import GHC.ByteCode.Types
 import GHC.Runtime.Eval
@@ -342,16 +342,16 @@ import GHC.SysTools
 import GHC.SysTools.BaseDir
 import GHC.Types.Annotations
 import GHC.Types.Module
-import Panic
+import GHC.Utils.Panic
 import GHC.Platform
-import Bag              ( listToBag )
-import ErrUtils
-import MonadUtils
-import Util
-import StringBuffer
-import Outputable
+import GHC.Data.Bag        ( listToBag )
+import GHC.Utils.Error
+import GHC.Utils.Monad
+import GHC.Utils.Misc
+import GHC.Data.StringBuffer
+import GHC.Utils.Outputable
 import GHC.Types.Basic
-import FastString
+import GHC.Data.FastString
 import qualified GHC.Parser as Parser
 import GHC.Parser.Lexer
 import GHC.Parser.Annotation
@@ -373,13 +373,13 @@ import Data.Typeable    ( Typeable )
 import Data.Word        ( Word8 )
 import Control.Monad
 import System.Exit      ( exitWith, ExitCode(..) )
-import Exception
+import GHC.Utils.Exception
 import Data.IORef
 import System.FilePath
 import Control.Concurrent
 import Control.Applicative ((<|>))
 
-import Maybes
+import GHC.Data.Maybe
 import System.IO.Error  ( isDoesNotExistError )
 import System.Environment ( getEnv )
 import System.Directory
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index 1b1bfdf7fe6480bb4aab870b3c937edb7bfe48ff..70a48dd350175fe20b4b5dee4df4cbf72820b82d 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -159,7 +159,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Module
 import GHC.Types.Name.Occurrence
@@ -167,7 +167,7 @@ import GHC.Types.Name.Reader
 import GHC.Types.Unique
 import GHC.Types.Name
 import GHC.Types.SrcLoc
-import FastString
+import GHC.Data.FastString
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
index 7f83cd7521a8c060649e6e4745f555bdd148502d..5123754c55f12c14feb2882e36dafe8712bed222 100644
--- a/compiler/GHC/Builtin/Names/TH.hs
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -6,7 +6,7 @@
 
 module GHC.Builtin.Names.TH where
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 import GHC.Builtin.Names( mk_known_key_name )
 import GHC.Types.Module( Module, mkModuleNameFS, mkModule, thUnitId )
@@ -14,7 +14,7 @@ import GHC.Types.Name( Name )
 import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName )
 import GHC.Types.Name.Reader( RdrName, nameRdrName )
 import GHC.Types.Unique
-import FastString
+import GHC.Data.FastString
 
 -- To add a name, do three things
 --
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index b6d7f898ef919d71c6fd7f65e5bed582404c84b7..1c53df523bec61b274002e726420cdd924773053 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -25,7 +25,7 @@ module GHC.Builtin.PrimOps (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
@@ -45,8 +45,8 @@ import GHC.Types.SrcLoc  ( wiredInSrcSpan )
 import GHC.Types.ForeignCall ( CLabelString )
 import GHC.Types.Unique  ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique )
 import GHC.Types.Module  ( UnitId )
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Builtin/PrimOps.hs-boot b/compiler/GHC/Builtin/PrimOps.hs-boot
index e9f913f602f3b47f0c8b82892a85b6da88e756d3..506e8bca600a3a508febd7ae17c5fcd9f5007f85 100644
--- a/compiler/GHC/Builtin/PrimOps.hs-boot
+++ b/compiler/GHC/Builtin/PrimOps.hs-boot
@@ -1,5 +1,5 @@
 module GHC.Builtin.PrimOps where
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 data PrimOp
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 2e4ba28b6a4c35d68fb72350ceaf4e48bac1d1a3..c1241fa7dd74225482da34cf61c5a95c0df955fa 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -130,7 +130,7 @@ module GHC.Builtin.Types (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Types.Id.Make ( mkDataConWorkId, mkDictSelId )
 
@@ -159,10 +159,10 @@ import GHC.Types.ForeignCall
 import GHC.Types.SrcLoc   ( noSrcSpan )
 import GHC.Types.Unique
 import Data.Array
-import FastString
-import Outputable
-import Util
-import BooleanFormula   ( mkAnd )
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
+import GHC.Data.BooleanFormula ( mkAnd )
 
 import qualified Data.ByteString.Char8 as BS
 
diff --git a/compiler/GHC/Builtin/Types/Literals.hs b/compiler/GHC/Builtin/Types/Literals.hs
index d5c1d209c6f673925ec4b0584160178d562d8b16..ef6fb962fd2dbd3ec9d24b012cfd2bb4de86d12c 100644
--- a/compiler/GHC/Builtin/Types/Literals.hs
+++ b/compiler/GHC/Builtin/Types/Literals.hs
@@ -21,10 +21,10 @@ module GHC.Builtin.Types.Literals
   , typeSymbolAppendTyCon
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Type
-import Pair
+import GHC.Data.Pair
 import GHC.Tc.Utils.TcType ( TcType, tcEqType )
 import GHC.Core.TyCon    ( TyCon, FamTyConFlav(..), mkFamilyTyCon
                          , Injectivity(..) )
@@ -33,7 +33,7 @@ import GHC.Tc.Types.Constraint ( Xi )
 import GHC.Core.Coercion.Axiom ( CoAxiomRule(..), BuiltInSynFamily(..), TypeEqn )
 import GHC.Types.Name          ( Name, BuiltInSyntax(..) )
 import GHC.Builtin.Types
-import GHC.Builtin.Types.Prim    ( mkTemplateAnonTyConBinders )
+import GHC.Builtin.Types.Prim  ( mkTemplateAnonTyConBinders )
 import GHC.Builtin.Names
                   ( gHC_TYPELITS
                   , gHC_TYPENATS
@@ -49,9 +49,7 @@ import GHC.Builtin.Names
                   , typeSymbolCmpTyFamNameKey
                   , typeSymbolAppendFamNameKey
                   )
-import FastString ( FastString
-                  , fsLit, nilFS, nullFS, unpackFS, mkFastString, appendFS
-                  )
+import GHC.Data.FastString
 import qualified Data.Map as Map
 import Data.Maybe ( isJust )
 import Control.Monad ( guard )
diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs
index 4bee18b9644d5766c7f0d04485c5111e43b7751a..e138780c44be130ceb7e5afcbc7ea535e59349ca 100644
--- a/compiler/GHC/Builtin/Types/Prim.hs
+++ b/compiler/GHC/Builtin/Types/Prim.hs
@@ -90,7 +90,7 @@ module GHC.Builtin.Types.Prim(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Builtin.Types
   ( runtimeRepTy, unboxedTupleKind, liftedTypeKind
@@ -116,8 +116,8 @@ import GHC.Core.TyCon
 import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Builtin.Names
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Core.TyCo.Rep -- Doesn't need special access, but this is easier to avoid
                          -- import loops which show up if you import Type instead
 
diff --git a/compiler/GHC/Builtin/Uniques.hs b/compiler/GHC/Builtin/Uniques.hs
index d73544378be07571d6662f81ae66fc5f96bbf2bb..5c0e29b7de1e6103208ffd76f4f7e3d9c6cca66e 100644
--- a/compiler/GHC/Builtin/Uniques.hs
+++ b/compiler/GHC/Builtin/Uniques.hs
@@ -26,17 +26,17 @@ module GHC.Builtin.Uniques
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Builtin.Types
 import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Types.Id
 import GHC.Types.Basic
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Name
-import Util
+import GHC.Utils.Misc
 
 import Data.Bits
 import Data.Maybe
diff --git a/compiler/GHC/Builtin/Uniques.hs-boot b/compiler/GHC/Builtin/Uniques.hs-boot
index f00490b53831df8a17437d0f9cc97c56fff0d818..3e24cd5a557e5343cac7f3c266489df3d5421b9e 100644
--- a/compiler/GHC/Builtin/Uniques.hs-boot
+++ b/compiler/GHC/Builtin/Uniques.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Builtin.Uniques where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Types.Unique
 import GHC.Types.Name
 import GHC.Types.Basic
diff --git a/compiler/GHC/Builtin/Utils.hs b/compiler/GHC/Builtin/Utils.hs
index 2b8b0bf69832c11b7e53831e4aad6692056201c7..dc03f051bbe43749963dcd7deba7bffcd64c1237 100644
--- a/compiler/GHC/Builtin/Utils.hs
+++ b/compiler/GHC/Builtin/Utils.hs
@@ -47,7 +47,7 @@ module GHC.Builtin.Utils (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Builtin.Uniques
 import GHC.Types.Unique ( isValidKnownKeyUnique )
@@ -63,14 +63,14 @@ import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.Id.Make
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
 import GHC.Driver.Types
 import GHC.Core.Class
 import GHC.Core.TyCon
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 import GHC.Builtin.Types.Literals ( typeNatTyCons )
 import GHC.Hs.Doc
 
diff --git a/compiler/GHC/ByteCode/Asm.hs b/compiler/GHC/ByteCode/Asm.hs
index f957215d3845468763421d5c1c946c2c461426b9..9ed02833948ec0904f38ef92641bcd69a65ee9eb 100644
--- a/compiler/GHC/ByteCode/Asm.hs
+++ b/compiler/GHC/ByteCode/Asm.hs
@@ -15,7 +15,7 @@ module GHC.ByteCode.Asm (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.ByteCode.Instr
 import GHC.ByteCode.InfoTable
@@ -28,13 +28,13 @@ import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Literal
 import GHC.Core.TyCon
-import FastString
+import GHC.Data.FastString
 import GHC.StgToCmm.Layout     ( ArgRep(..) )
 import GHC.Runtime.Heap.Layout
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique
 import GHC.Types.Unique.DSet
 
diff --git a/compiler/GHC/ByteCode/InfoTable.hs b/compiler/GHC/ByteCode/InfoTable.hs
index 93fc4970c4aebf6facadaaeba839087496530ef4..73f55f63cc9d539de34e1461523dfb087e38b2fb 100644
--- a/compiler/GHC/ByteCode/InfoTable.hs
+++ b/compiler/GHC/ByteCode/InfoTable.hs
@@ -9,7 +9,7 @@ module GHC.ByteCode.InfoTable ( mkITbls ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.ByteCode.Types
 import GHC.Runtime.Interpreter
@@ -22,8 +22,8 @@ import GHC.Core.TyCon       ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons
 import GHC.Types.RepType
 import GHC.StgToCmm.Layout  ( mkVirtConstrSizes )
 import GHC.StgToCmm.Closure ( tagForCon, NonVoid (..) )
-import Util
-import Panic
+import GHC.Utils.Misc
+import GHC.Utils.Panic
 
 {-
   Manufacturing of info tables for DataCons
diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index b473f418e3365a228516442311f5ecaedb347bcb..8aa78749aaa4d7d5e90ff71b6e833be276fc55b6 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -11,15 +11,15 @@ module GHC.ByteCode.Instr (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.ByteCode.Types
 import GHCi.RemoteTypes
 import GHCi.FFI (C_ffi_cif)
 import GHC.StgToCmm.Layout     ( ArgRep(..) )
 import GHC.Core.Ppr
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Name
 import GHC.Types.Unique
 import GHC.Types.Id
diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 9ad218e35e2c79fafb7e38b07cdd5e63c599c7b9..3b61d1f8896b21d5810a88690c8dae4df28a9bdd 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -18,7 +18,7 @@ module GHC.ByteCode.Linker (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHCi.RemoteTypes
 import GHCi.ResolvedBCO
@@ -32,10 +32,10 @@ import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Builtin.PrimOps
 import GHC.Types.Module
-import FastString
-import Panic
-import Outputable
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Panic
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 -- Standard libraries
 import Data.Array.Unboxed
diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index 7073da63c2abcb3b1baacdc8ef764e406e63ddc7..55ad6044477b18e79b14190e4b6343e79cc0edc4 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -13,13 +13,13 @@ module GHC.ByteCode.Types
   , CCostCentre
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Env
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.PrimOps
 import SizedSeq
 import GHC.Core.Type
diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs
index fe5109aa6fe82910b704589525dd4052712c5d4a..48ffd25f1b14b054690554751acce167d1ea3ddf 100644
--- a/compiler/GHC/Cmm.hs
+++ b/compiler/GHC/Cmm.hs
@@ -28,7 +28,7 @@ module GHC.Cmm (
      module GHC.Cmm.Expr,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Id
 import GHC.Types.CostCentre
@@ -41,7 +41,7 @@ import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
-import Outputable
+import GHC.Utils.Outputable
 import Data.ByteString (ByteString)
 
 -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Cmm/BlockId.hs b/compiler/GHC/Cmm/BlockId.hs
index e458c299023bf6378783905112649fe94dcc0dd2..e6396c8e8354bf7d59f8525a22c6b5d2ada81bf1 100644
--- a/compiler/GHC/Cmm/BlockId.hs
+++ b/compiler/GHC/Cmm/BlockId.hs
@@ -8,7 +8,7 @@ module GHC.Cmm.BlockId
   , blockLbl, infoTblLbl
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.CLabel
 import GHC.Types.Id.Info
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index c6969be7cae891639e17a5ffcc9d2a4a8a5ec45d..af1d7a6e98dd1006d1e63856fdee8fe0485b17e2 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -114,7 +114,7 @@ module GHC.Cmm.CLabel (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Id.Info
 import GHC.Types.Basic
@@ -125,12 +125,12 @@ import GHC.Types.Name
 import GHC.Types.Unique
 import GHC.Builtin.PrimOps
 import GHC.Types.CostCentre
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Driver.Session
 import GHC.Platform
 import GHC.Types.Unique.Set
-import Util
+import GHC.Utils.Misc
 import GHC.Core.Ppr ( {- instances -} )
 import GHC.CmmToAsm.Config
 
diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs
index 6cd66be30cf48ebde9e28419d7bcf47882e43f30..35f63661fae8b5483c59ccc37e24adff4cec0665 100644
--- a/compiler/GHC/Cmm/CallConv.hs
+++ b/compiler/GHC/Cmm/CallConv.hs
@@ -5,7 +5,7 @@ module GHC.Cmm.CallConv (
   realArgRegsCover
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.Expr
 import GHC.Runtime.Heap.Layout
@@ -14,7 +14,7 @@ import GHC.Cmm.Ppr () -- For Outputable instances
 
 import GHC.Driver.Session
 import GHC.Platform
-import Outputable
+import GHC.Utils.Outputable
 
 -- Calculate the 'GlobalReg' or stack locations for function call
 -- parameters as used by the Cmm calling convention.
diff --git a/compiler/GHC/Cmm/CommonBlockElim.hs b/compiler/GHC/Cmm/CommonBlockElim.hs
index 575e041e73384a756a725e64847ee2354bd5db5e..cc6cb2d40b3681ae117a2441339c31befb0f2704 100644
--- a/compiler/GHC/Cmm/CommonBlockElim.hs
+++ b/compiler/GHC/Cmm/CommonBlockElim.hs
@@ -6,7 +6,7 @@ module GHC.Cmm.CommonBlockElim
 where
 
 
-import GhcPrelude hiding (iterate, succ, unzip, zip)
+import GHC.Prelude hiding (iterate, succ, unzip, zip)
 
 import GHC.Cmm.BlockId
 import GHC.Cmm
@@ -23,8 +23,8 @@ import Data.Maybe (mapMaybe)
 import qualified Data.List as List
 import Data.Word
 import qualified Data.Map as M
-import Outputable
-import qualified TrieMap as TM
+import GHC.Utils.Outputable
+import qualified GHC.Data.TrieMap as TM
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
 import Control.Arrow (first, second)
diff --git a/compiler/GHC/Cmm/ContFlowOpt.hs b/compiler/GHC/Cmm/ContFlowOpt.hs
index 1e5459f460e2b458d756f3a16f19d4d8ec03a712..73c13d204082942618c78fe9756fc887de02b2b6 100644
--- a/compiler/GHC/Cmm/ContFlowOpt.hs
+++ b/compiler/GHC/Cmm/ContFlowOpt.hs
@@ -10,7 +10,7 @@ module GHC.Cmm.ContFlowOpt
     )
 where
 
-import GhcPrelude hiding (succ, unzip, zip)
+import GHC.Prelude hiding (succ, unzip, zip)
 
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
@@ -20,9 +20,9 @@ import GHC.Cmm.BlockId
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch (mapSwitchTargets, switchTargetsToList)
-import Maybes
-import Panic
-import Util
+import GHC.Data.Maybe
+import GHC.Utils.Panic
+import GHC.Utils.Misc
 
 import Control.Monad
 
diff --git a/compiler/GHC/Cmm/Dataflow.hs b/compiler/GHC/Cmm/Dataflow.hs
index d697240191888ed9db6fde3b740361265c7d0762..05a91fe649984aab20e384d4b353f0027f5ec16a 100644
--- a/compiler/GHC/Cmm/Dataflow.hs
+++ b/compiler/GHC/Cmm/Dataflow.hs
@@ -34,7 +34,7 @@ module GHC.Cmm.Dataflow
   )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm
 import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/Cmm/Dataflow/Block.hs b/compiler/GHC/Cmm/Dataflow/Block.hs
index ac567ca6054c43ae6fdce57e0272c8878ae2e97c..1fa8d4dfd668d44da2d3205f95601bab12423b9d 100644
--- a/compiler/GHC/Cmm/Dataflow/Block.hs
+++ b/compiler/GHC/Cmm/Dataflow/Block.hs
@@ -38,7 +38,7 @@ module GHC.Cmm.Dataflow.Block
     , replaceLastNode
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 -- -----------------------------------------------------------------------------
 -- Shapes: Open and Closed
diff --git a/compiler/GHC/Cmm/Dataflow/Collections.hs b/compiler/GHC/Cmm/Dataflow/Collections.hs
index bb762bf698230a6097885d5ad68b288abab2848a..1fb8f5d52c36a47a4769df267c802f560d5ba737 100644
--- a/compiler/GHC/Cmm/Dataflow/Collections.hs
+++ b/compiler/GHC/Cmm/Dataflow/Collections.hs
@@ -12,7 +12,7 @@ module GHC.Cmm.Dataflow.Collections
     , UniqueMap, UniqueSet
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified Data.IntMap.Strict as M
 import qualified Data.IntSet as S
diff --git a/compiler/GHC/Cmm/Dataflow/Graph.hs b/compiler/GHC/Cmm/Dataflow/Graph.hs
index de146c6a3520254f11c845851baa19c5f044ff6a..3fbdae85ecabd1d503fd8cf4e20dff675229d045 100644
--- a/compiler/GHC/Cmm/Dataflow/Graph.hs
+++ b/compiler/GHC/Cmm/Dataflow/Graph.hs
@@ -20,8 +20,8 @@ module GHC.Cmm.Dataflow.Graph
     ) where
 
 
-import GhcPrelude
-import Util
+import GHC.Prelude
+import GHC.Utils.Misc
 
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Dataflow.Block
diff --git a/compiler/GHC/Cmm/Dataflow/Label.hs b/compiler/GHC/Cmm/Dataflow/Label.hs
index 70027570d30da88d6fbe4a121879aa008a3cea1b..a63cc63ed8390f71b04d1753fcd90b67829b00d3 100644
--- a/compiler/GHC/Cmm/Dataflow/Label.hs
+++ b/compiler/GHC/Cmm/Dataflow/Label.hs
@@ -13,15 +13,15 @@ module GHC.Cmm.Dataflow.Label
     , mkHooplLabel
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 
 -- TODO: This should really just use GHC's Unique and Uniq{Set,FM}
 import GHC.Cmm.Dataflow.Collections
 
 import GHC.Types.Unique (Uniquable(..))
-import TrieMap
+import GHC.Data.TrieMap
 
 
 -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 99650e01ed3c57c018ef2ebd76234ba50e19a5f9..a3a7566a8b0df8ccbd75e51a584a658acb808a22 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -25,7 +25,7 @@ module GHC.Cmm.DebugBlock (
   UnwindExpr(..), toUnwindExpr
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Cmm.BlockId
@@ -33,12 +33,12 @@ import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Core
-import FastString      ( nilFS, mkFastString )
+import GHC.Data.FastString ( nilFS, mkFastString )
 import GHC.Types.Module
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Cmm.Ppr.Expr ( pprExpr )
 import GHC.Types.SrcLoc
-import Util            ( seqList )
+import GHC.Utils.Misc      ( seqList )
 
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
diff --git a/compiler/GHC/Cmm/Expr.hs b/compiler/GHC/Cmm/Expr.hs
index bb3fe2e2028a7c1a28b88830aac6ff391ff007d2..43d67346334fc97513485e1e414292fa85fa3cd8 100644
--- a/compiler/GHC/Cmm/Expr.hs
+++ b/compiler/GHC/Cmm/Expr.hs
@@ -31,7 +31,7 @@ module GHC.Cmm.Expr
     )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Cmm.BlockId
@@ -39,7 +39,7 @@ import GHC.Cmm.CLabel
 import GHC.Cmm.MachOp
 import GHC.Cmm.Type
 import GHC.Driver.Session
-import Outputable (panic)
+import GHC.Utils.Outputable (panic)
 import GHC.Types.Unique
 
 import Data.Set (Set)
diff --git a/compiler/GHC/Cmm/Graph.hs b/compiler/GHC/Cmm/Graph.hs
index 01fa4dc9550205ecfcefda60d68a75d9c115f4ff..edf51d8b7f2ee360c27253e117fe1653dff35027 100644
--- a/compiler/GHC/Cmm/Graph.hs
+++ b/compiler/GHC/Cmm/Graph.hs
@@ -21,7 +21,7 @@ module GHC.Cmm.Graph
   )
 where
 
-import GhcPrelude hiding ( (<*>) ) -- avoid importing (<*>)
+import GHC.Prelude hiding ( (<*>) ) -- avoid importing (<*>)
 
 import GHC.Cmm.BlockId
 import GHC.Cmm
@@ -32,13 +32,13 @@ import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.ForeignCall
-import OrdList
+import GHC.Data.OrdList
 import GHC.Runtime.Heap.Layout (ByteOff)
 import GHC.Types.Unique.Supply
-import Util
-import Panic
+import GHC.Utils.Misc
+import GHC.Utils.Panic
 
 
 -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index 4ccd06adac60e796fd95f6505d978b35851679ef..0c0fc98eb65b833b440a00dee8a7709857f92190 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -33,26 +33,26 @@ module GHC.Cmm.Info (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 import GHC.Runtime.Heap.Layout
 import GHC.Data.Bitmap
-import Stream (Stream)
-import qualified Stream
+import GHC.Data.Stream (Stream)
+import qualified GHC.Data.Stream as Stream
 import GHC.Cmm.Dataflow.Collections
 
 import GHC.Platform
-import Maybes
+import GHC.Data.Maybe
 import GHC.Driver.Session
-import ErrUtils (withTimingSilent)
-import Panic
+import GHC.Utils.Error (withTimingSilent)
+import GHC.Utils.Panic
 import GHC.Types.Unique.Supply
-import MonadUtils
-import Util
-import Outputable
+import GHC.Utils.Monad
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 
 import Data.ByteString (ByteString)
 import Data.Bits
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 8ee009f63846eefc225827082dd496523e7d4a49..bf936d41d9a5bd02ad93497c85c4c93b8f3711c7 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -8,7 +8,7 @@ module GHC.Cmm.Info.Build
   , SRTMap, srtMapNonCAFs
   ) where
 
-import GhcPrelude hiding (succ)
+import GHC.Prelude hiding (succ)
 
 import GHC.Types.Id
 import GHC.Types.Id.Info
@@ -20,13 +20,13 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
 import GHC.Types.Module
 import GHC.Platform
-import Digraph
+import GHC.Data.Graph.Directed
 import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Driver.Session
-import Maybes
-import Outputable
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
 import GHC.Runtime.Heap.Layout
 import GHC.Types.Unique.Supply
 import GHC.Types.CostCentre
diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index 4cf7fcfdc1fa208c31de263aff72c21652ccb040..232ab7934dd08597730ae08ed51ff59852162af7 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -3,7 +3,7 @@ module GHC.Cmm.LayoutStack (
        cmmLayoutStack, setInfoTableStackMap
   ) where
 
-import GhcPrelude hiding ((<*>))
+import GHC.Prelude hiding ((<*>))
 
 import GHC.StgToCmm.Utils      ( callerSaveVolatileRegs, newTemp  ) -- XXX layering violation
 import GHC.StgToCmm.Foreign    ( saveThreadState, loadThreadState ) -- XXX layering violation
@@ -25,14 +25,14 @@ import GHC.Cmm.Dataflow
 import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Label
 import GHC.Types.Unique.Supply
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 
 import GHC.Platform
 import GHC.Driver.Session
-import FastString
-import Outputable hiding ( isEmpty )
+import GHC.Data.FastString
+import GHC.Utils.Outputable hiding ( isEmpty )
 import qualified Data.Set as Set
 import Control.Monad.Fix
 import Data.Array as Array
diff --git a/compiler/GHC/Cmm/Lexer.x b/compiler/GHC/Cmm/Lexer.x
index d0fca50bd357c99dd0726540ad9d446bbbe6f8c5..010001cd2a078b48a0bb34fb923a184a0e5f184a 100644
--- a/compiler/GHC/Cmm/Lexer.x
+++ b/compiler/GHC/Cmm/Lexer.x
@@ -15,7 +15,7 @@ module GHC.Cmm.Lexer (
    CmmToken(..), cmmlex,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.Expr
 
@@ -23,10 +23,10 @@ import GHC.Parser.Lexer
 import GHC.Cmm.Monad
 import GHC.Types.SrcLoc
 import GHC.Types.Unique.FM
-import StringBuffer
-import FastString
+import GHC.Data.StringBuffer
+import GHC.Data.FastString
 import GHC.Parser.CharClass
-import Util
+import GHC.Utils.Misc
 --import TRACE
 
 import Data.Word
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs
index 3a96e82054c49e3698506a4a625b838dceedfd5d..aa3e3a896ec9c5a023b886226d3a38607338cb3c 100644
--- a/compiler/GHC/Cmm/Lint.hs
+++ b/compiler/GHC/Cmm/Lint.hs
@@ -11,7 +11,7 @@ module GHC.Cmm.Lint (
     cmmLint, cmmLintGraph
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Cmm.Dataflow.Block
@@ -23,7 +23,7 @@ import GHC.Cmm.Utils
 import GHC.Cmm.Liveness
 import GHC.Cmm.Switch (switchTargetsToList)
 import GHC.Cmm.Ppr () -- For Outputable instances
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Session
 
 import Control.Monad (ap)
diff --git a/compiler/GHC/Cmm/Liveness.hs b/compiler/GHC/Cmm/Liveness.hs
index 10d4ca8dfdeac651fd4acd7c4814181326b8056f..c229e48529790c7775c3436effaccdc8ae1e928a 100644
--- a/compiler/GHC/Cmm/Liveness.hs
+++ b/compiler/GHC/Cmm/Liveness.hs
@@ -12,7 +12,7 @@ module GHC.Cmm.Liveness
     )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Cmm.BlockId
@@ -23,8 +23,8 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow
 import GHC.Cmm.Dataflow.Label
 
-import Maybes
-import Outputable
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
 
 -----------------------------------------------------------------------------
 -- Calculating what variables are live on entry to a basic block
diff --git a/compiler/GHC/Cmm/MachOp.hs b/compiler/GHC/Cmm/MachOp.hs
index f1a1e9b69954075445fc59d66fff9a32b4ec2693..1b3dd2a53176cbf9ce99d2e7d65d91730761d1ff 100644
--- a/compiler/GHC/Cmm/MachOp.hs
+++ b/compiler/GHC/Cmm/MachOp.hs
@@ -28,11 +28,11 @@ module GHC.Cmm.MachOp
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Cmm.Type
-import Outputable
+import GHC.Utils.Outputable
 
 -----------------------------------------------------------------------------
 --              MachOp
diff --git a/compiler/GHC/Cmm/Monad.hs b/compiler/GHC/Cmm/Monad.hs
index d97df7719e003a8054d3372c5750a0dc0c20566b..27cf51af4f375c65e38a8bd5666c698878eaa56d 100644
--- a/compiler/GHC/Cmm/Monad.hs
+++ b/compiler/GHC/Cmm/Monad.hs
@@ -13,7 +13,7 @@ module GHC.Cmm.Monad (
   , failMsgPD
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Control.Monad
 
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index d5d020ee00671cfa87a54fd7c1d2b29c98c7f3fa..5e13483faed2719fbff9ef2d35880bcbf136cfbc 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -26,15 +26,15 @@ module GHC.Cmm.Node (
      CmmTickScope(..), isTickSubScope, combineTickScopes,
   ) where
 
-import GhcPrelude hiding (succ)
+import GHC.Prelude hiding (succ)
 
 import GHC.Platform.Regs
 import GHC.Cmm.Expr
 import GHC.Cmm.Switch
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.ForeignCall
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Runtime.Heap.Layout
 import GHC.Core (Tickish)
 import qualified GHC.Types.Unique as U
@@ -46,7 +46,7 @@ import GHC.Cmm.Dataflow.Label
 import Data.Maybe
 import Data.List (tails,sortBy)
 import GHC.Types.Unique (nonDetCmpUnique)
-import Util
+import GHC.Utils.Misc
 
 
 ------------------------
diff --git a/compiler/GHC/Cmm/Opt.hs b/compiler/GHC/Cmm/Opt.hs
index a217f71c47f96eaea345f1c88b03024eb5e5435d..4ac24523c19a8f9627857ea53889e0ae8db7d99d 100644
--- a/compiler/GHC/Cmm/Opt.hs
+++ b/compiler/GHC/Cmm/Opt.hs
@@ -13,13 +13,13 @@ module GHC.Cmm.Opt (
         cmmMachOpFoldM
  ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.Utils
 import GHC.Cmm
-import Util
+import GHC.Utils.Misc
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Data.Bits
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 9ff637de706b69f09dcc8caf35c92653a3144bfd..7da85271f60272df2483fb7d86adaf8b7ab8d119 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -202,7 +202,7 @@ necessary to the stack to accommodate it (e.g. 2).
 
 module GHC.Cmm.Parser ( parseCmmFile ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.StgToCmm.ExtCode
 import GHC.Cmm.CallConv
@@ -243,14 +243,14 @@ import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.SrcLoc
 import GHC.Driver.Session
-import ErrUtils
-import StringBuffer
-import FastString
-import Panic
+import GHC.Utils.Error
+import GHC.Data.StringBuffer
+import GHC.Data.FastString
+import GHC.Utils.Panic
 import GHC.Settings.Constants
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Basic
-import Bag              ( emptyBag, unitBag )
+import GHC.Data.Bag     ( emptyBag, unitBag )
 import GHC.Types.Var
 
 import Control.Monad
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index e730cfda408cf285f7d2c6896e90f0ca059e9323..8d8deac91dccde2d6a9a16d15c4ab0274fa2f824 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -9,7 +9,7 @@ module GHC.Cmm.Pipeline (
   cmmPipeline
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm
 import GHC.Cmm.Lint
@@ -24,10 +24,10 @@ import GHC.Cmm.Dataflow.Collections
 
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Types
 import Control.Monad
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import Data.Either (partitionEithers)
 
diff --git a/compiler/GHC/Cmm/Ppr.hs b/compiler/GHC/Cmm/Ppr.hs
index d37b960c80edfbc8aa00611c40d6e4e0c9ae25f7..91bdfb40aa5ce8d3d37f06ffa7072c787f099472 100644
--- a/compiler/GHC/Cmm/Ppr.hs
+++ b/compiler/GHC/Cmm/Ppr.hs
@@ -40,7 +40,7 @@ module GHC.Cmm.Ppr
   )
 where
 
-import GhcPrelude hiding (succ)
+import GHC.Prelude hiding (succ)
 
 import GHC.Platform
 import GHC.Driver.Session (targetPlatform)
@@ -48,11 +48,11 @@ import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Cmm.Ppr.Decl
 import GHC.Cmm.Ppr.Expr
-import Util
+import GHC.Utils.Misc
 
 import GHC.Types.Basic
 import GHC.Cmm.Dataflow.Block
diff --git a/compiler/GHC/Cmm/Ppr/Decl.hs b/compiler/GHC/Cmm/Ppr/Decl.hs
index d6ec1882b2f6a98d1d7f4a78928be90d02582b26..43a341bf8513e2526893199c862324583b6b9a2e 100644
--- a/compiler/GHC/Cmm/Ppr/Decl.hs
+++ b/compiler/GHC/Cmm/Ppr/Decl.hs
@@ -40,15 +40,15 @@ module GHC.Cmm.Ppr.Decl
     )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Cmm.Ppr.Expr
 import GHC.Cmm
 
 import GHC.Driver.Session
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 
 import Data.List
 import System.IO
diff --git a/compiler/GHC/Cmm/Ppr/Expr.hs b/compiler/GHC/Cmm/Ppr/Expr.hs
index 9e25ededf6cf589135ed09877d2937cf91d7cefa..fb8e158a2d09b1a573c823bf2dee93202b968848 100644
--- a/compiler/GHC/Cmm/Ppr/Expr.hs
+++ b/compiler/GHC/Cmm/Ppr/Expr.hs
@@ -39,13 +39,13 @@ module GHC.Cmm.Ppr.Expr
     )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Driver.Session (targetPlatform)
 import GHC.Cmm.Expr
 
-import Outputable
+import GHC.Utils.Outputable
 
 import Data.Maybe
 import Numeric ( fromRat )
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 9017c0eb0cee95df13080fd10662964fdb8ab2e2..f9dc3a8334fa3678a20b2bf29c22e83a8fda79a0 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -9,7 +9,7 @@ module GHC.Cmm.ProcPoint
     )
 where
 
-import GhcPrelude hiding (last, unzip, succ, zip)
+import GHC.Prelude hiding (last, unzip, succ, zip)
 
 import GHC.Driver.Session
 import GHC.Cmm.BlockId
@@ -21,9 +21,9 @@ import GHC.Cmm.Info
 import GHC.Cmm.Liveness
 import GHC.Cmm.Switch
 import Data.List (sortBy)
-import Maybes
+import GHC.Data.Maybe
 import Control.Monad
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique.Supply
 import GHC.Cmm.Dataflow.Block
diff --git a/compiler/GHC/Cmm/Sink.hs b/compiler/GHC/Cmm/Sink.hs
index 3ca4fe9c7575c6fb28eca524afd3767490ac211b..8c32ab01aa337133b9581b339c2501b94c1cec0d 100644
--- a/compiler/GHC/Cmm/Sink.hs
+++ b/compiler/GHC/Cmm/Sink.hs
@@ -3,7 +3,7 @@ module GHC.Cmm.Sink (
      cmmSink
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm
 import GHC.Cmm.Opt
diff --git a/compiler/GHC/Cmm/Switch.hs b/compiler/GHC/Cmm/Switch.hs
index f297bd8b5e457fbc2cd58e17094af0d002644a92..b8d7456b37634d5c7985a72d2e4e2335b003c1e5 100644
--- a/compiler/GHC/Cmm/Switch.hs
+++ b/compiler/GHC/Cmm/Switch.hs
@@ -12,9 +12,9 @@ module GHC.Cmm.Switch (
      createSwitchPlan,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Session
 import GHC.Cmm.Dataflow.Label (Label)
 
diff --git a/compiler/GHC/Cmm/Switch/Implement.hs b/compiler/GHC/Cmm/Switch/Implement.hs
index b0989177115670d15ab9c65fa2f00a329454026e..3279c5ab05c2a79edaa0be3754eded0086d17cc0 100644
--- a/compiler/GHC/Cmm/Switch/Implement.hs
+++ b/compiler/GHC/Cmm/Switch/Implement.hs
@@ -4,7 +4,7 @@ module GHC.Cmm.Switch.Implement
   )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Cmm.Dataflow.Block
@@ -14,7 +14,7 @@ import GHC.Cmm.Utils
 import GHC.Cmm.Switch
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
-import MonadUtils (concatMapM)
+import GHC.Utils.Monad (concatMapM)
 
 --
 -- This module replaces Switch statements as generated by the Stg -> Cmm
diff --git a/compiler/GHC/Cmm/Type.hs b/compiler/GHC/Cmm/Type.hs
index fced2bf076fe17f6b46789b8d87dfe1756087f1e..bddc933bf1a073b17807b2046b65d9df927dbdd3 100644
--- a/compiler/GHC/Cmm/Type.hs
+++ b/compiler/GHC/Cmm/Type.hs
@@ -29,12 +29,12 @@ module GHC.Cmm.Type
 where
 
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Driver.Session
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 
 import Data.Word
 import Data.Int
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index c23975bb44eddf32df40c095a3a9d36e2402f27e..a49557a07eb5798dd9d8ee241bec845216ddc4ee 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -71,7 +71,7 @@ module GHC.Cmm.Utils(
         blockTicks
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.TyCon     ( PrimRep(..), PrimElemRep(..) )
 import GHC.Types.RepType  ( UnaryType, SlotTy (..), typePrimRep1 )
@@ -81,7 +81,7 @@ import GHC.Runtime.Heap.Layout
 import GHC.Cmm
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Session
 import GHC.Types.Unique
 import GHC.Platform.Regs
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 56ac9ceaf5586e199e787db4b9d706c2ac9db50f..374b6c47e897907d253fc71735d55b925d08c456 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -30,7 +30,7 @@ module GHC.CmmToAsm (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified GHC.CmmToAsm.X86.CodeGen as X86.CodeGen
 import qualified GHC.CmmToAsm.X86.Regs    as X86.Regs
@@ -53,12 +53,12 @@ import qualified GHC.CmmToAsm.PPC.Ppr     as PPC.Ppr
 import GHC.CmmToAsm.Reg.Liveness
 import qualified GHC.CmmToAsm.Reg.Linear                as Linear
 
-import qualified GraphColor                             as Color
+import qualified GHC.Data.Graph.Color                   as Color
 import qualified GHC.CmmToAsm.Reg.Graph                 as Color
 import qualified GHC.CmmToAsm.Reg.Graph.Stats           as Color
 import qualified GHC.CmmToAsm.Reg.Graph.TrivColorable   as Color
 
-import AsmUtils
+import GHC.Utils.Asm
 import GHC.CmmToAsm.Reg.Target
 import GHC.Platform
 import GHC.CmmToAsm.BlockLayout as BlockLayout
@@ -86,21 +86,21 @@ import GHC.Cmm.CLabel
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
-import Util
+import GHC.Utils.Misc
 
 import GHC.Types.Basic       ( Alignment )
-import qualified Pretty
-import BufWrite
-import Outputable
-import FastString
+import qualified GHC.Utils.Ppr as Pretty
+import GHC.Utils.BufHandle
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.FastString
 import GHC.Types.Unique.Set
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Module
-import Stream (Stream)
-import qualified Stream
+import GHC.Data.Stream (Stream)
+import qualified GHC.Data.Stream as Stream
 
 -- DEBUGGING ONLY
---import OrdList
+--import GHC.Data.OrdList
 
 import Data.List
 import Data.Maybe
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index 7ff90e8c40a86e2fb82e997f2d25186b6b3340a0..07faa91473d93ed087b628f2bafa9a1d28cd68a0 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -14,7 +14,7 @@ module GHC.CmmToAsm.BlockLayout
 where
 
 #include "HsVersions.h"
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Monad
@@ -28,19 +28,19 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Platform
 import GHC.Driver.Session (gopt, GeneralFlag(..), DynFlags, targetPlatform)
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique
 
-import Digraph
-import Outputable
-import Maybes
+import GHC.Data.Graph.Directed
+import GHC.Utils.Outputable
+import GHC.Data.Maybe
 
 -- DEBUGGING ONLY
 --import GHC.Cmm.DebugBlock
 --import Debug.Trace
-import ListSetOps (removeDups)
+import GHC.Data.List.SetOps (removeDups)
 
-import OrdList
+import GHC.Data.OrdList
 import Data.List
 import Data.Foldable (toList)
 
diff --git a/compiler/GHC/CmmToAsm/CFG.hs b/compiler/GHC/CmmToAsm/CFG.hs
index dca02b0eb5dc331919f36af5582fe58ce0d61648..ad3a3cdae7fa322457e320590724fa8311be6861 100644
--- a/compiler/GHC/CmmToAsm/CFG.hs
+++ b/compiler/GHC/CmmToAsm/CFG.hs
@@ -44,7 +44,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.BlockId
 import GHC.Cmm as Cmm
@@ -56,9 +56,9 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Dataflow.Block
 import qualified GHC.Cmm.Dataflow.Graph as G
 
-import Util
-import Digraph
-import Maybes
+import GHC.Utils.Misc
+import GHC.Data.Graph.Directed
+import GHC.Data.Maybe
 
 import GHC.Types.Unique
 import qualified GHC.CmmToAsm.CFG.Dominators as Dom
@@ -72,10 +72,10 @@ import qualified Data.Set as S
 import Data.Tree
 import Data.Bifunctor
 
-import Outputable
+import GHC.Utils.Outputable
 -- DEBUGGING ONLY
 --import GHC.Cmm.DebugBlock
---import OrdList
+--import GHC.Data.OrdList
 --import GHC.Cmm.DebugBlock.Trace
 import GHC.Cmm.Ppr () -- For Outputable instances
 import qualified GHC.Driver.Session as D
diff --git a/compiler/GHC/CmmToAsm/CFG/Dominators.hs b/compiler/GHC/CmmToAsm/CFG/Dominators.hs
index b9dcacd8cb76732252e29abeaaa8a0462d6ce47a..bb28e877d7a307762478b75e16d0b111462858af 100644
--- a/compiler/GHC/CmmToAsm/CFG/Dominators.hs
+++ b/compiler/GHC/CmmToAsm/CFG/Dominators.hs
@@ -38,7 +38,7 @@ module GHC.CmmToAsm.CFG.Dominators (
   ,parents,ancestors
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Bifunctor
 import Data.Tuple (swap)
@@ -58,7 +58,7 @@ import Data.Array.Base hiding ((!))
   -- ,unsafeWrite,unsafeRead
   -- ,readArray,writeArray)
 
-import Util (debugIsOn)
+import GHC.Utils.Misc (debugIsOn)
 
 -----------------------------------------------------------------------------
 
diff --git a/compiler/GHC/CmmToAsm/CPrim.hs b/compiler/GHC/CmmToAsm/CPrim.hs
index 34c3a7ff6a0b6ef5ee95bc18c85aeb1e09f939cc..fc2d06262b65ce2c44013ee9bd72b2f4c2dedf4d 100644
--- a/compiler/GHC/CmmToAsm/CPrim.hs
+++ b/compiler/GHC/CmmToAsm/CPrim.hs
@@ -14,11 +14,11 @@ module GHC.CmmToAsm.CPrim
     , word2FloatLabel
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.Type
 import GHC.Cmm.MachOp
-import Outputable
+import GHC.Utils.Outputable
 
 popCntLabel :: Width -> String
 popCntLabel w = "hs_popcnt" ++ pprWidth w
diff --git a/compiler/GHC/CmmToAsm/Config.hs b/compiler/GHC/CmmToAsm/Config.hs
index 52c0995bdf3531fc54734500562e1e8fc0600d44..cbd15d0580a067a8dcc4ec7ab55279792ff910cd 100644
--- a/compiler/GHC/CmmToAsm/Config.hs
+++ b/compiler/GHC/CmmToAsm/Config.hs
@@ -6,7 +6,7 @@ module GHC.CmmToAsm.Config
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 import GHC.Cmm.Type (Width(..))
 import GHC.Types.Module
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 8075bdd27ee7c4ff6d803167d8de2a7e013af4a5..bc5e82c316a4df2fef8b0eff228870eddb19cfd8 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -2,7 +2,7 @@ module GHC.CmmToAsm.Dwarf (
   dwarfGen
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.CLabel
 import GHC.Cmm.Expr    ( GlobalReg(..) )
@@ -11,7 +11,7 @@ import GHC.Core        ( Tickish(..) )
 import GHC.Cmm.DebugBlock
 import GHC.Driver.Session
 import GHC.Types.Module
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
index 29592c106e658a90d33bd35ed5d8508eae15d1ef..e550813be1c253e75c918cf4786d99713f23d9bd 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
@@ -3,12 +3,12 @@
 
 module GHC.CmmToAsm.Dwarf.Constants where
 
-import GhcPrelude
+import GHC.Prelude
 
-import AsmUtils
-import FastString
+import GHC.Utils.Asm
+import GHC.Data.FastString
 import GHC.Platform
-import Outputable
+import GHC.Utils.Outputable
 
 import GHC.Platform.Reg
 import GHC.CmmToAsm.X86.Regs
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index eaeb570595b5f11e5bb6f4868f4bc10068dc6032..41c0dd518d12855e3e4800a150eb81b0c4f176d3 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -22,19 +22,19 @@ module GHC.CmmToAsm.Dwarf.Types
   )
   where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.DebugBlock
 import GHC.Cmm.CLabel
 import GHC.Cmm.Expr         ( GlobalReg(..) )
-import Encoding
-import FastString
-import Outputable
+import GHC.Utils.Encoding
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique
 import GHC.Platform.Reg
 import GHC.Types.SrcLoc
-import Util
+import GHC.Utils.Misc
 
 import GHC.CmmToAsm.Dwarf.Constants
 
diff --git a/compiler/GHC/CmmToAsm/Format.hs b/compiler/GHC/CmmToAsm/Format.hs
index 446c7609397841a4f8df7822e1c278127330645b..0049d2c9877814262a7d287a5f718a80458e541e 100644
--- a/compiler/GHC/CmmToAsm/Format.hs
+++ b/compiler/GHC/CmmToAsm/Format.hs
@@ -20,10 +20,10 @@ module GHC.CmmToAsm.Format (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm
-import Outputable
+import GHC.Utils.Outputable
 
 -- It looks very like the old MachRep, but it's now of purely local
 -- significance, here in the native code generator.  You can change it
diff --git a/compiler/GHC/CmmToAsm/Instr.hs b/compiler/GHC/CmmToAsm/Instr.hs
index 01f703340b9adc0f35e5f66231c144af3c4fef40..833a72a74a61f5197960179a8883e705bfb28e64 100644
--- a/compiler/GHC/CmmToAsm/Instr.hs
+++ b/compiler/GHC/CmmToAsm/Instr.hs
@@ -14,7 +14,7 @@ module GHC.CmmToAsm.Instr (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Platform.Reg
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 07c3cc809b1c538fa400a347c5f1bc02c70072b7..9d5cf246c2ef2ef5ca1dc2085a157e10caf9e8d8 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -46,7 +46,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Platform.Reg
@@ -59,7 +59,7 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.CLabel           ( CLabel )
 import GHC.Cmm.DebugBlock
-import FastString       ( FastString )
+import GHC.Data.FastString      ( FastString )
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
 import GHC.Types.Unique         ( Unique )
@@ -69,7 +69,7 @@ import GHC.Types.Module
 import Control.Monad    ( ap )
 
 import GHC.CmmToAsm.Instr
-import Outputable (SDoc, pprPanic, ppr)
+import GHC.Utils.Outputable (SDoc, pprPanic, ppr)
 import GHC.Cmm (RawCmmDecl, RawCmmStatics)
 import GHC.CmmToAsm.CFG
 
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index d60821ee10c7f93242b07a4d8a227961f61a3cc7..5b237fc7db29d3ef56bd8a7e13712737971018e8 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -47,7 +47,7 @@ module GHC.CmmToAsm.PIC (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified GHC.CmmToAsm.PPC.Instr as PPC
 import qualified GHC.CmmToAsm.PPC.Regs  as PPC
@@ -73,10 +73,10 @@ import GHC.Cmm.CLabel           ( mkForeignLabel )
 import GHC.Types.Basic
 import GHC.Types.Module
 
-import Outputable
+import GHC.Utils.Outputable
 
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 
 
 
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 16557dba716f6e50dbb9bae450fbf0e89755cbc2..764945c2bc51aa3a37d0789a9fa62d86f6d40989 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -23,7 +23,7 @@ where
 #include "HsVersions.h"
 
 -- NCG stuff:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Regs
 import GHC.CmmToAsm.PPC.Instr
@@ -60,16 +60,16 @@ import GHC.Core              ( Tickish(..) )
 import GHC.Types.SrcLoc      ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 
 -- The rest:
-import OrdList
-import Outputable
+import GHC.Data.OrdList
+import GHC.Utils.Outputable
 
 import Control.Monad    ( mapAndUnzipM, when )
 import Data.Bits
 import Data.Word
 
 import GHC.Types.Basic
-import FastString
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Misc
 
 -- -----------------------------------------------------------------------------
 -- Top-level of the instruction selector
diff --git a/compiler/GHC/CmmToAsm/PPC/Cond.hs b/compiler/GHC/CmmToAsm/PPC/Cond.hs
index e8efa30064892375ca182f843eaad8293c34c676..a8f7aac877373e29dc9a95275fe3aa7ae69d518a 100644
--- a/compiler/GHC/CmmToAsm/PPC/Cond.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Cond.hs
@@ -8,9 +8,9 @@ module GHC.CmmToAsm.PPC.Cond (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Panic
+import GHC.Utils.Panic
 
 data Cond
         = ALWAYS
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index 674b19ef930693cffe4707de42112947f8a8416b..26c50bcdc87f8ea6b02f7f6bc683bc9b644f8008 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
@@ -24,7 +24,7 @@ module GHC.CmmToAsm.PPC.Instr (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.PPC.Regs
 import GHC.CmmToAsm.PPC.Cond
@@ -41,9 +41,9 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
 import GHC.Cmm.Info
-import FastString
+import GHC.Data.FastString
 import GHC.Cmm.CLabel
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique.FM (listToUFM, lookupUFM)
 import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 15e72bbb49b9d8fd11527d5c9175e97c9e47056b..4ef5437b714a196afe46980ecfbdd4029b139e28 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -9,7 +9,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module GHC.CmmToAsm.PPC.Ppr (pprNatCmmDecl) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.PPC.Regs
 import GHC.CmmToAsm.PPC.Instr
@@ -32,8 +32,8 @@ import GHC.Cmm.Ppr.Expr () -- For Outputable instances
 
 import GHC.Types.Unique ( pprUniqueAlways, getUnique )
 import GHC.Platform
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Driver.Session (targetPlatform)
 
 import Data.Word
diff --git a/compiler/GHC/CmmToAsm/PPC/RegInfo.hs b/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
index 58e3f44ecef7b0b575d5aab783b2e0341a418533..0e0f1e464d26bf76f974c9504b1cbb122e885ceb 100644
--- a/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
+++ b/compiler/GHC/CmmToAsm/PPC/RegInfo.hs
@@ -19,7 +19,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.PPC.Instr
 
@@ -28,7 +28,7 @@ import GHC.Cmm
 import GHC.Cmm.CLabel
 
 import GHC.Types.Unique
-import Outputable (ppr, text, Outputable, (<>))
+import GHC.Utils.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 b37fb400fcbb094445187dedd4a39ffac64a4d8e..a92c7f00efb8ed501de8327cff0b9ce10a31ac57 100644
--- a/compiler/GHC/CmmToAsm/PPC/Regs.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Regs.hs
@@ -50,7 +50,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Reg
 import GHC.Platform.Reg.Class
@@ -61,7 +61,7 @@ import GHC.Cmm.CLabel           ( CLabel )
 import GHC.Types.Unique
 
 import GHC.Platform.Regs
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Data.Word        ( Word8, Word16, Word32, Word64 )
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index c0abb52ad3989ffd5e729cc88dc780585e110435..405bab9fffd151bcd0b5978ea17f3054571a5488 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -21,14 +21,14 @@ module GHC.CmmToAsm.Ppr (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import AsmUtils
+import GHC.Utils.Asm
 import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.CmmToAsm.Config
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import qualified Data.Array.Unsafe as U ( castSTUArray )
@@ -96,7 +96,7 @@ doubleToBytes d
 -- Printing ASCII strings.
 --
 -- Print as a string and escape non-printable characters.
--- This is similar to charToC in Utils.
+-- This is similar to charToC in GHC.Utils.Misc
 
 pprASCII :: ByteString -> SDoc
 pprASCII str
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs
index 443072b246e5f24ad7cdedabba26389b16672e1b..022c9eed4cab2c6504d2cb94754a8d54ad08f62c 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs
@@ -5,9 +5,9 @@
 module GHC.CmmToAsm.Reg.Graph (
         regAlloc
 ) where
-import GhcPrelude
+import GHC.Prelude
 
-import qualified GraphColor as Color
+import qualified GHC.Data.Graph.Color as Color
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Reg.Graph.Spill
 import GHC.CmmToAsm.Reg.Graph.SpillClean
@@ -20,13 +20,13 @@ import GHC.CmmToAsm.Config
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 
-import Bag
-import Outputable
+import GHC.Data.Bag
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
-import Util (seqList)
+import GHC.Utils.Misc (seqList)
 import GHC.CmmToAsm.CFG
 
 import Data.Maybe
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs
index ba3f82514981e71104ac9ccef4078f47b8b3167b..86c25c5a24b4fbf58726137cf85683fa601adbad 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Base.hs
@@ -22,12 +22,12 @@ module GHC.CmmToAsm.Reg.Graph.Base (
         squeese
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
-import MonadUtils (concatMapM)
+import GHC.Utils.Monad (concatMapM)
 
 
 -- Some basic register classes.
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
index dd2898126164853f8eb5303684796034d19ecea0..0bdee541ede25c05e0fba44067db6f2d53a914ae 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Coalesce.hs
@@ -3,15 +3,15 @@ module GHC.CmmToAsm.Reg.Graph.Coalesce (
         regCoalesce,
         slurpJoinMovs
 ) where
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
 import GHC.Platform.Reg
 
 import GHC.Cmm
-import Bag
-import Digraph
+import GHC.Data.Bag
+import GHC.Data.Graph.Directed
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
index 5ae55334a243bf30261854a5c87e835681c5ce04..4694ba6b9652a5b95051587afa557cc16c2a9194 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
@@ -7,7 +7,7 @@ module GHC.CmmToAsm.Reg.Graph.Spill (
         SpillStats(..),
         accSpillSL
 ) where
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
@@ -16,13 +16,13 @@ import GHC.Cmm hiding (RegSet)
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
 
-import MonadUtils
-import State
+import GHC.Utils.Monad
+import GHC.Utils.Monad.State
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Data.List
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
index ac784582e7233aa940c3c7cb1a53c9f454a0efb5..c810aeeac40e99bc5aac0f0ed33538d531fa150a 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillClean.hs
@@ -29,7 +29,7 @@
 module GHC.CmmToAsm.Reg.Graph.SpillClean (
         cleanSpills
 ) where
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
@@ -40,8 +40,8 @@ import GHC.Cmm
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
-import State
-import Outputable
+import GHC.Utils.Monad.State
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Cmm.Dataflow.Collections
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
index 6484a38d792a545caa7c626ef5df9d99513618ab..995b2868399c82b51ef073dbe4ea5d27a03c3cb2 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs
@@ -13,24 +13,24 @@ module GHC.CmmToAsm.Reg.Graph.SpillCost (
 
         lifeMapFromSpillCostInfo
 ) where
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 
-import GraphBase
+import GHC.Data.Graph.Base
 
 import GHC.Cmm.Dataflow.Collections (mapLookup)
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import Digraph          (flattenSCCs)
-import Outputable
+import GHC.Data.Graph.Directed          (flattenSCCs)
+import GHC.Utils.Outputable
 import GHC.Platform
-import State
+import GHC.Utils.Monad.State
 import GHC.CmmToAsm.CFG
 
 import Data.List        (nub, minimumBy)
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
index a06a22fa059651f85a2c024f1ef3838e8316e368..ddd353c4f2ccbdf869a984c9632d79535e2a6268 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
@@ -16,9 +16,9 @@ module GHC.CmmToAsm.Reg.Graph.Stats (
         countSRMs, addSRM
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import qualified GraphColor as Color
+import qualified GHC.Data.Graph.Color as Color
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Reg.Graph.Spill
 import GHC.CmmToAsm.Reg.Graph.SpillCost
@@ -29,10 +29,10 @@ import GHC.Platform.Reg
 import GHC.CmmToAsm.Reg.Target
 import GHC.Platform
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import State
+import GHC.Utils.Monad.State
 
 -- | Holds interesting statistics from the register allocator.
 data RegAllocStats statics instr
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs b/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
index 4cf3d98eb19f7a0694533942db00dcac4afaabc4..0370670b219f793951c419bd0d133381962f20e3 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
@@ -8,16 +8,16 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 
-import GraphBase
+import GHC.Data.Graph.Base
 
 import GHC.Types.Unique.Set
 import GHC.Platform
-import Panic
+import GHC.Utils.Panic
 
 -- trivColorable ---------------------------------------------------------------
 
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs b/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs
index c673c69c1d6c8788bb2805e763121c16cea25787..d63cc819acfd0868526e6cdf865cea2075d47fce 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/X86.hs
@@ -15,7 +15,7 @@ module GHC.CmmToAsm.Reg.Graph.X86 (
         squeese,
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Graph.Base  (Reg(..), RegSub(..), RegClass(..))
 import GHC.Types.Unique.Set
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs
index a093bad83a6196cd61bde5c171626568023bd251..00b4915d7b14e4e0351fe201e9c9f82c4c0e24a3 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs
@@ -104,7 +104,7 @@ module GHC.CmmToAsm.Reg.Linear (
 #include "HsVersions.h"
 
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Linear.State
 import GHC.CmmToAsm.Reg.Linear.Base
@@ -126,12 +126,12 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm hiding (RegSet)
 
-import Digraph
+import GHC.Data.Graph.Directed
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Data.Maybe
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
index 95036adb26f8ed997da9fc297340fae6b630c7d7..5784660e3fb60fb809bcc4f9a1a72b61fa3267c5 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
@@ -17,14 +17,14 @@ module GHC.CmmToAsm.Reg.Linear.Base (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Linear.StackMap
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Config
 import GHC.Platform.Reg
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs b/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
index e340dcf5c6cdd9b0511fce3d37862a80ed45b216..b4fa0f8b76c2a1b047588094cc513a7f71ad4606 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
@@ -9,13 +9,13 @@ module GHC.CmmToAsm.Reg.Linear.FreeRegs (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Reg
 import GHC.Platform.Reg.Class
 
 import GHC.CmmToAsm.Config
-import Panic
+import GHC.Utils.Panic
 import GHC.Platform
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index 55735913d49beaabb4edf85f23e5a391b9c5ba12..4ceaf4573b5d8bb10ea395275b2dd6ffe0ede0a5 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -10,7 +10,7 @@
 --
 module GHC.CmmToAsm.Reg.Linear.JoinToTargets (joinToTargets) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Linear.State
 import GHC.CmmToAsm.Reg.Linear.Base
@@ -22,8 +22,8 @@ import GHC.Platform.Reg
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Collections
-import Digraph
-import Outputable
+import GHC.Data.Graph.Directed
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/PPC.hs b/compiler/GHC/CmmToAsm/Reg/Linear/PPC.hs
index ce0a1876477d740f237331708745d9b2146ef99f..fe19164357f258da93e1066fcc82d9f8692e5a74 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/PPC.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/PPC.hs
@@ -1,13 +1,13 @@
 -- | Free regs map for PowerPC
 module GHC.CmmToAsm.Reg.Linear.PPC where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.PPC.Regs
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Data.Word
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/SPARC.hs b/compiler/GHC/CmmToAsm/Reg/Linear/SPARC.hs
index 7fa85f0913f8d3c81f1277e484005b4377e0147c..ac7dc85366df0b9c5aa767cd2fa20fad191c72af 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/SPARC.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/SPARC.hs
@@ -3,14 +3,14 @@
 -- | Free regs map for SPARC
 module GHC.CmmToAsm.Reg.Linear.SPARC where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Regs
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
 
 import GHC.Platform.Regs
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Data.Word
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
index c2477fc18f4d67133aa05a879383790295db0a30..29864f9752460a78a6bb11d38c3948bd239771dd 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
@@ -20,7 +20,7 @@ module GHC.CmmToAsm.Reg.Linear.StackMap (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/State.hs b/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
index cf8913e211f7c228e8e59c702db930c6fde61a62..f96cc71239e4ec91a859f6e24d1f433dfc38d5ff 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
@@ -38,7 +38,7 @@ module GHC.CmmToAsm.Reg.Linear.State (
 )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Linear.Stats
 import GHC.CmmToAsm.Reg.Linear.StackMap
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
index 84acc3a41780d14b4fe44f4323aec81c43371de6..414128b32cbbdb0d44fe34d30b8cf80e9401fd1e 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs
@@ -6,16 +6,16 @@ module GHC.CmmToAsm.Reg.Linear.Stats (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Linear.Base
 import GHC.CmmToAsm.Reg.Liveness
 import GHC.CmmToAsm.Instr
 
 import GHC.Types.Unique.FM
-import Outputable
+import GHC.Utils.Outputable
 
-import State
+import GHC.Utils.Monad.State
 
 -- | Build a map of how many times each reg was alloced, clobbered, loaded etc.
 binSpillReasons
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/X86.hs b/compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
index ce103bd6b2f4608d07e99f489d665522f59d133c..ae37b0f9d1086707b89604140851685c2f40a861 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
@@ -2,12 +2,12 @@
 -- | Free regs map for i386
 module GHC.CmmToAsm.Reg.Linear.X86 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.X86.Regs
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
-import Panic
+import GHC.Utils.Panic
 import GHC.Platform
 
 import Data.Word
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs b/compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
index 322ddd6bdd41f731fddab14d7f77d272c672a54f..325e033e853ef0fb15eac8fc9f88b960bdfe7f77 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
@@ -2,12 +2,12 @@
 -- | Free regs map for x86_64
 module GHC.CmmToAsm.Reg.Linear.X86_64 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.X86.Regs
 import GHC.Platform.Reg.Class
 import GHC.Platform.Reg
-import Panic
+import GHC.Utils.Panic
 import GHC.Platform
 
 import Data.Word
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index 5f5d4c8ff3a5853718dc9009b7dad55050ce4617..f650ad6186573637eb87fbbda97abcd63e120793 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -37,7 +37,7 @@ module GHC.CmmToAsm.Reg.Liveness (
         regLiveness,
         cmmTopLiveness
   ) where
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Reg
 import GHC.CmmToAsm.Instr
@@ -49,15 +49,15 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm hiding (RegSet, emptyRegSet)
 
-import Digraph
-import MonadUtils
-import Outputable
+import GHC.Data.Graph.Directed
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
-import Bag
-import State
+import GHC.Data.Bag
+import GHC.Utils.Monad.State
 
 import Data.List
 import Data.Maybe
diff --git a/compiler/GHC/CmmToAsm/Reg/Target.hs b/compiler/GHC/CmmToAsm/Reg/Target.hs
index 183d329790e61d973a1ed72c17730664040e53f2..d4bc561faad9c1fe99c96f030f66896700d4240e 100644
--- a/compiler/GHC/CmmToAsm/Reg/Target.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Target.hs
@@ -21,13 +21,13 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Reg
 import GHC.Platform.Reg.Class
 import GHC.CmmToAsm.Format
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Platform
 
diff --git a/compiler/GHC/CmmToAsm/SPARC/AddrMode.hs b/compiler/GHC/CmmToAsm/SPARC/AddrMode.hs
index 6cc660bba95deac5fd642aa28020da17fcce6a3c..b99b75f5eb113750327a4be151d7138de2ea9422 100644
--- a/compiler/GHC/CmmToAsm/SPARC/AddrMode.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/AddrMode.hs
@@ -6,7 +6,7 @@ module GHC.CmmToAsm.SPARC.AddrMode (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Imm
 import GHC.CmmToAsm.SPARC.Base
diff --git a/compiler/GHC/CmmToAsm/SPARC/Base.hs b/compiler/GHC/CmmToAsm/SPARC/Base.hs
index 85b1de9ef3beb11e7727e39c6330324c24b54057..a7929081b352fea863bce73952af766ab45f4a5b 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Base.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Base.hs
@@ -17,9 +17,9 @@ module GHC.CmmToAsm.SPARC.Base (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Panic
+import GHC.Utils.Panic
 
 import Data.Int
 
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index f88b2140a132487be74e280427cf4485b7c6cf70..2112983e73248db2d9e3e2a0948d2058d9e1d480 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -20,7 +20,7 @@ where
 #include "HsVersions.h"
 
 -- NCG stuff:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Base
 import GHC.CmmToAsm.SPARC.CodeGen.Sanity
@@ -53,9 +53,9 @@ import GHC.CmmToAsm.CPrim
 
 -- The rest:
 import GHC.Types.Basic
-import FastString
-import OrdList
-import Outputable
+import GHC.Data.FastString
+import GHC.Data.OrdList
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import Control.Monad    ( mapAndUnzipM )
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs
index 75eba25023aad6e04c320b7ac56fd63c012b1a85..87fb09d7d6807be51168950bb697aa05680eadc4 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Amode.hs
@@ -4,7 +4,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.Amode (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.CmmToAsm.SPARC.CodeGen.Gen32
 import GHC.CmmToAsm.SPARC.CodeGen.Base
@@ -18,7 +18,7 @@ import GHC.CmmToAsm.Format
 
 import GHC.Cmm
 
-import OrdList
+import GHC.Data.OrdList
 
 
 -- | Generate code to reference a memory address.
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs
index f00e60ca93f879d27a58b21aaea125773f751034..34ee34295d10b794523c353b496897771601c0ba 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Base.hs
@@ -13,7 +13,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.Base (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Cond
@@ -27,8 +27,8 @@ import GHC.Cmm
 import GHC.Cmm.Ppr.Expr () -- For Outputable instances
 import GHC.Platform
 
-import Outputable
-import OrdList
+import GHC.Utils.Outputable
+import GHC.Data.OrdList
 
 --------------------------------------------------------------------------------
 -- | 'InstrBlock's are the insn sequences generated by the insn selectors.
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs
index 3f8912a9c4d7ce5abc2fa3347dddeadcdf9bd498..0a6de1a034dfd8ee5d4bd2bb6e4c851be65836e7 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/CondCode.hs
@@ -6,7 +6,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.CondCode (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.CmmToAsm.SPARC.CodeGen.Gen32
 import GHC.CmmToAsm.SPARC.CodeGen.Base
@@ -20,8 +20,8 @@ import GHC.CmmToAsm.Format
 
 import GHC.Cmm
 
-import OrdList
-import Outputable
+import GHC.Data.OrdList
+import GHC.Utils.Outputable
 
 
 getCondCode :: CmmExpr -> NatM CondCode
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs
index 77732cf70cd1d67a40a5ee52e3600cae15c7c9f0..495a973c90737cc103443d5af6c6cc13a4dd9dad 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs
@@ -7,7 +7,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.Expand (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Imm
@@ -19,8 +19,8 @@ import GHC.CmmToAsm.Format
 import GHC.Cmm
 
 
-import Outputable
-import OrdList
+import GHC.Utils.Outputable
+import GHC.Data.OrdList
 
 -- | Expand out synthetic instructions in this top level thing
 expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs
index 494e407d19dfe161d597c48baf60c5783efb161e..e5b5990150c6a1145c292d6326dc31d4f468c01f 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen32.hs
@@ -6,7 +6,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.Gen32 (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.CodeGen.CondCode
 import GHC.CmmToAsm.SPARC.CodeGen.Amode
@@ -26,8 +26,8 @@ import GHC.Platform.Reg
 import GHC.Cmm
 
 import Control.Monad (liftM)
-import OrdList
-import Outputable
+import GHC.Data.OrdList
+import GHC.Utils.Outputable
 
 -- | The dual to getAnyReg: compute an expression into a register, but
 --      we don't mind which one it is.
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs
index 18b22b2a1e8589cc5850989f73ec047c84e75179..00a94ceb24bb8dac26996ccfc641ad61525a825e 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs
@@ -7,7 +7,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.Gen64 (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.CmmToAsm.SPARC.CodeGen.Gen32
 import GHC.CmmToAsm.SPARC.CodeGen.Base
@@ -24,8 +24,8 @@ import GHC.Platform.Reg
 
 import GHC.Cmm
 
-import OrdList
-import Outputable
+import GHC.Data.OrdList
+import GHC.Utils.Outputable
 
 -- | Code to assign a 64 bit value to memory.
 assignMem_I64Code
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs
index f8648c4549443e5d3f5fee3adb31d0618caf8b76..f6ec24434c20167434e398c1779229d6bd8cc76f 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs
@@ -6,7 +6,7 @@ module GHC.CmmToAsm.SPARC.CodeGen.Sanity (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Ppr        () -- For Outputable instances
@@ -14,7 +14,7 @@ import GHC.CmmToAsm.Instr
 
 import GHC.Cmm
 
-import Outputable
+import GHC.Utils.Outputable
 
 
 -- | Enforce intra-block invariants.
diff --git a/compiler/GHC/CmmToAsm/SPARC/Cond.hs b/compiler/GHC/CmmToAsm/SPARC/Cond.hs
index 89b64b7c3a097fdb79b4c1a8c122305ee296edfd..035de3dd7e6541796a312d95d6bd87976428229a 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Cond.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Cond.hs
@@ -7,7 +7,7 @@ module GHC.CmmToAsm.SPARC.Cond (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 -- | Branch condition codes.
 data Cond
diff --git a/compiler/GHC/CmmToAsm/SPARC/Imm.hs b/compiler/GHC/CmmToAsm/SPARC/Imm.hs
index 71b0257ac5f57ccc7980c98e6896f69ba9a60630..fd4185565cbb9b85605b066351a064783447c063 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Imm.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Imm.hs
@@ -7,12 +7,12 @@ module GHC.CmmToAsm.SPARC.Imm (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm
 import GHC.Cmm.CLabel
 
-import Outputable
+import GHC.Utils.Outputable
 
 -- | An immediate value.
 --      Not all of these are directly representable by the machine.
diff --git a/compiler/GHC/CmmToAsm/SPARC/Instr.hs b/compiler/GHC/CmmToAsm/SPARC/Instr.hs
index a1f890bc6ddafd0e58ee4f59b5371cf7062e0a99..6da02818db4c0b557282f6c6e08aa29e14066763 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Instr.hs
@@ -24,7 +24,7 @@ module GHC.CmmToAsm.SPARC.Instr (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Stack
 import GHC.CmmToAsm.SPARC.Imm
@@ -43,8 +43,8 @@ import GHC.Cmm.CLabel
 import GHC.Platform.Regs
 import GHC.Cmm.BlockId
 import GHC.Cmm
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Platform
 
 
diff --git a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
index 661db9dfbb21ce95377e00417162d4c7000a75cc..3943610346a341fef7f32ccb2a814db74768de6e 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Ppr.hs
@@ -24,7 +24,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Regs
 import GHC.CmmToAsm.SPARC.Instr
@@ -46,9 +46,9 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.Dataflow.Collections
 
 import GHC.Types.Unique ( pprUniqueAlways )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
-import FastString
+import GHC.Data.FastString
 
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
diff --git a/compiler/GHC/CmmToAsm/SPARC/Regs.hs b/compiler/GHC/CmmToAsm/SPARC/Regs.hs
index d6d5d87bf6f23d2a75fc8364a9f9991ae2ddda5a..9ee68baee2da64c06ff9d6ad7d41ccbd71916501 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Regs.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Regs.hs
@@ -32,7 +32,7 @@ module GHC.CmmToAsm.SPARC.Regs (
 where
 
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.SPARC
 import GHC.Platform.Reg
@@ -40,7 +40,7 @@ import GHC.Platform.Reg.Class
 import GHC.CmmToAsm.Format
 
 import GHC.Types.Unique
-import Outputable
+import GHC.Utils.Outputable
 
 {-
         The SPARC has 64 registers of interest; 32 integer registers and 32
diff --git a/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs b/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs
index 98f55d13d8cb4350c06c8624851926ec97113d9a..2c5b90d964046b8441021448944ea251820106ff 100644
--- a/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/ShortcutJump.hs
@@ -8,7 +8,7 @@ module GHC.CmmToAsm.SPARC.ShortcutJump (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.Instr
 import GHC.CmmToAsm.SPARC.Imm
@@ -17,8 +17,8 @@ import GHC.Cmm.CLabel
 import GHC.Cmm.BlockId
 import GHC.Cmm
 
-import Panic
-import Outputable
+import GHC.Utils.Panic
+import GHC.Utils.Outputable
 
 data JumpDest
         = DestBlockId BlockId
diff --git a/compiler/GHC/CmmToAsm/SPARC/Stack.hs b/compiler/GHC/CmmToAsm/SPARC/Stack.hs
index 861d1ad691b5d6ebfc46c95d7893e88a966580f6..4333f767f73211a3c3cdac714049bca6a8281419 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Stack.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Stack.hs
@@ -7,7 +7,7 @@ module GHC.CmmToAsm.SPARC.Stack (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.SPARC.AddrMode
 import GHC.CmmToAsm.SPARC.Regs
@@ -15,7 +15,7 @@ import GHC.CmmToAsm.SPARC.Base
 import GHC.CmmToAsm.SPARC.Imm
 import GHC.CmmToAsm.Config
 
-import Outputable
+import GHC.Utils.Outputable
 
 -- | Get an AddrMode relative to the address in sp.
 --      This gives us a stack relative addressing mode for volatile
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 4bbf79110222a0e905668eac4be36babcf92a4fe..2796bc32dc2e98ebd5320e7ca15c65242aeeb418 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -36,7 +36,7 @@ where
 #include "HsVersions.h"
 
 -- NCG stuff:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.X86.Instr
 import GHC.CmmToAsm.X86.Cond
@@ -81,11 +81,11 @@ import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 
 -- The rest:
 import GHC.Types.ForeignCall ( CCallConv(..) )
-import OrdList
-import Outputable
-import FastString
+import GHC.Data.OrdList
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Driver.Session
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique.Supply ( getUniqueM )
 
 import Control.Monad
diff --git a/compiler/GHC/CmmToAsm/X86/Cond.hs b/compiler/GHC/CmmToAsm/X86/Cond.hs
index bb8f61438b26c2e8bb96dec6e397c76803cbe15e..424a1718b074ac6399249c15227948d477cdc262 100644
--- a/compiler/GHC/CmmToAsm/X86/Cond.hs
+++ b/compiler/GHC/CmmToAsm/X86/Cond.hs
@@ -9,7 +9,7 @@ module GHC.CmmToAsm.X86.Cond (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 data Cond
         = ALWAYS        -- What's really used? ToDo
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 9c5888c21ddf4335fbea0086a061e6666a20b91c..67a6ffb93077ebe627124970713f575da296621c 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -18,7 +18,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.X86.Cond
 import GHC.CmmToAsm.X86.Regs
@@ -34,8 +34,8 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import GHC.Platform.Regs
 import GHC.Cmm
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import GHC.Types.Basic (Alignment)
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 0b0c406bc4372979c6b2221f031f5758ab740c9a..41c94f90c6555f4aacb1aa6419a18b63d98c70e9 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -22,7 +22,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.X86.Regs
 import GHC.CmmToAsm.X86.Instr
@@ -43,8 +43,8 @@ import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Types.Unique ( pprUniqueAlways )
 import GHC.Platform
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 
 import Data.Word
 import Data.Bits
diff --git a/compiler/GHC/CmmToAsm/X86/RegInfo.hs b/compiler/GHC/CmmToAsm/X86/RegInfo.hs
index 5b2464c4159863d65f709681aba16ced5f987d0d..de11279d548b8df0d03d486d30f4d17455add3ea 100644
--- a/compiler/GHC/CmmToAsm/X86/RegInfo.hs
+++ b/compiler/GHC/CmmToAsm/X86/RegInfo.hs
@@ -8,12 +8,12 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm.Format
 import GHC.Platform.Reg
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique
 
diff --git a/compiler/GHC/CmmToAsm/X86/Regs.hs b/compiler/GHC/CmmToAsm/X86/Regs.hs
index ab8e6d3b4fd08dd4e3c07909982e903a5e9abe2f..8e6f215d3c118e9ce697d0272f92298a7f463dbf 100644
--- a/compiler/GHC/CmmToAsm/X86/Regs.hs
+++ b/compiler/GHC/CmmToAsm/X86/Regs.hs
@@ -49,7 +49,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Regs
 import GHC.Platform.Reg
@@ -57,7 +57,7 @@ import GHC.Platform.Reg.Class
 
 import GHC.Cmm
 import GHC.Cmm.CLabel           ( CLabel )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 
 import qualified Data.Array as A
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index 3eddd87785f17d711c41300c1b6aaab13279ec39..f4b8878fe294f891348ee0950978b2fb059eb9ce 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -26,7 +26,7 @@ module GHC.CmmToC (
 #include "HsVersions.h"
 
 -- Cmm stuff
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
@@ -42,13 +42,13 @@ import GHC.Cmm.Switch
 -- Utils
 import GHC.CmmToAsm.CPrim
 import GHC.Driver.Session
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
-import Util
+import GHC.Utils.Misc
 
 -- The rest
 import Data.ByteString (ByteString)
diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs
index ea69809c136592591deb9f73fda82daa3c8541e5..f91f3578e6e9586c51d98f9e58effb55612e3e18 100644
--- a/compiler/GHC/CmmToLlvm.hs
+++ b/compiler/GHC/CmmToLlvm.hs
@@ -13,7 +13,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm
 import GHC.CmmToLlvm.Base
@@ -28,14 +28,14 @@ import GHC.Cmm
 import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Ppr
 
-import BufWrite
+import GHC.Utils.BufHandle
 import GHC.Driver.Session
 import GHC.Platform ( platformArch, Arch(..) )
-import ErrUtils
-import FastString
-import Outputable
+import GHC.Utils.Error
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.SysTools ( figureLlvmVersion )
-import qualified Stream
+import qualified GHC.Data.Stream as Stream
 
 import Control.Monad ( when, forM_ )
 import Data.Maybe ( fromMaybe, catMaybes )
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index b36b4814f111ec9f4191447fa21a8fc1c0ca99b3..99f5bd53a4b076d6af5501258af31dc5d9cc0221 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -41,7 +41,7 @@ module GHC.CmmToLlvm.Base (
 #include "HsVersions.h"
 #include "ghcautoconf.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm
 import GHC.CmmToLlvm.Regs
@@ -49,18 +49,18 @@ import GHC.CmmToLlvm.Regs
 import GHC.Cmm.CLabel
 import GHC.Platform.Regs ( activeStgRegs )
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Cmm              hiding ( succ )
 import GHC.Cmm.Utils (regsOverlap)
-import Outputable as Outp
+import GHC.Utils.Outputable as Outp
 import GHC.Platform
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
-import BufWrite   ( BufHandle )
+import GHC.Utils.BufHandle   ( BufHandle )
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.Supply
-import ErrUtils
-import qualified Stream
+import GHC.Utils.Error
+import qualified GHC.Data.Stream as Stream
 
 import Data.Maybe (fromJust)
 import Control.Monad (ap)
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index 7b3d198fa9d0510b3223bb9430236e5590c86594..e106a5e111cfcdb6613e04ddc55187b35602eb53 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -8,7 +8,7 @@ module GHC.CmmToLlvm.CodeGen ( genLlvmProc ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm
 import GHC.CmmToLlvm.Base
@@ -26,15 +26,15 @@ import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Dataflow.Collections
 
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.ForeignCall
-import Outputable hiding (panic, pprPanic)
-import qualified Outputable
+import GHC.Utils.Outputable hiding (panic, pprPanic)
+import qualified GHC.Utils.Outputable as Outputable
 import GHC.Platform
-import OrdList
+import GHC.Data.OrdList
 import GHC.Types.Unique.Supply
 import GHC.Types.Unique
-import Util
+import GHC.Utils.Misc
 
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Writer
diff --git a/compiler/GHC/CmmToLlvm/Data.hs b/compiler/GHC/CmmToLlvm/Data.hs
index a862895b3ce81a17ba6f869ceadebf0a707c6d9c..b8db6ba4edf4ab38b371632297e2ec899294fb69 100644
--- a/compiler/GHC/CmmToLlvm/Data.hs
+++ b/compiler/GHC/CmmToLlvm/Data.hs
@@ -9,7 +9,7 @@ module GHC.CmmToLlvm.Data (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm
 import GHC.CmmToLlvm.Base
@@ -20,8 +20,8 @@ import GHC.Cmm
 import GHC.Driver.Session
 import GHC.Platform
 
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import qualified Data.ByteString as BS
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToLlvm/Mangler.hs b/compiler/GHC/CmmToLlvm/Mangler.hs
index 6bf27267d737f42af086531280aba8276698173e..0436dbcf071aa154a1035fca92ebbc5f16a0e802 100644
--- a/compiler/GHC/CmmToLlvm/Mangler.hs
+++ b/compiler/GHC/CmmToLlvm/Mangler.hs
@@ -11,12 +11,12 @@
 
 module GHC.CmmToLlvm.Mangler ( llvmFixupAsm ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session ( DynFlags, targetPlatform )
 import GHC.Platform ( platformArch, Arch(..) )
-import ErrUtils ( withTiming )
-import Outputable ( text )
+import GHC.Utils.Error ( withTiming )
+import GHC.Utils.Outputable ( text )
 
 import Control.Exception
 import qualified Data.ByteString.Char8 as B
diff --git a/compiler/GHC/CmmToLlvm/Ppr.hs b/compiler/GHC/CmmToLlvm/Ppr.hs
index 3606ed56c06661cab17f39850da08f045e642b1b..290234d48a7cf063ed540ffbdc83d216ca6f8f1a 100644
--- a/compiler/GHC/CmmToLlvm/Ppr.hs
+++ b/compiler/GHC/CmmToLlvm/Ppr.hs
@@ -9,7 +9,7 @@ module GHC.CmmToLlvm.Ppr (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm
 import GHC.CmmToLlvm.Base
@@ -18,8 +18,8 @@ import GHC.CmmToLlvm.Data
 import GHC.Cmm.CLabel
 import GHC.Cmm
 
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToLlvm/Regs.hs b/compiler/GHC/CmmToLlvm/Regs.hs
index 6e9be629372215beeb06e2e793fed95d6ee12c9b..0951c7e37f808c6a29e52732150610a96bccb249 100644
--- a/compiler/GHC/CmmToLlvm/Regs.hs
+++ b/compiler/GHC/CmmToLlvm/Regs.hs
@@ -11,14 +11,14 @@ module GHC.CmmToLlvm.Regs (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm
 
 import GHC.Cmm.Expr
 import GHC.Platform
-import FastString
-import Outputable ( panic )
+import GHC.Data.FastString
+import GHC.Utils.Outputable ( panic )
 import GHC.Types.Unique
 
 -- | Get the LlvmVar function variable storing the real register
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 17384f0d438bba1c1c63bfa33713f34d9efbe52f..6c9bf98ca59b95fe956d193935f66ec3b309e371 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -99,7 +99,7 @@ module GHC.Core (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Types.CostCentre
@@ -114,11 +114,11 @@ import GHC.Types.Literal
 import GHC.Core.DataCon
 import GHC.Types.Module
 import GHC.Types.Basic
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Unique.Set
 import GHC.Types.SrcLoc ( RealSrcSpan, containsSpan )
-import Binary
+import GHC.Utils.Binary
 
 import Data.Data hiding (TyCon)
 import Data.Int
diff --git a/compiler/GHC/Core/Arity.hs b/compiler/GHC/Core/Arity.hs
index 9d1adab5199cd32b4d75d2c0052dc05e4a103026..53e47d9746a5dd4c6940ec7a380e047c6e356917 100644
--- a/compiler/GHC/Core/Arity.hs
+++ b/compiler/GHC/Core/Arity.hs
@@ -21,7 +21,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.FVs
@@ -38,9 +38,9 @@ import GHC.Core.Coercion as Coercion
 import GHC.Types.Basic
 import GHC.Types.Unique
 import GHC.Driver.Session ( DynFlags, GeneralFlag(..), gopt )
-import Outputable
-import FastString
-import Util     ( debugIsOn )
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc     ( debugIsOn )
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Core/Class.hs b/compiler/GHC/Core/Class.hs
index 5fb1fc9ea9211498f1b10e68c3da3c7d2e5f4921..2c2f8c353b643c0534307fbb718a575794018b0c 100644
--- a/compiler/GHC/Core/Class.hs
+++ b/compiler/GHC/Core/Class.hs
@@ -23,7 +23,7 @@ module GHC.Core.Class (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )
 import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, PredType )
@@ -32,10 +32,10 @@ import GHC.Types.Var
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Types.Unique
-import Util
+import GHC.Utils.Misc
 import GHC.Types.SrcLoc
-import Outputable
-import BooleanFormula (BooleanFormula, mkTrue)
+import GHC.Utils.Outputable
+import GHC.Data.BooleanFormula (BooleanFormula, mkTrue)
 
 import qualified Data.Data as Data
 
diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs
index ad97c4d7e9a65ea267897d90c979ec32ea1862f8..a95c16c37243e60ae424af7f6db9f54b08f2af78 100644
--- a/compiler/GHC/Core/Coercion.hs
+++ b/compiler/GHC/Core/Coercion.hs
@@ -121,7 +121,7 @@ module GHC.Core.Coercion (
 
 import {-# SOURCE #-} GHC.CoreToIface (toIfaceTyCon, tidyToIfaceTcArgs)
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Type
 import GHC.Core.TyCo.Rep
@@ -136,16 +136,16 @@ import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Types.Name hiding ( varName )
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Basic
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
-import Pair
+import GHC.Data.Pair
 import GHC.Types.SrcLoc
 import GHC.Builtin.Names
 import GHC.Builtin.Types.Prim
-import ListSetOps
-import Maybes
+import GHC.Data.List.SetOps
+import GHC.Data.Maybe
 import GHC.Types.Unique.FM
 
 import Control.Monad (foldM, zipWithM)
diff --git a/compiler/GHC/Core/Coercion.hs-boot b/compiler/GHC/Core/Coercion.hs-boot
index 8a10e09268cfb518a8307c4fb986fedac5582ae8..eaf0180bef3dbecc71480cb7cd77e51b92186b1a 100644
--- a/compiler/GHC/Core/Coercion.hs-boot
+++ b/compiler/GHC/Core/Coercion.hs-boot
@@ -2,7 +2,7 @@
 
 module GHC.Core.Coercion where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.TyCo.Rep
 import {-# SOURCE #-} GHC.Core.TyCon
@@ -10,8 +10,8 @@ import {-# SOURCE #-} GHC.Core.TyCon
 import GHC.Types.Basic ( LeftOrRight )
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Var
-import Pair
-import Util
+import GHC.Data.Pair
+import GHC.Utils.Misc
 
 mkReflCo :: Role -> Type -> Coercion
 mkTyConAppCo :: HasDebugCallStack => Role -> TyCon -> [Coercion] -> Coercion
diff --git a/compiler/GHC/Core/Coercion/Axiom.hs b/compiler/GHC/Core/Coercion/Axiom.hs
index cc4cbeff6d2824e4ee7dccf21ad69428b8e04560..4c95da97bc939206e8fef1ecfd232069d8245c91 100644
--- a/compiler/GHC/Core/Coercion/Axiom.hs
+++ b/compiler/GHC/Core/Coercion/Axiom.hs
@@ -29,19 +29,19 @@ module GHC.Core.Coercion.Axiom (
        BuiltInSynFamily(..)
        ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type )
 import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType )
 import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Name
 import GHC.Types.Unique
 import GHC.Types.Var
-import Util
-import Binary
-import Pair
+import GHC.Utils.Misc
+import GHC.Utils.Binary
+import GHC.Data.Pair
 import GHC.Types.Basic
 import Data.Typeable ( Typeable )
 import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Core/Coercion/Opt.hs b/compiler/GHC/Core/Coercion/Opt.hs
index 6a930067910a1ba37e6100d71c29e4e13f396cc4..e8a276e9ed4944578aba2f8e265ffee28e64c419 100644
--- a/compiler/GHC/Core/Coercion/Opt.hs
+++ b/compiler/GHC/Core/Coercion/Opt.hs
@@ -6,7 +6,7 @@ module GHC.Core.Coercion.Opt ( optCoercion, checkAxInstCo ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core.TyCo.Rep
@@ -18,11 +18,11 @@ import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.FamInstEnv ( flattenTys )
-import Pair
-import ListSetOps ( getNth )
-import Util
+import GHC.Data.Pair
+import GHC.Data.List.SetOps ( getNth )
+import GHC.Utils.Misc
 import GHC.Core.Unify
 import GHC.Core.InstEnv
 import Control.Monad   ( zipWithM )
diff --git a/compiler/GHC/Core/ConLike.hs b/compiler/GHC/Core/ConLike.hs
index e6169f7d7cb8ca8b787c16a5967b5658820fb72a..ed247c9d8152563b58836a607d655e3f33e1c817 100644
--- a/compiler/GHC/Core/ConLike.hs
+++ b/compiler/GHC/Core/ConLike.hs
@@ -27,13 +27,13 @@ module GHC.Core.ConLike (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Core.TyCo.Rep (Type, ThetaType)
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index a4521d688cdc4028351390e0353f2abc7f75e4a5..0a1955eacf717e81681666ab1e93b46e7c12dbd2 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -61,7 +61,7 @@ module GHC.Core.DataCon (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Types.Id.Make ( DataConBoxer )
 import GHC.Core.Type as Type
@@ -74,12 +74,12 @@ import GHC.Types.Name
 import GHC.Builtin.Names
 import GHC.Core.Predicate
 import GHC.Types.Var
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Basic
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Module
-import Binary
+import GHC.Utils.Binary
 import GHC.Types.Unique.Set
 import GHC.Types.Unique( mkAlphaTyVarUnique )
 
diff --git a/compiler/GHC/Core/DataCon.hs-boot b/compiler/GHC/Core/DataCon.hs-boot
index ab83a751176850d4755b0dd2394f6c2cb47d4d65..aa2b266b0688b9d03646ca8d370c0bd3493f6814 100644
--- a/compiler/GHC/Core/DataCon.hs-boot
+++ b/compiler/GHC/Core/DataCon.hs-boot
@@ -1,12 +1,12 @@
 module GHC.Core.DataCon where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Types.Var( TyVar, TyCoVar, TyVarBinder )
 import GHC.Types.Name( Name, NamedThing )
 import {-# SOURCE #-} GHC.Core.TyCon( TyCon )
 import GHC.Types.FieldLabel ( FieldLabel )
 import GHC.Types.Unique ( Uniquable )
-import Outputable ( Outputable, OutputableBndr )
+import GHC.Utils.Outputable ( Outputable, OutputableBndr )
 import GHC.Types.Basic (Arity)
 import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, ThetaType )
 
diff --git a/compiler/GHC/Core/FVs.hs b/compiler/GHC/Core/FVs.hs
index 6e7fa259ff26f41295ddbbe2dfec83107ab1f15f..b4430f41393c458264680f7b2d6e83c25e3cd0c9 100644
--- a/compiler/GHC/Core/FVs.hs
+++ b/compiler/GHC/Core/FVs.hs
@@ -59,7 +59,7 @@ module GHC.Core.FVs (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Types.Id
@@ -77,11 +77,11 @@ import GHC.Core.TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Core.FamInstEnv
 import GHC.Builtin.Types.Prim( funTyConName )
-import Maybes( orElse )
-import Util
+import GHC.Data.Maybe( orElse )
+import GHC.Utils.Misc
 import GHC.Types.Basic( Activation )
-import Outputable
-import FV
+import GHC.Utils.Outputable
+import GHC.Utils.FV as FV
 
 {-
 ************************************************************************
@@ -105,7 +105,7 @@ exprFreeVars :: CoreExpr -> VarSet
 exprFreeVars = fvVarSet . exprFVs
 
 -- | Find all locally-defined free Ids or type variables in an expression
--- returning a composable FV computation. See Note [FV naming conventions] in FV
+-- returning a composable FV computation. See Note [FV naming conventions] in GHC.Utils.FV
 -- for why export it.
 exprFVs :: CoreExpr -> FV
 exprFVs = filterFV isLocalVar . expr_fvs
@@ -150,7 +150,7 @@ exprsFreeVars :: [CoreExpr] -> VarSet
 exprsFreeVars = fvVarSet . exprsFVs
 
 -- | Find all locally-defined free Ids or type variables in several expressions
--- returning a composable FV computation. See Note [FV naming conventions] in FV
+-- returning a composable FV computation. See Note [FV naming conventions] in GHC.Utils.FV
 -- for why export it.
 exprsFVs :: [CoreExpr] -> FV
 exprsFVs exprs = mapUnionFV exprFVs exprs
diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs
index 6c737b555a6ac937b9367abe3bde52ecdb650076..1c01f4fdddf0bdbac3014f3ca8841aa314849234 100644
--- a/compiler/GHC/Core/FamInstEnv.hs
+++ b/compiler/GHC/Core/FamInstEnv.hs
@@ -41,7 +41,7 @@ module GHC.Core.FamInstEnv (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Unify
 import GHC.Core.Type as Type
@@ -53,14 +53,14 @@ 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.Utils.Outputable
+import GHC.Data.Maybe
 import GHC.Core.Map
 import GHC.Types.Unique
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var
 import GHC.Types.SrcLoc
-import FastString
+import GHC.Data.FastString
 import Control.Monad
 import Data.List( mapAccumL )
 import Data.Array( Array, assocs )
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs
index b32d1aa1509832eff3bb275c1c564eed42254cfe..b80b237733e20aaa3de3fbc69488a2150e32345c 100644
--- a/compiler/GHC/Core/InstEnv.hs
+++ b/compiler/GHC/Core/InstEnv.hs
@@ -31,7 +31,7 @@ module GHC.Core.InstEnv (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.TcType -- InstEnv is really part of the type checker,
               -- and depends on TcType in many ways
@@ -43,11 +43,11 @@ import GHC.Types.Var.Set
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Core.Unify
-import Outputable
-import ErrUtils
+import GHC.Utils.Outputable
+import GHC.Utils.Error
 import GHC.Types.Basic
 import GHC.Types.Unique.DFM
-import Util
+import GHC.Utils.Misc
 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 b496b87484122b016a5b038937137e7e56366add..bc74b7d393de04321baa3658de38ffa36c4e5df8 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -23,14 +23,14 @@ module GHC.Core.Lint (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.FVs
 import GHC.Core.Utils
 import GHC.Core.Stats ( coreBindsStats )
 import GHC.Core.Opt.Monad
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Literal
 import GHC.Core.DataCon
 import GHC.Builtin.Types.Prim
@@ -43,7 +43,7 @@ import GHC.Types.Name
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Core.Ppr
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Core.Coercion
 import GHC.Types.SrcLoc
 import GHC.Core.Type as Type
@@ -55,12 +55,12 @@ import GHC.Core.TyCo.Ppr ( pprTyVar )
 import GHC.Core.TyCon as TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Types.Basic
-import ErrUtils as Err
-import ListSetOps
+import GHC.Utils.Error as Err
+import GHC.Data.List.SetOps
 import GHC.Builtin.Names
-import Outputable
-import FastString
-import Util
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Core.InstEnv      ( instanceDFunId )
 import GHC.Core.Coercion.Opt ( checkAxInstCo )
 import GHC.Core.Arity        ( typeArity )
@@ -69,12 +69,12 @@ import GHC.Types.Demand ( splitStrictSig, isBotDiv )
 import GHC.Driver.Types
 import GHC.Driver.Session
 import Control.Monad
-import MonadUtils
+import GHC.Utils.Monad
 import Data.Foldable      ( toList )
 import Data.List.NonEmpty ( NonEmpty )
 import Data.List          ( partition )
 import Data.Maybe
-import Pair
+import GHC.Data.Pair
 import qualified GHC.LanguageExtensions as LangExt
 
 {-
@@ -2211,7 +2211,7 @@ top-level ones. See Note [Exported LocalIds] and #9857.
 
 Note [Checking StaticPtrs]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
-See Note [Grand plan for static forms] in StaticPtrTable for an overview.
+See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview.
 
 Every occurrence of the function 'makeStatic' should be moved to the
 top level by the FloatOut pass.  It's vital that we don't have nested
diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index bf927ebd4d8beaf507a0ee3fb20c2e245bea2582..38710f3829d6a83aa79d456c36658459852bb8d8 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -54,7 +54,7 @@ module GHC.Core.Make (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Id
 import GHC.Types.Var  ( EvVar, setTyVarUnique )
@@ -77,11 +77,11 @@ import GHC.Types.Id.Info
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Types.Name      hiding ( varName )
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Unique.Supply
 import GHC.Types.Basic
-import Util
+import GHC.Utils.Misc
 import Data.List
 
 import Data.Char        ( ord )
diff --git a/compiler/GHC/Core/Map.hs b/compiler/GHC/Core/Map.hs
index bb4eeb0fff6141ec0f8869a1e7b85408fc998bd5..6fc041887de53a480e72e2deb0446da3d3ff8ebc 100644
--- a/compiler/GHC/Core/Map.hs
+++ b/compiler/GHC/Core/Map.hs
@@ -37,23 +37,23 @@ module GHC.Core.Map (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import TrieMap
+import GHC.Data.TrieMap
 import GHC.Core
 import GHC.Core.Coercion
 import GHC.Types.Name
 import GHC.Core.Type
 import GHC.Core.TyCo.Rep
 import GHC.Types.Var
-import FastString(FastString)
-import Util
+import GHC.Data.FastString(FastString)
+import GHC.Utils.Misc
 
 import qualified Data.Map    as Map
 import qualified Data.IntMap as IntMap
 import GHC.Types.Var.Env
 import GHC.Types.Name.Env
-import Outputable
+import GHC.Utils.Outputable
 import Control.Monad( (>=>) )
 
 {-
diff --git a/compiler/GHC/Core/Opt/CSE.hs b/compiler/GHC/Core/Opt/CSE.hs
index 07e243d66280a71e74c715ebfe603d9250020b3d..39e5dd8d0aa41a570587e951a0a8b0af49a4c0a1 100644
--- a/compiler/GHC/Core/Opt/CSE.hs
+++ b/compiler/GHC/Core/Opt/CSE.hs
@@ -13,7 +13,7 @@ module GHC.Core.Opt.CSE (cseProgram, cseOneExpr) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Subst
 import GHC.Types.Var    ( Var )
@@ -28,10 +28,10 @@ import GHC.Core.Utils   ( mkAltExpr, eqExpr
 import GHC.Core.FVs     ( exprFreeVars )
 import GHC.Core.Type    ( tyConAppArgs )
 import GHC.Core
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Basic
 import GHC.Core.Map
-import Util             ( filterOut, equalLength, debugIsOn )
+import GHC.Utils.Misc   ( filterOut, equalLength, debugIsOn )
 import Data.List        ( mapAccumL )
 
 {-
diff --git a/compiler/GHC/Core/Opt/CallArity.hs b/compiler/GHC/Core/Opt/CallArity.hs
index 33a0e7c31de8b6e638fb3525971f5c5b119c4063..ef5bb94b238cc5157091c6e440ca78a934bbaeae 100644
--- a/compiler/GHC/Core/Opt/CallArity.hs
+++ b/compiler/GHC/Core/Opt/CallArity.hs
@@ -7,7 +7,7 @@ module GHC.Core.Opt.CallArity
     , callArityRHS -- for testing
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
@@ -18,9 +18,9 @@ import GHC.Core
 import GHC.Types.Id
 import GHC.Core.Arity ( typeArity )
 import GHC.Core.Utils ( exprIsCheap, exprIsTrivial )
-import UnVarGraph
+import GHC.Data.Graph.UnVar
 import GHC.Types.Demand
-import Util
+import GHC.Utils.Misc
 
 import Control.Arrow ( first, second )
 
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 91b44af996541a8a46e3667ba500015c88b9a920..7c18f27003392394088d4315a03be445469d71ec 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -26,7 +26,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Types.Id.Make ( mkPrimOpId, magicDictId )
 
@@ -49,13 +49,13 @@ import GHC.Core.Unfold ( exprIsConApp_maybe )
 import GHC.Core.Type
 import GHC.Types.Name.Occurrence ( occNameFS )
 import GHC.Builtin.Names
-import Maybes      ( orElse )
+import GHC.Data.Maybe      ( orElse )
 import GHC.Types.Name ( Name, nameOccName )
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Basic
 import GHC.Platform
-import Util
+import GHC.Utils.Misc
 import GHC.Core.Coercion   (mkUnbranchedAxInstCo,mkSymCo,Role(..))
 
 import Control.Applicative ( Alternative(..) )
diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs
index 4bc96a81d97b3eccb3f3bc3aaa3c0bde43d1ae6a..f29c8e713369cddc477a174bb409124a23c7852f 100644
--- a/compiler/GHC/Core/Opt/CprAnal.hs
+++ b/compiler/GHC/Core/Opt/CprAnal.hs
@@ -11,14 +11,14 @@ module GHC.Core.Opt.CprAnal ( cprAnalProgram ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Core
 import GHC.Core.Seq
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Var.Env
 import GHC.Types.Basic
 import Data.List
@@ -30,9 +30,9 @@ import GHC.Core.TyCon
 import GHC.Core.Type
 import GHC.Core.FamInstEnv
 import GHC.Core.Opt.WorkWrap.Utils
-import Util
-import ErrUtils         ( dumpIfSet_dyn, DumpFormat (..) )
-import Maybes           ( isJust, isNothing )
+import GHC.Utils.Misc
+import GHC.Utils.Error  ( dumpIfSet_dyn, DumpFormat (..) )
+import GHC.Data.Maybe   ( isJust, isNothing )
 
 {- Note [Constructed Product Result]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index 30956fd76859b5a674d6fd123de29ebcf6b1232e..5d4e65056419a6ec3d86bc561a6aecc07d30208b 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -13,14 +13,14 @@ module GHC.Core.Opt.DmdAnal ( dmdAnalProgram ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core.Opt.WorkWrap.Utils ( findTypeShape )
 import GHC.Types.Demand   -- All of it
 import GHC.Core
 import GHC.Core.Seq     ( seqBinds )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Var.Env
 import GHC.Types.Basic
 import Data.List        ( mapAccumL )
@@ -32,11 +32,11 @@ import GHC.Core.TyCon
 import GHC.Core.Type
 import GHC.Core.Coercion ( Coercion, coVarsOfCo )
 import GHC.Core.FamInstEnv
-import Util
-import Maybes           ( isJust )
+import GHC.Utils.Misc
+import GHC.Data.Maybe         ( isJust )
 import GHC.Builtin.Types
 import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
-import ErrUtils         ( dumpIfSet_dyn, DumpFormat (..) )
+import GHC.Utils.Error        ( dumpIfSet_dyn, DumpFormat (..) )
 import GHC.Types.Unique.Set
 
 {-
diff --git a/compiler/GHC/Core/Opt/Driver.hs b/compiler/GHC/Core/Opt/Driver.hs
index 0da360e589c1fc80fcee896b26f4a652ba8cc37c..43470240a6379e7e567a545e32926389376f2ea8 100644
--- a/compiler/GHC/Core/Opt/Driver.hs
+++ b/compiler/GHC/Core/Opt/Driver.hs
@@ -10,7 +10,7 @@ module GHC.Core.Opt.Driver ( core2core, simplifyExpr ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core
@@ -31,12 +31,12 @@ import GHC.Core.Opt.Simplify.Utils ( simplEnvForGHCi, activeRule, activeUnfoldin
 import GHC.Core.Opt.Simplify.Env
 import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Opt.Monad
-import qualified ErrUtils as Err
+import qualified GHC.Utils.Error as Err
 import GHC.Core.Opt.FloatIn  ( floatInwards )
 import GHC.Core.Opt.FloatOut ( floatOutwards )
 import GHC.Core.FamInstEnv
 import GHC.Types.Id
-import ErrUtils         ( withTiming, withTimingD, DumpFormat (..) )
+import GHC.Utils.Error  ( withTiming, withTimingD, DumpFormat (..) )
 import GHC.Types.Basic  ( CompilerPhase(..), isDefaultInlinePragma, defaultInlinePragma )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
@@ -50,14 +50,14 @@ import GHC.Core.Opt.CallArity    ( callArityAnalProgram )
 import GHC.Core.Opt.Exitify      ( exitifyProgram )
 import GHC.Core.Opt.WorkWrap     ( wwTopBinds )
 import GHC.Types.SrcLoc
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Module
 import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
 import GHC.Runtime.Loader -- ( initializePlugins )
 
 import GHC.Types.Unique.Supply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
 import GHC.Types.Unique.FM
-import Outputable
+import GHC.Utils.Outputable
 import Control.Monad
 import qualified GHC.LanguageExtensions as LangExt
 {-
@@ -186,7 +186,7 @@ getCoreToDo dflags
                            ))
 
     -- Static forms are moved to the top level with the FloatOut pass.
-    -- See Note [Grand plan for static forms] in StaticPtrTable.
+    -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
     static_ptrs_float_outwards =
       runWhen static_ptrs $ CoreDoPasses
         [ simpl_gently -- Float Out can't handle type lets (sometimes created
@@ -248,7 +248,7 @@ getCoreToDo dflags
         else
            -- Even with full laziness turned off, we still need to float static
            -- forms to the top level. See Note [Grand plan for static forms] in
-           -- StaticPtrTable.
+           -- GHC.Iface.Tidy.StaticPtrTable.
            static_ptrs_float_outwards,
 
         simpl_phases,
diff --git a/compiler/GHC/Core/Opt/Exitify.hs b/compiler/GHC/Core/Opt/Exitify.hs
index 088d0cb085602a20983774e664a7d7f02075edad..d903185c1dfb45534887f211cc43b77618e17e6d 100644
--- a/compiler/GHC/Core/Opt/Exitify.hs
+++ b/compiler/GHC/Core/Opt/Exitify.hs
@@ -35,20 +35,20 @@ Example result:
 Now `t` is no longer in a recursive function, and good things happen!
 -}
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Types.Var
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Core
 import GHC.Core.Utils
-import State
+import GHC.Utils.Monad.State
 import GHC.Types.Unique
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Core.FVs
-import FastString
+import GHC.Data.FastString
 import GHC.Core.Type
-import Util( mapSnd )
+import GHC.Utils.Misc( mapSnd )
 
 import Data.Bifunctor
 import Control.Monad
diff --git a/compiler/GHC/Core/Opt/FloatIn.hs b/compiler/GHC/Core/Opt/FloatIn.hs
index c5b8acc7f629bdba044d55756f1584bc6a3ee3d5..4d759a47bcb1cec5b75e689bfab55a0454980ee1 100644
--- a/compiler/GHC/Core/Opt/FloatIn.hs
+++ b/compiler/GHC/Core/Opt/FloatIn.hs
@@ -20,7 +20,7 @@ module GHC.Core.Opt.FloatIn ( floatInwards ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Core
@@ -33,9 +33,9 @@ import GHC.Types.Id         ( isOneShotBndr, idType, isJoinId, isJoinId_maybe )
 import GHC.Types.Var
 import GHC.Core.Type
 import GHC.Types.Var.Set
-import Util
+import GHC.Utils.Misc
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 -- import Data.List        ( mapAccumL )
 import GHC.Types.Basic      ( RecFlag(..), isRec )
 
diff --git a/compiler/GHC/Core/Opt/FloatOut.hs b/compiler/GHC/Core/Opt/FloatOut.hs
index d9d2d4dccfab88e05a6b9fba3a9ade52e3479c77..92a747424fd88f082ca8520b0dc0c7742701ce59 100644
--- a/compiler/GHC/Core/Opt/FloatOut.hs
+++ b/compiler/GHC/Core/Opt/FloatOut.hs
@@ -10,7 +10,7 @@
 
 module GHC.Core.Opt.FloatOut ( floatOutwards ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Utils
@@ -19,15 +19,15 @@ import GHC.Core.Arity    ( etaExpand )
 import GHC.Core.Opt.Monad ( FloatOutSwitches(..) )
 
 import GHC.Driver.Session
-import ErrUtils          ( dumpIfSet_dyn, DumpFormat (..) )
+import GHC.Utils.Error   ( dumpIfSet_dyn, DumpFormat (..) )
 import GHC.Types.Id      ( Id, idArity, idType, isBottomingId,
                            isJoinId, isJoinId_maybe )
 import GHC.Core.Opt.SetLevels
 import GHC.Types.Unique.Supply ( UniqSupply )
-import Bag
-import Util
-import Maybes
-import Outputable
+import GHC.Data.Bag
+import GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
 import GHC.Core.Type
 import qualified Data.IntMap as M
 
diff --git a/compiler/GHC/Core/Opt/LiberateCase.hs b/compiler/GHC/Core/Opt/LiberateCase.hs
index 2e284e3611d544c1d3aa3a562b87918a74fa570f..7a28abce202d863c89c04854c6aaa46742061363 100644
--- a/compiler/GHC/Core/Opt/LiberateCase.hs
+++ b/compiler/GHC/Core/Opt/LiberateCase.hs
@@ -9,7 +9,7 @@ module GHC.Core.Opt.LiberateCase ( liberateCase ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core
@@ -17,7 +17,7 @@ import GHC.Core.Unfold  ( couldBeSmallEnoughToInline )
 import GHC.Builtin.Types ( unitDataConId )
 import GHC.Types.Id
 import GHC.Types.Var.Env
-import Util             ( notNull )
+import GHC.Utils.Misc    ( notNull )
 
 {-
 The liberate-case transformation
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index 81faa53e47b358d9d9ec2aabd61e9b7282813c9b..19d0eec4a970e2341f472ce5b58a0298a7225e4f 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -48,7 +48,7 @@ module GHC.Core.Opt.Monad (
     dumpIfSet_dyn
   ) where
 
-import GhcPrelude hiding ( read )
+import GHC.Prelude hiding ( read )
 
 import GHC.Core
 import GHC.Driver.Types
@@ -57,18 +57,18 @@ import GHC.Driver.Session
 import GHC.Types.Basic  ( CompilerPhase(..) )
 import GHC.Types.Annotations
 
-import IOEnv hiding     ( liftIO, failM, failWithM )
-import qualified IOEnv  ( liftIO )
+import GHC.Data.IOEnv hiding     ( liftIO, failM, failWithM )
+import qualified GHC.Data.IOEnv  as IOEnv
 import GHC.Types.Var
-import Outputable
-import FastString
-import ErrUtils( Severity(..), DumpFormat (..), dumpOptionsFromFlag )
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.FastString
+import GHC.Utils.Error( Severity(..), DumpFormat (..), dumpOptionsFromFlag )
 import GHC.Types.Unique.Supply
-import MonadUtils
+import GHC.Utils.Monad
 import GHC.Types.Name.Env
 import GHC.Types.SrcLoc
 import Data.Bifunctor ( bimap )
-import ErrUtils (dumpAction)
+import GHC.Utils.Error (dumpAction)
 import Data.List (intersperse, groupBy, sortBy)
 import Data.Ord
 import Data.Dynamic
@@ -78,7 +78,7 @@ import qualified Data.Map.Strict as MapStrict
 import Data.Word
 import Control.Monad
 import Control.Applicative ( Alternative(..) )
-import Panic (throwGhcException, GhcException(..))
+import GHC.Utils.Panic (throwGhcException, GhcException(..))
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Core/Opt/Monad.hs-boot b/compiler/GHC/Core/Opt/Monad.hs-boot
index 6ea3a5b790ed74bc70522e362b6307df92aa4870..b92602dc59054acfbaec55981548b324511fed17 100644
--- a/compiler/GHC/Core/Opt/Monad.hs-boot
+++ b/compiler/GHC/Core/Opt/Monad.hs-boot
@@ -9,9 +9,9 @@
 
 module GHC.Core.Opt.Monad ( CoreToDo, CoreM ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import IOEnv ( IOEnv )
+import GHC.Data.IOEnv ( IOEnv )
 
 type CoreIOEnv = IOEnv CoreReader
 
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 4fe039cc52d866ec66bba799c7ded5e533790f88..21c7f86d784966e429d156000ce5e3b3af943499 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -18,7 +18,7 @@ module GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.FVs
@@ -36,15 +36,15 @@ 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 GHC.Data.Graph.Directed ( SCC(..), Node(..)
+                               , stronglyConnCompFromEdgedVerticesUniq
+                               , stronglyConnCompFromEdgedVerticesUniqR )
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import Util
-import Maybes( orElse, isJust )
-import Outputable
+import GHC.Utils.Misc
+import GHC.Data.Maybe( orElse, isJust )
+import GHC.Utils.Outputable
 import Data.List
 
 {-
@@ -1240,7 +1240,7 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs)
   = DigraphNode details (varUnique bndr) (nonDetKeysUniqSet node_fvs)
     -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR
     -- is still deterministic with edges in nondeterministic order as
-    -- explained in Note [Deterministic SCC] in Digraph.
+    -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
   where
     details = ND { nd_bndr            = bndr'
                  , nd_rhs             = rhs'
@@ -1334,7 +1334,7 @@ mkLoopBreakerNodes env lvl bndr_set body_uds details_s
               -- It's OK to use nonDetKeysUniqSet here as
               -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges
               -- in nondeterministic order as explained in
-              -- Note [Deterministic SCC] in Digraph.
+              -- Note [Deterministic SCC] in GHC.Data.Graph.Directed.
       where
         nd'     = nd { nd_bndr = new_bndr, nd_score = score }
         score   = nodeScore env new_bndr lb_deps nd
diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs
index 710a8cf70f3bc63d17e87c902a9df1647f9158f8..8f5d9c654a3a639aa9bb531c03d7d12dd52b12a6 100644
--- a/compiler/GHC/Core/Opt/SetLevels.hs
+++ b/compiler/GHC/Core/Opt/SetLevels.hs
@@ -64,7 +64,7 @@ module GHC.Core.Opt.SetLevels (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Opt.Monad ( FloatOutSwitches(..) )
@@ -97,13 +97,13 @@ import GHC.Types.Basic  ( Arity, RecFlag(..), isRec )
 import GHC.Core.DataCon ( dataConOrigResTy )
 import GHC.Builtin.Types
 import GHC.Types.Unique.Supply
-import Util
-import Outputable
-import FastString
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Unique.DFM
-import FV
+import GHC.Utils.FV
 import Data.Maybe
-import MonadUtils       ( mapAccumLM )
+import GHC.Utils.Monad  ( mapAccumLM )
 
 {-
 ************************************************************************
@@ -702,7 +702,7 @@ lvlMFE env strict_ctxt ann_expr
     join_arity_maybe = Nothing
 
     is_mk_static = isJust (collectMakeStaticArgs expr)
-        -- Yuk: See Note [Grand plan for static forms] in main/StaticPtrTable
+        -- Yuk: See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable
 
         -- A decision to float entails let-binding this thing, and we only do
         -- that if we'll escape a value lambda, or will go to the top level.
@@ -1699,7 +1699,7 @@ newLvlVar lvld_rhs join_arity_maybe is_mk_static
     rhs_ty        = exprType de_tagged_rhs
 
     mk_id uniq rhs_ty
-      -- See Note [Grand plan for static forms] in StaticPtrTable.
+      -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
       | is_mk_static
       = mkExportedVanillaId (mkSystemVarName uniq (mkFastString "static_ptr"))
                             rhs_ty
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index d2b63ecb9417f70c4ec064af4a2b9eb03f9b7ed6..8198ba32cf28b6f61c24844f58b703552f982aaa 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -11,7 +11,7 @@ module GHC.Core.Opt.Simplify ( simplTopBinds, simplExpr, simplRules ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Driver.Session
@@ -49,14 +49,14 @@ import GHC.Core.FVs     ( mkRuleInfo )
 import GHC.Core.Rules   ( lookupRule, getRules )
 import GHC.Types.Basic  ( TopLevelFlag(..), isNotTopLevel, isTopLevel,
                           RecFlag(..), Arity )
-import MonadUtils       ( mapAccumLM, liftIO )
+import GHC.Utils.Monad  ( mapAccumLM, liftIO )
 import GHC.Types.Var    ( isTyCoVar )
-import Maybes           ( orElse )
+import GHC.Data.Maybe   ( orElse )
 import Control.Monad
-import Outputable
-import FastString
-import Util
-import ErrUtils
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc
+import GHC.Utils.Error
 import GHC.Types.Module ( moduleName, pprModuleName )
 import GHC.Builtin.PrimOps ( PrimOp (SeqOp) )
 
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs
index 2827ba037d9850a3292c1aac48e799f7aca34c33..4a749e8951972b17c111d3a2932f5574685eeee6 100644
--- a/compiler/GHC/Core/Opt/Simplify/Env.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Env.hs
@@ -45,7 +45,7 @@ module GHC.Core.Opt.Simplify.Env (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Opt.Monad        ( SimplMode(..) )
@@ -54,7 +54,7 @@ import GHC.Core.Utils
 import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
-import OrdList
+import GHC.Data.OrdList
 import GHC.Types.Id as Id
 import GHC.Core.Make            ( mkWildValBinder )
 import GHC.Driver.Session       ( DynFlags )
@@ -64,9 +64,9 @@ import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, extendTvS
 import qualified GHC.Core.Coercion as Coercion
 import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
 import GHC.Types.Basic
-import MonadUtils
-import Outputable
-import Util
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Unique.FM      ( pprUniqFM )
 
 import Data.List (mapAccumL)
diff --git a/compiler/GHC/Core/Opt/Simplify/Monad.hs b/compiler/GHC/Core/Opt/Simplify/Monad.hs
index 043ced977b928695bca4c7e68d6bbf5a4fe1d932..b36d440402bcbbec236d95b7d2c52da2ef01797b 100644
--- a/compiler/GHC/Core/Opt/Simplify/Monad.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Monad.hs
@@ -20,7 +20,7 @@ module GHC.Core.Opt.Simplify.Monad (
         plusSimplCount, isZeroSimplCount
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var       ( Var, isId, mkLocalVar )
 import GHC.Types.Name      ( mkSystemVarName )
@@ -32,12 +32,12 @@ import GHC.Core            ( RuleEnv(..) )
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
 import GHC.Core.Opt.Monad
-import Outputable
-import FastString
-import MonadUtils
-import ErrUtils as Err
-import Util                ( count )
-import Panic               (throwGhcExceptionIO, GhcException (..))
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Monad
+import GHC.Utils.Error as Err
+import GHC.Utils.Misc      ( count )
+import GHC.Utils.Panic     (throwGhcExceptionIO, GhcException (..))
 import GHC.Types.Basic     ( IntWithInf, treatZeroAsInf, mkIntWithInf )
 import Control.Monad       ( ap )
 
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 1de946f7244aec87ff84c295787f4b81b15e86ac..14e1a08fe047ffa8686474710d9d2faf8945db8e 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -38,7 +38,7 @@ module GHC.Core.Opt.Simplify.Utils (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Opt.Simplify.Env
 import GHC.Core.Opt.Monad        ( SimplMode(..), Tick(..) )
@@ -63,12 +63,12 @@ import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Type     hiding( substTy )
 import GHC.Core.Coercion hiding( substCo )
 import GHC.Core.DataCon ( dataConWorkId, isNullaryRepDataCon )
-import Util
-import OrdList          ( isNilOL )
-import MonadUtils
-import Outputable
+import GHC.Utils.Misc
+import GHC.Data.OrdList ( isNilOL )
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Core.Opt.ConstantFold
-import FastString       ( fsLit )
+import GHC.Data.FastString ( fsLit )
 
 import Control.Monad    ( when )
 import Data.List        ( sortBy )
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index f0a7821b1f89c60f4ce3f8f60d4dcc537b275aee..60029cb478c8569c12912c00248141413d51ab9d 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -21,7 +21,7 @@ module GHC.Core.Opt.SpecConstr(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Subst
@@ -46,17 +46,17 @@ 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 GHC.Data.Maybe     ( orElse, catMaybes, isJust, isNothing )
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Serialized   ( deserializeWithData )
-import Util
-import Pair
+import GHC.Utils.Misc
+import GHC.Data.Pair
 import GHC.Types.Unique.Supply
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Unique.FM
-import MonadUtils
+import GHC.Utils.Monad
 import Control.Monad    ( zipWithM )
 import Data.List
 import GHC.Builtin.Names ( specTyConName )
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index b1a85fa93f84e938bfc9b893001c627ead7544f5..f40e67adcd6a4d9582b3f41ac84ec2f0067e8b1f 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -13,7 +13,7 @@ module GHC.Core.Opt.Specialise ( specProgram, specUnfolding ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Id
 import GHC.Tc.Utils.TcType hiding( substTy )
@@ -38,16 +38,16 @@ import GHC.Types.Unique.Supply
 import GHC.Types.Name
 import GHC.Types.Id.Make  ( voidArgId, voidPrimId )
 import GHC.Builtin.Types.Prim ( voidPrimTy )
-import Maybes           ( mapMaybe, maybeToList, isJust )
-import MonadUtils       ( foldlM )
+import GHC.Data.Maybe     ( mapMaybe, maybeToList, isJust )
+import GHC.Utils.Monad    ( foldlM )
 import GHC.Types.Basic
 import GHC.Driver.Types
-import Bag
+import GHC.Data.Bag
 import GHC.Driver.Session
-import Util
-import Outputable
-import FastString
-import State
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Monad.State
 import GHC.Types.Unique.DFM
 import GHC.Core.TyCo.Rep (TyCoBinder (..))
 
diff --git a/compiler/GHC/Core/Opt/StaticArgs.hs b/compiler/GHC/Core/Opt/StaticArgs.hs
index 0abcc063829aefc4ce9735a60e8d29a565092f79..827a3e90a59539cbe5a41c5a7fcb2ae11eeb773a 100644
--- a/compiler/GHC/Core/Opt/StaticArgs.hs
+++ b/compiler/GHC/Core/Opt/StaticArgs.hs
@@ -51,7 +51,7 @@ essential to make this work well!
 {-# LANGUAGE CPP #-}
 module GHC.Core.Opt.StaticArgs ( doStaticArgs ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var
 import GHC.Core
@@ -62,15 +62,15 @@ import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Var.Env
 import GHC.Types.Unique.Supply
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique.FM
 import GHC.Types.Var.Set
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
-import Outputable
+import GHC.Utils.Outputable
 
 import Data.List (mapAccumL)
-import FastString
+import GHC.Data.FastString
 
 #include "HsVersions.h"
 
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 0ba6acb73195a39beae5d94bd50e6b8bc882f7b7..52cdf04edfb982529333016846db5453b27dc626 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -7,7 +7,7 @@
 {-# LANGUAGE CPP #-}
 module GHC.Core.Opt.WorkWrap ( wwTopBinds ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Arity  ( manifestArity )
 import GHC.Core
@@ -24,10 +24,10 @@ import GHC.Driver.Session
 import GHC.Types.Demand
 import GHC.Types.Cpr
 import GHC.Core.Opt.WorkWrap.Utils
-import Util
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Core.FamInstEnv
-import MonadUtils
+import GHC.Utils.Monad
 
 #include "HsVersions.h"
 
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index cbd8788d667a4f084ffe40f405c3d1a0b371cf77..4c4c3dc5e7d71f662ea466e488dd442dcf0aceaa 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -16,7 +16,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Utils   ( exprType, mkCast, mkDefaultCase, mkSingleAltCase )
@@ -42,12 +42,12 @@ import GHC.Types.Basic       ( Boxity(..) )
 import GHC.Core.TyCon
 import GHC.Types.Unique.Supply
 import GHC.Types.Unique
-import Maybes
-import Util
-import Outputable
+import GHC.Data.Maybe
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Driver.Session
-import FastString
-import ListSetOps
+import GHC.Data.FastString
+import GHC.Data.List.SetOps
 
 {-
 ************************************************************************
@@ -345,7 +345,7 @@ f x y = join j (z, w) = \(u, v) -> ...
         in jump j (x, y)
 
 Typically this happens with functions that are seen as computing functions,
-rather than being curried. (The real-life example was GraphOps.addConflicts.)
+rather than being curried. (The real-life example was GHC.Data.Graph.Ops.addConflicts.)
 
 When we create the wrapper, it *must* be in "eta-contracted" form so that the
 jump has the right number of arguments:
diff --git a/compiler/GHC/Core/PatSyn.hs b/compiler/GHC/Core/PatSyn.hs
index 39e91795d62f0f12a8b9c42888389f9a17f7aa10..6179cd600bdf1383b5f7f7e5765f3702e7d5b48c 100644
--- a/compiler/GHC/Core/PatSyn.hs
+++ b/compiler/GHC/Core/PatSyn.hs
@@ -24,14 +24,14 @@ module GHC.Core.PatSyn (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Type
 import GHC.Core.TyCo.Ppr
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Basic
 import GHC.Types.Var
 import GHC.Types.FieldLabel
diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs
index df88351df2e2caf16448ad74c0a15bdd5bd62ee8..6c3eedb77fca919ce8fa2f67e615675cbf43a3d3 100644
--- a/compiler/GHC/Core/Ppr.hs
+++ b/compiler/GHC/Core/Ppr.hs
@@ -17,7 +17,7 @@ module GHC.Core.Ppr (
         pprRules, pprOptCo
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Stats (exprStats)
@@ -33,10 +33,10 @@ import GHC.Core.TyCon
 import GHC.Core.TyCo.Ppr
 import GHC.Core.Coercion
 import GHC.Types.Basic
-import Maybes
-import Util
-import Outputable
-import FastString
+import GHC.Data.Maybe
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.SrcLoc ( pprUserRealSpan )
 
 {-
diff --git a/compiler/GHC/Core/Ppr/TyThing.hs b/compiler/GHC/Core/Ppr/TyThing.hs
index 6782ba151825d6a1d65aa1dfe995bc3d76ab7bb1..628d13ad7fbdde25118c28ce33a47ee02f555cfd 100644
--- a/compiler/GHC/Core/Ppr/TyThing.hs
+++ b/compiler/GHC/Core/Ppr/TyThing.hs
@@ -19,7 +19,7 @@ module GHC.Core.Ppr.TyThing (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Type    ( Type, ArgFlag(..), TyThing(..), mkTyVarBinders, tidyOpenType )
 import GHC.Iface.Syntax ( ShowSub(..), ShowHowMuch(..), AltPpr(..)
@@ -31,7 +31,7 @@ import GHC.Core.FamInstEnv( FamInst(..), FamFlavor(..) )
 import GHC.Core.TyCo.Ppr ( pprUserForAll, pprTypeApp, pprSigmaType )
 import GHC.Types.Name
 import GHC.Types.Var.Env( emptyTidyEnv )
-import Outputable
+import GHC.Utils.Outputable
 
 -- -----------------------------------------------------------------------------
 -- Pretty-printing entities that we get from the GHC API
diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs
index dbeb099440b9adc6b3304e69f04b53db80f43b5c..9f0eefef303ce8e3a0ee54039e37ab7a974d90d1 100644
--- a/compiler/GHC/Core/Predicate.hs
+++ b/compiler/GHC/Core/Predicate.hs
@@ -28,7 +28,7 @@ module GHC.Core.Predicate (
   DictId, isEvVar, isDictId
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Type
 import GHC.Core.Class
@@ -38,9 +38,9 @@ import GHC.Core.Coercion
 
 import GHC.Builtin.Names
 
-import FastString
-import Outputable
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Control.Monad ( guard )
 
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index 899ae25d1b8b6af1a3a0885a66b63bdabb65e2e5..d4e60446bf98df5ba739e979a6c094016c2b26dc 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -28,7 +28,7 @@ module GHC.Core.Rules (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core         -- All of it
 import GHC.Types.Module   ( Module, ModuleSet, elemModuleSet )
@@ -60,11 +60,11 @@ import GHC.Core.Unify as Unify ( ruleMatchTyKiX )
 import GHC.Types.Basic
 import GHC.Driver.Session      ( DynFlags, gopt, targetPlatform )
 import GHC.Driver.Flags
-import Outputable
-import FastString
-import Maybes
-import Bag
-import Util
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Maybe
+import GHC.Data.Bag
+import GHC.Utils.Misc
 import Data.List
 import Data.Ord
 import Control.Monad    ( guard )
diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs
index 451a6fa4e3ed2d46546994d6c146564ccdc764e3..25a6ab31dc5b6f91f7d62fce4e0ac454a6baa4fa 100644
--- a/compiler/GHC/Core/Seq.hs
+++ b/compiler/GHC/Core/Seq.hs
@@ -10,7 +10,7 @@ module GHC.Core.Seq (
         megaSeqIdInfo, seqRuleInfo, seqBinds,
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Types.Id.Info
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 7545209b778d491ac59892f44c1b9f02e0b427b0..2f9d86627febd5340430d78f3811080d4318c6a7 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -20,7 +20,7 @@ module GHC.Core.SimpleOpt (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Arity( etaExpandToJoinPoint )
 
@@ -49,13 +49,13 @@ import GHC.Builtin.Types
 import GHC.Builtin.Names
 import GHC.Types.Basic
 import GHC.Types.Module ( Module )
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Session
-import Outputable
-import Pair
-import Util
-import Maybes       ( orElse )
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.Pair
+import GHC.Utils.Misc
+import GHC.Data.Maybe       ( orElse )
+import GHC.Data.FastString
 import Data.List
 import qualified Data.ByteString as BS
 
diff --git a/compiler/GHC/Core/Stats.hs b/compiler/GHC/Core/Stats.hs
index 29f2f44df4f2330a98ed9b4b15b038f8ca3507fa..cdff8283be1589ab2d8778f10073fe0e2ba22946 100644
--- a/compiler/GHC/Core/Stats.hs
+++ b/compiler/GHC/Core/Stats.hs
@@ -11,11 +11,11 @@ module GHC.Core.Stats (
         CoreStats(..), coreBindsStats, exprStats,
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
 import GHC.Core
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.Coercion
 import GHC.Types.Var
 import GHC.Core.Type(Type, typeSize)
diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs
index 9963875bf3a5cf6460e8d73d329c8e4dc72e58f3..ddb5b61f7bbd92bb0c53d6f0ea965afc7e443f0a 100644
--- a/compiler/GHC/Core/Subst.hs
+++ b/compiler/GHC/Core/Subst.hs
@@ -37,7 +37,7 @@ module GHC.Core.Subst (
 #include "HsVersions.h"
 
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.FVs
@@ -60,9 +60,9 @@ 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
+import GHC.Data.Maybe
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import Data.List
 
 
diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs
index 0b9d91af8a53be527d8381d8cd05246046abb131..c31b58f6edbe242765d0a2bd4135309f1536ce4a 100644
--- a/compiler/GHC/Core/Tidy.hs
+++ b/compiler/GHC/Core/Tidy.hs
@@ -15,7 +15,7 @@ module GHC.Core.Tidy (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Seq ( seqUnfolding )
@@ -29,7 +29,7 @@ import GHC.Types.Var.Env
 import GHC.Types.Unique.FM
 import GHC.Types.Name hiding (tidyNameOcc)
 import GHC.Types.SrcLoc
-import Maybes
+import GHC.Data.Maybe
 import Data.List
 
 {-
diff --git a/compiler/GHC/Core/TyCo/FVs.hs b/compiler/GHC/Core/TyCo/FVs.hs
index 3c4246750f11a7bf5093b03d1ac975a061869d5b..f54cbe71b37580c93f80e45c75edd3f1b710c973 100644
--- a/compiler/GHC/Core/TyCo/FVs.hs
+++ b/compiler/GHC/Core/TyCo/FVs.hs
@@ -43,7 +43,7 @@ module GHC.Core.TyCo.FVs
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.Type (coreView, partitionInvisibleTypes)
 
@@ -51,13 +51,13 @@ import Data.Monoid as DM ( Endo(..), All(..) )
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCon
 import GHC.Types.Var
-import FV
+import GHC.Utils.FV
 
 import GHC.Types.Unique.FM
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import Util
-import Panic
+import GHC.Utils.Misc
+import GHC.Utils.Panic
 
 {-
 %************************************************************************
@@ -523,14 +523,14 @@ closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems
 
 -- | `tyCoFVsOfType` that returns free variables of a type in a deterministic
 -- set. For explanation of why using `VarSet` is not deterministic see
--- Note [Deterministic FV] in FV.
+-- Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet
 -- See Note [Free variables of types]
 tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty
 
 -- | `tyCoFVsOfType` that returns free variables of a type in deterministic
 -- order. For explanation of why using `VarSet` is not deterministic see
--- Note [Deterministic FV] in FV.
+-- Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfTypeList :: Type -> [TyCoVar]
 -- See Note [Free variables of types]
 tyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty
@@ -554,10 +554,10 @@ tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys
 -- make the function quadratic.
 -- It's exported, so that it can be composed with
 -- other functions that compute free variables.
--- See Note [FV naming conventions] in FV.
+-- See Note [FV naming conventions] in GHC.Utils.FV.
 --
 -- Eta-expanded because that makes it run faster (apparently)
--- See Note [FV eta expansion] in FV for explanation.
+-- See Note [FV eta expansion] in GHC.Utils.FV for explanation.
 tyCoFVsOfType :: Type -> FV
 -- See Note [Free variables of types]
 tyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)
diff --git a/compiler/GHC/Core/TyCo/Ppr.hs b/compiler/GHC/Core/TyCo/Ppr.hs
index 751aa11b75ca60bcdc6a5967cdbee18c8715b11d..973641bf5cbc6103d3d92645d688af35c5aeb613 100644
--- a/compiler/GHC/Core/TyCo/Ppr.hs
+++ b/compiler/GHC/Core/TyCo/Ppr.hs
@@ -25,7 +25,7 @@ module GHC.Core.TyCo.Ppr
         pprTyThingCategory, pprShortTyThing,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.CoreToIface
    ( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr
@@ -50,7 +50,7 @@ import GHC.Iface.Type
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Basic ( PprPrec(..), topPrec, sigPrec, opPrec
                        , funPrec, appPrec, maybeParen )
 
diff --git a/compiler/GHC/Core/TyCo/Ppr.hs-boot b/compiler/GHC/Core/TyCo/Ppr.hs-boot
index 64562d9a288c83541e39e2d571a6dd0686ae975a..8e89c334eae942f9b90820b507d098aeb68b7169 100644
--- a/compiler/GHC/Core/TyCo/Ppr.hs-boot
+++ b/compiler/GHC/Core/TyCo/Ppr.hs-boot
@@ -1,7 +1,7 @@
 module GHC.Core.TyCo.Ppr where
 
 import {-# SOURCE #-} GHC.Core.TyCo.Rep (Type, Kind, Coercion, TyLit)
-import Outputable
+import GHC.Utils.Outputable
 
 pprType :: Type -> SDoc
 pprKind :: Kind -> SDoc
diff --git a/compiler/GHC/Core/TyCo/Rep.hs b/compiler/GHC/Core/TyCo/Rep.hs
index 00d3f95c43b3ddbffd0c29c67f8f36c0dabf3cba..4ac731bc07146c766bf961ecf010a044edf3c099 100644
--- a/compiler/GHC/Core/TyCo/Rep.hs
+++ b/compiler/GHC/Core/TyCo/Rep.hs
@@ -70,7 +70,7 @@ module GHC.Core.TyCo.Rep (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType, pprCo, pprTyLit )
 
@@ -88,9 +88,9 @@ import GHC.Core.Coercion.Axiom
 
 -- others
 import GHC.Types.Basic ( LeftOrRight(..), pickLR )
-import Outputable
-import FastString
-import Util
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc
 
 -- libraries
 import qualified Data.Data as Data hiding ( TyCon )
diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs
index a4d0c49b46a38543da71c9f778557d48686a74c1..ed885bfdfd234560cd3933df1cb2fa36b8ab89ab 100644
--- a/compiler/GHC/Core/TyCo/Subst.hs
+++ b/compiler/GHC/Core/TyCo/Subst.hs
@@ -53,7 +53,7 @@ module GHC.Core.TyCo.Subst
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.Type
    ( mkCastTy, mkAppTy, isCoercionTy )
@@ -74,13 +74,13 @@ import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 
-import Pair
-import Util
+import GHC.Data.Pair
+import GHC.Utils.Misc
 import GHC.Types.Unique.Supply
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import Outputable
+import GHC.Utils.Outputable
 
 import Data.List (mapAccumL)
 
diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs
index f18ee4f1328a53898f36ac7748403d39ffb0ddae..8ec4b5818bda68f74f05dcefe7f26e711dad8d83 100644
--- a/compiler/GHC/Core/TyCo/Tidy.hs
+++ b/compiler/GHC/Core/TyCo/Tidy.hs
@@ -18,7 +18,7 @@ module GHC.Core.TyCo.Tidy
         tidyTyCoVarBinder, tidyTyCoVarBinders
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList)
@@ -26,7 +26,7 @@ import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList)
 import GHC.Types.Name hiding (varName)
 import GHC.Types.Var
 import GHC.Types.Var.Env
-import Util (seqList)
+import GHC.Utils.Misc (seqList)
 
 import Data.List (mapAccumL)
 
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index e82cb2e21930ed1d9c80c194a1d7bd89f0e79232..c45b744c7bd674074d881bebd1000e79815e3af6 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -134,7 +134,7 @@ module GHC.Core.TyCon(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import {-# SOURCE #-} GHC.Core.TyCo.Rep
@@ -149,7 +149,7 @@ import {-# SOURCE #-} GHC.Core.DataCon
    , dataConTyCon, dataConFullSig
    , isUnboxedSumCon )
 
-import Binary
+import GHC.Utils.Binary
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Core.Class
@@ -159,12 +159,12 @@ import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Core.Coercion.Axiom
 import GHC.Builtin.Names
-import Maybes
-import Outputable
-import FastStringEnv
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
+import GHC.Data.FastString.Env
 import GHC.Types.FieldLabel
 import GHC.Settings.Constants
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique( tyConRepNameUnique, dataConTyRepNameUnique )
 import GHC.Types.Unique.Set
 import GHC.Types.Module
diff --git a/compiler/GHC/Core/TyCon.hs-boot b/compiler/GHC/Core/TyCon.hs-boot
index 84df99b0a9c116fe31ba818858c758aec27fc551..1081249d19fdf57b720323d6bae6aff30c716986 100644
--- a/compiler/GHC/Core/TyCon.hs-boot
+++ b/compiler/GHC/Core/TyCon.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Core.TyCon where
 
-import GhcPrelude
+import GHC.Prelude
 
 data TyCon
 
diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs
index a6521801b432c938cb9d9b7416d47ee6cf1d09cf..1e7af2d8cf301461918fa1f8c73238ebcd4f3831 100644
--- a/compiler/GHC/Core/Type.hs
+++ b/compiler/GHC/Core/Type.hs
@@ -221,7 +221,7 @@ module GHC.Core.Type (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
 
@@ -260,15 +260,15 @@ import {-# SOURCE #-} GHC.Core.Coercion
    , isReflexiveCo, seqCo )
 
 -- others
-import Util
-import FV
-import Outputable
-import FastString
-import Pair
-import ListSetOps
+import GHC.Utils.Misc
+import GHC.Utils.FV
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Pair
+import GHC.Data.List.SetOps
 import GHC.Types.Unique ( nonDetCmpUnique )
 
-import Maybes           ( orElse )
+import GHC.Data.Maybe   ( orElse )
 import Data.Maybe       ( isJust )
 import Control.Monad    ( guard )
 
diff --git a/compiler/GHC/Core/Type.hs-boot b/compiler/GHC/Core/Type.hs-boot
index e2d479be7d72c3fec63ed54ecf6dbe62a5679f96..08efbf608d203d59e304b41707e0596dd25d4ae5 100644
--- a/compiler/GHC/Core/Type.hs-boot
+++ b/compiler/GHC/Core/Type.hs-boot
@@ -2,10 +2,10 @@
 
 module GHC.Core.Type where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Core.TyCon
 import {-# SOURCE #-} GHC.Core.TyCo.Rep( Type, Coercion )
-import Util
+import GHC.Utils.Misc
 
 isPredTy     :: HasDebugCallStack => Type -> Bool
 isCoercionTy :: Type -> Bool
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 6c88c5a24dd49ea440e32018062386a4cb20d177..f619e36f8a453e9af6eb652334a25d9ba1ba9215 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -44,7 +44,7 @@ module GHC.Core.Unfold (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core
@@ -62,12 +62,12 @@ import GHC.Types.Basic  ( Arity, InlineSpec(..), inlinePragmaSpec )
 import GHC.Core.Type
 import GHC.Builtin.Names
 import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
-import Bag
-import Util
-import Outputable
+import GHC.Data.Bag
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Types.ForeignCall
 import GHC.Types.Name
-import ErrUtils
+import GHC.Utils.Error
 
 import qualified Data.ByteString as BS
 import Data.List
diff --git a/compiler/GHC/Core/Unfold.hs-boot b/compiler/GHC/Core/Unfold.hs-boot
index 54895ae8b17c6eb7213005b5356efe1461a4bae2..4706af49e7b668a4241abcba388e5b4fee5d727f 100644
--- a/compiler/GHC/Core/Unfold.hs-boot
+++ b/compiler/GHC/Core/Unfold.hs-boot
@@ -2,7 +2,7 @@ module GHC.Core.Unfold (
         mkUnfolding, mkInlineUnfolding
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Core
 import GHC.Driver.Session
 
diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs
index 2e77a9909e7d2fae34e1e171fdb04137fe688993..3801126ba9c2c84b5509b66d331d79038d11d849 100644
--- a/compiler/GHC/Core/Unify.hs
+++ b/compiler/GHC/Core/Unify.hs
@@ -26,7 +26,7 @@ module GHC.Core.Unify (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var
 import GHC.Types.Var.Env
@@ -38,10 +38,10 @@ import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs   ( tyCoVarsOfCoList, tyCoFVsOfTypes )
 import GHC.Core.TyCo.Subst ( mkTvSubst )
-import FV( FV, fvVarSet, fvVarList )
-import Util
-import Pair
-import Outputable
+import GHC.Utils.FV( FV, fvVarSet, fvVarList )
+import GHC.Utils.Misc
+import GHC.Data.Pair
+import GHC.Utils.Outputable
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
 
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index d954374eef345ec9f6d32671f1931f30752eac63..6faf1794899b86a7e8ef355a9c969b817e278e0a 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -62,7 +62,7 @@ module GHC.Core.Utils (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Core
@@ -86,19 +86,19 @@ import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder )
 import GHC.Core.Coercion
 import GHC.Core.TyCon
 import GHC.Types.Unique
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Types.Prim
-import FastString
-import Maybes
-import ListSetOps       ( minusList )
+import GHC.Data.FastString
+import GHC.Data.Maybe
+import GHC.Data.List.SetOps( minusList )
 import GHC.Types.Basic     ( Arity )
-import Util
-import Pair
+import GHC.Utils.Misc
+import GHC.Data.Pair
 import Data.ByteString     ( ByteString )
 import Data.Function       ( on )
 import Data.List
 import Data.Ord            ( comparing )
-import OrdList
+import GHC.Data.OrdList
 import qualified Data.Set as Set
 import GHC.Types.Unique.Set
 
@@ -2099,7 +2099,7 @@ eqExpr in_scope e1 e2
         env' = rnBndrs2 env bs1 bs2
 
     go env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
-      | null a1   -- See Note [Empty case alternatives] in TrieMap
+      | null a1   -- See Note [Empty case alternatives] in GHC.Data.TrieMap
       = null a2 && go env e1 e2 && eqTypeX env t1 t2
       | otherwise
       =  go env e1 e2 && all2 (go_alt (rnBndr2 env b1 b2)) a1 a2
@@ -2147,7 +2147,7 @@ diffExpr top env (Let bs1 e1) (Let bs2 e2)
     in ds ++ diffExpr top env' e1 e2
 diffExpr top env (Case e1 b1 t1 a1) (Case e2 b2 t2 a2)
   | equalLength a1 a2 && not (null a1) || eqTypeX env t1 t2
-    -- See Note [Empty case alternatives] in TrieMap
+    -- See Note [Empty case alternatives] in GHC.Data.TrieMap
   = diffExpr top env e1 e2 ++ concat (zipWith diffAlt a1 a2)
   where env' = rnBndr2 env b1 b2
         diffAlt (c1, bs1, e1) (c2, bs2, e2)
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index b2f185498c342319bbb1c867da14586e775127ac..1f3c0dd85d72c7d5ab2dcf1b5778ab8a859d64d4 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -12,7 +12,7 @@ module GHC.CoreToByteCode ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.ByteCode.Instr
 import GHC.ByteCode.Asm
@@ -23,7 +23,7 @@ import GHCi.FFI
 import GHCi.RemoteTypes
 import GHC.Types.Basic
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import GHC.Types.Name
 import GHC.Types.Id.Make
@@ -41,20 +41,20 @@ import GHC.Core.Type
 import GHC.Types.RepType
 import GHC.Core.DataCon
 import GHC.Core.TyCon
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Set
 import GHC.Builtin.Types.Prim
 import GHC.Core.TyCo.Ppr ( pprType )
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Unique
-import FastString
-import Panic
+import GHC.Data.FastString
+import GHC.Utils.Panic
 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 GHC.Data.OrdList
+import GHC.Data.Maybe
 import GHC.Types.Var.Env
 import GHC.Builtin.Names ( unsafeEqualityProofName )
 
@@ -73,7 +73,7 @@ import Data.Map (Map)
 import Data.IntMap (IntMap)
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
-import qualified FiniteMap as Map
+import qualified GHC.Data.FiniteMap as Map
 import Data.Ord
 import GHC.Stack.CCS
 import Data.Either ( partitionEithers )
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index dcce320ed9536c4c6caaf6010430a810b2d736c9..93c5ba5672f8857d5434d58e6adcb2d82d970001 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -45,7 +45,7 @@ module GHC.CoreToIface
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Syntax
 import GHC.Core.DataCon
@@ -62,9 +62,9 @@ import GHC.Types.Name
 import GHC.Types.Basic
 import GHC.Core.Type
 import GHC.Core.PatSyn
-import Outputable
-import FastString
-import Util
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index a35c81789b8eb8900f1abec5f31bb019b3318e90..8534ff77383d826e4128328f8a2e45c037b2afa1 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -15,7 +15,7 @@ module GHC.CoreToStg ( coreToStg ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Core.Utils   ( exprType, findDefault, isJoinBind
@@ -37,10 +37,10 @@ import GHC.Types.Name   ( isExternalName, nameModule_maybe )
 import GHC.Types.Basic  ( Arity )
 import GHC.Builtin.Types ( unboxedUnitDataCon, unitDataConId )
 import GHC.Types.Literal
-import Outputable
-import MonadUtils
-import FastString
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Monad
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Driver.Session
 import GHC.Driver.Ways
 import GHC.Types.ForeignCall
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index 50ae474cdf0a5c370f8172a1a658243daaf58331..c4c2463153920e58596af27a52e79d663fe47c66 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -17,7 +17,7 @@ module GHC.CoreToStg.Prep (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Core.Opt.OccurAnal
@@ -48,18 +48,18 @@ import GHC.Core.DataCon
 import GHC.Types.Basic
 import GHC.Types.Module
 import GHC.Types.Unique.Supply
-import Maybes
-import OrdList
-import ErrUtils
+import GHC.Data.Maybe
+import GHC.Data.OrdList
+import GHC.Utils.Error
 import GHC.Driver.Session
 import GHC.Driver.Ways
-import Util
-import Outputable
-import FastString
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Name   ( NamedThing(..), nameSrcSpan, isInternalName )
 import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
 import Data.Bits
-import MonadUtils       ( mapAccumLM )
+import GHC.Utils.Monad      ( mapAccumLM )
 import Control.Monad
 import GHC.Types.CostCentre ( CostCentre, ccFromThisModule )
 import qualified Data.Set as S
diff --git a/compiler/utils/Bag.hs b/compiler/GHC/Data/Bag.hs
similarity index 99%
rename from compiler/utils/Bag.hs
rename to compiler/GHC/Data/Bag.hs
index e1eea480009f6ea4791432b8e3363e187feeba6a..aa18bec5e135954c8e8c70db161144ce2ebad4be 100644
--- a/compiler/utils/Bag.hs
+++ b/compiler/GHC/Data/Bag.hs
@@ -8,7 +8,7 @@ Bag: an unordered collection with duplicates
 
 {-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor #-}
 
-module Bag (
+module GHC.Data.Bag (
         Bag, -- abstract type
 
         emptyBag, unitBag, unionBags, unionManyBags,
@@ -25,12 +25,12 @@ module Bag (
         anyBagM, filterBagM
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
-import MonadUtils
+import GHC.Utils.Monad
 import Control.Monad
 import Data.Data
 import Data.Maybe( mapMaybe )
diff --git a/compiler/GHC/Data/Bitmap.hs b/compiler/GHC/Data/Bitmap.hs
index 55700ddf9acccd5b15b67b9cda79eef2a3cb4f61..0b7158aa24a6317ae27f7f5f27e801f0dc572c10 100644
--- a/compiler/GHC/Data/Bitmap.hs
+++ b/compiler/GHC/Data/Bitmap.hs
@@ -14,7 +14,7 @@ module GHC.Data.Bitmap (
         mAX_SMALL_BITMAP_SIZE,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Runtime.Heap.Layout
diff --git a/compiler/utils/BooleanFormula.hs b/compiler/GHC/Data/BooleanFormula.hs
similarity index 98%
rename from compiler/utils/BooleanFormula.hs
rename to compiler/GHC/Data/BooleanFormula.hs
index 76d80eb3052563f34c87b7508896d109fa70842f..15c97558eba9404a8679088dbf8686b51574a564 100644
--- a/compiler/utils/BooleanFormula.hs
+++ b/compiler/GHC/Data/BooleanFormula.hs
@@ -7,7 +7,7 @@
 --
 -- This module is used to represent minimal complete definitions for classes.
 --
-module BooleanFormula (
+module GHC.Data.BooleanFormula (
         BooleanFormula(..), LBooleanFormula,
         mkFalse, mkTrue, mkAnd, mkOr, mkVar,
         isFalse, isTrue,
@@ -16,14 +16,14 @@ module BooleanFormula (
         pprBooleanFormula, pprBooleanFormulaNice
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.List ( nub, intersperse )
 import Data.Data
 
-import MonadUtils
-import Outputable
-import Binary
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Utils.Binary
 import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
diff --git a/compiler/utils/EnumSet.hs b/compiler/GHC/Data/EnumSet.hs
similarity index 95%
rename from compiler/utils/EnumSet.hs
rename to compiler/GHC/Data/EnumSet.hs
index 670a5c64c8ead30a693bf4b9592e734af663ba25..61d6bf002bad8d9dd1e74aef9238d1fc8ce2f12c 100644
--- a/compiler/utils/EnumSet.hs
+++ b/compiler/GHC/Data/EnumSet.hs
@@ -1,6 +1,6 @@
 -- | A tiny wrapper around 'IntSet.IntSet' for representing sets of 'Enum'
 -- things.
-module EnumSet
+module GHC.Data.EnumSet
     ( EnumSet
     , member
     , insert
@@ -10,7 +10,7 @@ module EnumSet
     , empty
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified Data.IntSet as IntSet
 
diff --git a/compiler/utils/FastMutInt.hs b/compiler/GHC/Data/FastMutInt.hs
similarity index 97%
rename from compiler/utils/FastMutInt.hs
rename to compiler/GHC/Data/FastMutInt.hs
index 20206f8b1ec6d175757fc6195f4a2db85087364b..cc81b88b01890d7d5bff99ae9a910f8588335d12 100644
--- a/compiler/utils/FastMutInt.hs
+++ b/compiler/GHC/Data/FastMutInt.hs
@@ -7,7 +7,7 @@
 --
 -- Unboxed mutable Ints
 
-module FastMutInt(
+module GHC.Data.FastMutInt(
         FastMutInt, newFastMutInt,
         readFastMutInt, writeFastMutInt,
 
@@ -15,7 +15,7 @@ module FastMutInt(
         readFastMutPtr, writeFastMutPtr
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Bits
 import GHC.Base
diff --git a/compiler/utils/FastString.hs b/compiler/GHC/Data/FastString.hs
similarity index 99%
rename from compiler/utils/FastString.hs
rename to compiler/GHC/Data/FastString.hs
index 9a74eff16defff755a6ae454c126fde53a38f20e..82f38601f59850593cb88766f16ef7f209de94f7 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/GHC/Data/FastString.hs
@@ -29,7 +29,7 @@
 --     arbitrary Unicode strings.
 --
 -- Use 'PtrString' unless you want the facilities of 'FastString'.
-module FastString
+module GHC.Data.FastString
        (
         -- * ByteString
         bytesFS,            -- :: FastString -> ByteString
@@ -97,12 +97,12 @@ module FastString
 
 #include "HsVersions.h"
 
-import GhcPrelude as Prelude
+import GHC.Prelude as Prelude
 
-import Encoding
-import FastFunctions
-import PlainPanic
-import Util
+import GHC.Utils.Encoding
+import GHC.Utils.IO.Unsafe
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Misc
 
 import Control.Concurrent.MVar
 import Control.DeepSeq
diff --git a/compiler/utils/FastStringEnv.hs b/compiler/GHC/Data/FastString/Env.hs
similarity index 96%
rename from compiler/utils/FastStringEnv.hs
rename to compiler/GHC/Data/FastString/Env.hs
index bc151f736b7f17c575251577156833bce091687b..36fab5727c072e4cadd5754576011fcbc873beb9 100644
--- a/compiler/utils/FastStringEnv.hs
+++ b/compiler/GHC/Data/FastString/Env.hs
@@ -3,10 +3,10 @@
 % (c) The University of Glasgow 2006
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-\section[FastStringEnv]{@FastStringEnv@: FastString environments}
 -}
 
-module FastStringEnv (
+-- | FastStringEnv: FastString environments
+module GHC.Data.FastString.Env (
         -- * FastString environments (maps)
         FastStringEnv,
 
@@ -27,12 +27,12 @@ module FastStringEnv (
         mkDFsEnv, emptyDFsEnv, dFsEnvElts, lookupDFsEnv
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
-import Maybes
-import FastString
+import GHC.Data.Maybe
+import GHC.Data.FastString
 
 
 -- | A non-deterministic set of FastStrings.
diff --git a/compiler/utils/FiniteMap.hs b/compiler/GHC/Data/FiniteMap.hs
similarity index 94%
rename from compiler/utils/FiniteMap.hs
rename to compiler/GHC/Data/FiniteMap.hs
index 069283093225dc326d8e0d99ac56a41c8a3c887a..055944d320ebec4bd1dab9be291bdcef9aca2480 100644
--- a/compiler/utils/FiniteMap.hs
+++ b/compiler/GHC/Data/FiniteMap.hs
@@ -1,13 +1,13 @@
 -- Some extra functions to extend Data.Map
 
-module FiniteMap (
+module GHC.Data.FiniteMap (
         insertList,
         insertListWith,
         deleteList,
         foldRight, foldRightWithKey
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Map (Map)
 import qualified Data.Map as Map
diff --git a/compiler/utils/GraphBase.hs b/compiler/GHC/Data/Graph/Base.hs
similarity index 98%
rename from compiler/utils/GraphBase.hs
rename to compiler/GHC/Data/Graph/Base.hs
index 67c362ff00eac853387a18873db2c219053b5906..3c406456608bf62967a67874be34b2bf4cdccf6e 100644
--- a/compiler/utils/GraphBase.hs
+++ b/compiler/GHC/Data/Graph/Base.hs
@@ -1,6 +1,6 @@
 
 -- | Types for the general graph colorer.
-module GraphBase (
+module GHC.Data.Graph.Base (
         Triv,
         Graph (..),
         initGraph,
@@ -12,7 +12,7 @@ module GraphBase (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
diff --git a/compiler/utils/GraphColor.hs b/compiler/GHC/Data/Graph/Color.hs
similarity index 98%
rename from compiler/utils/GraphColor.hs
rename to compiler/GHC/Data/Graph/Color.hs
index d10b28175cebde325e29e56883ce9cd76920aa1e..948447da58b85572944c8d2ab3389be2910d284a 100644
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/GHC/Data/Graph/Color.hs
@@ -5,25 +5,25 @@
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
-module GraphColor (
-        module GraphBase,
-        module GraphOps,
-        module GraphPpr,
+module GHC.Data.Graph.Color (
+        module GHC.Data.Graph.Base,
+        module GHC.Data.Graph.Ops,
+        module GHC.Data.Graph.Ppr,
         colorGraph
 )
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import GraphBase
-import GraphOps
-import GraphPpr
+import GHC.Data.Graph.Base
+import GHC.Data.Graph.Ops
+import GHC.Data.Graph.Ppr
 
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import Outputable
+import GHC.Utils.Outputable
 
 import Data.Maybe
 import Data.List
diff --git a/compiler/utils/Digraph.hs b/compiler/GHC/Data/Graph/Directed.hs
similarity index 99%
rename from compiler/utils/Digraph.hs
rename to compiler/GHC/Data/Graph/Directed.hs
index ad5fbf53c3cb7b725951d305fee3d3eae4963e93..c3f397051aedf49b196b28b2b3a29eb0d9f4e340 100644
--- a/compiler/utils/Digraph.hs
+++ b/compiler/GHC/Data/Graph/Directed.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE CPP, ScopedTypeVariables, ViewPatterns #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
-module Digraph(
+module GHC.Data.Graph.Directed (
         Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq,
 
         SCC(..), Node(..), flattenSCC, flattenSCCs,
@@ -42,11 +42,11 @@ module Digraph(
 ------------------------------------------------------------------------------
 
 
-import GhcPrelude
+import GHC.Prelude
 
-import Util        ( minWith, count )
-import Outputable
-import Maybes      ( expectJust )
+import GHC.Utils.Misc ( minWith, count )
+import GHC.Utils.Outputable
+import GHC.Data.Maybe ( expectJust )
 
 -- std interfaces
 import Data.Maybe
diff --git a/compiler/utils/GraphOps.hs b/compiler/GHC/Data/Graph/Ops.hs
similarity index 95%
rename from compiler/utils/GraphOps.hs
rename to compiler/GHC/Data/Graph/Ops.hs
index a1693c6a5aa2229951c5911d8c13548d31327185..7d9ce669c6667963e98ce5898def0fe6032befe9 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/GHC/Data/Graph/Ops.hs
@@ -3,28 +3,44 @@
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
-module GraphOps (
-        addNode,        delNode,        getNode,       lookupNode,     modNode,
-        size,
-        union,
-        addConflict,    delConflict,    addConflicts,
-        addCoalesce,    delCoalesce,
-        addExclusion,   addExclusions,
-        addPreference,
-        coalesceNodes,  coalesceGraph,
-        freezeNode,     freezeOneInGraph, freezeAllInGraph,
-        scanGraph,
-        setColor,
-        validateGraph,
-        slurpNodeConflictCount
-)
+module GHC.Data.Graph.Ops
+   ( addNode
+   , delNode
+   , getNode
+   , lookupNode
+   , modNode
+
+   , size
+   , union
+
+   , addConflict
+   , delConflict
+   , addConflicts
+
+   , addCoalesce
+   , delCoalesce
+
+   , addExclusion
+   , addExclusions
+
+   , addPreference
+   , coalesceNodes
+   , coalesceGraph
+   , freezeNode
+   , freezeOneInGraph
+   , freezeAllInGraph
+   , scanGraph
+   , setColor
+   , validateGraph
+   , slurpNodeConflictCount
+   )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import GraphBase
+import GHC.Data.Graph.Base
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
@@ -389,10 +405,10 @@ coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
 
         -- sanity checks
         | nodeClass nMin /= nodeClass nMax
-        = error "GraphOps.coalesceNodes: can't coalesce nodes of different classes."
+        = error "GHC.Data.Graph.Ops.coalesceNodes: can't coalesce nodes of different classes."
 
         | not (isNothing (nodeColor nMin) && isNothing (nodeColor nMax))
-        = error "GraphOps.coalesceNodes: can't coalesce colored nodes."
+        = error "GHC.Data.Graph.Ops.coalesceNodes: can't coalesce colored nodes."
 
         ---
         | otherwise
@@ -473,7 +489,7 @@ freezeNode k
         freezeEdge k node
          = if elementOfUniqSet k (nodeCoalesce node)
                 then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k }
-                else node       -- panic "GraphOps.freezeNode: edge to freeze wasn't in the coalesce set"
+                else node       -- panic "GHC.Data.Graph.Ops.freezeNode: edge to freeze wasn't in the coalesce set"
                                 -- If the edge isn't actually in the coelesce set then just ignore it.
 
         fm2     = nonDetFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1
@@ -570,7 +586,7 @@ validateGraph doc isColored graph
         , nodes         <- mkUniqSet $ map nodeId $ nonDetEltsUFM $ graphMap graph
         , badEdges      <- minusUniqSet edges nodes
         , not $ isEmptyUniqSet badEdges
-        = pprPanic "GraphOps.validateGraph"
+        = pprPanic "GHC.Data.Graph.Ops.validateGraph"
                 (  text "Graph has edges that point to non-existent nodes"
                 $$ text "  bad edges: " <> pprUFM (getUniqSet badEdges) (vcat . map ppr)
                 $$ doc )
@@ -580,7 +596,7 @@ validateGraph doc isColored graph
                         $ nonDetEltsUFM $ graphMap graph
                            -- See Note [Unique Determinism and code generation]
         , not $ null badNodes
-        = pprPanic "GraphOps.validateGraph"
+        = pprPanic "GHC.Data.Graph.Ops.validateGraph"
                 (  text "Node has same color as one of it's conflicts"
                 $$ text "  bad nodes: " <> hcat (map (ppr . nodeId) badNodes)
                 $$ doc)
@@ -591,7 +607,7 @@ validateGraph doc isColored graph
         , badNodes      <- filter (\n -> isNothing $ nodeColor n)
                         $  nonDetEltsUFM $ graphMap graph
         , not $ null badNodes
-        = pprPanic "GraphOps.validateGraph"
+        = pprPanic "GHC.Data.Graph.Ops.validateGraph"
                 (  text "Supposably colored graph has uncolored nodes."
                 $$ text "  uncolored nodes: " <> hcat (map (ppr . nodeId) badNodes)
                 $$ doc )
diff --git a/compiler/utils/GraphPpr.hs b/compiler/GHC/Data/Graph/Ppr.hs
similarity index 97%
rename from compiler/utils/GraphPpr.hs
rename to compiler/GHC/Data/Graph/Ppr.hs
index 4327ec881cb40e285c2d0435d3077d5356b4e0be..020284ea7e271180406556404b562792afe2900d 100644
--- a/compiler/utils/GraphPpr.hs
+++ b/compiler/GHC/Data/Graph/Ppr.hs
@@ -1,17 +1,17 @@
 
 -- | Pretty printing of graphs.
 
-module GraphPpr (
-        dumpGraph,
-        dotGraph
-)
+module GHC.Data.Graph.Ppr
+   ( dumpGraph
+   , dotGraph
+   )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import GraphBase
+import GHC.Data.Graph.Base
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
diff --git a/compiler/utils/UnVarGraph.hs b/compiler/GHC/Data/Graph/UnVar.hs
similarity index 98%
rename from compiler/utils/UnVarGraph.hs
rename to compiler/GHC/Data/Graph/UnVar.hs
index 20eff96c2c7c5acec3bb6160d24b88898fadd037..4d1657ce6259cd21d9ff839a135d5e5d7089bd28 100644
--- a/compiler/utils/UnVarGraph.hs
+++ b/compiler/GHC/Data/Graph/UnVar.hs
@@ -14,7 +14,7 @@ It does not normalize the graphs. This means that g `unionUnVarGraph` g is
 equal to g, but twice as expensive and large.
 
 -}
-module UnVarGraph
+module GHC.Data.Graph.UnVar
     ( UnVarSet
     , emptyUnVarSet, mkUnVarSet, varEnvDom, unionUnVarSet, unionUnVarSets
     , delUnVarSet
@@ -28,13 +28,13 @@ module UnVarGraph
     , delNode
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Id
 import GHC.Types.Var.Env
 import GHC.Types.Unique.FM
-import Outputable
-import Bag
+import GHC.Utils.Outputable
+import GHC.Data.Bag
 import GHC.Types.Unique
 
 import qualified Data.IntSet as S
diff --git a/compiler/utils/IOEnv.hs b/compiler/GHC/Data/IOEnv.hs
similarity index 97%
rename from compiler/utils/IOEnv.hs
rename to compiler/GHC/Data/IOEnv.hs
index f9da146da528cd069e376a99a1b179dff333042c..345482094e98563b2f1c5fde055d1598da2d6fc6 100644
--- a/compiler/utils/IOEnv.hs
+++ b/compiler/GHC/Data/IOEnv.hs
@@ -3,18 +3,18 @@
 --
 -- (c) The University of Glasgow 2002-2006
 --
--- The IO Monad with an environment
+
+-- | The IO Monad with an environment
 --
 -- The environment is passed around as a Reader monad but
 -- as its in the IO monad, mutable references can be used
 -- for updating state.
 --
-
-module IOEnv (
+module GHC.Data.IOEnv (
         IOEnv, -- Instance of Monad
 
         -- Monad utilities
-        module MonadUtils,
+        module GHC.Utils.Monad,
 
         -- Errors
         failM, failWithM,
@@ -31,19 +31,19 @@ module IOEnv (
         atomicUpdMutVar, atomicUpdMutVar'
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
-import Exception
+import GHC.Utils.Exception
 import GHC.Types.Module
-import Panic
+import GHC.Utils.Panic
 
 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,
                           atomicModifyIORef, atomicModifyIORef' )
 import System.IO.Unsafe ( unsafeInterleaveIO )
 import System.IO        ( fixIO )
 import Control.Monad
-import MonadUtils
+import GHC.Utils.Monad
 import Control.Applicative (Alternative(..))
 
 ----------------------------------------------------------------------
diff --git a/compiler/utils/ListSetOps.hs b/compiler/GHC/Data/List/SetOps.hs
similarity index 97%
rename from compiler/utils/ListSetOps.hs
rename to compiler/GHC/Data/List/SetOps.hs
index 85233c95331a5f8208702be14f978710b0b916c2..2d916e9dd5a8390caae3ef9c1532eec07fb46306 100644
--- a/compiler/utils/ListSetOps.hs
+++ b/compiler/GHC/Data/List/SetOps.hs
@@ -2,12 +2,14 @@
 (c) The University of Glasgow 2006
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 
-\section[ListSetOps]{Set-like operations on lists}
 -}
 
 {-# LANGUAGE CPP #-}
 
-module ListSetOps (
+-- | Set-like operations on lists
+--
+-- Avoid using them as much as possible
+module GHC.Data.List.SetOps (
         unionLists, minusList, deleteBys,
 
         -- Association lists
@@ -23,10 +25,10 @@ module ListSetOps (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
diff --git a/compiler/utils/Maybes.hs b/compiler/GHC/Data/Maybe.hs
similarity index 97%
rename from compiler/utils/Maybes.hs
rename to compiler/GHC/Data/Maybe.hs
index 37acb25a1a31e915f5d248b9434fe4408f2f5aab..230468a20e385c36f831719bc69f97315e0190f4 100644
--- a/compiler/utils/Maybes.hs
+++ b/compiler/GHC/Data/Maybe.hs
@@ -9,7 +9,7 @@
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 -}
 
-module Maybes (
+module GHC.Data.Maybe (
         module Data.Maybe,
 
         MaybeErr(..), -- Instance of Monad
@@ -25,13 +25,13 @@ module Maybes (
         MaybeT(..), liftMaybeT, tryMaybeT
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import Control.Exception (catch, SomeException(..))
 import Data.Maybe
-import Util (HasCallStack)
+import GHC.Utils.Misc (HasCallStack)
 
 infixr 4 `orElse`
 
diff --git a/compiler/utils/OrdList.hs b/compiler/GHC/Data/OrdList.hs
similarity index 96%
rename from compiler/utils/OrdList.hs
rename to compiler/GHC/Data/OrdList.hs
index 8da5038b2cc88ceea9916761701e68b49d7213f8..5476055f05b234015ca068a9cc1075b9d2315d54 100644
--- a/compiler/utils/OrdList.hs
+++ b/compiler/GHC/Data/OrdList.hs
@@ -3,16 +3,14 @@
 (c) The AQUA Project, Glasgow University, 1993-1998
 
 
-This is useful, general stuff for the Native Code Generator.
-
-Provide trees (of instructions), so that lists of instructions
-can be appended in linear time.
 -}
 {-# LANGUAGE DeriveFunctor #-}
 
 {-# LANGUAGE BangPatterns #-}
 
-module OrdList (
+-- | Provide trees (of instructions), so that lists of instructions can be
+-- appended in linear time.
+module GHC.Data.OrdList (
         OrdList,
         nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,
         headOL,
@@ -20,10 +18,10 @@ module OrdList (
         strictlyEqOL, strictlyOrdOL
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 import Data.Foldable
 
-import Outputable
+import GHC.Utils.Outputable
 
 import qualified Data.Semigroup as Semigroup
 
diff --git a/compiler/utils/Pair.hs b/compiler/GHC/Data/Pair.hs
similarity index 90%
rename from compiler/utils/Pair.hs
rename to compiler/GHC/Data/Pair.hs
index e9313f89b283facbf1d7b2c20d3eea7e61930ac8..ae51c78edc72392f269f787a32e0ed7cfc70471c 100644
--- a/compiler/utils/Pair.hs
+++ b/compiler/GHC/Data/Pair.hs
@@ -6,13 +6,21 @@ Traversable instances.
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveFunctor #-}
 
-module Pair ( Pair(..), unPair, toPair, swap, pLiftFst, pLiftSnd ) where
+module GHC.Data.Pair
+   ( Pair(..)
+   , unPair
+   , toPair
+   , swap
+   , pLiftFst
+   , pLiftSnd
+   )
+where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import qualified Data.Semigroup as Semi
 
 data Pair a = Pair { pFst :: a, pSnd :: a }
diff --git a/compiler/utils/Stream.hs b/compiler/GHC/Data/Stream.hs
similarity index 94%
rename from compiler/utils/Stream.hs
rename to compiler/GHC/Data/Stream.hs
index 7eabbe195852f8eb6591d2b3ce497ea128d189a6..7996ee7343dc106bd105a474e48ab2587855630d 100644
--- a/compiler/utils/Stream.hs
+++ b/compiler/GHC/Data/Stream.hs
@@ -2,18 +2,18 @@
 --
 -- (c) The University of Glasgow 2012
 --
--- Monadic streams
---
 -- -----------------------------------------------------------------------------
-module Stream (
+
+-- | Monadic streams
+module GHC.Data.Stream (
     Stream(..), yield, liftIO,
     collect, collect_, consume, fromList,
-    Stream.map, Stream.mapM, Stream.mapAccumL, Stream.mapAccumL_
+    map, mapM, mapAccumL, mapAccumL_
   ) where
 
-import GhcPrelude
+import GHC.Prelude hiding (map,mapM)
 
-import Control.Monad
+import Control.Monad hiding (mapM)
 
 -- |
 -- @Stream m a b@ is a computation in some Monad @m@ that delivers a sequence
@@ -100,7 +100,7 @@ map f str = Stream $ do
    r <- runStream str
    case r of
      Left x -> return (Left x)
-     Right (a, str') -> return (Right (f a, Stream.map f str'))
+     Right (a, str') -> return (Right (f a, map f str'))
 
 -- | Apply a monadic operation to each element of a 'Stream', lazily
 mapM :: Monad m => (a -> m b) -> Stream m a x -> Stream m b x
@@ -110,7 +110,7 @@ mapM f str = Stream $ do
      Left x -> return (Left x)
      Right (a, str') -> do
         b <- f a
-        return (Right (b, Stream.mapM f str'))
+        return (Right (b, mapM f str'))
 
 -- | analog of the list-based 'mapAccumL' on Streams.  This is a simple
 -- way to map over a Stream while carrying some state around.
diff --git a/compiler/utils/StringBuffer.hs b/compiler/GHC/Data/StringBuffer.hs
similarity index 98%
rename from compiler/utils/StringBuffer.hs
rename to compiler/GHC/Data/StringBuffer.hs
index 91377cad17918912faa0801056b82f807cf3b740..8ac5d1ae07034d105d5a4aa7d7fcde543573e587 100644
--- a/compiler/utils/StringBuffer.hs
+++ b/compiler/GHC/Data/StringBuffer.hs
@@ -11,7 +11,7 @@ Buffers for scanning string input stored in external arrays.
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
 
-module StringBuffer
+module GHC.Data.StringBuffer
        (
         StringBuffer(..),
         -- non-abstract for vs\/HaskellService
@@ -46,13 +46,13 @@ module StringBuffer
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Encoding
-import FastString
-import FastFunctions
-import PlainPanic
-import Util
+import GHC.Utils.Encoding
+import GHC.Data.FastString
+import GHC.Utils.IO.Unsafe
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Misc
 
 import Data.Maybe
 import Control.Exception
diff --git a/compiler/utils/TrieMap.hs b/compiler/GHC/Data/TrieMap.hs
similarity index 99%
rename from compiler/utils/TrieMap.hs
rename to compiler/GHC/Data/TrieMap.hs
index 815a060a0c6cb20357a60ecf8b308028f5e9bff6..e2506e3d4c3b41e3e84d2cd500b651ffea661a7d 100644
--- a/compiler/utils/TrieMap.hs
+++ b/compiler/GHC/Data/TrieMap.hs
@@ -9,7 +9,7 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
-module TrieMap(
+module GHC.Data.TrieMap(
    -- * Maps over 'Maybe' values
    MaybeMap,
    -- * Maps over 'List' values
@@ -29,7 +29,7 @@ module TrieMap(
 
  ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Literal
 import GHC.Types.Unique.DFM
@@ -37,7 +37,7 @@ import GHC.Types.Unique( Unique )
 
 import qualified Data.Map    as Map
 import qualified Data.IntMap as IntMap
-import Outputable
+import GHC.Utils.Outputable
 import Control.Monad( (>=>) )
 import Data.Kind( Type )
 
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 4f179f4aa1f7c5167e0fd99643fca3bb93b8af02..4b15a4da9d4e5071046fad1bd680935ded6ddb73 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -18,7 +18,7 @@ module GHC.Driver.Backpack (doBackpack) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 -- In a separate module because it hooks into the parser.
 import GHC.Driver.Backpack.Syntax
@@ -34,15 +34,15 @@ import GHC.Tc.Utils.Monad
 import GHC.Tc.Module
 import GHC.Types.Module
 import GHC.Driver.Types
-import StringBuffer
-import FastString
-import ErrUtils
+import GHC.Data.StringBuffer
+import GHC.Data.FastString
+import GHC.Utils.Error
 import GHC.Types.SrcLoc
 import GHC.Driver.Main
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
-import Outputable
-import Maybes
+import GHC.Utils.Outputable
+import GHC.Data.Maybe
 import GHC.Parser.Header
 import GHC.Iface.Recomp
 import GHC.Driver.Make
@@ -50,11 +50,11 @@ import GHC.Types.Unique.DSet
 import GHC.Builtin.Names
 import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Driver.Finder
-import Util
+import GHC.Utils.Misc
 
 import qualified GHC.LanguageExtensions as LangExt
 
-import Panic
+import GHC.Utils.Panic
 import Data.List ( partition )
 import System.Exit
 import Control.Monad
diff --git a/compiler/GHC/Driver/Backpack/Syntax.hs b/compiler/GHC/Driver/Backpack/Syntax.hs
index 7a119907da7f9d3a00963d8b6d107de86e7bcab3..bb459d8e35aee34e341308e83e292cedddb37bf8 100644
--- a/compiler/GHC/Driver/Backpack/Syntax.hs
+++ b/compiler/GHC/Driver/Backpack/Syntax.hs
@@ -16,14 +16,14 @@ module GHC.Driver.Backpack.Syntax (
     LRenaming, Renaming(..),
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Phases
 import GHC.Hs
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Module
-import UnitInfo
+import GHC.Unit.Info
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Driver/CmdLine.hs b/compiler/GHC/Driver/CmdLine.hs
index 243831cfc5f383bcc18b889f0553ececf836faea..2becd3e952a6522b37406b342a042dc1a779ba34 100644
--- a/compiler/GHC/Driver/CmdLine.hs
+++ b/compiler/GHC/Driver/CmdLine.hs
@@ -26,14 +26,14 @@ module GHC.Driver.CmdLine
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Util
-import Outputable
-import Panic
-import Bag
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+import GHC.Data.Bag
 import GHC.Types.SrcLoc
-import Json
+import GHC.Utils.Json
 
 import Data.Function
 import Data.List
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 3bce0db86dc158615ef5382e36f6ce7d44134e2f..7a768db4b9bc0c8eadb739a2f524e6b9298d1935 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -15,7 +15,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToAsm     ( nativeCodeGen )
 import GHC.CmmToLlvm    ( llvmCodeGen )
@@ -30,12 +30,12 @@ import GHC.Cmm              ( RawCmmGroup )
 import GHC.Cmm.CLabel
 import GHC.Driver.Types
 import GHC.Driver.Session
-import Stream           ( Stream )
-import qualified Stream
+import GHC.Data.Stream           ( Stream )
+import qualified GHC.Data.Stream as Stream
 import GHC.SysTools.FileCleanup
 
-import ErrUtils
-import Outputable
+import GHC.Utils.Error
+import GHC.Utils.Outputable
 import GHC.Types.Module
 import GHC.Types.SrcLoc
 import GHC.Types.CostCentre
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index 0a4b07509fe5073cec41f89d33a6e733389cb87d..1118e764becf321fa64dccced65457e6862604d0 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -33,17 +33,17 @@ module GHC.Driver.Finder (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Module
 import GHC.Driver.Types
 import GHC.Driver.Packages
-import FastString
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Builtin.Names ( gHC_PRIM )
 import GHC.Driver.Session
-import Outputable
-import Maybes           ( expectJust )
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.Maybe    ( expectJust )
 
 import Data.IORef       ( IORef, readIORef, atomicModifyIORef' )
 import System.Directory
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 2e867ac85f37280fa5c65b669b6e1225648e5cf0..b0be5f4bcee6621697f541de6eb1acdac8207c1f 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -8,10 +8,10 @@ module GHC.Driver.Flags
    )
 where
 
-import GhcPrelude
-import Outputable
-import EnumSet
-import Json
+import GHC.Prelude
+import GHC.Utils.Outputable
+import GHC.Data.EnumSet as EnumSet
+import GHC.Utils.Json
 
 -- | Debugging flags
 data DumpFlag
diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs
index 35b06ca1df4c13f05c84745c053d2632867097e0..b7915ed3af9d3d3cddf71cf9ca22618cee96e56d 100644
--- a/compiler/GHC/Driver/Hooks.hs
+++ b/compiler/GHC/Driver/Hooks.hs
@@ -28,7 +28,7 @@ module GHC.Driver.Hooks
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Driver.Pipeline.Monad
@@ -36,9 +36,9 @@ import GHC.Driver.Types
 import GHC.Hs.Decls
 import GHC.Hs.Binds
 import GHC.Hs.Expr
-import OrdList
+import GHC.Data.OrdList
 import GHC.Tc.Types
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Name.Reader
 import GHC.Types.Name
 import GHC.Types.Id
@@ -52,7 +52,7 @@ import GHC.Types.Module
 import GHC.Core.TyCon
 import GHC.Types.CostCentre
 import GHC.Stg.Syntax
-import Stream
+import GHC.Data.Stream
 import GHC.Cmm
 import GHC.Hs.Extension
 
diff --git a/compiler/GHC/Driver/Hooks.hs-boot b/compiler/GHC/Driver/Hooks.hs-boot
index 40ee5560eee9fe74e6f575de268793be72589a86..48d6cdb1bc677cee423d96b05ac9db039b414e7e 100644
--- a/compiler/GHC/Driver/Hooks.hs-boot
+++ b/compiler/GHC/Driver/Hooks.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Driver.Hooks where
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 data Hooks
 
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 5219ac6bd79b8756cdb5d8937981acdcd7ebec05..919913099646fd684c762d6f08c7da696d8af104 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -84,7 +84,7 @@ module GHC.Driver.Main
     , hscAddSptEntries
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Data hiding (Fixity, TyCon)
 import Data.Maybe       ( fromJust )
@@ -97,7 +97,7 @@ import GHC.Core.Tidy           ( tidyExpr )
 import GHC.Core.Type           ( Type, Kind )
 import GHC.Core.Lint           ( lintInteractiveExpr )
 import GHC.Types.Var.Env       ( emptyTidyEnv )
-import Panic
+import GHC.Utils.Panic
 import GHC.Core.ConLike
 
 import GHC.Parser.Annotation
@@ -107,7 +107,7 @@ import GHC.Types.Name.Reader
 import GHC.Hs
 import GHC.Hs.Dump
 import GHC.Core
-import StringBuffer
+import GHC.Data.StringBuffer
 import GHC.Parser
 import GHC.Parser.Lexer as Lexer
 import GHC.Types.SrcLoc
@@ -134,14 +134,14 @@ import GHC.Core.TyCon
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Cmm
-import GHC.Cmm.Parser         ( parseCmmFile )
+import GHC.Cmm.Parser       ( parseCmmFile )
 import GHC.Cmm.Info.Build
 import GHC.Cmm.Pipeline
 import GHC.Cmm.Info
 import GHC.Driver.CodeOutput
 import GHC.Core.InstEnv
 import GHC.Core.FamInstEnv
-import Fingerprint      ( Fingerprint )
+import GHC.Utils.Fingerprint ( Fingerprint )
 import GHC.Driver.Hooks
 import GHC.Tc.Utils.Env
 import GHC.Builtin.Names
@@ -149,20 +149,20 @@ import GHC.Driver.Plugins
 import GHC.Runtime.Loader   ( initializePlugins )
 
 import GHC.Driver.Session
-import ErrUtils
+import GHC.Utils.Error
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Name.Env
-import HscStats         ( ppSourceStats )
+import GHC.Hs.Stats         ( ppSourceStats )
 import GHC.Driver.Types
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Unique.Supply
-import Bag
-import Exception
-import qualified Stream
-import Stream (Stream)
+import GHC.Data.Bag
+import GHC.Utils.Exception
+import qualified GHC.Data.Stream as Stream
+import GHC.Data.Stream (Stream)
 
-import Util
+import GHC.Utils.Misc
 
 import Data.List        ( nub, isPrefixOf, partition )
 import Control.Monad
@@ -1767,7 +1767,7 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
     return (new_tythings, new_ictxt)
 
 -- | Load the given static-pointer table entries into the interpreter.
--- See Note [Grand plan for static forms] in StaticPtrTable.
+-- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
 hscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()
 hscAddSptEntries hsc_env entries = do
     let add_spt_entry :: SptEntry -> IO ()
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index b81b045ed614340cec798dae5f975f72f1a07089..30e313ea4635cb3ceb8dfbe16644c145a9b64492 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -33,41 +33,41 @@ module GHC.Driver.Make (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified GHC.Runtime.Linker as Linker
 
 import GHC.Driver.Phases
 import GHC.Driver.Pipeline
 import GHC.Driver.Session
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Finder
 import GHC.Driver.Monad
 import GHC.Parser.Header
 import GHC.Driver.Types
 import GHC.Types.Module
-import GHC.IfaceToCore  ( typecheckIface )
-import GHC.Tc.Utils.Monad     ( initIfaceCheck )
+import GHC.IfaceToCore     ( typecheckIface )
+import GHC.Tc.Utils.Monad  ( initIfaceCheck )
 import GHC.Driver.Main
 
-import Bag              ( unitBag, listToBag, unionManyBags, isEmptyBag )
+import GHC.Data.Bag        ( unitBag, listToBag, unionManyBags, isEmptyBag )
 import GHC.Types.Basic
-import Digraph
-import Exception        ( tryIO, gbracket, gfinally )
-import FastString
-import Maybes           ( expectJust )
+import GHC.Data.Graph.Directed
+import GHC.Utils.Exception ( tryIO, gbracket, gfinally )
+import GHC.Data.FastString
+import GHC.Data.Maybe      ( expectJust )
 import GHC.Types.Name
-import MonadUtils       ( allM )
-import Outputable
-import Panic
+import GHC.Utils.Monad     ( allM )
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
 import GHC.Types.SrcLoc
-import StringBuffer
+import GHC.Data.StringBuffer
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DSet
 import GHC.Tc.Utils.Backpack
 import GHC.Driver.Packages
 import GHC.Types.Unique.Set
-import Util
+import GHC.Utils.Misc
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Types.Name.Env
 import GHC.SysTools.FileCleanup
@@ -76,7 +76,7 @@ import Data.Either ( rights, partitionEithers )
 import qualified Data.Map as Map
 import Data.Map (Map)
 import qualified Data.Set as Set
-import qualified FiniteMap as Map ( insertListWith )
+import qualified GHC.Data.FiniteMap as Map ( insertListWith )
 
 import Control.Concurrent ( forkIOWithUnmask, killThread )
 import qualified GHC.Conc as CC
@@ -1505,7 +1505,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do
 
                         -- Add any necessary entries to the static pointer
                         -- table. See Note [Grand plan for static forms] in
-                        -- StaticPtrTable.
+                        -- GHC.Iface.Tidy.StaticPtrTable.
                 when (hscTarget (hsc_dflags hsc_env4) == HscInterpreted) $
                     liftIO $ hscAddSptEntries hsc_env4
                                  [ spt
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index d45b39e3b3d5a835b01f1a302d4f052d6b7fd0e9..01af21d4616f94f09cd02e6ac7b69093b873bbaa 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -15,27 +15,27 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified GHC
 import GHC.Driver.Monad
 import GHC.Driver.Session
 import GHC.Driver.Ways
-import Util
+import GHC.Utils.Misc
 import GHC.Driver.Types
 import qualified GHC.SysTools as SysTools
 import GHC.Types.Module
-import Digraph          ( SCC(..) )
+import GHC.Data.Graph.Directed ( SCC(..) )
 import GHC.Driver.Finder
-import Outputable
-import Panic
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
 import GHC.Types.SrcLoc
 import Data.List
-import FastString
+import GHC.Data.FastString
 import GHC.SysTools.FileCleanup
 
-import Exception
-import ErrUtils
+import GHC.Utils.Exception
+import GHC.Utils.Error
 
 import System.Directory
 import System.FilePath
diff --git a/compiler/GHC/Driver/Monad.hs b/compiler/GHC/Driver/Monad.hs
index 3825757ac68e625284be19af43bed86561c11e17..d0c950baf53ca4b626d8c86331c19d3682dccdd6 100644
--- a/compiler/GHC/Driver/Monad.hs
+++ b/compiler/GHC/Driver/Monad.hs
@@ -23,13 +23,13 @@ module GHC.Driver.Monad (
         WarnErrLogger, defaultWarnErrLogger
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import MonadUtils
+import GHC.Utils.Monad
 import GHC.Driver.Types
 import GHC.Driver.Session
-import Exception
-import ErrUtils
+import GHC.Utils.Exception
+import GHC.Utils.Error
 
 import Control.Monad
 import Data.IORef
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs
index 3e85251da284ed9049a9b2b7fefa8a78fc8891b3..a1964674978af894085588ef8ff679dc97eec615 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Driver/Packages.hs
@@ -4,7 +4,7 @@
 
 -- | Package manipulation
 module GHC.Driver.Packages (
-        module UnitInfo,
+        module GHC.Unit.Info,
 
         -- * Reading the package config, and processing cmdline args
         PackageState(preloadPackages, explicitPackages, moduleNameProvidersMap, requirementContext),
@@ -69,10 +69,10 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.PackageDb
-import UnitInfo
+import GHC.Unit.Info
 import GHC.Driver.Session
 import GHC.Driver.Ways
 import GHC.Types.Name       ( Name, nameModule_maybe )
@@ -80,17 +80,17 @@ 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.Utils.Misc
+import GHC.Utils.Panic
 import GHC.Platform
-import Outputable
-import Maybes
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.Maybe
 
 import System.Environment ( getEnv )
-import FastString
-import ErrUtils         ( debugTraceMsg, MsgDoc, dumpIfSet_dyn,
+import GHC.Data.FastString
+import GHC.Utils.Error  ( debugTraceMsg, MsgDoc, dumpIfSet_dyn,
                           withTiming, DumpFormat (..) )
-import Exception
+import GHC.Utils.Exception
 
 import System.Directory
 import System.FilePath as FilePath
diff --git a/compiler/GHC/Driver/Packages.hs-boot b/compiler/GHC/Driver/Packages.hs-boot
index 96bb95deec85fc8027ea1b8790f320b843ecd7fa..eab2ebd60fa0a5dbe6b35bc35810ad1620b1c26f 100644
--- a/compiler/GHC/Driver/Packages.hs-boot
+++ b/compiler/GHC/Driver/Packages.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Driver.Packages where
-import GhcPrelude
-import FastString
+import GHC.Prelude
+import GHC.Data.FastString
 import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
 import {-# SOURCE #-} GHC.Types.Module(ComponentId, UnitId, InstalledUnitId)
 data PackageState
diff --git a/compiler/GHC/Driver/Phases.hs b/compiler/GHC/Driver/Phases.hs
index d9059f65ece3a443699e16031e217812bff36e50..cfca2e87c14c499b88b50af24e268106468343a0 100644
--- a/compiler/GHC/Driver/Phases.hs
+++ b/compiler/GHC/Driver/Phases.hs
@@ -39,13 +39,13 @@ module GHC.Driver.Phases (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
 import System.FilePath
-import Binary
-import Util
+import GHC.Utils.Binary
+import GHC.Utils.Misc
 
 -----------------------------------------------------------------------------
 -- Phases
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 1fc37e0662479b87d003fbdae88a3c5ef9af94c7..c13f7aa0dc6b155374e9d38361f0d31e7524ed98 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -36,7 +36,7 @@ module GHC.Driver.Pipeline (
 #include <ghcplatform.h>
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Pipeline.Monad
 import GHC.Driver.Packages
@@ -48,18 +48,18 @@ import GHC.SysTools.ExtraObj
 import GHC.Driver.Main
 import GHC.Driver.Finder
 import GHC.Driver.Types hiding ( Hsc )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Module
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Session
-import Panic
-import Util
-import StringBuffer     ( hGetStringBuffer, hPutStringBuffer )
-import GHC.Types.Basic  ( SuccessFlag(..) )
-import Maybes           ( expectJust )
+import GHC.Utils.Panic
+import GHC.Utils.Misc
+import GHC.Data.StringBuffer ( hGetStringBuffer, hPutStringBuffer )
+import GHC.Types.Basic       ( SuccessFlag(..) )
+import GHC.Data.Maybe        ( expectJust )
 import GHC.Types.SrcLoc
-import GHC.CmmToLlvm    ( llvmFixupAsm, llvmVersionList )
-import MonadUtils
+import GHC.CmmToLlvm         ( llvmFixupAsm, llvmVersionList )
+import GHC.Utils.Monad
 import GHC.Platform
 import GHC.Tc.Types
 import GHC.Driver.Hooks
@@ -67,12 +67,12 @@ import qualified GHC.LanguageExtensions as LangExt
 import GHC.SysTools.FileCleanup
 import GHC.SysTools.Ar
 import GHC.Settings
-import Bag              ( unitBag )
-import FastString       ( mkFastString )
-import GHC.Iface.Make   ( mkFullIface )
-import UpdateCafInfos   ( updateModDetailsCafInfos )
+import GHC.Data.Bag             ( unitBag )
+import GHC.Data.FastString      ( mkFastString )
+import GHC.Iface.Make           ( mkFullIface )
+import GHC.Iface.UpdateCafInfos ( updateModDetailsCafInfos )
 
-import Exception
+import GHC.Utils.Exception as Exception
 import System.Directory
 import System.FilePath
 import System.IO
diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs
index 753f829f3c6448bfc26df3066ddc2e8eec76fbaa..bf22ae6e9d9815adcb09315f1be435e0b04a6b05 100644
--- a/compiler/GHC/Driver/Pipeline/Monad.hs
+++ b/compiler/GHC/Driver/Pipeline/Monad.hs
@@ -11,10 +11,10 @@ module GHC.Driver.Pipeline.Monad (
   , pipeStateDynFlags, pipeStateModIface
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import MonadUtils
-import Outputable
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Driver.Session
 import GHC.Driver.Phases
 import GHC.Driver.Types
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index d9e29d451bf65f98c3149cc2f46b5b51bf80d89d..4d4f9eab779e1178ec3828a90220ed6ac1e33b4d 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -47,7 +47,7 @@ module GHC.Driver.Plugins (
     , mapPlugins, withPlugins, withPlugins_
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.Opt.Monad ( CoreToDo, CoreM )
 import qualified GHC.Tc.Types
@@ -59,9 +59,9 @@ import GHC.Driver.Types
 import GHC.Driver.Monad
 import GHC.Driver.Phases
 import GHC.Types.Module ( ModuleName, Module(moduleName))
-import Fingerprint
+import GHC.Utils.Fingerprint
 import Data.List (sort)
-import Outputable (Outputable(..), text, (<+>))
+import GHC.Utils.Outputable (Outputable(..), text, (<+>))
 
 --Qualified import so we can define a Semigroup instance
 -- but it doesn't clash with Outputable.<>
diff --git a/compiler/GHC/Driver/Plugins.hs-boot b/compiler/GHC/Driver/Plugins.hs-boot
index 41a0c115d2fc81e10e9f74730df30005b01c5dcb..7b5f8ca16141966f45fe9173c8341ecb3d378864 100644
--- a/compiler/GHC/Driver/Plugins.hs-boot
+++ b/compiler/GHC/Driver/Plugins.hs-boot
@@ -2,7 +2,7 @@
 -- exposed without importing all of its implementation.
 module GHC.Driver.Plugins where
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 data Plugin
 
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 7efba2bcead002980de84fe2425f63028730610c..fe35d19ee53918705acddf0b93de9c5300add9b5 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -238,7 +238,7 @@ module GHC.Driver.Session (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.UniqueSubdir (uniqueSubdir)
@@ -251,27 +251,28 @@ import GHC.Driver.Phases ( Phase(..), phaseInputExt )
 import GHC.Driver.Flags
 import GHC.Driver.Ways
 import Config
-import CliOption
+import GHC.Utils.CliOption
 import GHC.Driver.CmdLine hiding (WarnReason(..))
 import qualified GHC.Driver.CmdLine as Cmd
 import GHC.Settings.Constants
-import Panic
-import qualified PprColour as Col
-import Util
-import Maybes
-import MonadUtils
-import qualified Pretty
+import GHC.Utils.Panic
+import qualified GHC.Utils.Ppr.Colour as Col
+import GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Utils.Monad
+import qualified GHC.Utils.Ppr as Pretty
 import GHC.Types.SrcLoc
 import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf )
-import FastString
-import Fingerprint
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Fingerprint
+import GHC.Utils.Outputable
 import GHC.Settings
 
-import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn
+import {-# SOURCE #-} GHC.Utils.Error
+                               ( Severity(..), MsgDoc, mkLocMessageAnn
                                , getCaretDiagnostic, DumpAction, TraceAction
                                , defaultDumpAction, defaultTraceAction )
-import Json
+import GHC.Utils.Json
 import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
 import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
 
@@ -300,8 +301,8 @@ import System.IO.Error
 import Text.ParserCombinators.ReadP hiding (char)
 import Text.ParserCombinators.ReadP as R
 
-import EnumSet (EnumSet)
-import qualified EnumSet
+import GHC.Data.EnumSet (EnumSet)
+import qualified GHC.Data.EnumSet as EnumSet
 
 import GHC.Foreign (withCString, peekCString)
 import qualified GHC.LanguageExtensions as LangExt
@@ -702,7 +703,7 @@ data DynFlags = DynFlags {
 
   ghciHistSize          :: Int,
 
-  -- | MsgDoc output action: use "ErrUtils" instead of this if you can
+  -- | MsgDoc output action: use "GHC.Utils.Error" instead of this if you can
   log_action            :: LogAction,
   dump_action           :: DumpAction,
   trace_action          :: TraceAction,
diff --git a/compiler/GHC/Driver/Session.hs-boot b/compiler/GHC/Driver/Session.hs-boot
index 2bc44dc3c62590e24a7e12f81881f5c950531d24..509535ba71b58273b7d45d037027c040bc81066d 100644
--- a/compiler/GHC/Driver/Session.hs-boot
+++ b/compiler/GHC/Driver/Session.hs-boot
@@ -1,8 +1,8 @@
 module GHC.Driver.Session where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
-import {-# SOURCE #-} Outputable
+import {-# SOURCE #-} GHC.Utils.Outputable
 
 data DynFlags
 
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 581a90ea1d16082e0e7d80b66a00590ecb22d02a..b4f07618f6c33e132b645faeb619d4f8753191d0 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -159,7 +159,7 @@ module GHC.Driver.Types (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.ByteCode.Types
 import GHC.Runtime.Eval.Types ( Resume )
@@ -202,21 +202,21 @@ import GHC.Driver.Phases
 import qualified GHC.Driver.Phases as Phase
 import GHC.Types.Basic
 import GHC.Iface.Syntax
-import Maybes
-import Outputable
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.DFM
-import FastString
-import StringBuffer     ( StringBuffer )
-import Fingerprint
-import MonadUtils
-import Bag
-import Binary
-import ErrUtils
+import GHC.Data.FastString
+import GHC.Data.StringBuffer ( StringBuffer )
+import GHC.Utils.Fingerprint
+import GHC.Utils.Monad
+import GHC.Data.Bag
+import GHC.Utils.Binary
+import GHC.Utils.Error
 import GHC.Types.Name.Cache
 import GHC.Platform
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique.DSet
 import GHC.Serialized   ( Serialized )
 import qualified GHC.LanguageExtensions as LangExt
@@ -227,7 +227,7 @@ import Data.IORef
 import Data.Map         ( Map )
 import qualified Data.Map as Map
 import Data.Time
-import Exception
+import GHC.Utils.Exception
 import System.FilePath
 import Control.DeepSeq
 import Control.Monad.Trans.Reader
@@ -1524,7 +1524,7 @@ data CgGuts
         cg_spt_entries :: [SptEntry]
                 -- ^ Static pointer table entries for static forms defined in
                 -- the module.
-                -- See Note [Grand plan for static forms] in StaticPtrTable
+                -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable
     }
 
 -----------------------------------
diff --git a/compiler/GHC/Driver/Ways.hs b/compiler/GHC/Driver/Ways.hs
index 1b9845850f06cd322719b21bbf22e1c473c7a031..eae86864d420111d529a84e4459c92c1d67a5692 100644
--- a/compiler/GHC/Driver/Ways.hs
+++ b/compiler/GHC/Driver/Ways.hs
@@ -37,7 +37,7 @@ module GHC.Driver.Ways
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 import GHC.Driver.Flags
 
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 72710c68302ae1abaa6b9d7a93ad530ce65513e5..59fe3e36b01ed6bb7280bc4afd939a78d0e4c0a0 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -35,7 +35,7 @@ module GHC.Hs (
 ) where
 
 -- friends:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs.Decls
 import GHC.Hs.Binds
@@ -51,7 +51,7 @@ import GHC.Hs.Doc
 import GHC.Hs.Instances () -- For Data instances
 
 -- others:
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Types.Module ( ModuleName )
 
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 5068f082ce4acead54c7b7b4382aac2f5ef1170c..025265620342f96f96490594331f3ab9e13142a7 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -23,7 +23,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
 
 module GHC.Hs.Binds where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, LHsExpr,
                                     MatchGroup, pprFunBind,
@@ -37,12 +37,12 @@ import GHC.Tc.Types.Evidence
 import GHC.Core.Type
 import GHC.Types.Name.Set
 import GHC.Types.Basic
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Var
-import Bag
-import FastString
-import BooleanFormula (LBooleanFormula)
+import GHC.Data.Bag
+import GHC.Data.FastString
+import GHC.Data.BooleanFormula (LBooleanFormula)
 
 import Data.Data hiding ( Fixity )
 import Data.List hiding ( foldr )
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs
index 0be89127a50539166614c392e062fcbd9f783c46..f0ffd06307f815c2f3328c4109c0ef0d564242b6 100644
--- a/compiler/GHC/Hs/Decls.hs
+++ b/compiler/GHC/Hs/Decls.hs
@@ -94,7 +94,7 @@ module GHC.Hs.Decls (
     ) where
 
 -- friends:
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, HsSplice, pprExpr,
                                    pprSpliceDecl )
@@ -112,13 +112,13 @@ import GHC.Types.Name.Set
 
 -- others:
 import GHC.Core.Class
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.SrcLoc
 import GHC.Core.Type
 
-import Bag
-import Maybes
+import GHC.Data.Bag
+import GHC.Data.Maybe
 import Data.Data        hiding (TyCon,Fixity, Infix)
 
 {-
diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs
index 7da56b15247104c290d2bbea672318361f62ddb8..9a5035b46e4f62067b744bcd7c33c0b951793b31 100644
--- a/compiler/GHC/Hs/Doc.hs
+++ b/compiler/GHC/Hs/Doc.hs
@@ -23,13 +23,13 @@ module GHC.Hs.Doc
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Binary
-import Encoding
-import FastFunctions
+import GHC.Utils.Binary
+import GHC.Utils.Encoding
+import GHC.Utils.IO.Unsafe
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.SrcLoc
 
 import Data.ByteString (ByteString)
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index 2fe8711570623e0263395ff0d67426b9485a72cb..ee9df10c5d27121c41d7e67f3d0ecd41caf3575a 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -15,12 +15,12 @@ module GHC.Hs.Dump (
         BlankSrcSpan(..),
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Data hiding (Fixity)
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Basic
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Name.Set
 import GHC.Types.Name
 import GHC.Core.DataCon
@@ -28,7 +28,7 @@ import GHC.Types.SrcLoc
 import GHC.Hs
 import GHC.Types.Var
 import GHC.Types.Module
-import Outputable
+import GHC.Utils.Outputable
 
 import qualified Data.ByteString as B
 
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 290a9716e28c0e29b1d7602c756d7349837d4a17..a03c0aa50d69c60d722186b3d93303cc84918cf8 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -26,7 +26,7 @@ module GHC.Hs.Expr where
 #include "HsVersions.h"
 
 -- friends:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs.Decls
 import GHC.Hs.Pat
@@ -43,9 +43,9 @@ import GHC.Types.Name.Set
 import GHC.Types.Basic
 import GHC.Core.ConLike
 import GHC.Types.SrcLoc
-import Util
-import Outputable
-import FastString
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Core.Type
 import GHC.Builtin.Types (mkTupleStr)
 import GHC.Tc.Utils.TcType (TcType)
diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot
index 87a4a2b38e7dbddae3f6f4683d18ec0e8041cddf..ccfe2cb65d74ff191856d31f62166ad6e246f272 100644
--- a/compiler/GHC/Hs/Expr.hs-boot
+++ b/compiler/GHC/Hs/Expr.hs-boot
@@ -11,7 +11,7 @@
 module GHC.Hs.Expr where
 
 import GHC.Types.SrcLoc     ( Located )
-import Outputable ( SDoc, Outputable )
+import GHC.Utils.Outputable ( SDoc, Outputable )
 import {-# SOURCE #-} GHC.Hs.Pat  ( LPat )
 import GHC.Types.Basic  ( SpliceExplicitFlag(..))
 import GHC.Hs.Extension ( OutputableBndrId, GhcPass )
diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs
index b24bdf19b8e8b36d487312d34db87257f135c2c5..57cd67e65af56b169c9afe5e66fe75eaf4ca6a44 100644
--- a/compiler/GHC/Hs/Extension.hs
+++ b/compiler/GHC/Hs/Extension.hs
@@ -25,13 +25,13 @@ module GHC.Hs.Extension where
 -- This module captures the type families to precisely identify the extension
 -- points for GHC.Hs syntax
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Data hiding ( Fixity )
 import GHC.Types.Name
 import GHC.Types.Name.Reader
 import GHC.Types.Var
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc (Located)
 
 import Data.Kind
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index d4ed3e64a0cb5d7988e723e575b84999bda38422..813d0ef9bf83c07d98597ea782692d68b2ef529a 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -16,7 +16,7 @@ GHC.Hs.ImpExp: Abstract syntax: imports, exports, interfaces
 
 module GHC.Hs.ImpExp where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Module       ( ModuleName )
 import GHC.Hs.Doc             ( HsDocString )
@@ -24,8 +24,8 @@ 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 GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.SrcLoc
 import GHC.Hs.Extension
 
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index db7a46805c1a2e5bbb6546d795ffeb3e2e469bab..6eca193bb817669a5fd0e04c7c2154ef2a9ef05f 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -16,7 +16,7 @@ module GHC.Hs.Instances where
 
 import Data.Data hiding ( Fixity )
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Hs.Extension
 import GHC.Hs.Binds
 import GHC.Hs.Decls
diff --git a/compiler/GHC/Hs/Lit.hs b/compiler/GHC/Hs/Lit.hs
index 964df0d356360b379e5e497a44a9a302c274d6ad..75e5c1d315f4966a75b7ed056d8b338dc59e538d 100644
--- a/compiler/GHC/Hs/Lit.hs
+++ b/compiler/GHC/Hs/Lit.hs
@@ -19,7 +19,7 @@ module GHC.Hs.Lit where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Hs.Expr( HsExpr, pprExpr )
 import GHC.Types.Basic
@@ -27,8 +27,8 @@ import GHC.Types.Basic
    , negateFractionalLit, SourceText(..), pprWithSourceText
    , PprPrec(..), topPrec )
 import GHC.Core.Type
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Hs.Extension
 
 import Data.ByteString (ByteString)
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index c92967db817afd16acc91ae0b812323e2ce7f894..4f73aa3e98d4e1fabcfabaae8dc51edd17aebacf 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -50,7 +50,7 @@ module GHC.Hs.Pat (
         pprParendLPat, pprConArgs
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Hs.Expr (SyntaxExpr, LHsExpr, HsSplice, pprLExpr, pprSplice)
 
@@ -69,11 +69,11 @@ import GHC.Types.Name.Reader ( RdrName )
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.Type
 import GHC.Types.SrcLoc
-import Bag -- collect ev vars from pats
-import Maybes
+import GHC.Data.Bag -- collect ev vars from pats
+import GHC.Data.Maybe
 import GHC.Types.Name (Name)
 -- libraries:
 import Data.Data hiding (TyCon,Fixity)
diff --git a/compiler/GHC/Hs/Pat.hs-boot b/compiler/GHC/Hs/Pat.hs-boot
index c7ff0a892e7a9f37044dfd45e0d93eb3b31526f0..1a783e3c7e994a10b6b3741d1e15c8253fafb056 100644
--- a/compiler/GHC/Hs/Pat.hs-boot
+++ b/compiler/GHC/Hs/Pat.hs-boot
@@ -9,7 +9,7 @@
 
 module GHC.Hs.Pat where
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Hs.Extension ( OutputableBndrId, GhcPass, XRec )
 import Data.Kind
 
diff --git a/compiler/main/HscStats.hs b/compiler/GHC/Hs/Stats.hs
similarity index 98%
rename from compiler/main/HscStats.hs
rename to compiler/GHC/Hs/Stats.hs
index 7e0b07ede651f94cc503ab2c83040029e4d72ed4..5b76372f37ddc760e3186bf20b9a986ccec489c2 100644
--- a/compiler/main/HscStats.hs
+++ b/compiler/GHC/Hs/Stats.hs
@@ -8,15 +8,15 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module HscStats ( ppSourceStats ) where
+module GHC.Hs.Stats ( ppSourceStats ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Bag
+import GHC.Data.Bag
 import GHC.Hs
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
-import Util
+import GHC.Utils.Misc
 
 import Data.Char
 
diff --git a/compiler/GHC/Hs/Types.hs b/compiler/GHC/Hs/Types.hs
index 38a0300a8f68624fe6fd429915cd0bf755a42aa2..fd782c6348e0239bdee373d2c1bae63d08a936ac 100644
--- a/compiler/GHC/Hs/Types.hs
+++ b/compiler/GHC/Hs/Types.hs
@@ -72,7 +72,7 @@ module GHC.Hs.Types (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Hs.Expr ( HsSplice, pprSplice )
 
@@ -88,10 +88,10 @@ import GHC.Core.Type
 import GHC.Hs.Doc
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
-import Outputable
-import FastString
-import Maybes( isJust )
-import Util ( count )
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Maybe( isJust )
+import GHC.Utils.Misc ( count )
 
 import Data.Data hiding ( Fixity, Prefix, Infix )
 
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 75ef5b06bf17f41dfd241c26f89ac051842d9d04..6e89b6844a0ba6b2f8e0d55ee0fe39e8a99e1a0d 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -104,7 +104,7 @@ module GHC.Hs.Utils(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs.Decls
 import GHC.Hs.Binds
@@ -130,10 +130,10 @@ 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
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc
+import GHC.Data.Bag
+import GHC.Utils.Outputable
 import GHC.Settings.Constants
 
 import Data.Either
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index ad445bf8bc5337aa52d7bb3d9d44da663671b1ce..7474678e3c043c9987042039406f635b3eda02b9 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -18,7 +18,7 @@ module GHC.HsToCore (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.HsToCore.Usage
 import GHC.Driver.Session
@@ -57,14 +57,14 @@ import GHC.Types.Basic
 import GHC.Core.Opt.Monad ( CoreToDo(..) )
 import GHC.Core.Lint     ( endPassIO )
 import GHC.Types.Var.Set
-import FastString
-import ErrUtils
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Error
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.HsToCore.Coverage
-import Util
-import MonadUtils
-import OrdList
+import GHC.Utils.Misc
+import GHC.Utils.Monad
+import GHC.Data.OrdList
 import GHC.HsToCore.Docs
 
 import Data.List
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index e3ac5a046bc4a26222e496771c1545aacd5c0c6f..733ae86d6e617c99cc35e29ec8f70d9c6035637d 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -16,7 +16,7 @@ module GHC.HsToCore.Arrows ( dsProcExpr ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.HsToCore.Match
 import GHC.HsToCore.Utils
@@ -50,12 +50,12 @@ import GHC.Core.ConLike
 import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Builtin.Names
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Var.Set
 import GHC.Types.SrcLoc
-import ListSetOps( assocMaybe )
+import GHC.Data.List.SetOps( assocMaybe )
 import Data.List
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique.DSet
 
 data DsCmdEnv = DsCmdEnv {
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index cd2a786445e6d553d54539ae2b85d6b24f41f2e7..7bc6fe25125af538b02f4d878c39b6e2293d9ea7 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -25,7 +25,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.HsToCore.Expr  ( dsLExpr )
 import {-# SOURCE #-}   GHC.HsToCore.Match ( matchWrapper )
@@ -44,7 +44,7 @@ import GHC.Core.Utils
 import GHC.Core.Arity     ( etaExpand )
 import GHC.Core.Unfold
 import GHC.Core.FVs
-import Digraph
+import GHC.Data.Graph.Directed
 import GHC.Core.Predicate
 
 import GHC.Builtin.Names
@@ -61,18 +61,18 @@ import GHC.Types.Var.Set
 import GHC.Core.Rules
 import GHC.Types.Var.Env
 import GHC.Types.Var( EvVar )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Module
 import GHC.Types.SrcLoc
-import Maybes
-import OrdList
-import Bag
+import GHC.Data.Maybe
+import GHC.Data.OrdList
+import GHC.Data.Bag
 import GHC.Types.Basic
 import GHC.Driver.Session
-import FastString
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Types.Unique.Set( nonDetEltsUniqSet )
-import MonadUtils
+import GHC.Utils.Monad
 import qualified GHC.LanguageExtensions as LangExt
 import Control.Monad
 import Data.List.NonEmpty ( nonEmpty )
@@ -1173,7 +1173,7 @@ mk_ev_binds ds_binds
                                           coVarsOfType (varType var) }
       -- It's OK to use nonDetEltsUniqSet here as stronglyConnCompFromEdgedVertices
       -- is still deterministic even if the edges are in nondeterministic order
-      -- as explained in Note [Deterministic SCC] in Digraph.
+      -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
 
     ds_scc (AcyclicSCC (v,r)) = NonRec v r
     ds_scc (CyclicSCC prs)    = Rec prs
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 196c4a0cf038ec9afad9a49344cc70730b52e61d..b2f5c4d15e64420fc3708343e473b0dd8b962084 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -12,7 +12,7 @@
 
 module GHC.HsToCore.Coverage (addTicksToBinds, hpcInitCode) where
 
-import GhcPrelude as Prelude
+import GHC.Prelude as Prelude
 
 import qualified GHC.Runtime.Interpreter as GHCi
 import GHCi.RemoteTypes
@@ -22,29 +22,29 @@ import GHC.Stack.CCS
 import GHC.Core.Type
 import GHC.Hs
 import GHC.Types.Module as Module
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Driver.Session
 import GHC.Core.ConLike
 import Control.Monad
 import GHC.Types.SrcLoc
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Name.Set hiding (FreeVars)
 import GHC.Types.Name
-import Bag
+import GHC.Data.Bag
 import GHC.Types.CostCentre
 import GHC.Types.CostCentre.State
 import GHC.Core
 import GHC.Types.Id
 import GHC.Types.Var.Set
 import Data.List
-import FastString
+import GHC.Data.FastString
 import GHC.Driver.Types
 import GHC.Core.TyCon
 import GHC.Types.Basic
-import MonadUtils
-import Maybes
+import GHC.Utils.Monad
+import GHC.Data.Maybe
 import GHC.Cmm.CLabel
-import Util
+import GHC.Utils.Misc
 
 import Data.Time
 import System.Directory
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index 30cf626d6da0b4ded6d9fec870d4714b9bf8168d..c14c2ac7e83a529d249a15b53a866ada21a83f16 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -8,8 +8,8 @@
 
 module GHC.HsToCore.Docs (extractDocs) where
 
-import GhcPrelude
-import Bag
+import GHC.Prelude
+import GHC.Data.Bag
 import GHC.Hs.Binds
 import GHC.Hs.Doc
 import GHC.Hs.Decls
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 8e4313f80df05d424fe0a9d4584692ce8f6717df..2ea1c17e048c02f4eb486aa5502822db2b6b96c0 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -22,7 +22,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.HsToCore.Match
 import GHC.HsToCore.Match.Literal
@@ -60,12 +60,12 @@ import GHC.Core.TyCo.Ppr( pprWithTYPE )
 import GHC.Builtin.Types
 import GHC.Builtin.Names
 import GHC.Types.Basic
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Var.Env
 import GHC.Types.SrcLoc
-import Util
-import Bag
-import Outputable
+import GHC.Utils.Misc
+import GHC.Data.Bag
+import GHC.Utils.Outputable as Outputable
 import GHC.Core.PatSyn
 
 import Control.Monad
@@ -471,7 +471,7 @@ dsExpr (ArithSeq expr witness seq)
 Static Pointers
 ~~~~~~~~~~~~~~~
 
-See Note [Grand plan for static forms] in StaticPtrTable for an overview.
+See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview.
 
     g = ... static f ...
 ==>
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index b3ecd82cf8a2ad12fd59a7a93b031099c77add72..9589c375e8ff009ca5c53a97fc75737a43cd41f3 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -22,7 +22,7 @@ where
 #include "HsVersions.h"
 
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Core
@@ -47,8 +47,8 @@ import GHC.Types.Basic
 import GHC.Types.Literal
 import GHC.Builtin.Names
 import GHC.Driver.Session
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Data.Maybe
 
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index dadfc4000554951d5fd9368981ad1410a4e6858a..9eb867a09851fe5c2a46ed276803e8188849b514 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -16,7 +16,7 @@ Desugaring foreign declarations (see also GHC.HsToCore.Foreign.Call).
 module GHC.HsToCore.Foreign.Decl ( dsForeigns ) where
 
 #include "HsVersions.h"
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Monad        -- temp
 
@@ -48,14 +48,14 @@ import GHC.Builtin.Types.Prim
 import GHC.Builtin.Names
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Driver.Session
 import GHC.Platform
-import OrdList
-import Util
+import GHC.Data.OrdList
+import GHC.Utils.Misc
 import GHC.Driver.Hooks
-import Encoding
+import GHC.Utils.Encoding
 
 import Data.Maybe
 import Data.List
diff --git a/compiler/GHC/HsToCore/GuardedRHSs.hs b/compiler/GHC/HsToCore/GuardedRHSs.hs
index 8ee3661da691df5489b5f2d0adb66a0f065ce137..68162187b882127b59e1d594c68b85621e9153c0 100644
--- a/compiler/GHC/HsToCore/GuardedRHSs.hs
+++ b/compiler/GHC/HsToCore/GuardedRHSs.hs
@@ -13,7 +13,7 @@ module GHC.HsToCore.GuardedRHSs ( dsGuarded, dsGRHSs, isTrueLHsExpr ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.HsToCore.Expr  ( dsLExpr, dsLocalBinds )
 import {-# SOURCE #-} GHC.HsToCore.Match ( matchSinglePatVar )
@@ -27,9 +27,9 @@ import GHC.HsToCore.Monad
 import GHC.HsToCore.Utils
 import GHC.HsToCore.PmCheck.Types ( Deltas, initDeltas )
 import GHC.Core.Type ( Type )
-import Util
+import GHC.Utils.Misc
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.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 9db596fb52e633d55976bd9ff9acfe369259906f..9d6a9bb462ab1b345f8bdcc7ab0cc607aaffa4ae 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -14,7 +14,7 @@ module GHC.HsToCore.ListComp ( dsListComp, dsMonadComp ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.HsToCore.Expr ( dsHandleMonadicFailure, dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds, dsSyntaxExpr )
 
@@ -34,10 +34,10 @@ import GHC.Builtin.Types
 import GHC.HsToCore.Match
 import GHC.Builtin.Names
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Tc.Utils.TcType
-import ListSetOps( getNth )
-import Util
+import GHC.Data.List.SetOps( getNth )
+import GHC.Utils.Misc
 
 {-
 List comprehensions may be desugared in one of two ways: ``ordinary''
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index b9e053c005b728ceaf81b5e4b2feb91827e82f9c..60b694ff9d7754ac7a6e16c79b51b2b448382342 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -23,7 +23,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import {-#SOURCE#-} GHC.HsToCore.Expr (dsLExpr, dsSyntaxExpr)
@@ -54,12 +54,12 @@ import GHC.Core.Coercion ( eqCoercion )
 import GHC.Core.TyCon    ( isNewTyCon )
 import GHC.Builtin.Types
 import GHC.Types.SrcLoc
-import Maybes
-import Util
+import GHC.Data.Maybe
+import GHC.Utils.Misc
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Basic ( isGenerated, il_value, fl_value )
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Unique
 import GHC.Types.Unique.DFM
 
diff --git a/compiler/GHC/HsToCore/Match.hs-boot b/compiler/GHC/HsToCore/Match.hs-boot
index 9466cbdb1799d4fb66490d7c3bd94d013fa6cf54..b42c84e10a54c7e484b2a6231e78359fbf0e2cb6 100644
--- a/compiler/GHC/HsToCore/Match.hs-boot
+++ b/compiler/GHC/HsToCore/Match.hs-boot
@@ -1,6 +1,6 @@
 module GHC.HsToCore.Match where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Types.Var ( Id )
 import GHC.Tc.Utils.TcType  ( Type )
 import GHC.HsToCore.Monad ( DsM, EquationInfo, MatchResult )
diff --git a/compiler/GHC/HsToCore/Match/Constructor.hs b/compiler/GHC/HsToCore/Match/Constructor.hs
index c7022d6b1de038e3bccc9c7e68772f653f1b1960..9c7ad46c22e2cc9e5802fe5b237f39f0a4b2d51e 100644
--- a/compiler/GHC/HsToCore/Match/Constructor.hs
+++ b/compiler/GHC/HsToCore/Match/Constructor.hs
@@ -16,7 +16,7 @@ module GHC.HsToCore.Match.Constructor ( matchConFamily, matchPatSyn ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.HsToCore.Match ( match )
 
@@ -29,12 +29,12 @@ import GHC.HsToCore.Monad
 import GHC.HsToCore.Utils
 import GHC.Core ( CoreExpr )
 import GHC.Core.Make ( mkCoreLets )
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Id
 import GHC.Types.Name.Env
 import GHC.Types.FieldLabel ( flSelector )
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import Control.Monad(liftM)
 import Data.List (groupBy)
 import Data.List.NonEmpty (NonEmpty(..))
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index 93b042e033d2644f45f974fac020c063e722b893..600af91468aabe9f925c2e953c9cdbbd87653e06 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -23,7 +23,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import {-# SOURCE #-} GHC.HsToCore.Match ( match )
@@ -49,11 +49,11 @@ import GHC.Builtin.Types.Prim
 import GHC.Types.Literal
 import GHC.Types.SrcLoc
 import Data.Ratio
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Basic
 import GHC.Driver.Session
-import Util
-import FastString
+import GHC.Utils.Misc
+import GHC.Data.FastString
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index f570330480568036deb208ca5c020bf5b4d179f4..a2163209c368c6ece21a53ef830d8c37a0f3d9ff 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -55,7 +55,7 @@ module GHC.HsToCore.Monad (
         pprRuntimeTrace
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Monad
 import GHC.Core.FamInstEnv
@@ -68,7 +68,7 @@ import GHC.Tc.Utils.TcMType ( checkForLevPolyX, formatLevPolyErr )
 import GHC.Builtin.Names
 import GHC.Types.Name.Reader
 import GHC.Driver.Types
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Basic ( Origin )
 import GHC.Core.DataCon
 import GHC.Core.ConLike
@@ -76,15 +76,15 @@ import GHC.Core.TyCon
 import GHC.HsToCore.PmCheck.Types
 import GHC.Types.Id
 import GHC.Types.Module
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Core.Type
 import GHC.Types.Unique.Supply
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Driver.Session
-import ErrUtils
-import FastString
+import GHC.Utils.Error
+import GHC.Data.FastString
 import GHC.Types.Unique.FM ( lookupWithDefaultUFM )
 import GHC.Types.Literal ( mkLitString )
 import GHC.Types.CostCentre.State
diff --git a/compiler/GHC/HsToCore/PmCheck.hs b/compiler/GHC/HsToCore/PmCheck.hs
index 6c8ac7f0468ad6515105b3499b41f8fc8c23622a..8b34f275b09285a9dde0b42ced932efdd9902e34 100644
--- a/compiler/GHC/HsToCore/PmCheck.hs
+++ b/compiler/GHC/HsToCore/PmCheck.hs
@@ -22,14 +22,14 @@ module GHC.HsToCore.PmCheck (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.HsToCore.PmCheck.Types
 import GHC.HsToCore.PmCheck.Oracle
 import GHC.HsToCore.PmCheck.Ppr
 import GHC.Types.Basic (Origin, isGenerated)
 import GHC.Core (CoreExpr, Expr(Var,App))
-import FastString (unpackFS, lengthFS)
+import GHC.Data.FastString (unpackFS, lengthFS)
 import GHC.Driver.Session
 import GHC.Hs
 import GHC.Tc.Utils.Zonk (shortCutLit)
@@ -39,8 +39,8 @@ import GHC.Types.Name
 import GHC.Tc.Instance.Family
 import GHC.Builtin.Types
 import GHC.Types.SrcLoc
-import Util
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Types.Var (EvVar)
@@ -52,14 +52,14 @@ import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper)
 import GHC.HsToCore.Utils (selectMatchVar)
 import GHC.HsToCore.Match.Literal (dsLit, dsOverLit)
 import GHC.HsToCore.Monad
-import Bag
-import OrdList
+import GHC.Data.Bag
+import GHC.Data.OrdList
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
 import GHC.HsToCore.Utils       (isTrueLHsExpr)
-import Maybes
+import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
-import MonadUtils (concatMapM)
+import GHC.Utils.Monad (concatMapM)
 
 import Control.Monad (when, forM_, zipWithM)
 import Data.List (elemIndex)
diff --git a/compiler/GHC/HsToCore/PmCheck/Oracle.hs b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
index 63cc4710ddda32453119391ea380fee58928fe9e..4fd6132784d350acba561d4473506dede6da50b6 100644
--- a/compiler/GHC/HsToCore/PmCheck/Oracle.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Oracle.hs
@@ -25,15 +25,15 @@ module GHC.HsToCore.PmCheck.Oracle (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.HsToCore.PmCheck.Types
 
 import GHC.Driver.Session
-import Outputable
-import ErrUtils
-import Util
-import Bag
+import GHC.Utils.Outputable
+import GHC.Utils.Error
+import GHC.Utils.Misc
+import GHC.Data.Bag
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.DSet
 import GHC.Types.Unique
@@ -49,9 +49,9 @@ import GHC.Core.SimpleOpt (simpleOptExpr, exprIsConApp_maybe)
 import GHC.Core.Utils     (exprType)
 import GHC.Core.Make      (mkListExpr, mkCharExpr)
 import GHC.Types.Unique.Supply
-import FastString
+import GHC.Data.FastString
 import GHC.Types.SrcLoc
-import Maybes
+import GHC.Data.Maybe
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
@@ -64,7 +64,7 @@ import GHC.Tc.Solver   (tcNormalise, tcCheckSatisfiability)
 import GHC.Core.Unify    (tcMatchTy)
 import GHC.Tc.Types      (completeMatchConLikes)
 import GHC.Core.Coercion
-import MonadUtils hiding (foldlM)
+import GHC.Utils.Monad hiding (foldlM)
 import GHC.HsToCore.Monad hiding (foldlM)
 import GHC.Tc.Instance.Family
 import GHC.Core.FamInstEnv
diff --git a/compiler/GHC/HsToCore/PmCheck/Ppr.hs b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
index 30a5a92f2b552c7137e51fb2cac106ff088e83af..f8619f9a1df0472db84382ce3c0bb32fd1a1cd64 100644
--- a/compiler/GHC/HsToCore/PmCheck/Ppr.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Ppr.hs
@@ -10,7 +10,7 @@ module GHC.HsToCore.PmCheck.Ppr (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
 import GHC.Types.Id
@@ -19,10 +19,10 @@ import GHC.Types.Unique.DFM
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Builtin.Types
-import Outputable
+import GHC.Utils.Outputable
 import Control.Monad.Trans.RWS.CPS
-import Util
-import Maybes
+import GHC.Utils.Misc
+import GHC.Data.Maybe
 import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
 
 import GHC.HsToCore.PmCheck.Types
diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs b/compiler/GHC/HsToCore/PmCheck/Types.hs
index 60ed0ce3567f980f71f88ab4cb25fdb3f49014ac..310786b01c8299dddd01c4cccb115b96ec5b082d 100644
--- a/compiler/GHC/HsToCore/PmCheck/Types.hs
+++ b/compiler/GHC/HsToCore/PmCheck/Types.hs
@@ -39,11 +39,11 @@ module GHC.HsToCore.PmCheck.Types (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Util
-import Bag
-import FastString
+import GHC.Utils.Misc
+import GHC.Data.Bag
+import GHC.Data.FastString
 import GHC.Types.Var (EvVar)
 import GHC.Types.Id
 import GHC.Types.Var.Env
@@ -52,9 +52,9 @@ import GHC.Types.Unique.DFM
 import GHC.Types.Name
 import GHC.Core.DataCon
 import GHC.Core.ConLike
-import Outputable
-import ListSetOps (unionLists)
-import Maybes
+import GHC.Utils.Outputable
+import GHC.Data.List.SetOps (unionLists)
+import GHC.Data.Maybe
 import GHC.Core.Type
 import GHC.Core.TyCon
 import GHC.Types.Literal
diff --git a/compiler/GHC/HsToCore/PmCheck/Types.hs-boot b/compiler/GHC/HsToCore/PmCheck/Types.hs-boot
index abbaa33cfa75d27280fca65c893c8932fab58609..a7c472faa68f4b0b269b3a2a4adfe993049f9b38 100644
--- a/compiler/GHC/HsToCore/PmCheck/Types.hs-boot
+++ b/compiler/GHC/HsToCore/PmCheck/Types.hs-boot
@@ -1,6 +1,6 @@
 module GHC.HsToCore.PmCheck.Types where
 
-import Bag
+import GHC.Data.Bag
 
 data Delta
 
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index b49bd9d66b6ce2d814c0a36c633a6f775b7eea37..54de211b3d7c035cb83e876d31036cc9ab0c323c 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -26,7 +26,7 @@ module GHC.HsToCore.Quote( dsBracket ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import {-# SOURCE #-}   GHC.HsToCore.Expr ( dsExpr )
@@ -53,14 +53,14 @@ import GHC.Core.Utils
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Basic
-import Outputable
-import Bag
+import GHC.Utils.Outputable
+import GHC.Data.Bag
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.ForeignCall
-import Util
-import Maybes
-import MonadUtils
+import GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Utils.Monad
 import GHC.Tc.Types.Evidence
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Class
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index b0588a0a016c87bb997d9ce8baa1d251a55ae9d4..c15fc022f04182ecb51708708ce21c09be56e83a 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -11,7 +11,7 @@ module GHC.HsToCore.Usage (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Driver.Ways
@@ -20,12 +20,12 @@ import GHC.Tc.Types
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Module
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
-import Fingerprint
-import Maybes
+import GHC.Utils.Fingerprint
+import GHC.Data.Maybe
 import GHC.Driver.Packages
 import GHC.Driver.Finder
 
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 01f2a5c7762c0e86bbf02f0db73a90e69dcaf1f0..20ba64bbc57a6b7988e61285badba9cf2ff4260f 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -46,7 +46,7 @@ module GHC.HsToCore.Utils (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.HsToCore.Match ( matchSimply )
 import {-# SOURCE #-} GHC.HsToCore.Expr  ( dsLExpr )
@@ -76,11 +76,11 @@ import GHC.Types.Unique.Supply
 import GHC.Types.Module
 import GHC.Builtin.Names
 import GHC.Types.Name( isInternalName )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
-import Util
+import GHC.Utils.Misc
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import qualified GHC.LanguageExtensions as LangExt
 
 import GHC.Tc.Types.Evidence
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index 2e1953ade7c073fc7d2805fefaace74142ec6156..3e00e8694d53ee018a91690eab88f8851992fa8d 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -33,7 +33,7 @@ module GHC.Iface.Binary (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Monad
 import GHC.Builtin.Utils   ( isKnownKeyName, lookupKnownKeyName )
@@ -44,18 +44,18 @@ import GHC.Types.Name
 import GHC.Driver.Session
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
-import Panic
-import Binary
+import GHC.Utils.Panic
+import GHC.Utils.Binary as Binary
 import GHC.Types.SrcLoc
-import ErrUtils
-import FastMutInt
+import GHC.Utils.Error
+import GHC.Data.FastMutInt
 import GHC.Types.Unique
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Name.Cache
 import GHC.Platform
-import FastString
+import GHC.Data.FastString
 import GHC.Settings.Constants
-import Util
+import GHC.Utils.Misc
 
 import Data.Array
 import Data.Array.ST
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 72cff8b8d75cee2f40388338c27a44dbf00ea96b..75b93605be4757cf1407e1263881eed9011c74ee 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -22,7 +22,7 @@ module GHC.Iface.Env (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Monad
 import GHC.Driver.Types
@@ -31,14 +31,14 @@ import GHC.Types.Var
 import GHC.Types.Name
 import GHC.Types.Avail
 import GHC.Types.Module
-import FastString
-import FastStringEnv
+import GHC.Data.FastString
+import GHC.Data.FastString.Env
 import GHC.Iface.Type
 import GHC.Types.Name.Cache
 import GHC.Types.Unique.Supply
 import GHC.Types.SrcLoc
 
-import Outputable
+import GHC.Utils.Outputable
 import Data.List     ( partition )
 
 {-
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 15edfd7bb6e8258c3cfd8635362833cc45052b87..f35cf8f2f079bb59612b789d9ffc652deff30345 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -17,12 +17,12 @@ Main functions for .hie file generation
 
 module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Avail            ( Avails )
-import Bag                        ( Bag, bagToList )
+import GHC.Data.Bag               ( Bag, bagToList )
 import GHC.Types.Basic
-import BooleanFormula
+import GHC.Data.BooleanFormula
 import GHC.Core.Class             ( FunDep )
 import GHC.Core.Utils             ( exprType )
 import GHC.Core.ConLike           ( conLikeName )
@@ -31,7 +31,7 @@ import GHC.Types.FieldLabel
 import GHC.Hs
 import GHC.Driver.Types
 import GHC.Types.Module           ( ModuleName, ml_hs_file )
-import MonadUtils                 ( concatMapM, liftIO )
+import GHC.Utils.Monad            ( concatMapM, liftIO )
 import GHC.Types.Name             ( Name, nameSrcSpan, setNameLoc )
 import GHC.Types.Name.Env         ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
 import GHC.Types.SrcLoc
@@ -41,8 +41,8 @@ import GHC.Builtin.Types          ( mkListTy, mkSumTy )
 import GHC.Types.Var              ( Id, Var, setVarName, varName, varType )
 import GHC.Tc.Types
 import GHC.Iface.Make             ( mkIfaceExports )
-import Panic
-import Maybes
+import GHC.Utils.Panic
+import GHC.Data.Maybe
 
 import GHC.Iface.Ext.Types
 import GHC.Iface.Ext.Utils
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index a90234c60fee1e21a0263ee79ad345e9cc695240..0077c23ee48eef25b5d5a3f2bb524d60fff51cb5 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -18,21 +18,21 @@ where
 import GHC.Settings.Utils         ( maybeRead )
 
 import Config                     ( cProjectVersion )
-import GhcPrelude
-import Binary
+import GHC.Prelude
+import GHC.Utils.Binary
 import GHC.Iface.Binary           ( getDictFastString )
-import FastMutInt
-import FastString                 ( FastString )
+import GHC.Data.FastMutInt
+import GHC.Data.FastString        ( FastString )
 import GHC.Types.Module           ( Module )
 import GHC.Types.Name
 import GHC.Types.Name.Cache
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Utils
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Unique.Supply    ( takeUniqFromSupply )
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 
 import qualified Data.Array as A
 import Data.IORef
diff --git a/compiler/GHC/Iface/Ext/Debug.hs b/compiler/GHC/Iface/Ext/Debug.hs
index 292668fe234c0a159b1b800f2befe8108f2abd0c..bb0c827627696c5169c074219f3515f2b6a3a7dc 100644
--- a/compiler/GHC/Iface/Ext/Debug.hs
+++ b/compiler/GHC/Iface/Ext/Debug.hs
@@ -7,12 +7,12 @@ Functions to validate and check .hie file ASTs generated by GHC.
 
 module GHC.Iface.Ext.Debug where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.SrcLoc
 import GHC.Types.Module
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 
 import GHC.Iface.Ext.Types
 import GHC.Iface.Ext.Binary
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index edd6540e800104feaaeb4a0a11fae3729d20cb76..88cb9c20428fee0c08198c50b49f17e8339863cb 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -12,18 +12,18 @@ For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files
 {-# LANGUAGE OverloadedStrings #-}
 module GHC.Iface.Ext.Types where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Config
-import Binary
-import FastString                 ( FastString )
+import GHC.Utils.Binary
+import GHC.Data.FastString        ( FastString )
 import GHC.Iface.Type
 import GHC.Types.Module           ( ModuleName, Module )
 import GHC.Types.Name             ( Name )
-import Outputable hiding ( (<>) )
+import GHC.Utils.Outputable hiding ( (<>) )
 import GHC.Types.SrcLoc           ( RealSrcSpan )
 import GHC.Types.Avail
-import qualified Outputable as O ( (<>) )
+import qualified GHC.Utils.Outputable as O ( (<>) )
 
 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 bbbe1084f12b2a89c2eaebe3e64ac231fe9225ba..3b9bb2b4aaee86194dbcdfa6aea4d00bcb7d0738 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -4,14 +4,14 @@
 {-# LANGUAGE FlexibleInstances #-}
 module GHC.Iface.Ext.Utils where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.Map
-import GHC.Driver.Session         ( DynFlags )
-import FastString                 ( FastString, mkFastString )
+import GHC.Driver.Session    ( DynFlags )
+import GHC.Data.FastString   ( FastString, mkFastString )
 import GHC.Iface.Type
 import GHC.Types.Name hiding (varName)
-import Outputable                 ( renderWithStyle, ppr, defaultUserStyle, initSDocContext )
+import GHC.Utils.Outputable  ( renderWithStyle, ppr, defaultUserStyle, initSDocContext )
 import GHC.Types.SrcLoc
 import GHC.CoreToIface
 import GHC.Core.TyCon
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 5fca78c67c5eed722c199b82349b9e2aa34819b1..0068441ee30d58c736eff9103d467c8c7cb1e7e6 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -34,7 +34,7 @@ module GHC.Iface.Load (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.IfaceToCore
    ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst
@@ -48,7 +48,7 @@ import GHC.Driver.Types
 import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Tc.Utils.Monad
 
-import Binary   ( BinData(..) )
+import GHC.Utils.Binary   ( BinData(..) )
 import GHC.Settings.Constants
 import GHC.Builtin.Names
 import GHC.Builtin.Utils
@@ -64,17 +64,17 @@ import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.Avail
 import GHC.Types.Module
-import Maybes
-import ErrUtils
+import GHC.Data.Maybe
+import GHC.Utils.Error
 import GHC.Driver.Finder
 import GHC.Types.Unique.FM
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Iface.Binary
-import Panic
-import Util
-import FastString
-import Fingerprint
+import GHC.Utils.Panic
+import GHC.Utils.Misc
+import GHC.Data.FastString
+import GHC.Utils.Fingerprint
 import GHC.Driver.Hooks
 import GHC.Types.FieldLabel
 import GHC.Iface.Rename
diff --git a/compiler/GHC/Iface/Load.hs-boot b/compiler/GHC/Iface/Load.hs-boot
index 51270ccb338ce06c51a03e50393777cf4357df62..7e7d235bb7359c292c3c742fc97f4ec341682f17 100644
--- a/compiler/GHC/Iface/Load.hs-boot
+++ b/compiler/GHC/Iface/Load.hs-boot
@@ -3,6 +3,6 @@ module GHC.Iface.Load where
 import GHC.Types.Module (Module)
 import GHC.Tc.Utils.Monad (IfM)
 import GHC.Driver.Types (ModIface)
-import Outputable (SDoc)
+import GHC.Utils.Outputable (SDoc)
 
 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index ef9e77b44d99b56a4c92bb1c5093ce4b5cc13c86..6ffce05405b4399ebb17240f491a5d4343505b0f 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -21,7 +21,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Syntax
 import GHC.Iface.Recomp
@@ -53,12 +53,12 @@ import GHC.Types.Name.Reader
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
 import GHC.Types.Module
-import ErrUtils
-import Outputable
-import GHC.Types.Basic  hiding ( SuccessFlag(..) )
-import Util             hiding ( eqListBy )
-import FastString
-import Maybes
+import GHC.Utils.Error
+import GHC.Utils.Outputable
+import GHC.Types.Basic hiding ( SuccessFlag(..) )
+import GHC.Utils.Misc  hiding ( eqListBy )
+import GHC.Data.FastString
+import GHC.Data.Maybe
 import GHC.HsToCore.Docs
 
 import Data.Function
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 57809a6d5931c03410e68a1583634668b9f7b73b..430f7b42071b9613af5a8faf48edeb3b5987661d 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -12,7 +12,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Syntax
 import GHC.Iface.Recomp.Binary
@@ -29,16 +29,16 @@ import GHC.Driver.Session
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Module
-import ErrUtils
-import Digraph
+import GHC.Utils.Error
+import GHC.Data.Graph.Directed
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Unique
-import Util             hiding ( eqListBy )
-import Maybes
-import Binary
-import Fingerprint
-import Exception
+import GHC.Utils.Misc hiding ( eqListBy )
+import GHC.Data.Maybe
+import GHC.Utils.Binary
+import GHC.Utils.Fingerprint
+import GHC.Utils.Exception
 import GHC.Types.Unique.Set
 import GHC.Driver.Packages
 
@@ -766,7 +766,7 @@ addFingerprints hsc_env iface0
                    -- used to construct the edges and
                    -- stronglyConnCompFromEdgedVertices is deterministic
                    -- even with non-deterministic order of edges as
-                   -- explained in Note [Deterministic SCC] in Digraph.
+                   -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
           where getParent :: OccName -> OccName
                 getParent occ = lookupOccEnv parent_map occ `orElse` occ
 
diff --git a/compiler/GHC/Iface/Recomp/Binary.hs b/compiler/GHC/Iface/Recomp/Binary.hs
index 55742b55eba79363758564f7c82f6a8ebe584db2..c07b5d7d166179a523ca5e19a9725ab08246bd90 100644
--- a/compiler/GHC/Iface/Recomp/Binary.hs
+++ b/compiler/GHC/Iface/Recomp/Binary.hs
@@ -10,13 +10,13 @@ module GHC.Iface.Recomp.Binary
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Fingerprint
-import Binary
+import GHC.Utils.Fingerprint
+import GHC.Utils.Binary
 import GHC.Types.Name
-import PlainPanic
-import Util
+import GHC.Utils.Panic.Plain
+import GHC.Utils.Misc
 
 fingerprintBinMem :: BinHandle -> IO Fingerprint
 fingerprintBinMem bh = withBinBuffer bh f
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index ff5b23b709d2eb4d8ae29063d824c5eb51c4a302..66b6b9f15f8afcd243b88d2f4ac016206db8ea05 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -8,18 +8,18 @@ module GHC.Iface.Recomp.Flags (
       , fingerprintHpcFlags
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Binary
+import GHC.Utils.Binary
 import GHC.Driver.Session
 import GHC.Driver.Types
 import GHC.Types.Module
 import GHC.Types.Name
-import Fingerprint
+import GHC.Utils.Fingerprint
 import GHC.Iface.Recomp.Binary
--- import Outputable
+-- import GHC.Utils.Outputable
 
-import qualified EnumSet
+import GHC.Data.EnumSet as EnumSet
 import System.FilePath (normalise)
 
 -- | Produce a fingerprint of a @DynFlags@ value. We only base
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 6bceb1effb8eb03b16ee75902b854f82cb06d38f..dbe847b5f4ce9e67f113867d3d1760c95d074654 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -17,10 +17,10 @@ module GHC.Iface.Rename (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Types
 import GHC.Types.Module
 import GHC.Types.Unique.FM
@@ -28,12 +28,12 @@ import GHC.Types.Avail
 import GHC.Iface.Syntax
 import GHC.Types.FieldLabel
 import GHC.Types.Var
-import ErrUtils
+import GHC.Utils.Error
 
 import GHC.Types.Name
 import GHC.Tc.Utils.Monad
-import Util
-import Fingerprint
+import GHC.Utils.Misc
+import GHC.Utils.Fingerprint
 import GHC.Types.Basic
 
 -- a bit vexing
@@ -42,7 +42,7 @@ import GHC.Driver.Session
 
 import qualified Data.Traversable as T
 
-import Bag
+import GHC.Data.Bag
 import Data.IORef
 import GHC.Types.Name.Shape
 import GHC.Iface.Env
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 3c707bc34818a9cf9f283f947edcbb146f0c5c1f..9db82731d8965800756fce84c4445faa75ac30ab 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -42,7 +42,7 @@ module GHC.Iface.Syntax (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Type
 import GHC.Iface.Recomp.Binary
@@ -59,19 +59,19 @@ import GHC.Types.Literal
 import GHC.Types.ForeignCall
 import GHC.Types.Annotations( AnnPayload, AnnTarget )
 import GHC.Types.Basic
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Module
 import GHC.Types.SrcLoc
-import Fingerprint
-import Binary
-import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
+import GHC.Utils.Fingerprint
+import GHC.Utils.Binary
+import GHC.Data.BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
 import GHC.Types.Var( VarBndr(..), binderVar )
 import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
-import Util( dropList, filterByList, notNull, unzipWith, debugIsOn )
+import GHC.Utils.Misc( dropList, filterByList, notNull, unzipWith, debugIsOn )
 import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
 import GHC.Utils.Lexeme (isLexSym)
 import GHC.Builtin.Types ( constraintKindTyConName )
-import Util (seqList)
+import GHC.Utils.Misc (seqList)
 
 import Control.Monad
 import System.IO.Unsafe
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 3fc645e2789e172f32120838b338dfc7f55bce58..e3c3c0b01c74eb5e1408db05bb8bcc534428484f 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -14,7 +14,7 @@ module GHC.Iface.Tidy (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types
 import GHC.Driver.Session
@@ -30,7 +30,7 @@ import GHC.Core.Rules
 import GHC.Core.PatSyn
 import GHC.Core.ConLike
 import GHC.Core.Arity   ( exprArity, exprBotStrictness_maybe )
-import StaticPtrTable
+import GHC.Iface.Tidy.StaticPtrTable
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Types.Var
@@ -54,11 +54,11 @@ import GHC.Core.TyCon
 import GHC.Core.Class
 import GHC.Types.Module
 import GHC.Driver.Types
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Unique.Supply
-import Outputable
-import Util( filterOut )
-import qualified ErrUtils as Err
+import GHC.Utils.Outputable
+import GHC.Utils.Misc( filterOut )
+import qualified GHC.Utils.Error as Err
 
 import Control.Monad
 import Data.Function
@@ -378,7 +378,7 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
         ; (tidy_env, tidy_binds)
                  <- tidyTopBinds hsc_env unfold_env tidy_occ_env trimmed_binds
 
-          -- See Note [Grand plan for static forms] in StaticPtrTable.
+          -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
         ; (spt_entries, tidy_binds') <-
              sptCreateStaticBinds hsc_env mod tidy_binds
         ; let { spt_init_code = sptModuleInitCode mod spt_entries
diff --git a/compiler/main/StaticPtrTable.hs b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
similarity index 99%
rename from compiler/main/StaticPtrTable.hs
rename to compiler/GHC/Iface/Tidy/StaticPtrTable.hs
index 006b6f2b395300c173a27a3693b349ba4ed37daa..09125a4b53dd418137732c82f220d289deadf7b6 100644
--- a/compiler/main/StaticPtrTable.hs
+++ b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
@@ -46,7 +46,7 @@
 --
 
 {-# LANGUAGE ViewPatterns, TupleSections #-}
-module StaticPtrTable
+module GHC.Iface.Tidy.StaticPtrTable
     ( sptCreateStaticBinds
     , sptModuleInitCode
     ) where
@@ -122,7 +122,7 @@ Here is a running example:
   in upsweep after we have compiled the module (see GHC.Driver.Make.upsweep').
 -}
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.CLabel
 import GHC.Core
@@ -134,7 +134,7 @@ import GHC.Types.Id
 import GHC.Core.Make (mkStringExprFSWith)
 import GHC.Types.Module
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Platform
 import GHC.Builtin.Names
 import GHC.Tc.Utils.Env (lookupGlobal)
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 6aedf0fd4cfe07563e6284b964296bace218fa38..5c2172f96fa6df2e2889c1098f60f6c41d43db4f 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -60,7 +60,7 @@ module GHC.Iface.Type (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Builtin.Types
                                  ( coercibleTyCon, heqTyCon
@@ -73,11 +73,11 @@ import GHC.Types.Var
 import GHC.Builtin.Names
 import GHC.Types.Name
 import GHC.Types.Basic
-import Binary
-import Outputable
-import FastString
-import FastStringEnv
-import Util
+import GHC.Utils.Binary
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.FastString.Env
+import GHC.Utils.Misc
 
 import Data.Maybe( isJust )
 import qualified Data.Semigroup as Semi
diff --git a/compiler/main/UpdateCafInfos.hs b/compiler/GHC/Iface/UpdateCafInfos.hs
similarity index 96%
rename from compiler/main/UpdateCafInfos.hs
rename to compiler/GHC/Iface/UpdateCafInfos.hs
index c8a0e725e36a683ce1bbb202fda5324cff6dc74a..befb95c6ef65b32c0f426e278c9855966a949e6b 100644
--- a/compiler/main/UpdateCafInfos.hs
+++ b/compiler/GHC/Iface/UpdateCafInfos.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE CPP, BangPatterns, Strict, RecordWildCards #-}
 
-module UpdateCafInfos
+module GHC.Iface.UpdateCafInfos
   ( updateModDetailsCafInfos
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core
 import GHC.Driver.Session
@@ -14,9 +14,9 @@ import GHC.Types.Id.Info
 import GHC.Core.InstEnv
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var
-import Outputable
+import GHC.Utils.Outputable
 
 #include "HsVersions.h"
 
@@ -116,7 +116,7 @@ updateGlobalIds env e = go env e
       case lookupNameEnv env (varName var) of
         Nothing -> var
         Just (AnId id) -> id
-        Just other -> pprPanic "UpdateCafInfos.updateGlobalIds" $
+        Just other -> pprPanic "GHC.Iface.UpdateCafInfos.updateGlobalIds" $
           text "Found a non-Id for Id Name" <+> ppr (varName var) $$
           nest 4 (text "Id:" <+> ppr var $$
                   text "TyThing:" <+> ppr other)
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 5f3cd10cfb52f2e43bace4eff570c018b10bfdeb..d895b9228e63e635e03deded192fa61022e348cd 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -24,7 +24,7 @@ module GHC.IfaceToCore (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Builtin.Types.Literals(typeNatCoAxiomRules)
 import GHC.Iface.Syntax
@@ -66,16 +66,16 @@ import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
 import GHC.Types.Module
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
-import Outputable
-import Maybes
+import GHC.Utils.Outputable
+import GHC.Data.Maybe
 import GHC.Types.SrcLoc
 import GHC.Driver.Session
-import Util
-import FastString
+import GHC.Utils.Misc
+import GHC.Data.FastString
 import GHC.Types.Basic hiding ( SuccessFlag(..) )
-import ListSetOps
+import GHC.Data.List.SetOps
 import GHC.Fingerprint
-import qualified BooleanFormula as BF
+import qualified GHC.Data.BooleanFormula as BF
 
 import Control.Monad
 import qualified Data.Map as Map
diff --git a/compiler/GHC/IfaceToCore.hs-boot b/compiler/GHC/IfaceToCore.hs-boot
index e658493d8f73af38268f4fc23d175aa50cc41c54..91b538ef41db052a04c0555ae471c5dc6f95241f 100644
--- a/compiler/GHC/IfaceToCore.hs-boot
+++ b/compiler/GHC/IfaceToCore.hs-boot
@@ -1,6 +1,6 @@
 module GHC.IfaceToCore where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Iface.Syntax ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule
                         , IfaceAnnotation, IfaceCompleteMatch )
 import GHC.Core.TyCo.Rep   ( TyThing )
diff --git a/compiler/GHC/Llvm/MetaData.hs b/compiler/GHC/Llvm/MetaData.hs
index 3e319c7036c6b6387d90c2c17db062208d1bce1c..c2a1aa4a8f56a730cf7381eca83f15a34879c812 100644
--- a/compiler/GHC/Llvm/MetaData.hs
+++ b/compiler/GHC/Llvm/MetaData.hs
@@ -2,10 +2,10 @@
 
 module GHC.Llvm.MetaData where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm.Types
-import Outputable
+import GHC.Utils.Outputable
 
 -- The LLVM Metadata System.
 --
diff --git a/compiler/GHC/Llvm/Ppr.hs b/compiler/GHC/Llvm/Ppr.hs
index 4645c89e1a699824c4d7ade9e644760fe1cde206..c16f6b4136a35c0ffa3eb22dbf15e7864da197fe 100644
--- a/compiler/GHC/Llvm/Ppr.hs
+++ b/compiler/GHC/Llvm/Ppr.hs
@@ -25,7 +25,7 @@ module GHC.Llvm.Ppr (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm.Syntax
 import GHC.Llvm.MetaData
@@ -33,9 +33,9 @@ import GHC.Llvm.Types
 import GHC.Platform
 
 import Data.List ( intersperse )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
-import FastString ( sLit )
+import GHC.Data.FastString ( sLit )
 
 --------------------------------------------------------------------------------
 -- * Top Level Print functions
diff --git a/compiler/GHC/Llvm/Syntax.hs b/compiler/GHC/Llvm/Syntax.hs
index 51324b396dddaa2a49d1dc198c418961f0db0cb2..12e0073c7a771732b049a14ae06c67227b097811 100644
--- a/compiler/GHC/Llvm/Syntax.hs
+++ b/compiler/GHC/Llvm/Syntax.hs
@@ -4,7 +4,7 @@
 
 module GHC.Llvm.Syntax where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Llvm.MetaData
 import GHC.Llvm.Types
diff --git a/compiler/GHC/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs
index 0452e6177c338e29a78545a20959ffa05e714c61..5a59c5c8fb24bf7220a6934c85bb31a03797ff2e 100644
--- a/compiler/GHC/Llvm/Types.hs
+++ b/compiler/GHC/Llvm/Types.hs
@@ -9,7 +9,7 @@ module GHC.Llvm.Types where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Char
 import Data.Int
@@ -17,8 +17,8 @@ import Numeric
 
 import GHC.Platform
 import GHC.Driver.Session
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 
 -- from NCG
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 90b23f7ca653a758ce2475ed35ac4e19317f16d4..81b0607a49473db5fe413be5848c2275a0d3adc0 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -54,16 +54,16 @@ import GHC.Driver.Phases  ( HscSource(..) )
 import GHC.Driver.Types   ( IsBootInterface, WarningTxt(..) )
 import GHC.Driver.Session
 import GHC.Driver.Backpack.Syntax
-import UnitInfo
+import GHC.Unit.Info
 
 -- compiler/utils
-import OrdList
-import BooleanFormula   ( BooleanFormula(..), LBooleanFormula(..), mkTrue )
-import FastString
-import Maybes           ( isJust, orElse )
-import Outputable
-import Util             ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
-import GhcPrelude
+import GHC.Data.OrdList
+import GHC.Data.BooleanFormula ( BooleanFormula(..), LBooleanFormula(..), mkTrue )
+import GHC.Data.FastString
+import GHC.Data.Maybe          ( isJust, orElse )
+import GHC.Utils.Outputable
+import GHC.Utils.Misc          ( looksLikePackageName, fstOf3, sndOf3, thdOf3 )
+import GHC.Prelude
 
 -- compiler/basicTypes
 import GHC.Types.Name.Reader
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index dbd1f79e23c84b3950b7f88317d0349cd73c2521..e05ac34b751d149c411c848bce1aee63160c4436 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -13,10 +13,10 @@ module GHC.Parser.Annotation (
   LRdrName -- Exists for haddocks only
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Name.Reader
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import qualified Data.Map as Map
 import Data.Data
diff --git a/compiler/GHC/Parser/CharClass.hs b/compiler/GHC/Parser/CharClass.hs
index dc98d48f944ee8c6a9699db22f7d07d43f220a01..6d09de764c8155c5f05824e3cbc74beef0f05bef 100644
--- a/compiler/GHC/Parser/CharClass.hs
+++ b/compiler/GHC/Parser/CharClass.hs
@@ -16,12 +16,12 @@ module GHC.Parser.CharClass
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.Bits        ( Bits((.&.),(.|.)) )
 import Data.Char        ( ord, chr )
 import Data.Word
-import Panic
+import GHC.Utils.Panic
 
 -- Bit masks
 
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index e2373827f4c97193e9c39478169c1bf4e562460d..12fd44dc4b2af4ebb1714e367ef1fb4cce5489eb 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -24,26 +24,26 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.Driver.Types
 import GHC.Parser           ( parseHeader )
 import GHC.Parser.Lexer
-import FastString
+import GHC.Data.FastString
 import GHC.Hs
 import GHC.Types.Module
 import GHC.Builtin.Names
-import StringBuffer
+import GHC.Data.StringBuffer
 import GHC.Types.SrcLoc
 import GHC.Driver.Session
-import ErrUtils
-import Util
-import Outputable
-import Maybes
-import Bag              ( emptyBag, listToBag, unitBag )
-import MonadUtils
-import Exception
+import GHC.Utils.Error
+import GHC.Utils.Misc
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.Maybe
+import GHC.Data.Bag         ( emptyBag, listToBag, unitBag )
+import GHC.Utils.Monad
+import GHC.Utils.Exception as Exception
 import GHC.Types.Basic
 import qualified GHC.LanguageExtensions as LangExt
 
@@ -345,7 +345,7 @@ optionsErrorMsgs dflags unhandled_flags flags_lines _filename
                                 , L l f' <- flags_lines
                                 , f == f' ]
         mkMsg (L flagSpan flag) =
-            ErrUtils.mkPlainErrMsg dflags flagSpan $
+            GHC.Utils.Error.mkPlainErrMsg dflags flagSpan $
                     text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+> text flag
 
 optionsParseError :: String -> DynFlags -> SrcSpan -> a     -- #15053
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 17b6674c950641c56b333bbade81507bc105a37e..3a93214cb45fd0e3c52bd01eca6ecbe73570f374 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -69,7 +69,7 @@ module GHC.Parser.Lexer (
    commentToAnnotation
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 -- base
 import Control.Monad
@@ -79,8 +79,7 @@ import Data.List
 import Data.Maybe
 import Data.Word
 
-import EnumSet (EnumSet)
-import qualified EnumSet
+import GHC.Data.EnumSet as EnumSet
 
 -- ghc-boot
 import qualified GHC.LanguageExtensions as LangExt
@@ -93,15 +92,15 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 
 -- compiler/utils
-import Bag
-import Outputable
-import StringBuffer
-import FastString
+import GHC.Data.Bag
+import GHC.Utils.Outputable
+import GHC.Data.StringBuffer
+import GHC.Data.FastString
 import GHC.Types.Unique.FM
-import Util             ( readRational, readHexRational )
+import GHC.Utils.Misc ( readRational, readHexRational )
 
 -- compiler/main
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Session as DynFlags
 
 -- compiler/basicTypes
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index b1354785842ec2632fdde1811fa707a4a91a93bf..5a1817a1f662c2b45086edee2d627f72dc023c1d 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -103,7 +103,7 @@ module GHC.Parser.PostProcess (
         PatBuilder
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Hs           -- Lots of it
 import GHC.Core.TyCon          ( TyCon, isTupleTyCon, tyConSingleDataCon_maybe )
 import GHC.Core.DataCon        ( DataCon, dataConTyCon )
@@ -123,16 +123,16 @@ import GHC.Types.ForeignCall
 import GHC.Builtin.Names ( allNameStrings )
 import GHC.Types.SrcLoc
 import GHC.Types.Unique ( hasKey )
-import OrdList          ( OrdList, fromOL )
-import Bag              ( emptyBag, consBag )
-import Outputable
-import FastString
-import Maybes
-import Util
+import GHC.Data.OrdList ( OrdList, fromOL )
+import GHC.Data.Bag     ( emptyBag, consBag )
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.FastString
+import GHC.Data.Maybe
+import GHC.Utils.Misc
 import GHC.Parser.Annotation
 import Data.List
 import GHC.Driver.Session ( WarningFlag(..), DynFlags )
-import ErrUtils ( Messages )
+import GHC.Utils.Error ( Messages )
 
 import Control.Monad
 import Text.ParserCombinators.ReadP as ReadP
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index a3d5e101d7d34dd58792c36445da6dbc5f920fb5..f232113c2e50a646622c64d0197a30ec615482ea 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -2,7 +2,7 @@
 
 module GHC.Parser.PostProcess.Haddock where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Platform/ARM.hs b/compiler/GHC/Platform/ARM.hs
index d0c7e5811a588a1f0e20056126ba46da6a2b0d5a..d1e2d9d3121693e70ededcf8f783c8d5fc8aa9da 100644
--- a/compiler/GHC/Platform/ARM.hs
+++ b/compiler/GHC/Platform/ARM.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.ARM where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_arm 1
diff --git a/compiler/GHC/Platform/ARM64.hs b/compiler/GHC/Platform/ARM64.hs
index ebd66b92c527bc758210462768cfeec7dbe9f6a6..5bc1ec91e24034a1be04515a1780ffe280702f67 100644
--- a/compiler/GHC/Platform/ARM64.hs
+++ b/compiler/GHC/Platform/ARM64.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.ARM64 where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_aarch64 1
diff --git a/compiler/GHC/Platform/NoRegs.hs b/compiler/GHC/Platform/NoRegs.hs
index e8abf442539a0c079f869bd262ee39bc86ea8534..c00f4cb7ff2d831a8651f69ed4e34d9dbff0622c 100644
--- a/compiler/GHC/Platform/NoRegs.hs
+++ b/compiler/GHC/Platform/NoRegs.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.NoRegs where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 1
 #include "../../../includes/CodeGen.Platform.hs"
diff --git a/compiler/GHC/Platform/PPC.hs b/compiler/GHC/Platform/PPC.hs
index f405f954383f2f3e62c7df9958b448595f80fed4..5b4f3bfb14106cff8df1bf3cdd8e33054328dbdb 100644
--- a/compiler/GHC/Platform/PPC.hs
+++ b/compiler/GHC/Platform/PPC.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.PPC where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_powerpc 1
diff --git a/compiler/GHC/Platform/Reg.hs b/compiler/GHC/Platform/Reg.hs
index 00cd254630ca0093f95f611ac6d2f72542fc01ee..37fd039ef760028c690f19bcf066778d74165078 100644
--- a/compiler/GHC/Platform/Reg.hs
+++ b/compiler/GHC/Platform/Reg.hs
@@ -26,9 +26,9 @@ module GHC.Platform.Reg (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 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 8aa81c2fe9428a2e1427358ef7f144de12591112..3b967c5c5529fd4c4f73fd3cbc0bf7d4cbe26e39 100644
--- a/compiler/GHC/Platform/Reg/Class.hs
+++ b/compiler/GHC/Platform/Reg/Class.hs
@@ -4,9 +4,9 @@ module GHC.Platform.Reg.Class
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Unique
 
 
diff --git a/compiler/GHC/Platform/Regs.hs b/compiler/GHC/Platform/Regs.hs
index d214b0d89f0b8b97bfc0ec2b89bc982d432b4298..1b72d079797a753b8aa2d4809b5036b354e38666 100644
--- a/compiler/GHC/Platform/Regs.hs
+++ b/compiler/GHC/Platform/Regs.hs
@@ -3,7 +3,7 @@ module GHC.Platform.Regs
        (callerSaves, activeStgRegs, haveRegBase, globalRegMaybe, freeReg)
        where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Cmm.Expr
 import GHC.Platform
diff --git a/compiler/GHC/Platform/S390X.hs b/compiler/GHC/Platform/S390X.hs
index 8599bb67c0a01465c2b458f11414a2c86e449a0a..709d2db1016e71d9a19d07de72d4a89c3f8a8147 100644
--- a/compiler/GHC/Platform/S390X.hs
+++ b/compiler/GHC/Platform/S390X.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.S390X where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_s390x 1
diff --git a/compiler/GHC/Platform/SPARC.hs b/compiler/GHC/Platform/SPARC.hs
index b0cdb27f44d35bf617902edd6ad754a52c0b00b2..b1dad08837ec504f668de168204b87983dbf7e3d 100644
--- a/compiler/GHC/Platform/SPARC.hs
+++ b/compiler/GHC/Platform/SPARC.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.SPARC where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_sparc 1
diff --git a/compiler/GHC/Platform/X86.hs b/compiler/GHC/Platform/X86.hs
index 1570ba9fa082a3f69cdc78ec7acf54d4d5974d52..e065036f6176d0384ecbc959ef0971a5a7ebdc4a 100644
--- a/compiler/GHC/Platform/X86.hs
+++ b/compiler/GHC/Platform/X86.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.X86 where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_i386 1
diff --git a/compiler/GHC/Platform/X86_64.hs b/compiler/GHC/Platform/X86_64.hs
index d2d1b15c715d4a68e607fe4bfad4a594ca438b30..27c42329757f91e7a3cf52a1b068bbc6eca9917b 100644
--- a/compiler/GHC/Platform/X86_64.hs
+++ b/compiler/GHC/Platform/X86_64.hs
@@ -2,7 +2,7 @@
 
 module GHC.Platform.X86_64 where
 
-import GhcPrelude
+import GHC.Prelude
 
 #define MACHREGS_NO_REGS 0
 #define MACHREGS_x86_64 1
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index 8ba1c5fb2d899cee8c0cec9d399253c2e8eeba12..c51ac4c0538ba563f741460a1d406cefad298bee 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -41,13 +41,13 @@ module GHC.Plugins
    , module GHC.Types.Unique
    , module GHC.Types.Unique.Set
    , module GHC.Types.Unique.FM
-   , module FiniteMap
-   , module Util
+   , module GHC.Data.FiniteMap
+   , module GHC.Utils.Misc
    , module GHC.Serialized
    , module GHC.Types.SrcLoc
-   , module Outputable
+   , module GHC.Utils.Outputable
    , module GHC.Types.Unique.Supply
-   , module FastString
+   , module GHC.Data.FastString
    , -- * Getting 'Name's
      thNameToGhcName
    )
@@ -103,21 +103,21 @@ import GHC.Types.Unique.Set
 import GHC.Types.Unique.FM
 -- Conflicts with UniqFM:
 --import LazyUniqFM
-import FiniteMap
+import GHC.Data.FiniteMap
 
 -- Common utilities
-import Util
+import GHC.Utils.Misc
 import GHC.Serialized
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique.Supply
 import GHC.Types.Unique ( Unique, Uniquable(..) )
-import FastString
+import GHC.Data.FastString
 import Data.Maybe
 
 import GHC.Iface.Env    ( lookupOrigIO )
-import GhcPrelude
-import MonadUtils       ( mapMaybeM )
+import GHC.Prelude
+import GHC.Utils.Monad  ( mapMaybeM )
 import GHC.ThToHs       ( thRdrNameGuesses )
 import GHC.Tc.Utils.Env ( lookupGlobal )
 
diff --git a/compiler/utils/GhcPrelude.hs b/compiler/GHC/Prelude.hs
similarity index 93%
rename from compiler/utils/GhcPrelude.hs
rename to compiler/GHC/Prelude.hs
index dd78f15573ddef083b5c4345ca60f123e715f59f..95c2d4b190d4a5f35b94fa538aea0c517ea0494f 100644
--- a/compiler/utils/GhcPrelude.hs
+++ b/compiler/GHC/Prelude.hs
@@ -8,9 +8,9 @@
 
 -- Every module in GHC
 --   * Is compiled with -XNoImplicitPrelude
---   * Explicitly imports GhcPrelude
+--   * Explicitly imports GHC.Prelude
 
-module GhcPrelude (module X) where
+module GHC.Prelude (module X) where
 
 -- We export the 'Semigroup' class but w/o the (<>) operator to avoid
 -- clashing with the (Outputable.<>) operator which is heavily used
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index b8dbfd1e1c6f51ca465acc149bba7c7f20cb44de..5f624a3000f53916d2e4f7908accb658f56ada4a 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -29,7 +29,7 @@ module GHC.Rename.Bind (
    HsSigCtxt(..)
    ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr, rnStmts )
 
@@ -51,15 +51,15 @@ 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 GHC.Types.Basic  ( RecFlag(..), TypeOrKind(..) )
-import Digraph          ( SCC(..) )
-import Bag
-import Util
-import Outputable
+import GHC.Data.List.SetOps    ( findDupsEq )
+import GHC.Types.Basic         ( RecFlag(..), TypeOrKind(..) )
+import GHC.Data.Graph.Directed ( SCC(..) )
+import GHC.Data.Bag
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Types.Unique.Set
-import Maybes           ( orElse )
-import OrdList
+import GHC.Data.Maybe          ( orElse )
+import GHC.Data.OrdList
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
diff --git a/compiler/GHC/Rename/Doc.hs b/compiler/GHC/Rename/Doc.hs
index bd9fd60b732ee0b018aa44354b871a77ec1e00f8..f053795073fd68a65699de602737011efb82a69c 100644
--- a/compiler/GHC/Rename/Doc.hs
+++ b/compiler/GHC/Rename/Doc.hs
@@ -2,7 +2,7 @@
 
 module GHC.Rename.Doc ( rnHsDoc, rnLHsDoc, rnMbLHsDoc ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types
 import GHC.Hs
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 18d922d636b6f874e18b7621970b1080a802dfa2..1c22cf781e65cc3fbba900dc723fb4ff645d724f 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -44,7 +44,7 @@ module GHC.Rename.Env (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Load   ( loadInterfaceForName, loadSrcInterface_maybe )
 import GHC.Iface.Env
@@ -63,18 +63,18 @@ import GHC.Types.Module
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.TyCon
-import ErrUtils         ( MsgDoc )
+import GHC.Utils.Error  ( MsgDoc )
 import GHC.Builtin.Names( rOOT_MAIN )
 import GHC.Types.Basic  ( pprWarningTxtForMsg, TopLevelFlag(..), TupleSort(..) )
 import GHC.Types.SrcLoc as SrcLoc
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Unique.Set ( uniqSetAny )
-import Util
-import Maybes
+import GHC.Utils.Misc
+import GHC.Data.Maybe
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import Control.Monad
-import ListSetOps       ( minusList )
+import GHC.Data.List.SetOps ( minusList )
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Rename.Unbound
 import GHC.Rename.Utils
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 9c520874480fd0d2d0c85c1be167811fe21c543e..62afe116df7d829a0522e0cc4caa9c7a2d0d08fb 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -26,7 +26,7 @@ module GHC.Rename.Expr (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS
                         , rnMatchGroup, rnGRHS, makeMiniFixityEnv)
@@ -54,12 +54,12 @@ 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 GHC.Utils.Misc
+import GHC.Data.List.SetOps ( removeDups )
+import GHC.Utils.Error
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.SrcLoc
-import FastString
+import GHC.Data.FastString
 import Control.Monad
 import GHC.Builtin.Types ( nilDataConName )
 import qualified GHC.LanguageExtensions as LangExt
@@ -353,7 +353,7 @@ rnExpr (ArithSeq x _ seq)
 
 For the static form we check that it is not used in splices.
 We also collect the free variables of the term which come from
-this module. See Note [Grand plan for static forms] in StaticPtrTable.
+this module. See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
 -}
 
 rnExpr e@(HsStatic _ expr) = do
diff --git a/compiler/GHC/Rename/Expr.hs-boot b/compiler/GHC/Rename/Expr.hs-boot
index 012b7731b32140f9b15f022e02df010a2289699c..cc52d45e82bfc50a22edabb554712456d596645e 100644
--- a/compiler/GHC/Rename/Expr.hs-boot
+++ b/compiler/GHC/Rename/Expr.hs-boot
@@ -4,7 +4,7 @@ import GHC.Hs
 import GHC.Types.Name.Set ( FreeVars )
 import GHC.Tc.Types
 import GHC.Types.SrcLoc   ( Located )
-import Outputable  ( Outputable )
+import GHC.Utils.Outputable  ( Outputable )
 
 rnLExpr :: LHsExpr GhcPs
         -> RnM (LHsExpr GhcRn, FreeVars)
diff --git a/compiler/GHC/Rename/Fixity.hs b/compiler/GHC/Rename/Fixity.hs
index b86be351606d64a22bff63b429c22f131787951a..5920a1ee9a41fce348f662b4845ac221c3a004e5 100644
--- a/compiler/GHC/Rename/Fixity.hs
+++ b/compiler/GHC/Rename/Fixity.hs
@@ -16,7 +16,7 @@ module GHC.Rename.Fixity
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Load
 import GHC.Hs
@@ -29,8 +29,8 @@ import GHC.Types.Module
 import GHC.Types.Basic  ( Fixity(..), FixityDirection(..), minPrecedence,
                           defaultFixity, SourceText(..) )
 import GHC.Types.SrcLoc
-import Outputable
-import Maybes
+import GHC.Utils.Outputable
+import GHC.Data.Maybe
 import Data.List
 import Data.Function    ( on )
 import GHC.Rename.Unbound
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 822f6f9cb93a0c479dbc5db8cce78dfa1f5d2c2d..99b928af3f0067c1db78aaf607044740da537671 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -32,7 +32,7 @@ module GHC.Rename.HsType (
         nubL, elemRdr
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Rename.Splice( rnSpliceType )
 
@@ -54,14 +54,14 @@ import GHC.Types.SrcLoc
 import GHC.Types.Name.Set
 import GHC.Types.FieldLabel
 
-import Util
-import ListSetOps       ( deleteBys )
+import GHC.Utils.Misc
+import GHC.Data.List.SetOps ( deleteBys )
 import GHC.Types.Basic  ( compareFixity, funTyFixity, negateFixity
                         , Fixity(..), FixityDirection(..), LexicalFixity(..)
                         , TypeOrKind(..) )
-import Outputable
-import FastString
-import Maybes
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
 
 import Data.List          ( nubBy, partition, (\\) )
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index bc2c7d3d5d24525f779468db4469f317f0b4a83b..88ad0fee9419a53fcb96df7ad978105fa952cf80 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -19,7 +19,7 @@ module GHC.Rename.Module (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr )
 import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls )
@@ -53,19 +53,19 @@ import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env
 import GHC.Types.Avail
-import Outputable
-import Bag
+import GHC.Utils.Outputable
+import GHC.Data.Bag
 import GHC.Types.Basic  ( pprRuleName, TypeOrKind(..) )
-import FastString
+import GHC.Data.FastString
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Session
-import Util             ( debugIsOn, filterOut, lengthExceeds, partitionWith )
+import GHC.Utils.Misc   ( debugIsOn, filterOut, lengthExceeds, partitionWith )
 import GHC.Driver.Types ( HscEnv, hsc_dflags )
-import ListSetOps       ( findDupsEq, removeDups, equivClasses )
-import Digraph          ( SCC, flattenSCC, flattenSCCs, Node(..)
-                        , stronglyConnCompFromEdgedVerticesUniq )
+import GHC.Data.List.SetOps ( findDupsEq, removeDups, equivClasses )
+import GHC.Data.Graph.Directed ( SCC, flattenSCC, flattenSCCs, Node(..)
+                               , stronglyConnCompFromEdgedVerticesUniq )
 import GHC.Types.Unique.Set
-import OrdList
+import GHC.Data.OrdList
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
@@ -1397,7 +1397,7 @@ depAnalTyClDecls rdr_env kisig_fv_env ds_w_fvs
             -- It's OK to use nonDetEltsUFM here as
             -- stronglyConnCompFromEdgedVertices is still deterministic
             -- even if the edges are in nondeterministic order as explained
-            -- in Note [Deterministic SCC] in Digraph.
+            -- in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
 
 toParents :: GlobalRdrEnv -> NameSet -> NameSet
 toParents rdr_env ns
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index ed080878999a31528d58542304d8f6b94f2d484b..c0832b5e35b524d5064945549e5d0175dc9c92f9 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -32,7 +32,7 @@ module GHC.Rename.Names (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core.TyCo.Ppr
@@ -53,13 +53,13 @@ import GHC.Types.FieldLabel
 import GHC.Driver.Types
 import GHC.Types.Name.Reader
 import GHC.Parser.PostProcess ( setRdrNameSpace )
-import Outputable
-import Maybes
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.Maybe
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Basic  ( TopLevelFlag(..), StringLiteral(..) )
-import Util
-import FastString
-import FastStringEnv
+import GHC.Utils.Misc
+import GHC.Data.FastString
+import GHC.Data.FastString.Env
 import GHC.Types.Id
 import GHC.Core.Type
 import GHC.Core.PatSyn
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index 8e6747550ed98422f01e3274e61e5eaf2484bf84..1e2bf09f4516366c9b313c2f699ecb44c502c2fa 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -44,7 +44,7 @@ module GHC.Rename.Pat (-- main entry points
 
 -- ENH: thin imports to only what is necessary for patterns
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
 import {-# SOURCE #-} GHC.Rename.Splice ( rnSplicePat )
@@ -67,9 +67,9 @@ 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 GHC.Utils.Misc
+import GHC.Data.List.SetOps( removeDups )
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Types.Literal   ( inCharRange )
 import GHC.Builtin.Types   ( nilDataCon )
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index c8aa73554f2d9a586063f01faaf37eea9b8ddada..1842cd0c44f772e923f623ec16f4467b53ff3947 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -14,7 +14,7 @@ module GHC.Rename.Splice (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Name
 import GHC.Types.Name.Set
@@ -28,7 +28,7 @@ import GHC.Rename.Unbound ( isUnboundName )
 import GHC.Rename.Module  ( rnSrcDecls, findSplice )
 import GHC.Rename.Pat     ( rnPat )
 import GHC.Types.Basic    ( TopLevelFlag, isTopLevel, SourceText(..) )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Module
 import GHC.Types.SrcLoc
 import GHC.Rename.HsType ( rnLHsType )
@@ -41,8 +41,8 @@ import GHC.Tc.Utils.Env     ( checkWellStaged )
 import GHC.Builtin.Names.TH ( liftName )
 
 import GHC.Driver.Session
-import FastString
-import ErrUtils         ( dumpIfSet_dyn_printer, DumpFormat (..) )
+import GHC.Data.FastString
+import GHC.Utils.Error  ( dumpIfSet_dyn_printer, DumpFormat (..) )
 import GHC.Tc.Utils.Env ( tcMetaTy )
 import GHC.Driver.Hooks
 import GHC.Builtin.Names.TH ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
diff --git a/compiler/GHC/Rename/Splice.hs-boot b/compiler/GHC/Rename/Splice.hs-boot
index a885ea4387dd1f1a5d521176ce2276db6cb8151d..06b8dc6c92551e2e4b9e6300e651117d70bd4c5f 100644
--- a/compiler/GHC/Rename/Splice.hs-boot
+++ b/compiler/GHC/Rename/Splice.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Rename.Splice where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Hs
 import GHC.Tc.Utils.Monad
 import GHC.Types.Name.Set
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index aa4e05941fc124c9718bdb38b4207e37a6b0805f..c0cc6eeb6411cedd3f6d1d0b4057b7e13d9d0b92 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -17,7 +17,7 @@ module GHC.Rename.Unbound
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Name.Reader
 import GHC.Driver.Types
@@ -25,12 +25,12 @@ import GHC.Tc.Utils.Monad
 import GHC.Types.Name
 import GHC.Types.Module
 import GHC.Types.SrcLoc as SrcLoc
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
-import Util
-import Maybes
+import GHC.Utils.Misc
+import GHC.Data.Maybe
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import Data.List
 import Data.Function ( on )
 import GHC.Types.Unique.DFM (udfmToList)
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index 3c4f5d065f52c0073b12971f60c176f87bc82664..19a7c57cfb4ba8692924cdc94540ba6ace649f4d 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -33,7 +33,7 @@ module GHC.Rename.Utils (
 where
 
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Types.Name.Reader
@@ -45,12 +45,12 @@ import GHC.Types.Name.Set
 import GHC.Types.Name.Env
 import GHC.Core.DataCon
 import GHC.Types.SrcLoc as SrcLoc
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Basic  ( TopLevelFlag(..) )
-import ListSetOps       ( removeDups )
+import GHC.Data.List.SetOps ( removeDups )
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import Control.Monad
 import Data.List
 import GHC.Settings.Constants ( mAX_TUPLE_SIZE )
diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs
index 50622d8fa98a2bc0e5ea471e5432b634776b20d8..511293ba5c7b156ff1d1cabccedc830329fcc331 100644
--- a/compiler/GHC/Runtime/Debugger.hs
+++ b/compiler/GHC/Runtime/Debugger.hs
@@ -14,7 +14,7 @@
 
 module GHC.Runtime.Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Runtime.Linker
 import GHC.Runtime.Heap.Inspect
@@ -32,12 +32,12 @@ import GHC.Types.Var.Set
 import GHC.Types.Unique.Set
 import GHC.Core.Type
 import GHC
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.Ppr.TyThing
-import ErrUtils
-import MonadUtils
+import GHC.Utils.Error
+import GHC.Utils.Monad
 import GHC.Driver.Session
-import Exception
+import GHC.Utils.Exception
 
 import Control.Monad
 import Data.List ( (\\) )
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 8e6d5e3ed54326f5049cff769de1de94fdabde64..cf3329fb8bb73652885fbc8683b6f9fa4eab793a 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -46,7 +46,7 @@ module GHC.Runtime.Eval (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Runtime.Eval.Types
 
@@ -82,19 +82,19 @@ import GHC.Driver.Session
 import GHC.LanguageExtensions
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
-import MonadUtils
+import GHC.Utils.Monad
 import GHC.Types.Module
 import GHC.Builtin.Names ( toDynName, pretendNameIsInScope )
 import GHC.Builtin.Types ( isCTupleTyConName )
-import Panic
-import Maybes
-import ErrUtils
+import GHC.Utils.Panic
+import GHC.Data.Maybe
+import GHC.Utils.Error
 import GHC.Types.SrcLoc
 import GHC.Runtime.Heap.Inspect
-import Outputable
-import FastString
-import Bag
-import Util
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Bag
+import GHC.Utils.Misc
 import qualified GHC.Parser.Lexer as Lexer (P (..), ParseResult(..), unP, mkPStatePure)
 import GHC.Parser.Lexer (ParserFlags)
 import qualified GHC.Parser       as Parser (parseStmt, parseModule, parseDeclaration, parseImport)
@@ -106,10 +106,10 @@ import qualified Data.IntMap as IntMap
 import Data.List (find,intercalate)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import StringBuffer (stringToStringBuffer)
+import GHC.Data.StringBuffer (stringToStringBuffer)
 import Control.Monad
 import Data.Array
-import Exception
+import GHC.Utils.Exception
 import Unsafe.Coerce ( unsafeCoerce )
 
 import GHC.Tc.Module ( runTcInteractive, tcRnType, loadUnqualIfaces )
diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs
index 753f776f20497fbe63e9402286206c9b07fd0581..0f2cd80c341e62a7fe011a0d54af38ff03189a32 100644
--- a/compiler/GHC/Runtime/Eval/Types.hs
+++ b/compiler/GHC/Runtime/Eval/Types.hs
@@ -12,7 +12,7 @@ module GHC.Runtime.Eval.Types (
         BreakInfo(..)
         ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHCi.RemoteTypes
 import GHCi.Message (EvalExpr, ResumeContext)
@@ -22,7 +22,7 @@ import GHC.Types.Module
 import GHC.Types.Name.Reader
 import GHC.Core.Type
 import GHC.Types.SrcLoc
-import Exception
+import GHC.Utils.Exception
 
 import Data.Word
 import GHC.Stack.CCS
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 0c856aa7a5549870bf4fdc031714de9b906e045c..748020fa21cd67a6a8cb62b98a275e9a2a3dbe4e 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -25,7 +25,7 @@ module GHC.Runtime.Heap.Inspect(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Runtime.Interpreter as GHCi
@@ -50,14 +50,14 @@ import GHC.Types.Name
 import GHC.Types.Name.Occurrence as OccName
 import GHC.Types.Module
 import GHC.Iface.Env
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Set
 import GHC.Types.Basic ( Boxity(..) )
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Names
 import GHC.Builtin.Types
 import GHC.Driver.Session
-import Outputable as Ppr
+import GHC.Utils.Outputable as Ppr
 import GHC.Char
 import GHC.Exts.Heap
 import GHC.Runtime.Heap.Layout ( roundUpTo )
diff --git a/compiler/GHC/Runtime/Heap/Layout.hs b/compiler/GHC/Runtime/Heap/Layout.hs
index c469f00cb470ff3b4209e409bbe8997bc9d08329..7436cbefd87a6bcbcf859cd55d1994bc22737217 100644
--- a/compiler/GHC/Runtime/Heap/Layout.hs
+++ b/compiler/GHC/Runtime/Heap/Layout.hs
@@ -44,13 +44,13 @@ module GHC.Runtime.Heap.Layout (
         card, cardRoundUp, cardTableSizeB, cardTableSizeW
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic( ConTagZ )
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
-import FastString
+import GHC.Data.FastString
 
 import Data.Word
 import Data.Bits
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 61e5297184a06535db9f56175cf2f6613a5cd238..081c71d3880cbb03b559437c1a83d7f147eeb98b 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -53,26 +53,26 @@ module GHC.Runtime.Interpreter
   , fromEvalResult
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Runtime.Interpreter.Types
 import GHCi.Message
 import GHCi.RemoteTypes
 import GHCi.ResolvedBCO
 import GHCi.BreakArray (BreakArray)
-import Fingerprint
+import GHC.Utils.Fingerprint
 import GHC.Driver.Types
 import GHC.Types.Unique.FM
-import Panic
+import GHC.Utils.Panic
 import GHC.Driver.Session
-import Exception
+import GHC.Utils.Exception
 import GHC.Types.Basic
-import FastString
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Runtime.Eval.Types(BreakInfo(..))
-import Outputable(brackets, ppr, showSDocUnqual)
+import GHC.Utils.Outputable(brackets, ppr, showSDocUnqual)
 import GHC.Types.SrcLoc
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Module
 import GHC.ByteCode.Types
 import GHC.Types.Unique
diff --git a/compiler/GHC/Runtime/Interpreter/Types.hs b/compiler/GHC/Runtime/Interpreter/Types.hs
index 9decf8abb26004e50ddbe5d4aae2b5223d20b1a9..11f405815c27b3969df579ed91c5a8c905dc0335 100644
--- a/compiler/GHC/Runtime/Interpreter/Types.hs
+++ b/compiler/GHC/Runtime/Interpreter/Types.hs
@@ -10,7 +10,7 @@ module GHC.Runtime.Interpreter.Types
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHCi.RemoteTypes
 import GHCi.Message         ( Pipe )
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index c103feb3fce06a5ff0c600326dbadfe3bfa87b76..30be5eca55478b8453b9d548cc38876735baf8e0 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -29,7 +29,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Runtime.Interpreter
 import GHC.Runtime.Interpreter.Types
@@ -47,18 +47,18 @@ import GHC.Driver.Ways
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.Module
-import ListSetOps
+import GHC.Data.List.SetOps
 import GHC.Runtime.Linker.Types (DynLinker(..), LinkerUnitId, PersistentLinkerState(..))
 import GHC.Driver.Session
 import GHC.Types.Basic
-import Outputable
-import Panic
-import Util
-import ErrUtils
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+import GHC.Utils.Misc
+import GHC.Utils.Error
 import GHC.Types.SrcLoc
-import qualified Maybes
+import qualified GHC.Data.Maybe as Maybes
 import GHC.Types.Unique.DSet
-import FastString
+import GHC.Data.FastString
 import GHC.Platform
 import GHC.SysTools
 import GHC.SysTools.FileCleanup
@@ -82,7 +82,7 @@ import System.Environment (lookupEnv)
 import System.Win32.Info (getSystemDirectory)
 #endif
 
-import Exception
+import GHC.Utils.Exception
 
 {- **********************************************************************
 
diff --git a/compiler/GHC/Runtime/Linker/Types.hs b/compiler/GHC/Runtime/Linker/Types.hs
index d8530a1460f8ddfb76ad12a3afc96fde0bf656f4..fce4e80e604a4e14fc3fd6ed132597f637456e72 100644
--- a/compiler/GHC/Runtime/Linker/Types.hs
+++ b/compiler/GHC/Runtime/Linker/Types.hs
@@ -15,13 +15,13 @@ module GHC.Runtime.Linker.Types (
       SptEntry(..)
     ) where
 
-import GhcPrelude              ( FilePath, String, show )
+import GHC.Prelude             ( FilePath, String, show )
 import Data.Time               ( UTCTime )
 import Data.Maybe              ( Maybe )
 import Control.Concurrent.MVar ( MVar )
 import GHC.Types.Module        ( InstalledUnitId, Module )
 import GHC.ByteCode.Types      ( ItblEnv, CompiledByteCode )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Var           ( Id )
 import GHC.Fingerprint.Type    ( Fingerprint )
 import GHC.Types.Name.Env      ( NameEnv )
@@ -95,7 +95,7 @@ data Unlinked
                        -- carries some static pointer table entries which
                        -- should be loaded along with the BCOs.
                        -- See Note [Grant plan for static forms] in
-                       -- StaticPtrTable.
+                       -- GHC.Iface.Tidy.StaticPtrTable.
 
 instance Outputable Unlinked where
   ppr (DotO path)   = text "DotO" <+> text path
@@ -104,7 +104,7 @@ instance Outputable Unlinked where
   ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt
 
 -- | An entry to be inserted into a module's static pointer table.
--- See Note [Grand plan for static forms] in StaticPtrTable.
+-- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
 data SptEntry = SptEntry Id Fingerprint
 
 instance Outputable SptEntry where
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index be8395896c4776b6adc8174a8a1c3ce04de90fbc..81168f7c28e1e6767bad4cb1a922eaa0e467af80 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -20,7 +20,7 @@ module GHC.Runtime.Loader (
         lessUnsafeCoerce
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Driver.Session
 
 import GHC.Runtime.Linker      ( linkModule, getHValue )
@@ -46,11 +46,11 @@ import GHC.Core.TyCon    ( TyCon )
 import GHC.Types.Name    ( Name, nameModule_maybe )
 import GHC.Types.Id      ( idType )
 import GHC.Types.Module  ( Module, ModuleName )
-import Panic
-import FastString
-import ErrUtils
-import Outputable
-import Exception
+import GHC.Utils.Panic
+import GHC.Data.FastString
+import GHC.Utils.Error
+import GHC.Utils.Outputable
+import GHC.Utils.Exception
 import GHC.Driver.Hooks
 
 import Control.Monad     ( unless )
diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs
index e0466a1cf22c34090f95dce6976652dad458f679..08b108a291f6f14443f1b30de3f0dca19decf5a4 100644
--- a/compiler/GHC/Settings.hs
+++ b/compiler/GHC/Settings.hs
@@ -69,10 +69,10 @@ module GHC.Settings
   , sGhcRtsWithLibdw
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import CliOption
-import Fingerprint
+import GHC.Utils.CliOption
+import GHC.Utils.Fingerprint
 import GHC.Platform
 
 data Settings = Settings
diff --git a/compiler/GHC/Settings/Constants.hs b/compiler/GHC/Settings/Constants.hs
index 92a917e4303c503603323f5caaba1c64896564f5..a852a5845d0754ce2285bef4a431f9c601c4f528 100644
--- a/compiler/GHC/Settings/Constants.hs
+++ b/compiler/GHC/Settings/Constants.hs
@@ -1,7 +1,7 @@
 -- | Compile-time settings
 module GHC.Settings.Constants where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Config
 
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
index bc15564543bab4fd5479ddbfdab66e6d164516df..225d5a6ec8b0c197098fdf22c60f88f615f1d6cb 100644
--- a/compiler/GHC/Settings/IO.hs
+++ b/compiler/GHC/Settings/IO.hs
@@ -9,16 +9,16 @@ module GHC.Settings.IO
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Settings.Platform
 import GHC.Settings.Utils
 
 import Config
-import CliOption
-import Fingerprint
+import GHC.Utils.CliOption
+import GHC.Utils.Fingerprint
 import GHC.Platform
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Settings
 import GHC.SysTools.BaseDir
 
diff --git a/compiler/GHC/Stg/CSE.hs b/compiler/GHC/Stg/CSE.hs
index 4fbcf47a02e041d4e1c6820ca2c7090ae0862f36..404b7faffdc4210175b25745454d76ee92f43bbc 100644
--- a/compiler/GHC/Stg/CSE.hs
+++ b/compiler/GHC/Stg/CSE.hs
@@ -86,12 +86,12 @@ Solution: do unarise first.
 
 module GHC.Stg.CSE (stgCse) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.DataCon
 import GHC.Types.Id
 import GHC.Stg.Syntax
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Basic (isWeakLoopBreaker)
 import GHC.Types.Var.Env
 import GHC.Core (AltCon(..))
@@ -106,7 +106,7 @@ import Control.Monad( (>=>) )
 --------------
 
 -- A lookup trie for data constructor applications, i.e.
--- keys of type `(DataCon, [StgArg])`, following the patterns in TrieMap.
+-- keys of type `(DataCon, [StgArg])`, following the patterns in GHC.Data.TrieMap.
 
 data StgArgMap a = SAM
     { sam_var :: DVarEnv a
diff --git a/compiler/GHC/Stg/DepAnal.hs b/compiler/GHC/Stg/DepAnal.hs
index 90eec24f74f5b959fb40daa37dcc70970c3fe233..3f35acbb169af108cd8a06d8fa73e7ed041042a9 100644
--- a/compiler/GHC/Stg/DepAnal.hs
+++ b/compiler/GHC/Stg/DepAnal.hs
@@ -2,13 +2,13 @@
 
 module GHC.Stg.DepAnal (depSortStgPgm) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 import GHC.Types.Id
 import GHC.Types.Name (Name, nameIsLocalOrFrom)
 import GHC.Types.Name.Env
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique.Set (nonDetEltsUniqSet)
 import GHC.Types.Var.Set
 import GHC.Types.Module (Module)
diff --git a/compiler/GHC/Stg/FVs.hs b/compiler/GHC/Stg/FVs.hs
index e323775c5f48c2d0954d53f001be2ff91827d2de..7fd7a3cae65cb3d7ac51c72b7c28caec74d2a98a 100644
--- a/compiler/GHC/Stg/FVs.hs
+++ b/compiler/GHC/Stg/FVs.hs
@@ -42,14 +42,14 @@ module GHC.Stg.FVs (
     annBindingFreeVars
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 import GHC.Types.Id
 import GHC.Types.Var.Set
 import GHC.Core    ( Tickish(Breakpoint) )
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Data.Maybe ( mapMaybe )
 
diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs
index f90ef519feaf918b5aef7aced847532b9d2548bc..80445843211972c4669438d5567323ec35a82a49 100644
--- a/compiler/GHC/Stg/Lift.hs
+++ b/compiler/GHC/Stg/Lift.hs
@@ -17,7 +17,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
 import GHC.Driver.Session
@@ -26,9 +26,9 @@ import GHC.Stg.FVs ( annBindingFreeVars )
 import GHC.Stg.Lift.Analysis
 import GHC.Stg.Lift.Monad
 import GHC.Stg.Syntax
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique.Supply
-import Util
+import GHC.Utils.Misc
 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 13778237eaa587f0a0baecd8112b1b1f145d6b4f..f6a955adb37bd0e642dc02edbee0b2e1f63eaa6d 100644
--- a/compiler/GHC/Stg/Lift/Analysis.hs
+++ b/compiler/GHC/Stg/Lift/Analysis.hs
@@ -20,7 +20,7 @@ module GHC.Stg.Lift.Analysis (
     closureGrowth -- Exported just for the docs
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Types.Basic
@@ -32,8 +32,8 @@ import GHC.Stg.Syntax
 import qualified GHC.StgToCmm.ArgRep  as StgToCmm.ArgRep
 import qualified GHC.StgToCmm.Closure as StgToCmm.Closure
 import qualified GHC.StgToCmm.Layout  as StgToCmm.Layout
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 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 28ec3e1e693a53423949338dcd694d1e0a89f773..b693730eca2275f82a2aeead4951089173708c13 100644
--- a/compiler/GHC/Stg/Lift/Monad.hs
+++ b/compiler/GHC/Stg/Lift/Monad.hs
@@ -22,21 +22,21 @@ module GHC.Stg.Lift.Monad (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
 import GHC.Types.CostCentre ( isCurrentCCS, dontCareCCS )
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Id
 import GHC.Types.Name
-import Outputable
-import OrdList
+import GHC.Utils.Outputable
+import GHC.Data.OrdList
 import GHC.Stg.Subst
 import GHC.Stg.Syntax
 import GHC.Core.Type
 import GHC.Types.Unique.Supply
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 
diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs
index bf4cfce443717b9fa819570b851595d64b13da31..69c961a081e1a8118424f92dec5b22fe529bb5b0 100644
--- a/compiler/GHC/Stg/Lint.hs
+++ b/compiler/GHC/Stg/Lint.hs
@@ -37,12 +37,12 @@ basic properties listed above.
 
 module GHC.Stg.Lint ( lintStgTopBindings ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 
 import GHC.Driver.Session
-import Bag                  ( Bag, emptyBag, isEmptyBag, snocBag, bagToList )
+import GHC.Data.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 )
@@ -50,13 +50,13 @@ import GHC.Types.Var.Set
 import GHC.Core.DataCon
 import GHC.Core             ( AltCon(..) )
 import GHC.Types.Name       ( getSrcLoc, nameIsLocalOrFrom )
-import ErrUtils             ( MsgDoc, Severity(..), mkLocMessage )
+import GHC.Utils.Error      ( MsgDoc, Severity(..), mkLocMessage )
 import GHC.Core.Type
 import GHC.Types.RepType
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Module           ( Module )
-import qualified ErrUtils as Err
+import qualified GHC.Utils.Error as Err
 import Control.Applicative ((<|>))
 import Control.Monad
 
diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs
index 4b463cb95e8ffc486a3ae09adaead652c181c655..59b592fbc1c83d754b3e48c6abfb55a49eb3e8f0 100644
--- a/compiler/GHC/Stg/Pipeline.hs
+++ b/compiler/GHC/Stg/Pipeline.hs
@@ -13,7 +13,7 @@ module GHC.Stg.Pipeline ( stg2stg ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 
@@ -26,9 +26,9 @@ import GHC.Stg.Lift     ( stgLiftLams )
 import GHC.Types.Module ( Module )
 
 import GHC.Driver.Session
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Unique.Supply
-import Outputable
+import GHC.Utils.Outputable
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.State.Strict
diff --git a/compiler/GHC/Stg/Stats.hs b/compiler/GHC/Stg/Stats.hs
index c2d546d587e225091762bc1761af9f947a9ae8f3..329f319a470dbef68f5f4e4ee53efb74056d0a39 100644
--- a/compiler/GHC/Stg/Stats.hs
+++ b/compiler/GHC/Stg/Stats.hs
@@ -27,12 +27,12 @@ module GHC.Stg.Stats ( showStgStats ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 
 import GHC.Types.Id (Id)
-import Panic
+import GHC.Utils.Panic
 
 import Data.Map (Map)
 import qualified Data.Map as Map
diff --git a/compiler/GHC/Stg/Subst.hs b/compiler/GHC/Stg/Subst.hs
index abbbfb0fd7c74bc472fd799e4286129b35cd008a..ba3550b3309fcbd97e0ff5c9c8cc548776300fc7 100644
--- a/compiler/GHC/Stg/Subst.hs
+++ b/compiler/GHC/Stg/Subst.hs
@@ -4,13 +4,13 @@ module GHC.Stg.Subst where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Id
 import GHC.Types.Var.Env
 import Control.Monad.Trans.State.Strict
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 -- | A renaming substitution from 'Id's to 'Id's. Like 'RnEnv2', but not
 -- maintaining pairs of substitutions. Like 'GHC.Core.Subst.Subst', but
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index aefb49d9882f51a1d4cfc597df6de90c9f514e13..71f1b5fbc15fd0efaf0504d9fb9df680c4432581 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -61,7 +61,7 @@ module GHC.Stg.Syntax (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core     ( AltCon, Tickish )
 import GHC.Types.CostCentre ( CostCentreStack )
@@ -75,7 +75,7 @@ import GHC.Types.Id
 import GHC.Types.Var.Set
 import GHC.Types.Literal     ( Literal, literalType )
 import GHC.Types.Module      ( Module )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Packages ( isDynLinkName )
 import GHC.Platform
 import GHC.Core.Ppr( {- instances -} )
@@ -83,7 +83,7 @@ import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
 import GHC.Core.TyCon    ( PrimRep(..), TyCon )
 import GHC.Core.Type     ( Type )
 import GHC.Types.RepType ( typePrimRep1 )
-import Util
+import GHC.Utils.Misc
 
 import Data.List.NonEmpty ( NonEmpty, toList )
 
diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index de74b0b0ab12f67c4ee5e87944487affa60fa453..e0b96d02493b175ca9ba0348ef0d3258cd5e230f 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -200,25 +200,25 @@ module GHC.Stg.Unarise (unarise) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
 import GHC.Core
 import GHC.Core.DataCon
-import FastString (FastString, mkFastString)
+import GHC.Data.FastString (FastString, mkFastString)
 import GHC.Types.Id
 import GHC.Types.Literal
 import GHC.Core.Make (aBSENT_SUM_FIELD_ERROR_ID)
 import GHC.Types.Id.Make (voidPrimId, voidArgId)
-import MonadUtils (mapAccumLM)
-import Outputable
+import GHC.Utils.Monad (mapAccumLM)
+import GHC.Utils.Outputable
 import GHC.Types.RepType
 import GHC.Stg.Syntax
 import GHC.Core.Type
 import GHC.Builtin.Types.Prim (intPrimTy,wordPrimTy,word64PrimTy)
 import GHC.Builtin.Types
 import GHC.Types.Unique.Supply
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Env
 
 import Data.Bifunctor (second)
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 231144965ed5f082927a1ec3da30c3b82aa0a0bc..4a2c379b365dbc4138fd827b4b7fb27e32d47640 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -13,7 +13,7 @@ module GHC.StgToCmm ( codeGen ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude as Prelude
+import GHC.Prelude as Prelude
 
 import GHC.StgToCmm.Prof (initCostCentres, ldvEnter)
 import GHC.StgToCmm.Monad
@@ -32,7 +32,7 @@ import GHC.Cmm.CLabel
 
 import GHC.Stg.Syntax
 import GHC.Driver.Session
-import ErrUtils
+import GHC.Utils.Error
 
 import GHC.Driver.Types
 import GHC.Types.CostCentre
@@ -42,18 +42,18 @@ import GHC.Types.RepType
 import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Types.Module
-import Outputable
-import Stream
+import GHC.Utils.Outputable
+import GHC.Data.Stream
 import GHC.Types.Basic
 import GHC.Types.Var.Set ( isEmptyDVarSet )
 import GHC.SysTools.FileCleanup
 
-import OrdList
+import GHC.Data.OrdList
 import GHC.Cmm.Graph
 
 import Data.IORef
 import Control.Monad (when,void)
-import Util
+import GHC.Utils.Misc
 import System.IO.Unsafe
 import qualified Data.ByteString as BS
 
diff --git a/compiler/GHC/StgToCmm/ArgRep.hs b/compiler/GHC/StgToCmm/ArgRep.hs
index a3df5a881fe9e4271a895f11236618caf68eb96f..4d85d23d173748e1a2aac892376da4ed0a019755 100644
--- a/compiler/GHC/StgToCmm/ArgRep.hs
+++ b/compiler/GHC/StgToCmm/ArgRep.hs
@@ -17,7 +17,7 @@ module GHC.StgToCmm.ArgRep (
 
         ) where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.StgToCmm.Closure    ( idPrimRep )
@@ -27,8 +27,8 @@ import GHC.Core.TyCon          ( PrimRep(..), primElemRepSizeB )
 import GHC.Types.Basic         ( RepArity )
 import GHC.Settings.Constants  ( wORD64_SIZE, dOUBLE_SIZE )
 
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 
 -- I extricated this code as this new module in order to avoid a
 -- cyclic dependency between GHC.StgToCmm.Layout and GHC.StgToCmm.Ticky.
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 8db97d8083bb1c3cec963fd93f1542c416f44033..851da5ed2182f67384896d79e0529cfa317840e4 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -13,7 +13,7 @@ module GHC.StgToCmm.Bind (
         pushUpdateFrame, emitUpdateFrame
   ) where
 
-import GhcPrelude hiding ((<*>))
+import GHC.Prelude hiding ((<*>))
 import GHC.Platform
 
 import GHC.StgToCmm.Expr
@@ -43,12 +43,12 @@ import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Name
 import GHC.Types.Module
-import ListSetOps
-import Util
+import GHC.Data.List.SetOps
+import GHC.Utils.Misc
 import GHC.Types.Var.Set
 import GHC.Types.Basic
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Driver.Session
 
 import Control.Monad
diff --git a/compiler/GHC/StgToCmm/CgUtils.hs b/compiler/GHC/StgToCmm/CgUtils.hs
index 7775cdf033ae7258196660002948c84fe87e7bf4..1ed7f2384fa3e44de870de94174b3632fe5ded98 100644
--- a/compiler/GHC/StgToCmm/CgUtils.hs
+++ b/compiler/GHC/StgToCmm/CgUtils.hs
@@ -16,7 +16,7 @@ module GHC.StgToCmm.CgUtils (
         get_GlobalReg_addr,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform.Regs
 import GHC.Cmm
@@ -25,7 +25,7 @@ import GHC.Cmm.Dataflow.Graph
 import GHC.Cmm.Utils
 import GHC.Cmm.CLabel
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 
 -- -----------------------------------------------------------------------------
 -- Information about global registers
diff --git a/compiler/GHC/StgToCmm/Closure.hs b/compiler/GHC/StgToCmm/Closure.hs
index b7e7c48fa0cc07ed10b4bda3af5f84719753763d..431a46ef48678b654dbf649716b602bf79c40a15 100644
--- a/compiler/GHC/StgToCmm/Closure.hs
+++ b/compiler/GHC/StgToCmm/Closure.hs
@@ -64,7 +64,7 @@ module GHC.StgToCmm.Closure (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 import GHC.Runtime.Heap.Layout
@@ -84,9 +84,9 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
 import GHC.Types.RepType
 import GHC.Types.Basic
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Session
-import Util
+import GHC.Utils.Misc
 
 import Data.Coerce (coerce)
 import qualified Data.ByteString.Char8 as BS8
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index a0645305faaab45dbf1834f5ce8da66f67dd7fbb..6d2ca6094449477e5a2ebeff34b538136a1ff37c 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -17,7 +17,7 @@ module GHC.StgToCmm.DataCon (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Stg.Syntax
 import GHC.Core  ( AltCon(..) )
@@ -38,17 +38,17 @@ import GHC.Types.CostCentre
 import GHC.Types.Module
 import GHC.Core.DataCon
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Id
 import GHC.Types.Id.Info( CafInfo( NoCafRefs ) )
 import GHC.Types.Name (isInternalName)
 import GHC.Types.RepType (countConRepArgs)
 import GHC.Types.Literal
 import GHC.Builtin.Utils
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
-import Util
-import MonadUtils (mapMaybeM)
+import GHC.Utils.Misc
+import GHC.Utils.Monad (mapMaybeM)
 
 import Control.Monad
 import Data.Char
diff --git a/compiler/GHC/StgToCmm/Env.hs b/compiler/GHC/StgToCmm/Env.hs
index da2158c7e968b0c362190aca33de4b044eb11c0e..03c53db9799360a75d8fcfe9238a59c04bb3dba4 100644
--- a/compiler/GHC/StgToCmm/Env.hs
+++ b/compiler/GHC/StgToCmm/Env.hs
@@ -24,7 +24,7 @@ module GHC.StgToCmm.Env (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.TyCon
 import GHC.Platform
@@ -41,12 +41,12 @@ import GHC.Driver.Session
 import GHC.Types.Id
 import GHC.Cmm.Graph
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Stg.Syntax
 import GHC.Core.Type
 import GHC.Builtin.Types.Prim
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Env
 
 -------------------------------------
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 94cd97ca239612bbd5027328cc6b52c045567369..b05da01d1b1227e91450f62fbc43d3a57ad391e5 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -14,7 +14,7 @@ module GHC.StgToCmm.Expr ( cgExpr ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude hiding ((<*>))
+import GHC.Prelude hiding ((<*>))
 
 import {-# SOURCE #-} GHC.StgToCmm.Bind ( cgBind )
 
@@ -46,10 +46,10 @@ import GHC.Core.TyCon
 import GHC.Core.Type        ( isUnliftedType )
 import GHC.Types.RepType    ( isVoidTy, countConRepArgs )
 import GHC.Types.CostCentre ( CostCentreStack, currentCCS )
-import Maybes
-import Util
-import FastString
-import Outputable
+import GHC.Data.Maybe
+import GHC.Utils.Misc
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 
 import Control.Monad ( unless, void )
 import Control.Arrow ( first )
diff --git a/compiler/GHC/StgToCmm/ExtCode.hs b/compiler/GHC/StgToCmm/ExtCode.hs
index 84195a67d29006371b4e5acd64864b35519e9643..e26d971c7feefabdec3aad737886659782379c8f 100644
--- a/compiler/GHC/StgToCmm/ExtCode.hs
+++ b/compiler/GHC/StgToCmm/ExtCode.hs
@@ -37,7 +37,7 @@ module GHC.StgToCmm.ExtCode (
 
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified GHC.StgToCmm.Monad as F
 import GHC.StgToCmm.Monad (FCode, newUnique)
@@ -48,7 +48,7 @@ import GHC.Cmm.Graph
 
 import GHC.Cmm.BlockId
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Module
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
diff --git a/compiler/GHC/StgToCmm/Foreign.hs b/compiler/GHC/StgToCmm/Foreign.hs
index 51fee717c401650def53193826f6fb88986fa221..72dae672bac0ef7962785cb47a7bda61be30cb16 100644
--- a/compiler/GHC/StgToCmm/Foreign.hs
+++ b/compiler/GHC/StgToCmm/Foreign.hs
@@ -18,7 +18,7 @@ module GHC.StgToCmm.Foreign (
   emitCloseNursery,
  ) where
 
-import GhcPrelude hiding( succ, (<*>) )
+import GHC.Prelude hiding( succ, (<*>) )
 
 import GHC.Stg.Syntax
 import GHC.StgToCmm.Prof (storeCurCCS, ccsType)
@@ -39,14 +39,14 @@ import GHC.Runtime.Heap.Layout
 import GHC.Types.ForeignCall
 import GHC.Driver.Session
 import GHC.Platform
-import Maybes
-import Outputable
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
 import GHC.Types.Unique.Supply
 import GHC.Types.Basic
 
 import GHC.Core.TyCo.Rep
 import GHC.Builtin.Types.Prim
-import Util (zipEqual)
+import GHC.Utils.Misc (zipEqual)
 
 import Control.Monad
 
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 9a66d77c7f3f51ffb21e8461d319fc6d681cfb55..65c2e7beff7751375945fe4cf0ef0515ec507879 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -22,7 +22,7 @@ module GHC.StgToCmm.Heap (
         emitSetDynHdr
     ) where
 
-import GhcPrelude hiding ((<*>))
+import GHC.Prelude hiding ((<*>))
 
 import GHC.Stg.Syntax
 import GHC.Cmm.CLabel
@@ -47,8 +47,8 @@ import GHC.Types.Id ( Id )
 import GHC.Types.Module
 import GHC.Driver.Session
 import GHC.Platform
-import FastString( mkFastString, fsLit )
-import Panic( sorry )
+import GHC.Data.FastString( mkFastString, fsLit )
+import GHC.Utils.Panic( sorry )
 
 import Control.Monad (when)
 import Data.Maybe (isJust)
diff --git a/compiler/GHC/StgToCmm/Hpc.hs b/compiler/GHC/StgToCmm/Hpc.hs
index 4feb81217b40b82e588f65fc8bc2eb207d32c189..e418d03fde6ecbca0884241d8f5c4f0b13fa782c 100644
--- a/compiler/GHC/StgToCmm/Hpc.hs
+++ b/compiler/GHC/StgToCmm/Hpc.hs
@@ -8,7 +8,7 @@
 
 module GHC.StgToCmm.Hpc ( initHpc, mkTickBox ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.StgToCmm.Monad
 
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 14ec8445c57fdd17ad1469595fdb7269a6b3e299..a02d66906f501b1f30df6ef83a31cf450bb5b438 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -32,7 +32,7 @@ module GHC.StgToCmm.Layout (
 
 #include "HsVersions.h"
 
-import GhcPrelude hiding ((<*>))
+import GHC.Prelude hiding ((<*>))
 
 import GHC.StgToCmm.Closure
 import GHC.StgToCmm.Env
@@ -56,10 +56,10 @@ import GHC.Driver.Session
 import GHC.Platform
 import GHC.Types.Module
 
-import Util
+import GHC.Utils.Misc
 import Data.List
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import Control.Monad
 
 ------------------------------------------------------------------------
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index a23d942c60f7124f4ad0e3e6dc59a143877d7aba..5516c2e7bc81143e4318c35ae9159896fb4601e1 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -59,7 +59,7 @@ module GHC.StgToCmm.Monad (
         CgInfoDownwards(..), CgState(..)        -- non-abstract
     ) where
 
-import GhcPrelude hiding( sequence, succ )
+import GHC.Prelude hiding( sequence, succ )
 
 import GHC.Platform
 import GHC.Cmm
@@ -73,13 +73,13 @@ import GHC.Runtime.Heap.Layout
 import GHC.Types.Module
 import GHC.Types.Id
 import GHC.Types.Var.Env
-import OrdList
+import GHC.Data.OrdList
 import GHC.Types.Basic( ConTagZ )
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
-import FastString
-import Outputable
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Control.Monad
 import Data.List
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index b315c6a196ac23f85e267ef23228a572d9b81339..18acc11304c0811ad574f2fecc97afbb3d1bef7e 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -24,7 +24,7 @@ module GHC.StgToCmm.Prim (
 
 #include "HsVersions.h"
 
-import GhcPrelude hiding ((<*>))
+import GHC.Prelude hiding ((<*>))
 
 import GHC.StgToCmm.Layout
 import GHC.StgToCmm.Foreign
@@ -49,9 +49,9 @@ import GHC.Cmm.CLabel
 import GHC.Cmm.Utils
 import GHC.Builtin.PrimOps
 import GHC.Runtime.Heap.Layout
-import FastString
-import Outputable
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import Data.Maybe
 
 import Data.Bits ((.&.), bit)
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index 578dbc13180dc8f92f96e4cbb936709f59f37a2c..ae123fd9c78fc790a9b5ff28e50170f4f081465b 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -23,7 +23,7 @@ module GHC.StgToCmm.Prof (
         ldvEnter, ldvEnterClosure, ldvRecordCreate
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.StgToCmm.Closure
@@ -38,9 +38,9 @@ import GHC.Cmm.CLabel
 
 import GHC.Types.CostCentre
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Module as Module
-import Outputable
+import GHC.Utils.Outputable
 
 import Control.Monad
 import Data.Char (ord)
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 179dc2d2d85a1c0c6dccd15687bd2b917ba0f3bf..8eff2f608c83d872040eb5845e36c11a6f885c87 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -105,7 +105,7 @@ module GHC.StgToCmm.Ticky (
   tickySlowCall, tickySlowCallPat,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.StgToCmm.ArgRep    ( slowCallPattern , toArgRep , argRepString )
@@ -124,9 +124,9 @@ import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Id
 import GHC.Types.Basic
-import FastString
-import Outputable
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import GHC.Driver.Session
 
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index de59cf3be9dd9f745c52a90a7964b24ce8005f9f..d60de74267920c67ebd50952abdf50cf82a1f5d2 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -48,7 +48,7 @@ module GHC.StgToCmm.Utils (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
 import GHC.StgToCmm.Monad
@@ -69,13 +69,13 @@ import GHC.Core.TyCon
 import GHC.Runtime.Heap.Layout
 import GHC.Types.Module
 import GHC.Types.Literal
-import Digraph
-import Util
+import GHC.Data.Graph.Directed
+import GHC.Utils.Misc
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply (MonadUnique(..))
 import GHC.Driver.Session
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.RepType
 import GHC.Types.CostCentre
 
diff --git a/compiler/GHC/SysTools.hs b/compiler/GHC/SysTools.hs
index f3f1b4b1ca96fa383a6df5987094355e19139337..0ec9912c8dfac7b7bca902bcab007ccdeb5613f9 100644
--- a/compiler/GHC/SysTools.hs
+++ b/compiler/GHC/SysTools.hs
@@ -38,14 +38,14 @@ module GHC.SysTools (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Settings.Utils
 
 import GHC.Types.Module
 import GHC.Driver.Packages
-import Outputable
-import ErrUtils
+import GHC.Utils.Outputable
+import GHC.Utils.Error
 import GHC.Platform
 import GHC.Driver.Session
 import GHC.Driver.Ways
diff --git a/compiler/GHC/SysTools/Ar.hs b/compiler/GHC/SysTools/Ar.hs
index 200b65204984f7b779e5bde3479aa919c5f654ef..198ad6596f27afee78a8fe7242d1c93aca99f254 100644
--- a/compiler/GHC/SysTools/Ar.hs
+++ b/compiler/GHC/SysTools/Ar.hs
@@ -32,7 +32,7 @@ module GHC.SysTools.Ar
   )
    where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Data.List (mapAccumL, isPrefixOf)
 import Data.Monoid ((<>))
diff --git a/compiler/GHC/SysTools/BaseDir.hs b/compiler/GHC/SysTools/BaseDir.hs
index fe749b5cdc21f2d4100c93b8e6fcac024c31f6de..e5b0c7ca617563f172bc6bcfcfbd1e053f2cb1ea 100644
--- a/compiler/GHC/SysTools/BaseDir.hs
+++ b/compiler/GHC/SysTools/BaseDir.hs
@@ -19,12 +19,12 @@ module GHC.SysTools.BaseDir
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 -- See note [Base Dir] for why some of this logic is shared with ghc-pkg.
 import GHC.BaseDir
 
-import Panic
+import GHC.Utils.Panic
 
 import System.Environment (lookupEnv)
 import System.FilePath
diff --git a/compiler/GHC/SysTools/Elf.hs b/compiler/GHC/SysTools/Elf.hs
index 5d4d87af45145e5fa77757ecbc3541f568632c8b..ca563dfb5257a967e42d3ca9948aabea8ba0f5dd 100644
--- a/compiler/GHC/SysTools/Elf.hs
+++ b/compiler/GHC/SysTools/Elf.hs
@@ -14,16 +14,16 @@ module GHC.SysTools.Elf (
     makeElfNote
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import AsmUtils
-import Exception
+import GHC.Utils.Asm
+import GHC.Utils.Exception
 import GHC.Driver.Session
 import GHC.Platform
-import ErrUtils
-import Maybes     (MaybeT(..),runMaybeT)
-import Util       (charToC)
-import Outputable (text,hcat,SDoc)
+import GHC.Utils.Error
+import GHC.Data.Maybe       (MaybeT(..),runMaybeT)
+import GHC.Utils.Misc       (charToC)
+import GHC.Utils.Outputable (text,hcat,SDoc)
 
 import Control.Monad (when)
 import Data.Binary.Get
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index f20f8151077f47c16097423a95e716573b669dd1..0a0486018566903ba09852fe1b227b7084eca2b6 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -13,17 +13,17 @@ module GHC.SysTools.ExtraObj (
   haveRtsOptsFlags
 ) where
 
-import AsmUtils
-import ErrUtils
+import GHC.Utils.Asm
+import GHC.Utils.Error
 import GHC.Driver.Session
 import GHC.Driver.Packages
 import GHC.Platform
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.SrcLoc ( noSrcSpan )
 import GHC.Types.Module
 import GHC.SysTools.Elf
-import Util
-import GhcPrelude
+import GHC.Utils.Misc
+import GHC.Prelude
 
 import Control.Monad
 import Data.Maybe
diff --git a/compiler/GHC/SysTools/FileCleanup.hs b/compiler/GHC/SysTools/FileCleanup.hs
index ef41185cdd7d04acbd26044558e8cf935b3845ee..f72480d65f81607e9f5c65411a0b8306189419a4 100644
--- a/compiler/GHC/SysTools/FileCleanup.hs
+++ b/compiler/GHC/SysTools/FileCleanup.hs
@@ -7,13 +7,13 @@ module GHC.SysTools.FileCleanup
   , withSystemTempDirectory, withTempDirectory
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
-import ErrUtils
-import Outputable
-import Util
-import Exception
+import GHC.Utils.Error
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Exception as Exception
 import GHC.Driver.Phases
 
 import Control.Monad
diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
index 805157075534dd58c570505c0171aaacd7ba77be..039c1d12aaa17dd7b76dc08eaf480ebe3268aaad 100644
--- a/compiler/GHC/SysTools/Info.hs
+++ b/compiler/GHC/SysTools/Info.hs
@@ -8,11 +8,11 @@
 -----------------------------------------------------------------------------
 module GHC.SysTools.Info where
 
-import Exception
-import ErrUtils
+import GHC.Utils.Exception
+import GHC.Utils.Error
 import GHC.Driver.Session
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Data.List
 import Data.IORef
@@ -20,7 +20,7 @@ import Data.IORef
 import System.IO
 
 import GHC.Platform
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.SysTools.Process
 
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index 82f7a6d2f064d542fd7a4083e22d87474ce42ccf..83547ab06cbd29f202bd286a0c2a2842d8279899 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -10,14 +10,14 @@ module GHC.SysTools.Process where
 
 #include "HsVersions.h"
 
-import Exception
-import ErrUtils
+import GHC.Utils.Exception
+import GHC.Utils.Error
 import GHC.Driver.Session
-import FastString
-import Outputable
-import Panic
-import GhcPrelude
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+import GHC.Prelude
+import GHC.Utils.Misc
 import GHC.Types.SrcLoc ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
 
 import Control.Concurrent
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index 9d7b736feeb63fabbb21c3258a6cb60fd51b943c..ee2f66457116c677a741c2babe9304bf16416ffb 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -8,19 +8,19 @@
 -----------------------------------------------------------------------------
 module GHC.SysTools.Tasks where
 
-import Exception
-import ErrUtils
+import GHC.Utils.Exception as Exception
+import GHC.Utils.Error
 import GHC.Driver.Types
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform
-import Util
+import GHC.Utils.Misc
 
 import Data.List
 
 import System.IO
 import System.Process
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, parseLlvmVersion)
 
diff --git a/compiler/GHC/SysTools/Terminal.hs b/compiler/GHC/SysTools/Terminal.hs
index 69c605bc7349a4ccb6ce63fc190a2b5d1f26432e..c7951e0b4370d9d0cdb18e88ef315d55253eaa45 100644
--- a/compiler/GHC/SysTools/Terminal.hs
+++ b/compiler/GHC/SysTools/Terminal.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module GHC.SysTools.Terminal (stderrSupportsAnsiColors) where
 
-import GhcPrelude
+import GHC.Prelude
 
 #if defined(MIN_VERSION_terminfo)
 import Control.Exception (catch)
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 6f5d72a51a6a4cbaa29d5a21cd670d4d7d227aaf..eca079ed23b6aebe7426a9a4f4a3c7aef796eeb4 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -15,7 +15,7 @@ module GHC.Tc.Deriv ( tcDeriving, DerivInfo(..) ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Driver.Session
@@ -47,9 +47,9 @@ import GHC.Types.Avail
 import GHC.Core.Unify( tcUnifyTy )
 import GHC.Core.Class
 import GHC.Core.Type
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Core.DataCon
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Name.Reader
 import GHC.Types.Name
 import GHC.Types.Name.Set as NameSet
@@ -60,11 +60,11 @@ import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Builtin.Names
 import GHC.Types.SrcLoc
-import Util
-import Outputable
-import FastString
-import Bag
-import FV (fvVarList, unionFV, mkFVs)
+import GHC.Utils.Misc
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.FastString
+import GHC.Data.Bag
+import GHC.Utils.FV as FV (fvVarList, unionFV, mkFVs)
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
diff --git a/compiler/GHC/Tc/Deriv/Functor.hs b/compiler/GHC/Tc/Deriv/Functor.hs
index 41aa86080de743d64a3530c35797996420181de4..6a13cfaccd3fa5d1fcf22a730d641285132e5dec 100644
--- a/compiler/GHC/Tc/Deriv/Functor.hs
+++ b/compiler/GHC/Tc/Deriv/Functor.hs
@@ -24,23 +24,23 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Bag
+import GHC.Data.Bag
 import GHC.Core.DataCon
-import FastString
+import GHC.Data.FastString
 import GHC.Hs
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Names
 import GHC.Types.Name.Reader
 import GHC.Types.SrcLoc
-import State
+import GHC.Utils.Monad.State
 import GHC.Tc.Deriv.Generate
 import GHC.Tc.Utils.TcType
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Id.Make (coerceId)
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index ad103ca7c8208c60c945568e19eed8d875dd7c3f..8177416c4b2fb0f07d59eafdd94cc24807ac08d0 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -38,7 +38,7 @@ module GHC.Tc.Deriv.Generate (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Monad
 import GHC.Hs
@@ -46,8 +46,8 @@ import GHC.Types.Name.Reader
 import GHC.Types.Basic
 import GHC.Core.DataCon
 import GHC.Types.Name
-import Fingerprint
-import Encoding
+import GHC.Utils.Fingerprint
+import GHC.Utils.Encoding
 
 import GHC.Driver.Session
 import GHC.Builtin.Utils
@@ -69,13 +69,13 @@ import GHC.Core.Type
 import GHC.Core.Class
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Utils.Lexeme
-import FastString
-import Pair
-import Bag
+import GHC.Data.FastString
+import GHC.Data.Pair
+import GHC.Data.Bag
 
 import Data.List  ( find, partition, intersperse )
 
@@ -2400,7 +2400,7 @@ mkAuxBinderName dflags parent occ_fun
     parent_stable_hash =
       let Fingerprint high low = fingerprintString parent_stable
       in toBase62 high ++ toBase62Padded low
-      -- See Note [Base 62 encoding 128-bit integers] in Encoding
+      -- See Note [Base 62 encoding 128-bit integers] in GHC.Utils.Encoding
     parent_occ  = nameOccName parent
 
 
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index d4af39d83c349c1d15051f309fb2c469a292a486..31dc85d7e9ee39965ad9c119e63d21e7fcb14355 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -19,7 +19,7 @@ module GHC.Tc.Deriv.Generics
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Core.Type
@@ -42,14 +42,14 @@ import GHC.Builtin.Names
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.Monad
 import GHC.Driver.Types
-import ErrUtils( Validity(..), andValid )
+import GHC.Utils.Error( Validity(..), andValid )
 import GHC.Types.SrcLoc
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set (elemVarSet)
-import Outputable
-import FastString
-import Util
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Misc
 
 import Control.Monad (mplus)
 import Data.List (zip4, partition)
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index 849f0bf2a9cb1bd06fa2353c41c065841ca058b0..56dafd209779137bf96e60f8a0348adae86c1013 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -16,16 +16,16 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Basic
 import GHC.Core.Class
 import GHC.Core.DataCon
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Tc.Utils.Instantiate
-import Outputable
-import Pair
+import GHC.Utils.Outputable
+import GHC.Data.Pair
 import GHC.Builtin.Names
 import GHC.Tc.Deriv.Utils
 import GHC.Tc.Utils.Env
@@ -46,7 +46,7 @@ import GHC.Tc.Validity (validDerivPred)
 import GHC.Tc.Utils.Unify (buildImplicationFor, checkConstraints)
 import GHC.Builtin.Types (typeToTypeKind)
 import GHC.Core.Unify (tcUnifyTy)
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var
 import GHC.Types.Var.Set
 
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index 63c0e3002cd7e407e39878c06f6053ec683d42ce..72ee0e6af3bb4436470c1af3c2bfa3650b18c51a 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -22,14 +22,14 @@ module GHC.Tc.Deriv.Utils (
         newDerivClsInst, extendLocalInstEnv
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Basic
 import GHC.Core.Class
 import GHC.Core.DataCon
 import GHC.Driver.Session
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Types (lookupFixity, mi_fix)
 import GHC.Hs
 import GHC.Tc.Utils.Instantiate
@@ -37,7 +37,7 @@ import GHC.Core.InstEnv
 import GHC.Iface.Load   (loadInterfaceForName)
 import GHC.Types.Module (getModule)
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Names
 import GHC.Types.SrcLoc
 import GHC.Tc.Deriv.Generate
@@ -50,13 +50,13 @@ import GHC.Builtin.Names.TH (liftClassKey)
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Ppr (pprSourceTyCon)
 import GHC.Core.Type
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Set
 
 import Control.Monad.Trans.Reader
 import Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
-import ListSetOps (assocMaybe)
+import GHC.Data.List.SetOps (assocMaybe)
 
 -- | To avoid having to manually plumb everything in 'DerivEnv' throughout
 -- various functions in @GHC.Tc.Deriv@ and @GHC.Tc.Deriv.Infer@, we use 'DerivM', which
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index ae08f784435a491db1afaa8cc9d376f74de97b00..e4746032d33532500150a5d8e584c14a9e84a9c6 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -15,7 +15,7 @@ module GHC.Tc.Errors(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types
 import GHC.Tc.Utils.Monad
@@ -51,19 +51,19 @@ import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Name.Set
-import Bag
-import ErrUtils         ( ErrMsg, errDoc, pprLocErrMsg )
+import GHC.Data.Bag
+import GHC.Utils.Error  ( ErrMsg, errDoc, pprLocErrMsg )
 import GHC.Types.Basic
 import GHC.Core.ConLike ( ConLike(..))
-import Util
-import FastString
-import Outputable
+import GHC.Utils.Misc
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Driver.Session
-import ListSetOps       ( equivClasses )
-import Maybes
+import GHC.Data.List.SetOps ( equivClasses )
+import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
-import FV ( fvVarList, unionFV )
+import GHC.Utils.FV ( fvVarList, unionFV )
 
 import Control.Monad    ( when )
 import Data.Foldable    ( toList )
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index 771765901ce1002b9a75cd7091ec97a6d3e1d63f..543fa0fca05737a2d8d2de64f47ab069e4d1342f 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -17,7 +17,7 @@ module GHC.Tc.Errors.Hole
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types
 import GHC.Tc.Utils.Monad
@@ -34,14 +34,14 @@ import GHC.Builtin.Names ( gHC_ERR )
 import GHC.Types.Id
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import Bag
+import GHC.Data.Bag
 import GHC.Core.ConLike ( ConLike(..) )
-import Util
+import GHC.Utils.Misc
 import GHC.Tc.Utils.Env (tcLookup)
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Session
-import Maybes
-import FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV )
+import GHC.Data.Maybe
+import GHC.Utils.FV ( fvVarList, fvVarSet, unionFV, mkFVs, FV )
 
 import Control.Arrow ( (&&&) )
 
diff --git a/compiler/GHC/Tc/Errors/Hole.hs-boot b/compiler/GHC/Tc/Errors/Hole.hs-boot
index bc79c3eed47a4b4df7a7d6f584ba017d24026e8e..fa3299c5d3f1e2976b2613d3459936c57661f276 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs-boot
+++ b/compiler/GHC/Tc/Errors/Hole.hs-boot
@@ -6,7 +6,7 @@ module GHC.Tc.Errors.Hole where
 
 import GHC.Tc.Types  ( TcM )
 import GHC.Tc.Types.Constraint ( Ct, Implication )
-import Outputable ( SDoc )
+import GHC.Utils.Outputable ( SDoc )
 import GHC.Types.Var.Env ( TidyEnv )
 
 findValidHoleFits :: TidyEnv -> [Implication] -> [Ct] -> Ct
diff --git a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
index 8aabc615ce11c32eb797f592c7926aa7554831a6..92bbe00115ccadfb3c06b0759a333944fb8f67e7 100644
--- a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
+++ b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs
@@ -5,7 +5,7 @@ module GHC.Tc.Errors.Hole.FitTypes (
   hfIsLcl, pprHoleFitCand
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types
 import GHC.Tc.Types.Constraint
@@ -16,7 +16,7 @@ import GHC.Types.Name.Reader
 import GHC.Hs.Doc
 import GHC.Types.Id
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Name
 
 import Data.Function ( on )
diff --git a/compiler/GHC/Tc/Gen/Annotation.hs b/compiler/GHC/Tc/Gen/Annotation.hs
index ef7168076fbb275c8d9bd92c9e69af27e67780fa..47bca17766bb38420e2fffcda705163d239eada2 100644
--- a/compiler/GHC/Tc/Gen/Annotation.hs
+++ b/compiler/GHC/Tc/Gen/Annotation.hs
@@ -10,7 +10,7 @@
 -- | Typechecking annotations
 module GHC.Tc.Gen.Annotation ( tcAnnotations, annCtxt ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Tc.Gen.Splice ( runAnnotation )
 import GHC.Types.Module
@@ -22,7 +22,7 @@ import GHC.Types.Name
 import GHC.Types.Annotations
 import GHC.Tc.Utils.Monad
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Types
 
 -- Some platforms don't support the interpreter, and compilation on those
diff --git a/compiler/GHC/Tc/Gen/Arrow.hs b/compiler/GHC/Tc/Gen/Arrow.hs
index 69c5e6719779fbca13d8bd070430fb6ce8532c20..5d26927ed4be6d1cb3a2070d4992a270b9b6f83a 100644
--- a/compiler/GHC/Tc/Gen/Arrow.hs
+++ b/compiler/GHC/Tc/Gen/Arrow.hs
@@ -12,7 +12,7 @@
 -- | Typecheck arrow notation
 module GHC.Tc.Gen.Arrow ( tcProc ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcLExpr, tcInferRho, tcSyntaxOp, tcCheckId, tcCheckExpr )
 
@@ -35,8 +35,8 @@ import GHC.Types.Var.Set
 import GHC.Builtin.Types.Prim
 import GHC.Types.Basic( Arity )
 import GHC.Types.SrcLoc
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Control.Monad
 
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 44fd5948491c2d9d5d975bb44f55366da9f710fd..929e02cc07911a93c8a9664a5b3a46c2d12c84e5 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -20,7 +20,7 @@ module GHC.Tc.Gen.Bind
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Tc.Gen.Match ( tcGRHSsPat, tcMatchesFun )
 import {-# SOURCE #-} GHC.Tc.Gen.Expr  ( tcLExpr )
@@ -28,7 +28,7 @@ import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind )
 import GHC.Core (Tickish (..))
 import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC))
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Hs
 import GHC.Tc.Gen.Sig
 import GHC.Tc.Utils.Monad
@@ -56,13 +56,13 @@ import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env
 import GHC.Types.SrcLoc
-import Bag
-import ErrUtils
-import Digraph
-import Maybes
-import Util
+import GHC.Data.Bag
+import GHC.Utils.Error
+import GHC.Data.Graph.Directed
+import GHC.Data.Maybe
+import GHC.Utils.Misc
 import GHC.Types.Basic
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Builtin.Names( ipClassName )
 import GHC.Tc.Validity (checkValidType)
 import GHC.Types.Unique.FM
@@ -552,7 +552,7 @@ mkEdges sig_fn binds
     ]
     -- It's OK to use nonDetEltsUFM here as stronglyConnCompFromEdgedVertices
     -- is still deterministic even if the edges are in nondeterministic order
-    -- as explained in Note [Deterministic SCC] in Digraph.
+    -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
   where
     bind_fvs (FunBind { fun_ext = fvs }) = fvs
     bind_fvs (PatBind { pat_ext = fvs }) = fvs
diff --git a/compiler/GHC/Tc/Gen/Default.hs b/compiler/GHC/Tc/Gen/Default.hs
index bf1132aa3e4ed998c2e4bef1a18975d8f765cbb4..ab5e021653ed42e950d62245dc7aed0723cdd8af 100644
--- a/compiler/GHC/Tc/Gen/Default.hs
+++ b/compiler/GHC/Tc/Gen/Default.hs
@@ -8,7 +8,7 @@
 -- | Typechecking @default@ declarations
 module GHC.Tc.Gen.Default ( tcDefaults ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Core.Class
@@ -21,8 +21,8 @@ import GHC.Tc.Validity
 import GHC.Tc.Utils.TcType
 import GHC.Builtin.Names
 import GHC.Types.SrcLoc
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import qualified GHC.LanguageExtensions as LangExt
 
 tcDefaults :: [LDefaultDecl GhcRn]
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index b384b494e461871816432bdb7b912e80dc1e4eb5..d4235ba171dbcad1002f0d2e381c0bc62916fe41 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -7,7 +7,7 @@
 
 module GHC.Tc.Gen.Export (tcRnExports, exports_from_avail) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Builtin.Names
@@ -18,7 +18,7 @@ import GHC.Tc.Utils.TcType
 import GHC.Rename.Names
 import GHC.Rename.Env
 import GHC.Rename.Unbound ( reportUnboundName )
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Module
@@ -29,14 +29,14 @@ import GHC.Types.Avail
 import GHC.Core.TyCon
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Types
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.PatSyn
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Unique.Set
-import Util (capitalise)
-import FastString (fsLit)
+import GHC.Utils.Misc (capitalise)
+import GHC.Data.FastString (fsLit)
 
 import Control.Monad
 import GHC.Driver.Session
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 70201773b962d5d1efc5064224f01d0efdf0114f..94341c62c2deaed9b1d74f69977ab8a7ef8e87b6 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -30,7 +30,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
 import GHC.Builtin.Names.TH( liftStringName, liftName )
@@ -79,12 +79,12 @@ import GHC.Builtin.PrimOps( tagToEnumKey )
 import GHC.Builtin.Names
 import GHC.Driver.Session
 import GHC.Types.SrcLoc
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var.Env  ( emptyTidyEnv, mkInScopeSet )
-import ListSetOps
-import Maybes
-import Outputable
-import FastString
+import GHC.Data.List.SetOps
+import GHC.Data.Maybe
+import GHC.Utils.Outputable as Outputable
+import GHC.Data.FastString
 import Control.Monad
 import GHC.Core.Class(classTyCon)
 import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
@@ -578,7 +578,7 @@ tcExpr (HsProc x pat cmd) res_ty
         ; return $ mkHsWrapCo coi (HsProc x pat' cmd') }
 
 -- Typechecks the static form and wraps it with a call to 'fromStaticPtr'.
--- See Note [Grand plan for static forms] in StaticPtrTable for an overview.
+-- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview.
 -- To type check
 --      (static e) :: p a
 -- we want to check (e :: a),
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index 858d8650267a0cba814709082b1238d4dd6d4870..8163e6820d888c4d1414d0021ff5f8c012aa64e1 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -33,7 +33,7 @@ module GHC.Tc.Gen.Foreign
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 
@@ -47,7 +47,7 @@ import GHC.Core.FamInstEnv
 import GHC.Core.Coercion
 import GHC.Core.Type
 import GHC.Types.ForeignCall
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Name.Reader
@@ -56,10 +56,10 @@ import GHC.Core.TyCon
 import GHC.Tc.Utils.TcType
 import GHC.Builtin.Names
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Platform
 import GHC.Types.SrcLoc
-import Bag
+import GHC.Data.Bag
 import GHC.Driver.Hooks
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index a25a7320e4d9210586fab059259786e8f76a8680..0614bfcc958c695fa8c933183cf5a7affd4f98c3 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -68,7 +68,7 @@ module GHC.Tc.Gen.HsType (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Tc.Utils.Monad
@@ -103,18 +103,18 @@ import GHC.Builtin.Types
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
 import GHC.Settings.Constants ( mAX_CTUPLE_SIZE )
-import ErrUtils( MsgDoc )
+import GHC.Utils.Error( MsgDoc )
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique.Supply
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Builtin.Names hiding ( wildCardName )
 import GHC.Driver.Session
 import qualified GHC.LanguageExtensions as LangExt
 
-import Maybes
+import GHC.Data.Maybe
 import Data.List ( find )
 import Control.Monad
 
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index 45fece68c0b52da0b5abe8c7c0fa41c8e0a3e1bf..857470b155b7ec7140b03d9088ca2cf886e64407 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -34,7 +34,7 @@ module GHC.Tc.Gen.Match
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRhoNC, tcInferRho
                                      , tcCheckId, tcLExpr, tcLExprNC, tcExpr
@@ -56,8 +56,8 @@ import GHC.Types.Id
 import GHC.Core.TyCon
 import GHC.Builtin.Types.Prim
 import GHC.Tc.Types.Evidence
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.SrcLoc
 
 -- Create chunkified tuple tybes for monad comprehensions
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 0456677cc7fa0a7f03ab7824e6f5f9b48cd52102..2f7d2e7721ef9bb8b5e072b996d3e57cbc6d0b2f 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -26,7 +26,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcSyntaxOp, tcSyntaxOpGen, tcInferSigma )
 
@@ -58,12 +58,12 @@ import GHC.Types.Basic hiding (SuccessFlag(..))
 import GHC.Driver.Session
 import GHC.Types.SrcLoc
 import GHC.Types.Var.Set
-import Util
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Outputable as Outputable
 import qualified GHC.LanguageExtensions as LangExt
 import Control.Arrow  ( second )
 import Control.Monad  ( when )
-import ListSetOps ( getNth )
+import GHC.Data.List.SetOps ( getNth )
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs
index 35b20acaa89cf0bed1e3456394d36a0bbb2d0616..20620d2c361fcb7add7e1c0434cf3c2b39c75e79 100644
--- a/compiler/GHC/Tc/Gen/Rule.hs
+++ b/compiler/GHC/Tc/Gen/Rule.hs
@@ -10,7 +10,7 @@
 -- | Typechecking transformation rules
 module GHC.Tc.Gen.Rule ( tcRules ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Tc.Types
@@ -33,9 +33,9 @@ import GHC.Types.Var( EvVar )
 import GHC.Types.Var.Set
 import GHC.Types.Basic ( RuleName )
 import GHC.Types.SrcLoc
-import Outputable
-import FastString
-import Bag
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Bag
 
 {-
 Note [Typechecking rules]
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 83fab20ca52c67357179ea3b96685e6c534c0319..a8cdd08bce640aaf8b3b314ff7dc604f81e48259 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -25,7 +25,7 @@ module GHC.Tc.Gen.Sig(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Tc.Gen.HsType
@@ -49,10 +49,10 @@ import GHC.Types.Basic
 import GHC.Types.Module( getModule )
 import GHC.Types.Name
 import GHC.Types.Name.Env
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
-import Util( singleton )
-import Maybes( orElse )
+import GHC.Utils.Misc( singleton )
+import GHC.Data.Maybe( orElse )
 import Data.Maybe( mapMaybe )
 import Control.Monad( unless )
 
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 830e17abd4b905724e46b5c7357c63d27dd94221..67ef5a3e6cfece74678854dd6d52173334b23877 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -34,7 +34,7 @@ module GHC.Tc.Gen.Splice(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Types.Annotations
@@ -43,7 +43,7 @@ import GHC.Types.Name
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.TcType
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Tc.Gen.Expr
 import GHC.Types.SrcLoc
 import GHC.Builtin.Names.TH
@@ -103,21 +103,21 @@ import GHC.Types.Id.Info
 import GHC.HsToCore.Expr
 import GHC.HsToCore.Monad
 import GHC.Serialized
-import ErrUtils
-import Util
+import GHC.Utils.Error
+import GHC.Utils.Misc
 import GHC.Types.Unique
 import GHC.Types.Var.Set
 import Data.List        ( find )
 import Data.Maybe
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Basic as BasicTypes hiding( SuccessFlag(..) )
-import Maybes( MaybeErr(..) )
+import GHC.Data.Maybe( MaybeErr(..) )
 import GHC.Driver.Session
-import Panic
+import GHC.Utils.Panic as Panic
 import GHC.Utils.Lexeme
-import qualified EnumSet
+import qualified GHC.Data.EnumSet as EnumSet
 import GHC.Driver.Plugins
-import Bag
+import GHC.Data.Bag
 
 import qualified Language.Haskell.TH as TH
 -- THSyntax gives access to internal functions and data types
diff --git a/compiler/GHC/Tc/Gen/Splice.hs-boot b/compiler/GHC/Tc/Gen/Splice.hs-boot
index d74edf3f3a59f02786196648bef3a7766c539ff8..fe57d4a1242b1a04301eeacfad51b2bb717664d6 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs-boot
+++ b/compiler/GHC/Tc/Gen/Splice.hs-boot
@@ -3,7 +3,7 @@
 
 module GHC.Tc.Gen.Splice where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Types.Name
 import GHC.Hs.Expr ( PendingRnSplice, DelayedSplice )
 import GHC.Tc.Types( TcM , SpliceType )
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs
index 53054de7f83ba76b0242844edbb886c84b9afebc..43c2092c70746f06aefe54bce423408093c8d475 100644
--- a/compiler/GHC/Tc/Instance/Class.hs
+++ b/compiler/GHC/Tc/Instance/Class.hs
@@ -11,7 +11,7 @@ module GHC.Tc.Instance.Class (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.Monad
@@ -40,8 +40,8 @@ import GHC.Core.DataCon
 import GHC.Core.TyCon
 import GHC.Core.Class
 import GHC.Driver.Session
-import Outputable
-import Util( splitAtList, fstOf3 )
+import GHC.Utils.Outputable
+import GHC.Utils.Misc( splitAtList, fstOf3 )
 import Data.Maybe
 
 {- *******************************************************************
diff --git a/compiler/GHC/Tc/Instance/Family.hs b/compiler/GHC/Tc/Instance/Family.hs
index 68c894f2e48aa3ddef512a874fd5004b3d9413e3..6f1ac07f74bdb8daf33fdd8411a9b5c1ce7a28ab 100644
--- a/compiler/GHC/Tc/Instance/Family.hs
+++ b/compiler/GHC/Tc/Instance/Family.hs
@@ -12,7 +12,7 @@ module GHC.Tc.Instance.Family (
         reportInjectivityErrors, reportConflictingInjectivityErrs
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Types
 import GHC.Core.FamInstEnv
@@ -28,20 +28,20 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.Coercion.Axiom
 import GHC.Driver.Session
 import GHC.Types.Module
-import Outputable
-import Util
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Name.Reader
 import GHC.Core.DataCon ( dataConName )
-import Maybes
+import GHC.Data.Maybe
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.FVs
 import GHC.Core.TyCo.Ppr ( pprWithExplicitKindsWhen )
 import GHC.Tc.Utils.TcMType
 import GHC.Types.Name
-import Panic
+import GHC.Utils.Panic
 import GHC.Types.Var.Set
-import FV
-import Bag( Bag, unionBags, unitBag )
+import GHC.Utils.FV
+import GHC.Data.Bag( Bag, unionBags, unitBag )
 import Control.Monad
 import Data.List ( sortBy )
 import Data.List.NonEmpty ( NonEmpty(..) )
diff --git a/compiler/GHC/Tc/Instance/FunDeps.hs b/compiler/GHC/Tc/Instance/FunDeps.hs
index 40344af9ed7fe31df3884a9528257bed597db72a..aba9031be6f372c63b06bac5b40f48563d0255e1 100644
--- a/compiler/GHC/Tc/Instance/FunDeps.hs
+++ b/compiler/GHC/Tc/Instance/FunDeps.hs
@@ -23,7 +23,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Name
 import GHC.Types.Var
@@ -38,13 +38,13 @@ import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Core.TyCo.FVs
 import GHC.Core.TyCo.Ppr( pprWithExplicitKindsWhen )
-import FV
-import Outputable
-import ErrUtils( Validity(..), allValid )
+import GHC.Utils.FV
+import GHC.Utils.Outputable
+import GHC.Utils.Error( Validity(..), allValid )
 import GHC.Types.SrcLoc
-import Util
+import GHC.Utils.Misc
 
-import Pair             ( Pair(..) )
+import GHC.Data.Pair             ( Pair(..) )
 import Data.List        ( nubBy )
 import Data.Maybe
 import Data.Foldable    ( fold )
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index c3e59b2f4ca73b7f497adf0339839d5c56ef6b0b..2c7656a20ce71ff79773bfd0aa8896399f5a8995 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -12,7 +12,7 @@ module GHC.Tc.Instance.Typeable(mkTypeableBinds, tyConIsTypeable) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Types.Basic ( Boxity(..), neverInlinePragma, SourceText(..) )
@@ -37,13 +37,13 @@ import GHC.Core.DataCon
 import GHC.Types.Module
 import GHC.Hs
 import GHC.Driver.Session
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Var ( VarBndr(..) )
 import GHC.Core.Map
 import GHC.Settings.Constants
-import Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)
-import Outputable
-import FastString ( FastString, mkFastString, fsLit )
+import GHC.Utils.Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)
+import GHC.Utils.Outputable
+import GHC.Data.FastString ( FastString, mkFastString, fsLit )
 
 import Control.Monad.Trans.State
 import Control.Monad.Trans.Class (lift)
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index cc3bf4a2cc8d386fbe8940807f3eb662e301a798..e202fdcec7d892c838529a11fc6a8f9516601e9a 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -48,7 +48,7 @@ module GHC.Tc.Module (
         getRenamedStuff, RenamedStuff
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Tc.Gen.Splice ( finishTH, runRemoteModFinalizers )
 import GHC.Rename.Splice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
@@ -78,7 +78,7 @@ import GHC.Tc.Gen.Export
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
-import qualified BooleanFormula as BF
+import qualified GHC.Data.BooleanFormula as BF
 import GHC.Core.Ppr.TyThing ( pprTyThingInContext )
 import GHC.Core.FVs         ( orphNamesOfFamInst )
 import GHC.Tc.Instance.Family
@@ -106,7 +106,7 @@ import GHC.Iface.Load
 import GHC.Rename.Names
 import GHC.Rename.Env
 import GHC.Rename.Module
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Id as Id
 import GHC.Types.Id.Info( IdDetails(..) )
 import GHC.Types.Var.Env
@@ -119,8 +119,8 @@ import GHC.Types.Avail
 import GHC.Core.TyCon
 import GHC.Types.SrcLoc
 import GHC.Driver.Types
-import ListSetOps
-import Outputable
+import GHC.Data.List.SetOps
+import GHC.Utils.Outputable as Outputable
 import GHC.Core.ConLike
 import GHC.Core.DataCon
 import GHC.Core.Type
@@ -130,10 +130,10 @@ import GHC.Core.Coercion.Axiom
 import GHC.Types.Annotations
 import Data.List ( find, sortBy, sort )
 import Data.Ord
-import FastString
-import Maybes
-import Util
-import Bag
+import GHC.Data.FastString
+import GHC.Data.Maybe
+import GHC.Utils.Misc
+import GHC.Data.Bag
 import GHC.Tc.Utils.Instantiate (tcGetInsts)
 import qualified GHC.LanguageExtensions as LangExt
 import Data.Data ( Data )
diff --git a/compiler/GHC/Tc/Module.hs-boot b/compiler/GHC/Tc/Module.hs-boot
index f1f5e31e8ad088974ac473cf9365d1e30fc40ce4..90d775a4e2ce24a476b6ab8837bdef62fe11a7e4 100644
--- a/compiler/GHC/Tc/Module.hs-boot
+++ b/compiler/GHC/Tc/Module.hs-boot
@@ -1,9 +1,9 @@
 module GHC.Tc.Module where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Core.Type(TyThing)
 import GHC.Tc.Types (TcM)
-import Outputable (SDoc)
+import GHC.Utils.Outputable (SDoc)
 import GHC.Types.Name (Name)
 
 checkBootDeclM :: Bool  -- ^ True <=> an hs-boot file (could also be a sig)
diff --git a/compiler/GHC/Tc/Plugin.hs b/compiler/GHC/Tc/Plugin.hs
index cde159815fd21feaf582e47bc227ca831f1e88a9..228647767dfff6d325b4735fc18410d6a96c4645 100644
--- a/compiler/GHC/Tc/Plugin.hs
+++ b/compiler/GHC/Tc/Plugin.hs
@@ -50,7 +50,7 @@ module GHC.Tc.Plugin (
         getEvBindsTcPluginM
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import qualified GHC.Tc.Utils.Monad           as TcM
 import qualified GHC.Tc.Solver.Monad    as TcS
@@ -77,12 +77,12 @@ import GHC.Core.TyCon
 import GHC.Core.DataCon
 import GHC.Core.Class
 import GHC.Driver.Types
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.Type
 import GHC.Core.Coercion   ( BlockSubstFlag(..) )
 import GHC.Types.Id
 import GHC.Core.InstEnv
-import FastString
+import GHC.Data.FastString
 import GHC.Types.Unique
 
 
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index c060eac63869e8904bc2801be9f1800c2df28f5a..92b739f00b996115281fe1d78150a12fa1ab7427 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -26,16 +26,16 @@ module GHC.Tc.Solver(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Bag
+import GHC.Data.Bag
 import GHC.Core.Class ( Class, classKey, classTyCon )
 import GHC.Driver.Session
 import GHC.Types.Id   ( idType, mkLocalId )
 import GHC.Tc.Utils.Instantiate
-import ListSetOps
+import GHC.Data.List.SetOps
 import GHC.Types.Name
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Utils
 import GHC.Builtin.Names
 import GHC.Tc.Errors
@@ -52,19 +52,19 @@ import GHC.Tc.Utils.TcType
 import GHC.Core.Type
 import GHC.Builtin.Types ( liftedRepTy )
 import GHC.Core.Unify    ( tcMatchTyKi )
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Unique.Set
 import GHC.Types.Basic    ( IntWithInf, intGtLimit )
-import ErrUtils           ( emptyMessages )
+import GHC.Utils.Error    ( emptyMessages )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Data.Foldable      ( toList )
 import Data.List          ( partition )
 import Data.List.NonEmpty ( NonEmpty(..) )
-import Maybes             ( isJust )
+import GHC.Data.Maybe     ( isJust )
 
 {-
 *********************************************************************************
diff --git a/compiler/GHC/Tc/Solver/Canonical.hs b/compiler/GHC/Tc/Solver/Canonical.hs
index c9d93b063e957746ab9fa861f5c03375acab4e26..5a231f2e442715a91ce5ef4766bfccb2ee40f5c6 100644
--- a/compiler/GHC/Tc/Solver/Canonical.hs
+++ b/compiler/GHC/Tc/Solver/Canonical.hs
@@ -11,7 +11,7 @@ module GHC.Tc.Solver.Canonical(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types.Constraint
 import GHC.Core.Predicate
@@ -35,16 +35,16 @@ import GHC.Types.Var
 import GHC.Types.Var.Env( mkInScopeSet )
 import GHC.Types.Var.Set( delVarSetList )
 import GHC.Types.Name.Occurrence ( OccName )
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Session( DynFlags )
 import GHC.Types.Name.Set
 import GHC.Types.Name.Reader
 import GHC.Hs.Types( HsIPName(..) )
 
-import Pair
-import Util
-import Bag
-import MonadUtils
+import GHC.Data.Pair
+import GHC.Utils.Misc
+import GHC.Data.Bag
+import GHC.Utils.Monad
 import Control.Monad
 import Data.Maybe ( isJust )
 import Data.List  ( zip4 )
diff --git a/compiler/GHC/Tc/Solver/Flatten.hs b/compiler/GHC/Tc/Solver/Flatten.hs
index e1a290fdf97706934f4ae21fb245b1c5ef8454b1..551e1de3955a878d0cf01fb0b7184243c0b43acd 100644
--- a/compiler/GHC/Tc/Solver/Flatten.hs
+++ b/compiler/GHC/Tc/Solver/Flatten.hs
@@ -12,7 +12,7 @@ module GHC.Tc.Solver.Flatten(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types
 import GHC.Core.TyCo.Ppr ( pprTyVar )
@@ -27,14 +27,14 @@ import GHC.Core.Coercion
 import GHC.Types.Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Tc.Solver.Monad as TcS
 import GHC.Types.Basic( SwapFlag(..) )
 
-import Util
-import Bag
+import GHC.Utils.Misc
+import GHC.Data.Bag
 import Control.Monad
-import MonadUtils    ( zipWith3M )
+import GHC.Utils.Monad ( zipWith3M )
 import Data.Foldable ( foldrM )
 
 import Control.Arrow ( first )
diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs
index acb9ca55430e5e029809eab15d82cd7882e1b08d..6a391d4406b885d9ed0e072fc94552f61deda84f 100644
--- a/compiler/GHC/Tc/Solver/Interact.hs
+++ b/compiler/GHC/Tc/Solver/Interact.hs
@@ -10,7 +10,7 @@ module GHC.Tc.Solver.Interact (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Types.Basic ( SwapFlag(..), isSwapped,
                          infinity, IntWithInf, intGtLimit )
 import GHC.Tc.Solver.Canonical
@@ -36,15 +36,15 @@ import GHC.Core.FamInstEnv
 import GHC.Core.Unify ( tcUnifyTyWithTFs, ruleMatchTyKiX )
 
 import GHC.Tc.Types.Evidence
-import Outputable
+import GHC.Utils.Outputable
 
 import GHC.Tc.Types
 import GHC.Tc.Types.Constraint
 import GHC.Core.Predicate
 import GHC.Tc.Types.Origin
 import GHC.Tc.Solver.Monad
-import Bag
-import MonadUtils ( concatMapM, foldlM )
+import GHC.Data.Bag
+import GHC.Utils.Monad ( concatMapM, foldlM )
 
 import GHC.Core
 import Data.List( partition, deleteFirstsBy )
@@ -52,11 +52,11 @@ import GHC.Types.SrcLoc
 import GHC.Types.Var.Env
 
 import Control.Monad
-import Maybes( isJust )
-import Pair (Pair(..))
+import GHC.Data.Maybe( isJust )
+import GHC.Data.Pair (Pair(..))
 import GHC.Types.Unique( hasKey )
 import GHC.Driver.Session
-import Util
+import GHC.Utils.Misc
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad.Trans.Class
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs
index 822ccb22482a6377332784e87d843d2e89fd3c0a..0baad1ff4b10932d07c649fb666b5602002ea0cc 100644
--- a/compiler/GHC/Tc/Solver/Monad.hs
+++ b/compiler/GHC/Tc/Solver/Monad.hs
@@ -127,7 +127,7 @@ module GHC.Tc.Solver.Monad (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Types
 
@@ -148,7 +148,7 @@ import GHC.Core.Type
 import GHC.Core.Coercion
 import GHC.Core.Unify
 
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Tc.Types.Evidence
 import GHC.Core.Class
 import GHC.Core.TyCon
@@ -161,10 +161,10 @@ import qualified GHC.Rename.Env as TcM
 import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
-import Outputable
-import Bag
+import GHC.Utils.Outputable
+import GHC.Data.Bag as Bag
 import GHC.Types.Unique.Supply
-import Util
+import GHC.Utils.Misc
 import GHC.Tc.Types
 import GHC.Tc.Types.Origin
 import GHC.Tc.Types.Constraint
@@ -173,16 +173,16 @@ import GHC.Core.Predicate
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
-import Maybes
+import GHC.Data.Maybe
 
 import GHC.Core.Map
 import Control.Monad
-import MonadUtils
+import GHC.Utils.Monad
 import Data.IORef
 import Data.List ( partition, mapAccumL )
 
 #if defined(DEBUG)
-import Digraph
+import GHC.Data.Graph.Directed
 import GHC.Types.Unique.Set
 #endif
 
@@ -2860,7 +2860,7 @@ checkForCyclicBinds ev_binds_map
             -- It's OK to use nonDetEltsUFM here as
             -- stronglyConnCompFromEdgedVertices is still deterministic even
             -- if the edges are in nondeterministic order as explained in
-            -- Note [Deterministic SCC] in Digraph.
+            -- Note [Deterministic SCC] in GHC.Data.Graph.Directed.
 #endif
 
 ----------------------------
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index e69990cb635b28262fdcb855145a2456ce7d8139..1f44338a4cd28ecbb23079ed749c3ac93468d226 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -25,7 +25,7 @@ module GHC.Tc.TyCl (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Driver.Types
@@ -64,12 +64,12 @@ import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env
-import Outputable
-import Maybes
+import GHC.Utils.Outputable
+import GHC.Data.Maybe
 import GHC.Core.Unify
-import Util
+import GHC.Utils.Misc
 import GHC.Types.SrcLoc
-import ListSetOps
+import GHC.Data.List.SetOps
 import GHC.Driver.Session
 import GHC.Types.Unique
 import GHC.Core.ConLike( ConLike(..) )
diff --git a/compiler/GHC/Tc/TyCl/Build.hs b/compiler/GHC/Tc/TyCl/Build.hs
index 908f1398d778b8f06a33d9066dd8b8fdd69e0b5d..fa0c1965044fad7d8ac439c3decbde25d8ae492f 100644
--- a/compiler/GHC/Tc/TyCl/Build.hs
+++ b/compiler/GHC/Tc/TyCl/Build.hs
@@ -17,7 +17,7 @@ module GHC.Tc.TyCl.Build (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Iface.Env
 import GHC.Core.FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
@@ -41,8 +41,8 @@ import GHC.Types.SrcLoc( SrcSpan, noSrcSpan )
 import GHC.Driver.Session
 import GHC.Tc.Utils.Monad
 import GHC.Types.Unique.Supply
-import Util
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 
 
 mkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
diff --git a/compiler/GHC/Tc/TyCl/Class.hs b/compiler/GHC/Tc/TyCl/Class.hs
index 55105f84ffe81253e669d4b1172513416ddd9d51..cedd42916bdfa5b36600fce92115a5bf2b178503 100644
--- a/compiler/GHC/Tc/TyCl/Class.hs
+++ b/compiler/GHC/Tc/TyCl/Class.hs
@@ -28,7 +28,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Tc.Utils.Env
@@ -56,15 +56,15 @@ import GHC.Types.Name.Env
 import GHC.Types.Name.Set
 import GHC.Types.Var
 import GHC.Types.Var.Env
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Core.TyCon
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.Basic
-import Bag
-import FastString
-import BooleanFormula
-import Util
+import GHC.Data.Bag
+import GHC.Data.FastString
+import GHC.Data.BooleanFormula
+import GHC.Utils.Misc
 
 import Control.Monad
 import Data.List ( mapAccumL, partition )
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index a716c9671fb057fb0680689218e6905521fdcc4b..22849451bf7db5389af7735c3842ff6d4da600e8 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -21,7 +21,7 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Tc.Gen.Bind
@@ -61,24 +61,24 @@ import GHC.Core.Class
 import GHC.Types.Var as Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
-import Bag
+import GHC.Data.Bag
 import GHC.Types.Basic
 import GHC.Driver.Session
-import ErrUtils
-import FastString
+import GHC.Utils.Error
+import GHC.Data.FastString
 import GHC.Types.Id
-import ListSetOps
+import GHC.Data.List.SetOps
 import GHC.Types.Name
 import GHC.Types.Name.Set
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
-import Util
-import BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )
+import GHC.Utils.Misc
+import GHC.Data.BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
 import Data.Tuple
-import Maybes
+import GHC.Data.Maybe
 import Data.List( mapAccumL )
 
 
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index 37ba4e332901a2744d78fb6714b915886712c09b..00e0beb5e16b87356170ceb6f33f54c9c475b071 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -20,7 +20,7 @@ module GHC.Tc.TyCl.PatSyn
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Tc.Gen.Pat
@@ -35,9 +35,9 @@ import GHC.Types.Name
 import GHC.Types.SrcLoc
 import GHC.Core.PatSyn
 import GHC.Types.Name.Set
-import Panic
-import Outputable
-import FastString
+import GHC.Utils.Panic
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Var
 import GHC.Types.Var.Env( emptyTidyEnv, mkInScopeSet )
 import GHC.Types.Id
@@ -57,9 +57,9 @@ import GHC.Types.Id.Make
 import GHC.Tc.TyCl.Utils
 import GHC.Core.ConLike
 import GHC.Types.FieldLabel
-import Bag
-import Util
-import ErrUtils
+import GHC.Data.Bag
+import GHC.Utils.Misc
+import GHC.Utils.Error
 import Data.Maybe( mapMaybe )
 import Control.Monad ( zipWithM )
 import Data.List( partition )
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs-boot b/compiler/GHC/Tc/TyCl/PatSyn.hs-boot
index 44be72781dae9224fcff17aebc1bf0141e57a62e..fb4ac51013370228de872dfe2db99a2094cd39b6 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs-boot
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs-boot
@@ -3,7 +3,7 @@ module GHC.Tc.TyCl.PatSyn where
 import GHC.Hs    ( PatSynBind, LHsBinds )
 import GHC.Tc.Types ( TcM, TcSigInfo )
 import GHC.Tc.Utils.Monad ( TcGblEnv)
-import Outputable ( Outputable )
+import GHC.Utils.Outputable ( Outputable )
 import GHC.Hs.Extension ( GhcRn, GhcTc )
 import Data.Maybe  ( Maybe )
 
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index 5ee3620db1c6abf285248f8f78dec4d6ebe90d30..890222b8aa85ba0e836eaddfb7be600b3bcaeec0 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -30,7 +30,7 @@ module GHC.Tc.TyCl.Utils(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.Env
@@ -59,12 +59,12 @@ import GHC.Core.Coercion ( ltRole )
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
 import GHC.Types.Unique ( mkBuiltinUnique )
-import Outputable
-import Util
-import Maybes
-import Bag
-import FastString
-import FV
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Data.Bag
+import GHC.Data.FastString
+import GHC.Utils.FV as FV
 import GHC.Types.Module
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 8c4086a2ca48af708491d4dd79d84e52bda4d5e2..be345c4f3027b161bac7c6f40943f6a951761a0c 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -84,7 +84,7 @@ module GHC.Tc.Types(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Platform
 
 import GHC.Hs
@@ -102,7 +102,7 @@ import GHC.Types.Annotations
 import GHC.Core.InstEnv
 import GHC.Core.FamInstEnv
 import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Deltas)
-import IOEnv
+import GHC.Data.IOEnv
 import GHC.Types.Name.Reader
 import GHC.Types.Name
 import GHC.Types.Name.Env
@@ -113,15 +113,15 @@ import GHC.Types.Var.Env
 import GHC.Types.Module
 import GHC.Types.SrcLoc
 import GHC.Types.Var.Set
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Unique.FM
 import GHC.Types.Basic
-import Bag
+import GHC.Data.Bag
 import GHC.Driver.Session
-import Outputable
-import ListSetOps
-import Fingerprint
-import Util
+import GHC.Utils.Outputable
+import GHC.Data.List.SetOps
+import GHC.Utils.Fingerprint
+import GHC.Utils.Misc
 import GHC.Builtin.Names ( isUnboundName )
 import GHC.Types.CostCentre.State
 
@@ -1167,7 +1167,7 @@ For (static e) to be valid, we need for every 'x' free in 'e',
 that x's binding is floatable to the top level.  Specifically:
    * x's RhsNames must be empty
    * x's type has no free variables
-See Note [Grand plan for static forms] in StaticPtrTable.hs.
+See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.hs.
 This test is made in GHC.Tc.Gen.Expr.checkClosedInStaticForm.
 Actually knowing x's RhsNames (rather than just its emptiness
 or otherwise) is just so we can produce better error messages
diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs
index 3f85594c973c043e97a3fe2f25ee5db5d369d12d..fdfd13e3391ba5e8528832fcade05ea79fdc5b97 100644
--- a/compiler/GHC/Tc/Types/Constraint.hs
+++ b/compiler/GHC/Tc/Types/Constraint.hs
@@ -70,7 +70,7 @@ module GHC.Tc.Types.Constraint (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Tc.Types ( TcLclEnv, setLclEnvTcLevel, getLclEnvTcLevel
                                    , setLclEnvLoc, getLclEnvLoc )
@@ -90,15 +90,15 @@ import GHC.Core
 
 import GHC.Core.TyCo.Ppr
 import GHC.Types.Name.Occurrence
-import FV
+import GHC.Utils.FV
 import GHC.Types.Var.Set
 import GHC.Driver.Session
 import GHC.Types.Basic
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
-import Bag
-import Util
+import GHC.Data.Bag
+import GHC.Utils.Misc
 
 import Control.Monad ( msum )
 
@@ -439,12 +439,12 @@ tyCoVarsOfCt :: Ct -> TcTyCoVarSet
 tyCoVarsOfCt = fvVarSet . tyCoFVsOfCt
 
 -- | Returns free variables of constraints as a deterministically ordered.
--- list. See Note [Deterministic FV] in FV.
+-- list. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfCtList :: Ct -> [TcTyCoVar]
 tyCoVarsOfCtList = fvVarList . tyCoFVsOfCt
 
 -- | Returns free variables of constraints as a composable FV computation.
--- See Note [Deterministic FV] in FV.
+-- See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoFVsOfCt :: Ct -> FV
 tyCoFVsOfCt ct = tyCoFVsOfType (ctPred ct)
   -- This must consult only the ctPred, so that it gets *tidied* fvs if the
@@ -452,34 +452,34 @@ tyCoFVsOfCt ct = tyCoFVsOfType (ctPred ct)
   -- fields of the Ct, only the predicate in the CtEvidence.
 
 -- | Returns free variables of a bag of constraints as a non-deterministic
--- set. See Note [Deterministic FV] in FV.
+-- set. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfCts :: Cts -> TcTyCoVarSet
 tyCoVarsOfCts = fvVarSet . tyCoFVsOfCts
 
 -- | Returns free variables of a bag of constraints as a deterministically
--- ordered list. See Note [Deterministic FV] in FV.
+-- ordered list. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfCtsList :: Cts -> [TcTyCoVar]
 tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts
 
 -- | Returns free variables of a bag of constraints as a composable FV
--- computation. See Note [Deterministic FV] in FV.
+-- computation. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoFVsOfCts :: Cts -> FV
 tyCoFVsOfCts = foldr (unionFV . tyCoFVsOfCt) emptyFV
 
 -- | Returns free variables of WantedConstraints as a non-deterministic
--- set. See Note [Deterministic FV] in FV.
+-- set. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet
 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
 tyCoVarsOfWC = fvVarSet . tyCoFVsOfWC
 
 -- | Returns free variables of WantedConstraints as a deterministically
--- ordered list. See Note [Deterministic FV] in FV.
+-- ordered list. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]
 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
 tyCoVarsOfWCList = fvVarList . tyCoFVsOfWC
 
 -- | Returns free variables of WantedConstraints as a composable FV
--- computation. See Note [Deterministic FV] in FV.
+-- computation. See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoFVsOfWC :: WantedConstraints -> FV
 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
 tyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic })
@@ -487,7 +487,7 @@ tyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic })
     tyCoFVsOfBag tyCoFVsOfImplic implic
 
 -- | Returns free variables of Implication as a composable FV computation.
--- See Note [Deterministic FV] in FV.
+-- See Note [Deterministic FV] in GHC.Utils.FV.
 tyCoFVsOfImplic :: Implication -> FV
 -- Only called on *zonked* things, hence no need to worry about flatten-skolems
 tyCoFVsOfImplic (Implic { ic_skols = skols
diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs
index 09f016ca7198e7ae9410f9cd89dec8591b0e7953..1352ceca90704f4b4d17b4d82cda58ab5634c6a8 100644
--- a/compiler/GHC/Tc/Types/EvTerm.hs
+++ b/compiler/GHC/Tc/Types/EvTerm.hs
@@ -4,9 +4,9 @@ module GHC.Tc.Types.EvTerm
     ( evDelayedError, evCallStack )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
-import FastString
+import GHC.Data.FastString
 import GHC.Core.Type
 import GHC.Core
 import GHC.Core.Make
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs
index 922055ebf5470f678291c4b3380e48d9df74b326..9c7e237ffe565abcc4d47011353cad933fbdc10f 100644
--- a/compiler/GHC/Tc/Types/Evidence.hs
+++ b/compiler/GHC/Tc/Types/Evidence.hs
@@ -53,7 +53,7 @@ module GHC.Tc.Types.Evidence (
   ) where
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var
 import GHC.Core.Coercion.Axiom
@@ -69,16 +69,16 @@ import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Core.Predicate
 import GHC.Types.Name
-import Pair
+import GHC.Data.Pair
 
 import GHC.Core
 import GHC.Core.Class ( classSCSelId )
 import GHC.Core.FVs   ( exprSomeFreeVars )
 
-import Util
-import Bag
+import GHC.Utils.Misc
+import GHC.Data.Bag
 import qualified Data.Data as Data
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import Data.IORef( IORef )
 import GHC.Types.Unique.Set
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index 86427853de0399f85fd934c7b192b377fb49ebc3..d21f594aefa7fd3ccdc216a7d2958e25b1f3b5dd 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -22,7 +22,7 @@ module GHC.Tc.Types.Origin (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Utils.TcType
 
@@ -40,8 +40,8 @@ import GHC.Types.Name
 import GHC.Types.Name.Reader
 
 import GHC.Types.SrcLoc
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.Basic
 
 {- *********************************************************************
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index fc134817be9e23157df8410da2cd2230fdd597e5..98999e57c8daddc8e84cf4781fadb3fa1bd483ab 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -18,7 +18,7 @@ module GHC.Tc.Utils.Backpack (
     instantiateSignature,
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic (defaultFixity, TypeOrKind(..))
 import GHC.Driver.Packages
@@ -39,7 +39,7 @@ import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Origin
 import GHC.Iface.Load
 import GHC.Rename.Names
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.Id
 import GHC.Types.Module
 import GHC.Types.Name
@@ -48,11 +48,11 @@ import GHC.Types.Name.Set
 import GHC.Types.Avail
 import GHC.Types.SrcLoc
 import GHC.Driver.Types
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Core.Type
-import FastString
+import GHC.Data.FastString
 import GHC.Rename.Fixity ( lookupFixityRn )
-import Maybes
+import GHC.Data.Maybe
 import GHC.Tc.Utils.Env
 import GHC.Types.Var
 import GHC.Iface.Syntax
@@ -65,7 +65,7 @@ import GHC.Types.Name.Shape
 import GHC.Tc.Errors
 import GHC.Tc.Utils.Unify
 import GHC.Iface.Rename
-import Util
+import GHC.Utils.Misc
 
 import Control.Monad
 import Data.List (find)
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index cf55316b2265ed22129dd7e5e5fa124543bb2074..d1a92298db6a6852a57dc776679803477714f027 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -71,7 +71,7 @@ module GHC.Tc.Utils.Env(
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Iface.Env
@@ -101,15 +101,15 @@ import GHC.Driver.Session
 import GHC.Types.SrcLoc
 import GHC.Types.Basic hiding( SuccessFlag(..) )
 import GHC.Types.Module
-import Outputable
-import Encoding
-import FastString
-import Bag
-import ListSetOps
-import ErrUtils
-import Maybes( MaybeErr(..), orElse )
+import GHC.Utils.Outputable
+import GHC.Utils.Encoding
+import GHC.Data.FastString
+import GHC.Data.Bag
+import GHC.Data.List.SetOps
+import GHC.Utils.Error
+import GHC.Data.Maybe( MaybeErr(..), orElse )
 import qualified GHC.LanguageExtensions as LangExt
-import Util ( HasDebugCallStack )
+import GHC.Utils.Misc ( HasDebugCallStack )
 
 import Data.IORef
 import Data.List (intercalate)
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 7e45b5d947e5e698d48ef44713b640243b6094ff..ea8ffd912b93ad0733796200e802915b22cdc24c 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -34,13 +34,13 @@ module GHC.Tc.Utils.Instantiate (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcCheckExpr, tcSyntaxOp )
 import {-# SOURCE #-}   GHC.Tc.Utils.Unify( unifyType, unifyKind )
 
 import GHC.Types.Basic ( IntegralLit(..), SourceText(..) )
-import FastString
+import GHC.Data.FastString
 import GHC.Hs
 import GHC.Tc.Utils.Zonk
 import GHC.Tc.Utils.Monad
@@ -70,8 +70,8 @@ import GHC.Types.Var.Env
 import GHC.Builtin.Names
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Session
-import Util
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Types.Basic ( TypeOrKind(..) )
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 918a71594d06f6aa76299c5edfd4149f85535cf8..60714e4cc1b8f609efcb1c9a0917d68b36c92442 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -138,15 +138,15 @@ module GHC.Tc.Utils.Monad(
 
   -- * Types etc.
   module GHC.Tc.Types,
-  module IOEnv
+  module GHC.Data.IOEnv
   ) where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Tc.Types     -- Re-export all
-import IOEnv            -- Re-export all
+import GHC.Data.IOEnv -- Re-export all
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Types.Evidence
 import GHC.Tc.Types.Origin
@@ -166,20 +166,20 @@ import GHC.Builtin.Names
 import GHC.Types.Id
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Types.SrcLoc
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
-import Bag
-import Outputable
+import GHC.Data.Bag
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
-import FastString
-import Panic
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Panic
+import GHC.Utils.Misc
 import GHC.Types.Annotations
 import GHC.Types.Basic( TopLevelFlag, TypeOrKind(..) )
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.CostCentre.State
 
 import qualified GHC.LanguageExtensions as LangExt
diff --git a/compiler/GHC/Tc/Utils/TcMType.hs b/compiler/GHC/Tc/Utils/TcMType.hs
index d37b37efe382679ed8ff9dcee2241ea21f2863f8..1189a57cd79ac73928a0847550184e357ddb8653 100644
--- a/compiler/GHC/Tc/Utils/TcMType.hs
+++ b/compiler/GHC/Tc/Utils/TcMType.hs
@@ -94,7 +94,7 @@ module GHC.Tc.Utils.TcMType (
 #include "HsVersions.h"
 
 -- friends:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr
@@ -119,18 +119,18 @@ import GHC.Builtin.Types.Prim
 import GHC.Types.Var.Env
 import GHC.Types.Name.Env
 import GHC.Builtin.Names
-import Util
-import Outputable
-import FastString
-import Bag
-import Pair
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.Bag
+import GHC.Data.Pair
 import GHC.Types.Unique.Set
 import GHC.Driver.Session
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Types.Basic ( TypeOrKind(..) )
 
 import Control.Monad
-import Maybes
+import GHC.Data.Maybe
 import Data.List        ( mapAccumL )
 import Control.Arrow    ( second )
 import qualified Data.Semigroup as Semi
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index dc1ef3a69e34aa1b0f2d9886a95badefabe7ecb1..693fd1f132dabf5b87d93c0b8d3049699f175873 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -189,7 +189,7 @@ module GHC.Tc.Utils.TcType (
 #include "HsVersions.h"
 
 -- friends:
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Subst ( mkTvSubst, substTyWithCoVars )
@@ -217,12 +217,12 @@ import GHC.Builtin.Names
 import GHC.Builtin.Types ( coercibleClass, eqClass, heqClass, unitTyCon, unitTyConKey
                          , listTyCon, constraintKind )
 import GHC.Types.Basic
-import Util
-import Maybes
-import ListSetOps ( getNth, findDupsEq )
-import Outputable
-import FastString
-import ErrUtils( Validity(..), MsgDoc, isValid )
+import GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Data.List.SetOps ( getNth, findDupsEq )
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Error( Validity(..), MsgDoc, isValid )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Data.List  ( mapAccumL )
diff --git a/compiler/GHC/Tc/Utils/TcType.hs-boot b/compiler/GHC/Tc/Utils/TcType.hs-boot
index 481d261f79c1d38dbed9501982a293330877b85c..dc5f4cf73fb3631c6f566c291596df5f6eb880b3 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs-boot
+++ b/compiler/GHC/Tc/Utils/TcType.hs-boot
@@ -1,5 +1,5 @@
 module GHC.Tc.Utils.TcType where
-import Outputable( SDoc )
+import GHC.Utils.Outputable( SDoc )
 
 data MetaDetails
 
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index 6a4d61627bbbf40dc51d9301d7f736d6d3441972..7c14e5631967995d2114038e1a82167099396a0e 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -40,7 +40,7 @@ module GHC.Tc.Utils.Unify (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Core.TyCo.Rep
@@ -62,13 +62,13 @@ import GHC.Builtin.Types.Prim( tYPE )
 import GHC.Types.Var as Var
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import ErrUtils
+import GHC.Utils.Error
 import GHC.Driver.Session
 import GHC.Types.Basic
-import Bag
-import Util
+import GHC.Data.Bag
+import GHC.Utils.Misc
 import qualified GHC.LanguageExtensions as LangExt
-import Outputable
+import GHC.Utils.Outputable as Outputable
 
 import Data.Maybe( isNothing )
 import Control.Monad
diff --git a/compiler/GHC/Tc/Utils/Unify.hs-boot b/compiler/GHC/Tc/Utils/Unify.hs-boot
index a281bf136bed2dd0bb199e9b6e1e20692366d7af..36f33676344afe9fed5c8e1c20314c74bc63e120 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs-boot
+++ b/compiler/GHC/Tc/Utils/Unify.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Tc.Utils.Unify where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Tc.Utils.TcType   ( TcTauType )
 import GHC.Tc.Types          ( TcM )
 import GHC.Tc.Types.Evidence ( TcCoercion )
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 09caf5fefa3bca844b3d855a69d18c23fec27f25..8fbbba22b1d0fbddbfd78fcfeae8abdf79762897 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -46,7 +46,7 @@ module GHC.Tc.Utils.Zonk (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs
 import GHC.Types.Id
@@ -74,11 +74,11 @@ import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Platform
 import GHC.Types.Basic
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.SrcLoc
-import Bag
-import Outputable
-import Util
+import GHC.Data.Bag
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 import GHC.Types.Unique.FM
 import GHC.Core
 
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index c72d4cd357d8848e069f0fab73fc4a9dc179079c..7b9d1192bdedc41132d371c463fbb4d7fdf0e899 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -22,9 +22,9 @@ module GHC.Tc.Validity (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Maybes
+import GHC.Data.Maybe
 
 -- friends:
 import GHC.Tc.Utils.Unify    ( tcSubType_NC )
@@ -59,15 +59,15 @@ import GHC.Types.Name
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
 import GHC.Types.Var     ( VarBndr(..), mkTyVar )
-import FV
-import ErrUtils
+import GHC.Utils.FV
+import GHC.Utils.Error
 import GHC.Driver.Session
-import Util
-import ListSetOps
+import GHC.Utils.Misc
+import GHC.Data.List.SetOps
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable as Outputable
 import GHC.Types.Unique  ( mkAlphaTyVarUnique )
-import Bag               ( emptyBag )
+import GHC.Data.Bag      ( emptyBag )
 import qualified GHC.LanguageExtensions as LangExt
 
 import Control.Monad
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 622ab13403e2993a14d742c8f924c37c01e131df..aad08d862e9b814091f1bb2d657fd5f40f04101a 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -24,7 +24,7 @@ module GHC.ThToHs
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Hs as Hs
 import GHC.Builtin.Names
@@ -40,13 +40,13 @@ import GHC.Builtin.Types
 import GHC.Types.Basic as Hs
 import GHC.Types.ForeignCall
 import GHC.Types.Unique
-import ErrUtils
-import Bag
+import GHC.Utils.Error
+import GHC.Data.Bag
 import GHC.Utils.Lexeme
-import Util
-import FastString
-import Outputable
-import MonadUtils ( foldrM )
+import GHC.Utils.Misc
+import GHC.Data.FastString
+import GHC.Utils.Outputable as Outputable
+import GHC.Utils.Monad ( foldrM )
 
 import qualified Data.ByteString as BS
 import Control.Monad( unless, ap )
diff --git a/compiler/GHC/Types/Annotations.hs b/compiler/GHC/Types/Annotations.hs
index 4dde431ab5f39f0b5103a3715037eebfc63aee09..c096558651e5beb360ddf61907227d7fb038b024 100644
--- a/compiler/GHC/Types/Annotations.hs
+++ b/compiler/GHC/Types/Annotations.hs
@@ -17,16 +17,16 @@ module GHC.Types.Annotations (
         deserializeAnns
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Binary
+import GHC.Utils.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.Utils.Outputable
 import GHC.Serialized
 
 import Control.Monad
diff --git a/compiler/GHC/Types/Avail.hs b/compiler/GHC/Types/Avail.hs
index 8730ce2e886facbf8d44cc72b1e86694075eda28..bee35d939569120616065bb5ada327c0fd3575b9 100644
--- a/compiler/GHC/Types/Avail.hs
+++ b/compiler/GHC/Types/Avail.hs
@@ -28,17 +28,17 @@ module GHC.Types.Avail (
 
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 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 GHC.Utils.Binary
+import GHC.Data.List.SetOps
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 import Data.Data ( Data )
 import Data.List ( find )
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 103b1940a08797db59cdefd13d8b9773e067cc6b..bbffb143cc7e1942f3a94bac061178019a6c25c0 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -113,10 +113,10 @@ module GHC.Types.Basic (
         TypeOrKind(..), isTypeLevel, isKindLevel
    ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc ( Located,unLoc )
 import Data.Data hiding (Fixity, Prefix, Infix)
 import Data.Function (on)
diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs
index 5280d90d3179696b4249ccd41b9f7c84c24d510e..a8fb03cef73b6caa631a9995e0794a8ba93f8cc4 100644
--- a/compiler/GHC/Types/CostCentre.hs
+++ b/compiler/GHC/Types/CostCentre.hs
@@ -20,17 +20,17 @@ module GHC.Types.CostCentre (
         cmpCostCentre   -- used for removing dups in a list
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Binary
+import GHC.Utils.Binary
 import GHC.Types.Var
 import GHC.Types.Name
 import GHC.Types.Module
 import GHC.Types.Unique
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
-import FastString
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Misc
 import GHC.Types.CostCentre.State
 
 import Data.Data
diff --git a/compiler/GHC/Types/CostCentre/State.hs b/compiler/GHC/Types/CostCentre/State.hs
index 51c364f7768698efa521e36692c8fcc48b92b7f5..f53034d7001abc7ea36fd255b8d74cac83074e57 100644
--- a/compiler/GHC/Types/CostCentre/State.hs
+++ b/compiler/GHC/Types/CostCentre/State.hs
@@ -9,12 +9,12 @@ module GHC.Types.CostCentre.State
    )
 where
 
-import GhcPrelude
-import FastString
-import FastStringEnv
+import GHC.Prelude
+import GHC.Data.FastString
+import GHC.Data.FastString.Env
 
 import Data.Data
-import Binary
+import GHC.Utils.Binary
 
 -- | Per-module state for tracking cost centre indices.
 --
diff --git a/compiler/GHC/Types/Cpr.hs b/compiler/GHC/Types/Cpr.hs
index e19c86142e7d21709222c211645177f92d2498b9..403104b8adec1997fd8e6d5c592fe52720d65f84 100644
--- a/compiler/GHC/Types/Cpr.hs
+++ b/compiler/GHC/Types/Cpr.hs
@@ -8,11 +8,11 @@ module GHC.Types.Cpr (
     CprSig (..), topCprSig, mkCprSigForArity, mkCprSig, seqCprSig
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
-import Outputable
-import Binary
+import GHC.Utils.Outputable
+import GHC.Utils.Binary
 
 --
 -- * CprResult
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 0ecb1b0b72af0b3f92ee54fac4b7f002ac2b49e9..a382bda18d941a4bfd8860f8313e7b59685487ad 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -58,16 +58,16 @@ module GHC.Types.Demand (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Var ( Var )
 import GHC.Types.Var.Env
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Basic
-import Binary
-import Maybes           ( orElse )
+import GHC.Utils.Binary
+import GHC.Data.Maybe   ( orElse )
 
 import GHC.Core.Type    ( Type )
 import GHC.Core.TyCon   ( isNewTyCon, isClassTyCon )
diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs
index e73877b2929aded5a8d9fdd8ffee37526d95054a..a392af845e57ceebd83513eb3e9344e85a1bbc96 100644
--- a/compiler/GHC/Types/FieldLabel.hs
+++ b/compiler/GHC/Types/FieldLabel.hs
@@ -71,15 +71,15 @@ module GHC.Types.FieldLabel
    )
 where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Name.Occurrence
 import GHC.Types.Name
 
-import FastString
-import FastStringEnv
-import Outputable
-import Binary
+import GHC.Data.FastString
+import GHC.Data.FastString.Env
+import GHC.Utils.Outputable
+import GHC.Utils.Binary
 
 import Data.Data
 
diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs
index 46cdfd2af35d0697369afff7ee778b6c30c667b6..0ab67c7b35a76faa25c0e0fbd59d4d6632891aa6 100644
--- a/compiler/GHC/Types/ForeignCall.hs
+++ b/compiler/GHC/Types/ForeignCall.hs
@@ -18,11 +18,11 @@ module GHC.Types.ForeignCall (
         Header(..), CType(..),
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import FastString
-import Binary
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Binary
+import GHC.Utils.Outputable
 import GHC.Types.Module
 import GHC.Types.Basic ( SourceText, pprWithSourceText )
 
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index 713f1c62588cf980bbfc23a99e307410872c46b5..ebb762dacdb96ec4bee5fe77040f03c359234149 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -118,7 +118,7 @@ module GHC.Types.Id (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Driver.Session
 import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding,
@@ -146,13 +146,13 @@ import GHC.Types.Module
 import GHC.Core.Class
 import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
 import GHC.Types.ForeignCall
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.SrcLoc
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Unique.Supply
-import FastString
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Misc
 
 -- infixl so you can say (id `set` a `set` b)
 infixl  1 `setIdUnfolding`,
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index a0a3b94ca988c85c68ca8aee5fa7d2df45a07b15..0e7d2d1b5fa87abf877eadf8b2980f987738211e 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -84,7 +84,7 @@ module GHC.Types.Id.Info (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Core hiding( hasCoreUnfolding )
 import GHC.Core( hasCoreUnfolding )
@@ -99,11 +99,11 @@ import GHC.Core.TyCon
 import GHC.Core.PatSyn
 import GHC.Core.Type
 import GHC.Types.ForeignCall
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Module
 import GHC.Types.Demand
 import GHC.Types.Cpr
-import Util
+import GHC.Utils.Misc
 
 -- infixl so you can say (id `set` a `set` b)
 infixl  1 `setRuleInfo`,
diff --git a/compiler/GHC/Types/Id/Info.hs-boot b/compiler/GHC/Types/Id/Info.hs-boot
index c6912344aa9b7e417ec145484bf14eba673a7e89..1b0e130de32db78d01148a51bbee4aac47b5be0f 100644
--- a/compiler/GHC/Types/Id/Info.hs-boot
+++ b/compiler/GHC/Types/Id/Info.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Types.Id.Info where
-import GhcPrelude
-import Outputable
+import GHC.Prelude
+import GHC.Utils.Outputable
 data IdInfo
 data IdDetails
 
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index d9d137a13bc4c787efbfc918670d7b916ddfbaf0..df62ad5469f535110ef8d29e305338e100100d50 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -40,7 +40,7 @@ module GHC.Types.Id.Make (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
@@ -71,11 +71,11 @@ import GHC.Types.Unique
 import GHC.Types.Unique.Supply
 import GHC.Builtin.Names
 import GHC.Types.Basic       hiding ( SuccessFlag(..) )
-import Util
+import GHC.Utils.Misc
 import GHC.Driver.Session
-import Outputable
-import FastString
-import ListSetOps
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Data.List.SetOps
 import GHC.Types.Var (VarBndr(Bndr))
 import qualified GHC.LanguageExtensions as LangExt
 
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
index 9c1d08822d97f08c66697ab8d00219c3edaf7c6d..c31f6349db2efbb622deda648b1bc8bb1f711815 100644
--- a/compiler/GHC/Types/Literal.hs
+++ b/compiler/GHC/Types/Literal.hs
@@ -50,20 +50,20 @@ module GHC.Types.Literal
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Names
 import GHC.Core.Type
 import GHC.Core.TyCon
-import Outputable
-import FastString
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 import GHC.Types.Basic
-import Binary
+import GHC.Utils.Binary
 import GHC.Settings.Constants
 import GHC.Platform
 import GHC.Types.Unique.FM
-import Util
+import GHC.Utils.Misc
 
 import Data.ByteString (ByteString)
 import Data.Int
diff --git a/compiler/GHC/Types/Module.hs b/compiler/GHC/Types/Module.hs
index 80ae18684f886142e3eba131b92062f8ffc96107..76bc026ea3d1ce027aed33ae000a42e175ddda54 100644
--- a/compiler/GHC/Types/Module.hs
+++ b/compiler/GHC/Types/Module.hs
@@ -137,25 +137,25 @@ module GHC.Types.Module
         unitModuleSet
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.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 GHC.Data.FastString
+import GHC.Utils.Binary
+import GHC.Utils.Misc
 import Data.List (sortBy, sort)
 import Data.Ord
 import Data.Version
 import GHC.PackageDb
-import Fingerprint
+import GHC.Utils.Fingerprint
 
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS.Char8
-import Encoding
+import GHC.Utils.Encoding
 
 import qualified Text.ParserCombinators.ReadP as Parse
 import Text.ParserCombinators.ReadP (ReadP, (<++))
@@ -168,7 +168,7 @@ 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 qualified GHC.Data.FiniteMap as Map
 import System.FilePath
 
 import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
diff --git a/compiler/GHC/Types/Module.hs-boot b/compiler/GHC/Types/Module.hs-boot
index 77df64280fb03f26220199bd4fc50f21d56d9561..5d30a94f3209a5990b626f7b3dcdc39d2d8c3a3e 100644
--- a/compiler/GHC/Types/Module.hs-boot
+++ b/compiler/GHC/Types/Module.hs-boot
@@ -1,6 +1,6 @@
 module GHC.Types.Module where
 
-import GhcPrelude
+import GHC.Prelude
 
 data Module
 data ModuleName
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index 60aee23af87c7a2a831c1ab8840265fc2579c1ca..691a1981675755daac812204cf4e39be5cb0b3ae 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -79,7 +79,7 @@ module GHC.Types.Name (
         module GHC.Types.Name.Occurrence
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Core.TyCo.Rep( TyThing )
 
@@ -87,11 +87,11 @@ 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 GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Utils.Binary
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 
 import Control.DeepSeq
 import Data.Data
diff --git a/compiler/GHC/Types/Name.hs-boot b/compiler/GHC/Types/Name.hs-boot
index fdd2f62b8d88f129a5eaa151754b5c5130b50e32..331dbda5ed05ee6ac34c7df7acec93af11b599f8 100644
--- a/compiler/GHC/Types/Name.hs-boot
+++ b/compiler/GHC/Types/Name.hs-boot
@@ -1,5 +1,5 @@
 module GHC.Types.Name where
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 data Name
diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs
index 9cac5eadf12eca067d971cc7ed2ebf88b4c12939..2d81e048ad4dd40f13a666f3ea90aac214ce329b 100644
--- a/compiler/GHC/Types/Name/Cache.hs
+++ b/compiler/GHC/Types/Name/Cache.hs
@@ -10,14 +10,14 @@ module GHC.Types.Name.Cache
     , NameCache(..), OrigNameCache
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Unique.Supply
 import GHC.Builtin.Types
-import Util
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
 import GHC.Builtin.Names
 
 #include "HsVersions.h"
diff --git a/compiler/GHC/Types/Name/Env.hs b/compiler/GHC/Types/Name/Env.hs
index 25842ab3f1e1d589c84c0d8b8537c97193c863c7..500c58043da9ee6860d44714dbf6678015764683 100644
--- a/compiler/GHC/Types/Name/Env.hs
+++ b/compiler/GHC/Types/Name/Env.hs
@@ -37,13 +37,13 @@ module GHC.Types.Name.Env (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Digraph
+import GHC.Data.Graph.Directed
 import GHC.Types.Name
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
-import Maybes
+import GHC.Data.Maybe
 
 {-
 ************************************************************************
@@ -60,7 +60,7 @@ 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.
+in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
 -}
 
 depAnal :: forall node.
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index c54770be136c1673ec6c87bae6634afed7496105..4c5ac689f25f8776952cd9e11ee4f2e595b32fc0 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -101,17 +101,17 @@ module GHC.Types.Name.Occurrence (
         FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import FastString
-import FastStringEnv
-import Outputable
+import GHC.Data.FastString
+import GHC.Data.FastString.Env
+import GHC.Utils.Outputable
 import GHC.Utils.Lexeme
-import Binary
+import GHC.Utils.Binary
 import Control.DeepSeq
 import Data.Char
 import Data.Data
diff --git a/compiler/GHC/Types/Name/Occurrence.hs-boot b/compiler/GHC/Types/Name/Occurrence.hs-boot
index 212b58b8e6f45007e73e9ea0478739a1b37ad428..ef23bb13fb5b8560567b4d6359f91627d33210b0 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs-boot
+++ b/compiler/GHC/Types/Name/Occurrence.hs-boot
@@ -1,5 +1,5 @@
 module GHC.Types.Name.Occurrence where
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 data OccName
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 29c427d5f949b4c5fa79dfef587f349bbe907682..274e3a90ceb3510d4b06398ec9c773f069054262 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -70,21 +70,21 @@ module GHC.Types.Name.Reader (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Module
 import GHC.Types.Name
 import GHC.Types.Avail
 import GHC.Types.Name.Set
-import Maybes
+import GHC.Data.Maybe
 import GHC.Types.SrcLoc as SrcLoc
-import FastString
+import GHC.Data.FastString
 import GHC.Types.FieldLabel
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Set
-import Util
+import GHC.Utils.Misc
 import GHC.Types.Name.Env
 
 import Data.Data
diff --git a/compiler/GHC/Types/Name/Set.hs b/compiler/GHC/Types/Name/Set.hs
index 04a8f1effaa1b8ae4b63a220ffba60773964cfd0..c011bcbf23d0e69cd7cff026235425c41c1a9fe0 100644
--- a/compiler/GHC/Types/Name/Set.hs
+++ b/compiler/GHC/Types/Name/Set.hs
@@ -33,10 +33,10 @@ module GHC.Types.Name.Set (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Name
-import OrdList
+import GHC.Data.OrdList
 import GHC.Types.Unique.Set
 import Data.List (sortBy)
 
diff --git a/compiler/GHC/Types/Name/Shape.hs b/compiler/GHC/Types/Name/Shape.hs
index be89bf349cd7f758b71c5f17ad324230edb13725..c7bfd9815250280f2d5d810fa215f563eb935864 100644
--- a/compiler/GHC/Types/Name/Shape.hs
+++ b/compiler/GHC/Types/Name/Shape.hs
@@ -13,9 +13,9 @@ where
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Types
 import GHC.Types.Module
 import GHC.Types.Unique.FM
@@ -25,7 +25,7 @@ import GHC.Types.FieldLabel
 import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Tc.Utils.Monad
-import Util
+import GHC.Utils.Misc
 import GHC.Iface.Env
 
 import Control.Monad
diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs
index c1bcb314d368f19011f705165ce28df147e75384..b883fbb05a07dd5ab46265fdb73af085f4e1845f 100644
--- a/compiler/GHC/Types/RepType.hs
+++ b/compiler/GHC/Types/RepType.hs
@@ -23,17 +23,17 @@ module GHC.Types.RepType
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic (Arity, RepArity)
 import GHC.Core.DataCon
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Builtin.Names
 import GHC.Core.Coercion
 import GHC.Core.TyCon
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
-import Util
+import GHC.Utils.Misc
 import GHC.Builtin.Types.Prim
 import {-# SOURCE #-} GHC.Builtin.Types ( anyTypeOfKind )
 
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
index 9211104cb359b7a2f7991e90777d97f23f7ad10a..d61c942397754dbc2c9688df2b58a19b7d2d9b1a 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -106,12 +106,12 @@ module GHC.Types.SrcLoc (
 
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Util
-import Json
-import Outputable
-import FastString
+import GHC.Utils.Misc
+import GHC.Utils.Json
+import GHC.Utils.Outputable
+import GHC.Data.FastString
 
 import Control.DeepSeq
 import Control.Applicative (liftA2)
diff --git a/compiler/GHC/Types/Unique.hs b/compiler/GHC/Types/Unique.hs
index 574d630ca1df2602eb36466fded9a63d8f9351f8..fba286da3ff1dbed5351a8e4db8482af70ac86e8 100644
--- a/compiler/GHC/Types/Unique.hs
+++ b/compiler/GHC/Types/Unique.hs
@@ -75,12 +75,12 @@ module GHC.Types.Unique (
 #include "HsVersions.h"
 #include "Unique.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Basic
-import FastString
-import Outputable
-import Util
+import GHC.Data.FastString
+import GHC.Utils.Outputable
+import GHC.Utils.Misc
 
 -- just for implementing a fast [0,61) -> Char function
 import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
diff --git a/compiler/GHC/Types/Unique/DFM.hs b/compiler/GHC/Types/Unique/DFM.hs
index 21e2f8249b7c6119f09815321f27dbaff789efd4..8d79626c1993955ec17d1886e5edebc07e4e20c3 100644
--- a/compiler/GHC/Types/Unique/DFM.hs
+++ b/compiler/GHC/Types/Unique/DFM.hs
@@ -61,10 +61,10 @@ module GHC.Types.Unique.DFM (
         alwaysUnsafeUfmToUdfm,
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique ( Uniquable(..), Unique, getKey )
-import Outputable
+import GHC.Utils.Outputable
 
 import qualified Data.IntMap as M
 import Data.Data
diff --git a/compiler/GHC/Types/Unique/DSet.hs b/compiler/GHC/Types/Unique/DSet.hs
index 32d32536dfc041c836748fa127b8e3076a4bc1a1..149f40e06fa1a206639b519a2518deb41329e66b 100644
--- a/compiler/GHC/Types/Unique/DSet.hs
+++ b/compiler/GHC/Types/Unique/DSet.hs
@@ -37,9 +37,9 @@ module GHC.Types.Unique.DSet (
         mapUniqDSet
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.Unique.DFM
 import GHC.Types.Unique.Set
 import GHC.Types.Unique
diff --git a/compiler/GHC/Types/Unique/FM.hs b/compiler/GHC/Types/Unique/FM.hs
index 01ab645783084c6832d85323cf8d38c12442666d..4dedf468da889cc01a2d31f74501458718764b8f 100644
--- a/compiler/GHC/Types/Unique/FM.hs
+++ b/compiler/GHC/Types/Unique/FM.hs
@@ -71,10 +71,10 @@ module GHC.Types.Unique.FM (
         pprUniqFM, pprUFM, pprUFMWithKeys, pluralUFM
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique ( Uniquable(..), Unique, getKey )
-import Outputable
+import GHC.Utils.Outputable
 
 import qualified Data.IntMap as M
 import qualified Data.IntSet as S
diff --git a/compiler/GHC/Types/Unique/Set.hs b/compiler/GHC/Types/Unique/Set.hs
index 1c52a66732ec2d8155e0e34e29f47d8749c5c447..24f8a40e9b75de08e54e360882f609450a135a83 100644
--- a/compiler/GHC/Types/Unique/Set.hs
+++ b/compiler/GHC/Types/Unique/Set.hs
@@ -46,12 +46,12 @@ module GHC.Types.Unique.Set (
         nonDetFoldUniqSet_Directly
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique.FM
 import GHC.Types.Unique
 import Data.Coerce
-import Outputable
+import GHC.Utils.Outputable
 import Data.Data
 import qualified Data.Semigroup as Semi
 
diff --git a/compiler/GHC/Types/Unique/Supply.hs b/compiler/GHC/Types/Unique/Supply.hs
index 403b88917e9e515998297b1ed19e80adb1274e12..bf4e6dd9333fe3f9ba0a937dc32f3382649f2078 100644
--- a/compiler/GHC/Types/Unique/Supply.hs
+++ b/compiler/GHC/Types/Unique/Supply.hs
@@ -33,14 +33,14 @@ module GHC.Types.Unique.Supply (
         initUniqSupply
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Unique
-import PlainPanic (panic)
+import GHC.Utils.Panic.Plain (panic)
 
 import GHC.IO
 
-import MonadUtils
+import GHC.Utils.Monad
 import Control.Monad
 import Data.Bits
 import Data.Char
diff --git a/compiler/GHC/Types/Var.hs b/compiler/GHC/Types/Var.hs
index 0f91cfd08c215085dd37672486629a595b072a87..1479856fb42909283f97f4a3f2307c9467f6e0a3 100644
--- a/compiler/GHC/Types/Var.hs
+++ b/compiler/GHC/Types/Var.hs
@@ -89,7 +89,7 @@ module GHC.Types.Var (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.Core.TyCo.Rep( Type, Kind )
 import {-# SOURCE #-}   GHC.Core.TyCo.Ppr( pprKind )
@@ -100,9 +100,9 @@ import {-# SOURCE #-}   GHC.Types.Id.Info( IdDetails, IdInfo, coVarDetails, isCo
 import GHC.Types.Name hiding (varName)
 import GHC.Types.Unique ( Uniquable, Unique, getKey, getUnique
                         , mkUniqueGrimily, nonDetCmpUnique )
-import Util
-import Binary
-import Outputable
+import GHC.Utils.Misc
+import GHC.Utils.Binary
+import GHC.Utils.Outputable
 
 import Data.Data
 
diff --git a/compiler/GHC/Types/Var.hs-boot b/compiler/GHC/Types/Var.hs-boot
index bf83f8cda6e20ee3efa1c2c0273cf4999430a418..6ea03efd91b6283722a2c1537ebb0edd4fffae59 100644
--- a/compiler/GHC/Types/Var.hs-boot
+++ b/compiler/GHC/Types/Var.hs-boot
@@ -1,12 +1,12 @@
 module GHC.Types.Var where
 
-import GhcPrelude ()
+import GHC.Prelude ()
   -- 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 this module depends on GHC.Prelude, which ensures
   -- that GHC.Type is built first.
 
 data ArgFlag
diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs
index fff3dc897de03fcaf2dd12ccca705f70e6fe968b..883d5bbeca5dc6734613a41f6c5b902d8d649588 100644
--- a/compiler/GHC/Types/Var/Env.hs
+++ b/compiler/GHC/Types/Var/Env.hs
@@ -74,7 +74,7 @@ module GHC.Types.Var.Env (
         emptyTidyEnv, mkEmptyTidyEnv, delTidyEnvList
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 import qualified Data.IntMap.Strict as IntMap -- TODO: Move this to UniqFM
 
 import GHC.Types.Name.Occurrence
@@ -85,9 +85,9 @@ 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
+import GHC.Utils.Misc
+import GHC.Data.Maybe
+import GHC.Utils.Outputable
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Types/Var/Set.hs b/compiler/GHC/Types/Var/Set.hs
index 5126988a2cd117990706b2e6ff99d06ca38a9fe6..5f1ea2e6c4c858ae386805e021439479d400e743 100644
--- a/compiler/GHC/Types/Var/Set.hs
+++ b/compiler/GHC/Types/Var/Set.hs
@@ -46,7 +46,7 @@ module GHC.Types.Var.Set (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var      ( Var, TyVar, CoVar, TyCoVar, Id )
 import GHC.Types.Unique
@@ -55,7 +55,7 @@ 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)
+import GHC.Utils.Outputable (SDoc)
 
 -- | A non-deterministic Variable Set
 --
diff --git a/compiler/main/UnitInfo.hs b/compiler/GHC/Unit/Info.hs
similarity index 98%
rename from compiler/main/UnitInfo.hs
rename to compiler/GHC/Unit/Info.hs
index 3fda0b79e85f2763dfb24ebbd4623cb7af05fcce..7248d84620802bc63d07edc40e8e3757f43a4248 100644
--- a/compiler/main/UnitInfo.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -6,7 +6,7 @@
 --
 -- (c) The University of Glasgow, 2004
 --
-module UnitInfo (
+module GHC.Unit.Info (
         -- $package_naming
 
         -- * UnitId
@@ -30,13 +30,13 @@ module UnitInfo (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.PackageDb
 import Data.Version
 
-import FastString
-import Outputable
+import GHC.Data.FastString
+import GHC.Utils.Outputable
 import GHC.Types.Module as Module
 import GHC.Types.Unique
 
diff --git a/compiler/utils/AsmUtils.hs b/compiler/GHC/Utils/Asm.hs
similarity index 88%
rename from compiler/utils/AsmUtils.hs
rename to compiler/GHC/Utils/Asm.hs
index d3393d71e25eedb49399be2771247c7d81a89763..5b8b209f5ea9f3b75b8a8c1fdafc02807e6534fd 100644
--- a/compiler/utils/AsmUtils.hs
+++ b/compiler/GHC/Utils/Asm.hs
@@ -2,14 +2,14 @@
 --
 -- These are used not only by the native code generator, but also by the
 -- GHC.Driver.Pipeline
-module AsmUtils
+module GHC.Utils.Asm
     ( sectionType
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Platform
-import Outputable
+import GHC.Utils.Outputable
 
 -- | Generate a section type (e.g. @\@progbits@). See #13937.
 sectionType :: Platform -- ^ Target platform
diff --git a/compiler/utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
similarity index 99%
rename from compiler/utils/Binary.hs
rename to compiler/GHC/Utils/Binary.hs
index 529519df1d89c5afe695eb97dd373168be915b87..1283dd5ffb1b1d184f0eeb95531f9bb1d4d2540c 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -21,7 +21,7 @@
 -- where you can obtain the original version of the Binary library, namely
 --     http://www.cs.york.ac.uk/fp/nhc98/
 
-module Binary
+module GHC.Utils.Binary
   ( {-type-}  Bin,
     {-class-} Binary(..),
     {-type-}  BinHandle,
@@ -64,14 +64,14 @@ module Binary
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-} GHC.Types.Name (Name)
-import FastString
-import PlainPanic
+import GHC.Data.FastString
+import GHC.Utils.Panic.Plain
 import GHC.Types.Unique.FM
-import FastMutInt
-import Fingerprint
+import GHC.Data.FastMutInt
+import GHC.Utils.Fingerprint
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
 
@@ -719,7 +719,7 @@ architecture specific details.
 We still use this scheme even with LEB128 available,
 as it has less overhead for truly large numbers. (> maxBound :: Int64)
 
-The instance is used for in Binary Integer and Binary Rational in basicTypes/Literal.hs
+The instance is used for in Binary Integer and Binary Rational in GHC.Types.Literal
 -}
 
 instance Binary Integer where
diff --git a/compiler/utils/BufWrite.hs b/compiler/GHC/Utils/BufHandle.hs
similarity index 96%
rename from compiler/utils/BufWrite.hs
rename to compiler/GHC/Utils/BufHandle.hs
index 8a28f470f4ff24bceffe23a70d066dc7baa3d37e..b0b829f96f762acc714d39f49b870dae6d49554f 100644
--- a/compiler/utils/BufWrite.hs
+++ b/compiler/GHC/Utils/BufHandle.hs
@@ -8,11 +8,11 @@
 --
 -- This is a simple abstraction over Handles that offers very fast write
 -- buffering, but without the thread safety that Handles provide.  It's used
--- to save time in Pretty.printDoc.
+-- to save time in GHC.Utils.Ppr.printDoc.
 --
 -----------------------------------------------------------------------------
 
-module BufWrite (
+module GHC.Utils.BufHandle (
         BufHandle(..),
         newBufHandle,
         bPutChar,
@@ -24,10 +24,10 @@ module BufWrite (
         bFlush,
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import FastString
-import FastMutInt
+import GHC.Data.FastString
+import GHC.Data.FastMutInt
 
 import Control.Monad    ( when )
 import Data.ByteString (ByteString)
diff --git a/compiler/main/CliOption.hs b/compiler/GHC/Utils/CliOption.hs
similarity index 95%
rename from compiler/main/CliOption.hs
rename to compiler/GHC/Utils/CliOption.hs
index d42c5b490031c89b0ed87b8cf0fa93565182f7e0..9f2333d3517abd9480bc4c459bf7e8848c899abc 100644
--- a/compiler/main/CliOption.hs
+++ b/compiler/GHC/Utils/CliOption.hs
@@ -1,9 +1,9 @@
-module CliOption
+module GHC.Utils.CliOption
   ( Option (..)
   , showOpt
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 -- -----------------------------------------------------------------------------
 -- Command-line options
diff --git a/compiler/utils/Encoding.hs b/compiler/GHC/Utils/Encoding.hs
similarity index 99%
rename from compiler/utils/Encoding.hs
rename to compiler/GHC/Utils/Encoding.hs
index b4af68621d3d9666d9288b9a2cf3e590c568829c..165aa05e5be2a0bfed0b25b168995fb68f3d387b 100644
--- a/compiler/utils/Encoding.hs
+++ b/compiler/GHC/Utils/Encoding.hs
@@ -11,7 +11,7 @@
 --
 -- -----------------------------------------------------------------------------
 
-module Encoding (
+module GHC.Utils.Encoding (
         -- * UTF-8
         utf8DecodeChar#,
         utf8PrevChar,
@@ -33,7 +33,7 @@ module Encoding (
         toBase62Padded
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Foreign
 import Foreign.ForeignPtr.Unsafe
diff --git a/compiler/main/ErrUtils.hs b/compiler/GHC/Utils/Error.hs
similarity index 99%
rename from compiler/main/ErrUtils.hs
rename to compiler/GHC/Utils/Error.hs
index 2a4168302b8c10c50393af8a16e941017211d45c..4b3683465a8c9d35d4447e415285881886e48d57 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -10,7 +10,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE LambdaCase #-}
 
-module ErrUtils (
+module GHC.Utils.Error (
         -- * Basic types
         Validity(..), andValid, allValid, isValid, getInvalids, orValid,
         Severity(..),
@@ -64,18 +64,18 @@ module ErrUtils (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Bag
-import Exception
-import Outputable
-import Panic
-import qualified PprColour as Col
+import GHC.Data.Bag
+import GHC.Utils.Exception
+import GHC.Utils.Outputable as Outputable
+import GHC.Utils.Panic
+import qualified GHC.Utils.Ppr.Colour as Col
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Driver.Session
-import FastString (unpackFS)
-import StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
-import Json
+import GHC.Data.FastString (unpackFS)
+import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
+import GHC.Utils.Json
 
 import System.Directory
 import System.Exit      ( ExitCode(..), exitWith )
diff --git a/compiler/main/ErrUtils.hs-boot b/compiler/GHC/Utils/Error.hs-boot
similarity index 89%
rename from compiler/main/ErrUtils.hs-boot
rename to compiler/GHC/Utils/Error.hs-boot
index f7f8b12f807961072e42ba13deca7b7e488ea663..20c6930fa55bc77acdabcbb510ef5898bbd45386 100644
--- a/compiler/main/ErrUtils.hs-boot
+++ b/compiler/GHC/Utils/Error.hs-boot
@@ -1,11 +1,11 @@
 {-# LANGUAGE RankNTypes #-}
 
-module ErrUtils where
+module GHC.Utils.Error where
 
-import GhcPrelude
-import Outputable (SDoc, PprStyle )
+import GHC.Prelude
+import GHC.Utils.Outputable (SDoc, PprStyle )
 import GHC.Types.SrcLoc (SrcSpan)
-import Json
+import GHC.Utils.Json
 import {-# SOURCE #-} GHC.Driver.Session ( DynFlags )
 
 type DumpAction = DynFlags -> PprStyle -> DumpOptions -> String
diff --git a/compiler/utils/Exception.hs b/compiler/GHC/Utils/Exception.hs
similarity index 97%
rename from compiler/utils/Exception.hs
rename to compiler/GHC/Utils/Exception.hs
index 9d9b3ae25ca4990dbf7a83d5b57e587bfd9433ea..e84221cdbe6d76da410d6aa98d840b0253f7f1d2 100644
--- a/compiler/utils/Exception.hs
+++ b/compiler/GHC/Utils/Exception.hs
@@ -1,12 +1,12 @@
 {-# OPTIONS_GHC -fno-warn-deprecations #-}
-module Exception
+module GHC.Utils.Exception
     (
     module Control.Exception,
-    module Exception
+    module GHC.Utils.Exception
     )
     where
 
-import GhcPrelude
+import GHC.Prelude
 
 import Control.Exception
 import Control.Monad.IO.Class
diff --git a/compiler/utils/FV.hs b/compiler/GHC/Utils/FV.hs
similarity index 98%
rename from compiler/utils/FV.hs
rename to compiler/GHC/Utils/FV.hs
index f0a35d4100f31466dafbd14d6f15f5f841b32323..167cf7fe0218735fb6cd7e53e59680ea9b736256 100644
--- a/compiler/utils/FV.hs
+++ b/compiler/GHC/Utils/FV.hs
@@ -1,13 +1,12 @@
 {-
 (c) Bartosz Nitka, Facebook 2015
 
-Utilities for efficiently and deterministically computing free variables.
-
 -}
 
 {-# LANGUAGE BangPatterns #-}
 
-module FV (
+-- | Utilities for efficiently and deterministically computing free variables.
+module GHC.Utils.FV (
         -- * Deterministic free vars computations
         FV, InterestingVarFun,
 
@@ -26,7 +25,7 @@ module FV (
         mapUnionFV,
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import GHC.Types.Var
 import GHC.Types.Var.Set
diff --git a/compiler/utils/Fingerprint.hs b/compiler/GHC/Utils/Fingerprint.hs
similarity index 96%
rename from compiler/utils/Fingerprint.hs
rename to compiler/GHC/Utils/Fingerprint.hs
index 21f6a93c770790c0ec25bb35e6a637bba37c78c6..b8c20911352e7fbe6f71fc6a02f0a2fe6ab9f4cb 100644
--- a/compiler/utils/Fingerprint.hs
+++ b/compiler/GHC/Utils/Fingerprint.hs
@@ -11,7 +11,7 @@
 --
 -- ----------------------------------------------------------------------------
 
-module Fingerprint (
+module GHC.Utils.Fingerprint (
         readHexFingerprint,
         fingerprintByteString,
         -- * Re-exported from GHC.Fingerprint
@@ -24,7 +24,7 @@ module Fingerprint (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
 import Foreign
 import GHC.IO
diff --git a/compiler/utils/FastFunctions.hs b/compiler/GHC/Utils/IO/Unsafe.hs
similarity index 80%
rename from compiler/utils/FastFunctions.hs
rename to compiler/GHC/Utils/IO/Unsafe.hs
index 9a09bb7b76a3e0e0c15de15cd67cd9d3c0c8a1ca..27efe373f74aa2410b7f95eab4940cda70536fbc 100644
--- a/compiler/utils/FastFunctions.hs
+++ b/compiler/GHC/Utils/IO/Unsafe.hs
@@ -4,13 +4,14 @@
 
 {-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
 
-module FastFunctions (
-    inlinePerformIO,
-  ) where
+module GHC.Utils.IO.Unsafe
+   ( inlinePerformIO,
+   )
+where
 
 #include "HsVersions.h"
 
-import GhcPrelude ()
+import GHC.Prelude ()
 
 import GHC.Exts
 import GHC.IO   (IO(..))
diff --git a/compiler/utils/Json.hs b/compiler/GHC/Utils/Json.hs
similarity index 95%
rename from compiler/utils/Json.hs
rename to compiler/GHC/Utils/Json.hs
index 2bf00d385121aad7d0f2c04125ae58ccaeaa8bdb..21358847c0538f67b333e4077b69421e1773c351 100644
--- a/compiler/utils/Json.hs
+++ b/compiler/GHC/Utils/Json.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE GADTs #-}
-module Json where
+module GHC.Utils.Json where
 
-import GhcPrelude
+import GHC.Prelude
 
-import Outputable
+import GHC.Utils.Outputable
 import Data.Char
 import Numeric
 
diff --git a/compiler/GHC/Utils/Lexeme.hs b/compiler/GHC/Utils/Lexeme.hs
index 44bdbf0895b9476525b92abb070f3880c4c0422b..6df962a54b3bb4d6155ec2d7224f9da6e4767f3f 100644
--- a/compiler/GHC/Utils/Lexeme.hs
+++ b/compiler/GHC/Utils/Lexeme.hs
@@ -27,9 +27,9 @@ module GHC.Utils.Lexeme (
 
   ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import FastString
+import GHC.Data.FastString
 
 import Data.Char
 import qualified Data.Set as Set
diff --git a/compiler/utils/Util.hs b/compiler/GHC/Utils/Misc.hs
similarity index 99%
rename from compiler/utils/Util.hs
rename to compiler/GHC/Utils/Misc.hs
index b343d9cf8b186985ceb929efacead0bf4bbfc653..b191507fcaba860f3958a9ac47157d5289b78a08 100644
--- a/compiler/utils/Util.hs
+++ b/compiler/GHC/Utils/Misc.hs
@@ -10,7 +10,7 @@
 
 -- | Highly random utility functions
 --
-module Util (
+module GHC.Utils.Misc (
         -- * Flags dependent on the compiler build
         ghciSupported, debugIsOn,
         isWindowsHost, isDarwinHost,
@@ -131,10 +131,10 @@ module Util (
 
 #include "HsVersions.h"
 
-import GhcPrelude
+import GHC.Prelude
 
-import Exception
-import PlainPanic
+import GHC.Utils.Exception
+import GHC.Utils.Panic.Plain
 
 import Data.Data
 import Data.IORef       ( IORef, newIORef, atomicModifyIORef' )
@@ -166,7 +166,7 @@ import qualified Data.Set as Set
 import Data.Time
 
 #if defined(DEBUG)
-import {-# SOURCE #-} Outputable ( warnPprTrace, text )
+import {-# SOURCE #-} GHC.Utils.Outputable ( warnPprTrace, text )
 #endif
 
 infixr 9 `thenCmp`
diff --git a/compiler/utils/MonadUtils.hs b/compiler/GHC/Utils/Monad.hs
similarity index 99%
rename from compiler/utils/MonadUtils.hs
rename to compiler/GHC/Utils/Monad.hs
index 50e53b98c86973f2eac8aa81fa9089ad9238e1a7..9e53edd0bbfd56599c57d56c6a3bb46b2f7fdda6 100644
--- a/compiler/utils/MonadUtils.hs
+++ b/compiler/GHC/Utils/Monad.hs
@@ -1,7 +1,7 @@
 -- | Utilities related to Monad and Applicative classes
 --   Mostly for backwards compatibility.
 
-module MonadUtils
+module GHC.Utils.Monad
         ( Applicative(..)
         , (<$>)
 
@@ -26,7 +26,7 @@ module MonadUtils
 -- Imports
 -------------------------------------------------------------------------------
 
-import GhcPrelude
+import GHC.Prelude
 
 import Control.Applicative
 import Control.Monad
diff --git a/compiler/utils/State.hs b/compiler/GHC/Utils/Monad/State.hs
similarity index 95%
rename from compiler/utils/State.hs
rename to compiler/GHC/Utils/Monad/State.hs
index 92269e91e76bc85646897a685df5ae4124df7f02..c7b9e3f5910055e8c0fee33b226acbde49efbdd5 100644
--- a/compiler/utils/State.hs
+++ b/compiler/GHC/Utils/Monad/State.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE UnboxedTuples #-}
 
-module State where
+module GHC.Utils.Monad.State where
 
-import GhcPrelude
+import GHC.Prelude
 
 newtype State s a = State { runState' :: s -> (# a, s #) }
     deriving (Functor)
diff --git a/compiler/utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
similarity index 99%
rename from compiler/utils/Outputable.hs
rename to compiler/GHC/Utils/Outputable.hs
index d36faa47245cdb3393dce2113e5c8d77b3f5bfed..178ac5881829f2c560f37be6df4e90499f60e11f 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -11,7 +11,7 @@
 -- The interface to this module is very similar to the standard Hughes-PJ pretty printing
 -- module, except that it exports a number of additional functions that are rarely used,
 -- and works over the 'SDoc' type.
-module Outputable (
+module GHC.Utils.Outputable (
         -- * Type classes
         Outputable(..), OutputableBndr(..),
 
@@ -92,7 +92,7 @@ module Outputable (
         pprDebugAndThen, callStackDoc,
     ) where
 
-import GhcPrelude
+import GHC.Prelude
 
 import {-# SOURCE #-}   GHC.Driver.Session
                            ( DynFlags, hasPprDebug, hasNoDebugOutput
@@ -102,13 +102,13 @@ import {-# SOURCE #-}   GHC.Driver.Session
 import {-# SOURCE #-}   GHC.Types.Module( UnitId, Module, ModuleName, moduleName )
 import {-# SOURCE #-}   GHC.Types.Name.Occurrence( OccName )
 
-import BufWrite (BufHandle)
-import FastString
-import qualified Pretty
-import Util
-import qualified PprColour as Col
-import Pretty           ( Doc, Mode(..) )
-import Panic
+import GHC.Utils.BufHandle (BufHandle)
+import GHC.Data.FastString
+import qualified GHC.Utils.Ppr as Pretty
+import GHC.Utils.Misc
+import qualified GHC.Utils.Ppr.Colour as Col
+import GHC.Utils.Ppr       ( Doc, Mode(..) )
+import GHC.Utils.Panic
 import GHC.Serialized
 import GHC.LanguageExtensions (Extension)
 
@@ -135,7 +135,7 @@ import GHC.Fingerprint
 import GHC.Show         ( showMultiLineString )
 import GHC.Stack        ( callStack, prettyCallStack )
 import Control.Monad.IO.Class
-import Exception
+import GHC.Utils.Exception
 
 {-
 ************************************************************************
@@ -617,7 +617,7 @@ integer n   = docToSDoc $ Pretty.integer n
 float n     = docToSDoc $ Pretty.float n
 double n    = docToSDoc $ Pretty.double n
 rational n  = docToSDoc $ Pretty.rational n
-              -- See Note [Print Hexadecimal Literals] in Pretty.hs
+              -- See Note [Print Hexadecimal Literals] in GHC.Utils.Ppr
 word n      = sdocOption sdocHexWordLiterals $ \case
                True  -> docToSDoc $ Pretty.hex n
                False -> docToSDoc $ Pretty.integer n
diff --git a/compiler/utils/Outputable.hs-boot b/compiler/GHC/Utils/Outputable.hs-boot
similarity index 79%
rename from compiler/utils/Outputable.hs-boot
rename to compiler/GHC/Utils/Outputable.hs-boot
index 77e0982826d3e5dbfc09794d57180b3cdade45f7..dee3d2039c5e44164a191b7c6648f76b007f2c28 100644
--- a/compiler/utils/Outputable.hs-boot
+++ b/compiler/GHC/Utils/Outputable.hs-boot
@@ -1,6 +1,6 @@
-module Outputable where
+module GHC.Utils.Outputable where
 
-import GhcPrelude
+import GHC.Prelude
 import GHC.Stack( HasCallStack )
 
 data SDoc
diff --git a/compiler/utils/Panic.hs b/compiler/GHC/Utils/Panic.hs
similarity index 95%
rename from compiler/utils/Panic.hs
rename to compiler/GHC/Utils/Panic.hs
index 16f493826cc59d6673e9f3aa9285ac63c9a47c26..48695e25d42f2c1cf5102586f539ca934796ad8a 100644
--- a/compiler/utils/Panic.hs
+++ b/compiler/GHC/Utils/Panic.hs
@@ -2,19 +2,19 @@
 (c) The University of Glasgow 2006
 (c) The GRASP Project, Glasgow University, 1992-2000
 
-Defines basic functions for printing error messages.
-
-It's hard to put these functions anywhere else without causing
-some unnecessary loops in the module dependency graph.
 -}
 
 {-# LANGUAGE CPP, ScopedTypeVariables, LambdaCase #-}
 
-module Panic (
+-- | Defines basic functions for printing error messages.
+--
+-- It's hard to put these functions anywhere else without causing
+-- some unnecessary loops in the module dependency graph.
+module GHC.Utils.Panic (
      GhcException(..), showGhcException,
      throwGhcException, throwGhcExceptionIO,
      handleGhcException,
-     PlainPanic.progName,
+     GHC.Utils.Panic.Plain.progName,
      pgmError,
 
      panic, sorry, assertPanic, trace,
@@ -28,12 +28,12 @@ module Panic (
      withSignalHandlers,
 ) where
 
-import GhcPrelude
+import GHC.Prelude
 
-import {-# SOURCE #-} Outputable (SDoc, showSDocUnsafe)
-import PlainPanic
+import {-# SOURCE #-} GHC.Utils.Outputable (SDoc, showSDocUnsafe)
+import GHC.Utils.Panic.Plain
 
-import Exception
+import GHC.Utils.Exception as Exception
 
 import Control.Monad.IO.Class
 import Control.Concurrent
diff --git a/compiler/utils/PlainPanic.hs b/compiler/GHC/Utils/Panic/Plain.hs
similarity index 98%
rename from compiler/utils/PlainPanic.hs
rename to compiler/GHC/Utils/Panic/Plain.hs
index 0892ebff7df74f3ae3081a082a2ea55e1d7f1bf2..37e0574d4b0adb5f2900cc46416258bac6632c46 100644
--- a/compiler/utils/PlainPanic.hs
+++ b/compiler/GHC/Utils/Panic/Plain.hs
@@ -14,7 +14,7 @@
 --
 -- 2. To reduce the number of modules that need to be compiled to
 -- object code when loading GHC into GHCi. See #13101
-module PlainPanic
+module GHC.Utils.Panic.Plain
   ( PlainGhcException(..)
   , showPlainGhcException
 
@@ -28,9 +28,9 @@ module PlainPanic
 #include "HsVersions.h"
 
 import Config
-import Exception
+import GHC.Utils.Exception as Exception
 import GHC.Stack
-import GhcPrelude
+import GHC.Prelude
 import System.Environment
 import System.IO.Unsafe
 
diff --git a/compiler/utils/Pretty.hs b/compiler/GHC/Utils/Ppr.hs
similarity index 99%
rename from compiler/utils/Pretty.hs
rename to compiler/GHC/Utils/Ppr.hs
index 5adfdd76997b144a7542c409c07eab637e42718d..559088e4155e458ecfe117d2971f257e02d756db 100644
--- a/compiler/utils/Pretty.hs
+++ b/compiler/GHC/Utils/Ppr.hs
@@ -3,7 +3,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  Pretty
+-- Module      :  GHC.Utils.Ppr
 -- Copyright   :  (c) The University of Glasgow 2001
 -- License     :  BSD-style (see the file LICENSE)
 --
@@ -63,7 +63,7 @@ allocation in the compiler (see thomie's comments in
 https://github.com/haskell/pretty/pull/9).
 -}
 
-module Pretty (
+module GHC.Utils.Ppr (
 
         -- * The document type
         Doc, TextDetails(..),
@@ -111,11 +111,11 @@ module Pretty (
 
   ) where
 
-import GhcPrelude hiding (error)
+import GHC.Prelude hiding (error)
 
-import BufWrite
-import FastString
-import PlainPanic
+import GHC.Utils.BufHandle
+import GHC.Data.FastString
+import GHC.Utils.Panic.Plain
 import System.IO
 import Numeric (showHex)
 
diff --git a/compiler/utils/PprColour.hs b/compiler/GHC/Utils/Ppr/Colour.hs
similarity index 96%
rename from compiler/utils/PprColour.hs
rename to compiler/GHC/Utils/Ppr/Colour.hs
index f32b8b00847ff4401f71707e439bbf42cbba63da..7283edd1821879ee551e43568ca78b806a4e6a18 100644
--- a/compiler/utils/PprColour.hs
+++ b/compiler/GHC/Utils/Ppr/Colour.hs
@@ -1,8 +1,8 @@
-module PprColour where
-import GhcPrelude
+module GHC.Utils.Ppr.Colour where
+import GHC.Prelude
 
 import Data.Maybe (fromMaybe)
-import Util (OverridingBool(..), split)
+import GHC.Utils.Misc (OverridingBool(..), split)
 import Data.Semigroup as Semi
 
 -- | A colour\/style for use with 'coloured'.
diff --git a/compiler/HsVersions.h b/compiler/HsVersions.h
index c46d5c897ffb42372ad2d41f6b6109ad7eaa93c9..3f9f28df2148b1549007e74190867efe063bec4e 100644
--- a/compiler/HsVersions.h
+++ b/compiler/HsVersions.h
@@ -15,25 +15,25 @@ you will screw up the layout where they are used in case expressions!
 #define GLOBAL_VAR(name,value,ty)  \
 {-# NOINLINE name #-};             \
 name :: IORef (ty);                \
-name = Util.global (value);
+name = GHC.Utils.Misc.global (value);
 
 #define GLOBAL_VAR_M(name,value,ty) \
 {-# NOINLINE name #-};              \
 name :: IORef (ty);                 \
-name = Util.globalM (value);
+name = GHC.Utils.Misc.globalM (value);
 
 
 #define SHARED_GLOBAL_VAR(name,accessor,saccessor,value,ty) \
 {-# NOINLINE name #-};                                      \
 name :: IORef (ty);                                         \
-name = Util.sharedGlobal (value) (accessor);                \
+name = GHC.Utils.Misc.sharedGlobal (value) (accessor);      \
 foreign import ccall unsafe saccessor                       \
   accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
 
 #define SHARED_GLOBAL_VAR_M(name,accessor,saccessor,value,ty)  \
 {-# NOINLINE name #-};                                         \
 name :: IORef (ty);                                            \
-name = Util.sharedGlobalM (value) (accessor);                  \
+name = GHC.Utils.Misc.sharedGlobalM (value) (accessor);        \
 foreign import ccall unsafe saccessor                          \
   accessor :: Ptr (IORef a) -> IO (Ptr (IORef a));
 
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index c1c4b6dc24931a114f849006b3e6dfc3024d81e6..5cc0b3af314985859a6731121ae44e5c959b19aa 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -136,7 +136,7 @@ Library
         UnboxedTuples
         UndecidableInstances
 
-    Include-Dirs: . utils
+    Include-Dirs: .
 
     -- We need to set the unit id to ghc (without a version number)
     -- as it's magic.
@@ -160,8 +160,6 @@ Library
 
     hs-source-dirs:
         .
-        main
-        utils
 
     -- we use an explicit Prelude
     Default-Extensions:
@@ -180,7 +178,7 @@ Library
         GHC.Types.Name.Shape
         GHC.Iface.Rename
         GHC.Types.Avail
-        AsmUtils
+        GHC.Utils.Asm
         GHC.Types.Basic
         GHC.Core.ConLike
         GHC.Core.DataCon
@@ -188,7 +186,7 @@ Library
         GHC.Types.Demand
         GHC.Types.Cpr
         GHC.Cmm.DebugBlock
-        Exception
+        GHC.Utils.Exception
         GHC.Types.FieldLabel
         GHC.Driver.Monad
         GHC.Driver.Hooks
@@ -222,11 +220,11 @@ Library
         GHC.Types.SrcLoc
         GHC.Types.Unique.Supply
         GHC.Types.Unique
-        UpdateCafInfos
+        GHC.Iface.UpdateCafInfos
         GHC.Types.Var
         GHC.Types.Var.Env
         GHC.Types.Var.Set
-        UnVarGraph
+        GHC.Data.Graph.UnVar
         GHC.Cmm.BlockId
         GHC.Cmm.CLabel
         GHC.Cmm
@@ -252,8 +250,8 @@ Library
         GHC.Cmm.Type
         GHC.Cmm.Utils
         GHC.Cmm.LayoutStack
-        CliOption
-        EnumSet
+        GHC.Utils.CliOption
+        GHC.Data.EnumSet
         GHC.Cmm.Graph
         GHC.CmmToAsm.Ppr
         GHC.CmmToAsm.Config
@@ -296,7 +294,7 @@ Library
         GHC.Core.Subst
         GHC.Core.SimpleOpt
         GHC.Core
-        TrieMap
+        GHC.Data.TrieMap
         GHC.Core.Tidy
         GHC.Core.Unfold
         GHC.Core.Utils
@@ -360,26 +358,26 @@ Library
         GHC.Driver.Pipeline.Monad
         GHC.Driver.Pipeline
         GHC.Driver.Session
-        ErrUtils
+        GHC.Utils.Error
         GHC.Driver.Finder
         GHC
         GHC.Driver.Make
         GHC.Plugins
-        GhcPrelude
+        GHC.Prelude
         GHC.Parser.Header
         GHC.Driver.Main
-        HscStats
+        GHC.Hs.Stats
         GHC.Driver.Types
         GHC.Runtime.Eval
         GHC.Runtime.Eval.Types
         GHC.Runtime.Loader
-        UnitInfo
+        GHC.Unit.Info
         GHC.Driver.Packages
         GHC.Driver.Plugins
         GHC.Tc.Plugin
         GHC.Core.Ppr.TyThing
         GHC.Settings
-        StaticPtrTable
+        GHC.Iface.Tidy.StaticPtrTable
         GHC.SysTools
         GHC.SysTools.BaseDir
         GHC.SysTools.Terminal
@@ -523,43 +521,43 @@ Library
         GHC.Core.TyCo.Ppr
         GHC.Core.TyCo.Tidy
         GHC.Core.Unify
-        Bag
-        Binary
-        BooleanFormula
-        BufWrite
-        Digraph
-        Encoding
-        FastFunctions
-        FastMutInt
-        FastString
-        FastStringEnv
-        Fingerprint
-        FiniteMap
-        FV
-        GraphBase
-        GraphColor
-        GraphOps
-        GraphPpr
-        IOEnv
-        Json
-        ListSetOps
-        Maybes
-        MonadUtils
-        OrdList
-        Outputable
-        Pair
-        Panic
-        PlainPanic
-        PprColour
-        Pretty
-        State
-        Stream
-        StringBuffer
+        GHC.Data.Bag
+        GHC.Utils.Binary
+        GHC.Data.BooleanFormula
+        GHC.Utils.BufHandle
+        GHC.Data.Graph.Directed
+        GHC.Utils.Encoding
+        GHC.Utils.IO.Unsafe
+        GHC.Data.FastMutInt
+        GHC.Data.FastString
+        GHC.Data.FastString.Env
+        GHC.Utils.Fingerprint
+        GHC.Data.FiniteMap
+        GHC.Utils.FV
+        GHC.Data.Graph.Base
+        GHC.Data.Graph.Color
+        GHC.Data.Graph.Ops
+        GHC.Data.Graph.Ppr
+        GHC.Data.IOEnv
+        GHC.Utils.Json
+        GHC.Data.List.SetOps
+        GHC.Data.Maybe
+        GHC.Utils.Monad
+        GHC.Data.OrdList
+        GHC.Utils.Outputable
+        GHC.Data.Pair
+        GHC.Utils.Panic
+        GHC.Utils.Panic.Plain
+        GHC.Utils.Ppr.Colour
+        GHC.Utils.Ppr
+        GHC.Utils.Monad.State
+        GHC.Data.Stream
+        GHC.Data.StringBuffer
         GHC.Types.Unique.DFM
         GHC.Types.Unique.DSet
         GHC.Types.Unique.FM
         GHC.Types.Unique.Set
-        Util
+        GHC.Utils.Misc
         GHC.Cmm.Dataflow
         GHC.Cmm.Dataflow.Block
         GHC.Cmm.Dataflow.Collections
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index d86aae9771b15d9cfdbaa36f071b76fb44c5c2ae..e5351b95db0efa38636243bf6e567fc5d8076979 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -76,7 +76,7 @@ compiler/stage$1/build/Config.hs : mk/config.mk mk/project.mk | $$$$(dir $$$$@)/
 	@echo '  , cStage'                                                  >> $$@
 	@echo '  ) where'                                                   >> $$@
 	@echo                                                               >> $$@
-	@echo 'import GhcPrelude'                                           >> $$@
+	@echo 'import GHC.Prelude'                                          >> $$@
 	@echo                                                               >> $$@
 	@echo 'import GHC.Version'                                          >> $$@
 	@echo                                                               >> $$@
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
index 5dcd9ab80dfd8233407b41520102103d1c17b397..e6a11cb9af3f7f4f25fe096882b007a2778ecac4 100644
--- a/ghc/GHCi/Leak.hs
+++ b/ghc/GHCi/Leak.hs
@@ -12,7 +12,7 @@ import GHC
 import GHC.Ptr (Ptr (..))
 import GHCi.Util
 import GHC.Driver.Types
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Platform (target32Bit)
 import Prelude
 import System.Mem
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 87826438e34ff954c119b7777473a93f28a25f30..46fe4fb4a538fbed7dedda45cc88d2ccd2292dcf 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -41,7 +41,7 @@ import GHC.Runtime.Interpreter.Types
 import GHCi.RemoteTypes
 import GHCi.BreakArray
 import GHC.Driver.Session as DynFlags
-import ErrUtils hiding (traceCmd)
+import GHC.Utils.Error hiding (traceCmd)
 import GHC.Driver.Finder as Finder
 import GHC.Driver.Monad ( modifySession )
 import qualified GHC
@@ -66,24 +66,24 @@ import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrNam
 import GHC.Types.SrcLoc as SrcLoc
 import qualified GHC.Parser.Lexer as Lexer
 
-import StringBuffer
-import Outputable hiding ( printForUser, printForUserPartWay )
+import GHC.Data.StringBuffer
+import GHC.Utils.Outputable hiding ( printForUser, printForUserPartWay )
 
 import GHC.Runtime.Loader ( initializePlugins )
 
 -- Other random utilities
 import GHC.Types.Basic hiding ( isTopLevel )
 import Config
-import Digraph
-import Encoding
-import FastString
+import GHC.Data.Graph.Directed
+import GHC.Utils.Encoding
+import GHC.Data.FastString
 import GHC.Runtime.Linker
-import Maybes ( orElse, expectJust )
+import GHC.Data.Maybe ( orElse, expectJust )
 import GHC.Types.Name.Set
-import Panic hiding ( showException )
-import Util
+import GHC.Utils.Panic hiding ( showException )
+import GHC.Utils.Misc
 import qualified GHC.LanguageExtensions as LangExt
-import Bag (unitBag)
+import GHC.Data.Bag (unitBag)
 
 -- Haskell Libraries
 import System.Console.Haskeline as Haskeline
@@ -112,7 +112,7 @@ import Data.Time.Format ( formatTime, defaultTimeLocale )
 import Data.Version ( showVersion )
 import Prelude hiding ((<>))
 
-import Exception hiding (catch)
+import GHC.Utils.Exception as Exception hiding (catch)
 import Foreign hiding (void)
 import GHC.Stack hiding (SrcLoc(..))
 
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index f5df1edc38b8c34b6bcc78384fe5f6f04cebbce9..22eb66485664a5cecae75eca7dfc5cf8491799dd 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -34,12 +34,12 @@ import           System.Directory
 import qualified GHC.Core.Utils
 import           GHC.HsToCore
 import           GHC.Driver.Session (HasDynFlags(..))
-import           FastString
+import           GHC.Data.FastString
 import           GHC
 import           GHC.Driver.Monad
 import           GHC.Types.Name
 import           GHC.Types.Name.Set
-import           Outputable
+import           GHC.Utils.Outputable
 import           GHC.Types.SrcLoc
 import           GHC.Tc.Utils.Zonk
 import           GHC.Types.Var
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 27e31b6cf62c967d7702e3854368f7f2fd4413b4..fb6d673fff0206347b0805f0fb402f21faa0ecd5 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -38,11 +38,11 @@ module GHCi.UI.Monad (
 import GHCi.UI.Info (ModInfo)
 import qualified GHC
 import GHC.Driver.Monad hiding (liftIO)
-import Outputable       hiding (printForUser, printForUserPartWay)
-import qualified Outputable
+import GHC.Utils.Outputable       hiding (printForUser, printForUserPartWay)
+import qualified GHC.Utils.Outputable as Outputable
 import GHC.Types.Name.Occurrence
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Driver.Types
 import GHC.Types.SrcLoc
 import GHC.Types.Module
@@ -52,9 +52,9 @@ import GHC.Runtime.Interpreter
 import GHCi.RemoteTypes
 import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
 import GHC.Hs.Utils
-import Util
+import GHC.Utils.Misc
 
-import Exception hiding (uninterruptibleMask, mask, catch)
+import GHC.Utils.Exception hiding (uninterruptibleMask, mask, catch)
 import Numeric
 import Data.Array
 import Data.IORef
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index 155a63bf5a6a1b6c40f7e57db00410d1f8a150ff..9f4dfa6e5365aeb610f36016fdfbf9b415dc9fa5 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -13,17 +13,17 @@ module GHCi.UI.Tags (
   createETagsFileCmd
 ) where
 
-import Exception
+import GHC.Utils.Exception
 import GHC
 import GHCi.UI.Monad
-import Outputable
+import GHC.Utils.Outputable
 
 -- ToDo: figure out whether we need these, and put something appropriate
 -- into the GHC API instead
 import GHC.Types.Name (nameOccName)
 import GHC.Types.Name.Occurrence (pprOccName)
 import GHC.Core.ConLike
-import MonadUtils
+import GHC.Utils.Monad
 
 import Control.Monad
 import Data.Function
@@ -31,7 +31,7 @@ import Data.List
 import Data.Maybe
 import Data.Ord
 import GHC.Driver.Phases
-import Panic
+import GHC.Utils.Panic
 import Prelude
 import System.Directory
 import System.IO
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 7a356b920ae6ecc58e3a432135e14ffc0d0c1166..a4cd897ab41ead934c326c17e49ddb199086a389 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -53,23 +53,23 @@ import GHC.Driver.Packages ( pprPackages, pprPackagesSimple )
 import GHC.Driver.Phases
 import GHC.Types.Basic     ( failed )
 import GHC.Driver.Session hiding (WarnReason(..))
-import ErrUtils
-import FastString
-import Outputable
+import GHC.Utils.Error
+import GHC.Data.FastString
+import GHC.Utils.Outputable as Outputable
 import GHC.SysTools.BaseDir
 import GHC.Settings.IO
 import GHC.Types.SrcLoc
-import Util
-import Panic
+import GHC.Utils.Misc
+import GHC.Utils.Panic
 import GHC.Types.Unique.Supply
-import MonadUtils       ( liftIO )
+import GHC.Utils.Monad       ( liftIO )
 
 -- Imports for --abi-hash
-import GHC.Iface.Load      ( loadUserInterface )
-import GHC.Driver.Finder   ( findImportedModule, cannotFindModule )
-import GHC.Tc.Utils.Monad        ( initIfaceCheck )
-import Binary              ( openBinMem, put_ )
-import GHC.Iface.Recomp.Binary      ( fingerprintBinMem )
+import GHC.Iface.Load          ( loadUserInterface )
+import GHC.Driver.Finder       ( findImportedModule, cannotFindModule )
+import GHC.Tc.Utils.Monad      ( initIfaceCheck )
+import GHC.Utils.Binary        ( openBinMem, put_ )
+import GHC.Iface.Recomp.Binary ( fingerprintBinMem )
 
 -- Standard Haskell libraries
 import System.IO
@@ -786,7 +786,7 @@ showInfo dflags = do
         let sq x = " [" ++ x ++ "\n ]"
         putStrLn $ sq $ intercalate "\n ," $ map show $ compilerInfo dflags
 
--- TODO use ErrUtils once that is disentangled from all the other GhcMonad stuff?
+-- TODO use GHC.Utils.Error once that is disentangled from all the other GhcMonad stuff?
 showSupportedExtensions :: Maybe String -> IO ()
 showSupportedExtensions m_top_dir = do
   res <- runExceptT $ do
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index 51afdf8724d0d893ff6aa4c3caa6f48c1b07fb89..b332713222c002246ad45e8dee7aeaa0651b6a94 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -355,7 +355,7 @@ generateConfigHs = do
         , "  , cStage"
         , "  ) where"
         , ""
-        , "import GhcPrelude"
+        , "import GHC.Prelude"
         , ""
         , "import GHC.Version"
         , ""
diff --git a/includes/CodeGen.Platform.hs b/includes/CodeGen.Platform.hs
index 6070dfcbd55fce7b4c013a6625ef1adc98f86142..c8f4ee1c690a82f91d4edc65c25937c378f38bde 100644
--- a/includes/CodeGen.Platform.hs
+++ b/includes/CodeGen.Platform.hs
@@ -2,7 +2,7 @@
 import GHC.Cmm.Expr
 #if !(defined(MACHREGS_i386) || defined(MACHREGS_x86_64) \
     || defined(MACHREGS_sparc) || defined(MACHREGS_powerpc))
-import PlainPanic
+import GHC.Utils.Panic.Plain
 #endif
 import GHC.Platform.Reg
 
diff --git a/testsuite/tests/annotations/should_run/annrun01.hs b/testsuite/tests/annotations/should_run/annrun01.hs
index 4a587afddc907684329de22f9533ba0f1f32f200..a18f662ebba0df3881675c0d64b6d2d9612f2edb 100644
--- a/testsuite/tests/annotations/should_run/annrun01.hs
+++ b/testsuite/tests/annotations/should_run/annrun01.hs
@@ -3,12 +3,12 @@
 module Main where
 
 import GHC
-import MonadUtils  ( liftIO )
+import GHC.Utils.Monad  ( liftIO )
 import Data.Maybe
 import GHC.Driver.Session    ( defaultFatalMessager, defaultFlushOut )
 import GHC.Types.Annotations ( AnnTarget(..), CoreAnnTarget )
 import GHC.Serialized  ( deserializeWithData )
-import Panic
+import GHC.Utils.Panic
 
 import Config
 import Annrun01_Help
diff --git a/testsuite/tests/callarity/unittest/CallArity1.hs b/testsuite/tests/callarity/unittest/CallArity1.hs
index 5a3820fd34c7a51bcbb63c3379398376d33ef3c1..60cb97835fcff0fadea6471efa46eb5de8bdda61 100644
--- a/testsuite/tests/callarity/unittest/CallArity1.hs
+++ b/testsuite/tests/callarity/unittest/CallArity1.hs
@@ -8,8 +8,8 @@ import GHC.Core.Opt.CallArity (callArityRHS)
 import GHC.Types.Id.Make
 import GHC.SysTools
 import GHC.Driver.Session
-import ErrUtils
-import Outputable
+import GHC.Utils.Error
+import GHC.Utils.Outputable as Outputable
 import GHC.Builtin.Types
 import GHC.Types.Literal
 import GHC
@@ -21,7 +21,7 @@ import GHC.Core.Ppr
 import GHC.Types.Unique
 import GHC.Types.Unique.Set
 import GHC.Core.Lint
-import FastString
+import GHC.Data.FastString
 
 -- Build IDs. use mkTemplateLocal, more predictable than proper uniques
 go, go2, x, d, n, y, z, scrutf, scruta :: Id
diff --git a/testsuite/tests/concurrent/prog001/Arithmetic.hs b/testsuite/tests/concurrent/prog001/Arithmetic.hs
index bce3ff6400afbd25bf13321e9340bd03f5aa6816..183b66c0ed78bb6a9600390696e6c1a114c12295 100644
--- a/testsuite/tests/concurrent/prog001/Arithmetic.hs
+++ b/testsuite/tests/concurrent/prog001/Arithmetic.hs
@@ -5,7 +5,7 @@ import Control.Concurrent.MVar
 import System.IO.Unsafe
 import Utilities
 import Converter
-import Stream
+import GHC.Data.Stream
 import Data.Ratio
 import Trit
 
diff --git a/testsuite/tests/concurrent/prog001/Converter.hs b/testsuite/tests/concurrent/prog001/Converter.hs
index cba86e0cfd4a7c54531f79780546c738df2acbb1..ba4132dc432ac4b30451d12e45907e9cc613edea 100644
--- a/testsuite/tests/concurrent/prog001/Converter.hs
+++ b/testsuite/tests/concurrent/prog001/Converter.hs
@@ -1,7 +1,7 @@
 
 module Converter (rationalToGray, grayToSignIO, signToGray, Gray, startF, startC) where
 
-import Stream
+import GHC.Data.Stream
 import Data.Ratio
 import Control.Concurrent
 import Control.Concurrent.MVar
diff --git a/testsuite/tests/concurrent/prog001/Thread.hs b/testsuite/tests/concurrent/prog001/Thread.hs
index 12886a84563d7d8815f70a12e6c52f315824d859..18799607a1a6dc0add6372bab114bebc60ab23d3 100644
--- a/testsuite/tests/concurrent/prog001/Thread.hs
+++ b/testsuite/tests/concurrent/prog001/Thread.hs
@@ -3,7 +3,7 @@ module Thread (threadTesting1) where
 
 import Control.Concurrent
 import Control.Concurrent.MVar
-import Stream
+import GHC.Data.Stream
 import Converter
 
 threadTesting1 :: Gray -> Gray -> IO Int
diff --git a/testsuite/tests/concurrent/prog001/Trit.hs b/testsuite/tests/concurrent/prog001/Trit.hs
index 8674d6510bd177d10f5ee24860ad5b0757eb34b7..f81bc8bf210128b5a078f3b3af917db55b8ffc84 100644
--- a/testsuite/tests/concurrent/prog001/Trit.hs
+++ b/testsuite/tests/concurrent/prog001/Trit.hs
@@ -2,7 +2,7 @@ module Trit (Trit, rationalToTrit, getIntegral, getFraction, getFraction',
                 neg, addTrits, subTrits, shiftLeft, shiftRight, multiply
                 ) where
 
-import Stream
+import GHC.Data.Stream
 import Utilities
 import Data.Ratio
 
diff --git a/testsuite/tests/concurrent/prog001/Utilities.hs b/testsuite/tests/concurrent/prog001/Utilities.hs
index 0ebdb3db9caa854491fd27e3782fe02bdb3d363e..faa15d8f8cf28ab7a9d1cd9453ef8448f6784b9a 100644
--- a/testsuite/tests/concurrent/prog001/Utilities.hs
+++ b/testsuite/tests/concurrent/prog001/Utilities.hs
@@ -1,6 +1,6 @@
 module Utilities (toBinary, fl) where
 
-import Stream
+import GHC.Data.Stream
 import Data.Ratio
 
 -- Convert from an Integer to its signed-digit representation
diff --git a/testsuite/tests/determinism/determ001/determinism001.hs b/testsuite/tests/determinism/determ001/determinism001.hs
index 6de1e673d0b3bfa23b21ca3b1cfdd4a7dea93931..283beaf0988ae29bb4f4fbe019b1f4e174002590 100644
--- a/testsuite/tests/determinism/determ001/determinism001.hs
+++ b/testsuite/tests/determinism/determ001/determinism001.hs
@@ -1,6 +1,6 @@
 module Main where
 
-import Digraph
+import GHC.Data.Graph.Directed
 
 main = mapM_ print
   [ test001
diff --git a/testsuite/tests/ghc-api/T10942.hs b/testsuite/tests/ghc-api/T10942.hs
index 359875167647c118a59188330fa6bf189ae66368..a6cee0fd7f7e3882788995a709c6c2789c814354 100644
--- a/testsuite/tests/ghc-api/T10942.hs
+++ b/testsuite/tests/ghc-api/T10942.hs
@@ -6,8 +6,8 @@ import GHC
 import Control.Monad.IO.Class (liftIO)
 import System.Environment
 import GHC.Parser.Header
-import Outputable
-import StringBuffer
+import GHC.Utils.Outputable
+import GHC.Data.StringBuffer
 
 main :: IO ()
 main = do
diff --git a/testsuite/tests/ghc-api/T11579.hs b/testsuite/tests/ghc-api/T11579.hs
index 9e45410d2e5a1b65c8f25e8fecb906dd5170ed4d..7ea08c92162967fd70569138594b0e50bc69aae1 100644
--- a/testsuite/tests/ghc-api/T11579.hs
+++ b/testsuite/tests/ghc-api/T11579.hs
@@ -1,8 +1,8 @@
 import System.Environment
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC
-import StringBuffer
+import GHC.Data.StringBuffer
 import GHC.Parser.Lexer
 import GHC.Types.SrcLoc
 
diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs
index 9c897f7e10d504eb94ead95a0bc70f743ba8730c..4da3acba186c113a075ecd5900fbebd22057cca4 100644
--- a/testsuite/tests/ghc-api/T4891/T4891.hs
+++ b/testsuite/tests/ghc-api/T4891/T4891.hs
@@ -19,8 +19,8 @@ import GHC.Types.Name (getOccString)
 import Unsafe.Coerce
 import Control.Monad
 import Data.Maybe
-import Bag
-import Outputable
+import GHC.Data.Bag
+import GHC.Utils.Outputable
 import GHC.Driver.Monad
 import X
 
diff --git a/testsuite/tests/ghc-api/T6145.hs b/testsuite/tests/ghc-api/T6145.hs
index 56538e11d6b6b2090e2b71e2adf45fc4bb32b83f..7c56320ff3161e4990cfff75dda449fd63fc4beb 100644
--- a/testsuite/tests/ghc-api/T6145.hs
+++ b/testsuite/tests/ghc-api/T6145.hs
@@ -6,9 +6,9 @@ module Main where
 
 import System.IO
 import GHC
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 
diff --git a/testsuite/tests/ghc-api/T7478/T7478.hs b/testsuite/tests/ghc-api/T7478/T7478.hs
index 4aa6f7d29e13690ad020b74bd11abf86d5662447..ae8bb82e88b94631d34326e833977a961a3d3028 100644
--- a/testsuite/tests/ghc-api/T7478/T7478.hs
+++ b/testsuite/tests/ghc-api/T7478/T7478.hs
@@ -7,9 +7,9 @@ import System.Environment
 
 import GHC
 import qualified Config as GHC
-import qualified Outputable as GHC
+import qualified GHC.Utils.Outputable as GHC
 import GHC.Driver.Monad (liftIO)
-import Outputable (PprStyle, queryQual)
+import GHC.Utils.Outputable (PprStyle, queryQual)
 
 compileInGhc :: [FilePath]          -- ^ Targets
              -> (String -> IO ())   -- ^ handler for each SevOutput message
diff --git a/testsuite/tests/ghc-api/T8628.hs b/testsuite/tests/ghc-api/T8628.hs
index a7cbdaa07c21e25e74b994313aad8a07f12993fe..9e8fd84fcbff6ea58bb92ea2609581a2b2556f35 100644
--- a/testsuite/tests/ghc-api/T8628.hs
+++ b/testsuite/tests/ghc-api/T8628.hs
@@ -3,12 +3,12 @@ module Main where
 import System.IO
 import GHC.Driver.Session
 import GHC
-import Exception
+import GHC.Utils.Exception
 import GHC.Types.Module
-import FastString
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Data.FastString
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import GHC.Builtin.Names
diff --git a/testsuite/tests/ghc-api/T8639_api.hs b/testsuite/tests/ghc-api/T8639_api.hs
index eab7ff9146e912c34b404a7490c4d42dd5d73a13..48024f672618cf9b72e95e82910cacb0e6156fa2 100644
--- a/testsuite/tests/ghc-api/T8639_api.hs
+++ b/testsuite/tests/ghc-api/T8639_api.hs
@@ -2,7 +2,7 @@ module Main where
 
 import GHC
 import GHC.Driver.Monad
-import Outputable
+import GHC.Utils.Outputable
 import System.IO
 import System.Environment( getArgs )
 
diff --git a/testsuite/tests/ghc-api/T9595.hs b/testsuite/tests/ghc-api/T9595.hs
index 808fd8e79c63225808edb71295217d5c989252ec..0080ae9bc5fd776c25eeac2cfff05229368fbf4a 100644
--- a/testsuite/tests/ghc-api/T9595.hs
+++ b/testsuite/tests/ghc-api/T9595.hs
@@ -3,7 +3,7 @@ module Main where
 import GHC
 import GHC.Driver.Packages
 import GHC.Driver.Monad
-import Outputable
+import GHC.Utils.Outputable
 import System.Environment
 import GHC.Driver.Session
 import GHC.Types.Module
@@ -14,7 +14,7 @@ main =
                 dflags <- getSessionDynFlags
                 setSessionDynFlags dflags
                 dflags <- getSessionDynFlags
-                liftIO $ print (mkModuleName "Outputable" `elem` listVisibleModuleNames dflags)
+                liftIO $ print (mkModuleName "GHC.Utils.Outputable" `elem` listVisibleModuleNames dflags)
      _ <- runGhc (Just libdir) $ do
                 dflags <- getSessionDynFlags
                 setSessionDynFlags (dflags {
@@ -23,5 +23,5 @@ main =
                                                   (ModRenaming True [])]
                     })
                 dflags <- getSessionDynFlags
-                liftIO $ print (mkModuleName "Outputable" `elem` listVisibleModuleNames dflags)
+                liftIO $ print (mkModuleName "GHC.Utils.Outputable" `elem` listVisibleModuleNames dflags)
      return ()
diff --git a/testsuite/tests/ghc-api/annotations-literals/literals.hs b/testsuite/tests/ghc-api/annotations-literals/literals.hs
index c125ea6e431ebf274ab5c23256b27aeb973e6280..64c0311c071c88295de9e6df4c4cd6aa9af09e44 100644
--- a/testsuite/tests/ghc-api/annotations-literals/literals.hs
+++ b/testsuite/tests/ghc-api/annotations-literals/literals.hs
@@ -8,9 +8,9 @@ import Data.List (intercalate)
 import System.IO
 import GHC
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations-literals/parsed.hs b/testsuite/tests/ghc-api/annotations-literals/parsed.hs
index 56add861ad124680f3f92f04ca4b865d9e932357..620bf0451e5c277e57126040bc6742629bdbe68f 100644
--- a/testsuite/tests/ghc-api/annotations-literals/parsed.hs
+++ b/testsuite/tests/ghc-api/annotations-literals/parsed.hs
@@ -9,9 +9,9 @@ import Data.List (intercalate)
 import System.IO
 import GHC
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations/CheckUtils.hs b/testsuite/tests/ghc-api/annotations/CheckUtils.hs
index 275067ac8a4dcc33c10f97ebde399a0d5ca8ded6..3f79f48e2862208169e6584c0122372cbf802372 100644
--- a/testsuite/tests/ghc-api/annotations/CheckUtils.hs
+++ b/testsuite/tests/ghc-api/annotations/CheckUtils.hs
@@ -10,10 +10,10 @@ import System.IO
 import GHC
 import GHC.Types.Basic
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Parser.Annotation
-import Bag (filterBag,isEmptyBag)
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations/annotations.hs b/testsuite/tests/ghc-api/annotations/annotations.hs
index d9157511aa42883eecf382ad742f509f7e962461..8347b57ffcf33f030e1b28137bbf123f2defab7f 100644
--- a/testsuite/tests/ghc-api/annotations/annotations.hs
+++ b/testsuite/tests/ghc-api/annotations/annotations.hs
@@ -10,9 +10,9 @@ import Data.List (intercalate)
 import System.IO
 import GHC
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations/comments.hs b/testsuite/tests/ghc-api/annotations/comments.hs
index 60d30426b1847af86e9d0a743b556f0ab3f558b5..4da8cbda54e2211bd1c48d5c054fa5f8e977387e 100644
--- a/testsuite/tests/ghc-api/annotations/comments.hs
+++ b/testsuite/tests/ghc-api/annotations/comments.hs
@@ -10,9 +10,9 @@ import Data.List (intercalate)
 import System.IO
 import GHC
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations/listcomps.hs b/testsuite/tests/ghc-api/annotations/listcomps.hs
index cd5eb86927c2eed0610da1d7b49f3decc179b9cf..ddc0b7ec7f6793bb5348a393dad69c91a26f0100 100644
--- a/testsuite/tests/ghc-api/annotations/listcomps.hs
+++ b/testsuite/tests/ghc-api/annotations/listcomps.hs
@@ -11,10 +11,10 @@ import System.IO
 import GHC
 import GHC.Types.Basic
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Parser.Annotation
-import Bag (filterBag,isEmptyBag)
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import System.Exit
diff --git a/testsuite/tests/ghc-api/annotations/parseTree.hs b/testsuite/tests/ghc-api/annotations/parseTree.hs
index af2aeb6cb5b6c885230419589cea78f44889e565..9c167787be4268a360f4f09cc72107cee89f6222 100644
--- a/testsuite/tests/ghc-api/annotations/parseTree.hs
+++ b/testsuite/tests/ghc-api/annotations/parseTree.hs
@@ -11,9 +11,9 @@ import System.IO
 import GHC
 import GHC.Types.Basic
 import GHC.Driver.Session
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations/stringSource.hs b/testsuite/tests/ghc-api/annotations/stringSource.hs
index b3b4c85ccae42a03ef6ff555a29a662b09ed190b..776aebd048f154dd2e5b7bd7fab317fd1e0a7b4a 100644
--- a/testsuite/tests/ghc-api/annotations/stringSource.hs
+++ b/testsuite/tests/ghc-api/annotations/stringSource.hs
@@ -13,12 +13,12 @@ import System.IO
 import GHC
 import GHC.Types.Basic
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.ForeignCall
-import MonadUtils
-import Outputable
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Hs.Decls
-import Bag (filterBag,isEmptyBag)
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/annotations/t11430.hs b/testsuite/tests/ghc-api/annotations/t11430.hs
index aa51c4118e2542c121ec8a029ecb75a3d39d3440..d8be3d10439cdab5538a74bf8358fe2ffebdfffe 100644
--- a/testsuite/tests/ghc-api/annotations/t11430.hs
+++ b/testsuite/tests/ghc-api/annotations/t11430.hs
@@ -13,12 +13,12 @@ import System.IO
 import GHC
 import GHC.Types.Basic
 import GHC.Driver.Session
-import FastString
+import GHC.Data.FastString
 import GHC.Types.ForeignCall
-import MonadUtils
-import Outputable
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
 import GHC.Hs.Decls
-import Bag (filterBag,isEmptyBag)
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 import qualified Data.Map as Map
diff --git a/testsuite/tests/ghc-api/apirecomp001/myghc.hs b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
index 8c6f7b867bc6ea6033012c49d6f6fd848977ecb4..0b65d5add6c17f1893ebfa56028286c9fc04bf3c 100644
--- a/testsuite/tests/ghc-api/apirecomp001/myghc.hs
+++ b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
@@ -11,9 +11,9 @@ module Main where
 
 import GHC
 import GHC.Driver.Session
-import MonadUtils ( MonadIO(..) )
+import GHC.Utils.Monad ( MonadIO(..) )
 import GHC.Types.Basic ( failed )
-import Bag        ( bagToList )
+import GHC.Data.Bag        ( bagToList )
 import System.Environment
 import Control.Monad
 import System.IO
diff --git a/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
index df6a2b63f663bfcc9447493219c728334228a270..b0c6ce2761caea90e0ef606121eba872b27bb147 100644
--- a/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
+++ b/testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
@@ -6,9 +6,9 @@
 import GHC
 import GHC.Driver.Make
 import GHC.Driver.Session
-import Outputable
-import Exception (ExceptionMonad, ghandle)
-import Bag
+import GHC.Utils.Outputable
+import GHC.Utils.Exception (ExceptionMonad, ghandle)
+import GHC.Data.Bag
 
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
diff --git a/testsuite/tests/ghc-api/dynCompileExpr/dynCompileExpr.hs b/testsuite/tests/ghc-api/dynCompileExpr/dynCompileExpr.hs
index 9cdd3f0b7db4ad55caf113730184b4032576cc4c..dd2b6383e2ae095ed84e3d5e03e02f284a0076f4 100644
--- a/testsuite/tests/ghc-api/dynCompileExpr/dynCompileExpr.hs
+++ b/testsuite/tests/ghc-api/dynCompileExpr/dynCompileExpr.hs
@@ -2,7 +2,7 @@
 module Main where
 
 import GHC
-import MonadUtils
+import GHC.Utils.Monad
 
 import System.Environment
 
diff --git a/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs b/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs
index 9a2993f7a8db054b3aafe690d65a28ade968c054..01b0bc1a8f22a5c559f71681ac6e52d5c215dc59 100644
--- a/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs
+++ b/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs
@@ -3,11 +3,11 @@ module Main where
 import Data.Data
 import System.IO
 import GHC
-import FastString
+import GHC.Data.FastString
 import GHC.Types.SrcLoc
-import MonadUtils
-import Outputable
-import Bag (filterBag,isEmptyBag)
+import GHC.Utils.Monad
+import GHC.Utils.Outputable
+import GHC.Data.Bag (filterBag,isEmptyBag)
 import System.Directory (removeFile)
 import System.Environment( getArgs )
 
diff --git a/testsuite/tests/ghc-api/target-contents/TargetContents.hs b/testsuite/tests/ghc-api/target-contents/TargetContents.hs
index f71d1131e37291837a5474b08e40aee0e625cd33..a5ef99105fe0f82a18ef52d6193f1d55c607797d 100644
--- a/testsuite/tests/ghc-api/target-contents/TargetContents.hs
+++ b/testsuite/tests/ghc-api/target-contents/TargetContents.hs
@@ -11,11 +11,11 @@ import Data.List (intercalate)
 import Data.Maybe
 import Data.Time.Calendar
 import Data.Time.Clock
-import Exception
+import GHC.Utils.Exception
 import GHC.Parser.Header
 import GHC.Driver.Types
-import Outputable
-import StringBuffer
+import GHC.Utils.Outputable
+import GHC.Data.StringBuffer
 import System.Directory
 import System.Environment
 import System.Process
diff --git a/testsuite/tests/ghci/linking/dyn/T3372.hs b/testsuite/tests/ghci/linking/dyn/T3372.hs
index 49b71488c2b39f3fb39c6f8bcf9b99bca6346a53..3234ff9cdf8fb81d6814542ec97b50fd6cf13f88 100644
--- a/testsuite/tests/ghci/linking/dyn/T3372.hs
+++ b/testsuite/tests/ghci/linking/dyn/T3372.hs
@@ -11,7 +11,7 @@ import Control.Concurrent.Chan
 
 import GHC ( Ghc )
 import qualified GHC
-import qualified MonadUtils as GHC
+import qualified GHC.Utils.Monad as GHC
 
 import qualified GHC.Exts
 
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs
index 03313fb66f0a0e2fb3e49b3f32afd04da9cb9a3c..c0b1445dc615236d34f8bc55595b575f33f5ef5d 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.hs
+++ b/testsuite/tests/parser/should_run/CountParserDeps.hs
@@ -15,7 +15,7 @@ import GHC.Types.Module
 import GHC.Driver.Session
 import GHC.Driver.Main
 import GHC
-import Util
+import GHC.Utils.Misc
 import Data.Maybe
 import Control.Monad
 import Control.Monad.IO.Class
diff --git a/testsuite/tests/parser/unicode/T6016.hs b/testsuite/tests/parser/unicode/T6016.hs
index 5783a728431b61073dbdb2db4105afca8f427ce3..60a8b206a7627ad006b5cab9ee82498b2e631243 100644
--- a/testsuite/tests/parser/unicode/T6016.hs
+++ b/testsuite/tests/parser/unicode/T6016.hs
@@ -4,7 +4,7 @@ import Control.Exception
 import Data.Char
 import System.IO
 
-import StringBuffer
+import GHC.Data.StringBuffer
 
 twoBOMs = "T6016-twoBOMs"
 
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
index f3ba8ff8df1c2bf52874c4eeefbd419fe54fdabc..45a0205eb0d7f4ec83dc4449ed09d7567d94328e 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/Plugin.hs
@@ -4,7 +4,7 @@ module Simple.Plugin(plugin) where
 
 import GHC.Types.Unique.FM
 import GHC.Plugins
-import qualified ErrUtils
+import qualified GHC.Utils.Error
 
 -- For annotation tests
 import Simple.DataStructures
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 8ee017e61b75f60aef9d722032a9b3b98aa180ef..610a0c188ed90fc6854dcf18c958918a95c2f23e 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -4,12 +4,12 @@ module Simple.RemovePlugin where
 import Control.Monad.IO.Class
 import Data.List (intercalate)
 import GHC.Driver.Plugins
-import Bag
+import GHC.Data.Bag
 import GHC.Driver.Types
 import GHC.Tc.Types
 import GHC.Hs.Extension
 import GHC.Hs.Expr
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.SrcLoc
 import GHC.Hs
 import GHC.Hs.Binds
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
index 36ea2302819e4647a7f3bbbafd990714cc9578ac..4e0eec36c03d0c0b1a4377ceafd474dfca5d51d7 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/SourcePlugin.hs
@@ -9,7 +9,7 @@ import GHC.Tc.Types
 import GHC.Hs.Extension
 import GHC.Types.Avail
 import GHC.Hs.Expr
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Hs.ImpExp
 import GHC.Hs.Decls
 import GHC.Hs.Doc
diff --git a/testsuite/tests/plugins/static-plugins.hs b/testsuite/tests/plugins/static-plugins.hs
index 77a5280befdabb4db5dc5d5ea826580bf7840f0d..47cbb462a2a180e8f30d6b151832c0f85886b064 100644
--- a/testsuite/tests/plugins/static-plugins.hs
+++ b/testsuite/tests/plugins/static-plugins.hs
@@ -12,7 +12,7 @@ import GHC.Hs.Expr
 import GHC.Hs.Extension
 import GHC.Hs.ImpExp
 import GHC.Driver.Types
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Driver.Plugins
 import System.Environment
 import GHC.Tc.Types
diff --git a/testsuite/tests/pmcheck/should_compile/T11195.hs b/testsuite/tests/pmcheck/should_compile/T11195.hs
index 57e2b442764ee84f81b7d4fdbc4a59ceb92aa28f..dca79500aca4cb8b34a7074ad4718e514dd372a4 100644
--- a/testsuite/tests/pmcheck/should_compile/T11195.hs
+++ b/testsuite/tests/pmcheck/should_compile/T11195.hs
@@ -10,7 +10,7 @@ import GHC.Core.Coercion.Axiom
 import GHC.Tc.Utils.TcType       ( exactTyCoVarsOfType )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import Pair
+import GHC.Data.Pair
 
 type NormalCo    = Coercion
 type NormalNonIdCo = NormalCo  -- Extra invariant: not the identity
diff --git a/testsuite/tests/quasiquotation/T7918.hs b/testsuite/tests/quasiquotation/T7918.hs
index d322a7f11e371b3352fba62c63c8f90ca8fae454..1a7de12d42f38ebfd3a33c75750983d1a78a2760 100644
--- a/testsuite/tests/quasiquotation/T7918.hs
+++ b/testsuite/tests/quasiquotation/T7918.hs
@@ -3,8 +3,8 @@ module Main (main) where
 
 import GHC
 import GHC.Driver.Session
-import Outputable
-import MonadUtils
+import GHC.Utils.Outputable
+import GHC.Utils.Monad
 import GHC.Types.Name.Set
 import GHC.Types.Var
 import GHC.Types.SrcLoc as SrcLoc
diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs
index efe955414c51318d4d278e0aefd5b8bcd603f996..932d98b5c87ef45ef933a1f9d248d23a21956f67 100644
--- a/testsuite/tests/regalloc/regalloc_unit_tests.hs
+++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs
@@ -40,11 +40,11 @@ import GHC.Driver.Monad
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.Supply
 import GHC.Driver.Session
-import ErrUtils
-import Outputable
+import GHC.Utils.Error
+import GHC.Utils.Outputable
 import GHC.Types.Basic
 
-import Stream (collect, yield)
+import GHC.Data.Stream as Stream (collect, yield)
 
 import Data.Typeable
 import Data.Maybe
diff --git a/testsuite/tests/rts/linker/LinkerUnload.hs b/testsuite/tests/rts/linker/LinkerUnload.hs
index d534be795dd816598a2610b6dd641dea9ea66277..af71cadfac7e110bbc0ef6ad642f93c7f4c96552 100644
--- a/testsuite/tests/rts/linker/LinkerUnload.hs
+++ b/testsuite/tests/rts/linker/LinkerUnload.hs
@@ -4,7 +4,7 @@ import GHC
 import GHC.Driver.Session
 import GHC.Runtime.Linker as Linker
 import System.Environment
-import MonadUtils ( MonadIO(..) )
+import GHC.Utils.Monad ( MonadIO(..) )
 
 foreign export ccall loadPackages :: IO ()
 
diff --git a/testsuite/tests/rts/linker/rdynamic.hs b/testsuite/tests/rts/linker/rdynamic.hs
index bbbe9e898d0358cc01daacc2c44a0e030f4a9e0c..d36360745aa83a362a7a04917356fb3389ae0ade 100644
--- a/testsuite/tests/rts/linker/rdynamic.hs
+++ b/testsuite/tests/rts/linker/rdynamic.hs
@@ -12,7 +12,7 @@ import Foreign.C.String ( withCString, CString )
 import GHC.Exts         ( addrToAny# )
 import GHC.Ptr          ( Ptr(..), nullPtr )
 import System.Info      ( os, arch )
-import Encoding
+import GHC.Utils.Encoding
 
 main = (loadFunction Nothing "Main" "f" :: IO (Maybe String)) >>= print
 
diff --git a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs
index 8d5c7756d9354755652740a0012658ec9b484ed7..e9cd3f34f4fdb99cebbb3eda28b8e3159e87c50b 100644
--- a/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs
+++ b/testsuite/tests/unboxedsums/unboxedsums_unit_tests.hs
@@ -3,7 +3,7 @@ module Main where
 import GHC.Types.Basic
 import GHC
 import GHC.Driver.Monad
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Types.RepType
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
diff --git a/testsuite/tests/utils/should_run/T14854.hs b/testsuite/tests/utils/should_run/T14854.hs
index 9187639d6dd2a0d30a649e75ce1e5a77bab154a5..ce6ac4b024765117ca257c0aba3a95193f6d2859 100644
--- a/testsuite/tests/utils/should_run/T14854.hs
+++ b/testsuite/tests/utils/should_run/T14854.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE RecordWildCards #-}
 module Main (main) where
 
-import FastString
+import GHC.Data.FastString
 
 import Control.Concurrent
 import Control.DeepSeq
diff --git a/utils/check-api-annotations/Main.hs b/utils/check-api-annotations/Main.hs
index e0d62e6684a6ad0e68ea16401b5b3a82de80ce0d..366f7c760184eb9a28d0dcc616f9daae7dc71cfc 100644
--- a/utils/check-api-annotations/Main.hs
+++ b/utils/check-api-annotations/Main.hs
@@ -4,7 +4,7 @@ import Data.Data
 import Data.List
 import GHC
 import GHC.Driver.Session
-import Outputable
+import GHC.Utils.Outputable
 import GHC.Parser.Annotation
 import GHC.Types.SrcLoc
 import System.Environment( getArgs )
diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs
index 0119311531e6e6386343b5dbee8bf523d73574d3..b222b726fb0ed2334ab43e6fa02f3796458f9da8 100644
--- a/utils/check-ppr/Main.hs
+++ b/utils/check-ppr/Main.hs
@@ -5,7 +5,7 @@ import GHC.Types.SrcLoc
 import GHC hiding (moduleName)
 import GHC.Hs.Dump
 import GHC.Driver.Session
-import Outputable hiding (space)
+import GHC.Utils.Outputable hiding (space)
 import System.Environment( getArgs )
 import System.Exit
 import System.FilePath
diff --git a/utils/haddock b/utils/haddock
index da4e2bd788b6231494d6ac56a8e88bcfa4be51f6..2d2587182568cc5aa4b29d401517337c32459c66 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit da4e2bd788b6231494d6ac56a8e88bcfa4be51f6
+Subproject commit 2d2587182568cc5aa4b29d401517337c32459c66