diff options
| -rw-r--r-- | ghc/GHCi/Leak.hs | 8 | ||||
| -rw-r--r-- | ghc/GHCi/Util.hs | 16 | ||||
| -rw-r--r-- | ghc/ghc-bin.cabal.in | 1 |
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 781933062f..f00b7946f9 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 |