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