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