@@ -8,15 +8,9 @@ module Parse.Primitives.Utf8
88
99
1010import Prelude hiding (length)
11−import Data.Bits
1211import qualified Data.ByteString.Internal as B
13−import qualified Data.ByteString.UTF8 as Utf8
14−import qualified Data.Char as Char
15−import Data.Monoid ((<>))
16−import qualified Data.Text as Text
17−import qualified Data.Text.Encoding as Text
18−import qualified Data.Text.Lazy as LText
19−import qualified Data.Text.Lazy.Builder as Text
12+import qualified Data.ByteString.UTF8 as BS_UTF8
13+import qualified Data.Utf8 as Utf8
2014import Foreign.ForeignPtr (ForeignPtr)
2115import GHC.Word (Word8(..))
2216
@@ -30,14 +24,14 @@ import qualified Reporting.Error.Syntax as E
3024-- CHARACTER
3125
3226
33−character :: Parser Text.Text
27+character :: Parser Utf8.Utf8
3428character =
3529 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
3630 if offset >= terminal || I.unsafeIndex fp offset /= 0x27 {- ' -} then
3731 eerr noError
3832
3933 else
40− case chompChar fp (offset + 1) terminal (col + 1) 0 "" of
34+ case chompChar fp (offset + 1) terminal (col + 1) 0 placeholder of
4135 Bad newCol problem ->
4236 cerr (E.ParseError row newCol problem)
4337
@@ -46,15 +40,15 @@ character =
4640 cerr (E.ParseError row col (E.BadChar newCol))
4741 else
4842 let !newState = State fp newOffset terminal indent row newCol ctx in
49− cok mostRecent newState noError
43+ cok (Utf8.fromChunks fp [mostRecent]) newState noError
5044
5145
5246data CharResult
5347 = Bad Int E.Problem
54− | Good Int Int Int Text.Text
48+ | Good Int Int Int Utf8.Chunk
5549
5650
57−chompChar :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Text.Text -> CharResult
51+chompChar :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Utf8.Chunk -> CharResult
5852chompChar fp offset terminal col numChars mostRecent =
5953 if offset >= terminal then
6054 Bad col E.EndOfFile_Char
@@ -70,15 +64,15 @@ chompChar fp offset terminal col numChars mostRecent =
7064 Bad col E.NewLineInChar
7165
7266 else if word == 0x22 {- " -} then
73− chompChar fp (offset + 1) terminal (col + 1) (numChars + 1) "\\\""
67+ chompChar fp (offset + 1) terminal (col + 1) (numChars + 1) doubleQuote
7468
7569 else if word == 0x5C {- \ -} then
7670 case eatEscape fp (offset + 1) terminal of
7771 EscapeNormal ->
78− chompChar fp (offset + 2) terminal (col + 2) (numChars + 1) (toText fp offset 2)
72+ chompChar fp (offset + 2) terminal (col + 2) (numChars + 1) (Utf8.Slice offset 2)
7973
80− EscapeUnicode delta bits ->
81− chompChar fp (offset + delta) terminal (col + delta) (numChars + 1) (Text.pack bits)
74+ EscapeUnicode delta code ->
75+ chompChar fp (offset + delta) terminal (col + delta) (numChars + 1) (Utf8.CodePoint code)
8276
8377 EscapeProblem newOffset problem ->
8478 Bad col (E.BadEscape (newOffset - offset) problem)
@@ -88,19 +82,14 @@ chompChar fp offset terminal col numChars mostRecent =
8882
8983 else
9084 let !width = I.getCharWidth fp offset terminal word in
91− chompChar fp (offset + width) terminal (col + 1) (numChars + 1) (toText fp offset width)
92−
93−
94−toText :: ForeignPtr Word8 -> Int -> Int -> Text.Text
95−toText fp offset length =
96− Text.decodeUtf8 (B.PS fp offset length)
85+ chompChar fp (offset + width) terminal (col + 1) (numChars + 1) (Utf8.Slice offset width)
9786
9887
9988
10089-- STRINGS
10190
10291
103−string :: Parser Text.Text
92+string :: Parser Utf8.Utf8
10493string =
10594 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
10695 if isDoubleQuote fp offset terminal then
@@ -117,12 +106,11 @@ string =
117106 Err err ->
118107 cerr err
119108
120− Ok newOffset newRow newCol builder ->
109+ Ok newOffset newRow newCol utf8 ->
121110 let
122111 !newState = State fp newOffset terminal indent newRow newCol ctx
123− !content = LText.toStrict (Text.toLazyText builder)
124112 in
125− cok content newState noError
113+ cok utf8 newState noError
126114
127115 else
128116 eerr noError
@@ -136,31 +124,32 @@ isDoubleQuote fp offset terminal =
136124
137125data StringResult
138126 = Err E.ParseError
139− | Ok !Int !Int !Int Text.Builder
127+ | Ok !Int !Int !Int !Utf8.Utf8
140128
141129
142−finalize :: ForeignPtr Word8 -> Int -> Int -> Text.Builder -> Text.Builder
143−finalize fp start end builder =
144− if start == end then
145− builder
146− else
147− builder <> Text.fromText (Text.decodeUtf8 (B.PS fp start (end - start)))
130+finalize :: ForeignPtr Word8 -> Int -> Int -> [Utf8.Chunk] -> Utf8.Utf8
131+finalize fp start end revChunks =
132+ Utf8.fromChunks fp $ reverse $
133+ if start == end then
134+ revChunks
135+ else
136+ Utf8.Slice start (end - start) : revChunks
148137
149138
150−addBits :: Text.Builder -> ForeignPtr Word8 -> Int -> Int -> Text.Builder -> Text.Builder
151−addBits bits fp start end builder =
139+addEscape :: Utf8.Chunk -> Int -> Int -> [Utf8.Chunk] -> [Utf8.Chunk]
140+addEscape chunk start end revChunks =
152141 if start == end then
153− builder <> bits
142+ chunk : revChunks
154143 else
155− builder <> Text.fromText (Text.decodeUtf8 (B.PS fp start (end - start))) <> bits
144+ chunk : Utf8.Slice start (end - start) : revChunks
156145
157146
158147
159148-- SINGLE STRINGS
160149
161150
162−singleString :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Int -> Text.Builder -> StringResult
163−singleString fp offset terminal row col initialOffset builder =
151+singleString :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Int -> [Utf8.Chunk] -> StringResult
152+singleString fp offset terminal row col initialOffset revChunks =
164153 if offset >= terminal then
165154 Err (E.ParseError row col E.EndOfFile_String)
166155
@@ -170,7 +159,7 @@ singleString fp offset terminal row col initialOffset builder =
170159 in
171160 if word == 0x22 {- " -} then
172161 Ok (offset + 1) row (col + 1) $
173− finalize fp initialOffset offset builder
162+ finalize fp initialOffset offset revChunks
174163
175164 else if word == 0x0A {- \n -} then
176165 Err (E.ParseError row col E.NewLineInString)
@@ -178,17 +167,17 @@ singleString fp offset terminal row col initialOffset builder =
178167 else if word == 0x27 {- ' -} then
179168 let !newOffset = offset + 1 in
180169 singleString fp newOffset terminal row (col + 1) newOffset $
181− addBits singleQuoteBits fp initialOffset offset builder
170+ addEscape singleQuote initialOffset offset revChunks
182171
183172 else if word == 0x5C {- \ -} then
184173 case eatEscape fp (offset + 1) terminal of
185174 EscapeNormal ->
186− singleString fp (offset + 2) terminal row (col + 2) initialOffset builder
175+ singleString fp (offset + 2) terminal row (col + 2) initialOffset revChunks
187176
188− EscapeUnicode delta bits ->
177+ EscapeUnicode delta code ->
189178 let !newOffset = offset + delta in
190179 singleString fp newOffset terminal row (col + delta) newOffset $
191− addBits (Text.fromText (Text.pack bits)) fp initialOffset offset builder
180+ addEscape (Utf8.CodePoint code) initialOffset offset revChunks
192181
193182 EscapeProblem newOffset problem ->
194183 Err (E.ParseError row col (E.BadEscape (newOffset - offset) problem))
@@ -198,15 +187,15 @@ singleString fp offset terminal row col initialOffset builder =
198187
199188 else
200189 let !newOffset = offset + I.getCharWidth fp offset terminal word in
201− singleString fp newOffset terminal row (col + 1) initialOffset builder
190+ singleString fp newOffset terminal row (col + 1) initialOffset revChunks
202191
203192
204193
205194-- MULTI STRINGS
206195
207196
208−multiString :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Int -> Text.Builder -> StringResult
209−multiString fp offset terminal row col initialOffset builder =
197+multiString :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> Int -> [Utf8.Chunk] -> StringResult
198+multiString fp offset terminal row col initialOffset revChunks =
210199 if offset >= terminal then
211200 Err (E.ParseError row col E.EndOfFile_MultiString)
212201
@@ -214,32 +203,32 @@ multiString fp offset terminal row col initialOffset builder =
214203 let !word = I.unsafeIndex fp offset in
215204 if word == 0x22 {- " -} && isDoubleQuote fp (offset + 1) terminal && isDoubleQuote fp (offset + 2) terminal then
216205 Ok (offset + 3) row (col + 3) $
217− finalize fp initialOffset offset builder
206+ finalize fp initialOffset offset revChunks
218207
219208 else if word == 0x27 {- ' -} then
220209 let !offset1 = offset + 1 in
221210 multiString fp offset1 terminal row (col + 1) offset1 $
222− addBits singleQuoteBits fp initialOffset offset builder
211+ addEscape singleQuote initialOffset offset revChunks
223212
224213 else if word == 0x0A {- \n -} then
225214 let !offset1 = offset + 1 in
226215 multiString fp offset1 terminal (row + 1) 1 offset1 $
227− addBits newlineBits fp initialOffset offset builder
216+ addEscape newline initialOffset offset revChunks
228217
229218 else if word == 0x0D {- \r -} then
230219 let !offset1 = offset + 1 in
231220 multiString fp offset1 terminal (row + 1) 1 offset1 $
232− addBits carriageReturnBits fp initialOffset offset builder
221+ addEscape carriageReturn initialOffset offset revChunks
233222
234223 else if word == 0x5C {- \ -} then
235224 case eatEscape fp (offset + 1) terminal of
236225 EscapeNormal ->
237− multiString fp (offset + 2) terminal row (col + 2) initialOffset builder
226+ multiString fp (offset + 2) terminal row (col + 2) initialOffset revChunks
238227
239− EscapeUnicode delta bits ->
228+ EscapeUnicode delta code ->
240229 let !newOffset = offset + delta in
241230 multiString fp newOffset terminal row (col + delta) newOffset $
242− addBits (Text.fromText (Text.pack bits)) fp initialOffset offset builder
231+ addEscape (Utf8.CodePoint code) initialOffset offset revChunks
243232
244233 EscapeProblem newOffset problem ->
245234 Err (E.ParseError row col (E.BadEscape (newOffset - offset) problem))
@@ -249,7 +238,7 @@ multiString fp offset terminal row col initialOffset builder =
249238
250239 else
251240 let !newOffset = offset + I.getCharWidth fp offset terminal word in
252− multiString fp newOffset terminal row (col + 1) initialOffset builder
241+ multiString fp newOffset terminal row (col + 1) initialOffset revChunks
253242
254243
255244
@@ -258,7 +247,7 @@ multiString fp offset terminal row col initialOffset builder =
258247
259248data Escape
260249 = EscapeNormal
261− | EscapeUnicode !Int [Char]
250+ | EscapeUnicode !Int !Int
262251 | EscapeProblem !Int E.EscapeProblem
263252 | EscapeEndOfFile
264253
@@ -298,186 +287,37 @@ eatUnicode fp offset terminal =
298287
299288 else if numDigits < 4 || 6 < numDigits then
300289 EscapeProblem (newOffset + 1) $
301− E.UnicodeLength numDigits (Utf8.toString (B.PS fp digitOffset numDigits))
290+ E.UnicodeLength numDigits (BS_UTF8.toString (B.PS fp digitOffset numDigits))
302291
303292 else
304− EscapeUnicode (numDigits + 4) (codePointToBits code)
305−
306−
307−
308−-- CODE POINT TO BITS
309−
310−
311−codePointToBits :: Int -> [Char]
312−codePointToBits code =
313− if code < 0xFFFF then
314− wordToBits code
315−
316− else
317− let
318− (hi,lo) = divMod (code - 0x10000) 0x400
319− in
320− wordToBits (hi + 0xD800) ++ wordToBits (lo + 0xDC00)
321−
322−
323−wordToBits :: Int -> [Char]
324−wordToBits code =
325− [ '\\' -- 0x5C -- \
326− , 'u' -- 0x75 -- u
327− , toBits code 12
328− , toBits code 8
329− , toBits code 4
330− , toBits code 0
331− ]
332−
333−
334−toBits :: Int -> Int -> Char
335−toBits code offset =
336− let !n = fromIntegral (shiftR code offset .&. 0x000F) in
337− Char.chr $ if n < 10 then 0x30 + n else 0x61 + (n - 10)
338−
339−
340−{-# NOINLINE singleQuoteBits #-}
341−singleQuoteBits :: Text.Builder
342−singleQuoteBits =
343− "\\\'"
344−
345−
346−{-# NOINLINE newlineBits #-}
347−newlineBits :: Text.Builder
348−newlineBits =
349− "\\n"
350−
351−
352−{-# NOINLINE carriageReturnBits #-}
353−carriageReturnBits :: Text.Builder
354−carriageReturnBits =
355− "\\r"
356−
357−
358−
359−---- CHUNKS
360−
361−
362−--data Chunk
363−-- = Copy { _offset :: Int, _length :: Int }
364−-- | Bits [Word8]
365−
366−
367−--finalize :: Int -> Int -> [Chunk] -> [Chunk]
368−--finalize start end chunks =
369−-- reverse $
370−-- if start == end then
371−-- chunks
372−-- else
373−-- Copy start (end - start) : chunks
374−
375−
376−--addBits :: [Word8] -> Int -> Int -> [Chunk] -> [Chunk]
377−--addBits bits start end chunks =
378−-- if start == end then
379−-- Bits bits : chunks
380−-- else
381−-- Bits bits : Copy start (end - start) : chunks
382−
383−
384−--chunkLength :: Chunk -> Int
385−--chunkLength chunk =
386−-- case chunk of
387−-- Copy _ len ->
388−-- len
389−
390−-- Bits bits ->
391−-- length bits
392−
393−
394−
395−---- CHUNK TO SHORT
396−
397−
398−--chunkToShort :: ForeignPtr Word8 -> Chunk -> S.ShortByteString
399−--chunkToShort fp chunk =
400−-- unsafeDupablePerformIO $ stToIO $
401−-- do MBA mba <- newMutableByteArray (chunkLength chunk)
402−-- case chunk of
403−-- Copy offset len ->
404−-- do copyToByteArray (unsafeForeignPtrToPtr fp `plusPtr` offset) mba 0 len
405−-- freeze mba
406−
407−-- Bits bits ->
408−-- do _ <- writeBits mba 0 bits
409−-- freeze mba
410−
411−
412−
413−---- CHUNKS TO SHORT
414−
415−
416−--chunksToShort :: ForeignPtr Word8 -> [Chunk] -> S.ShortByteString
417−--chunksToShort fp chunks =
418−-- unsafeDupablePerformIO $ stToIO $
419−-- do MBA mba <- newMutableByteArray (sum (map chunkLength chunks))
420−-- chunksToShortHelp fp mba 0 chunks
421−
422−
423−--chunksToShortHelp :: ForeignPtr Word8 -> Prim.MutableByteArray# s -> Int -> [Chunk] -> ST s S.ShortByteString
424−--chunksToShortHelp fp mba index chunks =
425−-- case chunks of
426−-- [] ->
427−-- freeze mba
428−
429−-- chunk : others ->
430−-- case chunk of
431−-- Copy offset len ->
432−-- do copyToByteArray (unsafeForeignPtrToPtr fp `plusPtr` offset) mba index len
433−-- chunksToShortHelp fp mba (index + len) others
434−
435−-- Bits bits ->
436−-- do newIndex <- writeBits mba index bits
437−-- chunksToShortHelp fp mba newIndex others
438−
439−
440−
441−---- CHUNKS HELPERS
442−
443−
444−--data MBA s = MBA (Prim.MutableByteArray# s)
445−
293+ EscapeUnicode (numDigits + 4) code
446294
447−--newMutableByteArray :: Int -> ST s (MBA s)
448−--newMutableByteArray (I# len) =
449−-- ST $ \s1 ->
450−-- case Prim.newByteArray# len s1 of
451−-- (# s2, mba #) -> (# s2, MBA mba #)
452295
296+{-# NOINLINE singleQuote #-}
297+singleQuote :: Utf8.Chunk
298+singleQuote =
299+ Utf8.Escape 0x5C27 {- \' -}
453300
454−--freeze :: Prim.MutableByteArray# s -> ST s S.ShortByteString
455−--freeze mba =
456−-- ST $ \s1 ->
457−-- case Prim.unsafeFreezeByteArray# mba s1 of
458−-- (# s2, ba #) -> (# s2, S.SBS ba #)
459301
302+{-# NOINLINE doubleQuote #-}
303+doubleQuote :: Utf8.Chunk
304+doubleQuote =
305+ Utf8.Escape 0x5C22 {- \" -}
460306
461−--copyToByteArray :: Ptr Word8 -> Prim.MutableByteArray# s -> Int -> Int -> ST s ()
462−--copyToByteArray (Ptr src) dst (I# dstOffset) (I# len) =
463−-- ST $ \s1 ->
464−-- case Prim.copyAddrToByteArray# src dst dstOffset len s1 of
465−-- s2 -> (# s2, () #)
466307
308+{-# NOINLINE newline #-}
309+newline :: Utf8.Chunk
310+newline =
311+ Utf8.Escape 0x5C6E {- \n -}
467312
468−--writeBits :: Prim.MutableByteArray# s -> Int -> [Word8] -> ST s Int
469−--writeBits mba index bits =
470−-- case bits of
471−-- [] ->
472−-- return index
473313
474−-- word : others ->
475−-- do writeWord8Array mba index word
476−-- writeBits mba (index + 1) others
314+{-# NOINLINE carriageReturn #-}
315+carriageReturn :: Utf8.Chunk
316+carriageReturn =
317+ Utf8.Escape 0x5C72 {- \r -}
477318
478319
479−--writeWord8Array :: Prim.MutableByteArray# s -> Int -> Word8 -> ST s ()
480−--writeWord8Array mba (I# offset) (W8# word) =
481−-- ST $ \s1 ->
482−-- case Prim.writeWord8Array# mba offset word s1 of
483−-- s2 -> (# s2, () #)
320+{-# NOINLINE placeholder #-}
321+placeholder :: Utf8.Chunk
322+placeholder =
323+ Utf8.CodePoint 0xFFFD {- replacement character -}