]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice/G16.expected.txt
!fixup impl: move `liftTypedString` to `Language.Haskell.TH.Show`
[haskell/symantic-parser.git] / tests / Golden / Splice / G16.expected.txt
1 \(input :: inp) ->
2 let !(#
3 initBuffer,
4 initPos,
5 readMore,
6 readNext,
7 append
8 #) =
9 let next buf pos =
10 let !( Data.Text.Unsafe.Iter
11 c
12 d
13 ) = Symantic.Parser.Machine.Input.Text.Buffer.iter buf pos
14 in (# c, pos GHC.Num.+ d #)
15 more buf pos = pos GHC.Classes.< Symantic.Parser.Machine.Input.Text.Buffer.length buf
16 append = Symantic.Parser.Machine.Input.Text.Buffer.pappend
17 in (#
18 Symantic.Parser.Machine.Input.Text.Buffer.buffer input,
19 0,
20 more,
21 next,
22 append
23 #)
24 finalRet = \_farInp _farExp v _inp _buf _end -> Symantic.Parser.Machine.Generate.returnST GHC.Base.$ Symantic.Parser.Machine.Generate.ResultDone v
25 finalRaise :: Symantic.Parser.Machine.Generate.ForallOnException inp =
26 Symantic.Parser.Machine.Generate.ForallOnException GHC.Base.$
27 ( \(!exn) _failInp (!farInp) (!farExp) buf end ->
28 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
29 Symantic.Parser.Machine.Generate.ResultError
30 Symantic.Parser.Machine.Generate.ParsingError
31 { Symantic.Parser.Machine.Generate.parsingErrorOffset = Symantic.Parser.Machine.Input.position farInp,
32 Symantic.Parser.Machine.Generate.parsingErrorException = exn,
33 Symantic.Parser.Machine.Generate.parsingErrorUnexpected =
34 if readMore buf farInp
35 then
36 GHC.Maybe.Just
37 ( let (#
38 c,
39 _
40 #) = readNext buf farInp
41 in c
42 )
43 else GHC.Maybe.Nothing,
44 Symantic.Parser.Machine.Generate.parsingErrorExpecting =
45 let ( minHoriz,
46 res
47 ) =
48 Data.Set.Internal.foldr
49 ( \f
50 ( minH,
51 acc
52 ) -> case Symantic.Parser.Grammar.Combinators.unSomeFailure f of
53 GHC.Maybe.Just (Symantic.Parser.Grammar.Combinators.FailureHorizon h :: Symantic.Parser.Grammar.Combinators.Failure (Symantic.Parser.Grammar.Combinators.CombSatisfiable (Symantic.Parser.Machine.Input.InputToken inp)))
54 | GHC.Maybe.Just old <- minH ->
55 ( GHC.Maybe.Just (GHC.Classes.min old h),
56 acc
57 )
58 | GHC.Base.otherwise ->
59 ( GHC.Maybe.Just h,
60 acc
61 )
62 _ ->
63 ( minH,
64 f GHC.Types.: acc
65 )
66 )
67 ( GHC.Maybe.Nothing,
68 GHC.Types . []
69 )
70 farExp
71 in Data.Set.Internal.fromList GHC.Base.$
72 ( case minHoriz of
73 GHC.Maybe.Just h -> Symantic.Parser.Grammar.Combinators.SomeFailure (Symantic.Parser.Grammar.Combinators.FailureHorizon @(Symantic.Parser.Machine.Input.InputToken inp) h) GHC.Types.: res
74 GHC.Maybe.Nothing -> res
75 )
76 }
77 )
78 in let inputToken = Data.Proxy.Proxy :: Data.Proxy.Proxy (Symantic.Parser.Machine.Input.InputToken inp)
79 in let partialCont buf =
80 let readFail = Symantic.Parser.Machine.Generate.unForallOnException finalRaise
81 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
82 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 initPos)
83 then
84 let
85 in let _ = "pushValue"
86 in let join = \farInp farExp v (!inp) buf end ->
87 let _ = "lift2Value checkedHorizon=0"
88 in let _ = "comment: satisfy ((GHC.Classes.==) 'd')"
89 in let partialCont buf =
90 let readFail = Symantic.Parser.Machine.Generate.unForallOnException finalRaise
91 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
92 in if readMore buf inp
93 then
94 let _ = "checkToken"
95 in let !(#
96 c,
97 cs
98 #) = readNext buf inp
99 in if (GHC.Classes.==) 'd' c
100 then
101 let _ = "lift2Value checkedHorizon=1"
102 in let _ = "resume"
103 in finalRet
104 farInp
105 farExp
106 ( let _ = "resume.genCode"
107 in GHC.Show.show v
108 )
109 cs
110 buf
111 end
112 else
113 let _ = "checkToken.fail"
114 in let failExp =
115 Data.Set.Internal.Bin
116 1
117 ( Symantic.Parser.Grammar.Combinators.SomeFailure
118 ( case inputToken of
119 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd'
120 )
121 )
122 Data.Set.Internal.Tip
123 Data.Set.Internal.Tip
124 in let (#
125 farInp,
126 farExp
127 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
128 GHC.Types.LT ->
129 (#
130 inp,
131 failExp
132 #)
133 GHC.Types.EQ ->
134 (#
135 farInp,
136 failExp GHC.Base.<> farExp
137 #)
138 GHC.Types.GT ->
139 (#
140 farInp,
141 farExp
142 #)
143 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf end
144 else
145 let _ = "checkHorizon.newCheck.fail"
146 in let noMoreInput =
147 let failExp =
148 Data.Set.Internal.Bin
149 1
150 ( Symantic.Parser.Grammar.Combinators.SomeFailure
151 ( case inputToken of
152 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
153 )
154 )
155 Data.Set.Internal.Tip
156 Data.Set.Internal.Tip
157 in let (#
158 farInp,
159 farExp
160 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
161 GHC.Types.LT ->
162 (#
163 inp,
164 failExp
165 #)
166 GHC.Types.EQ ->
167 (#
168 farInp,
169 failExp GHC.Base.<> farExp
170 #)
171 GHC.Types.GT ->
172 (#
173 farInp,
174 farExp
175 #)
176 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf GHC.Types.True
177 in if end
178 then noMoreInput
179 else
180 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
181 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
182 ( \newInput ->
183 if Symantic.Parser.Machine.Input.nullInput newInput
184 then noMoreInput
185 else partialCont (append buf newInput)
186 )
187 )
188 in partialCont buf
189 in let _ = "catch ExceptionFailure checkedHorizon=2"
190 in let onException =
191 let _ = "onException"
192 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
193 let _ = "comment: raiseAgainIfConsumed"
194 in let _ = "saveInput checkedHorizon=0"
195 in let _ = "lift2Value checkedHorizon=0"
196 in if (GHC.Classes.==) @GHC.Types.Int initPos failInp
197 then
198 let _ = "choicesBranch checkedHorizon=0"
199 in let _ = "catch ExceptionFailure checkedHorizon=0"
200 in let onException =
201 let _ = "onException"
202 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
203 let _ = "comment: raiseAgainIfConsumed"
204 in let _ = "saveInput checkedHorizon=0"
205 in let _ = "lift2Value checkedHorizon=0"
206 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
207 then
208 let _ = "choicesBranch checkedHorizon=0"
209 in let _ = "pushValue"
210 in let _ = "comment: satisfy ((GHC.Classes.==) 'c')"
211 in let partialCont buf =
212 let readFail = Symantic.Parser.Machine.Generate.unForallOnException finalRaise
213 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
214 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 failInp)
215 then
216 let _ = "checkToken"
217 in let !(#
218 c,
219 cs
220 #) = readNext buf failInp
221 in if (GHC.Classes.==) 'c' c
222 then
223 let _ = "lift2Value checkedHorizon=2"
224 in let _ = "resume"
225 in join
226 farInp
227 farExp
228 ( let _ = "resume.genCode"
229 in 'c'
230 )
231 cs
232 buf
233 end
234 else
235 let _ = "checkToken.fail"
236 in let failExp =
237 Data.Set.Internal.Bin
238 1
239 ( Symantic.Parser.Grammar.Combinators.SomeFailure
240 ( case inputToken of
241 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c'
242 )
243 )
244 Data.Set.Internal.Tip
245 Data.Set.Internal.Tip
246 in let (#
247 farInp,
248 farExp
249 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
250 GHC.Types.LT ->
251 (#
252 failInp,
253 failExp
254 #)
255 GHC.Types.EQ ->
256 (#
257 farInp,
258 failExp GHC.Base.<> farExp
259 #)
260 GHC.Types.GT ->
261 (#
262 farInp,
263 farExp
264 #)
265 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
266 else
267 let _ = "checkHorizon.newCheck.fail"
268 in let noMoreInput =
269 let failExp =
270 Data.Set.Internal.Bin
271 1
272 ( Symantic.Parser.Grammar.Combinators.SomeFailure
273 ( case inputToken of
274 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
275 )
276 )
277 Data.Set.Internal.Tip
278 Data.Set.Internal.Tip
279 in let (#
280 farInp,
281 farExp
282 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
283 GHC.Types.LT ->
284 (#
285 failInp,
286 failExp
287 #)
288 GHC.Types.EQ ->
289 (#
290 farInp,
291 failExp GHC.Base.<> farExp
292 #)
293 GHC.Types.GT ->
294 (#
295 farInp,
296 farExp
297 #)
298 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
299 in if end
300 then noMoreInput
301 else
302 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
303 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
304 ( \newInput ->
305 if Symantic.Parser.Machine.Input.nullInput newInput
306 then noMoreInput
307 else partialCont (append buf newInput)
308 )
309 )
310 in partialCont buf
311 else
312 let _ = "choicesBranch.else"
313 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
314 in let _ = "pushValue"
315 in let _ = "comment: satisfy ((GHC.Classes.==) 'b')"
316 in let partialCont buf =
317 let readFail = onException
318 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
319 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 failInp)
320 then
321 let _ = "checkToken"
322 in let !(#
323 c,
324 cs
325 #) = readNext buf failInp
326 in if (GHC.Classes.==) 'b' c
327 then
328 let _ = "lift2Value checkedHorizon=2"
329 in let _ = "commit"
330 in let _ = "resume"
331 in join
332 farInp
333 farExp
334 ( let _ = "resume.genCode"
335 in 'b'
336 )
337 cs
338 buf
339 end
340 else
341 let _ = "checkToken.fail"
342 in let failExp =
343 Data.Set.Internal.Bin
344 1
345 ( Symantic.Parser.Grammar.Combinators.SomeFailure
346 ( case inputToken of
347 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b'
348 )
349 )
350 Data.Set.Internal.Tip
351 Data.Set.Internal.Tip
352 in let (#
353 farInp,
354 farExp
355 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
356 GHC.Types.LT ->
357 (#
358 failInp,
359 failExp
360 #)
361 GHC.Types.EQ ->
362 (#
363 farInp,
364 failExp GHC.Base.<> farExp
365 #)
366 GHC.Types.GT ->
367 (#
368 farInp,
369 farExp
370 #)
371 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
372 else
373 let _ = "checkHorizon.newCheck.fail"
374 in let noMoreInput =
375 let failExp =
376 Data.Set.Internal.Bin
377 1
378 ( Symantic.Parser.Grammar.Combinators.SomeFailure
379 ( case inputToken of
380 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
381 )
382 )
383 Data.Set.Internal.Tip
384 Data.Set.Internal.Tip
385 in let (#
386 farInp,
387 farExp
388 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
389 GHC.Types.LT ->
390 (#
391 failInp,
392 failExp
393 #)
394 GHC.Types.EQ ->
395 (#
396 farInp,
397 failExp GHC.Base.<> farExp
398 #)
399 GHC.Types.GT ->
400 (#
401 farInp,
402 farExp
403 #)
404 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
405 in if end
406 then noMoreInput
407 else
408 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
409 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
410 ( \newInput ->
411 if Symantic.Parser.Machine.Input.nullInput newInput
412 then noMoreInput
413 else partialCont (append buf newInput)
414 )
415 )
416 in partialCont buf
417 else
418 let _ = "choicesBranch.else"
419 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
420 in let _ = "pushValue"
421 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
422 in let _ = "checkHorizon.oldCheck: checkedHorizon=2"
423 in let _ = "checkToken"
424 in let !(#
425 c,
426 cs
427 #) = readNext buf initPos
428 in if (GHC.Classes.==) 'a' c
429 then
430 let _ = "lift2Value checkedHorizon=1"
431 in let _ = "commit"
432 in let _ = "resume"
433 in join
434 initPos
435 Data.Set.Internal.empty
436 ( let _ = "resume.genCode"
437 in 'a'
438 )
439 cs
440 buf
441 GHC.Types.False
442 else
443 let _ = "checkToken.fail"
444 in let failExp =
445 Data.Set.Internal.Bin
446 1
447 ( Symantic.Parser.Grammar.Combinators.SomeFailure
448 ( case inputToken of
449 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
450 )
451 )
452 Data.Set.Internal.Tip
453 Data.Set.Internal.Tip
454 in let (#
455 farInp,
456 farExp
457 #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
458 GHC.Types.LT ->
459 (#
460 initPos,
461 failExp
462 #)
463 GHC.Types.EQ ->
464 (#
465 initPos,
466 failExp GHC.Base.<> Data.Set.Internal.empty
467 #)
468 GHC.Types.GT ->
469 (#
470 initPos,
471 Data.Set.Internal.empty
472 #)
473 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.False
474 else
475 let _ = "checkHorizon.newCheck.fail"
476 in let noMoreInput =
477 let failExp =
478 Data.Set.Internal.Bin
479 1
480 ( Symantic.Parser.Grammar.Combinators.SomeFailure
481 ( case inputToken of
482 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
483 )
484 )
485 Data.Set.Internal.Tip
486 Data.Set.Internal.Tip
487 in let (#
488 farInp,
489 farExp
490 #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
491 GHC.Types.LT ->
492 (#
493 initPos,
494 failExp
495 #)
496 GHC.Types.EQ ->
497 (#
498 initPos,
499 failExp GHC.Base.<> Data.Set.Internal.empty
500 #)
501 GHC.Types.GT ->
502 (#
503 initPos,
504 Data.Set.Internal.empty
505 #)
506 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.True
507 in if GHC.Types.False
508 then noMoreInput
509 else
510 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
511 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
512 ( \newInput ->
513 if Symantic.Parser.Machine.Input.nullInput newInput
514 then noMoreInput
515 else partialCont (append buf newInput)
516 )
517 )
518 in partialCont initBuffer