Commit 2844abb4 authored by Ian Lynagh's avatar Ian Lynagh

GHC 7.4 is now required for building HEAD

parent 8a133440
-- Cmm representations using Hoopl's Graph CmmNode e x. -- Cmm representations using Hoopl's Graph CmmNode e x.
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#if __GLASGOW_HASKELL__ >= 703
-- GHC 7.0.1 improved incomplete pattern warnings with GADTs
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
#endif
module Cmm ( module Cmm (
-- * Cmm top-level datatypes -- * Cmm top-level datatypes
......
...@@ -48,11 +48,7 @@ import qualified Data.Set as Set ...@@ -48,11 +48,7 @@ import qualified Data.Set as Set
import Control.Monad import Control.Monad
foldSet :: (a -> b -> b) -> b -> Set a -> b foldSet :: (a -> b -> b) -> b -> Set a -> b
#if __GLASGOW_HASKELL__ < 704
foldSet = Set.fold
#else
foldSet = Set.foldr foldSet = Set.foldr
#endif
---------------------------------------------------------------- ----------------------------------------------------------------
-- Building InfoTables -- Building InfoTables
......
{-# LANGUAGE RecordWildCards, GADTs #-} {-# LANGUAGE RecordWildCards, GADTs #-}
#if __GLASGOW_HASKELL__ < 701
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#endif
module CmmLayoutStack ( module CmmLayoutStack (
cmmLayoutStack, setInfoTableStackMap cmmLayoutStack, setInfoTableStackMap
) where ) where
......
...@@ -6,9 +6,6 @@ ...@@ -6,9 +6,6 @@
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
#if __GLASGOW_HASKELL__ < 701
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#endif
module CmmLint ( module CmmLint (
cmmLint, cmmLintGraph cmmLint, cmmLintGraph
) where ) where
......
...@@ -8,12 +8,6 @@ ...@@ -8,12 +8,6 @@
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details -- for details
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#if __GLASGOW_HASKELL__ >= 703
-- GHC 7.0.1 improved incomplete pattern warnings with GADTs
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
#endif
module CmmNode ( module CmmNode (
CmmNode(..), ForeignHint(..), CmmFormal, CmmActual, CmmNode(..), ForeignHint(..), CmmFormal, CmmActual,
UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..), UpdFrameOffset, Convention(..), ForeignConvention(..), ForeignTarget(..),
......
{-# LANGUAGE GADTs, DisambiguateRecordFields #-} {-# LANGUAGE GADTs, DisambiguateRecordFields #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
#if __GLASGOW_HASKELL__ < 701
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#endif
module CmmProcPoint module CmmProcPoint
( ProcPointSet, Status(..) ( ProcPointSet, Status(..)
......
...@@ -8,11 +8,6 @@ ...@@ -8,11 +8,6 @@
{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}
-- Warnings from deprecated blockToNodeList -- Warnings from deprecated blockToNodeList
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#if __GLASGOW_HASKELL__ >= 703
-- GHC 7.0.1 improved incomplete pattern warnings with GADTs
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
#endif
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
......
#if __GLASGOW_HASKELL__ < 701
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
#endif
module Hoopl ( module Hoopl (
module Compiler.Hoopl, module Compiler.Hoopl,
module Hoopl.Dataflow, module Hoopl.Dataflow,
......
...@@ -10,15 +10,8 @@ ...@@ -10,15 +10,8 @@
-- --
{-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables, GADTs, EmptyDataDecls, PatternGuards, TypeFamilies, MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 703
{-# OPTIONS_GHC -fprof-auto-top #-} {-# OPTIONS_GHC -fprof-auto-top #-}
#endif
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ < 701
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
#endif
module Hoopl.Dataflow module Hoopl.Dataflow
( DataflowLattice(..), OldFact(..), NewFact(..), Fact, mkFactBase ( DataflowLattice(..), OldFact(..), NewFact(..), Fact, mkFactBase
......
...@@ -51,12 +51,8 @@ import Data.Word ...@@ -51,12 +51,8 @@ import Data.Word
import System.IO import System.IO
import qualified Data.Map as Map import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ >= 703
import Data.Array.Unsafe ( castSTUArray ) import Data.Array.Unsafe ( castSTUArray )
import Data.Array.ST hiding ( castSTUArray ) import Data.Array.ST hiding ( castSTUArray )
#else
import Data.Array.ST
#endif
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- Top level -- Top level
......
...@@ -14,9 +14,7 @@ A ``lint'' pass to check for Core correctness ...@@ -14,9 +14,7 @@ A ``lint'' pass to check for Core correctness
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details -- for details
#if __GLASGOW_HASKELL__ >= 704
{-# OPTIONS_GHC -fprof-auto #-} {-# OPTIONS_GHC -fprof-auto #-}
#endif
module CoreLint ( lintCoreBindings, lintUnfolding ) where module CoreLint ( lintCoreBindings, lintUnfolding ) where
......
...@@ -100,7 +100,6 @@ Library ...@@ -100,7 +100,6 @@ Library
c-sources: c-sources:
parser/cutils.c parser/cutils.c
utils/md5.c
if flag(dynlibs) if flag(dynlibs)
c-sources: c-sources:
......
...@@ -76,11 +76,7 @@ import Data.Dynamic ...@@ -76,11 +76,7 @@ import Data.Dynamic
import Data.Either import Data.Either
import Data.List (find) import Data.List (find)
import Control.Monad import Control.Monad
#if __GLASGOW_HASKELL__ >= 701
import Foreign.Safe import Foreign.Safe
#else
import Foreign hiding (unsafePerformIO)
#endif
import Foreign.C import Foreign.C
import GHC.Exts import GHC.Exts
import Data.Array import Data.Array
......
...@@ -596,7 +596,6 @@ copyWithHeader dflags purpose maybe_header from to = do ...@@ -596,7 +596,6 @@ copyWithHeader dflags purpose maybe_header from to = do
hClose hout hClose hout
hClose hin hClose hin
where where
#if __GLASGOW_HASKELL__ >= 702
-- write the header string in UTF-8. The header is something like -- write the header string in UTF-8. The header is something like
-- {-# LINE "foo.hs" #-} -- {-# LINE "foo.hs" #-}
-- and we want to make sure a Unicode filename isn't mangled. -- and we want to make sure a Unicode filename isn't mangled.
...@@ -604,9 +603,6 @@ copyWithHeader dflags purpose maybe_header from to = do ...@@ -604,9 +603,6 @@ copyWithHeader dflags purpose maybe_header from to = do
hSetEncoding h utf8 hSetEncoding h utf8
hPutStr h str hPutStr h str
hSetBinaryMode h True hSetBinaryMode h True
#else
header h str = hPutStr h str
#endif
-- | read the contents of the named section in an ELF object as a -- | read the contents of the named section in an ELF object as a
-- String. -- String.
...@@ -782,11 +778,7 @@ runSomethingWith ...@@ -782,11 +778,7 @@ runSomethingWith
runSomethingWith dflags phase_name pgm args io = do runSomethingWith dflags phase_name pgm args io = do
let real_args = filter notNull (map showOpt args) let real_args = filter notNull (map showOpt args)
#if __GLASGOW_HASKELL__ >= 701
cmdLine = showCommandForUser pgm real_args cmdLine = showCommandForUser pgm real_args
#else
cmdLine = unwords (pgm:real_args)
#endif
traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args traceCmd dflags phase_name cmdLine $ handleProc pgm phase_name $ io real_args
handleProc :: String -> String -> IO (ExitCode, r) -> IO r handleProc :: String -> String -> IO (ExitCode, r) -> IO r
......
...@@ -22,13 +22,8 @@ module PprBase ( ...@@ -22,13 +22,8 @@ module PprBase (
where where
-- castSTUArray has moved to Data.Array.Unsafe
#if __GLASGOW_HASKELL__ >= 703
import Data.Array.Unsafe( castSTUArray ) import Data.Array.Unsafe( castSTUArray )
import Data.Array.ST hiding( castSTUArray ) import Data.Array.ST hiding( castSTUArray )
#else
import Data.Array.ST
#endif
import Control.Monad.ST import Control.Monad.ST
......
...@@ -78,9 +78,7 @@ import Data.IORef ...@@ -78,9 +78,7 @@ import Data.IORef
import Data.Char ( ord, chr ) import Data.Char ( ord, chr )
import Data.Time import Data.Time
import Data.Typeable import Data.Typeable
#if __GLASGOW_HASKELL__ >= 701
import Data.Typeable.Internal import Data.Typeable.Internal
#endif
import Control.Monad ( when ) import Control.Monad ( when )
import System.IO as IO import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Unsafe ( unsafeInterleaveIO )
...@@ -604,22 +602,12 @@ instance Binary (Bin a) where ...@@ -604,22 +602,12 @@ instance Binary (Bin a) where
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Instances for Data.Typeable stuff -- Instances for Data.Typeable stuff
#if __GLASGOW_HASKELL__ >= 701
instance Binary TyCon where instance Binary TyCon where
put_ bh (TyCon _ p m n) = do put_ bh (TyCon _ p m n) = do
put_ bh (p,m,n) put_ bh (p,m,n)
get bh = do get bh = do
(p,m,n) <- get bh (p,m,n) <- get bh
return (mkTyCon3 p m n) return (mkTyCon3 p m n)
#else
instance Binary TyCon where
put_ bh ty_con = do
let s = tyConString ty_con
put_ bh s
get bh = do
s <- get bh
return (mkTyCon s)
#endif
instance Binary TypeRep where instance Binary TypeRep where
put_ bh type_rep = do put_ bh type_rep = do
......
...@@ -119,11 +119,7 @@ import Data.Char ...@@ -119,11 +119,7 @@ import Data.Char
import GHC.IO ( IO(..) ) import GHC.IO ( IO(..) )
#if __GLASGOW_HASKELL__ >= 701
import Foreign.Safe import Foreign.Safe
#else
import Foreign hiding ( unsafePerformIO )
#endif
#if defined(__GLASGOW_HASKELL__) #if defined(__GLASGOW_HASKELL__)
import GHC.Base ( unpackCString# ) import GHC.Base ( unpackCString# )
......
...@@ -24,71 +24,7 @@ import Outputable ...@@ -24,71 +24,7 @@ import Outputable
import Text.Printf import Text.Printf
import Numeric ( readHex ) import Numeric ( readHex )
##if __GLASGOW_HASKELL__ >= 701
-- The MD5 implementation is now in base, to support Typeable
import GHC.Fingerprint import GHC.Fingerprint
##endif
##if __GLASGOW_HASKELL__ < 701
import Data.Char
import Foreign
import Foreign.C
import GHC.IO (unsafeDupablePerformIO)
-- Using 128-bit MD5 fingerprints for now.
data Fingerprint = Fingerprint {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64
deriving (Eq, Ord)
-- or ByteString?
fingerprint0 :: Fingerprint
fingerprint0 = Fingerprint 0 0
peekFingerprint :: Ptr Word8 -> IO Fingerprint
peekFingerprint p = do
let peekW64 :: Ptr Word8 -> Int -> Word64 -> IO Word64
STRICT3(peekW64)
peekW64 _ 0 i = return i
peekW64 p n i = do
w8 <- peek p
peekW64 (p `plusPtr` 1) (n-1)
((i `shiftL` 8) .|. fromIntegral w8)
high <- peekW64 p 8 0
low <- peekW64 (p `plusPtr` 8) 8 0
return (Fingerprint high low)
fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
fingerprintData buf len = do
allocaBytes (#const sizeof(struct MD5Context)) $ \pctxt -> do
c_MD5Init pctxt
c_MD5Update pctxt buf (fromIntegral len)
allocaBytes 16 $ \pdigest -> do
c_MD5Final pdigest pctxt
peekFingerprint (castPtr pdigest)
-- This is duplicated in libraries/base/GHC/Fingerprint.hs
fingerprintString :: String -> Fingerprint
fingerprintString str = unsafeDupablePerformIO $
withArrayLen word8s $ \len p ->
fingerprintData p len
where word8s = concatMap f str
f c = let w32 :: Word32
w32 = fromIntegral (ord c)
in [fromIntegral (w32 `shiftR` 24),
fromIntegral (w32 `shiftR` 16),
fromIntegral (w32 `shiftR` 8),
fromIntegral w32]
data MD5Context
foreign import ccall unsafe "MD5Init"
c_MD5Init :: Ptr MD5Context -> IO ()
foreign import ccall unsafe "MD5Update"
c_MD5Update :: Ptr MD5Context -> Ptr Word8 -> CInt -> IO ()
foreign import ccall unsafe "MD5Final"
c_MD5Final :: Ptr Word8 -> Ptr MD5Context -> IO ()
##endif
instance Outputable Fingerprint where instance Outputable Fingerprint where
ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2) ppr (Fingerprint w1 w2) = text (printf "%016x%016x" w1 w2)
......
...@@ -93,14 +93,7 @@ import Data.Word ...@@ -93,14 +93,7 @@ import Data.Word
import System.IO ( Handle ) import System.IO ( Handle )
import System.FilePath import System.FilePath
#if __GLASGOW_HASKELL__ >= 701
import GHC.Show ( showMultiLineString ) import GHC.Show ( showMultiLineString )
#else
showMultiLineString :: String -> [String]
-- Crude version
showMultiLineString s = [ showList s "" ]
#endif
\end{code} \end{code}
......
...@@ -47,9 +47,7 @@ import System.Posix.Signals ...@@ -47,9 +47,7 @@ import System.Posix.Signals
import GHC.ConsoleHandler import GHC.ConsoleHandler
#endif #endif
#if __GLASGOW_HASKELL__ >= 703
import GHC.Stack import GHC.Stack
#endif
#if __GLASGOW_HASKELL__ >= 705 #if __GLASGOW_HASKELL__ >= 705
import System.Mem.Weak ( Weak, deRefWeak ) import System.Mem.Weak ( Weak, deRefWeak )
...@@ -188,15 +186,11 @@ handleGhcException = ghandle ...@@ -188,15 +186,11 @@ handleGhcException = ghandle
-- | Panics and asserts. -- | Panics and asserts.
panic, sorry, pgmError :: String -> a panic, sorry, pgmError :: String -> a
#if __GLASGOW_HASKELL__ >= 703
panic x = unsafeDupablePerformIO $ do panic x = unsafeDupablePerformIO $ do
stack <- ccsToStrings =<< getCurrentCCS x stack <- ccsToStrings =<< getCurrentCCS x
if null stack if null stack
then throwGhcException (Panic x) then throwGhcException (Panic x)
else throwGhcException (Panic (x ++ '\n' : renderStack stack)) else throwGhcException (Panic (x ++ '\n' : renderStack stack))
#else
panic x = throwGhcException (Panic x)
#endif
sorry x = throwGhcException (Sorry x) sorry x = throwGhcException (Sorry x)
pgmError x = throwGhcException (ProgramError x) pgmError x = throwGhcException (ProgramError x)
......
...@@ -54,11 +54,7 @@ import System.IO.Unsafe ( unsafePerformIO ) ...@@ -54,11 +54,7 @@ import System.IO.Unsafe ( unsafePerformIO )
import GHC.Exts import GHC.Exts
#if __GLASGOW_HASKELL__ >= 701
import Foreign.Safe import Foreign.Safe
#else
import Foreign hiding ( unsafePerformIO )
#endif
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- The StringBuffer type -- The StringBuffer type
......
/*
* This code implements the MD5 message-digest algorithm.
* The algorithm is due to Ron Rivest. This code was
* written by Colin Plumb in 1993, no copyright is claimed.
* This code is in the public domain; do with it what you wish.
*
* Equivalent code is available from RSA Data Security, Inc.
* This code has been tested against that, and is equivalent,
* except that you don't need to include two pages of legalese
* with every copy.
*
* To compute the message digest of a chunk of bytes, declare an
* MD5Context structure, pass it to MD5Init, call MD5Update as
* needed on buffers full of bytes, and then call MD5Final, which
* will fill a supplied 16-byte array with the digest.
*/
#if __GLASGOW_HASKELL__ < 701
#include "HsFFI.h"
#include "md5.h"
#include <string.h>
void MD5Init(struct MD5Context *context);
void MD5Update(struct MD5Context *context, byte const *buf, int len);
void MD5Final(byte digest[16], struct MD5Context *context);
void MD5Transform(word32 buf[4], word32 const in[16]);
/*
* Shuffle the bytes into little-endian order within words, as per the
* MD5 spec. Note: this code works regardless of the byte order.
*/
void
byteSwap(word32 *buf, unsigned words)
{
byte *p = (byte *)buf;
do {
*buf++ = (word32)((unsigned)p[3] << 8 | p[2]) << 16 |
((unsigned)p[1] << 8 | p[0]);
p += 4;
} while (--words);
}
/*
* Start MD5 accumulation. Set bit count to 0 and buffer to mysterious
* initialization constants.
*/
void
MD5Init(struct MD5Context *ctx)
{
ctx->buf[0] = 0x67452301;
ctx->buf[1] = 0xefcdab89;
ctx->buf[2] = 0x98badcfe;
ctx->buf[3] = 0x10325476;
ctx->bytes[0] = 0;
ctx->bytes[1] = 0;
}
/*
* Update context to reflect the concatenation of another buffer full
* of bytes.
*/
void
MD5Update(struct MD5Context *ctx, byte const *buf, int len)
{
word32 t;
/* Update byte count */
t = ctx->bytes[0];
if ((ctx->bytes[0] = t + len) < t)
ctx->bytes[1]++; /* Carry from low to high */
t = 64 - (t & 0x3f); /* Space available in ctx->in (at least 1) */
if ((unsigned)t > len) {
memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, len);
return;
}
/* First chunk is an odd size */
memcpy((byte *)ctx->in + 64 - (unsigned)t, buf, (unsigned)t);
byteSwap(ctx->in, 16);
MD5Transform(ctx->buf, ctx->in);
buf += (unsigned)t;
len -= (unsigned)t;
/* Process data in 64-byte chunks */
while (len >= 64) {
memcpy(ctx->in, buf, 64);
byteSwap(ctx->in, 16);
MD5Transform(ctx->buf, ctx->in);
buf += 64;
len -= 64;
}
/* Handle any remaining bytes of data. */
memcpy(ctx->in, buf, len);
}
/*
* Final wrapup - pad to 64-byte boundary with the bit pattern
* 1 0* (64-bit count of bits processed, MSB-first)
*/
void
MD5Final(byte digest[16], struct MD5Context *ctx)
{
int count = (int)(ctx->bytes[0] & 0x3f); /* Bytes in ctx->in */
byte *p = (byte *)ctx->in + count; /* First unused byte */
/* Set the first char of padding to 0x80. There is always room. */
*p++ = 0x80;
/* Bytes of padding needed to make 56 bytes (-8..55) */
count = 56 - 1 - count;
if (count < 0) { /* Padding forces an extra block */
memset(p, 0, count+8);
byteSwap(ctx->in, 16);
MD5Transform(ctx->buf, ctx->in);
p = (byte *)ctx->in;
count = 56;
}
memset(p, 0, count+8);
byteSwap(ctx->in, 14);
/* Append length in bits and transform */
ctx->in[14] = ctx->bytes[0] << 3;
ctx->in[15] = ctx->bytes[1] << 3 | ctx->bytes[0] >> 29;
MD5Transform(ctx->buf, ctx->in);
byteSwap(ctx->buf, 4);
memcpy(digest, ctx->buf, 16);
memset(ctx,0,sizeof(ctx));
}
/* The four core functions - F1 is optimized somewhat */
/* #define F1(x, y, z) (x & y | ~x & z) */
#define F1(x, y, z) (z ^ (x & (y ^ z)))
#define F2(x, y, z) F1(z, x, y)
#define F3(x, y, z) (x ^ y ^ z)
#define F4(x, y, z) (y ^ (x | ~z))
/* This is the central step in the MD5 algorithm. */
#define MD5STEP(f,w,x,y,z,in,s) \
(w += f(x,y,z) + in, w = (w<<s | w>>(32-s)) + x)