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