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