[commit: base] master: Remove some things deprecated since GHC 7.2 (33ca04c)

Ian Lynagh igloo at earth.li
Sat Feb 16 18:23:02 CET 2013


Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/33ca04cae7aa14e18cf6b0fbe72958a837bf0ed6

>---------------------------------------------------------------

commit 33ca04cae7aa14e18cf6b0fbe72958a837bf0ed6
Author: Ian Lynagh <ian at well-typed.com>
Date:   Sat Feb 16 12:32:53 2013 +0000

    Remove some things deprecated since GHC 7.2
    
    7.2 is too old even to build HEAD, so seems reasonable to remove them
    now.

>---------------------------------------------------------------

 Control/Concurrent.hs |    3 ---
 Foreign.hs            |   17 -----------------
 Foreign/ForeignPtr.hs |   10 ----------
 Foreign/Marshal.hs    |   30 ------------------------------
 GHC/Conc.lhs          |    3 ---
 GHC/Conc/Sync.lhs     |   20 +-------------------
 6 files changed, 1 insertions(+), 82 deletions(-)

diff --git a/Control/Concurrent.hs b/Control/Concurrent.hs
index a53b1a8..2c0f987 100644
--- a/Control/Concurrent.hs
+++ b/Control/Concurrent.hs
@@ -107,9 +107,6 @@ module Control.Concurrent (
 
         -- $preemption
 
-        -- * Deprecated functions
-        forkIOUnmasked
-
     ) where
 
 import Prelude
diff --git a/Foreign.hs b/Foreign.hs
index dbdc905..43ee102 100644
--- a/Foreign.hs
+++ b/Foreign.hs
@@ -25,14 +25,6 @@ module Foreign
         , module Foreign.StablePtr
         , module Foreign.Storable
         , module Foreign.Marshal
-
-        -- * Unsafe Functions
-
-        -- | 'unsafePerformIO' is exported here for backwards
-        -- compatibility reasons only.  For doing local marshalling in
-        -- the FFI, use 'unsafeLocalState'.  For other uses, see
-        -- 'System.IO.Unsafe.unsafePerformIO'.
-        , unsafePerformIO
         ) where
 
 import Data.Bits
@@ -44,12 +36,3 @@ import Foreign.StablePtr
 import Foreign.Storable
 import Foreign.Marshal
 
-import GHC.IO (IO)
-import qualified GHC.IO (unsafePerformIO)
-
-{-# DEPRECATED unsafePerformIO "Use System.IO.Unsafe.unsafePerformIO instead; This function will be removed in the next release" #-} -- deprecated in 7.2
-
-{-# INLINE unsafePerformIO #-}
-unsafePerformIO :: IO a -> a
-unsafePerformIO = GHC.IO.unsafePerformIO
-
diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs
index be6dec0..b980f50 100644
--- a/Foreign/ForeignPtr.hs
+++ b/Foreign/ForeignPtr.hs
@@ -48,17 +48,7 @@ module Foreign.ForeignPtr (
         , mallocForeignPtrBytes
         , mallocForeignPtrArray
         , mallocForeignPtrArray0
-        -- ** Unsafe low-level operations
-        , unsafeForeignPtrToPtr
     ) where
 
 import Foreign.ForeignPtr.Safe
 
-import Foreign.Ptr ( Ptr )
-import qualified Foreign.ForeignPtr.Unsafe as U
-
-{-# DEPRECATED unsafeForeignPtrToPtr "Use Foreign.ForeignPtr.Unsafe.unsafeForeignPtrToPtr instead; This function will be removed in the next release" #-} -- deprecated in 7.2
-{-# INLINE unsafeForeignPtrToPtr #-}
-unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a
-unsafeForeignPtrToPtr = U.unsafeForeignPtrToPtr
-
diff --git a/Foreign/Marshal.hs b/Foreign/Marshal.hs
index ef81cec..799596e 100644
--- a/Foreign/Marshal.hs
+++ b/Foreign/Marshal.hs
@@ -20,37 +20,7 @@ module Foreign.Marshal
          -- | The module "Foreign.Marshal" re-exports the safe content in the
          -- @Foreign.Marshal@ hierarchy:
           module Foreign.Marshal.Safe
-         -- | and provides one function:
-        , unsafeLocalState
         ) where
 
 import Foreign.Marshal.Safe
 
-#ifdef __GLASGOW_HASKELL__
-import GHC.IO
-#else
-import System.IO.Unsafe
-#endif
-
-{- |
-Sometimes an external entity is a pure function, except that it passes
-arguments and/or results via pointers.  The function
- at unsafeLocalState@ permits the packaging of such entities as pure
-functions.  
-
-The only IO operations allowed in the IO action passed to
- at unsafeLocalState@ are (a) local allocation (@alloca@, @allocaBytes@
-and derived operations such as @withArray@ and @withCString@), and (b)
-pointer operations (@Foreign.Storable@ and @Foreign.Ptr@) on the
-pointers to local storage, and (c) foreign functions whose only
-observable effect is to read and/or write the locally allocated
-memory.  Passing an IO operation that does not obey these rules
-results in undefined behaviour.
-
-It is expected that this operation will be
-replaced in a future revision of Haskell.
--}
-{-# DEPRECATED unsafeLocalState "Please import from Foreign.Marshall.Unsafe instead; This will be removed in the next release" #-} -- deprecated in 7.2
-unsafeLocalState :: IO a -> a
-unsafeLocalState = unsafePerformIO
-
diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index aa14b37..ded38d5 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -31,11 +31,8 @@ module GHC.Conc
 
         -- * Forking and suchlike
         , forkIO
-        , forkIOUnmasked
         , forkIOWithUnmask
         , forkOn
-        , forkOnIO
-        , forkOnIOUnmasked
         , forkOnWithUnmask
         , numCapabilities
         , getNumCapabilities
diff --git a/GHC/Conc/Sync.lhs b/GHC/Conc/Sync.lhs
index 7c6c1b6..eb70e56 100644
--- a/GHC/Conc/Sync.lhs
+++ b/GHC/Conc/Sync.lhs
@@ -42,11 +42,8 @@ module GHC.Conc.Sync
 
         -- * Forking and suchlike
         , forkIO
-        , forkIOUnmasked
         , forkIOWithUnmask
         , forkOn
-        , forkOnIO    -- DEPRECATED -- deprecated in 7.2
-        , forkOnIOUnmasked
         , forkOnWithUnmask
         , numCapabilities
         , getNumCapabilities
@@ -97,7 +94,7 @@ module GHC.Conc.Sync
         , sharedCAF
         ) where
 
-import Foreign hiding (unsafePerformIO)
+import Foreign
 import Foreign.C
 
 #ifdef mingw32_HOST_OS
@@ -208,11 +205,6 @@ forkIO action = IO $ \ s ->
  where
   action_plus = catchException action childHandler
 
-{-# DEPRECATED forkIOUnmasked "use forkIOWithUnmask instead" #-} -- deprecated in 7.2
--- | This function is deprecated; use 'forkIOWithUnmask' instead
-forkIOUnmasked :: IO () -> IO ThreadId
-forkIOUnmasked io = forkIO (unsafeUnmask io)
-
 -- | Like 'forkIO', but the child thread is passed a function that can
 -- be used to unmask asynchronous exceptions.  This function is
 -- typically used in the following way
@@ -258,16 +250,6 @@ forkOn (I# cpu) action = IO $ \ s ->
  where
   action_plus = catchException action childHandler
 
-{-# DEPRECATED forkOnIO "renamed to forkOn" #-} -- deprecated in 7.2
--- | This function is deprecated; use 'forkOn' instead
-forkOnIO :: Int -> IO () -> IO ThreadId
-forkOnIO = forkOn
-
-{-# DEPRECATED forkOnIOUnmasked "use forkOnWithUnmask instead" #-} -- deprecated in 7.2
--- | This function is deprecated; use 'forkOnWIthUnmask' instead
-forkOnIOUnmasked :: Int -> IO () -> IO ThreadId
-forkOnIOUnmasked cpu io = forkOn cpu (unsafeUnmask io)
-
 -- | Like 'forkIOWithUnmask', but the child thread is pinned to the
 -- given CPU, as with 'forkOn'.
 forkOnWithUnmask :: Int -> ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId





More information about the ghc-commits mailing list