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