+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 ""
+
+-- -----------------------------------------------------------------------------
+-- Outputting 'FastString's
+
+-- |Outputs a 'FastString' with /no decoding at all/, that is, you
+-- get the actual bytes in the 'FastString' written to the 'Handle'.
+hPutFS handle (FastString _ len _ fp _)
+ | len == 0 = return ()
+ | otherwise = do withForeignPtr fp $ \ptr -> hPutBuf handle ptr len
+
+-- ToDo: we'll probably want an hPutFSLocal, or something, to output
+-- in the current locale's encoding (for error messages and suchlike).
+
+-- -----------------------------------------------------------------------------
+-- LitStrings, here for convenience only.
+
+type LitString = Ptr ()
+
+mkLitString# :: Addr# -> LitString
+mkLitString# a# = Ptr a#
+
+foreign import ccall unsafe "ghc_strlen"
+ strLength :: Ptr () -> Int
+
+-- -----------------------------------------------------------------------------
+-- under the carpet
+
+-- Just like unsafePerformIO, but we inline it.
+{-# INLINE inlinePerformIO #-}
+inlinePerformIO :: IO a -> a
+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+
+pokeCAString :: Ptr CChar -> String -> IO ()
+pokeCAString ptr str =
+ let
+ go [] n = pokeElemOff ptr n 0
+ go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
+ in
+ go str 0