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