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