git.iko.soy/elk
on f4401ac help sign in
elk/compiler/src/Parse/String.hs
343 lines 9.5 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
3module Parse.String
4 ( string
5 , character
6 )
7 where
10import qualified Data.Utf8 as Utf8
11import Data.Word (Word8, Word16)
12import Foreign.Ptr (Ptr, plusPtr, minusPtr)
14import qualified Elm.String as ES
15import Parse.Primitives (Parser, Row, Col)
16import qualified Parse.Number as Number
17import qualified Parse.Primitives as P
18import qualified Reporting.Error.Syntax as E
22-- CHARACTER
25character :: (Row -> Col -> x) -> (E.Char -> Row -> Col -> x) -> Parser x ES.String
26character toExpectation toError =
27 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
28 if pos >= end || P.unsafeIndex pos /= 0x27 {- ' -} then
29 eerr row col toExpectation
31 else
32 case chompChar (plusPtr pos 1) end row (col + 1) 0 placeholder of
33 Good newPos newCol numChars mostRecent ->
34 if numChars /= 1 then
35 cerr row col (toError (E.CharNotString (fromIntegral (newCol - col))))
36 else
37 let
38 !newState = P.State src newPos end indent row newCol
39 !char = ES.fromChunks [mostRecent]
40 in
41 cok char newState
43 CharEndless newCol ->
44 cerr row newCol (toError E.CharEndless)
46 CharEscape r c escape ->
47 cerr r c (toError (E.CharEscape escape))
50data CharResult
51 = Good (Ptr Word8) Col Word16 ES.Chunk
52 | CharEndless Col
53 | CharEscape Row Col E.Escape
56chompChar :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Word16 -> ES.Chunk -> CharResult
57chompChar pos end row col numChars mostRecent =
58 if pos >= end then
59 CharEndless col
61 else
62 let
63 !word = P.unsafeIndex pos
64 in
65 if word == 0x27 {- ' -} then
66 Good (plusPtr pos 1) (col + 1) numChars mostRecent
68 else if word == 0x0A {- \n -} then
69 CharEndless col
71 else if word == 0x22 {- " -} then
72 chompChar (plusPtr pos 1) end row (col + 1) (numChars + 1) doubleQuote
74 else if word == 0x5C {- \ -} then
75 case eatEscape (plusPtr pos 1) end row col of
76 EscapeNormal ->
77 chompChar (plusPtr pos 2) end row (col + 2) (numChars + 1) (ES.Slice pos 2)
79 EscapeUnicode delta code ->
80 chompChar (plusPtr pos delta) end row (col + fromIntegral delta) (numChars + 1) (ES.CodePoint code)
82 EscapeProblem r c badEscape ->
83 CharEscape r c badEscape
85 EscapeEndOfFile ->
86 CharEndless col
88 else
89 let
90 !width = P.getCharWidth word
91 !newPos = plusPtr pos width
92 in
93 chompChar newPos end row (col + 1) (numChars + 1) (ES.Slice pos width)
97-- STRINGS
100string :: (Row -> Col -> x) -> (E.String -> Row -> Col -> x) -> Parser x ES.String
101string toExpectation toError =
102 P.Parser $ \(P.State src pos end indent row col) cok _ cerr eerr ->
103 if isDoubleQuote pos end then
105 let
106 !pos1 = plusPtr pos 1
107 in
108 case
109 if isDoubleQuote pos1 end then
110 let !pos2 = plusPtr pos 2 in
111 if isDoubleQuote pos2 end then
112 let
113 !pos3 = plusPtr pos 3
114 !col3 = col + 3
115 in
116 multiString pos3 end row col3 pos3 row col mempty
117 else
118 Ok pos2 row (col + 2) Utf8.empty
119 else
120 singleString pos1 end row (col + 1) pos1 mempty
121 of
122 Ok newPos newRow newCol utf8 ->
123 let
124 !newState =
125 P.State src newPos end indent newRow newCol
126 in
127 cok utf8 newState
129 Err r c x ->
130 cerr r c (toError x)
132 else
133 eerr row col toExpectation
136{-# INLINE isDoubleQuote #-}
137isDoubleQuote :: Ptr Word8 -> Ptr Word8 -> Bool
138isDoubleQuote pos end =
139 pos < end && P.unsafeIndex pos == 0x22 {- " -}
142data StringResult
143 = Ok (Ptr Word8) Row Col !ES.String
144 | Err Row Col E.String
147finalize :: Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> ES.String
148finalize start end revChunks =
149 ES.fromChunks $ reverse $
150 if start == end then
151 revChunks
152 else
153 ES.Slice start (minusPtr end start) : revChunks
156addEscape :: ES.Chunk -> Ptr Word8 -> Ptr Word8 -> [ES.Chunk] -> [ES.Chunk]
157addEscape chunk start end revChunks =
158 if start == end then
159 chunk : revChunks
160 else
161 chunk : ES.Slice start (minusPtr end start) : revChunks
165-- SINGLE STRINGS
168singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [ES.Chunk] -> StringResult
169singleString pos end row col initialPos revChunks =
170 if pos >= end then
171 Err row col E.StringEndless_Single
173 else
174 let
175 !word = P.unsafeIndex pos
176 in
177 if word == 0x22 {- " -} then
178 Ok (plusPtr pos 1) row (col + 1) $
179 finalize initialPos pos revChunks
181 else if word == 0x0A {- \n -} then
182 Err row col E.StringEndless_Single
184 else if word == 0x27 {- ' -} then
185 let !newPos = plusPtr pos 1 in
186 singleString newPos end row (col + 1) newPos $
187 addEscape singleQuote initialPos pos revChunks
189 else if word == 0x5C {- \ -} then
190 case eatEscape (plusPtr pos 1) end row col of
191 EscapeNormal ->
192 singleString (plusPtr pos 2) end row (col + 2) initialPos revChunks
194 EscapeUnicode delta code ->
195 let !newPos = plusPtr pos delta in
196 singleString newPos end row (col + fromIntegral delta) newPos $
197 addEscape (ES.CodePoint code) initialPos pos revChunks
199 EscapeProblem r c x ->
200 Err r c (E.StringEscape x)
202 EscapeEndOfFile ->
203 Err row (col + 1) E.StringEndless_Single
205 else
206 let !newPos = plusPtr pos (P.getCharWidth word) in
207 singleString newPos end row (col + 1) initialPos revChunks
211-- MULTI STRINGS
214multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [ES.Chunk] -> StringResult
215multiString pos end row col initialPos sr sc revChunks =
216 if pos >= end then
217 Err sr sc E.StringEndless_Multi
219 else
220 let !word = P.unsafeIndex pos in
221 if word == 0x22 {- " -} && isDoubleQuote (plusPtr pos 1) end && isDoubleQuote (plusPtr pos 2) end then
222 Ok (plusPtr pos 3) row (col + 3) $
223 finalize initialPos pos revChunks
225 else if word == 0x27 {- ' -} then
226 let !pos1 = plusPtr pos 1 in
227 multiString pos1 end row (col + 1) pos1 sr sc $
228 addEscape singleQuote initialPos pos revChunks
230 else if word == 0x0A {- \n -} then
231 let !pos1 = plusPtr pos 1 in
232 multiString pos1 end (row + 1) 1 pos1 sr sc $
233 addEscape newline initialPos pos revChunks
235 else if word == 0x0D {- \r -} then
236 let !pos1 = plusPtr pos 1 in
237 multiString pos1 end row col pos1 sr sc $
238 addEscape carriageReturn initialPos pos revChunks
240 else if word == 0x5C {- \ -} then
241 case eatEscape (plusPtr pos 1) end row col of
242 EscapeNormal ->
243 multiString (plusPtr pos 2) end row (col + 2) initialPos sr sc revChunks
245 EscapeUnicode delta code ->
246 let !newPos = plusPtr pos delta in
247 multiString newPos end row (col + fromIntegral delta) newPos sr sc $
248 addEscape (ES.CodePoint code) initialPos pos revChunks
250 EscapeProblem r c x ->
251 Err r c (E.StringEscape x)
253 EscapeEndOfFile ->
254 Err sr sc E.StringEndless_Multi
256 else
257 let !newPos = plusPtr pos (P.getCharWidth word) in
258 multiString newPos end row (col + 1) initialPos sr sc revChunks
262-- ESCAPE CHARACTERS
265data Escape
266 = EscapeNormal
267 | EscapeUnicode !Int !Int
268 | EscapeEndOfFile
269 | EscapeProblem Row Col E.Escape
272eatEscape :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Escape
273eatEscape pos end row col =
274 if pos >= end then
275 EscapeEndOfFile
277 else
278 case P.unsafeIndex pos of
279 0x6E {- n -} -> EscapeNormal
280 0x72 {- r -} -> EscapeNormal
281 0x74 {- t -} -> EscapeNormal
282 0x22 {- " -} -> EscapeNormal
283 0x27 {- ' -} -> EscapeNormal
284 0x5C {- \ -} -> EscapeNormal
285 0x75 {- u -} -> eatUnicode (plusPtr pos 1) end row col
286 _ -> EscapeProblem row col E.EscapeUnknown
289eatUnicode :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> Escape
290eatUnicode pos end row col =
291 if pos >= end || P.unsafeIndex pos /= 0x7B {- { -} then
292 EscapeProblem row col (E.BadUnicodeFormat 2)
293 else
294 let
295 !digitPos = plusPtr pos 1
296 (# newPos, code #) = Number.chompHex digitPos end
297 !numDigits = minusPtr newPos digitPos
298 in
299 if newPos >= end || P.unsafeIndex newPos /= 0x7D {- } -} then
300 EscapeProblem row col $ E.BadUnicodeFormat (2 + fromIntegral (minusPtr newPos pos))
302 else if code < 0 || 0x10FFFF < code then
303 EscapeProblem row col $ E.BadUnicodeCode (3 + fromIntegral (minusPtr newPos pos))
305 else if numDigits < 4 || 6 < numDigits then
306 EscapeProblem row col $
307 E.BadUnicodeLength
308 (3 + fromIntegral (minusPtr newPos pos))
309 numDigits
310 code
312 else
313 EscapeUnicode (numDigits + 4) code
316{-# NOINLINE singleQuote #-}
317singleQuote :: ES.Chunk
318singleQuote =
319 ES.Escape 0x27 {-'-}
322{-# NOINLINE doubleQuote #-}
323doubleQuote :: ES.Chunk
324doubleQuote =
325 ES.Escape 0x22 {-"-}
328{-# NOINLINE newline #-}
329newline :: ES.Chunk
330newline =
331 ES.Escape 0x6E {-n-}
334{-# NOINLINE carriageReturn #-}
335carriageReturn :: ES.Chunk
336carriageReturn =
337 ES.Escape 0x72 {-r-}
340{-# NOINLINE placeholder #-}
341placeholder :: ES.Chunk
342placeholder =
343 ES.CodePoint 0xFFFD {-replacement character-}