[commit: ghc] master: Delete __GLASGOW_HASKELL__ ifdefs for stage0 < 7.8 (e0a3c44)
git at git.haskell.org
git at git.haskell.org
Tue Jul 21 11:57:34 UTC 2015
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/e0a3c441412923bb8b422281cf2e0f8f2841d6c1/ghc
>---------------------------------------------------------------
commit e0a3c441412923bb8b422281cf2e0f8f2841d6c1
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date: Tue Jul 21 13:02:29 2015 +0200
Delete __GLASGOW_HASKELL__ ifdefs for stage0 < 7.8
Reviewers: austin, goldfire, bgamari
Reviewed By: bgamari
Subscribers: bgamari, thomie
Differential Revision: https://phabricator.haskell.org/D904
>---------------------------------------------------------------
e0a3c441412923bb8b422281cf2e0f8f2841d6c1
compiler/hsSyn/HsExpr.hs-boot | 12 -------
compiler/hsSyn/HsPat.hs-boot | 8 -----
compiler/utils/Fingerprint.hsc | 39 +---------------------
compiler/utils/Serialized.hs | 10 ------
ghc/hschooks.c | 4 ---
.../template-haskell/Language/Haskell/TH/Syntax.hs | 6 ----
6 files changed, 1 insertion(+), 78 deletions(-)
diff --git a/compiler/hsSyn/HsExpr.hs-boot b/compiler/hsSyn/HsExpr.hs-boot
index 4b9f968..eb9d23a 100644
--- a/compiler/hsSyn/HsExpr.hs-boot
+++ b/compiler/hsSyn/HsExpr.hs-boot
@@ -3,9 +3,7 @@
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
-#if __GLASGOW_HASKELL__ > 706
{-# LANGUAGE RoleAnnotations #-}
-#endif
module HsExpr where
@@ -15,31 +13,21 @@ import {-# SOURCE #-} HsPat ( LPat )
import PlaceHolder ( DataId )
import Data.Data hiding ( Fixity )
-#if __GLASGOW_HASKELL__ > 706
type role HsExpr nominal
type role HsCmd nominal
type role MatchGroup nominal representational
type role GRHSs nominal representational
type role HsSplice nominal
-#endif
data HsExpr (i :: *)
data HsCmd (i :: *)
data HsSplice (i :: *)
data MatchGroup (a :: *) (body :: *)
data GRHSs (a :: *) (body :: *)
-#if __GLASGOW_HASKELL__ > 706
instance Typeable HsSplice
instance Typeable HsExpr
instance Typeable MatchGroup
instance Typeable GRHSs
-#else
-instance Typeable1 HsSplice
-instance Typeable1 HsExpr
-instance Typeable1 HsCmd
-instance Typeable2 MatchGroup
-instance Typeable2 GRHSs
-#endif
instance (DataId id) => Data (HsSplice id)
instance (DataId id) => Data (HsExpr id)
diff --git a/compiler/hsSyn/HsPat.hs-boot b/compiler/hsSyn/HsPat.hs-boot
index 114425b..c6ab5a5 100644
--- a/compiler/hsSyn/HsPat.hs-boot
+++ b/compiler/hsSyn/HsPat.hs-boot
@@ -3,9 +3,7 @@
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
-#if __GLASGOW_HASKELL__ > 706
{-# LANGUAGE RoleAnnotations #-}
-#endif
module HsPat where
import SrcLoc( Located )
@@ -14,17 +12,11 @@ import Data.Data hiding (Fixity)
import Outputable
import PlaceHolder ( DataId )
-#if __GLASGOW_HASKELL__ > 706
type role Pat nominal
-#endif
data Pat (i :: *)
type LPat i = Located (Pat i)
-#if __GLASGOW_HASKELL__ > 706
instance Typeable Pat
-#else
-instance Typeable1 Pat
-#endif
instance (DataId id) => Data (Pat id)
instance (OutputableBndr name) => Outputable (Pat name)
diff --git a/compiler/utils/Fingerprint.hsc b/compiler/utils/Fingerprint.hsc
index 464337b..ed4cd6f 100644
--- a/compiler/utils/Fingerprint.hsc
+++ b/compiler/utils/Fingerprint.hsc
@@ -15,7 +15,7 @@ module Fingerprint (
readHexFingerprint,
fingerprintData,
fingerprintString,
- -- Re-exported from GHC.Fingerprint for GHC >= 7.7, local otherwise
+ -- Re-exported from GHC.Fingerprint
getFileHash
) where
@@ -23,13 +23,6 @@ module Fingerprint (
##include "HsVersions.h"
import Numeric ( readHex )
-#if __GLASGOW_HASKELL__ < 707
--- Only needed for getFileHash below.
-import Foreign
-import Panic
-import System.IO
-import Control.Monad ( when )
-#endif
import GHC.Fingerprint
@@ -39,33 +32,3 @@ readHexFingerprint s = Fingerprint w1 w2
where (s1,s2) = splitAt 16 s
[(w1,"")] = readHex s1
[(w2,"")] = readHex (take 16 s2)
-
-
-#if __GLASGOW_HASKELL__ < 707
--- Only use this if we're smaller than GHC 7.7, otherwise
--- GHC.Fingerprint exports a better version of this function.
-
--- | Computes the hash of a given file.
--- It loads the full file into memory an does not work with files bigger than
--- MAXINT.
-getFileHash :: FilePath -> IO Fingerprint
-getFileHash path = withBinaryFile path ReadMode $ \h -> do
-
- fileSize <- toIntFileSize `fmap` hFileSize h
-
- allocaBytes fileSize $ \bufPtr -> do
- n <- hGetBuf h bufPtr fileSize
- when (n /= fileSize) readFailedError
- fingerprintData bufPtr fileSize
-
- where
- toIntFileSize :: Integer -> Int
- toIntFileSize size
- | size > fromIntegral (maxBound :: Int) = throwGhcException $
- Sorry $ "Fingerprint.getFileHash: Tried to calculate hash of file "
- ++ path ++ " with size > maxBound :: Int. This is not supported."
- | otherwise = fromIntegral size
-
- readFailedError = throwGhcException $
- Panic $ "Fingerprint.getFileHash: hGetBuf failed on interface file"
-#endif
diff --git a/compiler/utils/Serialized.hs b/compiler/utils/Serialized.hs
index d4e0048..01fa071 100644
--- a/compiler/utils/Serialized.hs
+++ b/compiler/utils/Serialized.hs
@@ -96,26 +96,16 @@ deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->
x -> error $ "deserializeConstr: unrecognised serialized constructor type " ++ show x ++ " in context " ++ show bytes
-#if __GLASGOW_HASKELL__ < 707
-serializeFixedWidthNum :: forall a. (Num a, Integral a, Bits a) => a -> [Word8] -> [Word8]
-serializeFixedWidthNum what = go (bitSize what) what
-#else
serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum what = go (finiteBitSize what) what
-#endif
where
go :: Int -> a -> [Word8] -> [Word8]
go size current rest
| size <= 0 = rest
| otherwise = fromIntegral (current .&. 255) : go (size - 8) (current `shiftR` 8) rest
-#if __GLASGOW_HASKELL__ < 707
-deserializeFixedWidthNum :: forall a b. (Num a, Integral a, Bits a) => [Word8] -> (a -> [Word8] -> b) -> b
-deserializeFixedWidthNum bytes k = go (bitSize (undefined :: a)) bytes k
-#else
deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k
-#endif
where
go :: Int -> [Word8] -> (a -> [Word8] -> b) -> b
go size bytes k
diff --git a/ghc/hschooks.c b/ghc/hschooks.c
index 2ebbace..46a0944 100644
--- a/ghc/hschooks.c
+++ b/ghc/hschooks.c
@@ -30,14 +30,10 @@ initGCStatistics(void)
void
defaultsHook (void)
{
-#if __GLASGOW_HASKELL__ >= 707
// This helps particularly with large compiles, but didn't work
// very well with earlier GHCs because it caused large amounts of
// fragmentation. See rts/sm/BlockAlloc.c:allocLargeChunk().
RtsFlags.GcFlags.heapSizeSuggestionAuto = rtsTrue;
-#else
- RtsFlags.GcFlags.heapSizeSuggestion = 6*1024*1024 / BLOCK_SIZE;
-#endif
RtsFlags.GcFlags.maxStkSize = 512*1024*1024 / sizeof(W_);
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index b1f70f8..d2233a1 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -2,12 +2,8 @@
DeriveGeneric, FlexibleInstances, DefaultSignatures,
ScopedTypeVariables, Rank2Types #-}
-#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE RoleAnnotations #-}
{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
-#else
-{-# OPTIONS_GHC -w #-} -- -fno-warn-inline-rule-shadowing doesn't exist
-#endif
#if MIN_VERSION_base(4,8,0)
#define HAS_NATURAL
@@ -178,9 +174,7 @@ instance Applicative Q where
--
-----------------------------------------------------
-#if __GLASGOW_HASKELL__ >= 707
type role TExp nominal -- See Note [Role of TExp]
-#endif
newtype TExp a = TExp { unType :: Exp }
unTypeQ :: Q (TExp a) -> Q Exp
More information about the ghc-commits
mailing list