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