diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index 8135c3731efc18ffd500ca3a3a0e18d765db4d89..874d9e2cdc2e90173cc7b3604aba9bc832e606f4 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 0000000000000000000000000000000000000000..050a0566d6e72f2693567a33a5a0a4357b67df7a --- /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 781933062fbb404bf307705449434c5912aa07f9..f00b7946f975df3f119967f475789d457c1d53fd 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