ghc/compiler/utils/StringBuffer.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997
   3 %
   4 \section{String buffers}
   5
   6 Buffers for scanning string input stored in external arrays.
   7
   8 \begin{code}
   9 #include "HsVersions.h"
  10
  11 module StringBuffer
  12        (
  13         StringBuffer,
  14
  15          -- creation
  16         hGetStringBuffer,  -- :: FilePath       -> IO StringBuffer
  17         freeStringBuffer,  -- :: StringBuffer   -> IO ()
  18
  19          -- Lookup
  20         currentChar,      -- :: StringBuffer -> Char
  21         currentChar#,     -- :: StringBuffer -> Char#
  22         indexSBuffer,     -- :: StringBuffer -> Int -> Char
  23         indexSBuffer#,    -- :: StringBuffer -> Int# -> Char#
  24          -- relative lookup, i.e, currentChar = lookAhead 0
  25         lookAhead,        -- :: StringBuffer -> Int  -> Char
  26         lookAhead#,       -- :: StringBuffer -> Int# -> Char#
  27
  28          -- moving the end point of the current lexeme.
  29         setCurrentPos#,   -- :: StringBuffer -> Int# -> StringBuffer
  30         incLexeme,        -- :: StringBuffer -> StringBuffer
  31         decLexeme,        -- :: StringBuffer -> StringBuffer
  32
  33          -- move the start and end lexeme pointer on by x units.
  34         stepOn,           -- :: StringBuffer -> StringBuffer
  35         stepOnBy#,        -- :: StringBuffer -> Int# -> StringBuffer
  36         stepOnTo#,        -- :: StringBuffer -> Int# -> StringBuffer
  37         stepOnUntil,      -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
  38         stepOverLexeme,   -- :: StringBuffer   -> StringBuffer
  39         scanNumLit,       -- :: Int -> StringBuffer -> (Int, StringBuffer)
  40         expandWhile,      -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
  41         expandUntilMatch, -- :: StrinBuffer -> String -> StringBuffer
  42          -- at or beyond end of buffer?
  43         bufferExhausted,  -- :: StringBuffer -> Bool
  44         emptyLexeme,      -- :: StringBuffer -> Bool
  45
  46          -- matching
  47         prefixMatch,       -- :: StringBuffer -> String -> Bool
  48         untilEndOfString#, -- :: StringBuffer -> Int#
  49         untilEndOfChar#,   -- :: StringBuffer -> Int#
  50         untilChar#,        -- :: StringBuffer -> Char# -> Int#
  51
  52          -- conversion
  53         lexemeToString,     -- :: StringBuffer -> String
  54         lexemeToByteArray,  -- :: StringBuffer -> _ByteArray Int
  55         lexemeToFastString, -- :: StringBuffer -> FastString
  56         lexemeToBuffer,     -- :: StringBuffer -> StringBuffer
  57
  58         FastString,
  59         _ByteArray
  60        ) where
  61
  62 #if __GLASGOW_HASKELL__ <= 200
  63 import PreludeGlaST
  64 import PreludeGlaMisc
  65 import HandleHack
  66 import Ubiq
  67 #else
  68 import GlaExts
  69 import Foreign
  70 import IOBase
  71 import IOHandle
  72 import ST
  73 import STBase
  74 import Char (isDigit)
  75 # if __GLASGOW_HASKELL__ == 202
  76 import PrelBase ( Char(..) )
  77 # endif
  78 # if __GLASGOW_HASKELL__ >= 206
  79 import PackBase
  80 # endif
  81 #endif
  82 import PrimPacked
  83 import FastString
  84
  85 \end{code}
  86
  87 \begin{code}
  88 data StringBuffer
  89  = StringBuffer
  90      Addr#
  91 --     ForeignObj#  -- the data
  92      Int#         -- length
  93      Int#         -- lexeme start
  94      Int#         -- current pos
  95 \end{code}
  96
  97 \begin{code}
  98 instance Text StringBuffer where
  99         showsPrec _ s = showString ""
 100 \end{code}
 101
 102 \begin{code}
 103 hGetStringBuffer :: FilePath -> IO StringBuffer
 104 hGetStringBuffer fname =
 105 --    trace ("Renamer: opening " ++ fname) $
 106     openFile fname ReadMode >>= \ hndl ->
 107     hFileSize hndl          >>= \ len@(J# _ _ d#) ->
 108     let len_i = fromInteger len in
 109       -- Allocate an array for system call to store its bytes into.
 110       -- ToDo: make it robust
 111 --    trace (show ((len_i::Int)+1)) $
 112     (_casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int))  `CCALL_THEN` \ arr@(A# a#) ->
 113     if addr2Int# a# ==# 0# then
 114        failWith MkIOError(hndl,UserError,("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
 115     else
 116
 117 --   _casm_ `` %r=NULL; ''                                   `thenPrimIO` \ free_p ->
 118 --    makeForeignObj arr free_p                              `thenPrimIO` \ fo@(_ForeignObj fo#) ->
 119      _readHandle hndl        >>= \ hndl_ ->
 120      _writeHandle hndl hndl_ >>
 121      let ptr = _filePtr hndl_ in
 122      _ccall_ fread arr (1::Int) len_i ptr                     `CCALL_THEN` \  (I# read#) ->
 123 --     trace ("DEBUG: opened " ++ fname ++ show (I# read#)) $
 124      hClose hndl                     >>
 125      if read# ==# 0# then -- EOF or other error
 126         failWith MkIOError(hndl,UserError,"hGetStringBuffer: EOF reached or some other error")
 127      else
 128         -- Add a sentinel NUL
 129         _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) `CCALL_THEN` \ () ->
 130         return (StringBuffer a# read# 0# 0#)
 131
 132 freeStringBuffer :: StringBuffer -> IO ()
 133 freeStringBuffer (StringBuffer a# _ _ _) =
 134  _casm_ `` free((char *)%0); '' (A# a#) `CCALL_THEN` \ () ->
 135  return ()
 136
 137 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
 138 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
 139  unsafePerformPrimIO (
 140    _casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) `thenPrimIO` \ () ->
 141    returnPrimIO s)
 142
 143 \end{code}
 144
 145 Lookup
 146
 147 \begin{code}
 148 currentChar# :: StringBuffer -> Char#
 149 currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
 150
 151 currentChar  :: StringBuffer -> Char
 152 currentChar sb = case currentChar# sb of c -> C# c
 153
 154 indexSBuffer# :: StringBuffer -> Int# -> Char#
 155 indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
 156
 157 indexSBuffer :: StringBuffer -> Int -> Char
 158 indexSBuffer sb (I# i#) = case indexSBuffer# sb i# of c -> C# c
 159
 160  -- relative lookup, i.e, currentChar = lookAhead 0
 161 lookAhead# :: StringBuffer -> Int# -> Char#
 162 lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
 163
 164 lookAhead :: StringBuffer -> Int  -> Char
 165 lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
 166
 167 \end{code}
 168
 169  moving the start point of the current lexeme.
 170
 171 \begin{code}
 172  -- moving the end point of the current lexeme.
 173 setCurrentPos# :: StringBuffer -> Int# -> StringBuffer
 174 setCurrentPos# (StringBuffer fo l# s# c#) i# =
 175  StringBuffer fo l# s# (c# +# i#)
 176
 177 -- augmenting the current lexeme by one.
 178 incLexeme :: StringBuffer -> StringBuffer
 179 incLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# +# 1#)
 180
 181 decLexeme :: StringBuffer -> StringBuffer
 182 decLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# -# 1#)
 183
 184 \end{code}
 185
 186 -- move the start and end point of the buffer on by
 187 -- x units.
 188
 189 \begin{code}
 190 stepOn :: StringBuffer -> StringBuffer
 191 stepOn (StringBuffer fo l# s# c#) = StringBuffer fo l# (s# +# 1#) (s# +# 1#) -- assume they're the same.
 192
 193 stepOnBy# :: StringBuffer -> Int# -> StringBuffer
 194 stepOnBy# (StringBuffer fo# l# s# c#) i# =
 195  case s# +# i# of
 196   new_s# -> StringBuffer fo# l# new_s# new_s#
 197
 198 -- jump to pos.
 199 stepOnTo# :: StringBuffer -> Int# -> StringBuffer
 200 stepOnTo# (StringBuffer fo l _ _) s# = StringBuffer fo l s# s#
 201
 202 stepOnUntil :: (Char -> Bool) -> StringBuffer -> StringBuffer
 203 stepOnUntil pred (StringBuffer fo l# s# c#) =
 204  loop c#
 205   where
 206    loop c# =
 207     case indexCharOffAddr# fo c# of
 208      ch# | pred (C# ch#) -> StringBuffer fo l# c# c#
 209          | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
 210          | otherwise     -> loop (c# +# 1#)
 211
 212 stepOverLexeme :: StringBuffer -> StringBuffer
 213 stepOverLexeme (StringBuffer fo l s# c#) = StringBuffer fo l c# c#
 214
 215 expandWhile :: (Char -> Bool) -> StringBuffer -> StringBuffer
 216 expandWhile pred (StringBuffer fo l# s# c#) =
 217  loop c#
 218   where
 219    loop c# =
 220     case indexCharOffAddr# fo c# of
 221      ch# | pred (C# ch#) -> loop (c# +# 1#)
 222          | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
 223          | otherwise     -> StringBuffer fo l# s# c#
 224
 225
 226 scanNumLit :: Int -> StringBuffer -> (Int,StringBuffer)
 227 scanNumLit (I# acc#) (StringBuffer fo l# s# c#) =
 228  loop acc# c#
 229   where
 230    loop acc# c# =
 231     case indexCharOffAddr# fo c# of
 232      ch# | isDigit (C# ch#) -> loop (acc# *# 10# +# (ord# ch# -# ord# '0'#)) (c# +# 1#)
 233          | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# l# l#) -- EOB, return immediately.
 234          | otherwise        -> (I# acc#,StringBuffer fo l# s# c#)
 235
 236
 237 expandUntilMatch :: StringBuffer -> String -> StringBuffer
 238 expandUntilMatch (StringBuffer fo l# s# c#) str =
 239   loop c# str
 240   where
 241    loop c# [] = StringBuffer fo l# s# c#
 242    loop c# ((C# x#):xs) =
 243      if indexCharOffAddr# fo c# `eqChar#` x# then
 244         loop (c# +# 1#) xs
 245      else
 246         loop (c# +# 1#) str
 247 \end{code}
 248
 249 \begin{code}
 250    -- at or beyond end of buffer?
 251 bufferExhausted :: StringBuffer -> Bool
 252 bufferExhausted (StringBuffer fo l# _ c#) = c# >=# l#
 253
 254 emptyLexeme :: StringBuffer -> Bool
 255 emptyLexeme (StringBuffer fo l# s# c#) = s# ==# c#
 256
 257  -- matching
 258 prefixMatch :: StringBuffer -> String -> Maybe StringBuffer
 259 prefixMatch (StringBuffer fo l# s# c#) str =
 260   loop c# str
 261   where
 262    loop c# [] = Just (StringBuffer fo l# s# c#)
 263    loop c# ((C# x#):xs) =
 264      if indexCharOffAddr# fo c# `eqChar#` x# then
 265         loop (c# +# 1#) xs
 266      else
 267         Nothing
 268
 269 untilEndOfString# :: StringBuffer -> StringBuffer
 270 untilEndOfString# (StringBuffer fo l# s# c#) =
 271  loop c#
 272  where
 273   loop c# =
 274    case indexCharOffAddr# fo c# of
 275     '\"'# ->
 276        case indexCharOffAddr# fo (c# -# 1#) of
 277         '\\'# ->
 278                   -- looks like an escaped something or other to me,
 279                   -- better count the number of "\\"s that are immediately
 280                   -- preceeding to decide if the " is escaped.
 281               let
 282                odd_slashes flg i# =
 283                 case indexCharOffAddr# fo i# of
 284                  '\\'# -> odd_slashes (not flg) (i# -# 1#)
 285                  _     -> flg
 286               in
 287               if odd_slashes True (c# -# 2#) then
 288                   -- odd number, " is ecaped.
 289                   loop (c# +# 1#)
 290               else  -- a real end of string delimiter after all.
 291                   StringBuffer fo l# s# c#
 292         _ -> StringBuffer fo l# s# c#
 293     '\NUL'# ->
 294         if c# >=# l# then -- hit sentinel, this doesn't look too good..
 295            StringBuffer fo l# l# l#
 296         else
 297            loop (c# +# 1#)
 298     _ -> loop (c# +# 1#)
 299
 300
 301 untilEndOfChar# :: StringBuffer -> StringBuffer
 302 untilEndOfChar# (StringBuffer fo l# s# c#) =
 303  loop c#
 304  where
 305   loop c# =
 306    case indexCharOffAddr# fo c# of
 307     '\''# ->
 308        case indexCharOffAddr# fo (c# -# 1#) of
 309         '\\'# ->
 310            case indexCharOffAddr# fo (c# -# 2#) of
 311              '\\'# -> -- end of char
 312                    StringBuffer fo l# s# c#
 313              _ -> loop (c# +# 1#) -- false alarm
 314         _ -> StringBuffer fo l# s# c#
 315     '\NUL'# ->
 316         if c# >=# l# then -- hit sentinel, this doesn't look too good..
 317            StringBuffer fo l# l# l#
 318         else
 319            loop (c# +# 1#)
 320     _ -> loop (c# +# 1#)
 321
 322 untilChar# :: StringBuffer -> Char# -> StringBuffer
 323 untilChar# (StringBuffer fo l# s# c#) x# =
 324  loop c#
 325  where
 326   loop c# =
 327    if indexCharOffAddr# fo c# `eqChar#` x# then
 328       StringBuffer fo l# s# c#
 329    else
 330       loop (c# +# 1#)
 331
 332          -- conversion
 333 lexemeToString :: StringBuffer -> String
 334 lexemeToString (StringBuffer fo _ start_pos# current#) =
 335  if start_pos# ==# current# then
 336     ""
 337  else
 338 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 205
 339     byteArrayToString (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
 340 #else
 341     unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
 342 #endif
 343
 344 lexemeToByteArray :: StringBuffer -> _ByteArray Int
 345 lexemeToByteArray (StringBuffer fo _ start_pos# current#) =
 346  if start_pos# ==# current# then
 347     error "lexemeToByteArray"
 348  else
 349     copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
 350
 351 lexemeToFastString :: StringBuffer -> FastString
 352 lexemeToFastString (StringBuffer fo l# start_pos# current#) =
 353  if start_pos# ==# current# then
 354     mkFastCharString2 (A# fo) (I# 0#)
 355  else
 356     mkFastSubString (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
 357
 358 {-
 359  Create a StringBuffer from the current lexeme, and add a sentinel
 360  at the end. Know What You're Doing before taking this function
 361  into use..
 362 -}
 363 lexemeToBuffer :: StringBuffer -> StringBuffer
 364 lexemeToBuffer (StringBuffer fo l# start_pos# current#) =
 365  if start_pos# ==# current# then
 366     StringBuffer fo 0# start_pos# current# -- an error, really.
 367  else
 368     unsafeWriteBuffer (StringBuffer fo (current# -# start_pos#) start_pos# start_pos#)
 369                       (current# -# 1#)
 370                       '\NUL'#
 371
 372 \end{code}