ghc/compiler/utils/StringBuffer.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
   3 %
   4 \section{String buffers}
   5
   6 Buffers for scanning string input stored in external arrays.
   7
   8 \begin{code}
   9
  10 module StringBuffer
  11        (
  12         StringBuffer,
  13
  14          -- creation/destruction
  15         hGetStringBuffer,     -- :: FilePath     -> IO StringBuffer
  16 #ifdef GHCI
  17         stringToStringBuffer, -- :: String       -> IO StringBuffer
  18         freeStringBuffer,     -- :: StringBuffer -> IO ()
  19 #endif
  20
  21          -- Lookup
  22         currentChar,      -- :: StringBuffer -> Char
  23         currentChar#,     -- :: StringBuffer -> Char#
  24         indexSBuffer,     -- :: StringBuffer -> Int -> Char
  25         indexSBuffer#,    -- :: StringBuffer -> Int# -> Char#
  26          -- relative lookup, i.e, currentChar = lookAhead 0
  27         lookAhead,        -- :: StringBuffer -> Int  -> Char
  28         lookAhead#,       -- :: StringBuffer -> Int# -> Char#
  29
  30         -- offsets
  31         currentIndex#,    -- :: StringBuffer -> Int#
  32         lexemeIndex,      -- :: StringBuffer -> Int#
  33
  34          -- moving the end point of the current lexeme.
  35         setCurrentPos#,   -- :: StringBuffer -> Int# -> StringBuffer
  36         incLexeme,        -- :: StringBuffer -> StringBuffer
  37         decLexeme,        -- :: StringBuffer -> StringBuffer
  38
  39          -- move the start and end lexeme pointer on by x units.
  40         stepOn,           -- :: StringBuffer -> StringBuffer
  41         stepOnBy#,        -- :: StringBuffer -> Int# -> StringBuffer
  42         stepOnTo#,        -- :: StringBuffer -> Int# -> StringBuffer
  43         stepOnUntil,      -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
  44         stepOnUntilChar#, -- :: StringBuffer -> Char# -> StringBuffer
  45         stepOverLexeme,   -- :: StringBuffer   -> StringBuffer
  46         scanNumLit,       -- :: Int -> StringBuffer -> (Int, StringBuffer)
  47         squeezeLexeme,    -- :: StringBuffer -> Int# -> StringBuffer
  48         mergeLexemes,     -- :: StringBuffer -> StringBuffer -> StringBuffer
  49         expandWhile,      -- :: (Char  -> Bool) -> StringBuffer -> StringBuffer
  50         expandWhile#,     -- :: (Char# -> Bool) -> StringBuffer -> StringBuffer
  51         expandUntilMatch, -- :: StrinBuffer -> String -> StringBuffer
  52          -- at or beyond end of buffer?
  53         bufferExhausted,  -- :: StringBuffer -> Bool
  54         emptyLexeme,      -- :: StringBuffer -> Bool
  55
  56          -- matching
  57         prefixMatch,       -- :: StringBuffer -> String -> Bool
  58         untilEndOfString#, -- :: StringBuffer -> Int#
  59
  60          -- conversion
  61         lexemeToString,     -- :: StringBuffer -> String
  62         lexemeToByteArray,  -- :: StringBuffer -> _ByteArray Int
  63         lexemeToFastString, -- :: StringBuffer -> FastString
  64         lexemeToBuffer,     -- :: StringBuffer -> StringBuffer
  65
  66         FastString,
  67         ByteArray
  68        ) where
  69
  70 #include "HsVersions.h"
  71
  72 import GlaExts
  73 #if __GLASGOW_HASKELL__ < 411
  74 import PrelAddr         ( Addr(..) )
  75 #else
  76 import Addr             ( Addr(..) )
  77 #endif
  78 import Foreign
  79 import Char             ( chr )
  80
  81 -- urk!
  82 #include "../lib/std/cbits/stgerror.h"
  83
  84 #if __GLASGOW_HASKELL__ >= 303
  85 import IO               ( openFile
  86 #if __GLASGOW_HASKELL__ < 407
  87                         , slurpFile   -- comes from PrelHandle or IOExts now
  88 #endif
  89                         )
  90 import PrelIOBase
  91 import PrelHandle
  92 import Addr
  93 #else
  94 import IO               ( openFile, hFileSize, hClose, IOMode(..) )
  95 import Addr
  96 #endif
  97 #if __GLASGOW_HASKELL__ >= 411
  98 import Ptr              ( Ptr(..) )
  99 #endif
 100
 101 #if __GLASGOW_HASKELL__ < 301
 102 import IOBase           ( Handle, IOError(..), IOErrorType(..),
 103                           constructErrorAndFail )
 104 import IOHandle         ( readHandle, writeHandle, filePtr )
 105 import PackBase         ( unpackCStringBA )
 106 #else
 107 # if __GLASGOW_HASKELL__ <= 302
 108 import PrelIOBase       ( Handle, IOError(..), IOErrorType(..),
 109                           constructErrorAndFail )
 110 import PrelHandle       ( readHandle, writeHandle, filePtr )
 111 # endif
 112 import PrelPack         ( unpackCStringBA )
 113 #endif
 114
 115 #if __GLASGOW_HASKELL__ < 402
 116 import Util             ( bracket )
 117 #else
 118 import Exception        ( bracket )
 119 #endif
 120
 121 import PrimPacked
 122 import FastString
 123 import Char             (isDigit)
 124 \end{code}
 125
 126 \begin{code}
 127 data StringBuffer
 128  = StringBuffer
 129      Addr#
 130      Int#         -- length
 131      Int#         -- lexeme start
 132      Int#         -- current pos
 133 \end{code}
 134
 135 \begin{code}
 136 instance Show StringBuffer where
 137         showsPrec _ s = showString ""
 138 \end{code}
 139
 140 \begin{code}
 141 hGetStringBuffer :: Bool -> FilePath -> IO StringBuffer
 142 hGetStringBuffer expand_tabs fname = do
 143    (a, read) <- if expand_tabs
 144                                 then slurpFileExpandTabs fname
 145 #if __GLASGOW_HASKELL__ < 411
 146                                 else slurpFile fname
 147 #else
 148                                 else do
 149                                     (Ptr a#, read) <- slurpFile fname
 150                                     return (A# a#, read)
 151 #endif
 152
 153    let (A# a#) = a;  (I# read#) = read
 154
 155          -- add sentinel '\NUL'
 156    _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' (A# a#) (I# (read# -# 1#))
 157    return (StringBuffer a# read# 0# 0#)
 158
 159 #if __GLASGOW_HASKELL__ < 303
 160 slurpFile fname =
 161     openFile fname ReadMode >>= \ hndl ->
 162     hFileSize hndl          >>= \ len ->
 163     let len_i = fromInteger len in
 164       -- Allocate an array for system call to store its bytes into.
 165       -- ToDo: make it robust
 166 --    trace (show ((len_i::Int)+1)) $
 167     _casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int)  >>= \ arr@(A# a#) ->
 168     if addr2Int# a# ==# 0# then
 169        fail (userError ("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
 170     else
 171     readHandle hndl        >>= \ hndl_ ->
 172     writeHandle hndl hndl_ >>
 173      let ptr = filePtr hndl_ in
 174 #if __GLASGOW_HASKELL__ <= 302
 175      _ccall_ fread arr (1::Int) len_i (ptr::ForeignObj)               >>= \  (I# read#) ->
 176 #else
 177      _ccall_ fread arr (1::Int) len_i (ptr::Addr)                     >>= \  (I# read#) ->
 178 #endif
 179      hClose hndl                     >>
 180      if read# ==# 0# then -- EOF or some other error
 181         fail (userError ("hGetStringBuffer: failed to slurp in interface file "++fname))
 182      else
 183         return (arr, I# read#)
 184 #endif
 185
 186 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
 187 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
 188  unsafePerformIO (
 189    _casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) >>= \ () ->
 190    return s
 191  )
 192 \end{code}
 193
 194 -----------------------------------------------------------------------------
 195 -- Turn a String into a StringBuffer
 196
 197 \begin{code}
 198 #ifdef GHCI
 199 stringToStringBuffer :: String -> IO StringBuffer
 200 stringToStringBuffer str =
 201   do let sz@(I# sz#) = length str + 1
 202      (Ptr a@(A# a#)) <- mallocBytes sz
 203      fill_in str a
 204      writeCharOffAddr a (sz-1) '\0'             -- sentinel
 205      return (StringBuffer a# sz# 0# 0#)
 206  where
 207   fill_in [] _ = return ()
 208   fill_in (c:cs) a = do
 209     writeCharOffAddr a 0 c
 210     fill_in cs (a `plusAddr` 1)
 211
 212 freeStringBuffer :: StringBuffer -> IO ()
 213 freeStringBuffer (StringBuffer a# _ _ _) = Foreign.free (Ptr (A# a#))
 214 #endif
 215 \end{code}
 216
 217 -----------------------------------------------------------------------------
 218 This very disturbing bit of code is used for expanding the tabs in a
 219 file before we start parsing it.  Expanding the tabs early makes the
 220 lexer a lot simpler: we only have to record the beginning of the line
 221 in order to be able to calculate the column offset of the current
 222 token.
 223
 224 We guess the size of the buffer required as 20% extra for
 225 expanded tabs, and enlarge it if necessary.
 226
 227 \begin{code}
 228 #if __GLASGOW_HASKELL__ < 303
 229 mayBlock fo thing = thing
 230
 231 writeCharOffAddr :: Addr -> Int -> Char -> IO ()
 232 writeCharOffAddr addr off c
 233   = _casm_ ``*((char *)%0+(int)%1)=(char)%2;'' addr off c
 234 #endif
 235
 236 getErrType :: IO Int
 237 #if __GLASGOW_HASKELL__ < 303
 238 getErrType = _casm_ ``%r = ghc_errtype;''
 239 #else
 240 getErrType =  _ccall_ getErrType__
 241 #endif
 242
 243 slurpFileExpandTabs :: FilePath -> IO (Addr,Int)
 244 slurpFileExpandTabs fname = do
 245   bracket (openFile fname ReadMode) (hClose)
 246    (\ handle ->
 247      do sz <- hFileSize handle
 248         if sz > toInteger (maxBound::Int)
 249           then IOERROR (userError "slurpFile: file too big")
 250           else do
 251             let sz_i = fromInteger sz
 252                 sz_i' = (sz_i * 12) `div` 10            -- add 20% for tabs
 253             chunk <- allocMem sz_i'
 254             trySlurp handle sz_i' chunk
 255    )
 256
 257 trySlurp :: Handle -> Int -> Addr -> IO (Addr, Int)
 258 trySlurp handle sz_i chunk =
 259 #if __GLASGOW_HASKELL__ == 303
 260   wantReadableHandle "hGetChar" handle >>= \ handle_ ->
 261   let fo = haFO__ handle_ in
 262 #elif __GLASGOW_HASKELL__ > 303
 263   wantReadableHandle "hGetChar" handle $ \ handle_ ->
 264   let fo = haFO__ handle_ in
 265 #else
 266   readHandle handle        >>= \ handle_ ->
 267   let fo = filePtr handle_ in
 268 #endif
 269   let
 270         (I# chunk_sz) = sz_i
 271
 272         tAB_SIZE = 8#
 273
 274         slurpFile :: Int# -> Int# -> Addr -> Int# -> Int# -> IO (Addr, Int)
 275         slurpFile c off chunk chunk_sz max_off = slurp c off
 276          where
 277
 278           slurp :: Int# -> Int# -> IO (Addr, Int)
 279           slurp c off | off >=# max_off = do
 280                 let new_sz = chunk_sz *# 2#
 281                 chunk' <- reAllocMem chunk (I# new_sz)
 282                 slurpFile c off chunk' new_sz (new_sz -# (tAB_SIZE +# 1#))
 283           slurp c off = do
 284                 intc <- mayBlock fo (_ccall_ fileGetc fo)
 285                 if intc == ((-1)::Int)
 286                   then do errtype <- getErrType
 287                           if errtype == (ERR_EOF :: Int)
 288                             then return (chunk, I# off)
 289                             else constructErrorAndFail "slurpFile"
 290                   else case chr intc of
 291                          '\t' -> tabIt c off
 292                          ch   -> do  writeCharOffAddr chunk (I# off) ch
 293                                      let c' | ch == '\n' = 0#
 294                                             | otherwise  = c +# 1#
 295                                      slurp c' (off +# 1#)
 296
 297           tabIt :: Int# -> Int# -> IO (Addr, Int)
 298           -- can't run out of buffer in here, because we reserved an
 299           -- extra tAB_SIZE bytes at the end earlier.
 300           tabIt c off = do
 301                 writeCharOffAddr chunk (I# off) ' '
 302                 let c' = c +# 1#
 303                     off' = off +# 1#
 304                 if c' `remInt#` tAB_SIZE ==# 0#
 305                         then slurp c' off'
 306                         else tabIt c' off'
 307   in do
 308
 309         -- allow space for a full tab at the end of the buffer
 310         -- (that's what the max_off thing is for),
 311         -- and add 1 to allow room for the final sentinel \NUL at
 312         -- the end of the file.
 313   (chunk', rc) <- slurpFile 0# 0# chunk chunk_sz (chunk_sz -# (tAB_SIZE +# 1#))
 314 #if __GLASGOW_HASKELL__ < 404
 315   writeHandle handle handle_
 316 #endif
 317   if rc < (0::Int)
 318         then constructErrorAndFail "slurpFile"
 319         else return (chunk', rc+1 {-room for sentinel-})
 320
 321
 322 reAllocMem :: Addr -> Int -> IO Addr
 323 reAllocMem ptr sz = do
 324    chunk <- _ccall_ realloc ptr sz
 325    if chunk == nullAddr
 326 #if __GLASGOW_HASKELL__ >= 400
 327       then fail "reAllocMem"
 328 #else
 329       then fail (userError "reAllocMem")
 330 #endif
 331       else return chunk
 332
 333 allocMem :: Int -> IO Addr
 334 allocMem sz = do
 335    chunk <- _ccall_ malloc sz
 336 #if __GLASGOW_HASKELL__ < 303
 337    if chunk == nullAddr
 338       then fail (userError "allocMem")
 339       else return chunk
 340 #else
 341    if chunk == nullAddr
 342       then constructErrorAndFail "allocMem"
 343       else return chunk
 344 #endif
 345 \end{code}
 346
 347 Lookup
 348
 349 \begin{code}
 350 currentChar  :: StringBuffer -> Char
 351 currentChar sb = case currentChar# sb of c -> C# c
 352
 353 lookAhead :: StringBuffer -> Int  -> Char
 354 lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
 355
 356 indexSBuffer :: StringBuffer -> Int -> Char
 357 indexSBuffer sb (I# i#) = case indexSBuffer# sb i# of c -> C# c
 358
 359 currentChar# :: StringBuffer -> Char#
 360 indexSBuffer# :: StringBuffer -> Int# -> Char#
 361 lookAhead# :: StringBuffer -> Int# -> Char#
 362 currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
 363 indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
 364
 365  -- relative lookup, i.e, currentChar = lookAhead 0
 366 lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
 367
 368 currentIndex# :: StringBuffer -> Int#
 369 currentIndex# (StringBuffer fo# _ _ c#) = c#
 370
 371 lexemeIndex :: StringBuffer -> Int#
 372 lexemeIndex (StringBuffer fo# _ c# _) = c#
 373 \end{code}
 374
 375  moving the start point of the current lexeme.
 376
 377 \begin{code}
 378  -- moving the end point of the current lexeme.
 379 setCurrentPos# :: StringBuffer -> Int# -> StringBuffer
 380 setCurrentPos# (StringBuffer fo l# s# c#) i# =
 381  StringBuffer fo l# s# (c# +# i#)
 382
 383 -- augmenting the current lexeme by one.
 384 incLexeme :: StringBuffer -> StringBuffer
 385 incLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# +# 1#)
 386
 387 decLexeme :: StringBuffer -> StringBuffer
 388 decLexeme (StringBuffer fo l# s# c#) = StringBuffer fo l# s# (c# -# 1#)
 389
 390 \end{code}
 391
 392 -- move the start and end point of the buffer on by
 393 -- x units.
 394
 395 \begin{code}
 396 stepOn :: StringBuffer -> StringBuffer
 397 stepOn (StringBuffer fo l# s# c#) = StringBuffer fo l# (s# +# 1#) (s# +# 1#) -- assume they're the same.
 398
 399 stepOnBy# :: StringBuffer -> Int# -> StringBuffer
 400 stepOnBy# (StringBuffer fo# l# s# c#) i# =
 401  case s# +# i# of
 402   new_s# -> StringBuffer fo# l# new_s# new_s#
 403
 404 -- jump to pos.
 405 stepOnTo# :: StringBuffer -> Int# -> StringBuffer
 406 stepOnTo# (StringBuffer fo l _ _) s# = StringBuffer fo l s# s#
 407
 408 squeezeLexeme :: StringBuffer -> Int# -> StringBuffer
 409 squeezeLexeme (StringBuffer fo l s# c#) i# = StringBuffer fo l (s# +# i#) c#
 410
 411 mergeLexemes :: StringBuffer -> StringBuffer -> StringBuffer
 412 mergeLexemes (StringBuffer fo l s# _) (StringBuffer _ _ _ c#)
 413    = StringBuffer fo l s# c#
 414
 415 stepOnUntil :: (Char -> Bool) -> StringBuffer -> StringBuffer
 416
 417 stepOnUntil pred (StringBuffer fo l# s# c#) =
 418  loop c#
 419   where
 420    loop c# =
 421     case indexCharOffAddr# fo c# of
 422      ch# | pred (C# ch#) -> StringBuffer fo l# c# c#
 423          | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
 424          | otherwise     -> loop (c# +# 1#)
 425
 426 stepOverLexeme :: StringBuffer -> StringBuffer
 427 stepOverLexeme (StringBuffer fo l s# c#) = StringBuffer fo l c# c#
 428
 429 expandWhile :: (Char -> Bool) -> StringBuffer -> StringBuffer
 430 expandWhile pred (StringBuffer fo l# s# c#) =
 431  loop c#
 432   where
 433    loop c# =
 434     case indexCharOffAddr# fo c# of
 435      ch# | pred (C# ch#) -> loop (c# +# 1#)
 436          | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
 437          | otherwise     -> StringBuffer fo l# s# c#
 438
 439 expandWhile# :: (Char# -> Bool) -> StringBuffer -> StringBuffer
 440 expandWhile# pred (StringBuffer fo l# s# c#) =
 441  loop c#
 442   where
 443    loop c# =
 444     case indexCharOffAddr# fo c# of
 445      ch# | pred ch# -> loop (c# +# 1#)
 446          | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# s# c# -- EOB, return immediately.
 447          | otherwise     -> StringBuffer fo l# s# c#
 448
 449 scanNumLit :: Integer -> StringBuffer -> (Integer,StringBuffer)
 450 scanNumLit acc (StringBuffer fo l# s# c#) =
 451  loop acc c#
 452   where
 453    loop acc c# =
 454     case indexCharOffAddr# fo c# of
 455      ch# | isDigit (C# ch#) -> loop (acc*10 + (toInteger (I# (ord# ch# -# ord# '0'#)))) (c# +# 1#)
 456          | ch# `eqChar#` '\NUL'# && c# >=# l# -> (acc, StringBuffer fo l# s# c#) -- EOB, return immediately.
 457          | otherwise        -> (acc,StringBuffer fo l# s# c#)
 458
 459
 460 expandUntilMatch :: StringBuffer -> String -> Maybe StringBuffer
 461 expandUntilMatch (StringBuffer fo l# s# c#) str =
 462   loop c# str
 463   where
 464    loop c# [] = Just (StringBuffer fo l# s# c#)
 465    loop c# ((C# x#):xs) =
 466     case indexCharOffAddr# fo c# of
 467       ch# | ch# `eqChar#` '\NUL'# && c# >=# l# -> Nothing
 468           | ch# `eqChar#` x# -> loop (c# +# 1#) xs
 469           | otherwise        -> loop (c# +# 1#) str
 470
 471 \end{code}
 472
 473 \begin{code}
 474    -- at or beyond end of buffer?
 475 bufferExhausted :: StringBuffer -> Bool
 476 bufferExhausted (StringBuffer fo l# _ c#) = c# >=# l#
 477
 478 emptyLexeme :: StringBuffer -> Bool
 479 emptyLexeme (StringBuffer fo l# s# c#) = s# ==# c#
 480
 481  -- matching
 482 prefixMatch :: StringBuffer -> String -> Maybe StringBuffer
 483 prefixMatch (StringBuffer fo l# s# c#) str =
 484   loop c# str
 485   where
 486    loop c# [] = Just (StringBuffer fo l# s# c#)
 487    loop c# ((C# x#):xs)
 488      | indexCharOffAddr# fo c# `eqChar#` x#
 489      = loop (c# +# 1#) xs
 490      | otherwise
 491      = Nothing
 492
 493 untilEndOfString# :: StringBuffer -> StringBuffer
 494 untilEndOfString# (StringBuffer fo l# s# c#) =
 495  loop c#
 496  where
 497   getch# i# = indexCharOffAddr# fo i#
 498
 499   loop c# =
 500    case getch# c# of
 501     '\"'# ->
 502       case getch# (c# -# 1#) of
 503         '\\'# ->
 504                   -- looks like an escaped something or other to me,
 505                   -- better count the number of "\\"s that are immediately
 506                   -- preceeding to decide if the " is escaped.
 507               let
 508                odd_slashes flg i# =
 509                 case getch# i# of
 510                  '\\'# -> odd_slashes (not flg) (i# -# 1#)
 511                  _     -> flg
 512               in
 513               if odd_slashes True (c# -# 2#) then
 514                   -- odd number, " is ecaped.
 515                   loop (c# +# 1#)
 516               else  -- a real end of string delimiter after all.
 517                   StringBuffer fo l# s# c#
 518         _ -> StringBuffer fo l# s# c#
 519     '\NUL'# ->
 520         if c# >=# l# then -- hit sentinel, this doesn't look too good..
 521            StringBuffer fo l# l# l#
 522         else
 523            loop (c# +# 1#)
 524     _ -> loop (c# +# 1#)
 525
 526
 527 stepOnUntilChar# :: StringBuffer -> Char# -> StringBuffer
 528 stepOnUntilChar# (StringBuffer fo l# s# c#) x# =
 529  loop c#
 530  where
 531   loop c#
 532    | c# >=# l# || indexCharOffAddr# fo c# `eqChar#` x#
 533    = StringBuffer fo l# c# c#
 534    | otherwise
 535    = loop (c# +# 1#)
 536
 537          -- conversion
 538 lexemeToString :: StringBuffer -> String
 539 lexemeToString (StringBuffer fo _ start_pos# current#) =
 540  if start_pos# ==# current# then
 541     ""
 542  else
 543     unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
 544
 545 lexemeToByteArray :: StringBuffer -> ByteArray Int
 546 lexemeToByteArray (StringBuffer fo _ start_pos# current#) =
 547  if start_pos# ==# current# then
 548     error "lexemeToByteArray"
 549  else
 550     copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
 551
 552 lexemeToFastString :: StringBuffer -> FastString
 553 lexemeToFastString (StringBuffer fo l# start_pos# current#) =
 554  if start_pos# ==# current# then
 555     mkFastCharString2 (A# fo) (I# 0#)
 556  else
 557     mkFastSubString (A# fo) (I# start_pos#) (I# (current# -# start_pos#))
 558
 559 {-
 560  Create a StringBuffer from the current lexeme, and add a sentinel
 561  at the end. Know What You're Doing before taking this function
 562  into use..
 563 -}
 564 lexemeToBuffer :: StringBuffer -> StringBuffer
 565 lexemeToBuffer (StringBuffer fo l# start_pos# current#) =
 566  if start_pos# ==# current# then
 567     StringBuffer fo 0# start_pos# current# -- an error, really.
 568  else
 569     unsafeWriteBuffer (StringBuffer fo (current# -# start_pos#) start_pos# start_pos#)
 570                       (current# -# 1#)
 571                       '\NUL'#
 572
 573 \end{code}