ghc/compiler/utils/StringBuffer.lhs

   1 %
   2 % (c) The University of Glasgow, 1997-2003
   3 %
   4 \section{String buffers}
   5
   6 Buffers for scanning string input stored in external arrays.
   7
   8 \begin{code}
   9 {-# OPTIONS_GHC -O #-}
  10 -- always optimise this module, it's critical
  11
  12 module StringBuffer
  13        (
  14         StringBuffer(..),
  15         -- non-abstract for vs\/HaskellService
  16
  17          -- * Creation\/destruction
  18         hGetStringBuffer,
  19         stringToStringBuffer,
  20
  21         -- * Inspection
  22         nextChar,
  23         currentChar,
  24         prevChar,
  25         atEnd,
  26
  27         -- * Moving and comparison
  28         stepOn,
  29         offsetBytes,
  30         byteDiff,
  31
  32         -- * Conversion
  33         lexemeToString,
  34         lexemeToFastString,
  35
  36          -- * Parsing integers
  37         parseInteger,
  38        ) where
  39
  40 #include "HsVersions.h"
  41
  42 import Encoding
  43 import FastString       (FastString,mkFastString,mkFastStringBytes)
  44
  45 import GLAEXTS
  46
  47 import Foreign
  48
  49 import GHC.IOBase               ( IO(..) )
  50 import GHC.Base                 ( unsafeChr )
  51
  52 import System.IO                ( hGetBuf )
  53
  54 import IO                       ( hFileSize, IOMode(ReadMode),
  55                                   hClose )
  56 #if __GLASGOW_HASKELL__ >= 601
  57 import System.IO                ( openBinaryFile )
  58 #else
  59 import IOExts                   ( openFileEx, IOModeEx(..) )
  60 #endif
  61
  62 #if __GLASGOW_HASKELL__ < 601
  63 openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
  64 #endif
  65
  66 -- -----------------------------------------------------------------------------
  67 -- The StringBuffer type
  68
  69 -- |A StringBuffer is an internal pointer to a sized chunk of bytes.
  70 -- The bytes are intended to be *immutable*.  There are pure
  71 -- operations to read the contents of a StringBuffer.
  72 --
  73 -- A StringBuffer may have a finalizer, depending on how it was
  74 -- obtained.
  75 --
  76 data StringBuffer
  77  = StringBuffer {
  78      buf :: {-# UNPACK #-} !(ForeignPtr Word8),
  79      len :: {-# UNPACK #-} !Int,        -- length
  80      cur :: {-# UNPACK #-} !Int         -- current pos
  81   }
  82         -- The buffer is assumed to be UTF-8 encoded, and furthermore
  83         -- we add three '\0' bytes to the end as sentinels so that the
  84         -- decoder doesn't have to check for overflow at every single byte
  85         -- of a multibyte sequence.
  86
  87 instance Show StringBuffer where
  88         showsPrec _ s = showString "<stringbuffer("
  89                       . shows (len s) . showString "," . shows (cur s)
  90                       . showString ">"
  91
  92 -- -----------------------------------------------------------------------------
  93 -- Creation / Destruction
  94
  95 hGetStringBuffer :: FilePath -> IO StringBuffer
  96 hGetStringBuffer fname = do
  97    h <- openBinaryFile fname ReadMode
  98    size_i <- hFileSize h
  99    let size = fromIntegral size_i
 100    buf <- mallocForeignPtrArray (size+3)
 101    withForeignPtr buf $ \ptr -> do
 102      r <- if size == 0 then return 0 else hGetBuf h ptr size
 103      hClose h
 104      if (r /= size)
 105         then ioError (userError "short read of file")
 106         else do
 107           pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
 108                  -- sentinels for UTF-8 decoding
 109           return (StringBuffer buf size 0)
 110
 111 stringToStringBuffer :: String -> IO StringBuffer
 112 stringToStringBuffer str = do
 113   let size = utf8EncodedLength str
 114   buf <- mallocForeignPtrArray (size+3)
 115   withForeignPtr buf $ \ptr -> do
 116     utf8EncodeString ptr str
 117     pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
 118          -- sentinels for UTF-8 decoding
 119   return (StringBuffer buf size 0)
 120
 121 -- -----------------------------------------------------------------------------
 122 -- Grab a character
 123
 124 -- Getting our fingers dirty a little here, but this is performance-critical
 125 {-# INLINE nextChar #-}
 126 nextChar :: StringBuffer -> (Char,StringBuffer)
 127 nextChar (StringBuffer buf len (I# cur#)) =
 128   inlinePerformIO $ do
 129     withForeignPtr buf $ \(Ptr a#) -> do
 130         case utf8DecodeChar# (a# `plusAddr#` cur#) of
 131           (# c#, b# #) ->
 132              let cur' = I# (b# `minusAddr#` a#) in
 133              return (C# c#, StringBuffer buf len cur')
 134
 135 currentChar :: StringBuffer -> Char
 136 currentChar = fst . nextChar
 137
 138 prevChar :: StringBuffer -> Char -> Char
 139 prevChar (StringBuffer buf len 0)   deflt = deflt
 140 prevChar (StringBuffer buf len cur) deflt =
 141   inlinePerformIO $ do
 142     withForeignPtr buf $ \p -> do
 143       p' <- utf8PrevChar (p `plusPtr` cur)
 144       return (fst (utf8DecodeChar p'))
 145
 146 -- -----------------------------------------------------------------------------
 147 -- Moving
 148
 149 stepOn :: StringBuffer -> StringBuffer
 150 stepOn s = snd (nextChar s)
 151
 152 offsetBytes :: Int -> StringBuffer -> StringBuffer
 153 offsetBytes i s = s { cur = cur s + i }
 154
 155 byteDiff :: StringBuffer -> StringBuffer -> Int
 156 byteDiff s1 s2 = cur s2 - cur s1
 157
 158 atEnd :: StringBuffer -> Bool
 159 atEnd (StringBuffer _ l c) = l == c
 160
 161 -- -----------------------------------------------------------------------------
 162 -- Conversion
 163
 164 lexemeToString :: StringBuffer -> Int {-bytes-} -> String
 165 lexemeToString _ 0 = ""
 166 lexemeToString (StringBuffer buf _ cur) bytes =
 167   inlinePerformIO $
 168     withForeignPtr buf $ \ptr ->
 169       utf8DecodeString (ptr `plusPtr` cur) bytes
 170
 171 lexemeToFastString :: StringBuffer -> Int {-bytes-} -> FastString
 172 lexemeToFastString _ 0 = mkFastString ""
 173 lexemeToFastString (StringBuffer buf _ cur) len =
 174    inlinePerformIO $
 175      withForeignPtr buf $ \ptr ->
 176        return $! mkFastStringBytes (ptr `plusPtr` cur) len
 177
 178 -- -----------------------------------------------------------------------------
 179 -- Parsing integer strings in various bases
 180
 181 byteOff :: StringBuffer -> Int -> Char
 182 byteOff (StringBuffer buf _ cur) i =
 183   inlinePerformIO $ withForeignPtr buf $ \ptr -> do
 184     w <- peek (ptr `plusPtr` (cur+i))
 185     return (unsafeChr (fromIntegral (w::Word8)))
 186
 187 -- | XXX assumes ASCII digits only
 188 parseInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
 189 parseInteger buf len radix to_int
 190   = go 0 0
 191   where go i x | i == len  = x
 192                | otherwise = go (i+1) (x * radix + toInteger (to_int (byteOff buf i)))
 193
 194 -- -----------------------------------------------------------------------------
 195 -- under the carpet
 196
 197 -- Just like unsafePerformIO, but we inline it.
 198 {-# INLINE inlinePerformIO #-}
 199 inlinePerformIO :: IO a -> a
 200 inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
 201
 202 \end{code}