From 317fc69d18eda68fd65f5ba634feafbe4a3923da Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Fri, 6 Apr 2007 00:11:37 +0000 Subject: [PATCH] Remove code that is dead, as we require __GLASGOW_HASKELL__ >= 504 --- compiler/basicTypes/UniqSupply.lhs | 4 -- compiler/basicTypes/Unique.lhs | 12 +----- compiler/cmm/PprC.hs | 48 +++++----------------- compiler/ghci/Linker.lhs | 7 ---- compiler/main/DriverMkDepend.hs | 3 -- compiler/main/StaticFlags.hs | 5 --- compiler/nativeGen/MachRegs.lhs | 5 --- compiler/nativeGen/PprMach.hs | 78 +++++++++++------------------------- compiler/parser/LexCore.hs | 38 +----------------- compiler/parser/Lexer.x | 5 --- compiler/parser/cutils.c | 14 ------- compiler/parser/hschooks.c | 14 ------- compiler/prelude/PrelRules.lhs | 18 --------- compiler/simplCore/SimplMonad.lhs | 4 -- compiler/utils/Binary.hs | 23 +---------- compiler/utils/Digraph.lhs | 17 ++------ compiler/utils/FastMutInt.lhs | 4 -- compiler/utils/Panic.lhs | 23 +---------- compiler/utils/Pretty.lhs | 9 ----- compiler/utils/UniqFM.lhs | 12 +----- compiler/utils/Util.lhs | 4 -- 21 files changed, 43 insertions(+), 304 deletions(-) diff --git a/compiler/basicTypes/UniqSupply.lhs b/compiler/basicTypes/UniqSupply.lhs index 710fc03..424dbe2 100644 --- a/compiler/basicTypes/UniqSupply.lhs +++ b/compiler/basicTypes/UniqSupply.lhs @@ -63,11 +63,7 @@ uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite \begin{code} mkSplitUniqSupply (C# c#) = let -#if __GLASGOW_HASKELL__ >= 503 mask# = (i2w (ord# c#)) `uncheckedShiftL#` (i2w_s 24#) -#else - mask# = (i2w (ord# c#)) `shiftL#` (i2w_s 24#) -#endif -- here comes THE MAGIC: -- This is one of the most hammered bits in the whole compiler diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs index 058b0be..a0b28f8 100644 --- a/compiler/basicTypes/Unique.lhs +++ b/compiler/basicTypes/Unique.lhs @@ -120,25 +120,15 @@ i2w_s x = (x::Int#) mkUnique (C# c) (I# i) = MkUnique (w2i (tag `or#` bits)) where -#if __GLASGOW_HASKELL__ >= 503 tag = i2w (ord# c) `uncheckedShiftL#` i2w_s 24# -#else - tag = i2w (ord# c) `shiftL#` i2w_s 24# -#endif bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-} unpkUnique (MkUnique u) = let - tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#)))) + tag = C# (chr# (w2i ((i2w u) `uncheckedShiftRL#` (i2w_s 24#)))) i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-})) in (tag, i) - where -#if __GLASGOW_HASKELL__ >= 503 - shiftr x y = uncheckedShiftRL# x y -#else - shiftr x y = shiftRL# x y -#endif \end{code} diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index fa92911..b8ba5b7 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -51,9 +51,7 @@ import PprCmm () -- instances only -- import Debug.Trace #endif -#if __GLASGOW_HASKELL__ >= 504 import Data.Array.ST -#endif import Control.Monad.ST #if x86_64_TARGET_ARCH @@ -965,46 +963,20 @@ big_doubles | machRepByteWidth F64 == wORD_SIZE = False | otherwise = panic "big_doubles" -#if __GLASGOW_HASKELL__ >= 504 -newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float) -newFloatArray = newArray_ - -newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double) -newDoubleArray = newArray_ - castFloatToIntArray :: STUArray s Int Float -> ST s (STUArray s Int Int) castFloatToIntArray = castSTUArray castDoubleToIntArray :: STUArray s Int Double -> ST s (STUArray s Int Int) castDoubleToIntArray = castSTUArray -writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s () -writeFloatArray = writeArray - -writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s () -writeDoubleArray = writeArray - -readIntArray :: STUArray s Int Int -> Int -> ST s Int -readIntArray = readArray - -#else - -castFloatToIntArray :: MutableByteArray s t -> ST s (MutableByteArray s t) -castFloatToIntArray = return - -castDoubleToIntArray :: MutableByteArray s t -> ST s (MutableByteArray s t) -castDoubleToIntArray = return - -#endif - -- floats are always 1 word floatToWord :: Rational -> CmmLit floatToWord r = runST (do - arr <- newFloatArray ((0::Int),0) - writeFloatArray arr 0 (fromRational r) + arr <- newArray_ ((0::Int),0) + writeArray arr 0 (fromRational r) arr' <- castFloatToIntArray arr - i <- readIntArray arr' 0 + i <- readArray arr' 0 return (CmmInt (toInteger i) wordRep) ) @@ -1012,21 +984,21 @@ doubleToWords :: Rational -> [CmmLit] doubleToWords r | big_doubles -- doubles are 2 words = runST (do - arr <- newDoubleArray ((0::Int),1) - writeDoubleArray arr 0 (fromRational r) + arr <- newArray_ ((0::Int),1) + writeArray arr 0 (fromRational r) arr' <- castDoubleToIntArray arr - i1 <- readIntArray arr' 0 - i2 <- readIntArray arr' 1 + i1 <- readArray arr' 0 + i2 <- readArray arr' 1 return [ CmmInt (toInteger i1) wordRep , CmmInt (toInteger i2) wordRep ] ) | otherwise -- doubles are 1 word = runST (do - arr <- newDoubleArray ((0::Int),0) - writeDoubleArray arr 0 (fromRational r) + arr <- newArray_ ((0::Int),0) + writeArray arr 0 (fromRational r) arr' <- castDoubleToIntArray arr - i <- readIntArray arr' 0 + i <- readArray arr' 0 return [ CmmInt (toInteger i) wordRep ] ) diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 4508e4b..2c1b668 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -68,13 +68,6 @@ import System.Directory import Control.Exception import Data.Maybe - -#if __GLASGOW_HASKELL__ >= 503 -import GHC.IOBase ( IO(..) ) -#else -import PrelIOBase ( IO(..) ) -#endif - \end{code} diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index af917bd..b24c14e 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -29,9 +29,6 @@ import SrcLoc import Data.List import CmdLineParser -#if __GLASGOW_HASKELL__ <= 408 -import Panic ( catchJust, ioErrors ) -#endif import ErrUtils ( debugTraceMsg, putMsg ) import Data.IORef ( IORef, readIORef, writeIORef ) diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index be70daa..2b67159 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -417,13 +417,8 @@ decodeSize str ----------------------------------------------------------------------------- -- RTS Hooks -#if __GLASGOW_HASKELL__ >= 504 foreign import ccall unsafe "setHeapSize" setHeapSize :: Int -> IO () foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO () -#else -foreign import "setHeapSize" unsafe setHeapSize :: Int -> IO () -foreign import "enableTimingStats" unsafe enableTimingStats :: IO () -#endif ----------------------------------------------------------------------------- -- Ways diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs index bffb723..df3be5e 100644 --- a/compiler/nativeGen/MachRegs.lhs +++ b/compiler/nativeGen/MachRegs.lhs @@ -96,13 +96,8 @@ import Constants import FastTypes #if powerpc_TARGET_ARCH -#if __GLASGOW_HASKELL__ >= 504 import Data.Word ( Word8, Word16, Word32 ) import Data.Int ( Int8, Int16, Int32 ) -#else -import Word ( Word8, Word16, Word32 ) -import Int ( Int8, Int16, Int32 ) -#endif #endif -- ----------------------------------------------------------------------------- diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 5c731f1..1534ec7 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -2395,41 +2395,11 @@ limitShiftRI x = x -- ----------------------------------------------------------------------------- -- Converting floating-point literals to integrals for printing -#if __GLASGOW_HASKELL__ >= 504 -newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float) -newFloatArray = newArray_ +castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8) +castFloatToWord8Array = castSTUArray -newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double) -newDoubleArray = newArray_ - -castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8) -castFloatToCharArray = castSTUArray - -castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8) -castDoubleToCharArray = castSTUArray - -writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s () -writeFloatArray = writeArray - -writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s () -writeDoubleArray = writeArray - -readCharArray :: STUArray s Int Word8 -> Int -> ST s Char -readCharArray arr i = do - w <- readArray arr i - return $! (chr (fromIntegral w)) - -#else - -castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t) -castFloatToCharArray = return - -castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t) - - -castDoubleToCharArray = return - -#endif +castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8) +castDoubleToWord8Array = castSTUArray -- floatToBytes and doubleToBytes convert to the host's byte -- order. Providing that we're not cross-compiling for a @@ -2442,29 +2412,29 @@ castDoubleToCharArray = return floatToBytes :: Float -> [Int] floatToBytes f = runST (do - arr <- newFloatArray ((0::Int),3) - writeFloatArray arr 0 f - arr <- castFloatToCharArray arr - i0 <- readCharArray arr 0 - i1 <- readCharArray arr 1 - i2 <- readCharArray arr 2 - i3 <- readCharArray arr 3 - return (map ord [i0,i1,i2,i3]) + arr <- newArray_ ((0::Int),3) + writeArray arr 0 f + arr <- castFloatToWord8Array arr + i0 <- readArray arr 0 + i1 <- readArray arr 1 + i2 <- readArray arr 2 + i3 <- readArray arr 3 + return (map fromIntegral [i0,i1,i2,i3]) ) doubleToBytes :: Double -> [Int] doubleToBytes d = runST (do - arr <- newDoubleArray ((0::Int),7) - writeDoubleArray arr 0 d - arr <- castDoubleToCharArray arr - i0 <- readCharArray arr 0 - i1 <- readCharArray arr 1 - i2 <- readCharArray arr 2 - i3 <- readCharArray arr 3 - i4 <- readCharArray arr 4 - i5 <- readCharArray arr 5 - i6 <- readCharArray arr 6 - i7 <- readCharArray arr 7 - return (map ord [i0,i1,i2,i3,i4,i5,i6,i7]) + arr <- newArray_ ((0::Int),7) + writeArray arr 0 d + arr <- castDoubleToWord8Array arr + i0 <- readArray arr 0 + i1 <- readArray arr 1 + i2 <- readArray arr 2 + i3 <- readArray arr 3 + i4 <- readArray arr 4 + i5 <- readArray arr 5 + i6 <- readArray arr 6 + i7 <- readArray arr 7 + return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7]) ) diff --git a/compiler/parser/LexCore.hs b/compiler/parser/LexCore.hs index 7be074a..936786d 100644 --- a/compiler/parser/LexCore.hs +++ b/compiler/parser/LexCore.hs @@ -3,7 +3,7 @@ module LexCore where import ParserCoreUtils import Ratio import Char -import qualified Numeric( readFloat, readDec ) +import Numeric isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') || (c == ':') || (c == '$') @@ -97,39 +97,3 @@ lexKeyword cont cs = ("_",rest) -> cont TKwild rest _ -> failP "invalid keyword" ('%':cs) - -#if __GLASGOW_HASKELL__ >= 504 --- The readFloat in the Numeric library will do the job - -readFloat :: (RealFrac a) => ReadS a -readFloat = Numeric.readFloat - -#else --- Haskell 98's Numeric.readFloat used to have a bogusly restricted signature --- so it was incapable of reading a rational. --- So for GHCs that have that old bogus library, here is the code, written out longhand. - -readFloat r = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r, - (k,t) <- readExp s] ++ - [ (0/0, t) | ("NaN",t) <- lex r] ++ - [ (1/0, t) | ("Infinity",t) <- lex r] - where - readFix r = [(read (ds++ds'), length ds', t) - | (ds,d) <- lexDigits r, - (ds',t) <- lexFrac d ] - - lexFrac ('.':ds) = lexDigits ds - lexFrac s = [("",s)] - - readExp (e:s) | e `elem` "eE" = readExp' s - readExp s = [(0,s)] - - readExp' ('-':s) = [(-k,t) | (k,t) <- Numeric.readDec s] - readExp' ('+':s) = Numeric.readDec s - readExp' s = Numeric.readDec s - -lexDigits :: ReadS String -lexDigits s = case span isDigit s of - (cs,s') | not (null cs) -> [(cs,s')] - otherwise -> [] -#endif diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 0526b1e..d9a0fb0 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -379,11 +379,6 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } } { --- work around bug in Alex 2.0 -#if __GLASGOW_HASKELL__ < 503 -unsafeAt arr i = arr ! i -#endif - -- ----------------------------------------------------------------------------- -- The token type diff --git a/compiler/parser/cutils.c b/compiler/parser/cutils.c index 08832f2..4a7b7b3 100644 --- a/compiler/parser/cutils.c +++ b/compiler/parser/cutils.c @@ -3,19 +3,8 @@ These utility routines are used various places in the GHC library. */ -/* For GHC 4.08, we are relying on the fact that RtsFlags has - * compatible layout with the current version, because we're - * #including the current version of RtsFlags.h below. 4.08 didn't - * ship with its own RtsFlags.h, unfortunately. For later GHC - * versions, we #include the correct RtsFlags.h. - */ -#if __GLASGOW_HASKELL__ < 502 -#include "../includes/Rts.h" -#include "../includes/RtsFlags.h" -#else #include "Rts.h" #include "RtsFlags.h" -#endif #include "HsFFI.h" @@ -51,10 +40,7 @@ ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len ) void enableTimingStats( void ) /* called from the driver */ { -#if __GLASGOW_HASKELL__ >= 411 RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS; -#endif - /* ignored when bootstrapping with an older GHC */ } void diff --git a/compiler/parser/hschooks.c b/compiler/parser/hschooks.c index 5c87b31..9ccb345 100644 --- a/compiler/parser/hschooks.c +++ b/compiler/parser/hschooks.c @@ -4,19 +4,8 @@ for various bits of the RTS. They are linked in instead of the defaults. */ -/* For GHC 4.08, we are relying on the fact that RtsFlags has - * compatible layout with the current version, because we're - * #including the current version of RtsFlags.h below. 4.08 didn't - * ship with its own RtsFlags.h, unfortunately. For later GHC - * versions, we #include the correct RtsFlags.h. - */ -#if __GLASGOW_HASKELL__ < 502 -#include "../includes/Rts.h" -#include "../includes/RtsFlags.h" -#else #include "Rts.h" #include "RtsFlags.h" -#endif #include "HsFFI.h" @@ -31,11 +20,8 @@ defaultsHook (void) { RtsFlags.GcFlags.heapSizeSuggestion = 6*1024*1024 / BLOCK_SIZE; RtsFlags.GcFlags.maxStkSize = 8*1024*1024 / sizeof(W_); -#if __GLASGOW_HASKELL__ >= 411 - /* GHC < 4.11 didn't have these */ RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS; RtsFlags.GcFlags.statsFile = stderr; -#endif } void diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 3863351..747817b 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -47,11 +47,7 @@ import StaticFlags ( opt_SimplExcessPrecision ) import Data.Bits as Bits ( Bits(..), shiftL, shiftR ) -- shiftL and shiftR were not always methods of Bits -#if __GLASGOW_HASKELL__ >= 500 import Data.Word ( Word ) -#else -import Data.Word ( Word64 ) -#endif \end{code} @@ -104,18 +100,14 @@ primOpRules op op_name = primop_rule op primop_rule ISrlOp = two_lits (intShiftOp2 shiftRightLogical) -- Word operations -#if __GLASGOW_HASKELL__ >= 500 primop_rule WordAddOp = two_lits (wordOp2 (+)) primop_rule WordSubOp = two_lits (wordOp2 (-)) primop_rule WordMulOp = two_lits (wordOp2 (*)) -#endif primop_rule WordQuotOp = two_lits (wordOp2Z quot) primop_rule WordRemOp = two_lits (wordOp2Z rem) -#if __GLASGOW_HASKELL__ >= 407 primop_rule AndOp = two_lits (wordBitOp2 (.&.)) primop_rule OrOp = two_lits (wordBitOp2 (.|.)) primop_rule XorOp = two_lits (wordBitOp2 xor) -#endif primop_rule SllOp = two_lits (wordShiftOp2 Bits.shiftL) primop_rule SrlOp = two_lits (wordShiftOp2 shiftRightLogical) @@ -261,26 +253,18 @@ shiftRightLogical x n = fromIntegral (fromInteger x `shiftR` n :: Word) -------------------------- -#if __GLASGOW_HASKELL__ >= 500 wordOp2 :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr wordOp2 op (MachWord w1) (MachWord w2) = wordResult (w1 `op` w2) wordOp2 op l1 l2 = Nothing -- Could find LitLit -#endif wordOp2Z :: (Integer->Integer->Integer) -> Literal -> Literal -> Maybe CoreExpr wordOp2Z op (MachWord w1) (MachWord w2) | w2 /= 0 = wordResult (w1 `op` w2) wordOp2Z op l1 l2 = Nothing -- LitLit or zero dividend -#if __GLASGOW_HASKELL__ >= 500 wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2) = wordResult (w1 `op` w2) -#else --- Integer is not an instance of Bits, so we operate on Word64 -wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2) - = wordResult ((fromIntegral::Word64->Integer) (fromIntegral w1 `op` fromIntegral w2)) -#endif wordBitOp2 op l1 l2 = Nothing -- Could find LitLit wordShiftOp2 :: (Integer->Int->Integer) -> Literal -> Literal -> Maybe CoreExpr @@ -360,11 +344,9 @@ intResult :: Integer -> Maybe CoreExpr intResult result = Just (mkIntVal (toInteger (fromInteger result :: Int))) -#if __GLASGOW_HASKELL__ >= 500 wordResult :: Integer -> Maybe CoreExpr wordResult result = Just (mkWordVal (toInteger (fromInteger result :: Word))) -#endif \end{code} diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 5b6ac40..a198b32 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -43,11 +43,7 @@ import FastTypes import GHC.Exts ( indexArray# ) -#if __GLASGOW_HASKELL__ < 503 -import PrelArr ( Array(..) ) -#else import GHC.Arr ( Array(..) ) -#endif import Array ( array, (//) ) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index e479b79..6bce832 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -202,12 +202,6 @@ writeBinMem (BinMem _ ix_r sz_r arr_r) fn = do arr <- readIORef arr_r ix <- readFastMutInt ix_r hPutArray h arr ix -#if __GLASGOW_HASKELL__ <= 500 - -- workaround a bug in old implementation of hPutBuf (it doesn't - -- set the FILEOBJ_RW_WRITTEN flag on the file object, so the file doens't - -- get flushed properly). Adding an extra '\0' doens't do any harm. - hPutChar h '\0' -#endif hClose h readBinMem :: FilePath -> IO BinHandle @@ -272,11 +266,7 @@ getWord8 (BinMem _ ix_r sz_r arr_r) = do ix <- readFastMutInt ix_r sz <- readFastMutInt sz_r when (ix >= sz) $ -#if __GLASGOW_HASKELL__ <= 408 - throw (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) -#else ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) -#endif arr <- readIORef arr_r w <- unsafeRead arr ix writeFastMutInt ix_r (ix+1) @@ -516,23 +506,12 @@ freezeByteArray arr = IO $ \s -> (# s, BA arr #) } writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO () - -#if __GLASGOW_HASKELL__ < 503 -writeByteArray arr i w8 = IO $ \s -> - case word8ToWord w8 of { W# w# -> - case writeCharArray# arr i (chr# (word2Int# w#)) s of { s -> - (# s , () #) }} -#else writeByteArray arr i (W8# w) = IO $ \s -> case writeWord8Array# arr i w s of { s -> (# s, () #) } -#endif -#if __GLASGOW_HASKELL__ < 503 -indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#))) -#else +indexByteArray :: ByteArray# -> Int# -> Word8 indexByteArray a# n# = W8# (indexWord8Array# a# n#) -#endif instance (Integral a, Binary a) => Binary (Ratio a) where put_ bh (a :% b) = do put_ bh a; put_ bh b diff --git a/compiler/utils/Digraph.lhs b/compiler/utils/Digraph.lhs index 669f718..9129d9d 100644 --- a/compiler/utils/Digraph.lhs +++ b/compiler/utils/Digraph.lhs @@ -252,27 +252,16 @@ draw (Node x ts) = grp this (space (length this)) (stLoop ts) %************************************************************************ \begin{code} -#if __GLASGOW_HASKELL__ >= 504 -newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e) -newSTArray = newArray - -readSTArray :: Ix i => STArray s i e -> i -> ST s e -readSTArray = readArray - -writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s () -writeSTArray = writeArray -#endif - type Set s = STArray s Vertex Bool mkEmpty :: Bounds -> ST s (Set s) -mkEmpty bnds = newSTArray bnds False +mkEmpty bnds = newArray bnds False contains :: Set s -> Vertex -> ST s Bool -contains m v = readSTArray m v +contains m v = readArray m v include :: Set s -> Vertex -> ST s () -include m v = writeSTArray m v True +include m v = writeArray m v True \end{code} \begin{code} diff --git a/compiler/utils/FastMutInt.lhs b/compiler/utils/FastMutInt.lhs index 86ca0bd..3c2a199 100644 --- a/compiler/utils/FastMutInt.lhs +++ b/compiler/utils/FastMutInt.lhs @@ -19,10 +19,6 @@ module FastMutInt( import GHC.Base import GHC.IOBase - -#if __GLASGOW_HASKELL__ < 411 -newByteArray# = newCharArray# -#endif \end{code} \begin{code} diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index eb3ce78..53d75b0 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -39,7 +39,7 @@ import Posix ( Handler(Catch), installHandler, sigINT, sigQUIT ) import GHC.ConsoleHandler #endif -import Control.Exception hiding (try) +import Control.Exception import Control.Concurrent ( myThreadId, MVar, ThreadId, withMVar, newMVar ) import Data.Dynamic import qualified Control.Exception as Exception @@ -171,33 +171,14 @@ tryMost action = do r <- try action; filter r tryUser :: IO a -> IO (Either Exception.Exception a) tryUser action = tryJust tc_errors action where -#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500 +#if __GLASGOW_HASKELL__ > 504 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e -#elif __GLASGOW_HASKELL__ == 502 - tc_errors e@(UserError _) = Just e #else tc_errors e@(Exception.IOException ioe) | isUserError e = Just e #endif tc_errors _other = Nothing \end{code} -Compatibility stuff: - -\begin{code} -#if __GLASGOW_HASKELL__ <= 408 -try = Exception.tryAllIO -#else -try = Exception.try -#endif - -#if __GLASGOW_HASKELL__ <= 408 -catchJust = Exception.catchIO -tryJust = Exception.tryIO -ioErrors = Exception.justIoErrors -throwTo = Exception.raiseInThread -#endif -\end{code} - Standard signal handlers for catching ^C, which just throw an exception in the target thread. The current target thread is the thread at the head of the list in the MVar passed to diff --git a/compiler/utils/Pretty.lhs b/compiler/utils/Pretty.lhs index 0fc817f..f611d7a 100644 --- a/compiler/utils/Pretty.lhs +++ b/compiler/utils/Pretty.lhs @@ -1022,11 +1022,7 @@ printDoc mode hdl doc -- some versions of hPutBuf will barf if the length is zero hPutLitString handle a# 0# = return () hPutLitString handle a# l# -#if __GLASGOW_HASKELL__ < 411 - = hPutBuf handle (A# a#) (I# l#) -#else = hPutBuf handle (Ptr a#) (I# l#) -#endif -- Printing output in LeftMode is performance critical: it's used when -- dumping C and assembly output, so we allow ourselves a few dirty @@ -1066,9 +1062,4 @@ layLeft b (TextBeside s sl p) = put b s >> layLeft b p put b (Str s) = bPutStr b s put b (PStr s) = bPutFS b s put b (LStr s l) = bPutLitString b s l - -#if __GLASGOW_HASKELL__ < 503 -hPutBuf = hPutBufFull -#endif - \end{code} diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs index 267aeab..bb5b33e 100644 --- a/compiler/utils/UniqFM.lhs +++ b/compiler/utils/UniqFM.lhs @@ -827,18 +827,8 @@ shiftR_ :: FastInt -> FastInt -> FastInt #if __GLASGOW_HASKELL__ {-# INLINE shiftL_ #-} {-# INLINE shiftR_ #-} -#if __GLASGOW_HASKELL__ >= 503 shiftL_ n p = word2Int#((int2Word# n) `uncheckedShiftL#` p) -#else -shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p) -#endif -shiftR_ n p = word2Int#((int2Word# n) `shiftr` p) - where -#if __GLASGOW_HASKELL__ >= 503 - shiftr x y = uncheckedShiftRL# x y -#else - shiftr x y = shiftRL# x y -#endif +shiftR_ n p = word2Int#((int2Word# n) `uncheckedShiftRL#` p) #else /* not GHC */ shiftL_ n p = n * (2 ^ p) diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs index 6463c1a..39fd64b 100644 --- a/compiler/utils/Util.lhs +++ b/compiler/utils/Util.lhs @@ -890,13 +890,9 @@ handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a handleDyn = flip catchDyn handle :: (Exception -> IO a) -> IO a -> IO a -#if __GLASGOW_HASKELL__ < 501 -handle = flip Exception.catchAllIO -#else handle h f = f `Exception.catch` \e -> case e of ExitException _ -> throw e _ -> h e -#endif -- -------------------------------------------------------------- -- check existence & modification time at the same time -- 1.7.10.4