[project @ 2000-04-13 19:31:05 by panne]

[ghc-hetmet.git] / ghc / compiler / utils / FastString.lhs

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index 5d08d76..3d63e7f 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -86,8 +86,13 @@ import PrelIOBase    ( Handle__(..), IOError(..), IOErrorType(..),
 
 import PrimPacked
 import GlaExts
-import Addr            ( Addr(..) )
+import PrelAddr                ( Addr(..) )
+#if __GLASGOW_HASKELL__ < 407
 import MutableArray    ( MutableArray(..) )
+#else
+import PrelArr         ( STArray(..), newSTArray )
+import IOExts          ( hPutBuf, hPutBufBA )
+#endif
 
 -- ForeignObj is now exported abstractly.
 #if __GLASGOW_HASKELL__ >= 303
@@ -232,11 +237,15 @@ type FastStringTableVar = IORef FastStringTable
 string_table :: FastStringTableVar
 string_table = 
  unsafePerformIO (
-   stToIO (newArray (0::Int,hASH_TBL_SIZE) [])
 #if __GLASGOW_HASKELL__ < 405
+   stToIO (newArray (0::Int,hASH_TBL_SIZE) [])
        >>= \ (MutableArray _ arr#) ->
-#else
+#elif __GLASGOW_HASKELL__ < 407
+   stToIO (newArray (0::Int,hASH_TBL_SIZE) [])
        >>= \ (MutableArray _ _ arr#) ->
+#else
+   stToIO (newSTArray (0::Int,hASH_TBL_SIZE) [])
+       >>= \ (STArray _ _ arr#) ->
 #endif
    newIORef (FastStringTable 0# arr#))
 
@@ -626,8 +635,12 @@ hPutFS handle (FastString _ l# ba#)
   | l# ==# 0#  = return ()
 #if __GLASGOW_HASKELL__ < 405
   | otherwise  = hPutBufBA handle (ByteArray bot ba#) (I# l#)
-#else
+#elif __GLASGOW_HASKELL__ < 407
   | otherwise  = hPutBufBA handle (ByteArray bot bot ba#) (I# l#)
+#else
+  | otherwise  = do mba <- stToIO $ unsafeThawByteArray (ByteArray (bot::Int) bot ba#)
+                    hPutBufBA  handle mba (I# l#)
+                    return ()
 #endif
  where
   bot = error "hPutFS.ba"
@@ -636,7 +649,7 @@ hPutFS handle (FastString _ l# ba#)
 
 hPutFS handle (CharStr a# l#)
   | l# ==# 0#  = return ()
-  | otherwise  = hPutBuf handle (A# a#) (I# l#)
+  | otherwise  = do hPutBuf handle (A# a#) (I# l#) ; return ()
 
 
 #endif