ghc/compiler/utils/StringBuffer.lhs

   1 %
   2 % (c) The University of Glasgow, 1997-2003
   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         -- non-abstract for vs\/HaskellService
  13
  14          -- * Creation\/destruction
  15         hGetStringBuffer,     -- :: FilePath     -> IO StringBuffer
  16         stringToStringBuffer, -- :: String       -> IO StringBuffer
  17
  18          -- * Lookup
  19         currentChar,       -- :: StringBuffer -> Char
  20         prevChar,          -- :: StringBuffer -> Char -> Char
  21         lookAhead,         -- :: StringBuffer -> Int  -> Char
  22         atEnd,             -- :: StringBuffer -> Bool
  23
  24         -- * Moving
  25         stepOn, stepOnBy,
  26
  27         -- * Conversion
  28         lexemeToString,     -- :: StringBuffer -> Int -> String
  29         lexemeToFastString, -- :: StringBuffer -> Int -> FastString
  30
  31          -- * Parsing integers
  32         parseInteger,
  33        ) where
  34
  35 #include "HsVersions.h"
  36
  37 import FastString
  38 import Panic
  39
  40 import GLAEXTS
  41
  42 import Foreign
  43
  44 #if __GLASGOW_HASKELL__ < 503
  45 import PrelIOBase
  46 import PrelHandle
  47 #else
  48 import GHC.IOBase
  49 import GHC.IO           ( slurpFile )
  50 #endif
  51
  52 import IO                       ( openFile, hFileSize, IOMode(ReadMode),
  53                                   hClose )
  54 #if __GLASGOW_HASKELL__ >= 601
  55 import System.IO                ( openBinaryFile )
  56 #else
  57 import IOExts                   ( openFileEx, IOModeEx(..) )
  58 #endif
  59
  60 #if __GLASGOW_HASKELL__ < 503
  61 import IArray                   ( listArray )
  62 import ArrayBase                ( UArray(..) )
  63 import MutableArray
  64 import IOExts                   ( hGetBufBA )
  65 #else
  66 import Data.Array.IArray        ( listArray )
  67 import Data.Array.MArray        ( unsafeFreeze, newArray_ )
  68 import Data.Array.Base          ( UArray(..)  )
  69 import Data.Array.IO            ( IOArray, hGetArray )
  70 #endif
  71
  72 import Char                     ( ord )
  73
  74 #if __GLASGOW_HASKELL__ < 601
  75 openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
  76 #endif
  77 -- -----------------------------------------------------------------------------
  78 -- The StringBuffer type
  79
  80 -- A StringBuffer is a ByteArray# with a pointer into it.  We also cache
  81 -- the length of the ByteArray# for speed.
  82
  83 data StringBuffer
  84  = StringBuffer
  85      ByteArray#
  86      Int#         -- length
  87      Int#         -- current pos
  88
  89 instance Show StringBuffer where
  90         showsPrec _ s = showString "<stringbuffer>"
  91
  92 -- -----------------------------------------------------------------------------
  93 -- Creation / Destruction
  94
  95 hGetStringBuffer :: FilePath -> IO StringBuffer
  96 hGetStringBuffer fname = do
  97    h <- openBinaryFile fname ReadMode
  98    size <- hFileSize h
  99    let size_i@(I# sz#) = fromIntegral size
 100 #if __GLASGOW_HASKELL__ < 503
 101    arr <- stToIO (newCharArray (0,size_i-1))
 102    r <- hGetBufBA h arr size_i
 103 #else
 104    arr <- newArray_ (0,size_i-1)
 105    r <- if size_i == 0 then return 0 else hGetArray h arr size_i
 106 #endif
 107    hClose h
 108    if (r /= size_i)
 109         then ioError (userError "short read of file")
 110         else do
 111 #if __GLASGOW_HASKELL__ < 503
 112    frozen <- stToIO (unsafeFreezeByteArray arr)
 113    case frozen of
 114       ByteArray _ _ bytearr# -> return (StringBuffer bytearr# sz# 0#)
 115 #else
 116    frozen <- unsafeFreeze arr
 117    case frozen of
 118       UArray _ _ bytearr# -> return (StringBuffer bytearr# sz# 0#)
 119 #endif
 120
 121 #if __GLASGOW_HASKELL__ >= 502
 122 stringToStringBuffer str = do
 123   let size@(I# sz#) = length str
 124       arr = listArray (0,size-1) (map (fromIntegral.ord) str)
 125                  :: UArray Int Word8
 126   case arr of
 127         UArray _ _ bytearr# -> return (StringBuffer bytearr# sz# 0#)
 128 #else
 129 stringToStringBuffer = panic "stringToStringBuffer: not implemented"
 130 #endif
 131
 132 -- -----------------------------------------------------------------------------
 133 -- Lookup
 134
 135 currentChar  :: StringBuffer -> Char
 136 currentChar (StringBuffer arr# l# current#) =
 137   ASSERT(current# <# l#)
 138   C# (indexCharArray# arr# current#)
 139
 140 prevChar :: StringBuffer -> Char -> Char
 141 prevChar (StringBuffer _ _ 0#) deflt = deflt
 142 prevChar s deflt = lookAhead s (-1)
 143
 144 lookAhead :: StringBuffer -> Int  -> Char
 145 lookAhead (StringBuffer arr# l# c#) (I# i#) =
 146   ASSERT(off <# l#  && off >=# 0#)
 147   C# (indexCharArray# arr# off)
 148  where
 149    off = c# +# i#
 150
 151 -- -----------------------------------------------------------------------------
 152 -- Moving
 153
 154 stepOn :: StringBuffer -> StringBuffer
 155 stepOn s = stepOnBy 1 s
 156
 157 stepOnBy :: Int -> StringBuffer -> StringBuffer
 158 stepOnBy (I# i#) (StringBuffer fo# l# c#) = StringBuffer fo# l# (c# +# i#)
 159
 160 atEnd :: StringBuffer -> Bool
 161 atEnd (StringBuffer _ l# c#) = l# ==# c#
 162
 163 -- -----------------------------------------------------------------------------
 164 -- Conversion
 165
 166 lexemeToString :: StringBuffer -> Int -> String
 167 lexemeToString _ 0 = ""
 168 lexemeToString (StringBuffer arr# _ current#) (I# len#) = unpack current#
 169  where
 170     end = current# +# len#
 171
 172     unpack nh
 173       | nh >=# end  = []
 174       | otherwise   = C# ch : unpack (nh +# 1#)
 175       where
 176         ch = indexCharArray# arr# nh
 177
 178 lexemeToFastString :: StringBuffer -> Int -> FastString
 179 lexemeToFastString _ 0 = mkFastString ""
 180 lexemeToFastString (StringBuffer fo _ current#) (I# len) =
 181     mkFastSubStringBA# fo current# len
 182
 183 -- -----------------------------------------------------------------------------
 184 -- Parsing integer strings in various bases
 185
 186 parseInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
 187 parseInteger buf len radix to_int
 188   = go 0 0
 189   where go i x | i == len  = x
 190                | otherwise = go (i+1) (x * radix + toInteger (to_int (lookAhead buf i)))
 191 \end{code}