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