aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Binary.hs76
-rw-r--r--src/Digraph.lhs16
-rw-r--r--src/HaddockDB.hs6
-rw-r--r--src/HaddockHH.hs7
-rw-r--r--src/HaddockHtml.hs8
-rw-r--r--src/HaddockRename.hs5
-rw-r--r--src/HaddockTypes.hs5
-rw-r--r--src/HaddockUtil.hs18
-rw-r--r--src/Main.hs16
-rw-r--r--src/Makefile8
10 files changed, 134 insertions, 31 deletions
diff --git a/src/Binary.hs b/src/Binary.hs
index c5fb294e..6ac9db1c 100644
--- a/src/Binary.hs
+++ b/src/Binary.hs
@@ -56,6 +56,10 @@ module Binary
import FastMutInt
+import Char
+import Monad
+
+#if __GLASGOW_HASKELL__ < 503
import IOExts
import Bits
import Int
@@ -64,42 +68,68 @@ import Char
import Monad
import Exception
import GlaExts hiding (ByteArray, newByteArray, freezeByteArray)
+import Array
import IO
-#if __GLASGOW_HASKELL__ < 503
-import PrelIOBase -- ( IOError(..), IOErrorType(..) )
-import PrelReal -- ( Ratio(..) )
-import PrelIOBase -- ( IO(..) )
+import PrelIOBase ( IOError(..), IOErrorType(..)
+#if __GLASGOW_HASKELL__ > 411
+ , IOException(..)
+#endif
+ )
+import PrelReal ( Ratio(..) )
+import PrelIOBase ( IO(..) )
#else
-import System.IO.Error ( mkIOError, eofErrorType )
-import GHC.Real ( Ratio(..) )
-import GHC.IOBase ( IO(..) )
+import Data.Array.IO
+import Data.Array
+import Data.Bits
+import Data.Int
+import Data.Word
+import Data.IORef
+import Data.Char ( ord, chr )
+import Data.Array.Base ( unsafeRead, unsafeWrite )
+import Control.Monad ( when )
+import Control.Exception ( throwDyn )
+import System.IO as IO
+import System.IO.Unsafe ( unsafeInterleaveIO )
+import System.IO.Error ( mkIOError, eofErrorType )
+import GHC.Real ( Ratio(..) )
+import GHC.Exts
+import GHC.IOBase ( IO(..) )
+import GHC.Word ( Word8(..) )
+#if __GLASGOW_HASKELL__ < 601
+-- openFileEx is available from the lang package, but we want to
+-- be independent of hslibs libraries.
+import GHC.Handle ( openFileEx, IOModeEx(..) )
+#else
+import System.IO ( openBinaryFile )
+#endif
+#endif
+
+import IO
+
+#if __GLASGOW_HASKELL__ < 601
+openBinaryFile f mode = openFileEx f (BinaryMode mode)
#endif
+#if __GLASGOW_HASKELL__ < 503
type BinArray = MutableByteArray RealWorld Int
-newArray_ :: Ix ix => (ix, ix) -> IO (MutableByteArray RealWorld ix)
newArray_ bounds = stToIO (newCharArray bounds)
-
-unsafeWrite :: Ix ix => MutableByteArray RealWorld ix -> ix -> Word8 -> IO ()
unsafeWrite arr ix e = stToIO (writeWord8Array arr ix e)
-
-unsafeRead :: Ix ix => MutableByteArray RealWorld ix -> ix -> IO Word8
unsafeRead arr ix = stToIO (readWord8Array arr ix)
+#if __GLASGOW_HASKELL__ < 411
+newByteArray# = newCharArray#
+#endif
+hPutArray h arr sz = hPutBufBAFull h arr sz
+hGetArray h sz = hGetBufBAFull h sz
-hPutArray :: Handle -> MutableByteArray RealWorld a -> Int -> IO ()
-hPutArray h arr sz = hPutBufBA h arr sz
-
-hGetArray :: Handle -> MutableByteArray RealWorld a -> Int -> IO Int
-hGetArray h sz = hGetBufBA h sz
-
-#if __GLASGOW_HASKELL__ < 503
mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> Exception
mkIOError t location maybe_hdl maybe_filename
= IOException (IOError maybe_hdl t location ""
+#if __GLASGOW_HASKELL__ > 411
maybe_filename
+#endif
)
eofErrorType = EOF
-#endif
#ifndef SIZEOF_HSINT
#define SIZEOF_HSINT INT_SIZE_IN_BYTES
@@ -109,7 +139,9 @@ eofErrorType = EOF
#define SIZEOF_HSWORD WORD_SIZE_IN_BYTES
#endif
---type BinArray = IOUArray Int Word8
+#else
+type BinArray = IOUArray Int Word8
+#endif
data BinHandle
= BinMem { -- binary data stored in an unboxed array
@@ -204,7 +236,7 @@ isEOFBin (BinIO _ _ h) = hIsEOF h
writeBinMem :: BinHandle -> FilePath -> IO ()
writeBinMem (BinIO _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"
writeBinMem (BinMem _ ix_r _ arr_r0) fn = do
- h <- openFileEx fn (BinaryMode WriteMode)
+ h <- openBinaryFile fn WriteMode
arr <- readIORef arr_r0
ix <- readFastMutInt ix_r
hPutArray h arr ix
diff --git a/src/Digraph.lhs b/src/Digraph.lhs
index 6bf8de7b..a7a04d49 100644
--- a/src/Digraph.lhs
+++ b/src/Digraph.lhs
@@ -39,7 +39,12 @@ module Digraph(
#define ARR_ELT (COMMA)
-- Extensions
+#if __GLASGOW_HASKELL__ < 503
import ST
+#else
+import Control.Monad.ST
+import Data.Array.ST hiding (indices,bounds)
+#endif
-- std interfaces
import Maybe
@@ -233,6 +238,17 @@ draw (Node x ts0) = grp this (space (length this)) (stLoop ts0)
%************************************************************************
\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)
diff --git a/src/HaddockDB.hs b/src/HaddockDB.hs
index ebd0ccb2..f1718149 100644
--- a/src/HaddockDB.hs
+++ b/src/HaddockDB.hs
@@ -10,8 +10,14 @@ import HaddockTypes
import HaddockUtil
import HsSyn
+
+#if __GLASGOW_HASKELL__ < 503
import Pretty
import FiniteMap
+#else
+import Text.PrettyPrint
+import Data.FiniteMap
+#endif
-----------------------------------------------------------------------------
-- Printing the results in DocBook format
diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs
index d1c0f486..9357c00c 100644
--- a/src/HaddockHH.hs
+++ b/src/HaddockHH.hs
@@ -1,8 +1,15 @@
module HaddockHH(ppHHContents, ppHHIndex) where
import HsSyn hiding(Doc)
+
+#if __GLASGOW_HASKELL__ < 503
import Pretty
import FiniteMap
+#else
+import Text.PrettyPrint
+import Data.FiniteMap
+#endif
+
import HaddockModuleTree
import HaddockUtil
import HaddockTypes
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 44663821..7275e948 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -16,11 +16,17 @@ import HsSyn
import IO
import Maybe ( fromJust, isJust )
-import FiniteMap
import List ( sortBy )
import Char ( toUpper, toLower, isAlpha, ord )
import Monad ( when, unless )
+
+#if __GLASGOW_HASKELL__ < 503
+import FiniteMap
import URI ( escapeString, unreserved )
+#else
+import Data.FiniteMap
+import Network.URI ( escapeString, unreserved )
+#endif
import Html
import qualified Html
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index b539e9ff..1a2ab04e 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -16,7 +16,12 @@ module HaddockRename (
import HaddockTypes
import HsSyn
+#if __GLASGOW_HASKELL__ < 503
import FiniteMap
+#else
+import Data.FiniteMap
+#endif
+
import Monad
-- -----------------------------------------------------------------------------
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index 36cb9351..cc6585bc 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -12,7 +12,12 @@ module HaddockTypes (
DocOption(..), InstHead,
) where
+#if __GLASGOW_HASKELL__ < 503
import FiniteMap
+#else
+import Data.FiniteMap
+#endif
+
import HsSyn
-- ---------------------------------------------------------------------------
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 61c40373..9804fb6e 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -26,16 +26,24 @@ module HaddockUtil (
import HsSyn
-import FiniteMap
import List ( intersect )
import Maybe
import IO ( hPutStr, stderr )
import System
-import RegexString
import Binary
-import IOExts
import Monad
+#if __GLASGOW_HASKELL__ < 503
+import RegexString
+import FiniteMap
+import IOExts
+#else
+import Text.Regex
+import Data.FiniteMap
+import Data.IORef
+import System.IO.Unsafe ( unsafePerformIO )
+#endif
+
-- -----------------------------------------------------------------------------
-- Some Utilities
@@ -167,7 +175,11 @@ declDoc _ = Nothing
parseModuleHeader :: String -> (String, Maybe ModuleInfo)
parseModuleHeader str =
case matchRegexAll moduleHeaderRE str of
+#if __GLASGOW_HASKELL__ < 503
Just (_, _, after, _, (_:_:_:s1:s2:s3:_)) ->
+#else
+ Just (_, _, after, (_:_:_:s1:s2:s3:_)) ->
+#endif
(after, Just (ModuleInfo {
portability = s3,
stability = s2,
diff --git a/src/Main.hs b/src/Main.hs
index d1bd8e51..092c4861 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,9 +20,7 @@ import Binary
import HsParser
import HsParseMonad
import HsSyn
-import GetOpt
import System
-import FiniteMap
--import Pretty
@@ -32,12 +30,20 @@ import Monad ( when )
import Char ( isSpace )
import IO
-#ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ < 503
+import MonadWriter
+import FiniteMap
+import GetOpt
import IOExts
+#else
+import Control.Monad.Writer
+import Data.FiniteMap
+import System.Console.GetOpt
+import Data.IORef
+import Debug.Trace
+import System.IO.Unsafe ( unsafePerformIO )
#endif
-import MonadWriter
-
#if __GLASGOW_HASKELL__ < 500
import Regex
import PackedString
diff --git a/src/Makefile b/src/Makefile
index 5064025b..c7685e92 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -3,7 +3,15 @@ include $(TOP)/mk/boilerplate.mk
INSTALLING=1
+ghc_ge_504 = $(shell if (test $(GhcCanonVersion) -ge 504); then echo YES; else echo NO; fi)
+
+# Don't use any hslibs packages in GHC >= 5.04
+ifeq "$(ghc_ge_504)" "YES"
+SRC_HC_OPTS += -package network -fglasgow-exts -cpp
+else
SRC_HC_OPTS += -package data -package text -package util -package net -fglasgow-exts -cpp
+endif
+
HS_PROG = haddock.bin
HsParser_HC_OPTS += -Onot