X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FFastString.lhs;h=8a2d89af6d7d6c4d8e59564de756a6f407e35a8d;hb=1ca8c2c729e6c224090307fc7e9c42e302a2097a;hp=985c083a95511ab36649084f768b4d0cf3fcbff9;hpb=00638b9287b045767d0edea797abd92639ee6f42;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index 985c083..8a2d89a 100644
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -4,7 +4,7 @@
 \section{Fast strings}
 
 Compact representations of character strings with
-unique identifiers.
+unique identifiers (hash-cons'ish).
 
 \begin{code}
 module FastString
@@ -13,16 +13,21 @@ module FastString
 
          --names?
         mkFastString,       -- :: String -> FastString
-	mkFastCharString,   -- :: _Addr -> FastString
-	mkFastCharString2,  -- :: _Addr -> Int -> FastString
-        mkFastSubString,    -- :: _Addr -> Int -> Int -> FastString
+        mkFastSubString,    -- :: Addr -> Int -> Int -> FastString
         mkFastSubStringFO,  -- :: ForeignObj -> Int -> Int -> FastString
 
+	-- These ones hold on to the Addr after they return, and aren't hashed; 
+	-- they are used for literals
+	mkFastCharString,   -- :: Addr -> FastString
+	mkFastCharString#,  -- :: Addr# -> FastString
+	mkFastCharString2,  -- :: Addr -> Int -> FastString
+
 	mkFastString#,      -- :: Addr# -> Int# -> FastString
         mkFastSubStringBA#, -- :: ByteArray# -> Int# -> Int# -> FastString
         mkFastSubString#,   -- :: Addr# -> Int# -> Int# -> FastString
         mkFastSubStringFO#, -- :: ForeignObj# -> Int# -> Int# -> FastString
        
+        uniqueOfFS,	    -- :: FastString -> Int#
 	lengthFS,	    -- :: FastString -> Int
 	nullFastString,     -- :: FastString -> Bool
 
@@ -35,19 +40,41 @@ module FastString
 	concatFS,	    -- :: [FastString] -> FastString
         consFS,             -- :: Char -> FastString -> FastString
 
-        hPutFS,		    -- :: Handle -> FastString -> IO ()
-        tagCmpFS	    -- :: FastString -> FastString -> _CMP_TAG
+        hPutFS		    -- :: Handle -> FastString -> IO ()
        ) where
 
-import PreludeGlaST
-import PreludeGlaMisc
-import HandleHack
+-- This #define suppresses the "import FastString" that
+-- HsVersions otherwise produces
+#define COMPILING_FAST_STRING
+#include "HsVersions.h"
+
+#if __GLASGOW_HASKELL__ < 301
+import PackBase
+import STBase		( StateAndPtr#(..) )
+import IOHandle		( filePtr, readHandle, writeHandle )
+import IOBase		( Handle__(..), IOError(..), IOErrorType(..),
+		  	  IOResult(..), IO(..),
+		  	  constructError
+			)
+#else
+import PrelPack
+import PrelST		( StateAndPtr#(..) )
+import PrelHandle	( filePtr, readHandle, writeHandle )
+import PrelIOBase	( Handle__(..), IOError(..), IOErrorType(..),
+		  	  IOResult(..), IO(..),
+		  	  constructError
+			)
+#endif
 
 import PrimPacked
-import Ubiq
+import GlaExts
+import Addr		( Addr(..) )
+import MutableArray	( MutableArray(..) )
+import Foreign		( ForeignObj(..) )
+import IOExts		( IORef, newIORef, readIORef, writeIORef )
+import IO
 
 #define hASH_TBL_SIZE 993
-
 \end{code} 
 
 @FastString@s are packed representations of strings
@@ -70,43 +97,29 @@ data FastString
       Int#       -- length  (cached)
 
 instance Eq FastString where
-  a == b = case tagCmpFS a b of { _LT -> False; _EQ -> True;  _GT -> False }
-  a /= b = case tagCmpFS a b of { _LT -> True;  _EQ -> False; _GT -> True  }
-
-{-
- (FastString u1# _ _) == (FastString u2# _ _) = u1# ==# u2#
--}
+  a == b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> False }
+  a /= b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> True  }
 
-instance Uniquable FastString where
- uniqueOf (FastString u# _ _) = mkUniqueGrimily u#
- uniqueOf (CharStr a# l#) =
-   {-
-     [A somewhat moby hack]: to avoid entering all sorts
-     of junk into the hash table, all C char strings
-     are by default left out. The benefit of being in
-     the table is that string comparisons are lightning fast,
-     just an Int# comparison.
-   
-     But, if you want to get the Unique of a CharStr, we 
-     enter it into the table and return that unique. This
-     works, but causes the CharStr to be looked up in the hash
-     table each time it is accessed..
-   -}
-   mkUniqueGrimily (case mkFastString# a# l# of { FastString u# _ _ -> u#}) -- Ugh!
-
-instance Uniquable Int where
- uniqueOf (I# i#) = mkUniqueGrimily i#
+instance Ord FastString where
+    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
+    a <	 b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
+    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
+    a >	 b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
+    max x y | x >= y	=  x
+            | otherwise	=  y
+    min x y | x <= y	=  x
+            | otherwise	=  y
+    compare a b = cmpFS a b
 
 instance Text FastString  where
-    readsPrec p = error "readsPrec: FastString: ToDo"
     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#
 
-getByteArray :: FastString -> _ByteArray Int
-getByteArray (FastString _ l# ba#) = _ByteArray (0,I# l#) ba#
+getByteArray :: FastString -> ByteArray Int
+getByteArray (FastString _ l# ba#) = ByteArray (0,I# l#) ba#
 
 lengthFS :: FastString -> Int
 lengthFS (FastString _ l# _) = I# l#
@@ -117,7 +130,7 @@ nullFastString (FastString _ l# _) = l# ==# 0#
 nullFastString (CharStr _ l#) = l# ==# 0#
 
 unpackFS :: FastString -> String
-unpackFS (FastString _ l# ba#) = byteArrayToString (_ByteArray (0,I# l#) ba#)
+unpackFS (FastString _ l# ba#) = unpackCStringBA# ba# l#
 unpackFS (CharStr addr len#) =
  unpack 0#
  where
@@ -145,6 +158,21 @@ tailFS (FastString _ l# ba#) = mkFastSubStringBA# ba# 1# (l# -# 1#)
 consFS :: Char -> FastString -> FastString
 consFS c fs = mkFastString (c:unpackFS fs)
 
+uniqueOfFS :: FastString -> Int#
+uniqueOfFS (FastString u# _ _) = u#
+uniqueOfFS (CharStr a# l#)     = case mkFastString# a# l# of { FastString u# _ _ -> u#} -- Ugh!
+   {-
+     [A somewhat moby hack]: to avoid entering all sorts
+     of junk into the hash table, all C char strings
+     are by default left out. The benefit of being in
+     the table is that string comparisons are lightning fast,
+     just an Int# comparison.
+   
+     But, if you want to get the Unique of a CharStr, we 
+     enter it into the table and return that unique. This
+     works, but causes the CharStr to be looked up in the hash
+     table each time it is accessed..
+   -}
 \end{code}
 
 Internally, the compiler will maintain a fast string symbol
@@ -156,46 +184,46 @@ new @FastString@s then covertly does a lookup, re-using the
 data FastStringTable = 
  FastStringTable
     Int#
-    (MutableArray# _RealWorld [FastString])
+    (MutableArray# RealWorld [FastString])
 
-type FastStringTableVar = MutableVar _RealWorld FastStringTable
+type FastStringTableVar = IORef FastStringTable
 
 string_table :: FastStringTableVar
 string_table = 
- unsafePerformPrimIO (
-   newArray (0::Int,hASH_TBL_SIZE) [] `thenPrimIO` \ (_MutableArray _ arr#) ->
-   newVar (FastStringTable 0# arr#))
+ unsafePerformIO (
+   stToIO (newArray (0::Int,hASH_TBL_SIZE) [])		>>= \ (MutableArray _ arr#) ->
+   newIORef (FastStringTable 0# arr#))
 
-lookupTbl :: FastStringTable -> Int# -> [FastString]
+lookupTbl :: FastStringTable -> Int# -> IO [FastString]
 lookupTbl (FastStringTable _ arr#) i# =
- unsafePerformPrimIO ( \ (S# s#) ->
-   case readArray# arr# i# s# of { StateAndPtr# s2# r ->
-    (r, S# s2#) } )
+  IO ( \ s# ->
+  case readArray# arr# i# s# of { StateAndPtr# s2# r ->
+  IOok s2# r })
 
-updTbl :: FastStringTableVar -> FastStringTable -> Int# -> [FastString] -> PrimIO ()
-updTbl (_MutableArray _ var#) (FastStringTable uid# arr#) i# ls (S# s#) =
- case writeArray# arr# i# ls s# of { s2# ->
- case writeArray# var# 0# (FastStringTable (uid# +# 1#) arr#) s2# of { s3# ->
-  ((), S# s3#) }}
+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# () })	>>
+ writeIORef fs_table_var (FastStringTable (uid# +# 1#) arr#)
 
 mkFastString# :: Addr# -> Int# -> FastString
 mkFastString# a# len# =
- unsafePerformPrimIO  (
-  readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) ->
+ unsafePerformIO  (
+  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->
   let
    h = hashStr a# len#
   in
 --  _trace ("hashed: "++show (I# h)) $
-  case lookupTbl ft h of
+  lookupTbl ft h	>>= \ lookup_result ->
+  case lookup_result of
     [] -> 
        -- no match, add it to table by copying out the
        -- the string into a ByteArray
        -- _trace "empty bucket" $
        case copyPrefixStr (A# a#) (I# len#) of
-	 (_ByteArray _ barr#) ->  
+	 (ByteArray _ barr#) ->  
 	   let f_str = FastString uid# len# barr# in
-           updTbl string_table ft h [f_str] `seqPrimIO`
-           ({- _trace ("new: " ++ show f_str)   $ -} returnPrimIO f_str)
+           updTbl string_table ft h [f_str] >>
+           ({- _trace ("new: " ++ show f_str)   $ -} return f_str)
     ls -> 
        -- non-empty `bucket', scan the list looking
        -- entry with same length and compare byte by byte.
@@ -203,11 +231,11 @@ mkFastString# a# len# =
        case bucket_match ls len# a# of
 	 Nothing -> 
            case copyPrefixStr (A# a#) (I# len#) of
-  	    (_ByteArray _ barr#) ->  
+  	    (ByteArray _ barr#) ->  
               let f_str = FastString uid# len# barr# in
-              updTbl string_table ft h (f_str:ls) `seqPrimIO`
-	      ( {- _trace ("new: " ++ show f_str)  $ -} returnPrimIO f_str)
-	 Just v  -> {- _trace ("re-use: "++show v) $ -} returnPrimIO v)
+              updTbl string_table ft h (f_str:ls) >>
+	      ( {- _trace ("new: " ++ show f_str)  $ -} return f_str)
+	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
   where
    bucket_match [] _ _ = Nothing
    bucket_match (v@(FastString _ l# ba#):ls) len# a# =
@@ -221,29 +249,32 @@ mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#))
 
 mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString
 mkFastSubStringFO# fo# start# len# =
- unsafePerformPrimIO  (
-  readVar string_table                 `thenPrimIO` \ ft@(FastStringTable uid# tbl#) ->
-  let h = hashSubStrFO fo# start# len# in
-  case lookupTbl ft h of
+ unsafePerformIO  (
+  readIORef string_table >>= \ ft@(FastStringTable uid# tbl#) ->
+  let
+   h = hashSubStrFO fo# start# len#
+  in
+  lookupTbl ft h	>>= \ lookup_result ->
+  case lookup_result of
     [] -> 
        -- no match, add it to table by copying out the
        -- the string into a ByteArray
        case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
-	 (_ByteArray _ barr#) ->  
+	 (ByteArray _ barr#) ->  
 	   let f_str = FastString uid# len# barr# in
-           updTbl string_table ft h [f_str]       `seqPrimIO`
-	   returnPrimIO f_str
+           updTbl string_table ft h [f_str]       >>
+	   return f_str
     ls -> 
        -- non-empty `bucket', scan the list looking
        -- entry with same length and compare byte by byte.
        case bucket_match ls start# len# fo# of
 	 Nothing -> 
            case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
-   	     (_ByteArray _ barr#) ->  
+   	     (ByteArray _ barr#) ->  
               let f_str = FastString uid# len# barr# in
-              updTbl string_table ft  h (f_str:ls) `seqPrimIO`
-	      ( {- _trace ("new: " ++ show f_str) $ -} returnPrimIO f_str)
-	 Just v  -> {- _trace ("re-use: "++show v) $ -} returnPrimIO v)
+              updTbl string_table ft  h (f_str:ls) >>
+	      ( {- _trace ("new: " ++ show f_str) $ -} return f_str)
+	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
   where
    bucket_match [] _ _ _ = Nothing
    bucket_match (v@(FastString _ l# barr#):ls) start# len# fo# =
@@ -255,36 +286,39 @@ mkFastSubStringFO# fo# start# len# =
 
 mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString
 mkFastSubStringBA# barr# start# len# =
- unsafePerformPrimIO  (
-  readVar string_table                   `thenPrimIO` \ ft@(FastStringTable uid# tbl#) ->
-  let h = hashSubStrBA barr# start# len# in
-  -- _trace ("hashed(b): "++show (I# h)) $
-  case lookupTbl ft h of
+ unsafePerformIO  (
+  readIORef string_table	>>= \ ft@(FastStringTable uid# tbl#) ->
+  let
+   h = hashSubStrBA barr# start# len#
+  in
+--  _trace ("hashed(b): "++show (I# h)) $
+  lookupTbl ft h		>>= \ lookup_result ->
+  case lookup_result of
     [] -> 
        -- no match, add it to table by copying out the
        -- the string into a ByteArray
        -- _trace "empty bucket(b)" $
-       case copySubStrBA (_ByteArray btm barr#) (I# start#) (I# len#) of
-         (_ByteArray _ ba#) ->  
+       case copySubStrBA (ByteArray btm barr#) (I# start#) (I# len#) of
+         (ByteArray _ ba#) ->  
           let f_str = FastString uid# len# ba# in
-          updTbl string_table ft h [f_str]     `seqPrimIO`
+          updTbl string_table ft h [f_str]     >>
           -- _trace ("new(b): " ++ show f_str)   $
-	  returnPrimIO f_str
+	  return f_str
     ls -> 
        -- non-empty `bucket', scan the list looking
        -- entry with same length and compare byte by byte. 
        -- _trace ("non-empty bucket(b)"++show ls) $
        case bucket_match ls start# len# barr# of
 	 Nothing -> 
-          case copySubStrBA (_ByteArray (error "") barr#) (I# start#) (I# len#) of
-            (_ByteArray _ ba#) ->  
+          case copySubStrBA (ByteArray (error "") barr#) (I# start#) (I# len#) of
+            (ByteArray _ ba#) ->  
               let f_str = FastString uid# len# ba# in
-              updTbl string_table ft h (f_str:ls) `seqPrimIO`
+              updTbl string_table ft h (f_str:ls) >>
 	      -- _trace ("new(b): " ++ show f_str)   $
-	      returnPrimIO f_str
+	      return f_str
 	 Just v  -> 
               -- _trace ("re-use(b): "++show v) $
-	      returnPrimIO v
+	      return v
   )
  where
    btm = error ""
@@ -298,29 +332,32 @@ mkFastSubStringBA# barr# start# len# =
       else
 	 bucket_match ls start# len# ba#
 
-mkFastCharString :: _Addr -> FastString
+mkFastCharString :: Addr -> FastString
 mkFastCharString a@(A# a#) = 
  case strLength a of{ (I# len#) -> CharStr a# len# }
 
-mkFastCharString2 :: _Addr -> Int -> FastString
+mkFastCharString# :: Addr# -> FastString
+mkFastCharString# a# = 
+ case strLength (A# a#) of { (I# len#) -> CharStr a# len# }
+
+mkFastCharString2 :: Addr -> Int -> FastString
 mkFastCharString2 a@(A# a#) (I# len#) = CharStr a# len#
 
 mkFastString :: String -> FastString
 mkFastString str = 
- case stringToByteArray str of
-  (_ByteArray (_,I# len#) frozen#) -> 
+ case packString str of
+  (ByteArray (_,I# len#) frozen#) -> 
     mkFastSubStringBA# frozen# 0# len#
     {- 0-indexed array, len# == index to one beyond end of string,
        i.e., (0,1) => empty string.    -}
 
-mkFastSubString :: _Addr -> Int -> Int -> FastString
+mkFastSubString :: Addr -> Int -> Int -> FastString
 mkFastSubString (A# a#) (I# start#) (I# len#) =
  mkFastString# (addrOffset# a# start#) len#
 
 mkFastSubStringFO :: _ForeignObj -> Int -> Int -> FastString
 mkFastSubStringFO (_ForeignObj fo#) (I# start#) (I# len#) =
  mkFastSubStringFO# fo# start# len#
-
 \end{code}
 
 \begin{code}
@@ -332,113 +369,92 @@ hashStr a# len# =
    1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
-{- Currently UNUSED:
-  if len# ==# 0# then
-     0#
-  else
-     ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#)
-	`remInt#` hASH_TBL_SIZE#
--}
   where
     c0 = indexCharOffAddr# a# 0#
-    c1 = indexCharOffAddr# a# 1# --(len# `quotInt#` 2# -# 1#)
-    c2 = indexCharOffAddr# a# 2# --(len# -# 1#)
+    c1 = indexCharOffAddr# a# (len# `quotInt#` 2# -# 1#)
+    c2 = indexCharOffAddr# a# (len# -# 1#)
+{-
+    c1 = indexCharOffAddr# a# 1#
+    c2 = indexCharOffAddr# a# 2#
+-}
 
 hashSubStrFO  :: ForeignObj# -> Int# -> Int# -> Int#
- -- use the Addr to produce a hash value between 0 & m (inclusive)
+ -- use the FO to produce a hash value between 0 & m (inclusive)
 hashSubStrFO fo# start# len# =
   case len# of
    0# -> 0#
    1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
-{-
-  if len# ==# 0# then
-     0#
-  else
-     ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#)
-	`remInt#` hASH_TBL_SIZE#
--}
   where
-    c0 = indexCharOffFO# fo# 0#
-    c1 = indexCharOffFO# fo# 1# --(len# `quotInt#` 2# -# 1#)
-    c2 = indexCharOffFO# fo# 2# --(len# -# 1#)
+    c0 = indexCharOffForeignObj# fo# 0#
+    c1 = indexCharOffForeignObj# fo# (len# `quotInt#` 2# -# 1#)
+    c2 = indexCharOffForeignObj# fo# (len# -# 1#)
+
+--    c1 = indexCharOffFO# fo# 1#
+--    c2 = indexCharOffFO# fo# 2#
 
 
 hashSubStrBA  :: ByteArray# -> Int# -> Int# -> Int#
- -- use the Addr to produce a hash value between 0 & m (inclusive)
+ -- use the byte array to produce a hash value between 0 & m (inclusive)
 hashSubStrBA ba# start# len# =
   case len# of
    0# -> 0#
    1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
    2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
    _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
-{-
-  if len# ==# 0# then
-     0#
-  else
-     ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#)
-	`remInt#` hASH_TBL_SIZE#
--}
   where
     c0 = indexCharArray# ba# 0#
-    c1 = indexCharArray# ba# 1# --(len# `quotInt#` 2# -# 1#)
-    c2 = indexCharArray# ba# 2# --(len# -# 1#)
+    c1 = indexCharArray# ba# (len# `quotInt#` 2# -# 1#)
+    c2 = indexCharArray# ba# (len# -# 1#)
+
+--    c1 = indexCharArray# ba# 1#
+--    c2 = indexCharArray# ba# 2#
 
 \end{code}
 
 \begin{code}
-tagCmpFS :: FastString -> FastString -> _CMP_TAG
-tagCmpFS (FastString u1# _ b1#) (FastString u2# _ b2#) = -- assume non-null chars
+cmpFS :: FastString -> FastString -> Ordering
+cmpFS (FastString u1# _ b1#) (FastString u2# _ b2#) = -- assume non-null chars
   if u1# ==# u2# then
-     _EQ
+     EQ
   else
-   unsafePerformPrimIO (
-    _ccall_ strcmp (_ByteArray bottom b1#) (_ByteArray bottom b2#) `thenPrimIO` \ (I# res) ->
-    returnPrimIO (
-    if      res <#  0# then _LT
-    else if res ==# 0# then _EQ
-    else		    _GT
+   unsafePerformIO (
+    _ccall_ strcmp (ByteArray bottom b1#) (ByteArray bottom b2#)	>>= \ (I# res) ->
+    return (
+    if      res <#  0# then LT
+    else if res ==# 0# then EQ
+    else		    GT
     ))
   where
+   bottom :: (Int,Int)
    bottom = error "tagCmp"
-tagCmpFS (CharStr bs1 len1) (CharStr bs2 len2)
-  = unsafePerformPrimIO (
-    _ccall_ strcmp ba1 ba2  `thenPrimIO` \ (I# res) ->
-    returnPrimIO (
-    if      res <#  0# then _LT
-    else if res ==# 0# then _EQ
-    else		    _GT
+cmpFS (CharStr bs1 len1) (CharStr bs2 len2)
+  = unsafePerformIO (
+    _ccall_ strcmp ba1 ba2	>>= \ (I# res) ->
+    return (
+    if      res <#  0# then LT
+    else if res ==# 0# then EQ
+    else		    GT
     ))
   where
     ba1 = A# bs1
     ba2 = A# bs2
-tagCmpFS (FastString _ len1 bs1) (CharStr bs2 len2)
- = unsafePerformPrimIO (
-    _ccall_ strcmp ba1 ba2 `thenPrimIO` \ (I# res) ->
-    returnPrimIO (
-     if      res <#  0# then _LT
-     else if res ==# 0# then _EQ
-     else		    _GT
+cmpFS (FastString _ len1 bs1) (CharStr bs2 len2)
+ = unsafePerformIO (
+    _ccall_ strcmp ba1 ba2	>>= \ (I# res) ->
+    return (
+     if      res <#  0# then LT
+     else if res ==# 0# then EQ
+     else		     GT
     ))
   where
-    ba1 = _ByteArray (error "") bs1
+    ba1 = ByteArray ((error "")::(Int,Int)) bs1
     ba2 = A# bs2
 
-tagCmpFS a@(CharStr _ _) b@(FastString _ _ _)
+cmpFS a@(CharStr _ _) b@(FastString _ _ _)
   = -- try them the other way 'round
-    case (tagCmpFS b a) of { _LT -> _GT; _EQ -> _EQ; _GT -> _LT }
-
-instance Ord FastString where
-    a <= b = case tagCmpFS a b of { _LT -> True;  _EQ -> True;  _GT -> False }
-    a <	 b = case tagCmpFS a b of { _LT -> True;  _EQ -> False; _GT -> False }
-    a >= b = case tagCmpFS a b of { _LT -> False; _EQ -> True;  _GT -> True  }
-    a >	 b = case tagCmpFS a b of { _LT -> False; _EQ -> False; _GT -> True  }
-    max x y | x >= y	=  x
-            | otherwise	=  y
-    min x y | x <= y	=  x
-            | otherwise	=  y
-    _tagCmp a b = tagCmpFS a b
+    case (cmpFS b a) of { LT -> GT; EQ -> EQ; GT -> LT }
 
 \end{code}
 
@@ -451,56 +467,56 @@ hPutFS handle (FastString _ l# ba#) =
  if l# ==# 0# then
     return ()
  else
-    _readHandle handle				    >>= \ htype ->
+    readHandle handle				    >>= \ htype ->
     case htype of 
-      _ErrorHandle ioError ->
-	  _writeHandle handle htype		    >>
-          failWith ioError
-      _ClosedHandle ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is closed")
-      _SemiClosedHandle _ _ ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is closed")
-      _ReadHandle _ _ _ ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is not open for writing")
+      ErrorHandle ioError ->
+	  writeHandle handle htype		    >>
+          fail ioError
+      ClosedHandle ->
+	  writeHandle handle htype		    >>
+	  fail MkIOError(handle,IllegalOperation,"handle is closed")
+      SemiClosedHandle _ _ ->
+	  writeHandle handle htype		    >>
+	  fail MkIOError(handle,IllegalOperation,"handle is closed")
+      ReadHandle _ _ _ ->
+	  writeHandle handle htype		    >>
+	  fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
       other -> 
-          let fp = _filePtr htype in
+          let fp = filePtr htype in
 	   -- here we go..
-          _ccall_ writeFile (_ByteArray (error "") ba#) fp (I# l#) `thenPrimIO` \rc ->
+          _ccall_ writeFile (ByteArray ((error "")::(Int,Int)) ba#) fp (I# l#) >>= \rc ->
           if rc==0 then
               return ()
           else
-              _constructError "hPutFS"   `thenPrimIO` \ err ->
-	      failWith err
+              constructError "hPutFS"   >>= \ err ->
+	      fail err
 hPutFS handle (CharStr a# l#) =
  if l# ==# 0# then
     return ()
  else
-    _readHandle handle				    >>= \ htype ->
+    readHandle handle				    >>= \ htype ->
     case htype of 
-      _ErrorHandle ioError ->
-	  _writeHandle handle htype		    >>
-          failWith ioError
-      _ClosedHandle ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is closed")
-      _SemiClosedHandle _ _ ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is closed")
-      _ReadHandle _ _ _ ->
-	  _writeHandle handle htype		    >>
-	  failWith (IllegalOperation "handle is not open for writing")
+      ErrorHandle ioError ->
+	  writeHandle handle htype		    >>
+          fail ioError
+      ClosedHandle ->
+	  writeHandle handle htype		    >>
+	  fail MkIOError(handle,IllegalOperation,"handle is closed")
+      SemiClosedHandle _ _ ->
+	  writeHandle handle htype		    >>
+	  fail MkIOError(handle,IllegalOperation,"handle is closed")
+      ReadHandle _ _ _ ->
+	  writeHandle handle htype		    >>
+	  fail MkIOError(handle,IllegalOperation,"handle is not open for writing")
       other -> 
-          let fp = _filePtr htype in
+          let fp = filePtr htype in
 	   -- here we go..
-          _ccall_ writeFile (A# a#) fp (I# l#) `thenPrimIO` \rc ->
+          _ccall_ writeFile (A# a#) fp (I# l#)	>>= \rc ->
           if rc==0 then
               return ()
           else
-              _constructError "hPutFS"   `thenPrimIO` \ err ->
-	      failWith err
+              constructError "hPutFS"   	>>= \ err ->
+	      fail err
 
 --ToDo: avoid silly code duplic.
 \end{code}