[project @ 1999-05-21 12:52:28 by simonmar]

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

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index f49002a..b0a12b1 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1997
+% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
 %
 \section{Fast strings}
 
@@ -39,6 +39,7 @@ module FastString
         tailFS,                    -- :: FastString -> FastString
        concatFS,           -- :: [FastString] -> FastString
         consFS,             -- :: Char -> FastString -> FastString
+       indexFS,            -- :: FastString -> Int -> Char
 
         hPutFS             -- :: Handle -> FastString -> IO ()
        ) where
@@ -58,15 +59,24 @@ import IOBase               ( Handle__(..), IOError(..), IOErrorType(..),
                        )
 #else
 import PrelPack
+#if __GLASGOW_HASKELL__ < 400
 import PrelST          ( StateAndPtr#(..) )
+#endif
+
+#if __GLASGOW_HASKELL__ <= 303
 import PrelHandle      ( readHandle, 
-#if __GLASGOW_HASKELL__ < 303
+# if __GLASGOW_HASKELL__ < 303
                          filePtr,
-#endif
+# endif
                          writeHandle
                        )
+#endif
+
 import PrelIOBase      ( Handle__(..), IOError(..), IOErrorType(..),
-                         IOResult(..), IO(..),
+#if __GLASGOW_HASKELL__ < 400
+                         IOResult(..), 
+#endif
+                         IO(..),
 #if __GLASGOW_HASKELL__ >= 303
                          Handle__Type(..),
 #endif
@@ -78,11 +88,22 @@ import PrimPacked
 import GlaExts
 import Addr            ( Addr(..) )
 import MutableArray    ( MutableArray(..) )
+
+-- ForeignObj is now exported abstractly.
+#if __GLASGOW_HASKELL__ >= 303
+import qualified PrelForeign as Foreign  ( ForeignObj(..) )
+#else
 import Foreign         ( ForeignObj(..) )
+#endif
+
 import IOExts          ( IORef, newIORef, readIORef, writeIORef )
 import IO
 
 #define hASH_TBL_SIZE 993
+
+#if __GLASGOW_HASKELL__ >= 400
+#define IOok STret
+#endif
 \end{code} 
 
 @FastString@s are packed representations of strings
@@ -119,10 +140,6 @@ instance Ord FastString where
             | otherwise        =  y
     compare a b = cmpFS a b
 
-instance Text FastString  where
-    showsPrec p ps@(FastString u# _ _) r = showsPrec p (unpackFS ps) r
-    showsPrec p ps r = showsPrec p (unpackFS ps) r
-
 getByteArray# :: FastString -> ByteArray#
 getByteArray# (FastString _ _ ba#) = ba#
 
@@ -160,6 +177,18 @@ headFS f@(FastString _ l# ba#) =
 headFS f@(CharStr a# l#) = 
  if l# ># 0# then C# (indexCharOffAddr# a# 0#) else error ("headFS: empty FS: " ++ unpackFS f)
 
+indexFS :: FastString -> Int -> Char
+indexFS f i@(I# i#) =
+ case f of
+   FastString _ l# ba#
+     | l# ># 0# && l# ># i#  -> C# (indexCharArray# ba# i#)
+     | otherwise            -> error (msg (I# l#))
+   CharStr a# l#
+     | l# ># 0# && l# ># i#  -> C# (indexCharOffAddr# a# i#)
+     | otherwise            -> error (msg (I# l#))
+ where
+  msg l =  "indexFS: out of range: " ++ show (l,i)
+
 tailFS :: FastString -> FastString
 tailFS (FastString _ l# ba#) = mkFastSubStringBA# ba# 1# (l# -# 1#)
 
@@ -205,12 +234,21 @@ string_table =
 lookupTbl :: FastStringTable -> Int# -> IO [FastString]
 lookupTbl (FastStringTable _ arr#) i# =
   IO ( \ s# ->
+#if __GLASGOW_HASKELL__ < 400
   case readArray# arr# i# s# of { StateAndPtr# s2# r ->
   IOok s2# r })
+#else
+  readArray# arr# i# s#)
+#endif
 
 updTbl :: FastStringTableVar -> FastStringTable -> Int# -> [FastString] -> IO ()
 updTbl fs_table_var (FastStringTable uid# arr#) i# ls =
- IO (\ s# -> case writeArray# arr# i# ls s# of { s2# -> IOok s2# () }) >>
+ IO (\ s# -> case writeArray# arr# i# ls s# of { s2# -> 
+#if __GLASGOW_HASKELL__ < 400
+       IOok s2# () })  >>
+#else
+       (# s2#, () #) }) >>
+#endif
  writeIORef fs_table_var (FastStringTable (uid# +# 1#) arr#)
 
 mkFastString# :: Addr# -> Int# -> FastString
@@ -526,6 +564,8 @@ hPutFS handle (CharStr a# l#) =
           else
               constructError "hPutFS"          >>= \ err ->
              fail err
+
+
 #else
 hPutFS handle (FastString _ l# ba#)
   | l# ==# 0#  = return ()
@@ -533,9 +573,12 @@ hPutFS handle (FastString _ l# ba#)
  where
   bottom = error "hPutFS.ba"
 
+--ToDo: avoid silly code duplic.
+
 hPutFS handle (CharStr a# l#)
   | l# ==# 0#  = return ()
   | otherwise  = hPutBuf handle (A# a#) (I# l#)
 
+
 #endif
 \end{code}