summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichael Sloan <mgsloan@gmail.com>2019-03-14 16:12:09 -0700
committerBen Gamari <ben@well-typed.com>2019-06-03 23:42:47 -0400
commita675f4987ec329352ba5b3dd654a4809dc04010b (patch)
treea93f86b6ed79a166dba0c1642007c646409362e3
parent3be420327adda2236d5c4f5c3a8cec8c572ed93c (diff)
downloadhaskell-a675f4987ec329352ba5b3dd654a4809dc04010b.tar.gz
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. (cherry picked from commit c01d5af31c8feb634fc3dffc84e6e7ece61ba190)
-rw-r--r--ghc/GHCi/Leak.hs8
-rw-r--r--ghc/GHCi/Util.hs16
-rw-r--r--ghc/ghc-bin.cabal.in1
3 files changed, 20 insertions, 5 deletions
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
index 8135c3731e..874d9e2cdc 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 0000000000..050a0566d6
--- /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 0d4dd0a948..0000a1ee3f 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -71,6 +71,7 @@ Executable ghc
GHCi.UI.Info
GHCi.UI.Monad
GHCi.UI.Tags
+ GHCi.Util
Other-Extensions:
BangPatterns
FlexibleInstances