-\begin{code}
-cmpFS :: FastString -> FastString -> Ordering
-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# 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
- if l1# ==# l2# then EQ
- else if l1# <# l2# then LT else GT
- else GT
- ))
-
-foreign import ccall "ghc_memcmp" unsafe
- memcmp :: ByteArray# -> ByteArray# -> Int# -> IO Int
+-- | Returns 'True' if the 'FastString' is Z-encoded
+isZEncoded :: FastString -> Bool
+isZEncoded fs | ZEncoded <- enc fs = True
+ | otherwise = False
+
+-- | Returns 'True' if the 'FastString' is empty
+nullFS :: FastString -> Bool
+nullFS f = n_bytes f == 0
+
+-- | unpacks and decodes the FastString
+unpackFS :: FastString -> String
+unpackFS (FastString _ n_bytes _ buf enc) =
+ inlinePerformIO $ withForeignPtr buf $ \ptr ->
+ case enc of
+ ZEncoded -> peekCAStringLen (castPtr ptr,n_bytes)
+ UTF8Encoded _ -> utf8DecodeString ptr n_bytes
+
+bytesFS :: FastString -> [Word8]
+bytesFS (FastString _ n_bytes _ buf enc) =
+ inlinePerformIO $ withForeignPtr buf $ \ptr ->
+ peekArray n_bytes ptr
+
+-- | returns a Z-encoded version of a 'FastString'. This might be the
+-- original, if it was already Z-encoded. The first time this
+-- function is applied to a particular 'FastString', the results are
+-- memoized.
+--
+zEncodeFS :: FastString -> FastString
+zEncodeFS fs@(FastString uid n_bytes _ fp enc) =
+ case enc of
+ ZEncoded -> fs
+ UTF8Encoded ref ->
+ inlinePerformIO $ do
+ m <- readIORef ref
+ case m of
+ Just fs -> return fs
+ Nothing -> do
+ let efs = mkZFastString (zEncodeString (unpackFS fs))
+ writeIORef ref (Just efs)
+ return efs
+
+appendFS :: FastString -> FastString -> FastString
+appendFS fs1 fs2 = mkFastString (unpackFS fs1 ++ unpackFS fs2)
+
+concatFS :: [FastString] -> FastString
+concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
+
+headFS :: FastString -> Char
+headFS (FastString _ n_bytes _ buf enc) =
+ inlinePerformIO $ withForeignPtr buf $ \ptr -> do
+ case enc of
+ ZEncoded -> do
+ w <- peek (castPtr ptr)
+ return (castCCharToChar w)
+ UTF8Encoded _ ->
+ return (fst (utf8DecodeChar ptr))
+
+tailFS :: FastString -> FastString
+tailFS (FastString _ n_bytes _ buf enc) =
+ inlinePerformIO $ withForeignPtr buf $ \ptr -> do
+ case enc of
+ ZEncoded -> do
+ return $! mkZFastStringBytes (ptr `plusPtr` 1) (n_bytes - 1)
+ UTF8Encoded _ -> do
+ let (_,ptr') = utf8DecodeChar ptr
+ let off = ptr' `minusPtr` ptr
+ return $! mkFastStringBytes (ptr `plusPtr` off) (n_bytes - off)
+
+consFS :: Char -> FastString -> FastString
+consFS c fs = mkFastString (c : unpackFS fs)
+
+uniqueOfFS :: FastString -> Int#
+uniqueOfFS (FastString (I# u#) _ _ _ _) = u#
+
+nilFS = mkFastString ""