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