diff options
| -rw-r--r-- | compiler/ghc.cabal.in | 2 | ||||
| -rw-r--r-- | compiler/ghc.mk | 1 | ||||
| -rw-r--r-- | compiler/main/BreakArray.hs | 4 | ||||
| -rw-r--r-- | compiler/utils/Binary.hs | 21 | ||||
| -rw-r--r-- | compiler/utils/Encoding.hs | 22 | ||||
| -rw-r--r-- | compiler/utils/ExtsCompat46.hs | 293 | ||||
| -rw-r--r-- | compiler/utils/FastString.hs | 8 |
7 files changed, 24 insertions, 327 deletions
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index c8a3893d0f..16918d6173 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -466,8 +466,6 @@ Library UniqFM UniqSet Util - ExtsCompat46 --- ^^^ a temporary module necessary to bootstrap with GHC <= 7.6 Vectorise.Builtins.Base Vectorise.Builtins.Initialise Vectorise.Builtins diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 69ab85d5da..7bd23226ed 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -502,7 +502,6 @@ compiler_stage2_dll0_MODULES = \ Encoding \ ErrUtils \ Exception \ - ExtsCompat46 \ FamInstEnv \ FastFunctions \ FastMutInt \ diff --git a/compiler/main/BreakArray.hs b/compiler/main/BreakArray.hs index 65bf932cda..9b84931390 100644 --- a/compiler/main/BreakArray.hs +++ b/compiler/main/BreakArray.hs @@ -32,7 +32,7 @@ import DynFlags #ifdef GHCI import Control.Monad -import ExtsCompat46 +import GHC.Exts import GHC.IO ( IO(..) ) import System.IO.Unsafe ( unsafeDupablePerformIO ) @@ -95,7 +95,7 @@ newBreakArray dflags entries@(I# sz) = do BA array <- allocBA (entries * wORD_SIZE dflags) case breakOff of W# off -> do -- Todo: there must be a better way to write zero as a Word! - let loop n | n ==# sz = return () + let loop n | isTrue# (n ==# sz) = return () | otherwise = do writeBA# array n off loop (n +# 1#) diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs index 8f0d8e50dc..8946b6cf62 100644 --- a/compiler/utils/Binary.hs +++ b/compiler/utils/Binary.hs @@ -48,10 +48,6 @@ module Binary lazyGet, lazyPut, - ByteArray(..), - getByteArray, - putByteArray, - UserData(..), getUserData, setUserData, newReadState, newWriteState, putDictionary, getDictionary, putFS, @@ -86,10 +82,6 @@ import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) -import ExtsCompat46 -import GHC.Word ( Word8(..) ) - -import GHC.IO ( IO(..) ) type BinArray = ForeignPtr Word8 @@ -484,6 +476,10 @@ instance Binary Integer where _ -> fail ("Binary Integer: got " ++ show str) {- + -- This code is currently commented out. + -- See https://ghc.haskell.org/trac/ghc/ticket/3379#comment:10 for + -- discussion. + put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#) put_ bh (J# s# a#) = do putByte bh 1 @@ -501,11 +497,6 @@ instance Binary Integer where sz <- get bh (BA a#) <- getByteArray bh sz return (J# s# a#) --} - --- As for the rest of this code, even though this module --- exports it, it doesn't seem to be used anywhere else --- in GHC! putByteArray :: BinHandle -> ByteArray# -> Int# -> IO () putByteArray bh a s# = loop 0# @@ -526,8 +517,9 @@ getByteArray bh (I# sz) = do loop (n +# 1#) loop 0# freezeByteArray arr + -} - +{- data ByteArray = BA ByteArray# data MBA = MBA (MutableByteArray# RealWorld) @@ -549,6 +541,7 @@ writeByteArray arr i (W8# w) = IO $ \s -> indexByteArray :: ByteArray# -> Int# -> Word8 indexByteArray a# n# = W8# (indexWord8Array# a# n#) +-} instance (Binary a) => Binary (Ratio a) where put_ bh (a :% b) = do put_ bh a; put_ bh b get bh = do a <- get bh; b <- get bh; return (a :% b) diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs index ae727d2f3f..c8dcea24a7 100644 --- a/compiler/utils/Encoding.hs +++ b/compiler/utils/Encoding.hs @@ -31,7 +31,7 @@ module Encoding ( import Foreign import Data.Char import Numeric -import ExtsCompat46 +import GHC.Exts -- ----------------------------------------------------------------------------- -- UTF-8 @@ -50,32 +50,32 @@ utf8DecodeChar# :: Addr# -> (# Char#, Int# #) utf8DecodeChar# a# = let !ch0 = word2Int# (indexWord8OffAddr# a# 0#) in case () of - _ | ch0 <=# 0x7F# -> (# chr# ch0, 1# #) + _ | isTrue# (ch0 <=# 0x7F#) -> (# chr# ch0, 1# #) - | ch0 >=# 0xC0# && ch0 <=# 0xDF# -> + | isTrue# ((ch0 >=# 0xC0#) `andI#` (ch0 <=# 0xDF#)) -> let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in - if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else + if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else (# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +# (ch1 -# 0x80#)), 2# #) - | ch0 >=# 0xE0# && ch0 <=# 0xEF# -> + | isTrue# ((ch0 >=# 0xE0#) `andI#` (ch0 <=# 0xEF#)) -> let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in - if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else + if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in - if ch2 <# 0x80# || ch2 >=# 0xC0# then fail 2# else + if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else (# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +# ((ch1 -# 0x80#) `uncheckedIShiftL#` 6#) +# (ch2 -# 0x80#)), 3# #) - | ch0 >=# 0xF0# && ch0 <=# 0xF8# -> + | isTrue# ((ch0 >=# 0xF0#) `andI#` (ch0 <=# 0xF8#)) -> let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in - if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else + if isTrue# ((ch1 <# 0x80#) `orI#` (ch1 >=# 0xC0#)) then fail 1# else let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in - if ch2 <# 0x80# || ch2 >=# 0xC0# then fail 2# else + if isTrue# ((ch2 <# 0x80#) `orI#` (ch2 >=# 0xC0#)) then fail 2# else let !ch3 = word2Int# (indexWord8OffAddr# a# 3#) in - if ch3 <# 0x80# || ch3 >=# 0xC0# then fail 3# else + if isTrue# ((ch3 <# 0x80#) `orI#` (ch3 >=# 0xC0#)) then fail 3# else (# chr# (((ch0 -# 0xF0#) `uncheckedIShiftL#` 18#) +# ((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +# ((ch2 -# 0x80#) `uncheckedIShiftL#` 6#) +# diff --git a/compiler/utils/ExtsCompat46.hs b/compiler/utils/ExtsCompat46.hs deleted file mode 100644 index 5d40655a16..0000000000 --- a/compiler/utils/ExtsCompat46.hs +++ /dev/null @@ -1,293 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP, MagicHash #-} - ------------------------------------------------------------------------------ --- | --- Module : ExtsCompat46 --- Copyright : (c) Lodz University of Technology 2013 --- License : see LICENSE --- --- Maintainer : ghc-devs@haskell.org --- Stability : internal --- Portability : non-portable (GHC internal) --- --- Compatibility module to encapsulate primops API change between GHC 7.6 --- GHC 7.8. --- --- In GHC we use comparison primops in a couple of modules, but that primops --- have different type signature in GHC 7.6 (where they return Bool) than --- in GHC 7.8 (where they return Int#). As long as we allow bootstrapping --- with GHC 7.6 or earlier we need to have this compatibility module, so that --- we can compile stage1 compiler using the old API and then continue with --- stage2 using the new API. When we set GHC 7.8 as the minimum version --- required for bootstrapping, we should remove this module. --- ------------------------------------------------------------------------------ - -module ExtsCompat46 ( - module GHC.Exts, - - gtChar#, geChar#, eqChar#, - neChar#, ltChar#, leChar#, - - (>#), (>=#), (==#), (/=#), (<#), (<=#), - - gtWord#, geWord#, eqWord#, - neWord#, ltWord#, leWord#, - - (>##), (>=##), (==##), (/=##), (<##), (<=##), - - gtFloat#, geFloat#, eqFloat#, - neFloat#, ltFloat#, leFloat#, - - gtAddr#, geAddr#, eqAddr#, - neAddr#, ltAddr#, leAddr#, - - sameMutableArray#, sameMutableByteArray#, sameMutableArrayArray#, - sameMutVar#, sameTVar#, sameMVar# - - ) where - -import GHC.Exts hiding ( - gtChar#, geChar#, eqChar#, - neChar#, ltChar#, leChar#, - - (>#), (>=#), (==#), (/=#), (<#), (<=#), - - gtWord#, geWord#, eqWord#, - neWord#, ltWord#, leWord#, - - (>##), (>=##), (==##), (/=##), (<##), (<=##), - - gtFloat#, geFloat#, eqFloat#, - neFloat#, ltFloat#, leFloat#, - - gtAddr#, geAddr#, eqAddr#, - neAddr#, ltAddr#, leAddr#, - - sameMutableArray#, sameMutableByteArray#, sameMutableArrayArray#, - sameMutVar#, sameTVar#, sameMVar# - ) - -import qualified GHC.Exts as E ( - gtChar#, geChar#, eqChar#, - neChar#, ltChar#, leChar#, - - (>#), (>=#), (==#), (/=#), (<#), (<=#), - - gtWord#, geWord#, eqWord#, - neWord#, ltWord#, leWord#, - - (>##), (>=##), (==##), (/=##), (<##), (<=##), - - gtFloat#, geFloat#, eqFloat#, - neFloat#, ltFloat#, leFloat#, - - gtAddr#, geAddr#, eqAddr#, - neAddr#, ltAddr#, leAddr#, - - sameMutableArray#, sameMutableByteArray#, sameMutableArrayArray#, - sameMutVar#, sameTVar#, sameMVar# - ) - --- See #8330 -#if __GLASGOW_HASKELL__ > 711 -#error What is minimal version of GHC required for bootstraping? If it's GHC 7.8 we should remove this module and use GHC.Exts instead. -#endif - -#if __GLASGOW_HASKELL__ > 706 - -gtChar# :: Char# -> Char# -> Bool -gtChar# a b = isTrue# (a `E.gtChar#` b) -geChar# :: Char# -> Char# -> Bool -geChar# a b = isTrue# (a `E.geChar#` b) -eqChar# :: Char# -> Char# -> Bool -eqChar# a b = isTrue# (a `E.eqChar#` b) -neChar# :: Char# -> Char# -> Bool -neChar# a b = isTrue# (a `E.neChar#` b) -ltChar# :: Char# -> Char# -> Bool -ltChar# a b = isTrue# (a `E.ltChar#` b) -leChar# :: Char# -> Char# -> Bool -leChar# a b = isTrue# (a `E.leChar#` b) - -infix 4 >#, >=#, ==#, /=#, <#, <=# - -(>#) :: Int# -> Int# -> Bool -(>#) a b = isTrue# (a E.># b) -(>=#) :: Int# -> Int# -> Bool -(>=#) a b = isTrue# (a E.>=# b) -(==#) :: Int# -> Int# -> Bool -(==#) a b = isTrue# (a E.==# b) -(/=#) :: Int# -> Int# -> Bool -(/=#) a b = isTrue# (a E./=# b) -(<#) :: Int# -> Int# -> Bool -(<#) a b = isTrue# (a E.<# b) -(<=#) :: Int# -> Int# -> Bool -(<=#) a b = isTrue# (a E.<=# b) - -gtWord# :: Word# -> Word# -> Bool -gtWord# a b = isTrue# (a `E.gtWord#` b) -geWord# :: Word# -> Word# -> Bool -geWord# a b = isTrue# (a `E.geWord#` b) -eqWord# :: Word# -> Word# -> Bool -eqWord# a b = isTrue# (a `E.eqWord#` b) -neWord# :: Word# -> Word# -> Bool -neWord# a b = isTrue# (a `E.neWord#` b) -ltWord# :: Word# -> Word# -> Bool -ltWord# a b = isTrue# (a `E.ltWord#` b) -leWord# :: Word# -> Word# -> Bool -leWord# a b = isTrue# (a `E.leWord#` b) - -infix 4 >##, >=##, ==##, /=##, <##, <=## - -(>##) :: Double# -> Double# -> Bool -(>##) a b = isTrue# (a E.>## b) -(>=##) :: Double# -> Double# -> Bool -(>=##) a b = isTrue# (a E.>=## b) -(==##) :: Double# -> Double# -> Bool -(==##) a b = isTrue# (a E.==## b) -(/=##) :: Double# -> Double# -> Bool -(/=##) a b = isTrue# (a E./=## b) -(<##) :: Double# -> Double# -> Bool -(<##) a b = isTrue# (a E.<## b) -(<=##) :: Double# -> Double# -> Bool -(<=##) a b = isTrue# (a E.<=## b) - -gtFloat# :: Float# -> Float# -> Bool -gtFloat# a b = isTrue# (a `E.gtFloat#` b) -geFloat# :: Float# -> Float# -> Bool -geFloat# a b = isTrue# (a `E.geFloat#` b) -eqFloat# :: Float# -> Float# -> Bool -eqFloat# a b = isTrue# (a `E.eqFloat#` b) -neFloat# :: Float# -> Float# -> Bool -neFloat# a b = isTrue# (a `E.neFloat#` b) -ltFloat# :: Float# -> Float# -> Bool -ltFloat# a b = isTrue# (a `E.ltFloat#` b) -leFloat# :: Float# -> Float# -> Bool -leFloat# a b = isTrue# (a `E.leFloat#` b) - -gtAddr# :: Addr# -> Addr# -> Bool -gtAddr# a b = isTrue# (a `E.gtAddr#` b) -geAddr# :: Addr# -> Addr# -> Bool -geAddr# a b = isTrue# (a `E.geAddr#` b) -eqAddr# :: Addr# -> Addr# -> Bool -eqAddr# a b = isTrue# (a `E.eqAddr#` b) -neAddr# :: Addr# -> Addr# -> Bool -neAddr# a b = isTrue# (a `E.neAddr#` b) -ltAddr# :: Addr# -> Addr# -> Bool -ltAddr# a b = isTrue# (a `E.ltAddr#` b) -leAddr# :: Addr# -> Addr# -> Bool -leAddr# a b = isTrue# (a `E.leAddr#` b) - -sameMutableArray# :: MutableArray# s a -> MutableArray# s a -> Bool -sameMutableArray# a b = isTrue# (E.sameMutableArray# a b) -sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Bool -sameMutableByteArray# a b = isTrue# (E.sameMutableByteArray# a b) -sameMutableArrayArray# :: MutableArrayArray# s -> MutableArrayArray# s -> Bool -sameMutableArrayArray# a b = isTrue# (E.sameMutableArrayArray# a b) - -sameMutVar# :: MutVar# s a -> MutVar# s a -> Bool -sameMutVar# a b = isTrue# (E.sameMutVar# a b) -sameTVar# :: TVar# s a -> TVar# s a -> Bool -sameTVar# a b = isTrue# (E.sameTVar# a b) -sameMVar# :: MVar# s a -> MVar# s a -> Bool -sameMVar# a b = isTrue# (E.sameMVar# a b) - -#else - -gtChar# :: Char# -> Char# -> Bool -gtChar# a b = a `E.gtChar#` b -geChar# :: Char# -> Char# -> Bool -geChar# a b = a `E.geChar#` b -eqChar# :: Char# -> Char# -> Bool -eqChar# a b = a `E.eqChar#` b -neChar# :: Char# -> Char# -> Bool -neChar# a b = a `E.neChar#` b -ltChar# :: Char# -> Char# -> Bool -ltChar# a b = a `E.ltChar#` b -leChar# :: Char# -> Char# -> Bool -leChar# a b = a `E.leChar#` b - -infix 4 >#, >=#, ==#, /=#, <#, <=# - -(>#) :: Int# -> Int# -> Bool -(>#) a b = a E.># b -(>=#) :: Int# -> Int# -> Bool -(>=#) a b = a E.>=# b -(==#) :: Int# -> Int# -> Bool -(==#) a b = a E.==# b -(/=#) :: Int# -> Int# -> Bool -(/=#) a b = a E./=# b -(<#) :: Int# -> Int# -> Bool -(<#) a b = a E.<# b -(<=#) :: Int# -> Int# -> Bool -(<=#) a b = a E.<=# b - -gtWord# :: Word# -> Word# -> Bool -gtWord# a b = a `E.gtWord#` b -geWord# :: Word# -> Word# -> Bool -geWord# a b = a `E.geWord#` b -eqWord# :: Word# -> Word# -> Bool -eqWord# a b = a `E.eqWord#` b -neWord# :: Word# -> Word# -> Bool -neWord# a b = a `E.neWord#` b -ltWord# :: Word# -> Word# -> Bool -ltWord# a b = a `E.ltWord#` b -leWord# :: Word# -> Word# -> Bool -leWord# a b = a `E.leWord#` b - -infix 4 >##, >=##, ==##, /=##, <##, <=## - -(>##) :: Double# -> Double# -> Bool -(>##) a b = a E.>## b -(>=##) :: Double# -> Double# -> Bool -(>=##) a b = a E.>=## b -(==##) :: Double# -> Double# -> Bool -(==##) a b = a E.==## b -(/=##) :: Double# -> Double# -> Bool -(/=##) a b = a E./=## b -(<##) :: Double# -> Double# -> Bool -(<##) a b = a E.<## b -(<=##) :: Double# -> Double# -> Bool -(<=##) a b = a E.<=## b - -gtFloat# :: Float# -> Float# -> Bool -gtFloat# a b = a `E.gtFloat#` b -geFloat# :: Float# -> Float# -> Bool -geFloat# a b = a `E.geFloat#` b -eqFloat# :: Float# -> Float# -> Bool -eqFloat# a b = a `E.eqFloat#` b -neFloat# :: Float# -> Float# -> Bool -neFloat# a b = a `E.neFloat#` b -ltFloat# :: Float# -> Float# -> Bool -ltFloat# a b = a `E.ltFloat#` b -leFloat# :: Float# -> Float# -> Bool -leFloat# a b = a `E.leFloat#` b - -gtAddr# :: Addr# -> Addr# -> Bool -gtAddr# a b = a `E.gtAddr#` b -geAddr# :: Addr# -> Addr# -> Bool -geAddr# a b = a `E.geAddr#` b -eqAddr# :: Addr# -> Addr# -> Bool -eqAddr# a b = a `E.eqAddr#` b -neAddr# :: Addr# -> Addr# -> Bool -neAddr# a b = a `E.neAddr#` b -ltAddr# :: Addr# -> Addr# -> Bool -ltAddr# a b = a `E.ltAddr#` b -leAddr# :: Addr# -> Addr# -> Bool -leAddr# a b = a `E.leAddr#` b - -sameMutableArray# :: MutableArray# s a -> MutableArray# s a -> Bool -sameMutableArray# a b = E.sameMutableArray# a b -sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Bool -sameMutableByteArray# a b = E.sameMutableByteArray# a b -sameMutableArrayArray# :: MutableArrayArray# s -> MutableArrayArray# s -> Bool -sameMutableArrayArray# a b = E.sameMutableArrayArray# a b - -sameMutVar# :: MutVar# s a -> MutVar# s a -> Bool -sameMutVar# a b = E.sameMutVar# a b -sameTVar# :: TVar# s a -> TVar# s a -> Bool -sameTVar# a b = E.sameTVar# a b -sameMVar# :: MVar# s a -> MVar# s a -> Bool -sameMVar# a b = E.sameMVar# a b - -#endif diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs index 32482ccb0b..e1ef46abe1 100644 --- a/compiler/utils/FastString.hs +++ b/compiler/utils/FastString.hs @@ -104,7 +104,7 @@ import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS import Foreign.C -import ExtsCompat46 +import GHC.Exts import System.IO import System.IO.Unsafe ( unsafePerformIO ) import Data.Data @@ -454,10 +454,10 @@ hashStr :: Ptr Word8 -> Int -> Int -- use the Addr to produce a hash value between 0 & m (inclusive) hashStr (Ptr a#) (I# len#) = loop 0# 0# where - loop h n | n ExtsCompat46.==# len# = I# h - | otherwise = loop h2 (n ExtsCompat46.+# 1#) + loop h n | isTrue# (n ==# len#) = I# h + | otherwise = loop h2 (n +# 1#) where !c = ord# (indexCharOffAddr# a# n) - !h2 = (c ExtsCompat46.+# (h ExtsCompat46.*# 128#)) `remInt#` + !h2 = (c +# (h *# 128#)) `remInt#` hASH_TBL_SIZE# -- ----------------------------------------------------------------------------- |