[project @ 2002-12-19 14:33:22 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 7523f92..494648f 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -47,7 +47,6 @@ module FastString
 #include "HsVersions.h"
 
 #if __GLASGOW_HASKELL__ < 503
-import PrelPack                hiding (packString)
 import PrelIOBase      ( IO(..) )
 #else
 import GHC.IOBase      ( IO(..) )
@@ -56,7 +55,7 @@ import GHC.IOBase     ( IO(..) )
 import PrimPacked
 import GLAEXTS
 import UNSAFE_IO       ( unsafePerformIO )
-import ST              ( stToIO )
+import MONAD_ST                ( stToIO )
 import DATA_IOREF      ( IORef, newIORef, readIORef, writeIORef )
 
 #if __GLASGOW_HASKELL__ < 503
@@ -127,7 +126,7 @@ nullFastString (UnicodeStr _ []) = True
 nullFastString (UnicodeStr _ (_:_)) = False
 
 unpackFS :: FastString -> String
-unpackFS (FastString _ l# ba#) = unpackCStringBA (BA ba#) (I# l#)
+unpackFS (FastString _ l# ba#) = unpackNBytesBA (BA ba#) (I# l#)
 unpackFS (UnicodeStr _ s) = map chr s
 
 unpackIntFS :: FastString -> [Int]
@@ -419,20 +418,21 @@ cmpFS (UnicodeStr u1# s1) (UnicodeStr u2# s2) = if u1# ==# u2# then EQ
     else compare s1 s2
 cmpFS (UnicodeStr _ s1) s2 = compare s1 (unpackIntFS s2)
 cmpFS s1 (UnicodeStr _ s2) = compare (unpackIntFS s1) s2
-cmpFS (FastString u1# _ b1#) (FastString u2# _ b2#) = -- assume non-null chars
-  if u1# ==# u2# then
-     EQ
-  else
-   unsafePerformIO (
-    strcmp b1# b2# >>= \ (I# res) ->
+cmpFS (FastString u1# l1# b1#) (FastString u2# l2# b2#) =
+  if u1# ==# u2# then EQ else
+  let l# = if l1# <=# l2# then l1# else l2# in
+  unsafePerformIO (
+    memcmp b1# b2# l# >>= \ (I# res) ->
     return (
     if      res <#  0# then LT
-    else if res ==# 0# then EQ
+    else if res ==# 0# then 
+       if l1# ==# l2# then EQ
+       else if l1# <# l2# then LT else GT
     else                   GT
     ))
 
-foreign import ccall "strcmp" unsafe 
-  strcmp :: ByteArray# -> ByteArray# -> IO Int
+foreign import ccall "ghc_memcmp" unsafe 
+  memcmp :: ByteArray# -> ByteArray# -> Int# -> IO Int
 
 -- -----------------------------------------------------------------------------
 -- Outputting 'FastString's