Commit 0f5eae02 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Constant-fold `__GLASGOW_HASKELL__` CPP conditionals

Now that HUGS and NHC specific code has been removed, this commit "folds"
the now redundant `#if((n)def)`s containing `__GLASGOW_HASKELL__`.  This
renders `base` officially GHC only.

This commit also removes redundant `{-# LANGUAGE CPP #-}`.
Signed-off-by: Herbert Valerio Riedel's avatarHerbert Valerio Riedel <hvr@gnu.org>
parent 43ece172
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
...@@ -59,9 +58,7 @@ import Data.Proxy ...@@ -59,9 +58,7 @@ import Data.Proxy
import Text.ParserCombinators.ReadP (ReadP) import Text.ParserCombinators.ReadP (ReadP)
import Text.ParserCombinators.ReadPrec (ReadPrec) import Text.ParserCombinators.ReadPrec (ReadPrec)
#ifdef __GLASGOW_HASKELL__
import GHC.Conc (STM, retry, orElse) import GHC.Conc (STM, retry, orElse)
#endif
infixl 3 <|> infixl 3 <|>
infixl 4 <*>, <*, *>, <**> infixl 4 <*>, <*, *>, <**>
...@@ -181,7 +178,6 @@ instance Applicative (Lazy.ST s) where ...@@ -181,7 +178,6 @@ instance Applicative (Lazy.ST s) where
pure = return pure = return
(<*>) = ap (<*>) = ap
#ifdef __GLASGOW_HASKELL__
instance Applicative STM where instance Applicative STM where
pure = return pure = return
(<*>) = ap (<*>) = ap
...@@ -189,7 +185,6 @@ instance Applicative STM where ...@@ -189,7 +185,6 @@ instance Applicative STM where
instance Alternative STM where instance Alternative STM where
empty = retry empty = retry
(<|>) = orElse (<|>) = orElse
#endif
instance Applicative ((->) a) where instance Applicative ((->) a) where
pure = const pure = const
......
...@@ -20,10 +20,7 @@ ...@@ -20,10 +20,7 @@
module Control.Category where module Control.Category where
import qualified Prelude import qualified Prelude
#ifdef __GLASGOW_HASKELL__
import Data.Type.Equality import Data.Type.Equality
#endif
infixr 9 . infixr 9 .
infixr 1 >>>, <<< infixr 1 >>>, <<<
...@@ -50,11 +47,9 @@ instance Category (->) where ...@@ -50,11 +47,9 @@ instance Category (->) where
id = Prelude.id id = Prelude.id
(.) = (Prelude..) (.) = (Prelude..)
#ifdef __GLASGOW_HASKELL__
instance Category (:=:) where instance Category (:=:) where
id = Refl id = Refl
Refl . Refl = Refl Refl . Refl = Refl
#endif
-- | Right-to-left composition -- | Right-to-left composition
(<<<) :: Category cat => cat b c -> cat a b -> cat a c (<<<) :: Category cat => cat b c -> cat a b -> cat a c
......
...@@ -33,17 +33,13 @@ module Control.Concurrent ( ...@@ -33,17 +33,13 @@ module Control.Concurrent (
-- * Basic concurrency operations -- * Basic concurrency operations
ThreadId, ThreadId,
#ifdef __GLASGOW_HASKELL__
myThreadId, myThreadId,
#endif
forkIO, forkIO,
#ifdef __GLASGOW_HASKELL__
forkFinally, forkFinally,
forkIOWithUnmask, forkIOWithUnmask,
killThread, killThread,
throwTo, throwTo,
#endif
-- ** Threads with affinity -- ** Threads with affinity
forkOn, forkOn,
...@@ -61,14 +57,12 @@ module Control.Concurrent ( ...@@ -61,14 +57,12 @@ module Control.Concurrent (
-- $blocking -- $blocking
#ifdef __GLASGOW_HASKELL__
-- ** Waiting -- ** Waiting
threadDelay, threadDelay,
threadWaitRead, threadWaitRead,
threadWaitWrite, threadWaitWrite,
threadWaitReadSTM, threadWaitReadSTM,
threadWaitWriteSTM, threadWaitWriteSTM,
#endif
-- * Communication abstractions -- * Communication abstractions
...@@ -77,7 +71,6 @@ module Control.Concurrent ( ...@@ -77,7 +71,6 @@ module Control.Concurrent (
module Control.Concurrent.QSem, module Control.Concurrent.QSem,
module Control.Concurrent.QSemN, module Control.Concurrent.QSemN,
#ifdef __GLASGOW_HASKELL__
-- * Bound Threads -- * Bound Threads
-- $boundthreads -- $boundthreads
rtsSupportsBoundThreads, rtsSupportsBoundThreads,
...@@ -85,7 +78,6 @@ module Control.Concurrent ( ...@@ -85,7 +78,6 @@ module Control.Concurrent (
isCurrentThreadBound, isCurrentThreadBound,
runInBoundThread, runInBoundThread,
runInUnboundThread, runInUnboundThread,
#endif
-- * Weak references to ThreadIds -- * Weak references to ThreadIds
mkWeakThreadId, mkWeakThreadId,
...@@ -117,7 +109,6 @@ import Prelude ...@@ -117,7 +109,6 @@ import Prelude
import Control.Exception.Base as Exception import Control.Exception.Base as Exception
#ifdef __GLASGOW_HASKELL__
import GHC.Exception import GHC.Exception
import GHC.Conc hiding (threadWaitRead, threadWaitWrite, import GHC.Conc hiding (threadWaitRead, threadWaitWrite,
threadWaitReadSTM, threadWaitWriteSTM) threadWaitReadSTM, threadWaitWriteSTM)
...@@ -136,7 +127,6 @@ import Foreign.C ...@@ -136,7 +127,6 @@ import Foreign.C
import System.IO import System.IO
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
#endif #endif
#endif
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Control.Concurrent.Chan import Control.Concurrent.Chan
...@@ -211,7 +201,6 @@ forkFinally action and_then = ...@@ -211,7 +201,6 @@ forkFinally action and_then =
mask $ \restore -> mask $ \restore ->
forkIO $ try (restore action) >>= and_then forkIO $ try (restore action) >>= and_then
#ifdef __GLASGOW_HASKELL__
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Bound Threads -- Bound Threads
...@@ -396,9 +385,7 @@ runInUnboundThread action = do ...@@ -396,9 +385,7 @@ runInUnboundThread action = do
unsafeResult :: Either SomeException a -> IO a unsafeResult :: Either SomeException a -> IO a
unsafeResult = either Exception.throwIO return unsafeResult = either Exception.throwIO return
#endif /* __GLASGOW_HASKELL__ */
#ifdef __GLASGOW_HASKELL__
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- threadWaitRead/threadWaitWrite -- threadWaitRead/threadWaitWrite
...@@ -672,5 +659,3 @@ alternative then it is possible to prevent the thread from being ...@@ -672,5 +659,3 @@ alternative then it is possible to prevent the thread from being
considered deadlocked by making a 'StablePtr' pointing to it. Don't considered deadlocked by making a 'StablePtr' pointing to it. Don't
forget to release the 'StablePtr' later with 'freeStablePtr'. forget to release the 'StablePtr' later with 'freeStablePtr'.
-} -}
#endif /* __GLASGOW_HASKELL__ */
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
......
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, UnboxedTuples, MagicHash #-} {-# LANGUAGE NoImplicitPrelude, UnboxedTuples, MagicHash #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
...@@ -146,20 +146,13 @@ module Control.Concurrent.MVar ...@@ -146,20 +146,13 @@ module Control.Concurrent.MVar
, addMVarFinalizer , addMVarFinalizer
) where ) where
#ifdef __GLASGOW_HASKELL__
import GHC.MVar ( MVar(..), newEmptyMVar, newMVar, takeMVar, putMVar, import GHC.MVar ( MVar(..), newEmptyMVar, newMVar, takeMVar, putMVar,
tryTakeMVar, tryPutMVar, isEmptyMVar, readMVar, tryTakeMVar, tryPutMVar, isEmptyMVar, readMVar,
tryReadMVar tryReadMVar
) )
import qualified GHC.MVar import qualified GHC.MVar
import GHC.Weak import GHC.Weak
#endif
#ifdef __GLASGOW_HASKELL__
import GHC.Base import GHC.Base
#else
import Prelude
#endif
import Control.Exception.Base import Control.Exception.Base
......
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, BangPatterns #-} {-# LANGUAGE DeriveDataTypeable, BangPatterns #-}
#endif
{-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_GHC -funbox-strict-fields #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
......
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, BangPatterns #-} {-# LANGUAGE DeriveDataTypeable, BangPatterns #-}
#endif
{-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_GHC -funbox-strict-fields #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
......
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, ExistentialQuantification #-} {-# LANGUAGE NoImplicitPrelude, ExistentialQuantification #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
...@@ -44,11 +44,8 @@ module Control.Exception ( ...@@ -44,11 +44,8 @@ module Control.Exception (
AsyncException(..), -- instance Eq, Ord, Show, Typeable, Exception AsyncException(..), -- instance Eq, Ord, Show, Typeable, Exception
asyncExceptionToException, asyncExceptionFromException, asyncExceptionToException, asyncExceptionFromException,
#if __GLASGOW_HASKELL__
NonTermination(..), NonTermination(..),
NestedAtomically(..), NestedAtomically(..),
#endif
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
Deadlock(..), Deadlock(..),
...@@ -63,9 +60,7 @@ module Control.Exception ( ...@@ -63,9 +60,7 @@ module Control.Exception (
throw, throw,
throwIO, throwIO,
ioError, ioError,
#ifdef __GLASGOW_HASKELL__
throwTo, throwTo,
#endif
-- * Catching Exceptions -- * Catching Exceptions
...@@ -136,13 +131,9 @@ module Control.Exception ( ...@@ -136,13 +131,9 @@ module Control.Exception (
import Control.Exception.Base import Control.Exception.Base
#ifdef __GLASGOW_HASKELL__
import GHC.Base import GHC.Base
import GHC.IO (unsafeUnmask) import GHC.IO (unsafeUnmask)
import Data.Maybe import Data.Maybe
#else
import Prelude hiding (catch)
#endif
-- | You need this when using 'catches'. -- | You need this when using 'catches'.
data Handler a = forall e . Exception e => Handler (e -> IO a) data Handler a = forall e . Exception e => Handler (e -> IO a)
......
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
#ifdef __GLASGOW_HASKELL__
{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
#endif
#include "Typeable.h" #include "Typeable.h"
...@@ -31,12 +29,8 @@ module Control.Exception.Base ( ...@@ -31,12 +29,8 @@ module Control.Exception.Base (
AssertionFailed(..), AssertionFailed(..),
SomeAsyncException(..), AsyncException(..), SomeAsyncException(..), AsyncException(..),
asyncExceptionToException, asyncExceptionFromException, asyncExceptionToException, asyncExceptionFromException,
#ifdef __GLASGOW_HASKELL__
NonTermination(..), NonTermination(..),
NestedAtomically(..), NestedAtomically(..),
#endif
BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..), BlockedIndefinitelyOnSTM(..),
Deadlock(..), Deadlock(..),
...@@ -51,9 +45,7 @@ module Control.Exception.Base ( ...@@ -51,9 +45,7 @@ module Control.Exception.Base (
throwIO, throwIO,
throw, throw,
ioError, ioError,
#ifdef __GLASGOW_HASKELL__
throwTo, throwTo,
#endif
-- * Catching Exceptions -- * Catching Exceptions
...@@ -98,16 +90,13 @@ module Control.Exception.Base ( ...@@ -98,16 +90,13 @@ module Control.Exception.Base (
finally, finally,
#ifdef __GLASGOW_HASKELL__
-- * Calls for GHC runtime -- * Calls for GHC runtime
recSelError, recConError, irrefutPatError, runtimeError, recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError, nonExhaustiveGuardsError, patError, noMethodBindingError,
absentError, absentError,
nonTermination, nestedAtomically, nonTermination, nestedAtomically,
#endif
) where ) where
#ifdef __GLASGOW_HASKELL__
import GHC.Base import GHC.Base
import GHC.IO hiding (bracket,finally,onException) import GHC.IO hiding (bracket,finally,onException)
import GHC.IO.Exception import GHC.IO.Exception
...@@ -115,7 +104,6 @@ import GHC.Exception ...@@ -115,7 +104,6 @@ import GHC.Exception
import GHC.Show import GHC.Show
-- import GHC.Exception hiding ( Exception ) -- import GHC.Exception hiding ( Exception )
import GHC.Conc.Sync import GHC.Conc.Sync
#endif
import Data.Dynamic import Data.Dynamic
import Data.Either import Data.Either
...@@ -161,9 +149,7 @@ catch :: Exception e ...@@ -161,9 +149,7 @@ catch :: Exception e
=> IO a -- ^ The computation to run => IO a -- ^ The computation to run
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a -> IO a
#if __GLASGOW_HASKELL__
catch = catchException catch = catchException
#endif
-- | The function 'catchJust' is like 'catch', but it takes an extra -- | The function 'catchJust' is like 'catch', but it takes an extra
-- argument which is an /exception predicate/, a function which -- argument which is an /exception predicate/, a function which
...@@ -309,15 +295,8 @@ bracketOnError before after thing = ...@@ -309,15 +295,8 @@ bracketOnError before after thing =
a <- before a <- before
restore (thing a) `onException` after a restore (thing a) `onException` after a
#if !__GLASGOW_HASKELL__
assert :: Bool -> a -> a
assert True x = x
assert False _ = throw (AssertionFailed "")
#endif
----- -----
#if __GLASGOW_HASKELL__
-- |A pattern match failed. The @String@ gives information about the -- |A pattern match failed. The @String@ gives information about the
-- source location of the pattern. -- source location of the pattern.
data PatternMatchFail = PatternMatchFail String data PatternMatchFail = PatternMatchFail String
...@@ -412,9 +391,6 @@ instance Exception NestedAtomically ...@@ -412,9 +391,6 @@ instance Exception NestedAtomically
----- -----
#endif /* __GLASGOW_HASKELL__ */
#ifdef __GLASGOW_HASKELL__
recSelError, recConError, irrefutPatError, runtimeError, recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError, nonExhaustiveGuardsError, patError, noMethodBindingError,
absentError absentError
...@@ -438,4 +414,3 @@ nonTermination = toException NonTermination ...@@ -438,4 +414,3 @@ nonTermination = toException NonTermination
-- GHC's RTS calls this -- GHC's RTS calls this
nestedAtomically :: SomeException nestedAtomically :: SomeException
nestedAtomically = toException NestedAtomically nestedAtomically = toException NestedAtomically
#endif
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP, NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
...@@ -78,12 +78,9 @@ module Control.Monad ...@@ -78,12 +78,9 @@ module Control.Monad
import Data.Maybe import Data.Maybe
#ifdef __GLASGOW_HASKELL__
import GHC.List import GHC.List
import GHC.Base import GHC.Base
#endif
#ifdef __GLASGOW_HASKELL__
infixr 1 =<< infixr 1 =<<
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -118,8 +115,6 @@ mapM_ :: Monad m => (a -> m b) -> [a] -> m () ...@@ -118,8 +115,6 @@ mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
{-# INLINE mapM_ #-} {-# INLINE mapM_ #-}
mapM_ f as = sequence_ (map f as) mapM_ f as = sequence_ (map f as)
#endif /* __GLASGOW_HASKELL__ */
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- The MonadPlus class definition -- The MonadPlus class definition
......
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
...@@ -26,9 +25,7 @@ module Control.Monad.Fix ( ...@@ -26,9 +25,7 @@ module Control.Monad.Fix (
import Prelude import Prelude
import System.IO import System.IO
import Data.Function (fix) import Data.Function (fix)
#if defined(__GLASGOW_HASKELL__)
import GHC.ST import GHC.ST
#endif
-- | Monads having fixed points with a \'knot-tying\' semantics. -- | Monads having fixed points with a \'knot-tying\' semantics.
-- Instances of 'MonadFix' should satisfy the following laws: -- Instances of 'MonadFix' should satisfy the following laws:
...@@ -78,8 +75,5 @@ instance MonadFix (Either e) where ...@@ -78,8 +75,5 @@ instance MonadFix (Either e) where
where unRight (Right x) = x where unRight (Right x) = x
unRight (Left _) = error "mfix Either: Left" unRight (Left _) = error "mfix Either: Left"