Commit 317fc69d authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Remove code that is dead, as we require __GLASGOW_HASKELL__ >= 504

parent 0d126b9c
......@@ -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
......
......@@ -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}
......
......@@ -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 ]
)
......
......@@ -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}
......
......@@ -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 )
......
......@@ -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
......
......@@ -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
-- -----------------------------------------------------------------------------
......
......@@ -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])
)
......@@ -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
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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}
......
......@@ -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, (//) )
......
......@@ -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
......
......@@ -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}
......
......@@ -19,10 +19,6 @@ module FastMutInt(
import GHC.Base
import GHC.IOBase
#if __GLASGOW_HASKELL__ < 411
newByteArray# = newCharArray#
#endif
\end{code}
\begin{code}
......
......@@ -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