]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice/G14.expected.txt
sourcephile / git / haskell / symantic-parser.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
tests: add more tests
[haskell/symantic-parser.git] / tests / Golden / Splice / G14.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=1"
82 in if readMore buf initPos
83 then
84 let name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
85 let _ = "catch ExceptionFailure checkedHorizon=0"
86 in let onException =
87 let _ = "onException"
88 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
89 let _ = "comment: raiseAgainIfConsumed"
90 in let _ = "saveInput checkedHorizon=0"
91 in let _ = "lift2Value checkedHorizon=0"
92 in if (GHC.Classes.==) @GHC.Types.Int callerInput failInp
93 then
94 let _ = "choicesBranch checkedHorizon=0"
95 in let _ = "catch ExceptionFailure checkedHorizon=0"
96 in let onException =
97 let _ = "onException"
98 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
99 let _ = "comment: raiseAgainIfConsumed"
100 in let _ = "saveInput checkedHorizon=0"
101 in let _ = "lift2Value checkedHorizon=0"
102 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
103 then
104 let _ = "choicesBranch checkedHorizon=0"
105 in let _ = "pushValue"
106 in name
107 ( let _ = "onReturn"
108 in \farInp farExp v (!inp) buf end ->
109 let _ = "lift2Value checkedHorizon=0"
110 in let join = \farInp farExp v (!inp) buf end ->
111 let _ = "lift2Value checkedHorizon=0"
112 in let _ = "resume"
113 in callerOnReturn
114 farInp
115 farExp
116 ( let _ = "resume.genCode"
117 in v
118 )
119 inp
120 buf
121 end
122 in let _ = "catch ExceptionFailure checkedHorizon=0"
123 in let onException =
124 let _ = "onException"
125 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
126 let _ = "comment: raiseAgainIfConsumed"
127 in let _ = "saveInput checkedHorizon=0"
128 in let _ = "lift2Value checkedHorizon=0"
129 in if (GHC.Classes.==) @GHC.Types.Int inp failInp
130 then
131 let _ = "choicesBranch checkedHorizon=0"
132 in name
133 ( let _ = "onReturn"
134 in \farInp farExp v (!inp) buf end ->
135 let _ = "resume"
136 in join
137 farInp
138 farExp
139 ( let _ = "resume.genCode"
140 in v
141 )
142 inp
143 buf
144 end
145 )
146 failInp
147 buf
148 end
149 Data.Map.Internal.Tip
150 else
151 let _ = "choicesBranch.else"
152 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
153 in let _ = "pushValue"
154 in let join = \farInp farExp v (!inp) buf end ->
155 let _ = "lift2Value checkedHorizon=0"
156 in let _ = "commit"
157 in let _ = "resume"
158 in join
159 farInp
160 farExp
161 ( let _ = "resume.genCode"
162 in GHC.Tuple . ()
163 )
164 inp
165 buf
166 end
167 in let _ = "catch ExceptionFailure checkedHorizon=0"
168 in let onException =
169 let _ = "onException"
170 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
171 let _ = "comment: raiseAgainIfConsumed"
172 in let _ = "saveInput checkedHorizon=0"
173 in let _ = "lift2Value checkedHorizon=0"
174 in if (GHC.Classes.==) @GHC.Types.Int inp failInp
175 then
176 let _ = "choicesBranch checkedHorizon=0"
177 in name
178 ( let _ = "onReturn"
179 in \farInp farExp v (!inp) buf end ->
180 let _ = "resume"
181 in join
182 farInp
183 farExp
184 ( let _ = "resume.genCode"
185 in v
186 )
187 inp
188 buf
189 end
190 )
191 failInp
192 buf
193 end
194 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
195 else
196 let _ = "choicesBranch.else"
197 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
198 in let _ = "pushValue"
199 in name
200 ( let _ = "onReturn"
201 in \farInp farExp v (!inp) buf end ->
202 let _ = "lift2Value checkedHorizon=0"
203 in let join = \farInp farExp v (!inp) buf end ->
204 let _ = "lift2Value checkedHorizon=0"
205 in name
206 ( let _ = "onReturn"
207 in \farInp farExp v (!inp) buf end ->
208 let _ = "lift2Value checkedHorizon=0"
209 in let _ = "commit"
210 in let _ = "resume"
211 in join
212 farInp
213 farExp
214 ( let _ = "resume.genCode"
215 in v
216 )
217 inp
218 buf
219 end
220 )
221 inp
222 buf
223 end
224 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
225 in let _ = "catch ExceptionFailure checkedHorizon=0"
226 in let onException =
227 let _ = "onException"
228 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
229 let _ = "comment: raiseAgainIfConsumed"
230 in let _ = "saveInput checkedHorizon=0"
231 in let _ = "lift2Value checkedHorizon=0"
232 in if (GHC.Classes.==) @GHC.Types.Int inp failInp
233 then
234 let _ = "choicesBranch checkedHorizon=0"
235 in name
236 ( let _ = "onReturn"
237 in \farInp farExp v (!inp) buf end ->
238 let _ = "resume"
239 in join
240 farInp
241 farExp
242 ( let _ = "resume.genCode"
243 in v
244 )
245 inp
246 buf
247 end
248 )
249 failInp
250 buf
251 end
252 Data.Map.Internal.Tip
253 else
254 let _ = "choicesBranch.else"
255 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
256 in let _ = "pushValue"
257 in name
258 ( let _ = "onReturn"
259 in \farInp farExp v (!inp) buf end ->
260 let _ = "lift2Value checkedHorizon=0"
261 in let _ = "pushValue"
262 in do
263 let dupv = \u -> u
264 reg <- GHC.STRef.newSTRef dupv
265 let _ = "iter"
266 in let onException loopInput =
267 let _ = "onException"
268 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
269 let _ = "comment: raiseAgainIfConsumed"
270 in let _ = "saveInput checkedHorizon=0"
271 in let _ = "lift2Value checkedHorizon=0"
272 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
273 then
274 let _ = "choicesBranch checkedHorizon=0"
275 in do
276 sr <- GHC.STRef.readSTRef reg
277 name
278 ( let _ = "onReturn"
279 in \farInp farExp v (!inp) buf end ->
280 let _ = "lift2Value checkedHorizon=0"
281 in let _ = "lift2Value checkedHorizon=0"
282 in name
283 ( let _ = "onReturn"
284 in \farInp farExp v (!inp) buf end ->
285 let _ = "lift2Value checkedHorizon=0"
286 in let _ = "commit"
287 in let _ = "resume"
288 in join
289 farInp
290 farExp
291 ( let _ = "resume.genCode"
292 in GHC.Tuple . ()
293 )
294 inp
295 buf
296 end
297 )
298 inp
299 buf
300 end
301 Data.Map.Internal.Tip
302 )
303 failInp
304 buf
305 end
306 Data.Map.Internal.Tip
307 else
308 let _ = "choicesBranch.else"
309 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
310 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
311 let _ = "pushValue"
312 in name
313 ( let _ = "onReturn"
314 in \farInp farExp v (!inp) buf end ->
315 let _ = "lift2Value checkedHorizon=0"
316 in name
317 ( let _ = "onReturn"
318 in \farInp farExp v (!inp) buf end ->
319 let _ = "lift2Value checkedHorizon=0"
320 in name
321 ( let _ = "onReturn"
322 in \farInp farExp v (!inp) buf end ->
323 let _ = "lift2Value checkedHorizon=0"
324 in do
325 sr <- GHC.STRef.readSTRef reg
326 let _ = "lift2Value checkedHorizon=0"
327 in do
328 let dupv = v v sr
329 GHC.STRef.writeSTRef reg dupv
330 let _ = "jump"
331 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
332 )
333 inp
334 buf
335 end
336 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
337 )
338 inp
339 buf
340 end
341 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
342 )
343 callerInput
344 callerBuffer
345 callerEnded
346 Data.Map.Internal.Tip
347 in let _ = "jump"
348 in loop callerOnReturn inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
349 )
350 inp
351 buf
352 end
353 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
354 )
355 inp
356 buf
357 end
358 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
359 )
360 failInp
361 buf
362 end
363 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
364 else
365 let _ = "choicesBranch.else"
366 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
367 in let _ = "pushValue"
368 in let _ = "comment: satisfy ((GHC.Classes.==) '\\'')"
369 in let partialCont buf =
370 let readFail = onException
371 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=4"
372 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 3 failInp)
373 then
374 let _ = "checkToken"
375 in let !(#
376 c,
377 cs
378 #) = readNext buf failInp
379 in if (GHC.Classes.==) '\'' c
380 then
381 let _ = "lift2Value checkedHorizon=4"
382 in let join = \farInp farExp v (!inp) buf end ->
383 let _ = "lift2Value checkedHorizon=0"
384 in let _ = "comment: satisfy ((GHC.Classes.==) '\\'')"
385 in let partialCont buf =
386 let readFail = readFail
387 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
388 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 inp)
389 then
390 let _ = "checkToken"
391 in let !(#
392 c,
393 cs
394 #) = readNext buf inp
395 in if (GHC.Classes.==) '\'' c
396 then
397 let _ = "lift2Value checkedHorizon=2"
398 in name
399 ( let _ = "onReturn"
400 in \farInp farExp v (!inp) buf end ->
401 let _ = "lift2Value checkedHorizon=0"
402 in let _ = "commit"
403 in let _ = "resume"
404 in callerOnReturn
405 farInp
406 farExp
407 ( let _ = "resume.genCode"
408 in v
409 )
410 inp
411 buf
412 end
413 )
414 cs
415 buf
416 end
417 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
418 else
419 let _ = "checkToken.fail"
420 in let failExp =
421 Data.Set.Internal.Bin
422 1
423 ( Symantic.Parser.Grammar.Combinators.SomeFailure
424 ( case inputToken of
425 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '\''
426 )
427 )
428 Data.Set.Internal.Tip
429 Data.Set.Internal.Tip
430 in let (#
431 farInp,
432 farExp
433 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
434 GHC.Types.LT ->
435 (#
436 inp,
437 failExp
438 #)
439 GHC.Types.EQ ->
440 (#
441 farInp,
442 failExp GHC.Base.<> farExp
443 #)
444 GHC.Types.GT ->
445 (#
446 farInp,
447 farExp
448 #)
449 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf end
450 else
451 let _ = "checkHorizon.newCheck.fail"
452 in let noMoreInput =
453 let failExp =
454 Data.Set.Internal.Bin
455 1
456 ( Symantic.Parser.Grammar.Combinators.SomeFailure
457 ( case inputToken of
458 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
459 )
460 )
461 Data.Set.Internal.Tip
462 Data.Set.Internal.Tip
463 in let (#
464 farInp,
465 farExp
466 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
467 GHC.Types.LT ->
468 (#
469 inp,
470 failExp
471 #)
472 GHC.Types.EQ ->
473 (#
474 farInp,
475 failExp GHC.Base.<> farExp
476 #)
477 GHC.Types.GT ->
478 (#
479 farInp,
480 farExp
481 #)
482 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf GHC.Types.True
483 in if end
484 then noMoreInput
485 else
486 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
487 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
488 ( \newInput ->
489 if Symantic.Parser.Machine.Input.nullInput newInput
490 then noMoreInput
491 else partialCont (append buf newInput)
492 )
493 )
494 in partialCont buf
495 in let _ = "catch ExceptionFailure checkedHorizon=4"
496 in let onException =
497 let _ = "onException"
498 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
499 let _ = "comment: raiseAgainIfConsumed"
500 in let _ = "saveInput checkedHorizon=0"
501 in let _ = "lift2Value checkedHorizon=0"
502 in if (GHC.Classes.==) @GHC.Types.Int cs failInp
503 then
504 let _ = "choicesBranch checkedHorizon=0"
505 in let _ = "pushValue"
506 in let _ = "comment: satisfy ((GHC.Classes.==) '\\\\')"
507 in let partialCont buf =
508 let readFail = readFail
509 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=4"
510 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 3 failInp)
511 then
512 let _ = "checkToken"
513 in let !(#
514 c,
515 cs
516 #) = readNext buf failInp
517 in if (GHC.Classes.==) '\\' c
518 then
519 let _ = "lift2Value checkedHorizon=4"
520 in let _ = "comment: satisfy (\\t_0 -> ('0' GHC.Classes.== t_0) GHC.Classes.|| (('t' GHC.Classes.== t_0) GHC.Classes.|| (('n' GHC.Classes.== t_0) GHC.Classes.|| (('v' GHC.Classes.== t_0) GHC.Classes.|| (('f' GHC.Classes.== t_0) GHC.Classes.|| (('r' GHC.Classes.== t_0) GHC.Classes.|| GHC.Types.False))))))"
521 in let _ = "checkHorizon.oldCheck: checkedHorizon=4"
522 in let _ = "checkToken"
523 in let !(#
524 c,
525 cs
526 #) = readNext buf cs
527 in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('t' GHC.Classes.== t) GHC.Classes.|| (('n' GHC.Classes.== t) GHC.Classes.|| (('v' GHC.Classes.== t) GHC.Classes.|| (('f' GHC.Classes.== t) GHC.Classes.|| (('r' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))) c
528 then
529 let _ = "lift2Value checkedHorizon=3"
530 in name
531 ( let _ = "onReturn"
532 in \farInp farExp v (!inp) buf end ->
533 let _ = "lift2Value checkedHorizon=0"
534 in let _ = "resume"
535 in join
536 farInp
537 farExp
538 ( let _ = "resume.genCode"
539 in v
540 )
541 inp
542 buf
543 end
544 )
545 cs
546 buf
547 end
548 Data.Map.Internal.Tip
549 else
550 let _ = "checkToken.fail"
551 in let failExp =
552 Data.Set.Internal.Bin
553 6
554 ( Symantic.Parser.Grammar.Combinators.SomeFailure
555 ( case inputToken of
556 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'n'
557 )
558 )
559 ( Data.Set.Internal.Bin
560 2
561 ( Symantic.Parser.Grammar.Combinators.SomeFailure
562 ( case inputToken of
563 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '0'
564 )
565 )
566 Data.Set.Internal.Tip
567 ( Data.Set.Internal.Bin
568 1
569 ( Symantic.Parser.Grammar.Combinators.SomeFailure
570 ( case inputToken of
571 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'f'
572 )
573 )
574 Data.Set.Internal.Tip
575 Data.Set.Internal.Tip
576 )
577 )
578 ( Data.Set.Internal.Bin
579 3
580 ( Symantic.Parser.Grammar.Combinators.SomeFailure
581 ( case inputToken of
582 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 't'
583 )
584 )
585 ( Data.Set.Internal.Bin
586 1
587 ( Symantic.Parser.Grammar.Combinators.SomeFailure
588 ( case inputToken of
589 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'r'
590 )
591 )
592 Data.Set.Internal.Tip
593 Data.Set.Internal.Tip
594 )
595 ( Data.Set.Internal.Bin
596 1
597 ( Symantic.Parser.Grammar.Combinators.SomeFailure
598 ( case inputToken of
599 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'v'
600 )
601 )
602 Data.Set.Internal.Tip
603 Data.Set.Internal.Tip
604 )
605 )
606 in let (#
607 farInp,
608 farExp
609 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
610 GHC.Types.LT ->
611 (#
612 cs,
613 failExp
614 #)
615 GHC.Types.EQ ->
616 (#
617 farInp,
618 failExp GHC.Base.<> farExp
619 #)
620 GHC.Types.GT ->
621 (#
622 farInp,
623 farExp
624 #)
625 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
626 else
627 let _ = "checkToken.fail"
628 in let failExp =
629 Data.Set.Internal.Bin
630 1
631 ( Symantic.Parser.Grammar.Combinators.SomeFailure
632 ( case inputToken of
633 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '\\'
634 )
635 )
636 Data.Set.Internal.Tip
637 Data.Set.Internal.Tip
638 in let (#
639 farInp,
640 farExp
641 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
642 GHC.Types.LT ->
643 (#
644 failInp,
645 failExp
646 #)
647 GHC.Types.EQ ->
648 (#
649 farInp,
650 failExp GHC.Base.<> farExp
651 #)
652 GHC.Types.GT ->
653 (#
654 farInp,
655 farExp
656 #)
657 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
658 else
659 let _ = "checkHorizon.newCheck.fail"
660 in let noMoreInput =
661 let failExp =
662 Data.Set.Internal.Bin
663 1
664 ( Symantic.Parser.Grammar.Combinators.SomeFailure
665 ( case inputToken of
666 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
667 )
668 )
669 Data.Set.Internal.Tip
670 Data.Set.Internal.Tip
671 in let (#
672 farInp,
673 farExp
674 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
675 GHC.Types.LT ->
676 (#
677 failInp,
678 failExp
679 #)
680 GHC.Types.EQ ->
681 (#
682 farInp,
683 failExp GHC.Base.<> farExp
684 #)
685 GHC.Types.GT ->
686 (#
687 farInp,
688 farExp
689 #)
690 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
691 in if end
692 then noMoreInput
693 else
694 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
695 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
696 ( \newInput ->
697 if Symantic.Parser.Machine.Input.nullInput newInput
698 then noMoreInput
699 else partialCont (append buf newInput)
700 )
701 )
702 in partialCont buf
703 else
704 let _ = "choicesBranch.else"
705 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
706 in let _ = "pushValue"
707 in let _ = "comment: satisfy Parsers.Nandlang.nandStringLetter"
708 in let _ = "checkHorizon.oldCheck: checkedHorizon=4"
709 in let _ = "checkToken"
710 in let !(#
711 c,
712 cs
713 #) = readNext buf cs
714 in if Parsers.Nandlang.nandStringLetter c
715 then
716 let _ = "lift2Value checkedHorizon=3"
717 in name
718 ( let _ = "onReturn"
719 in \farInp farExp v (!inp) buf end ->
720 let _ = "lift2Value checkedHorizon=0"
721 in let _ = "commit"
722 in let _ = "resume"
723 in join
724 farInp
725 farExp
726 ( let _ = "resume.genCode"
727 in v
728 )
729 inp
730 buf
731 end
732 )
733 cs
734 buf
735 end
736 Data.Map.Internal.Tip
737 else
738 let _ = "checkToken.fail"
739 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
740 else
741 let _ = "checkToken.fail"
742 in let failExp =
743 Data.Set.Internal.Bin
744 1
745 ( Symantic.Parser.Grammar.Combinators.SomeFailure
746 ( case inputToken of
747 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '\''
748 )
749 )
750 Data.Set.Internal.Tip
751 Data.Set.Internal.Tip
752 in let (#
753 farInp,
754 farExp
755 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
756 GHC.Types.LT ->
757 (#
758 failInp,
759 failExp
760 #)
761 GHC.Types.EQ ->
762 (#
763 farInp,
764 failExp GHC.Base.<> farExp
765 #)
766 GHC.Types.GT ->
767 (#
768 farInp,
769 farExp
770 #)
771 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
772 else
773 let _ = "checkHorizon.newCheck.fail"
774 in let noMoreInput =
775 let failExp =
776 Data.Set.Internal.Bin
777 1
778 ( Symantic.Parser.Grammar.Combinators.SomeFailure
779 ( case inputToken of
780 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
781 )
782 )
783 Data.Set.Internal.Tip
784 Data.Set.Internal.Tip
785 in let (#
786 farInp,
787 farExp
788 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
789 GHC.Types.LT ->
790 (#
791 failInp,
792 failExp
793 #)
794 GHC.Types.EQ ->
795 (#
796 farInp,
797 failExp GHC.Base.<> farExp
798 #)
799 GHC.Types.GT ->
800 (#
801 farInp,
802 farExp
803 #)
804 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
805 in if end
806 then noMoreInput
807 else
808 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
809 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
810 ( \newInput ->
811 if Symantic.Parser.Machine.Input.nullInput newInput
812 then noMoreInput
813 else partialCont (append buf newInput)
814 )
815 )
816 in partialCont buf
817 else
818 let _ = "choicesBranch.else"
819 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
820 in let _ = "pushValue"
821 in let join = \farInp farExp v (!inp) buf end ->
822 let _ = "lift2Value checkedHorizon=0"
823 in name
824 ( let _ = "onReturn"
825 in \farInp farExp v (!inp) buf end ->
826 let _ = "lift2Value checkedHorizon=0"
827 in let _ = "commit"
828 in let _ = "resume"
829 in callerOnReturn
830 farInp
831 farExp
832 ( let _ = "resume.genCode"
833 in v
834 )
835 inp
836 buf
837 end
838 )
839 inp
840 buf
841 end
842 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
843 in let _ = "catch ExceptionFailure checkedHorizon=0"
844 in let onException =
845 let _ = "onException"
846 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
847 let _ = "comment: raiseAgainIfConsumed"
848 in let _ = "saveInput checkedHorizon=0"
849 in let _ = "lift2Value checkedHorizon=0"
850 in if (GHC.Classes.==) @GHC.Types.Int callerInput failInp
851 then
852 let _ = "choicesBranch checkedHorizon=0"
853 in let _ = "pushValue"
854 in let _ = "comment: satisfy ((GHC.Classes.==) '1')"
855 in let partialCont buf =
856 let readFail = onException
857 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
858 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 failInp)
859 then
860 let _ = "checkToken"
861 in let !(#
862 c,
863 cs
864 #) = readNext buf failInp
865 in if (GHC.Classes.==) '1' c
866 then
867 let _ = "lift2Value checkedHorizon=2"
868 in let _ = "resume"
869 in join
870 farInp
871 farExp
872 ( let _ = "resume.genCode"
873 in '1'
874 )
875 cs
876 buf
877 end
878 else
879 let _ = "checkToken.fail"
880 in let failExp =
881 Data.Set.Internal.Bin
882 1
883 ( Symantic.Parser.Grammar.Combinators.SomeFailure
884 ( case inputToken of
885 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '1'
886 )
887 )
888 Data.Set.Internal.Tip
889 Data.Set.Internal.Tip
890 in let (#
891 farInp,
892 farExp
893 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
894 GHC.Types.LT ->
895 (#
896 failInp,
897 failExp
898 #)
899 GHC.Types.EQ ->
900 (#
901 farInp,
902 failExp GHC.Base.<> farExp
903 #)
904 GHC.Types.GT ->
905 (#
906 farInp,
907 farExp
908 #)
909 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
910 else
911 let _ = "checkHorizon.newCheck.fail"
912 in let noMoreInput =
913 let failExp =
914 Data.Set.Internal.Bin
915 1
916 ( Symantic.Parser.Grammar.Combinators.SomeFailure
917 ( case inputToken of
918 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
919 )
920 )
921 Data.Set.Internal.Tip
922 Data.Set.Internal.Tip
923 in let (#
924 farInp,
925 farExp
926 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
927 GHC.Types.LT ->
928 (#
929 failInp,
930 failExp
931 #)
932 GHC.Types.EQ ->
933 (#
934 farInp,
935 failExp GHC.Base.<> farExp
936 #)
937 GHC.Types.GT ->
938 (#
939 farInp,
940 farExp
941 #)
942 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
943 in if end
944 then noMoreInput
945 else
946 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
947 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
948 ( \newInput ->
949 if Symantic.Parser.Machine.Input.nullInput newInput
950 then noMoreInput
951 else partialCont (append buf newInput)
952 )
953 )
954 in partialCont buf
955 else
956 let _ = "choicesBranch.else"
957 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
958 in let _ = "pushValue"
959 in let _ = "comment: satisfy ((GHC.Classes.==) '0')"
960 in let partialCont buf =
961 let readFail = onException
962 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
963 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
964 then
965 let _ = "checkToken"
966 in let !(#
967 c,
968 cs
969 #) = readNext buf callerInput
970 in if (GHC.Classes.==) '0' c
971 then
972 let _ = "lift2Value checkedHorizon=2"
973 in let _ = "commit"
974 in let _ = "resume"
975 in join
976 initPos
977 Data.Set.Internal.empty
978 ( let _ = "resume.genCode"
979 in '0'
980 )
981 cs
982 buf
983 callerEnd
984 else
985 let _ = "checkToken.fail"
986 in let failExp =
987 Data.Set.Internal.Bin
988 1
989 ( Symantic.Parser.Grammar.Combinators.SomeFailure
990 ( case inputToken of
991 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '0'
992 )
993 )
994 Data.Set.Internal.Tip
995 Data.Set.Internal.Tip
996 in let (#
997 farInp,
998 farExp
999 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1000 GHC.Types.LT ->
1001 (#
1002 callerInput,
1003 failExp
1004 #)
1005 GHC.Types.EQ ->
1006 (#
1007 initPos,
1008 failExp GHC.Base.<> Data.Set.Internal.empty
1009 #)
1010 GHC.Types.GT ->
1011 (#
1012 initPos,
1013 Data.Set.Internal.empty
1014 #)
1015 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
1016 else
1017 let _ = "checkHorizon.newCheck.fail"
1018 in let noMoreInput =
1019 let failExp =
1020 Data.Set.Internal.Bin
1021 1
1022 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1023 ( case inputToken of
1024 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
1025 )
1026 )
1027 Data.Set.Internal.Tip
1028 Data.Set.Internal.Tip
1029 in let (#
1030 farInp,
1031 farExp
1032 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1033 GHC.Types.LT ->
1034 (#
1035 callerInput,
1036 failExp
1037 #)
1038 GHC.Types.EQ ->
1039 (#
1040 initPos,
1041 failExp GHC.Base.<> Data.Set.Internal.empty
1042 #)
1043 GHC.Types.GT ->
1044 (#
1045 initPos,
1046 Data.Set.Internal.empty
1047 #)
1048 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
1049 in if callerEnd
1050 then noMoreInput
1051 else
1052 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
1053 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
1054 ( \newInput ->
1055 if Symantic.Parser.Machine.Input.nullInput newInput
1056 then noMoreInput
1057 else partialCont (append buf newInput)
1058 )
1059 )
1060 in partialCont callerBuffer
1061 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1062 let _ = "catch ExceptionFailure checkedHorizon=0"
1063 in let onException =
1064 let _ = "onException"
1065 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1066 let _ = "comment: raiseAgainIfConsumed"
1067 in let _ = "saveInput checkedHorizon=0"
1068 in let _ = "lift2Value checkedHorizon=0"
1069 in if (GHC.Classes.==) @GHC.Types.Int callerInput failInp
1070 then
1071 let _ = "choicesBranch checkedHorizon=0"
1072 in let _ = "jump"
1073 in name callerOnReturn failInp buf end Data.Map.Internal.Tip
1074 else
1075 let _ = "choicesBranch.else"
1076 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
1077 in let _ = "pushValue"
1078 in name
1079 ( let _ = "onReturn"
1080 in \farInp farExp v (!inp) buf end ->
1081 let _ = "lift2Value checkedHorizon=0"
1082 in let _ = "pushValue"
1083 in do
1084 let dupv = \u -> u
1085 reg <- GHC.STRef.newSTRef dupv
1086 let _ = "iter"
1087 in let onException loopInput =
1088 let _ = "onException"
1089 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1090 let _ = "comment: raiseAgainIfConsumed"
1091 in let _ = "saveInput checkedHorizon=0"
1092 in let _ = "lift2Value checkedHorizon=0"
1093 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
1094 then
1095 let _ = "choicesBranch checkedHorizon=0"
1096 in do
1097 sr <- GHC.STRef.readSTRef reg
1098 name
1099 ( let _ = "onReturn"
1100 in \farInp farExp v (!inp) buf end ->
1101 let _ = "lift2Value checkedHorizon=0"
1102 in let _ = "lift2Value checkedHorizon=0"
1103 in name
1104 ( let _ = "onReturn"
1105 in \farInp farExp v (!inp) buf end ->
1106 let _ = "lift2Value checkedHorizon=0"
1107 in let _ = "commit"
1108 in let _ = "resume"
1109 in callerOnReturn
1110 farInp
1111 farExp
1112 ( let _ = "resume.genCode"
1113 in GHC.Tuple . ()
1114 )
1115 inp
1116 buf
1117 end
1118 )
1119 inp
1120 buf
1121 end
1122 Data.Map.Internal.Tip
1123 )
1124 failInp
1125 buf
1126 end
1127 Data.Map.Internal.Tip
1128 else
1129 let _ = "choicesBranch.else"
1130 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
1131 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
1132 let _ = "pushValue"
1133 in name
1134 ( let _ = "onReturn"
1135 in \farInp farExp v (!inp) buf end ->
1136 let _ = "lift2Value checkedHorizon=0"
1137 in name
1138 ( let _ = "onReturn"
1139 in \farInp farExp v (!inp) buf end ->
1140 let _ = "lift2Value checkedHorizon=0"
1141 in name
1142 ( let _ = "onReturn"
1143 in \farInp farExp v (!inp) buf end ->
1144 let _ = "lift2Value checkedHorizon=0"
1145 in do
1146 sr <- GHC.STRef.readSTRef reg
1147 let _ = "lift2Value checkedHorizon=0"
1148 in do
1149 let dupv = v v sr
1150 GHC.STRef.writeSTRef reg dupv
1151 let _ = "jump"
1152 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1153 )
1154 inp
1155 buf
1156 end
1157 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1158 )
1159 inp
1160 buf
1161 end
1162 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1163 )
1164 callerInput
1165 callerBuffer
1166 callerEnded
1167 Data.Map.Internal.Tip
1168 in let _ = "jump"
1169 in loop callerOnReturn inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
1170 )
1171 callerInput
1172 callerBuffer
1173 callerEnd
1174 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
1175 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1176 let _ = "comment: satisfy (\\t_0 -> ('0' GHC.Classes.== t_0) GHC.Classes.|| (('1' GHC.Classes.== t_0) GHC.Classes.|| (('2' GHC.Classes.== t_0) GHC.Classes.|| (('3' GHC.Classes.== t_0) GHC.Classes.|| (('4' GHC.Classes.== t_0) GHC.Classes.|| (('5' GHC.Classes.== t_0) GHC.Classes.|| (('6' GHC.Classes.== t_0) GHC.Classes.|| (('7' GHC.Classes.== t_0) GHC.Classes.|| (('8' GHC.Classes.== t_0) GHC.Classes.|| (('9' GHC.Classes.== t_0) GHC.Classes.|| GHC.Types.False))))))))))"
1177 in let partialCont buf =
1178 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
1179 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
1180 in if readMore buf callerInput
1181 then
1182 let _ = "checkToken"
1183 in let !(#
1184 c,
1185 cs
1186 #) = readNext buf callerInput
1187 in if (\t -> ('0' GHC.Classes.== t) GHC.Classes.|| (('1' GHC.Classes.== t) GHC.Classes.|| (('2' GHC.Classes.== t) GHC.Classes.|| (('3' GHC.Classes.== t) GHC.Classes.|| (('4' GHC.Classes.== t) GHC.Classes.|| (('5' GHC.Classes.== t) GHC.Classes.|| (('6' GHC.Classes.== t) GHC.Classes.|| (('7' GHC.Classes.== t) GHC.Classes.|| (('8' GHC.Classes.== t) GHC.Classes.|| (('9' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))))))))) c
1188 then
1189 let _ = "resume"
1190 in callerOnReturn
1191 initPos
1192 Data.Set.Internal.empty
1193 ( let _ = "resume.genCode"
1194 in c
1195 )
1196 cs
1197 buf
1198 callerEnd
1199 else
1200 let _ = "checkToken.fail"
1201 in let failExp =
1202 Data.Set.Internal.Bin
1203 10
1204 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1205 ( case inputToken of
1206 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '3'
1207 )
1208 )
1209 ( Data.Set.Internal.Bin
1210 3
1211 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1212 ( case inputToken of
1213 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '1'
1214 )
1215 )
1216 ( Data.Set.Internal.Bin
1217 1
1218 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1219 ( case inputToken of
1220 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '0'
1221 )
1222 )
1223 Data.Set.Internal.Tip
1224 Data.Set.Internal.Tip
1225 )
1226 ( Data.Set.Internal.Bin
1227 1
1228 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1229 ( case inputToken of
1230 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '2'
1231 )
1232 )
1233 Data.Set.Internal.Tip
1234 Data.Set.Internal.Tip
1235 )
1236 )
1237 ( Data.Set.Internal.Bin
1238 6
1239 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1240 ( case inputToken of
1241 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '7'
1242 )
1243 )
1244 ( Data.Set.Internal.Bin
1245 3
1246 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1247 ( case inputToken of
1248 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '5'
1249 )
1250 )
1251 ( Data.Set.Internal.Bin
1252 1
1253 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1254 ( case inputToken of
1255 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '4'
1256 )
1257 )
1258 Data.Set.Internal.Tip
1259 Data.Set.Internal.Tip
1260 )
1261 ( Data.Set.Internal.Bin
1262 1
1263 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1264 ( case inputToken of
1265 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '6'
1266 )
1267 )
1268 Data.Set.Internal.Tip
1269 Data.Set.Internal.Tip
1270 )
1271 )
1272 ( Data.Set.Internal.Bin
1273 2
1274 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1275 ( case inputToken of
1276 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '8'
1277 )
1278 )
1279 Data.Set.Internal.Tip
1280 ( Data.Set.Internal.Bin
1281 1
1282 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1283 ( case inputToken of
1284 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '9'
1285 )
1286 )
1287 Data.Set.Internal.Tip
1288 Data.Set.Internal.Tip
1289 )
1290 )
1291 )
1292 in let (#
1293 farInp,
1294 farExp
1295 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1296 GHC.Types.LT ->
1297 (#
1298 callerInput,
1299 failExp
1300 #)
1301 GHC.Types.EQ ->
1302 (#
1303 initPos,
1304 failExp GHC.Base.<> Data.Set.Internal.empty
1305 #)
1306 GHC.Types.GT ->
1307 (#
1308 initPos,
1309 Data.Set.Internal.empty
1310 #)
1311 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
1312 else
1313 let _ = "checkHorizon.newCheck.fail"
1314 in let noMoreInput =
1315 let failExp =
1316 Data.Set.Internal.Bin
1317 1
1318 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1319 ( case inputToken of
1320 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
1321 )
1322 )
1323 Data.Set.Internal.Tip
1324 Data.Set.Internal.Tip
1325 in let (#
1326 farInp,
1327 farExp
1328 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1329 GHC.Types.LT ->
1330 (#
1331 callerInput,
1332 failExp
1333 #)
1334 GHC.Types.EQ ->
1335 (#
1336 initPos,
1337 failExp GHC.Base.<> Data.Set.Internal.empty
1338 #)
1339 GHC.Types.GT ->
1340 (#
1341 initPos,
1342 Data.Set.Internal.empty
1343 #)
1344 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
1345 in if callerEnd
1346 then noMoreInput
1347 else
1348 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
1349 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
1350 ( \newInput ->
1351 if Symantic.Parser.Machine.Input.nullInput newInput
1352 then noMoreInput
1353 else partialCont (append buf newInput)
1354 )
1355 )
1356 in partialCont callerBuffer
1357 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1358 let _ = "pushValue"
1359 in name
1360 ( let _ = "onReturn"
1361 in \farInp farExp v (!inp) buf end ->
1362 let _ = "lift2Value checkedHorizon=0"
1363 in let join = \farInp farExp v (!inp) buf end ->
1364 let _ = "lift2Value checkedHorizon=0"
1365 in let _ = "resume"
1366 in callerOnReturn
1367 farInp
1368 farExp
1369 ( let _ = "resume.genCode"
1370 in v
1371 )
1372 inp
1373 buf
1374 end
1375 in let _ = "catch ExceptionFailure checkedHorizon=0"
1376 in let onException =
1377 let _ = "onException"
1378 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1379 let _ = "comment: raiseAgainIfConsumed"
1380 in let _ = "saveInput checkedHorizon=0"
1381 in let _ = "lift2Value checkedHorizon=0"
1382 in if (GHC.Classes.==) @GHC.Types.Int inp failInp
1383 then
1384 let _ = "choicesBranch checkedHorizon=0"
1385 in name
1386 ( let _ = "onReturn"
1387 in \farInp farExp v (!inp) buf end ->
1388 let _ = "resume"
1389 in join
1390 farInp
1391 farExp
1392 ( let _ = "resume.genCode"
1393 in v
1394 )
1395 inp
1396 buf
1397 end
1398 )
1399 failInp
1400 buf
1401 end
1402 Data.Map.Internal.Tip
1403 else
1404 let _ = "choicesBranch.else"
1405 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
1406 in let _ = "pushValue"
1407 in name
1408 ( let _ = "onReturn"
1409 in \farInp farExp v (!inp) buf end ->
1410 let _ = "lift2Value checkedHorizon=0"
1411 in let _ = "commit"
1412 in let _ = "resume"
1413 in join
1414 farInp
1415 farExp
1416 ( let _ = "resume.genCode"
1417 in GHC.Tuple . ()
1418 )
1419 inp
1420 buf
1421 end
1422 )
1423 inp
1424 buf
1425 end
1426 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
1427 )
1428 callerInput
1429 callerBuffer
1430 callerEnd
1431 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1432 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1433 let _ = "pushValue"
1434 in name
1435 ( let _ = "onReturn"
1436 in \farInp farExp v (!inp) buf end ->
1437 let _ = "lift2Value checkedHorizon=0"
1438 in let _ = "pushValue"
1439 in do
1440 let dupv = \u -> u
1441 reg <- GHC.STRef.newSTRef dupv
1442 let _ = "iter"
1443 in let onException loopInput =
1444 let _ = "onException"
1445 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1446 let _ = "comment: raiseAgainIfConsumed"
1447 in let _ = "saveInput checkedHorizon=0"
1448 in let _ = "lift2Value checkedHorizon=0"
1449 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
1450 then
1451 let _ = "choicesBranch checkedHorizon=0"
1452 in do
1453 sr <- GHC.STRef.readSTRef reg
1454 name
1455 ( let _ = "onReturn"
1456 in \farInp farExp v (!inp) buf end ->
1457 let _ = "lift2Value checkedHorizon=0"
1458 in let _ = "lift2Value checkedHorizon=0"
1459 in name
1460 ( let _ = "onReturn"
1461 in \farInp farExp v (!inp) buf end ->
1462 let _ = "lift2Value checkedHorizon=0"
1463 in let _ = "resume"
1464 in callerOnReturn
1465 farInp
1466 farExp
1467 ( let _ = "resume.genCode"
1468 in v
1469 )
1470 inp
1471 buf
1472 end
1473 )
1474 inp
1475 buf
1476 end
1477 Data.Map.Internal.Tip
1478 )
1479 failInp
1480 buf
1481 end
1482 Data.Map.Internal.Tip
1483 else
1484 let _ = "choicesBranch.else"
1485 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
1486 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
1487 let _ = "pushValue"
1488 in let _ = "comment: satisfy ((GHC.Classes.==) '!')"
1489 in let partialCont buf =
1490 let readFail = onException callerInput
1491 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=4"
1492 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 3 callerInput)
1493 then
1494 let _ = "checkToken"
1495 in let !(#
1496 c,
1497 cs
1498 #) = readNext buf callerInput
1499 in if (GHC.Classes.==) '!' c
1500 then
1501 let _ = "lift2Value checkedHorizon=4"
1502 in name
1503 ( let _ = "onReturn"
1504 in \farInp farExp v (!inp) buf end ->
1505 let _ = "lift2Value checkedHorizon=0"
1506 in name
1507 ( let _ = "onReturn"
1508 in \farInp farExp v (!inp) buf end ->
1509 let _ = "lift2Value checkedHorizon=0"
1510 in do
1511 sr <- GHC.STRef.readSTRef reg
1512 let _ = "lift2Value checkedHorizon=0"
1513 in do
1514 let dupv = sr
1515 GHC.STRef.writeSTRef reg dupv
1516 let _ = "jump"
1517 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
1518 )
1519 inp
1520 buf
1521 end
1522 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
1523 )
1524 cs
1525 buf
1526 callerEnded
1527 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
1528 else
1529 let _ = "checkToken.fail"
1530 in let failExp =
1531 Data.Set.Internal.Bin
1532 1
1533 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1534 ( case inputToken of
1535 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '!'
1536 )
1537 )
1538 Data.Set.Internal.Tip
1539 Data.Set.Internal.Tip
1540 in let (#
1541 farInp,
1542 farExp
1543 #) = case GHC.Classes.compare @GHC.Types.Int farInp callerInput of
1544 GHC.Types.LT ->
1545 (#
1546 callerInput,
1547 failExp
1548 #)
1549 GHC.Types.EQ ->
1550 (#
1551 farInp,
1552 failExp GHC.Base.<> farExp
1553 #)
1554 GHC.Types.GT ->
1555 (#
1556 farInp,
1557 farExp
1558 #)
1559 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnded
1560 else
1561 let _ = "checkHorizon.newCheck.fail"
1562 in let noMoreInput =
1563 let failExp =
1564 Data.Set.Internal.Bin
1565 1
1566 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1567 ( case inputToken of
1568 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
1569 )
1570 )
1571 Data.Set.Internal.Tip
1572 Data.Set.Internal.Tip
1573 in let (#
1574 farInp,
1575 farExp
1576 #) = case GHC.Classes.compare @GHC.Types.Int farInp callerInput of
1577 GHC.Types.LT ->
1578 (#
1579 callerInput,
1580 failExp
1581 #)
1582 GHC.Types.EQ ->
1583 (#
1584 farInp,
1585 failExp GHC.Base.<> farExp
1586 #)
1587 GHC.Types.GT ->
1588 (#
1589 farInp,
1590 farExp
1591 #)
1592 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
1593 in if callerEnded
1594 then noMoreInput
1595 else
1596 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
1597 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
1598 ( \newInput ->
1599 if Symantic.Parser.Machine.Input.nullInput newInput
1600 then noMoreInput
1601 else partialCont (append buf newInput)
1602 )
1603 )
1604 in partialCont callerBuffer
1605 in let _ = "jump"
1606 in loop callerOnReturn inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1607 )
1608 callerInput
1609 callerBuffer
1610 callerEnd
1611 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1612 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1613 let _ = "pushValue"
1614 in name
1615 ( let _ = "onReturn"
1616 in \farInp farExp v (!inp) buf end ->
1617 let _ = "lift2Value checkedHorizon=0"
1618 in let _ = "pushValue"
1619 in do
1620 let dupv = \u -> u
1621 reg <- GHC.STRef.newSTRef dupv
1622 let _ = "iter"
1623 in let onException loopInput =
1624 let _ = "onException"
1625 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1626 let _ = "comment: raiseAgainIfConsumed"
1627 in let _ = "saveInput checkedHorizon=0"
1628 in let _ = "lift2Value checkedHorizon=0"
1629 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
1630 then
1631 let _ = "choicesBranch checkedHorizon=0"
1632 in do
1633 sr <- GHC.STRef.readSTRef reg
1634 let _ = "pushValue"
1635 in let _ = "lift2Value checkedHorizon=0"
1636 in let _ = "lift2Value checkedHorizon=0"
1637 in let _ = "resume"
1638 in callerOnReturn
1639 farInp
1640 farExp
1641 ( let _ = "resume.genCode"
1642 in GHC.Tuple . ()
1643 )
1644 failInp
1645 buf
1646 end
1647 else
1648 let _ = "choicesBranch.else"
1649 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
1650 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
1651 let _ = "pushValue"
1652 in name
1653 ( let _ = "onReturn"
1654 in \farInp farExp v (!inp) buf end ->
1655 let _ = "lift2Value checkedHorizon=0"
1656 in do
1657 sr <- GHC.STRef.readSTRef reg
1658 let _ = "lift2Value checkedHorizon=0"
1659 in do
1660 let dupv = sr
1661 GHC.STRef.writeSTRef reg dupv
1662 let _ = "jump"
1663 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1664 )
1665 callerInput
1666 callerBuffer
1667 callerEnded
1668 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1669 in let _ = "jump"
1670 in loop callerOnReturn inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1671 )
1672 callerInput
1673 callerBuffer
1674 callerEnd
1675 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1676 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1677 let _ = "pushValue"
1678 in let _ = "catch ExceptionFailure checkedHorizon=0"
1679 in let onException =
1680 let _ = "onException"
1681 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1682 let _ = "loadInput checkedHorizon=0"
1683 in let _ = "checkHorizon.noCheck"
1684 in Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf end
1685 in let _ = "pushValue"
1686 in let _ = "comment: satisfy Parsers.Nandlang.nandIdentStart"
1687 in let partialCont buf =
1688 let readFail = onException
1689 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
1690 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
1691 then
1692 let _ = "checkToken"
1693 in let !(#
1694 c,
1695 cs
1696 #) = readNext buf callerInput
1697 in if Parsers.Nandlang.nandIdentStart c
1698 then
1699 let _ = "lift2Value checkedHorizon=2"
1700 in let _ = "pushValue"
1701 in do
1702 let dupv = \u -> u
1703 reg <- GHC.STRef.newSTRef dupv
1704 let _ = "iter"
1705 in let onException loopInput =
1706 let _ = "onException"
1707 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
1708 let _ = "comment: raiseAgainIfConsumed"
1709 in let _ = "saveInput checkedHorizon=0"
1710 in let _ = "lift2Value checkedHorizon=0"
1711 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
1712 then
1713 let _ = "choicesBranch checkedHorizon=0"
1714 in do
1715 sr <- GHC.STRef.readSTRef reg
1716 name
1717 ( let _ = "onReturn"
1718 in \farInp farExp v (!inp) buf end ->
1719 let _ = "lift2Value checkedHorizon=0"
1720 in let _ = "lift2Value checkedHorizon=0"
1721 in let _ = "commit"
1722 in let _ = "lift2Value checkedHorizon=0"
1723 in name
1724 ( let _ = "onReturn"
1725 in \farInp farExp v (!inp) buf end ->
1726 let _ = "lift2Value checkedHorizon=0"
1727 in let _ = "resume"
1728 in callerOnReturn
1729 farInp
1730 farExp
1731 ( let _ = "resume.genCode"
1732 in v
1733 )
1734 inp
1735 buf
1736 end
1737 )
1738 inp
1739 buf
1740 end
1741 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel) Data.Map.Internal.Tip Data.Map.Internal.Tip)
1742 )
1743 failInp
1744 buf
1745 end
1746 Data.Map.Internal.Tip
1747 else
1748 let _ = "choicesBranch.else"
1749 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
1750 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
1751 let _ = "pushValue"
1752 in let _ = "comment: satisfy Parsers.Nandlang.nandIdentLetter"
1753 in let partialCont buf =
1754 let readFail = onException callerInput
1755 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
1756 in if readMore buf callerInput
1757 then
1758 let _ = "checkToken"
1759 in let !(#
1760 c,
1761 cs
1762 #) = readNext buf callerInput
1763 in if Parsers.Nandlang.nandIdentLetter c
1764 then
1765 let _ = "lift2Value checkedHorizon=1"
1766 in do
1767 sr <- GHC.STRef.readSTRef reg
1768 let _ = "lift2Value checkedHorizon=1"
1769 in do
1770 let dupv = sr
1771 GHC.STRef.writeSTRef reg dupv
1772 let _ = "jump"
1773 in loop (GHC.Err.error "invalid onReturn") cs buf callerEnded (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
1774 else
1775 let _ = "checkToken.fail"
1776 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput initPos Data.Set.Internal.empty buf callerEnded
1777 else
1778 let _ = "checkHorizon.newCheck.fail"
1779 in let noMoreInput =
1780 let failExp =
1781 Data.Set.Internal.Bin
1782 1
1783 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1784 ( case inputToken of
1785 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
1786 )
1787 )
1788 Data.Set.Internal.Tip
1789 Data.Set.Internal.Tip
1790 in let (#
1791 farInp,
1792 farExp
1793 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1794 GHC.Types.LT ->
1795 (#
1796 callerInput,
1797 failExp
1798 #)
1799 GHC.Types.EQ ->
1800 (#
1801 initPos,
1802 failExp GHC.Base.<> Data.Set.Internal.empty
1803 #)
1804 GHC.Types.GT ->
1805 (#
1806 initPos,
1807 Data.Set.Internal.empty
1808 #)
1809 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
1810 in if callerEnded
1811 then noMoreInput
1812 else
1813 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
1814 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
1815 ( \newInput ->
1816 if Symantic.Parser.Machine.Input.nullInput newInput
1817 then noMoreInput
1818 else partialCont (append buf newInput)
1819 )
1820 )
1821 in partialCont callerBuffer
1822 in let _ = "jump"
1823 in loop callerOnReturn cs buf callerEnd (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
1824 else
1825 let _ = "checkToken.fail"
1826 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput initPos Data.Set.Internal.empty buf callerEnd
1827 else
1828 let _ = "checkHorizon.newCheck.fail"
1829 in let noMoreInput =
1830 let failExp =
1831 Data.Set.Internal.Bin
1832 1
1833 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1834 ( case inputToken of
1835 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
1836 )
1837 )
1838 Data.Set.Internal.Tip
1839 Data.Set.Internal.Tip
1840 in let (#
1841 farInp,
1842 farExp
1843 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1844 GHC.Types.LT ->
1845 (#
1846 callerInput,
1847 failExp
1848 #)
1849 GHC.Types.EQ ->
1850 (#
1851 initPos,
1852 failExp GHC.Base.<> Data.Set.Internal.empty
1853 #)
1854 GHC.Types.GT ->
1855 (#
1856 initPos,
1857 Data.Set.Internal.empty
1858 #)
1859 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
1860 in if callerEnd
1861 then noMoreInput
1862 else
1863 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
1864 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
1865 ( \newInput ->
1866 if Symantic.Parser.Machine.Input.nullInput newInput
1867 then noMoreInput
1868 else partialCont (append buf newInput)
1869 )
1870 )
1871 in partialCont callerBuffer
1872 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1873 let _ = "pushValue"
1874 in let _ = "comment: satisfy ((GHC.Classes.==) '(')"
1875 in let partialCont buf =
1876 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
1877 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
1878 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
1879 then
1880 let _ = "checkToken"
1881 in let !(#
1882 c,
1883 cs
1884 #) = readNext buf callerInput
1885 in if (GHC.Classes.==) '(' c
1886 then
1887 let _ = "lift2Value checkedHorizon=2"
1888 in name
1889 ( let _ = "onReturn"
1890 in \farInp farExp v (!inp) buf end ->
1891 let _ = "lift2Value checkedHorizon=0"
1892 in let _ = "resume"
1893 in callerOnReturn
1894 farInp
1895 farExp
1896 ( let _ = "resume.genCode"
1897 in '('
1898 )
1899 inp
1900 buf
1901 end
1902 )
1903 cs
1904 buf
1905 callerEnd
1906 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
1907 else
1908 let _ = "checkToken.fail"
1909 in let failExp =
1910 Data.Set.Internal.Bin
1911 1
1912 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1913 ( case inputToken of
1914 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '('
1915 )
1916 )
1917 Data.Set.Internal.Tip
1918 Data.Set.Internal.Tip
1919 in let (#
1920 farInp,
1921 farExp
1922 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1923 GHC.Types.LT ->
1924 (#
1925 callerInput,
1926 failExp
1927 #)
1928 GHC.Types.EQ ->
1929 (#
1930 initPos,
1931 failExp GHC.Base.<> Data.Set.Internal.empty
1932 #)
1933 GHC.Types.GT ->
1934 (#
1935 initPos,
1936 Data.Set.Internal.empty
1937 #)
1938 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
1939 else
1940 let _ = "checkHorizon.newCheck.fail"
1941 in let noMoreInput =
1942 let failExp =
1943 Data.Set.Internal.Bin
1944 1
1945 ( Symantic.Parser.Grammar.Combinators.SomeFailure
1946 ( case inputToken of
1947 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
1948 )
1949 )
1950 Data.Set.Internal.Tip
1951 Data.Set.Internal.Tip
1952 in let (#
1953 farInp,
1954 farExp
1955 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
1956 GHC.Types.LT ->
1957 (#
1958 callerInput,
1959 failExp
1960 #)
1961 GHC.Types.EQ ->
1962 (#
1963 initPos,
1964 failExp GHC.Base.<> Data.Set.Internal.empty
1965 #)
1966 GHC.Types.GT ->
1967 (#
1968 initPos,
1969 Data.Set.Internal.empty
1970 #)
1971 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
1972 in if callerEnd
1973 then noMoreInput
1974 else
1975 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
1976 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
1977 ( \newInput ->
1978 if Symantic.Parser.Machine.Input.nullInput newInput
1979 then noMoreInput
1980 else partialCont (append buf newInput)
1981 )
1982 )
1983 in partialCont callerBuffer
1984 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
1985 let _ = "pushValue"
1986 in let _ = "comment: satisfy ((GHC.Classes.==) ')')"
1987 in let partialCont buf =
1988 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
1989 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
1990 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
1991 then
1992 let _ = "checkToken"
1993 in let !(#
1994 c,
1995 cs
1996 #) = readNext buf callerInput
1997 in if (GHC.Classes.==) ')' c
1998 then
1999 let _ = "lift2Value checkedHorizon=2"
2000 in name
2001 ( let _ = "onReturn"
2002 in \farInp farExp v (!inp) buf end ->
2003 let _ = "lift2Value checkedHorizon=0"
2004 in let _ = "resume"
2005 in callerOnReturn
2006 farInp
2007 farExp
2008 ( let _ = "resume.genCode"
2009 in ')'
2010 )
2011 inp
2012 buf
2013 end
2014 )
2015 cs
2016 buf
2017 callerEnd
2018 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2019 else
2020 let _ = "checkToken.fail"
2021 in let failExp =
2022 Data.Set.Internal.Bin
2023 1
2024 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2025 ( case inputToken of
2026 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ')'
2027 )
2028 )
2029 Data.Set.Internal.Tip
2030 Data.Set.Internal.Tip
2031 in let (#
2032 farInp,
2033 farExp
2034 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2035 GHC.Types.LT ->
2036 (#
2037 callerInput,
2038 failExp
2039 #)
2040 GHC.Types.EQ ->
2041 (#
2042 initPos,
2043 failExp GHC.Base.<> Data.Set.Internal.empty
2044 #)
2045 GHC.Types.GT ->
2046 (#
2047 initPos,
2048 Data.Set.Internal.empty
2049 #)
2050 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
2051 else
2052 let _ = "checkHorizon.newCheck.fail"
2053 in let noMoreInput =
2054 let failExp =
2055 Data.Set.Internal.Bin
2056 1
2057 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2058 ( case inputToken of
2059 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
2060 )
2061 )
2062 Data.Set.Internal.Tip
2063 Data.Set.Internal.Tip
2064 in let (#
2065 farInp,
2066 farExp
2067 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2068 GHC.Types.LT ->
2069 (#
2070 callerInput,
2071 failExp
2072 #)
2073 GHC.Types.EQ ->
2074 (#
2075 initPos,
2076 failExp GHC.Base.<> Data.Set.Internal.empty
2077 #)
2078 GHC.Types.GT ->
2079 (#
2080 initPos,
2081 Data.Set.Internal.empty
2082 #)
2083 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
2084 in if callerEnd
2085 then noMoreInput
2086 else
2087 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
2088 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
2089 ( \newInput ->
2090 if Symantic.Parser.Machine.Input.nullInput newInput
2091 then noMoreInput
2092 else partialCont (append buf newInput)
2093 )
2094 )
2095 in partialCont callerBuffer
2096 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
2097 let _ = "pushValue"
2098 in let _ = "comment: satisfy ((GHC.Classes.==) ',')"
2099 in let partialCont buf =
2100 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
2101 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
2102 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
2103 then
2104 let _ = "checkToken"
2105 in let !(#
2106 c,
2107 cs
2108 #) = readNext buf callerInput
2109 in if (GHC.Classes.==) ',' c
2110 then
2111 let _ = "lift2Value checkedHorizon=2"
2112 in name
2113 ( let _ = "onReturn"
2114 in \farInp farExp v (!inp) buf end ->
2115 let _ = "lift2Value checkedHorizon=0"
2116 in let _ = "resume"
2117 in callerOnReturn
2118 farInp
2119 farExp
2120 ( let _ = "resume.genCode"
2121 in ','
2122 )
2123 inp
2124 buf
2125 end
2126 )
2127 cs
2128 buf
2129 callerEnd
2130 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2131 else
2132 let _ = "checkToken.fail"
2133 in let failExp =
2134 Data.Set.Internal.Bin
2135 1
2136 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2137 ( case inputToken of
2138 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ','
2139 )
2140 )
2141 Data.Set.Internal.Tip
2142 Data.Set.Internal.Tip
2143 in let (#
2144 farInp,
2145 farExp
2146 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2147 GHC.Types.LT ->
2148 (#
2149 callerInput,
2150 failExp
2151 #)
2152 GHC.Types.EQ ->
2153 (#
2154 initPos,
2155 failExp GHC.Base.<> Data.Set.Internal.empty
2156 #)
2157 GHC.Types.GT ->
2158 (#
2159 initPos,
2160 Data.Set.Internal.empty
2161 #)
2162 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
2163 else
2164 let _ = "checkHorizon.newCheck.fail"
2165 in let noMoreInput =
2166 let failExp =
2167 Data.Set.Internal.Bin
2168 1
2169 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2170 ( case inputToken of
2171 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
2172 )
2173 )
2174 Data.Set.Internal.Tip
2175 Data.Set.Internal.Tip
2176 in let (#
2177 farInp,
2178 farExp
2179 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2180 GHC.Types.LT ->
2181 (#
2182 callerInput,
2183 failExp
2184 #)
2185 GHC.Types.EQ ->
2186 (#
2187 initPos,
2188 failExp GHC.Base.<> Data.Set.Internal.empty
2189 #)
2190 GHC.Types.GT ->
2191 (#
2192 initPos,
2193 Data.Set.Internal.empty
2194 #)
2195 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
2196 in if callerEnd
2197 then noMoreInput
2198 else
2199 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
2200 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
2201 ( \newInput ->
2202 if Symantic.Parser.Machine.Input.nullInput newInput
2203 then noMoreInput
2204 else partialCont (append buf newInput)
2205 )
2206 )
2207 in partialCont callerBuffer
2208 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
2209 let _ = "pushValue"
2210 in let _ = "comment: satisfy ((GHC.Classes.==) ';')"
2211 in let partialCont buf =
2212 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
2213 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
2214 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
2215 then
2216 let _ = "checkToken"
2217 in let !(#
2218 c,
2219 cs
2220 #) = readNext buf callerInput
2221 in if (GHC.Classes.==) ';' c
2222 then
2223 let _ = "lift2Value checkedHorizon=2"
2224 in name
2225 ( let _ = "onReturn"
2226 in \farInp farExp v (!inp) buf end ->
2227 let _ = "lift2Value checkedHorizon=0"
2228 in let _ = "resume"
2229 in callerOnReturn
2230 farInp
2231 farExp
2232 ( let _ = "resume.genCode"
2233 in ';'
2234 )
2235 inp
2236 buf
2237 end
2238 )
2239 cs
2240 buf
2241 callerEnd
2242 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2243 else
2244 let _ = "checkToken.fail"
2245 in let failExp =
2246 Data.Set.Internal.Bin
2247 1
2248 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2249 ( case inputToken of
2250 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ';'
2251 )
2252 )
2253 Data.Set.Internal.Tip
2254 Data.Set.Internal.Tip
2255 in let (#
2256 farInp,
2257 farExp
2258 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2259 GHC.Types.LT ->
2260 (#
2261 callerInput,
2262 failExp
2263 #)
2264 GHC.Types.EQ ->
2265 (#
2266 initPos,
2267 failExp GHC.Base.<> Data.Set.Internal.empty
2268 #)
2269 GHC.Types.GT ->
2270 (#
2271 initPos,
2272 Data.Set.Internal.empty
2273 #)
2274 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
2275 else
2276 let _ = "checkHorizon.newCheck.fail"
2277 in let noMoreInput =
2278 let failExp =
2279 Data.Set.Internal.Bin
2280 1
2281 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2282 ( case inputToken of
2283 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
2284 )
2285 )
2286 Data.Set.Internal.Tip
2287 Data.Set.Internal.Tip
2288 in let (#
2289 farInp,
2290 farExp
2291 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2292 GHC.Types.LT ->
2293 (#
2294 callerInput,
2295 failExp
2296 #)
2297 GHC.Types.EQ ->
2298 (#
2299 initPos,
2300 failExp GHC.Base.<> Data.Set.Internal.empty
2301 #)
2302 GHC.Types.GT ->
2303 (#
2304 initPos,
2305 Data.Set.Internal.empty
2306 #)
2307 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
2308 in if callerEnd
2309 then noMoreInput
2310 else
2311 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
2312 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
2313 ( \newInput ->
2314 if Symantic.Parser.Machine.Input.nullInput newInput
2315 then noMoreInput
2316 else partialCont (append buf newInput)
2317 )
2318 )
2319 in partialCont callerBuffer
2320 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
2321 let _ = "pushValue"
2322 in let _ = "comment: satisfy ((GHC.Classes.==) '[')"
2323 in let partialCont buf =
2324 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
2325 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=5"
2326 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 4 callerInput)
2327 then
2328 let _ = "checkToken"
2329 in let !(#
2330 c,
2331 cs
2332 #) = readNext buf callerInput
2333 in if (GHC.Classes.==) '[' c
2334 then
2335 let _ = "lift2Value checkedHorizon=5"
2336 in name
2337 ( let _ = "onReturn"
2338 in \farInp farExp v (!inp) buf end ->
2339 let _ = "lift2Value checkedHorizon=0"
2340 in name
2341 ( let _ = "onReturn"
2342 in \farInp farExp v (!inp) buf end ->
2343 let _ = "lift2Value checkedHorizon=0"
2344 in let _ = "pushValue"
2345 in do
2346 let dupv = \u -> u
2347 reg <- GHC.STRef.newSTRef dupv
2348 let _ = "iter"
2349 in let onException loopInput =
2350 let _ = "onException"
2351 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2352 let _ = "comment: raiseAgainIfConsumed"
2353 in let _ = "saveInput checkedHorizon=0"
2354 in let _ = "lift2Value checkedHorizon=0"
2355 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
2356 then
2357 let _ = "choicesBranch checkedHorizon=0"
2358 in do
2359 sr <- GHC.STRef.readSTRef reg
2360 let _ = "pushValue"
2361 in let _ = "lift2Value checkedHorizon=0"
2362 in let _ = "lift2Value checkedHorizon=0"
2363 in let _ = "comment: satisfy ((GHC.Classes.==) ']')"
2364 in let partialCont buf =
2365 let readFail = readFail
2366 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
2367 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 failInp)
2368 then
2369 let _ = "checkToken"
2370 in let !(#
2371 c,
2372 cs
2373 #) = readNext buf failInp
2374 in if (GHC.Classes.==) ']' c
2375 then
2376 let _ = "lift2Value checkedHorizon=2"
2377 in name
2378 ( let _ = "onReturn"
2379 in \farInp farExp v (!inp) buf end ->
2380 let _ = "lift2Value checkedHorizon=0"
2381 in let _ = "resume"
2382 in callerOnReturn
2383 farInp
2384 farExp
2385 ( let _ = "resume.genCode"
2386 in GHC.Tuple . ()
2387 )
2388 inp
2389 buf
2390 end
2391 )
2392 cs
2393 buf
2394 end
2395 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2396 else
2397 let _ = "checkToken.fail"
2398 in let failExp =
2399 Data.Set.Internal.Bin
2400 1
2401 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2402 ( case inputToken of
2403 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ']'
2404 )
2405 )
2406 Data.Set.Internal.Tip
2407 Data.Set.Internal.Tip
2408 in let (#
2409 farInp,
2410 farExp
2411 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
2412 GHC.Types.LT ->
2413 (#
2414 failInp,
2415 failExp
2416 #)
2417 GHC.Types.EQ ->
2418 (#
2419 farInp,
2420 failExp GHC.Base.<> farExp
2421 #)
2422 GHC.Types.GT ->
2423 (#
2424 farInp,
2425 farExp
2426 #)
2427 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
2428 else
2429 let _ = "checkHorizon.newCheck.fail"
2430 in let noMoreInput =
2431 let failExp =
2432 Data.Set.Internal.Bin
2433 1
2434 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2435 ( case inputToken of
2436 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
2437 )
2438 )
2439 Data.Set.Internal.Tip
2440 Data.Set.Internal.Tip
2441 in let (#
2442 farInp,
2443 farExp
2444 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
2445 GHC.Types.LT ->
2446 (#
2447 failInp,
2448 failExp
2449 #)
2450 GHC.Types.EQ ->
2451 (#
2452 farInp,
2453 failExp GHC.Base.<> farExp
2454 #)
2455 GHC.Types.GT ->
2456 (#
2457 farInp,
2458 farExp
2459 #)
2460 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
2461 in if end
2462 then noMoreInput
2463 else
2464 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
2465 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
2466 ( \newInput ->
2467 if Symantic.Parser.Machine.Input.nullInput newInput
2468 then noMoreInput
2469 else partialCont (append buf newInput)
2470 )
2471 )
2472 in partialCont buf
2473 else
2474 let _ = "choicesBranch.else"
2475 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
2476 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
2477 let _ = "pushValue"
2478 in name
2479 ( let _ = "onReturn"
2480 in \farInp farExp v (!inp) buf end ->
2481 let _ = "lift2Value checkedHorizon=0"
2482 in do
2483 sr <- GHC.STRef.readSTRef reg
2484 let _ = "lift2Value checkedHorizon=0"
2485 in do
2486 let dupv = sr
2487 GHC.STRef.writeSTRef reg dupv
2488 let _ = "jump"
2489 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2490 )
2491 callerInput
2492 callerBuffer
2493 callerEnded
2494 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2495 in let _ = "jump"
2496 in loop callerOnReturn inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2497 )
2498 inp
2499 buf
2500 end
2501 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2502 )
2503 cs
2504 buf
2505 callerEnd
2506 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2507 else
2508 let _ = "checkToken.fail"
2509 in let failExp =
2510 Data.Set.Internal.Bin
2511 1
2512 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2513 ( case inputToken of
2514 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '['
2515 )
2516 )
2517 Data.Set.Internal.Tip
2518 Data.Set.Internal.Tip
2519 in let (#
2520 farInp,
2521 farExp
2522 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2523 GHC.Types.LT ->
2524 (#
2525 callerInput,
2526 failExp
2527 #)
2528 GHC.Types.EQ ->
2529 (#
2530 initPos,
2531 failExp GHC.Base.<> Data.Set.Internal.empty
2532 #)
2533 GHC.Types.GT ->
2534 (#
2535 initPos,
2536 Data.Set.Internal.empty
2537 #)
2538 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
2539 else
2540 let _ = "checkHorizon.newCheck.fail"
2541 in let noMoreInput =
2542 let failExp =
2543 Data.Set.Internal.Bin
2544 1
2545 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2546 ( case inputToken of
2547 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 5
2548 )
2549 )
2550 Data.Set.Internal.Tip
2551 Data.Set.Internal.Tip
2552 in let (#
2553 farInp,
2554 farExp
2555 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
2556 GHC.Types.LT ->
2557 (#
2558 callerInput,
2559 failExp
2560 #)
2561 GHC.Types.EQ ->
2562 (#
2563 initPos,
2564 failExp GHC.Base.<> Data.Set.Internal.empty
2565 #)
2566 GHC.Types.GT ->
2567 (#
2568 initPos,
2569 Data.Set.Internal.empty
2570 #)
2571 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
2572 in if callerEnd
2573 then noMoreInput
2574 else
2575 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
2576 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
2577 ( \newInput ->
2578 if Symantic.Parser.Machine.Input.nullInput newInput
2579 then noMoreInput
2580 else partialCont (append buf newInput)
2581 )
2582 )
2583 in partialCont callerBuffer
2584 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
2585 let _ = "pushValue"
2586 in let _ = "comment: satisfy ((GHC.Classes.==) '{')"
2587 in let partialCont buf =
2588 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
2589 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=4"
2590 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 3 callerInput)
2591 then
2592 let _ = "checkToken"
2593 in let !(#
2594 c,
2595 cs
2596 #) = readNext buf callerInput
2597 in if (GHC.Classes.==) '{' c
2598 then
2599 let _ = "lift2Value checkedHorizon=4"
2600 in name
2601 ( let _ = "onReturn"
2602 in \farInp farExp v (!inp) buf end ->
2603 let _ = "lift2Value checkedHorizon=0"
2604 in let _ = "pushValue"
2605 in do
2606 let dupv = \u -> u
2607 reg <- GHC.STRef.newSTRef dupv
2608 let _ = "iter"
2609 in let onException loopInput =
2610 let _ = "onException"
2611 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2612 let _ = "comment: raiseAgainIfConsumed"
2613 in let _ = "saveInput checkedHorizon=0"
2614 in let _ = "lift2Value checkedHorizon=0"
2615 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
2616 then
2617 let _ = "choicesBranch checkedHorizon=0"
2618 in do
2619 sr <- GHC.STRef.readSTRef reg
2620 name
2621 ( let _ = "onReturn"
2622 in \farInp farExp v (!inp) buf end ->
2623 let _ = "lift2Value checkedHorizon=0"
2624 in let _ = "lift2Value checkedHorizon=0"
2625 in name
2626 ( let _ = "onReturn"
2627 in \farInp farExp v (!inp) buf end ->
2628 let _ = "lift2Value checkedHorizon=0"
2629 in let _ = "comment: satisfy ((GHC.Classes.==) '}')"
2630 in let partialCont buf =
2631 let readFail = readFail
2632 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
2633 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 inp)
2634 then
2635 let _ = "checkToken"
2636 in let !(#
2637 c,
2638 cs
2639 #) = readNext buf inp
2640 in if (GHC.Classes.==) '}' c
2641 then
2642 let _ = "lift2Value checkedHorizon=2"
2643 in name
2644 ( let _ = "onReturn"
2645 in \farInp farExp v (!inp) buf end ->
2646 let _ = "lift2Value checkedHorizon=0"
2647 in let _ = "resume"
2648 in callerOnReturn
2649 farInp
2650 farExp
2651 ( let _ = "resume.genCode"
2652 in v
2653 )
2654 inp
2655 buf
2656 end
2657 )
2658 cs
2659 buf
2660 end
2661 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2662 else
2663 let _ = "checkToken.fail"
2664 in let failExp =
2665 Data.Set.Internal.Bin
2666 1
2667 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2668 ( case inputToken of
2669 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '}'
2670 )
2671 )
2672 Data.Set.Internal.Tip
2673 Data.Set.Internal.Tip
2674 in let (#
2675 farInp,
2676 farExp
2677 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
2678 GHC.Types.LT ->
2679 (#
2680 inp,
2681 failExp
2682 #)
2683 GHC.Types.EQ ->
2684 (#
2685 farInp,
2686 failExp GHC.Base.<> farExp
2687 #)
2688 GHC.Types.GT ->
2689 (#
2690 farInp,
2691 farExp
2692 #)
2693 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf end
2694 else
2695 let _ = "checkHorizon.newCheck.fail"
2696 in let noMoreInput =
2697 let failExp =
2698 Data.Set.Internal.Bin
2699 1
2700 ( Symantic.Parser.Grammar.Combinators.SomeFailure
2701 ( case inputToken of
2702 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
2703 )
2704 )
2705 Data.Set.Internal.Tip
2706 Data.Set.Internal.Tip
2707 in let (#
2708 farInp,
2709 farExp
2710 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
2711 GHC.Types.LT ->
2712 (#
2713 inp,
2714 failExp
2715 #)
2716 GHC.Types.EQ ->
2717 (#
2718 farInp,
2719 failExp GHC.Base.<> farExp
2720 #)
2721 GHC.Types.GT ->
2722 (#
2723 farInp,
2724 farExp
2725 #)
2726 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf GHC.Types.True
2727 in if end
2728 then noMoreInput
2729 else
2730 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
2731 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
2732 ( \newInput ->
2733 if Symantic.Parser.Machine.Input.nullInput newInput
2734 then noMoreInput
2735 else partialCont (append buf newInput)
2736 )
2737 )
2738 in partialCont buf
2739 )
2740 inp
2741 buf
2742 end
2743 Data.Map.Internal.Tip
2744 )
2745 failInp
2746 buf
2747 end
2748 Data.Map.Internal.Tip
2749 else
2750 let _ = "choicesBranch.else"
2751 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
2752 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
2753 let _ = "pushValue"
2754 in let join = \farInp farExp v (!inp) buf end ->
2755 let _ = "lift2Value checkedHorizon=0"
2756 in do
2757 sr <- GHC.STRef.readSTRef reg
2758 let _ = "lift2Value checkedHorizon=0"
2759 in do
2760 let dupv = sr
2761 GHC.STRef.writeSTRef reg dupv
2762 let _ = "jump"
2763 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2764 in let _ = "catch ExceptionFailure checkedHorizon=0"
2765 in let onException =
2766 let _ = "onException"
2767 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2768 let _ = "comment: raiseAgainIfConsumed"
2769 in let _ = "saveInput checkedHorizon=0"
2770 in let _ = "lift2Value checkedHorizon=0"
2771 in if (GHC.Classes.==) @GHC.Types.Int callerInput failInp
2772 then
2773 let _ = "choicesBranch checkedHorizon=0"
2774 in let _ = "catch ExceptionFailure checkedHorizon=0"
2775 in let onException =
2776 let _ = "onException"
2777 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2778 let _ = "comment: raiseAgainIfConsumed"
2779 in let _ = "saveInput checkedHorizon=0"
2780 in let _ = "lift2Value checkedHorizon=0"
2781 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
2782 then
2783 let _ = "choicesBranch checkedHorizon=0"
2784 in let _ = "catch ExceptionFailure checkedHorizon=0"
2785 in let onException =
2786 let _ = "onException"
2787 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2788 let _ = "comment: raiseAgainIfConsumed"
2789 in let _ = "saveInput checkedHorizon=0"
2790 in let _ = "lift2Value checkedHorizon=0"
2791 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
2792 then
2793 let _ = "choicesBranch checkedHorizon=0"
2794 in let _ = "pushValue"
2795 in name
2796 ( let _ = "onReturn"
2797 in \farInp farExp v (!inp) buf end ->
2798 let _ = "lift2Value checkedHorizon=0"
2799 in name
2800 ( let _ = "onReturn"
2801 in \farInp farExp v (!inp) buf end ->
2802 let _ = "lift2Value checkedHorizon=0"
2803 in let _ = "resume"
2804 in join
2805 farInp
2806 farExp
2807 ( let _ = "resume.genCode"
2808 in v
2809 )
2810 inp
2811 buf
2812 end
2813 )
2814 inp
2815 buf
2816 end
2817 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2818 )
2819 failInp
2820 buf
2821 end
2822 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2823 else
2824 let _ = "choicesBranch.else"
2825 in onException callerInput Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
2826 in let _ = "catch ExceptionFailure checkedHorizon=0"
2827 in let onException =
2828 let _ = "onException"
2829 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2830 let _ = "loadInput checkedHorizon=0"
2831 in let _ = "checkHorizon.noCheck"
2832 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
2833 in let _ = "pushValue"
2834 in let join = \farInp farExp v (!inp) buf end ->
2835 let _ = "lift2Value checkedHorizon=0"
2836 in name
2837 ( let _ = "onReturn"
2838 in \farInp farExp v (!inp) buf end ->
2839 let _ = "lift2Value checkedHorizon=0"
2840 in let _ = "pushValue"
2841 in do
2842 let dupv = \u -> u
2843 reg <- GHC.STRef.newSTRef dupv
2844 let _ = "iter"
2845 in let onException loopInput =
2846 let _ = "onException"
2847 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2848 let _ = "comment: raiseAgainIfConsumed"
2849 in let _ = "saveInput checkedHorizon=0"
2850 in let _ = "lift2Value checkedHorizon=0"
2851 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
2852 then
2853 let _ = "choicesBranch checkedHorizon=0"
2854 in do
2855 sr <- GHC.STRef.readSTRef reg
2856 name
2857 ( let _ = "onReturn"
2858 in \farInp farExp v (!inp) buf end ->
2859 let _ = "lift2Value checkedHorizon=0"
2860 in let _ = "lift2Value checkedHorizon=0"
2861 in name
2862 ( let _ = "onReturn"
2863 in \farInp farExp v (!inp) buf end ->
2864 let _ = "lift2Value checkedHorizon=0"
2865 in let _ = "comment: satisfy ((GHC.Classes.==) '=')"
2866 in let partialCont buf =
2867 let readFail = onException
2868 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=6"
2869 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 5 inp)
2870 then
2871 let _ = "checkToken"
2872 in let !(#
2873 c,
2874 cs
2875 #) = readNext buf inp
2876 in if (GHC.Classes.==) '=' c
2877 then
2878 let _ = "lift2Value checkedHorizon=6"
2879 in name
2880 ( let _ = "onReturn"
2881 in \farInp farExp v (!inp) buf end ->
2882 let _ = "lift2Value checkedHorizon=0"
2883 in name
2884 ( let _ = "onReturn"
2885 in \farInp farExp v (!inp) buf end ->
2886 let _ = "lift2Value checkedHorizon=0"
2887 in let _ = "pushValue"
2888 in do
2889 let dupv = \u -> u
2890 reg <- GHC.STRef.newSTRef dupv
2891 let _ = "iter"
2892 in let onException loopInput =
2893 let _ = "onException"
2894 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
2895 let _ = "comment: raiseAgainIfConsumed"
2896 in let _ = "saveInput checkedHorizon=0"
2897 in let _ = "lift2Value checkedHorizon=0"
2898 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
2899 then
2900 let _ = "choicesBranch checkedHorizon=0"
2901 in do
2902 sr <- GHC.STRef.readSTRef reg
2903 name
2904 ( let _ = "onReturn"
2905 in \farInp farExp v (!inp) buf end ->
2906 let _ = "lift2Value checkedHorizon=0"
2907 in let _ = "lift2Value checkedHorizon=0"
2908 in name
2909 ( let _ = "onReturn"
2910 in \farInp farExp v (!inp) buf end ->
2911 let _ = "lift2Value checkedHorizon=0"
2912 in name
2913 ( let _ = "onReturn"
2914 in \farInp farExp v (!inp) buf end ->
2915 let _ = "lift2Value checkedHorizon=0"
2916 in let _ = "commit"
2917 in let _ = "commit"
2918 in let _ = "resume"
2919 in join
2920 farInp
2921 farExp
2922 ( let _ = "resume.genCode"
2923 in v
2924 )
2925 inp
2926 buf
2927 end
2928 )
2929 inp
2930 buf
2931 end
2932 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2933 )
2934 inp
2935 buf
2936 end
2937 Data.Map.Internal.Tip
2938 )
2939 failInp
2940 buf
2941 end
2942 Data.Map.Internal.Tip
2943 else
2944 let _ = "choicesBranch.else"
2945 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
2946 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
2947 let _ = "pushValue"
2948 in name
2949 ( let _ = "onReturn"
2950 in \farInp farExp v (!inp) buf end ->
2951 let _ = "lift2Value checkedHorizon=0"
2952 in name
2953 ( let _ = "onReturn"
2954 in \farInp farExp v (!inp) buf end ->
2955 let _ = "lift2Value checkedHorizon=0"
2956 in name
2957 ( let _ = "onReturn"
2958 in \farInp farExp v (!inp) buf end ->
2959 let _ = "lift2Value checkedHorizon=0"
2960 in do
2961 sr <- GHC.STRef.readSTRef reg
2962 let _ = "lift2Value checkedHorizon=0"
2963 in do
2964 let dupv = v v sr
2965 GHC.STRef.writeSTRef reg dupv
2966 let _ = "jump"
2967 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2968 )
2969 inp
2970 buf
2971 end
2972 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2973 )
2974 inp
2975 buf
2976 end
2977 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
2978 )
2979 callerInput
2980 callerBuffer
2981 callerEnded
2982 Data.Map.Internal.Tip
2983 in let _ = "jump"
2984 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2985 )
2986 inp
2987 buf
2988 end
2989 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2990 )
2991 cs
2992 buf
2993 end
2994 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
2995 else
2996 let _ = "checkToken.fail"
2997 in let failExp =
2998 Data.Set.Internal.Bin
2999 1
3000 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3001 ( case inputToken of
3002 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '='
3003 )
3004 )
3005 Data.Set.Internal.Tip
3006 Data.Set.Internal.Tip
3007 in let (#
3008 farInp,
3009 farExp
3010 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
3011 GHC.Types.LT ->
3012 (#
3013 inp,
3014 failExp
3015 #)
3016 GHC.Types.EQ ->
3017 (#
3018 farInp,
3019 failExp GHC.Base.<> farExp
3020 #)
3021 GHC.Types.GT ->
3022 (#
3023 farInp,
3024 farExp
3025 #)
3026 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf end
3027 else
3028 let _ = "checkHorizon.newCheck.fail"
3029 in let noMoreInput =
3030 let failExp =
3031 Data.Set.Internal.Bin
3032 1
3033 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3034 ( case inputToken of
3035 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 6
3036 )
3037 )
3038 Data.Set.Internal.Tip
3039 Data.Set.Internal.Tip
3040 in let (#
3041 farInp,
3042 farExp
3043 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
3044 GHC.Types.LT ->
3045 (#
3046 inp,
3047 failExp
3048 #)
3049 GHC.Types.EQ ->
3050 (#
3051 farInp,
3052 failExp GHC.Base.<> farExp
3053 #)
3054 GHC.Types.GT ->
3055 (#
3056 farInp,
3057 farExp
3058 #)
3059 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf GHC.Types.True
3060 in if end
3061 then noMoreInput
3062 else
3063 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
3064 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
3065 ( \newInput ->
3066 if Symantic.Parser.Machine.Input.nullInput newInput
3067 then noMoreInput
3068 else partialCont (append buf newInput)
3069 )
3070 )
3071 in partialCont buf
3072 )
3073 inp
3074 buf
3075 end
3076 Data.Map.Internal.Tip
3077 )
3078 failInp
3079 buf
3080 end
3081 Data.Map.Internal.Tip
3082 else
3083 let _ = "choicesBranch.else"
3084 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3085 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
3086 let _ = "pushValue"
3087 in name
3088 ( let _ = "onReturn"
3089 in \farInp farExp v (!inp) buf end ->
3090 let _ = "lift2Value checkedHorizon=0"
3091 in name
3092 ( let _ = "onReturn"
3093 in \farInp farExp v (!inp) buf end ->
3094 let _ = "lift2Value checkedHorizon=0"
3095 in name
3096 ( let _ = "onReturn"
3097 in \farInp farExp v (!inp) buf end ->
3098 let _ = "lift2Value checkedHorizon=0"
3099 in do
3100 sr <- GHC.STRef.readSTRef reg
3101 let _ = "lift2Value checkedHorizon=0"
3102 in do
3103 let dupv = v v sr
3104 GHC.STRef.writeSTRef reg dupv
3105 let _ = "jump"
3106 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
3107 )
3108 inp
3109 buf
3110 end
3111 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
3112 )
3113 inp
3114 buf
3115 end
3116 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
3117 )
3118 callerInput
3119 callerBuffer
3120 callerEnded
3121 Data.Map.Internal.Tip
3122 in let _ = "jump"
3123 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
3124 )
3125 inp
3126 buf
3127 end
3128 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
3129 in let _ = "catch ExceptionFailure checkedHorizon=0"
3130 in let onException =
3131 let _ = "onException"
3132 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
3133 let _ = "comment: raiseAgainIfConsumed"
3134 in let _ = "saveInput checkedHorizon=0"
3135 in let _ = "lift2Value checkedHorizon=0"
3136 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
3137 then
3138 let _ = "choicesBranch checkedHorizon=0"
3139 in name
3140 ( let _ = "onReturn"
3141 in \farInp farExp v (!inp) buf end ->
3142 let _ = "resume"
3143 in join
3144 farInp
3145 farExp
3146 ( let _ = "resume.genCode"
3147 in v
3148 )
3149 inp
3150 buf
3151 end
3152 )
3153 failInp
3154 buf
3155 end
3156 Data.Map.Internal.Tip
3157 else
3158 let _ = "choicesBranch.else"
3159 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3160 in let _ = "pushValue"
3161 in let _ = "catch ExceptionFailure checkedHorizon=0"
3162 in let onException =
3163 let _ = "onException"
3164 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
3165 let _ = "loadInput checkedHorizon=0"
3166 in let _ = "checkHorizon.noCheck"
3167 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3168 in let _ = "pushValue"
3169 in let _ = "comment: satisfy ((GHC.Classes.==) 'v')"
3170 in let partialCont buf =
3171 let readFail = onException
3172 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=11"
3173 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 10 failInp)
3174 then
3175 let _ = "checkToken"
3176 in let !(#
3177 c,
3178 cs
3179 #) = readNext buf failInp
3180 in if (GHC.Classes.==) 'v' c
3181 then
3182 let _ = "lift2Value checkedHorizon=11"
3183 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
3184 in let _ = "checkHorizon.oldCheck: checkedHorizon=11"
3185 in let _ = "checkToken"
3186 in let !(#
3187 c,
3188 cs
3189 #) = readNext buf cs
3190 in if (GHC.Classes.==) 'a' c
3191 then
3192 let _ = "lift2Value checkedHorizon=10"
3193 in let _ = "comment: satisfy ((GHC.Classes.==) 'r')"
3194 in let _ = "checkHorizon.oldCheck: checkedHorizon=10"
3195 in let _ = "checkToken"
3196 in let !(#
3197 c,
3198 cs
3199 #) = readNext buf cs
3200 in if (GHC.Classes.==) 'r' c
3201 then
3202 let _ = "lift2Value checkedHorizon=9"
3203 in let _ = "commit"
3204 in let _ = "lift2Value checkedHorizon=9"
3205 in let _ = "commit"
3206 in let _ = "resume"
3207 in join
3208 farInp
3209 farExp
3210 ( let _ = "resume.genCode"
3211 in GHC.Tuple . ()
3212 )
3213 cs
3214 buf
3215 end
3216 else
3217 let _ = "checkToken.fail"
3218 in let failExp =
3219 Data.Set.Internal.Bin
3220 1
3221 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3222 ( case inputToken of
3223 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'r'
3224 )
3225 )
3226 Data.Set.Internal.Tip
3227 Data.Set.Internal.Tip
3228 in let (#
3229 farInp,
3230 farExp
3231 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3232 GHC.Types.LT ->
3233 (#
3234 cs,
3235 failExp
3236 #)
3237 GHC.Types.EQ ->
3238 (#
3239 farInp,
3240 failExp GHC.Base.<> farExp
3241 #)
3242 GHC.Types.GT ->
3243 (#
3244 farInp,
3245 farExp
3246 #)
3247 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
3248 else
3249 let _ = "checkToken.fail"
3250 in let failExp =
3251 Data.Set.Internal.Bin
3252 1
3253 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3254 ( case inputToken of
3255 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
3256 )
3257 )
3258 Data.Set.Internal.Tip
3259 Data.Set.Internal.Tip
3260 in let (#
3261 farInp,
3262 farExp
3263 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3264 GHC.Types.LT ->
3265 (#
3266 cs,
3267 failExp
3268 #)
3269 GHC.Types.EQ ->
3270 (#
3271 farInp,
3272 failExp GHC.Base.<> farExp
3273 #)
3274 GHC.Types.GT ->
3275 (#
3276 farInp,
3277 farExp
3278 #)
3279 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
3280 else
3281 let _ = "checkToken.fail"
3282 in let failExp =
3283 Data.Set.Internal.Bin
3284 1
3285 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3286 ( case inputToken of
3287 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'v'
3288 )
3289 )
3290 Data.Set.Internal.Tip
3291 Data.Set.Internal.Tip
3292 in let (#
3293 farInp,
3294 farExp
3295 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
3296 GHC.Types.LT ->
3297 (#
3298 failInp,
3299 failExp
3300 #)
3301 GHC.Types.EQ ->
3302 (#
3303 farInp,
3304 failExp GHC.Base.<> farExp
3305 #)
3306 GHC.Types.GT ->
3307 (#
3308 farInp,
3309 farExp
3310 #)
3311 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3312 else
3313 let _ = "checkHorizon.newCheck.fail"
3314 in let noMoreInput =
3315 let failExp =
3316 Data.Set.Internal.Bin
3317 1
3318 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3319 ( case inputToken of
3320 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 11
3321 )
3322 )
3323 Data.Set.Internal.Tip
3324 Data.Set.Internal.Tip
3325 in let (#
3326 farInp,
3327 farExp
3328 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
3329 GHC.Types.LT ->
3330 (#
3331 failInp,
3332 failExp
3333 #)
3334 GHC.Types.EQ ->
3335 (#
3336 farInp,
3337 failExp GHC.Base.<> farExp
3338 #)
3339 GHC.Types.GT ->
3340 (#
3341 farInp,
3342 farExp
3343 #)
3344 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
3345 in if end
3346 then noMoreInput
3347 else
3348 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
3349 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
3350 ( \newInput ->
3351 if Symantic.Parser.Machine.Input.nullInput newInput
3352 then noMoreInput
3353 else partialCont (append buf newInput)
3354 )
3355 )
3356 in partialCont buf
3357 else
3358 let _ = "choicesBranch.else"
3359 in onException callerInput Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3360 in let _ = "pushValue"
3361 in let _ = "catch ExceptionFailure checkedHorizon=0"
3362 in let onException =
3363 let _ = "onException"
3364 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
3365 let _ = "loadInput checkedHorizon=0"
3366 in let _ = "checkHorizon.noCheck"
3367 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3368 in let _ = "pushValue"
3369 in let _ = "comment: satisfy ((GHC.Classes.==) 'w')"
3370 in let partialCont buf =
3371 let readFail = onException
3372 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=7"
3373 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 6 failInp)
3374 then
3375 let _ = "checkToken"
3376 in let !(#
3377 c,
3378 cs
3379 #) = readNext buf failInp
3380 in if (GHC.Classes.==) 'w' c
3381 then
3382 let _ = "lift2Value checkedHorizon=7"
3383 in let _ = "comment: satisfy ((GHC.Classes.==) 'h')"
3384 in let _ = "checkHorizon.oldCheck: checkedHorizon=7"
3385 in let _ = "checkToken"
3386 in let !(#
3387 c,
3388 cs
3389 #) = readNext buf cs
3390 in if (GHC.Classes.==) 'h' c
3391 then
3392 let _ = "lift2Value checkedHorizon=6"
3393 in let _ = "comment: satisfy ((GHC.Classes.==) 'i')"
3394 in let _ = "checkHorizon.oldCheck: checkedHorizon=6"
3395 in let _ = "checkToken"
3396 in let !(#
3397 c,
3398 cs
3399 #) = readNext buf cs
3400 in if (GHC.Classes.==) 'i' c
3401 then
3402 let _ = "lift2Value checkedHorizon=5"
3403 in let _ = "comment: satisfy ((GHC.Classes.==) 'l')"
3404 in let _ = "checkHorizon.oldCheck: checkedHorizon=5"
3405 in let _ = "checkToken"
3406 in let !(#
3407 c,
3408 cs
3409 #) = readNext buf cs
3410 in if (GHC.Classes.==) 'l' c
3411 then
3412 let _ = "lift2Value checkedHorizon=4"
3413 in let _ = "comment: satisfy ((GHC.Classes.==) 'e')"
3414 in let _ = "checkHorizon.oldCheck: checkedHorizon=4"
3415 in let _ = "checkToken"
3416 in let !(#
3417 c,
3418 cs
3419 #) = readNext buf cs
3420 in if (GHC.Classes.==) 'e' c
3421 then
3422 let _ = "lift2Value checkedHorizon=3"
3423 in let _ = "commit"
3424 in let _ = "lift2Value checkedHorizon=3"
3425 in name
3426 ( let _ = "onReturn"
3427 in \farInp farExp v (!inp) buf end ->
3428 let _ = "lift2Value checkedHorizon=0"
3429 in name
3430 ( let _ = "onReturn"
3431 in \farInp farExp v (!inp) buf end ->
3432 let _ = "lift2Value checkedHorizon=0"
3433 in let _ = "commit"
3434 in let _ = "resume"
3435 in join
3436 farInp
3437 farExp
3438 ( let _ = "resume.genCode"
3439 in v
3440 )
3441 inp
3442 buf
3443 end
3444 )
3445 inp
3446 buf
3447 end
3448 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
3449 )
3450 cs
3451 buf
3452 end
3453 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure onException Data.Map.Internal.Tip Data.Map.Internal.Tip)
3454 else
3455 let _ = "checkToken.fail"
3456 in let failExp =
3457 Data.Set.Internal.Bin
3458 1
3459 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3460 ( case inputToken of
3461 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'e'
3462 )
3463 )
3464 Data.Set.Internal.Tip
3465 Data.Set.Internal.Tip
3466 in let (#
3467 farInp,
3468 farExp
3469 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3470 GHC.Types.LT ->
3471 (#
3472 cs,
3473 failExp
3474 #)
3475 GHC.Types.EQ ->
3476 (#
3477 farInp,
3478 failExp GHC.Base.<> farExp
3479 #)
3480 GHC.Types.GT ->
3481 (#
3482 farInp,
3483 farExp
3484 #)
3485 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
3486 else
3487 let _ = "checkToken.fail"
3488 in let failExp =
3489 Data.Set.Internal.Bin
3490 1
3491 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3492 ( case inputToken of
3493 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'l'
3494 )
3495 )
3496 Data.Set.Internal.Tip
3497 Data.Set.Internal.Tip
3498 in let (#
3499 farInp,
3500 farExp
3501 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3502 GHC.Types.LT ->
3503 (#
3504 cs,
3505 failExp
3506 #)
3507 GHC.Types.EQ ->
3508 (#
3509 farInp,
3510 failExp GHC.Base.<> farExp
3511 #)
3512 GHC.Types.GT ->
3513 (#
3514 farInp,
3515 farExp
3516 #)
3517 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
3518 else
3519 let _ = "checkToken.fail"
3520 in let failExp =
3521 Data.Set.Internal.Bin
3522 1
3523 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3524 ( case inputToken of
3525 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'i'
3526 )
3527 )
3528 Data.Set.Internal.Tip
3529 Data.Set.Internal.Tip
3530 in let (#
3531 farInp,
3532 farExp
3533 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3534 GHC.Types.LT ->
3535 (#
3536 cs,
3537 failExp
3538 #)
3539 GHC.Types.EQ ->
3540 (#
3541 farInp,
3542 failExp GHC.Base.<> farExp
3543 #)
3544 GHC.Types.GT ->
3545 (#
3546 farInp,
3547 farExp
3548 #)
3549 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
3550 else
3551 let _ = "checkToken.fail"
3552 in let failExp =
3553 Data.Set.Internal.Bin
3554 1
3555 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3556 ( case inputToken of
3557 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'h'
3558 )
3559 )
3560 Data.Set.Internal.Tip
3561 Data.Set.Internal.Tip
3562 in let (#
3563 farInp,
3564 farExp
3565 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3566 GHC.Types.LT ->
3567 (#
3568 cs,
3569 failExp
3570 #)
3571 GHC.Types.EQ ->
3572 (#
3573 farInp,
3574 failExp GHC.Base.<> farExp
3575 #)
3576 GHC.Types.GT ->
3577 (#
3578 farInp,
3579 farExp
3580 #)
3581 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
3582 else
3583 let _ = "checkToken.fail"
3584 in let failExp =
3585 Data.Set.Internal.Bin
3586 1
3587 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3588 ( case inputToken of
3589 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'w'
3590 )
3591 )
3592 Data.Set.Internal.Tip
3593 Data.Set.Internal.Tip
3594 in let (#
3595 farInp,
3596 farExp
3597 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
3598 GHC.Types.LT ->
3599 (#
3600 failInp,
3601 failExp
3602 #)
3603 GHC.Types.EQ ->
3604 (#
3605 farInp,
3606 failExp GHC.Base.<> farExp
3607 #)
3608 GHC.Types.GT ->
3609 (#
3610 farInp,
3611 farExp
3612 #)
3613 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3614 else
3615 let _ = "checkHorizon.newCheck.fail"
3616 in let noMoreInput =
3617 let failExp =
3618 Data.Set.Internal.Bin
3619 1
3620 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3621 ( case inputToken of
3622 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 7
3623 )
3624 )
3625 Data.Set.Internal.Tip
3626 Data.Set.Internal.Tip
3627 in let (#
3628 farInp,
3629 farExp
3630 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
3631 GHC.Types.LT ->
3632 (#
3633 failInp,
3634 failExp
3635 #)
3636 GHC.Types.EQ ->
3637 (#
3638 farInp,
3639 failExp GHC.Base.<> farExp
3640 #)
3641 GHC.Types.GT ->
3642 (#
3643 farInp,
3644 farExp
3645 #)
3646 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
3647 in if end
3648 then noMoreInput
3649 else
3650 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
3651 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
3652 ( \newInput ->
3653 if Symantic.Parser.Machine.Input.nullInput newInput
3654 then noMoreInput
3655 else partialCont (append buf newInput)
3656 )
3657 )
3658 in partialCont buf
3659 else
3660 let _ = "choicesBranch.else"
3661 in onException callerInput Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
3662 in let _ = "pushValue"
3663 in let _ = "catch ExceptionFailure checkedHorizon=0"
3664 in let onException =
3665 let _ = "onException"
3666 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
3667 let _ = "loadInput checkedHorizon=0"
3668 in let _ = "checkHorizon.noCheck"
3669 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf end
3670 in let _ = "pushValue"
3671 in let _ = "comment: satisfy ((GHC.Classes.==) 'i')"
3672 in let partialCont buf =
3673 let readFail = onException
3674 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
3675 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 callerInput)
3676 then
3677 let _ = "checkToken"
3678 in let !(#
3679 c,
3680 cs
3681 #) = readNext buf callerInput
3682 in if (GHC.Classes.==) 'i' c
3683 then
3684 let _ = "lift2Value checkedHorizon=2"
3685 in let _ = "comment: satisfy ((GHC.Classes.==) 'f')"
3686 in let _ = "checkHorizon.oldCheck: checkedHorizon=2"
3687 in let _ = "checkToken"
3688 in let !(#
3689 c,
3690 cs
3691 #) = readNext buf cs
3692 in if (GHC.Classes.==) 'f' c
3693 then
3694 let _ = "lift2Value checkedHorizon=1"
3695 in let _ = "commit"
3696 in let _ = "lift2Value checkedHorizon=1"
3697 in let _ = "commit"
3698 in let _ = "resume"
3699 in join
3700 farInp
3701 farExp
3702 ( let _ = "resume.genCode"
3703 in GHC.Tuple . ()
3704 )
3705 cs
3706 buf
3707 callerEnded
3708 else
3709 let _ = "checkToken.fail"
3710 in let failExp =
3711 Data.Set.Internal.Bin
3712 1
3713 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3714 ( case inputToken of
3715 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'f'
3716 )
3717 )
3718 Data.Set.Internal.Tip
3719 Data.Set.Internal.Tip
3720 in let (#
3721 farInp,
3722 farExp
3723 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
3724 GHC.Types.LT ->
3725 (#
3726 cs,
3727 failExp
3728 #)
3729 GHC.Types.EQ ->
3730 (#
3731 farInp,
3732 failExp GHC.Base.<> farExp
3733 #)
3734 GHC.Types.GT ->
3735 (#
3736 farInp,
3737 farExp
3738 #)
3739 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
3740 else
3741 let _ = "checkToken.fail"
3742 in let failExp =
3743 Data.Set.Internal.Bin
3744 1
3745 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3746 ( case inputToken of
3747 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'i'
3748 )
3749 )
3750 Data.Set.Internal.Tip
3751 Data.Set.Internal.Tip
3752 in let (#
3753 farInp,
3754 farExp
3755 #) = case GHC.Classes.compare @GHC.Types.Int farInp callerInput of
3756 GHC.Types.LT ->
3757 (#
3758 callerInput,
3759 failExp
3760 #)
3761 GHC.Types.EQ ->
3762 (#
3763 farInp,
3764 failExp GHC.Base.<> farExp
3765 #)
3766 GHC.Types.GT ->
3767 (#
3768 farInp,
3769 farExp
3770 #)
3771 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnded
3772 else
3773 let _ = "checkHorizon.newCheck.fail"
3774 in let noMoreInput =
3775 let failExp =
3776 Data.Set.Internal.Bin
3777 1
3778 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3779 ( case inputToken of
3780 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
3781 )
3782 )
3783 Data.Set.Internal.Tip
3784 Data.Set.Internal.Tip
3785 in let (#
3786 farInp,
3787 farExp
3788 #) = case GHC.Classes.compare @GHC.Types.Int farInp callerInput of
3789 GHC.Types.LT ->
3790 (#
3791 callerInput,
3792 failExp
3793 #)
3794 GHC.Types.EQ ->
3795 (#
3796 farInp,
3797 failExp GHC.Base.<> farExp
3798 #)
3799 GHC.Types.GT ->
3800 (#
3801 farInp,
3802 farExp
3803 #)
3804 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
3805 in if callerEnded
3806 then noMoreInput
3807 else
3808 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
3809 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
3810 ( \newInput ->
3811 if Symantic.Parser.Machine.Input.nullInput newInput
3812 then noMoreInput
3813 else partialCont (append buf newInput)
3814 )
3815 )
3816 in partialCont callerBuffer
3817 in let _ = "jump"
3818 in loop callerOnReturn inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
3819 )
3820 cs
3821 buf
3822 callerEnd
3823 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
3824 else
3825 let _ = "checkToken.fail"
3826 in let failExp =
3827 Data.Set.Internal.Bin
3828 1
3829 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3830 ( case inputToken of
3831 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken '{'
3832 )
3833 )
3834 Data.Set.Internal.Tip
3835 Data.Set.Internal.Tip
3836 in let (#
3837 farInp,
3838 farExp
3839 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
3840 GHC.Types.LT ->
3841 (#
3842 callerInput,
3843 failExp
3844 #)
3845 GHC.Types.EQ ->
3846 (#
3847 initPos,
3848 failExp GHC.Base.<> Data.Set.Internal.empty
3849 #)
3850 GHC.Types.GT ->
3851 (#
3852 initPos,
3853 Data.Set.Internal.empty
3854 #)
3855 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
3856 else
3857 let _ = "checkHorizon.newCheck.fail"
3858 in let noMoreInput =
3859 let failExp =
3860 Data.Set.Internal.Bin
3861 1
3862 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3863 ( case inputToken of
3864 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
3865 )
3866 )
3867 Data.Set.Internal.Tip
3868 Data.Set.Internal.Tip
3869 in let (#
3870 farInp,
3871 farExp
3872 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
3873 GHC.Types.LT ->
3874 (#
3875 callerInput,
3876 failExp
3877 #)
3878 GHC.Types.EQ ->
3879 (#
3880 initPos,
3881 failExp GHC.Base.<> Data.Set.Internal.empty
3882 #)
3883 GHC.Types.GT ->
3884 (#
3885 initPos,
3886 Data.Set.Internal.empty
3887 #)
3888 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
3889 in if callerEnd
3890 then noMoreInput
3891 else
3892 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
3893 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
3894 ( \newInput ->
3895 if Symantic.Parser.Machine.Input.nullInput newInput
3896 then noMoreInput
3897 else partialCont (append buf newInput)
3898 )
3899 )
3900 in partialCont callerBuffer
3901 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
3902 let _ = "pushValue"
3903 in let _ = "comment: satisfy GHC.Unicode.isSpace"
3904 in let partialCont buf =
3905 let readFail = Data.Map.Strict.Internal.findWithDefault (Symantic.Parser.Machine.Generate.unForallOnException finalRaise) Symantic.Parser.Grammar.Combinators.ExceptionFailure callerOnExceptionStackByLabel
3906 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
3907 in if readMore buf callerInput
3908 then
3909 let _ = "checkToken"
3910 in let !(#
3911 c,
3912 cs
3913 #) = readNext buf callerInput
3914 in if GHC.Unicode.isSpace c
3915 then
3916 let _ = "lift2Value checkedHorizon=1"
3917 in let _ = "resume"
3918 in callerOnReturn
3919 initPos
3920 Data.Set.Internal.empty
3921 ( let _ = "resume.genCode"
3922 in GHC.Tuple . ()
3923 )
3924 cs
3925 buf
3926 callerEnd
3927 else
3928 let _ = "checkToken.fail"
3929 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput initPos Data.Set.Internal.empty buf callerEnd
3930 else
3931 let _ = "checkHorizon.newCheck.fail"
3932 in let noMoreInput =
3933 let failExp =
3934 Data.Set.Internal.Bin
3935 1
3936 ( Symantic.Parser.Grammar.Combinators.SomeFailure
3937 ( case inputToken of
3938 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
3939 )
3940 )
3941 Data.Set.Internal.Tip
3942 Data.Set.Internal.Tip
3943 in let (#
3944 farInp,
3945 farExp
3946 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
3947 GHC.Types.LT ->
3948 (#
3949 callerInput,
3950 failExp
3951 #)
3952 GHC.Types.EQ ->
3953 (#
3954 initPos,
3955 failExp GHC.Base.<> Data.Set.Internal.empty
3956 #)
3957 GHC.Types.GT ->
3958 (#
3959 initPos,
3960 Data.Set.Internal.empty
3961 #)
3962 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
3963 in if callerEnd
3964 then noMoreInput
3965 else
3966 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
3967 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
3968 ( \newInput ->
3969 if Symantic.Parser.Machine.Input.nullInput newInput
3970 then noMoreInput
3971 else partialCont (append buf newInput)
3972 )
3973 )
3974 in partialCont callerBuffer
3975 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
3976 let _ = "pushValue"
3977 in let _ = "resume"
3978 in callerOnReturn
3979 initPos
3980 Data.Set.Internal.empty
3981 ( let _ = "resume.genCode"
3982 in GHC.Tuple . ()
3983 )
3984 callerInput
3985 callerBuffer
3986 callerEnd
3987 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
3988 let _ = "pushValue"
3989 in let _ = "resume"
3990 in callerOnReturn
3991 initPos
3992 Data.Set.Internal.empty
3993 ( let _ = "resume.genCode"
3994 in GHC.Tuple . ()
3995 )
3996 callerInput
3997 callerBuffer
3998 callerEnd
3999 name = \(!callerOnReturn) (!callerInput) (!callerBuffer) (!callerEnd) (!callerOnExceptionStackByLabel) ->
4000 let _ = "pushValue"
4001 in let _ = "resume"
4002 in callerOnReturn
4003 initPos
4004 Data.Set.Internal.empty
4005 ( let _ = "resume.genCode"
4006 in \u -> \u -> u
4007 )
4008 callerInput
4009 callerBuffer
4010 callerEnd
4011 in let _ = "pushValue"
4012 in name
4013 ( let _ = "onReturn"
4014 in \farInp farExp v (!inp) buf end ->
4015 let _ = "lift2Value checkedHorizon=0"
4016 in let _ = "pushValue"
4017 in do
4018 let dupv = \u -> u
4019 reg <- GHC.STRef.newSTRef dupv
4020 let _ = "iter"
4021 in let onException loopInput =
4022 let _ = "onException"
4023 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
4024 let _ = "comment: raiseAgainIfConsumed"
4025 in let _ = "saveInput checkedHorizon=0"
4026 in let _ = "lift2Value checkedHorizon=0"
4027 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
4028 then
4029 let _ = "choicesBranch checkedHorizon=0"
4030 in do
4031 sr <- GHC.STRef.readSTRef reg
4032 name
4033 ( let _ = "onReturn"
4034 in \farInp farExp v (!inp) buf end ->
4035 let _ = "lift2Value checkedHorizon=0"
4036 in let _ = "lift2Value checkedHorizon=0"
4037 in let join = \farInp farExp v (!inp) buf end ->
4038 let _ = "lift2Value checkedHorizon=0"
4039 in let _ = "resume"
4040 in finalRet
4041 farInp
4042 farExp
4043 ( let _ = "resume.genCode"
4044 in GHC.Show.show GHC.Tuple . ()
4045 )
4046 inp
4047 buf
4048 end
4049 in let _ = "catch ExceptionFailure checkedHorizon=0"
4050 in let onException =
4051 let _ = "onException"
4052 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
4053 let _ = "comment: raiseAgainIfConsumed"
4054 in let _ = "saveInput checkedHorizon=0"
4055 in let _ = "lift2Value checkedHorizon=0"
4056 in if (GHC.Classes.==) @GHC.Types.Int inp failInp
4057 then
4058 let _ = "choicesBranch checkedHorizon=0"
4059 in let _ = "comment: eof.fail"
4060 in let failExp = Data.Set.Internal.Bin 1 (Symantic.Parser.Grammar.Combinators.SomeFailure Symantic.Parser.Grammar.Combinators.FailureEnd) Data.Set.Internal.Tip Data.Set.Internal.Tip
4061 in let (#
4062 farInp,
4063 farExp
4064 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
4065 GHC.Types.LT ->
4066 (#
4067 failInp,
4068 failExp
4069 #)
4070 GHC.Types.EQ ->
4071 (#
4072 farInp,
4073 failExp GHC.Base.<> farExp
4074 #)
4075 GHC.Types.GT ->
4076 (#
4077 farInp,
4078 farExp
4079 #)
4080 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
4081 else
4082 let _ = "choicesBranch.else"
4083 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
4084 in let _ = "comment: negLook"
4085 in let _ = "catch ExceptionFailure checkedHorizon=0"
4086 in let onException =
4087 let _ = "onException"
4088 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
4089 let _ = "comment: negLook.reset"
4090 in let _ = "loadInput checkedHorizon=0"
4091 in let _ = "checkHorizon.noCheck"
4092 in let _ = "pushValue"
4093 in let _ = "commit"
4094 in let _ = "resume"
4095 in join
4096 farInp
4097 farExp
4098 ( let _ = "resume.genCode"
4099 in GHC.Tuple . ()
4100 )
4101 inp
4102 buf
4103 end
4104 in let _ = "comment: negLook.ahead"
4105 in let _ = "saveInput checkedHorizon=0"
4106 in let _ = "comment: satisfy (GHC.Base.const GHC.Types.True)"
4107 in let partialCont buf =
4108 let readFail = onException
4109 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
4110 in if readMore buf inp
4111 then
4112 let _ = "checkToken"
4113 in let !(#
4114 c,
4115 cs
4116 #) = readNext buf inp
4117 in let _ = "popValue"
4118 in let _ = "commit"
4119 in let _ = "loadInput checkedHorizon=0"
4120 in let _ = "checkHorizon.noCheck"
4121 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf end
4122 else
4123 let _ = "checkHorizon.newCheck.fail"
4124 in let noMoreInput =
4125 let failExp =
4126 Data.Set.Internal.Bin
4127 1
4128 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4129 ( case inputToken of
4130 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
4131 )
4132 )
4133 Data.Set.Internal.Tip
4134 Data.Set.Internal.Tip
4135 in let (#
4136 farInp,
4137 farExp
4138 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
4139 GHC.Types.LT ->
4140 (#
4141 inp,
4142 failExp
4143 #)
4144 GHC.Types.EQ ->
4145 (#
4146 farInp,
4147 failExp GHC.Base.<> farExp
4148 #)
4149 GHC.Types.GT ->
4150 (#
4151 farInp,
4152 farExp
4153 #)
4154 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf GHC.Types.True
4155 in if end
4156 then noMoreInput
4157 else
4158 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
4159 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
4160 ( \newInput ->
4161 if Symantic.Parser.Machine.Input.nullInput newInput
4162 then noMoreInput
4163 else partialCont (append buf newInput)
4164 )
4165 )
4166 in partialCont buf
4167 )
4168 failInp
4169 buf
4170 end
4171 Data.Map.Internal.Tip
4172 else
4173 let _ = "choicesBranch.else"
4174 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
4175 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
4176 let _ = "pushValue"
4177 in let _ = "catch ExceptionFailure checkedHorizon=0"
4178 in let onException =
4179 let _ = "onException"
4180 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
4181 let _ = "loadInput checkedHorizon=0"
4182 in let _ = "checkHorizon.noCheck"
4183 in onException callerInput Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf end
4184 in let _ = "pushValue"
4185 in let _ = "comment: satisfy ((GHC.Classes.==) 'f')"
4186 in let partialCont buf =
4187 let readFail = onException
4188 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=18"
4189 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 17 callerInput)
4190 then
4191 let _ = "checkToken"
4192 in let !(#
4193 c,
4194 cs
4195 #) = readNext buf callerInput
4196 in if (GHC.Classes.==) 'f' c
4197 then
4198 let _ = "lift2Value checkedHorizon=18"
4199 in let _ = "comment: satisfy ((GHC.Classes.==) 'u')"
4200 in let _ = "checkHorizon.oldCheck: checkedHorizon=18"
4201 in let _ = "checkToken"
4202 in let !(#
4203 c,
4204 cs
4205 #) = readNext buf cs
4206 in if (GHC.Classes.==) 'u' c
4207 then
4208 let _ = "lift2Value checkedHorizon=17"
4209 in let _ = "comment: satisfy ((GHC.Classes.==) 'n')"
4210 in let _ = "checkHorizon.oldCheck: checkedHorizon=17"
4211 in let _ = "checkToken"
4212 in let !(#
4213 c,
4214 cs
4215 #) = readNext buf cs
4216 in if (GHC.Classes.==) 'n' c
4217 then
4218 let _ = "lift2Value checkedHorizon=16"
4219 in let _ = "comment: satisfy ((GHC.Classes.==) 'c')"
4220 in let _ = "checkHorizon.oldCheck: checkedHorizon=16"
4221 in let _ = "checkToken"
4222 in let !(#
4223 c,
4224 cs
4225 #) = readNext buf cs
4226 in if (GHC.Classes.==) 'c' c
4227 then
4228 let _ = "lift2Value checkedHorizon=15"
4229 in let _ = "comment: satisfy ((GHC.Classes.==) 't')"
4230 in let _ = "checkHorizon.oldCheck: checkedHorizon=15"
4231 in let _ = "checkToken"
4232 in let !(#
4233 c,
4234 cs
4235 #) = readNext buf cs
4236 in if (GHC.Classes.==) 't' c
4237 then
4238 let _ = "lift2Value checkedHorizon=14"
4239 in let _ = "comment: satisfy ((GHC.Classes.==) 'i')"
4240 in let _ = "checkHorizon.oldCheck: checkedHorizon=14"
4241 in let _ = "checkToken"
4242 in let !(#
4243 c,
4244 cs
4245 #) = readNext buf cs
4246 in if (GHC.Classes.==) 'i' c
4247 then
4248 let _ = "lift2Value checkedHorizon=13"
4249 in let _ = "comment: satisfy ((GHC.Classes.==) 'o')"
4250 in let _ = "checkHorizon.oldCheck: checkedHorizon=13"
4251 in let _ = "checkToken"
4252 in let !(#
4253 c,
4254 cs
4255 #) = readNext buf cs
4256 in if (GHC.Classes.==) 'o' c
4257 then
4258 let _ = "lift2Value checkedHorizon=12"
4259 in let _ = "comment: satisfy ((GHC.Classes.==) 'n')"
4260 in let _ = "checkHorizon.oldCheck: checkedHorizon=12"
4261 in let _ = "checkToken"
4262 in let !(#
4263 c,
4264 cs
4265 #) = readNext buf cs
4266 in if (GHC.Classes.==) 'n' c
4267 then
4268 let _ = "lift2Value checkedHorizon=11"
4269 in let _ = "commit"
4270 in let _ = "lift2Value checkedHorizon=11"
4271 in name
4272 ( let _ = "onReturn"
4273 in \farInp farExp v (!inp) buf end ->
4274 let _ = "lift2Value checkedHorizon=0"
4275 in name
4276 ( let _ = "onReturn"
4277 in \farInp farExp v (!inp) buf end ->
4278 let _ = "lift2Value checkedHorizon=0"
4279 in name
4280 ( let _ = "onReturn"
4281 in \farInp farExp v (!inp) buf end ->
4282 let _ = "lift2Value checkedHorizon=0"
4283 in let join = \farInp farExp v (!inp) buf end ->
4284 let _ = "lift2Value checkedHorizon=0"
4285 in name
4286 ( let _ = "onReturn"
4287 in \farInp farExp v (!inp) buf end ->
4288 let _ = "lift2Value checkedHorizon=0"
4289 in name
4290 ( let _ = "onReturn"
4291 in \farInp farExp v (!inp) buf end ->
4292 let _ = "lift2Value checkedHorizon=0"
4293 in do
4294 sr <- GHC.STRef.readSTRef reg
4295 let _ = "lift2Value checkedHorizon=0"
4296 in do
4297 let dupv = sr
4298 GHC.STRef.writeSTRef reg dupv
4299 let _ = "jump"
4300 in loop (GHC.Err.error "invalid onReturn") inp buf end (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
4301 )
4302 inp
4303 buf
4304 end
4305 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
4306 )
4307 inp
4308 buf
4309 end
4310 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
4311 in let _ = "catch ExceptionFailure checkedHorizon=0"
4312 in let onException =
4313 let _ = "onException"
4314 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
4315 let _ = "comment: raiseAgainIfConsumed"
4316 in let _ = "saveInput checkedHorizon=0"
4317 in let _ = "lift2Value checkedHorizon=0"
4318 in if (GHC.Classes.==) @GHC.Types.Int inp failInp
4319 then
4320 let _ = "choicesBranch checkedHorizon=0"
4321 in name
4322 ( let _ = "onReturn"
4323 in \farInp farExp v (!inp) buf end ->
4324 let _ = "resume"
4325 in join
4326 farInp
4327 farExp
4328 ( let _ = "resume.genCode"
4329 in v
4330 )
4331 inp
4332 buf
4333 end
4334 )
4335 failInp
4336 buf
4337 end
4338 Data.Map.Internal.Tip
4339 else
4340 let _ = "choicesBranch.else"
4341 in onException callerInput Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
4342 in let _ = "pushValue"
4343 in let _ = "comment: satisfy ((GHC.Classes.==) ':')"
4344 in let partialCont buf =
4345 let readFail = onException
4346 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=8"
4347 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 7 inp)
4348 then
4349 let _ = "checkToken"
4350 in let !(#
4351 c,
4352 cs
4353 #) = readNext buf inp
4354 in if (GHC.Classes.==) ':' c
4355 then
4356 let _ = "lift2Value checkedHorizon=8"
4357 in name
4358 ( let _ = "onReturn"
4359 in \farInp farExp v (!inp) buf end ->
4360 let _ = "lift2Value checkedHorizon=0"
4361 in name
4362 ( let _ = "onReturn"
4363 in \farInp farExp v (!inp) buf end ->
4364 let _ = "lift2Value checkedHorizon=0"
4365 in let _ = "commit"
4366 in let _ = "resume"
4367 in join
4368 farInp
4369 farExp
4370 ( let _ = "resume.genCode"
4371 in GHC.Tuple . ()
4372 )
4373 inp
4374 buf
4375 end
4376 )
4377 inp
4378 buf
4379 end
4380 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
4381 )
4382 cs
4383 buf
4384 end
4385 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure readFail Data.Map.Internal.Tip Data.Map.Internal.Tip)
4386 else
4387 let _ = "checkToken.fail"
4388 in let failExp =
4389 Data.Set.Internal.Bin
4390 1
4391 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4392 ( case inputToken of
4393 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken ':'
4394 )
4395 )
4396 Data.Set.Internal.Tip
4397 Data.Set.Internal.Tip
4398 in let (#
4399 farInp,
4400 farExp
4401 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
4402 GHC.Types.LT ->
4403 (#
4404 inp,
4405 failExp
4406 #)
4407 GHC.Types.EQ ->
4408 (#
4409 farInp,
4410 failExp GHC.Base.<> farExp
4411 #)
4412 GHC.Types.GT ->
4413 (#
4414 farInp,
4415 farExp
4416 #)
4417 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf end
4418 else
4419 let _ = "checkHorizon.newCheck.fail"
4420 in let noMoreInput =
4421 let failExp =
4422 Data.Set.Internal.Bin
4423 1
4424 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4425 ( case inputToken of
4426 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 8
4427 )
4428 )
4429 Data.Set.Internal.Tip
4430 Data.Set.Internal.Tip
4431 in let (#
4432 farInp,
4433 farExp
4434 #) = case GHC.Classes.compare @GHC.Types.Int farInp inp of
4435 GHC.Types.LT ->
4436 (#
4437 inp,
4438 failExp
4439 #)
4440 GHC.Types.EQ ->
4441 (#
4442 farInp,
4443 failExp GHC.Base.<> farExp
4444 #)
4445 GHC.Types.GT ->
4446 (#
4447 farInp,
4448 farExp
4449 #)
4450 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure inp farInp farExp buf GHC.Types.True
4451 in if end
4452 then noMoreInput
4453 else
4454 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
4455 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
4456 ( \newInput ->
4457 if Symantic.Parser.Machine.Input.nullInput newInput
4458 then noMoreInput
4459 else partialCont (append buf newInput)
4460 )
4461 )
4462 in partialCont buf
4463 )
4464 inp
4465 buf
4466 end
4467 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
4468 )
4469 inp
4470 buf
4471 end
4472 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
4473 )
4474 cs
4475 buf
4476 callerEnded
4477 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
4478 else
4479 let _ = "checkToken.fail"
4480 in let failExp =
4481 Data.Set.Internal.Bin
4482 1
4483 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4484 ( case inputToken of
4485 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'n'
4486 )
4487 )
4488 Data.Set.Internal.Tip
4489 Data.Set.Internal.Tip
4490 in let (#
4491 farInp,
4492 farExp
4493 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4494 GHC.Types.LT ->
4495 (#
4496 cs,
4497 failExp
4498 #)
4499 GHC.Types.EQ ->
4500 (#
4501 farInp,
4502 failExp GHC.Base.<> farExp
4503 #)
4504 GHC.Types.GT ->
4505 (#
4506 farInp,
4507 farExp
4508 #)
4509 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4510 else
4511 let _ = "checkToken.fail"
4512 in let failExp =
4513 Data.Set.Internal.Bin
4514 1
4515 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4516 ( case inputToken of
4517 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'o'
4518 )
4519 )
4520 Data.Set.Internal.Tip
4521 Data.Set.Internal.Tip
4522 in let (#
4523 farInp,
4524 farExp
4525 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4526 GHC.Types.LT ->
4527 (#
4528 cs,
4529 failExp
4530 #)
4531 GHC.Types.EQ ->
4532 (#
4533 farInp,
4534 failExp GHC.Base.<> farExp
4535 #)
4536 GHC.Types.GT ->
4537 (#
4538 farInp,
4539 farExp
4540 #)
4541 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4542 else
4543 let _ = "checkToken.fail"
4544 in let failExp =
4545 Data.Set.Internal.Bin
4546 1
4547 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4548 ( case inputToken of
4549 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'i'
4550 )
4551 )
4552 Data.Set.Internal.Tip
4553 Data.Set.Internal.Tip
4554 in let (#
4555 farInp,
4556 farExp
4557 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4558 GHC.Types.LT ->
4559 (#
4560 cs,
4561 failExp
4562 #)
4563 GHC.Types.EQ ->
4564 (#
4565 farInp,
4566 failExp GHC.Base.<> farExp
4567 #)
4568 GHC.Types.GT ->
4569 (#
4570 farInp,
4571 farExp
4572 #)
4573 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4574 else
4575 let _ = "checkToken.fail"
4576 in let failExp =
4577 Data.Set.Internal.Bin
4578 1
4579 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4580 ( case inputToken of
4581 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 't'
4582 )
4583 )
4584 Data.Set.Internal.Tip
4585 Data.Set.Internal.Tip
4586 in let (#
4587 farInp,
4588 farExp
4589 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4590 GHC.Types.LT ->
4591 (#
4592 cs,
4593 failExp
4594 #)
4595 GHC.Types.EQ ->
4596 (#
4597 farInp,
4598 failExp GHC.Base.<> farExp
4599 #)
4600 GHC.Types.GT ->
4601 (#
4602 farInp,
4603 farExp
4604 #)
4605 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4606 else
4607 let _ = "checkToken.fail"
4608 in let failExp =
4609 Data.Set.Internal.Bin
4610 1
4611 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4612 ( case inputToken of
4613 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c'
4614 )
4615 )
4616 Data.Set.Internal.Tip
4617 Data.Set.Internal.Tip
4618 in let (#
4619 farInp,
4620 farExp
4621 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4622 GHC.Types.LT ->
4623 (#
4624 cs,
4625 failExp
4626 #)
4627 GHC.Types.EQ ->
4628 (#
4629 farInp,
4630 failExp GHC.Base.<> farExp
4631 #)
4632 GHC.Types.GT ->
4633 (#
4634 farInp,
4635 farExp
4636 #)
4637 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4638 else
4639 let _ = "checkToken.fail"
4640 in let failExp =
4641 Data.Set.Internal.Bin
4642 1
4643 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4644 ( case inputToken of
4645 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'n'
4646 )
4647 )
4648 Data.Set.Internal.Tip
4649 Data.Set.Internal.Tip
4650 in let (#
4651 farInp,
4652 farExp
4653 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4654 GHC.Types.LT ->
4655 (#
4656 cs,
4657 failExp
4658 #)
4659 GHC.Types.EQ ->
4660 (#
4661 farInp,
4662 failExp GHC.Base.<> farExp
4663 #)
4664 GHC.Types.GT ->
4665 (#
4666 farInp,
4667 farExp
4668 #)
4669 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4670 else
4671 let _ = "checkToken.fail"
4672 in let failExp =
4673 Data.Set.Internal.Bin
4674 1
4675 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4676 ( case inputToken of
4677 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'u'
4678 )
4679 )
4680 Data.Set.Internal.Tip
4681 Data.Set.Internal.Tip
4682 in let (#
4683 farInp,
4684 farExp
4685 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
4686 GHC.Types.LT ->
4687 (#
4688 cs,
4689 failExp
4690 #)
4691 GHC.Types.EQ ->
4692 (#
4693 farInp,
4694 failExp GHC.Base.<> farExp
4695 #)
4696 GHC.Types.GT ->
4697 (#
4698 farInp,
4699 farExp
4700 #)
4701 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnded
4702 else
4703 let _ = "checkToken.fail"
4704 in let failExp =
4705 Data.Set.Internal.Bin
4706 1
4707 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4708 ( case inputToken of
4709 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'f'
4710 )
4711 )
4712 Data.Set.Internal.Tip
4713 Data.Set.Internal.Tip
4714 in let (#
4715 farInp,
4716 farExp
4717 #) = case GHC.Classes.compare @GHC.Types.Int farInp callerInput of
4718 GHC.Types.LT ->
4719 (#
4720 callerInput,
4721 failExp
4722 #)
4723 GHC.Types.EQ ->
4724 (#
4725 farInp,
4726 failExp GHC.Base.<> farExp
4727 #)
4728 GHC.Types.GT ->
4729 (#
4730 farInp,
4731 farExp
4732 #)
4733 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnded
4734 else
4735 let _ = "checkHorizon.newCheck.fail"
4736 in let noMoreInput =
4737 let failExp =
4738 Data.Set.Internal.Bin
4739 1
4740 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4741 ( case inputToken of
4742 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 18
4743 )
4744 )
4745 Data.Set.Internal.Tip
4746 Data.Set.Internal.Tip
4747 in let (#
4748 farInp,
4749 farExp
4750 #) = case GHC.Classes.compare @GHC.Types.Int farInp callerInput of
4751 GHC.Types.LT ->
4752 (#
4753 callerInput,
4754 failExp
4755 #)
4756 GHC.Types.EQ ->
4757 (#
4758 farInp,
4759 failExp GHC.Base.<> farExp
4760 #)
4761 GHC.Types.GT ->
4762 (#
4763 farInp,
4764 farExp
4765 #)
4766 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
4767 in if callerEnded
4768 then noMoreInput
4769 else
4770 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
4771 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
4772 ( \newInput ->
4773 if Symantic.Parser.Machine.Input.nullInput newInput
4774 then noMoreInput
4775 else partialCont (append buf newInput)
4776 )
4777 )
4778 in partialCont callerBuffer
4779 in let _ = "jump"
4780 in loop finalRet inp buf end Data.Map.Internal.Tip
4781 )
4782 initPos
4783 buf
4784 GHC.Types.False
4785 Data.Map.Internal.Tip
4786 else
4787 let _ = "checkHorizon.newCheck.fail"
4788 in let noMoreInput =
4789 let failExp =
4790 Data.Set.Internal.Bin
4791 1
4792 ( Symantic.Parser.Grammar.Combinators.SomeFailure
4793 ( case inputToken of
4794 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
4795 )
4796 )
4797 Data.Set.Internal.Tip
4798 Data.Set.Internal.Tip
4799 in let (#
4800 farInp,
4801 farExp
4802 #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
4803 GHC.Types.LT ->
4804 (#
4805 initPos,
4806 failExp
4807 #)
4808 GHC.Types.EQ ->
4809 (#
4810 initPos,
4811 failExp GHC.Base.<> Data.Set.Internal.empty
4812 #)
4813 GHC.Types.GT ->
4814 (#
4815 initPos,
4816 Data.Set.Internal.empty
4817 #)
4818 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.True
4819 in if GHC.Types.False
4820 then noMoreInput
4821 else
4822 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
4823 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
4824 ( \newInput ->
4825 if Symantic.Parser.Machine.Input.nullInput newInput
4826 then noMoreInput
4827 else partialCont (append buf newInput)
4828 )
4829 )
4830 in partialCont initBuffer
Library for parsing