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