StringBuffer.lhs 5.13 KB
Newer Older
1
%
2
% (c) The University of Glasgow, 1997-2003
3
4
5
6
7
8
9
10
%
\section{String buffers}

Buffers for scanning string input stored in external arrays.

\begin{code}
module StringBuffer
       (
11
12
        StringBuffer(..),
	-- non-abstract for vs/HaskellService
13

14
	 -- * Creation/destruction
15
16
        hGetStringBuffer,     -- :: FilePath     -> IO StringBuffer
	stringToStringBuffer, -- :: String       -> IO StringBuffer
17

18
19
20
21
22
         -- * Lookup
	currentChar,       -- :: StringBuffer -> Char
	prevChar,          -- :: StringBuffer -> Char -> Char
	lookAhead,         -- :: StringBuffer -> Int  -> Char
	atEnd,		   -- :: StringBuffer -> Bool
23

24
25
	-- * Moving
	stepOn, stepOnBy,
26

27
28
29
         -- * Conversion
        lexemeToString,     -- :: StringBuffer -> Int -> String
        lexemeToFastString, -- :: StringBuffer -> Int -> FastString
30
31
32

	 -- * Parsing integers
	 parseInteger,
33
       ) where
34

35
#include "HsVersions.h"
36

37
import FastString
38
import Panic
39

40
41
import GLAEXTS

42
import Foreign
sof's avatar
sof committed
43

44
45
46
47
48
#if __GLASGOW_HASKELL__ < 503
import PrelIOBase
import PrelHandle
#else
import GHC.IOBase
49
import GHC.IO		( slurpFile )
50
#endif
51

52
53
import IO			( openFile, hFileSize, IOMode(ReadMode),
				  hClose )
sof's avatar
sof committed
54
55
56
57
58
#if __GLASGOW_HASKELL__ >= 601
import System.IO		( openBinaryFile )
#else
import IOExts                   ( openFileEx, IOModeEx(..) )
#endif
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

#if __GLASGOW_HASKELL__ < 503
import IArray			( listArray )
import ArrayBase		( UArray(..) )
import MutableArray
import IOExts			( hGetBufBA )
#else
import Data.Array.IArray	( listArray )
import Data.Array.MArray 	( unsafeFreeze, newArray_ )
import Data.Array.Base		( UArray(..)  )
import Data.Array.IO		( IOArray, hGetArray )
#endif

import Char			( ord )

sof's avatar
sof committed
74
75
76
#if __GLASGOW_HASKELL__ < 601
openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
#endif
77
78
79
80
81
-- -----------------------------------------------------------------------------
-- The StringBuffer type

-- A StringBuffer is a ByteArray# with a pointer into it.  We also cache
-- the length of the ByteArray# for speed.
82
83
84

data StringBuffer
 = StringBuffer
85
     ByteArray#
86
87
88
     Int#         -- length
     Int#         -- current pos

89
instance Show StringBuffer where
90
	showsPrec _ s = showString "<stringbuffer>"
91

92
93
94
-- -----------------------------------------------------------------------------
-- Creation / Destruction

95
96
hGetStringBuffer :: FilePath -> IO StringBuffer
hGetStringBuffer fname = do
sof's avatar
sof committed
97
   h <- openBinaryFile fname ReadMode
98
99
100
101
102
   size <- hFileSize h
   let size_i@(I# sz#) = fromIntegral size
#if __GLASGOW_HASKELL__ < 503
   arr <- stToIO (newCharArray (0,size_i-1))
   r <- hGetBufBA h arr size_i
sof's avatar
sof committed
103
#else
104
   arr <- newArray_ (0,size_i-1)
105
   r <- if size_i == 0 then return 0 else hGetArray h arr size_i
sof's avatar
sof committed
106
#endif
107
   hClose h
108
109
110
111
112
113
114
   if (r /= size_i)
	then ioError (userError "short read of file")
	else do
#if __GLASGOW_HASKELL__ < 503
   frozen <- stToIO (unsafeFreezeByteArray arr)
   case frozen of
      ByteArray _ _ bytearr# -> return (StringBuffer bytearr# sz# 0#)
115
#else
116
117
118
   frozen <- unsafeFreeze arr
   case frozen of
      UArray _ _ bytearr# -> return (StringBuffer bytearr# sz# 0#)
119
#endif
120

121
122
123
124
125
126
127
#if __GLASGOW_HASKELL__ >= 502
stringToStringBuffer str = do
  let size@(I# sz#) = length str
      arr = listArray (0,size-1) (map (fromIntegral.ord) str)
		 :: UArray Int Word8
  case arr of
	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
137
138
currentChar (StringBuffer arr# l# current#) =
  ASSERT(current# <# l#)
  C# (indexCharArray# arr# current#)
139

140
141
142
prevChar :: StringBuffer -> Char -> Char
prevChar (StringBuffer _ _ 0#) deflt = deflt
prevChar s deflt = lookAhead s (-1)
143

144
145
146
147
148
149
lookAhead :: StringBuffer -> Int  -> Char
lookAhead (StringBuffer arr# l# c#) (I# i#) =
  ASSERT(off <# l#  && off >=# 0#)
  C# (indexCharArray# arr# off)
 where 
   off = c# +# i#
150

151
152
-- -----------------------------------------------------------------------------
-- Moving
153

154
155
stepOn :: StringBuffer -> StringBuffer
stepOn s = stepOnBy 1 s
156

157
158
stepOnBy :: Int -> StringBuffer -> StringBuffer
stepOnBy (I# i#) (StringBuffer fo# l# c#) = StringBuffer fo# l# (c# +# i#)
159

160
161
atEnd :: StringBuffer -> Bool
atEnd (StringBuffer _ l# c#) = l# ==# c#
162

163
164
-- -----------------------------------------------------------------------------
-- Conversion
165

166
167
168
lexemeToString :: StringBuffer -> Int -> String
lexemeToString _ 0 = ""
lexemeToString (StringBuffer arr# _ current#) (I# len#) = unpack current#
169
 where
170
171
172
173
174
175
176
177
178
179
180
181
    end = current# +# len#

    unpack nh
      | nh >=# end  = []
      | otherwise   = C# ch : unpack (nh +# 1#)
      where
	ch = indexCharArray# arr# nh

lexemeToFastString :: StringBuffer -> Int -> FastString
lexemeToFastString _ 0 = mkFastString ""
lexemeToFastString (StringBuffer fo _ current#) (I# len) =
    mkFastSubStringBA# fo current# len
182
183
184
185
186
187
188
189
190

-- -----------------------------------------------------------------------------
-- Parsing integer strings in various bases

parseInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
parseInteger buf len radix to_int 
  = go 0 0
  where go i x | i == len  = x
	       | otherwise = go (i+1) (x * radix + toInteger (to_int (lookAhead buf i)))
191
\end{code}