diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 0d49327f47323c3127fcbd72d087943f4c6ec951..0406d0e03ae440ef6b07d5f1938b23cd84167fb9 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -534,6 +534,7 @@ data GeneralFlag
    | Opt_IgnoreDotGhci
    | Opt_GhciSandbox
    | Opt_GhciHistory
+   | Opt_GhciLeakCheck
    | Opt_LocalGhciHistory
    | Opt_NoIt
    | Opt_HelpfulErrors
@@ -3893,6 +3894,7 @@ fFlagsDeps = [
   flagSpec "fun-to-thunk"                     Opt_FunToThunk,
   flagSpec "gen-manifest"                     Opt_GenManifest,
   flagSpec "ghci-history"                     Opt_GhciHistory,
+  flagSpec "ghci-leak-check"                  Opt_GhciLeakCheck,
   flagGhciSpec "local-ghci-history"           Opt_LocalGhciHistory,
   flagGhciSpec "no-it"                        Opt_NoIt,
   flagSpec "ghci-sandbox"                     Opt_GhciSandbox,
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index f5dcfe39626ead1e2f24e2781a9f6438464f0157..a5f5764a9e34264b964d8dc5da8cd2a8ad0e7ef8 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -2025,6 +2025,17 @@ mostly obvious.
 
     It will create ``.ghci-history`` in current folder where GHCi is launched.
 
+.. ghc-flag:: -fghci-leak-check
+    :shortdesc: (Debugging only) check for space leaks when loading
+                new modules in GHCi.
+    :type: dynamic
+    :reverse: -fno-ghci-leak-check
+    :category:
+
+    (Debugging only) When loading new modules with ``:load``, check
+    that any previously loaded modules have been correctly garbage
+    collected. Emits messages if a leak is detected.
+
 Packages
 ~~~~~~~~
 
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
new file mode 100644
index 0000000000000000000000000000000000000000..3f64b5dcf0ff80d0c5526b3a97c127b1afa9ac30
--- /dev/null
+++ b/ghc/GHCi/Leak.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE RecordWildCards, LambdaCase #-}
+module GHCi.Leak
+  ( LeakIndicators
+  , getLeakIndicators
+  , checkLeakIndicators
+  ) where
+
+import Control.Monad
+import GHC
+import Outputable
+import HscTypes
+import UniqDFM
+import System.Mem
+import System.Mem.Weak
+
+-- Checking for space leaks in GHCi. See #15111, and the
+-- -fghci-leak-check flag.
+
+data LeakIndicators = LeakIndicators [LeakModIndicators]
+
+data LeakModIndicators = LeakModIndicators
+  { leakMod :: Weak HomeModInfo
+  , leakIface :: Weak ModIface
+  , leakDetails :: Weak ModDetails
+  , leakLinkable :: Maybe (Weak Linkable)
+  }
+
+-- | Grab weak references to some of the data structures representing
+-- the currently loaded modules.
+getLeakIndicators :: HscEnv -> IO LeakIndicators
+getLeakIndicators HscEnv{..} =
+  fmap LeakIndicators $
+    forM (eltsUDFM hsc_HPT) $ \hmi@HomeModInfo{..} -> do
+      leakMod <- mkWeakPtr hmi Nothing
+      leakIface <- mkWeakPtr hm_iface Nothing
+      leakDetails <- mkWeakPtr hm_details Nothing
+      leakLinkable <- mapM (`mkWeakPtr` Nothing) hm_linkable
+      return $ LeakModIndicators{..}
+
+-- | Look at the LeakIndicators collected by an earlier call to
+-- `getLeakIndicators`, and print messasges if any of them are still
+-- alive.
+checkLeakIndicators :: DynFlags -> LeakIndicators -> IO ()
+checkLeakIndicators dflags (LeakIndicators leakmods)  = do
+  performGC
+  forM_ leakmods $ \LeakModIndicators{..} -> do
+    deRefWeak leakMod >>= \case
+      Nothing -> return ()
+      Just hmi ->
+        report ("HomeModInfo for " ++
+          showSDoc dflags (ppr (mi_module (hm_iface hmi)))) (Just hmi)
+    deRefWeak leakIface >>= report "ModIface"
+    deRefWeak leakDetails >>= report "ModDetails"
+    forM_ leakLinkable $ \l -> deRefWeak l >>= report "Linkable"
+ where
+  report :: String -> Maybe a -> IO ()
+  report _ Nothing = return ()
+  report msg (Just _) =
+    putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive!")
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 3ed1c7f6a340b9bd12978371fe01163847dadcee..d449b3ca83217eadba133ce350588049c948f670 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -134,6 +134,8 @@ import GHC.IO.Exception ( IOErrorType(InvalidArgument) )
 import GHC.IO.Handle ( hFlushAll )
 import GHC.TopHandler ( topHandler )
 
+import GHCi.Leak
+
 -----------------------------------------------------------------------------
 
 data GhciSettings = GhciSettings {
@@ -1642,6 +1644,14 @@ loadModule' files = do
   -- require some re-working of the GHC interface, so we'll leave it
   -- as a ToDo for now.
 
+  hsc_env <- GHC.getSession
+
+  -- Grab references to the currently loaded modules so that we can
+  -- see if they leak.
+  leak_indicators <- if gopt Opt_GhciLeakCheck (hsc_dflags hsc_env)
+    then liftIO $ getLeakIndicators hsc_env
+    else return (panic "no leak indicators")
+
   -- unload first
   _ <- GHC.abandonAll
   lift discardActiveBreakPoints
@@ -1649,7 +1659,10 @@ loadModule' files = do
   _ <- GHC.load LoadAllTargets
 
   GHC.setTargets targets
-  doLoadAndCollectInfo False LoadAllTargets
+  success <- doLoadAndCollectInfo False LoadAllTargets
+  when (gopt Opt_GhciLeakCheck (hsc_dflags hsc_env)) $
+    liftIO $ checkLeakIndicators (hsc_dflags hsc_env) leak_indicators
+  return success
 
 -- | @:add@ command
 addModule :: [FilePath] -> InputT GHCi ()
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 12812ef07c15c993d5a4aff38d15e4f6d77f4e5c..6c12941630b7b5c2d5069a44d8789d965cc3012e 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -61,6 +61,7 @@ Executable ghc
         CPP-Options: -DGHCI
         GHC-Options: -fno-warn-name-shadowing
         Other-Modules:
+            GHCi.Leak
             GHCi.UI
             GHCi.UI.Info
             GHCi.UI.Monad
diff --git a/testsuite/config/ghc b/testsuite/config/ghc
index 62963941977d7fad77aa8443f6d9133ef835dc9d..f41f372cb2f57e45dfc0a033e0b7fff6ecc533e5 100644
--- a/testsuite/config/ghc
+++ b/testsuite/config/ghc
@@ -80,7 +80,7 @@ config.way_flags = {
     'prof_no_auto' : ['-prof', '-static', '-fasm'],
     'profasm'      : ['-O', '-prof', '-static', '-fprof-auto'],
     'profthreaded' : ['-O', '-prof', '-static', '-fprof-auto', '-threaded'],
-    'ghci'         : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '+RTS', '-I0.1', '-RTS'],
+    'ghci'         : ['--interactive', '-v0', '-ignore-dot-ghci', '-fno-ghci-history', '-fghci-leak-check', '+RTS', '-I0.1', '-RTS'],
     'sanity'       : ['-debug'],
     'threaded1'    : ['-threaded', '-debug'],
     'threaded1_ls' : ['-threaded', '-debug'],
diff --git a/testsuite/tests/ghci/scripts/T9293.stdout b/testsuite/tests/ghci/scripts/T9293.stdout
index 2e5adc404c93df71512a6aac0cbe07fbeeef7e94..4fdd3504bce53cfb51faf52a42ed43900242b7fb 100644
--- a/testsuite/tests/ghci/scripts/T9293.stdout
+++ b/testsuite/tests/ghci/scripts/T9293.stdout
@@ -10,6 +10,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
@@ -29,6 +30,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
@@ -47,6 +49,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout
index 2e5adc404c93df71512a6aac0cbe07fbeeef7e94..4fdd3504bce53cfb51faf52a42ed43900242b7fb 100644
--- a/testsuite/tests/ghci/scripts/ghci057.stdout
+++ b/testsuite/tests/ghci/scripts/ghci057.stdout
@@ -10,6 +10,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
@@ -29,6 +30,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
@@ -47,6 +49,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings:
@@ -67,6 +70,7 @@ other dynamic, non-language, flag settings:
   -fignore-optim-changes
   -fignore-hpc-changes
   -fno-ghci-history
+  -fghci-leak-check
   -fimplicit-import-qualified
   -fshow-warning-groups
 warning settings: