From c01d5af31c8feb634fc3dffc84e6e7ece61ba190 Mon Sep 17 00:00:00 2001
From: Michael Sloan <mgsloan@gmail.com>
Date: Thu, 14 Mar 2019 16:12:09 -0700
Subject: [PATCH] Extract out use of UnboxedTuples from GHCi.Leak
See #13101 + #15454 for motivation. This change reduces the number of
modules that need to be compiled to object code when loading GHC into
GHCi.
---
ghc/GHCi/Leak.hs | 8 +++-----
ghc/GHCi/Util.hs | 16 ++++++++++++++++
ghc/ghc-bin.cabal.in | 1 +
3 files changed, 20 insertions(+), 5 deletions(-)
create mode 100644 ghc/GHCi/Util.hs
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
index 8135c3731efc..874d9e2cdc2e 100644
--- a/ghc/GHCi/Leak.hs
+++ b/ghc/GHCi/Leak.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RecordWildCards, LambdaCase, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE RecordWildCards, LambdaCase #-}
module GHCi.Leak
( LeakIndicators
, getLeakIndicators
@@ -10,9 +10,8 @@ import Data.Bits
import DynFlags ( sTargetPlatform )
import Foreign.Ptr (ptrToIntPtr, intPtrToPtr)
import GHC
-import GHC.Exts (anyToAddr#)
import GHC.Ptr (Ptr (..))
-import GHC.Types (IO (..))
+import GHCi.Util
import HscTypes
import Outputable
import Platform (target32Bit)
@@ -64,8 +63,7 @@ checkLeakIndicators dflags (LeakIndicators leakmods) = do
report :: String -> Maybe a -> IO ()
report _ Nothing = return ()
report msg (Just a) = do
- addr <- IO (\s -> case anyToAddr# a s of
- (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())
+ addr <- anyToPtr a
putStrLn ("-fghci-leak-check: " ++ msg ++ " is still alive at " ++
show (maskTagBits addr))
diff --git a/ghc/GHCi/Util.hs b/ghc/GHCi/Util.hs
new file mode 100644
index 000000000000..050a0566d6e7
--- /dev/null
+++ b/ghc/GHCi/Util.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+-- | Utilities for GHCi.
+module GHCi.Util where
+
+-- NOTE: Avoid importing GHC modules here, because the primary purpose
+-- of this module is to not use UnboxedTuples in a module that imports
+-- lots of other modules. See issue#13101 for more info.
+
+import GHC.Exts
+import GHC.Types
+
+anyToPtr :: a -> IO (Ptr ())
+anyToPtr x =
+ IO (\s -> case anyToAddr# x s of
+ (# s', addr #) -> (# s', Ptr addr #)) :: IO (Ptr ())
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 781933062fbb..f00b7946f975 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -72,6 +72,7 @@ Executable ghc
GHCi.UI.Info
GHCi.UI.Monad
GHCi.UI.Tags
+ GHCi.Util
Other-Extensions:
BangPatterns
FlexibleInstances
--
GitLab