Update of /cvsroot/gtk2hs/gtk2hs/tools/c2hs/base/general
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv572/tools/c2hs/base/general
Modified Files:
FastMutInt.hs Binary.hs
Log Message:
Allow these modules to compile with older ghc versions 5.04.x and 6.0.x, that
lack openBinaryFile and Data.HashTable and that do not like you to put
optimisation flags in an {-# OPTIONS #-} pragma.
Also define SIZEOF_HSINT more portably.
Index: Binary.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/c2hs/base/general/Binary.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- Binary.hs 13 Nov 2004 17:26:50 -0000 1.1
+++ Binary.hs 16 Jan 2005 21:34:06 -0000 1.2
@@ -1,4 +1,4 @@
-{-# OPTIONS -cpp -fglasgow-exts -O -funbox-strict-fields #-}
+{-# OPTIONS -cpp -fglasgow-exts #-}
--
-- (c) The University of Glasgow 2002
--
@@ -48,10 +48,14 @@
) where
+#include "config.h"
+
import FastMutInt
import Data.FiniteMap
+# if __GLASGOW_HASKELL__>=602
import Data.HashTable as HashTable
+# endif
import Data.Array.IO
import Data.Array
import Data.Bits
@@ -60,7 +64,7 @@
import Data.IORef
import Data.Char ( ord, chr )
import Data.Array.Base ( unsafeRead, unsafeWrite )
-import Control.Monad ( when )
+import Control.Monad ( when, liftM )
import Control.Exception ( throwDyn )
import System.IO as IO
import System.IO.Unsafe ( unsafeInterleaveIO )
@@ -69,13 +73,15 @@
import GHC.Exts
import GHC.IOBase ( IO(..) )
import GHC.Word ( Word8(..) )
-import System.IO ( openBinaryFile )
-
+# if __GLASGOW_HASKELL__<602
+import GHC.Handle ( hSetBinaryMode )
+# endif
-- for debug
import System.CPUTime (getCPUTime)
import Numeric (showFFloat)
-#define SIZEOF_HSINT 4
+-- FIXME: we should really get SIZEOF_HSINT directly from ghc's config.h
+#define SIZEOF_HSINT SIZEOF_VOID_P
type BinArray = IOUArray Int Word8
@@ -185,7 +191,8 @@
writeBinMem :: BinHandle -> FilePath -> IO ()
writeBinMem (BinIO _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"
writeBinMem (BinMem _ ix_r sz_r arr_r) fn = do
- h <- openBinaryFile fn WriteMode
+ h <- openFile fn WriteMode
+ hSetBinaryMode h True
arr <- readIORef arr_r
ix <- readFastMutInt ix_r
hPutArray h arr ix
@@ -194,7 +201,8 @@
readBinMem :: FilePath -> IO BinHandle
-- Return a BinHandle with a totally undefined State
readBinMem filename = do
- h <- openBinaryFile filename ReadMode
+ h <- openFile filename ReadMode
+ hSetBinaryMode h True
filesize' <- hFileSize h
let filesize = fromIntegral filesize'
arr <- newArray_ (0,filesize-1)
@@ -619,7 +627,11 @@
-- Get the final-state
j <- readIORef (ud_next usr_state)
+#if __GLASGOW_HASKELL__>=602
fm <- HashTable.toList (ud_map usr_state)
+#else
+ fm <- liftM fmToList $ readIORef (ud_map usr_state)
+#endif
dict_p <- tellBin bh -- This is where the dictionary will start
-- Write the dictionary pointer at the fornt of the file
@@ -643,7 +655,11 @@
-- The next two fields are only used when writing
ud_next :: IORef Int, -- The next index to use
+#if __GLASGOW_HASKELL__>=602
ud_map :: HashTable String Int -- The index of each string
+#else
+ ud_map :: IORef (FiniteMap String Int)
+#endif
}
noUserData = error "Binary.UserData: no user data"
@@ -656,7 +672,11 @@
newWriteState :: IO UserData
newWriteState = do
j_r <- newIORef 0
+#if __GLASGOW_HASKELL__>=602
out_r <- HashTable.new (==) HashTable.hashString
+#else
+ out_r <- newIORef emptyFM
+#endif
return (UserData { ud_dict = error "dict",
ud_next = j_r,
ud_map = out_r })
@@ -693,14 +713,23 @@
putSharedString bh str =
case getUserData bh of
UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do
+#if __GLASGOW_HASKELL__>=602
entry <- HashTable.lookup out_r str
+#else
+ fm <- readIORef out_r
+ let entry = lookupFM fm str
+#endif
case entry of
Just j -> put_ bh j
Nothing -> do
j <- readIORef j_r
put_ bh j
writeIORef j_r (j+1)
+#if __GLASGOW_HASKELL__>=602
HashTable.insert out_r str j
+#else
+ modifyIORef out_r (\fm -> addToFM fm str j)
+#endif
getSharedString :: BinHandle -> IO String
getSharedString bh = do
Index: FastMutInt.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/c2hs/base/general/FastMutInt.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- FastMutInt.hs 13 Nov 2004 17:26:50 -0000 1.1
+++ FastMutInt.hs 16 Jan 2005 21:34:06 -0000 1.2
@@ -1,4 +1,4 @@
-{-# OPTIONS -cpp -fglasgow-exts -O #-}
+{-# OPTIONS -cpp -fglasgow-exts #-}
--
-- (c) The University of Glasgow 2002
--
|
