]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice/G5.expected.txt
wip
[haskell/symantic-parser.git] / tests / Golden / Splice / G5.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=4"
82 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 3 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 _ = "loadInput checkedHorizon=0"
90 in let _ = "checkHorizon.noCheck"
91 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
92 in let _ = "pushValue"
93 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
94 in let partialCont buf =
95 let readFail = onException
96 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=4"
97 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 3 callerInput)
98 then
99 let _ = "checkToken"
100 in let !(#
101 c,
102 cs
103 #) = readNext buf callerInput
104 in if (GHC.Classes.==) 'a' c
105 then
106 let _ = "lift2Value checkedHorizon=4"
107 in let _ = "comment: satisfy ((GHC.Classes.==) 'b')"
108 in let _ = "checkHorizon.oldCheck: checkedHorizon=4"
109 in let _ = "checkToken"
110 in let !(#
111 c,
112 cs
113 #) = readNext buf cs
114 in if (GHC.Classes.==) 'b' c
115 then
116 let _ = "lift2Value checkedHorizon=3"
117 in let _ = "comment: satisfy ((GHC.Classes.==) 'c')"
118 in let _ = "checkHorizon.oldCheck: checkedHorizon=3"
119 in let _ = "checkToken"
120 in let !(#
121 c,
122 cs
123 #) = readNext buf cs
124 in if (GHC.Classes.==) 'c' c
125 then
126 let _ = "lift2Value checkedHorizon=2"
127 in let _ = "comment: satisfy ((GHC.Classes.==) 'd')"
128 in let _ = "checkHorizon.oldCheck: checkedHorizon=2"
129 in let _ = "checkToken"
130 in let !(#
131 c,
132 cs
133 #) = readNext buf cs
134 in if (GHC.Classes.==) 'd' c
135 then
136 let _ = "lift2Value checkedHorizon=1"
137 in let _ = "commit"
138 in let _ = "resume"
139 in callerOnReturn
140 initPos
141 Data.Set.Internal.empty
142 ( let _ = "resume.genCode"
143 in (GHC.Types.:) 'a' ((GHC.Types.:) 'b' ((GHC.Types.:) 'c' ((GHC.Types.:) 'd' GHC.Types . [])))
144 )
145 cs
146 buf
147 callerEnd
148 else
149 let _ = "checkToken.fail"
150 in let failExp =
151 Data.Set.Internal.Bin
152 1
153 ( Symantic.Parser.Grammar.Combinators.SomeFailure
154 ( case inputToken of
155 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd'
156 )
157 )
158 Data.Set.Internal.Tip
159 Data.Set.Internal.Tip
160 in let (#
161 farInp,
162 farExp
163 #) = case GHC.Classes.compare @GHC.Types.Int initPos cs of
164 GHC.Types.LT ->
165 (#
166 cs,
167 failExp
168 #)
169 GHC.Types.EQ ->
170 (#
171 initPos,
172 failExp GHC.Base.<> Data.Set.Internal.empty
173 #)
174 GHC.Types.GT ->
175 (#
176 initPos,
177 Data.Set.Internal.empty
178 #)
179 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnd
180 else
181 let _ = "checkToken.fail"
182 in let failExp =
183 Data.Set.Internal.Bin
184 1
185 ( Symantic.Parser.Grammar.Combinators.SomeFailure
186 ( case inputToken of
187 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c'
188 )
189 )
190 Data.Set.Internal.Tip
191 Data.Set.Internal.Tip
192 in let (#
193 farInp,
194 farExp
195 #) = case GHC.Classes.compare @GHC.Types.Int initPos cs of
196 GHC.Types.LT ->
197 (#
198 cs,
199 failExp
200 #)
201 GHC.Types.EQ ->
202 (#
203 initPos,
204 failExp GHC.Base.<> Data.Set.Internal.empty
205 #)
206 GHC.Types.GT ->
207 (#
208 initPos,
209 Data.Set.Internal.empty
210 #)
211 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnd
212 else
213 let _ = "checkToken.fail"
214 in let failExp =
215 Data.Set.Internal.Bin
216 1
217 ( Symantic.Parser.Grammar.Combinators.SomeFailure
218 ( case inputToken of
219 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b'
220 )
221 )
222 Data.Set.Internal.Tip
223 Data.Set.Internal.Tip
224 in let (#
225 farInp,
226 farExp
227 #) = case GHC.Classes.compare @GHC.Types.Int initPos cs of
228 GHC.Types.LT ->
229 (#
230 cs,
231 failExp
232 #)
233 GHC.Types.EQ ->
234 (#
235 initPos,
236 failExp GHC.Base.<> Data.Set.Internal.empty
237 #)
238 GHC.Types.GT ->
239 (#
240 initPos,
241 Data.Set.Internal.empty
242 #)
243 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf callerEnd
244 else
245 let _ = "checkToken.fail"
246 in let failExp =
247 Data.Set.Internal.Bin
248 1
249 ( Symantic.Parser.Grammar.Combinators.SomeFailure
250 ( case inputToken of
251 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
252 )
253 )
254 Data.Set.Internal.Tip
255 Data.Set.Internal.Tip
256 in let (#
257 farInp,
258 farExp
259 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
260 GHC.Types.LT ->
261 (#
262 callerInput,
263 failExp
264 #)
265 GHC.Types.EQ ->
266 (#
267 initPos,
268 failExp GHC.Base.<> Data.Set.Internal.empty
269 #)
270 GHC.Types.GT ->
271 (#
272 initPos,
273 Data.Set.Internal.empty
274 #)
275 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnd
276 else
277 let _ = "checkHorizon.newCheck.fail"
278 in let noMoreInput =
279 let failExp =
280 Data.Set.Internal.Bin
281 1
282 ( Symantic.Parser.Grammar.Combinators.SomeFailure
283 ( case inputToken of
284 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
285 )
286 )
287 Data.Set.Internal.Tip
288 Data.Set.Internal.Tip
289 in let (#
290 farInp,
291 farExp
292 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
293 GHC.Types.LT ->
294 (#
295 callerInput,
296 failExp
297 #)
298 GHC.Types.EQ ->
299 (#
300 initPos,
301 failExp GHC.Base.<> Data.Set.Internal.empty
302 #)
303 GHC.Types.GT ->
304 (#
305 initPos,
306 Data.Set.Internal.empty
307 #)
308 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
309 in if callerEnd
310 then noMoreInput
311 else
312 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
313 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
314 ( \newInput ->
315 if Symantic.Parser.Machine.Input.nullInput newInput
316 then noMoreInput
317 else partialCont (append buf newInput)
318 )
319 )
320 in partialCont callerBuffer
321 in let _ = "pushValue"
322 in name
323 ( let _ = "onReturn"
324 in \farInp farExp v (!inp) buf end ->
325 let _ = "lift2Value checkedHorizon=0"
326 in let _ = "pushValue"
327 in do
328 let dupv = \u -> u
329 reg <- GHC.STRef.newSTRef dupv
330 let _ = "iter"
331 in let onException loopInput =
332 let _ = "onException"
333 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
334 let _ = "comment: raiseAgainIfConsumed"
335 in let _ = "saveInput checkedHorizon=0"
336 in let _ = "lift2Value checkedHorizon=0"
337 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
338 then
339 let _ = "choicesBranch checkedHorizon=0"
340 in do
341 sr <- GHC.STRef.readSTRef reg
342 let _ = "pushValue"
343 in let _ = "lift2Value checkedHorizon=0"
344 in let _ = "lift2Value checkedHorizon=0"
345 in let join = \farInp farExp v (!inp) buf end ->
346 let _ = "lift2Value checkedHorizon=0"
347 in let _ = "resume"
348 in finalRet
349 farInp
350 farExp
351 ( let _ = "resume.genCode"
352 in GHC.Show.show ((GHC.Types.:) v (sr GHC.Types . []))
353 )
354 inp
355 buf
356 end
357 in let _ = "catch ExceptionFailure checkedHorizon=0"
358 in let onException =
359 let _ = "onException"
360 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
361 let _ = "comment: raiseAgainIfConsumed"
362 in let _ = "saveInput checkedHorizon=0"
363 in let _ = "lift2Value checkedHorizon=0"
364 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
365 then
366 let _ = "choicesBranch checkedHorizon=0"
367 in let _ = "comment: eof.fail"
368 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
369 in let (#
370 farInp,
371 farExp
372 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
373 GHC.Types.LT ->
374 (#
375 failInp,
376 failExp
377 #)
378 GHC.Types.EQ ->
379 (#
380 farInp,
381 failExp GHC.Base.<> farExp
382 #)
383 GHC.Types.GT ->
384 (#
385 farInp,
386 farExp
387 #)
388 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
389 else
390 let _ = "choicesBranch.else"
391 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
392 in let _ = "comment: negLook"
393 in let _ = "catch ExceptionFailure checkedHorizon=0"
394 in let onException =
395 let _ = "onException"
396 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
397 let _ = "comment: negLook.reset"
398 in let _ = "loadInput checkedHorizon=0"
399 in let _ = "checkHorizon.noCheck"
400 in let _ = "pushValue"
401 in let _ = "commit"
402 in let _ = "resume"
403 in join
404 farInp
405 farExp
406 ( let _ = "resume.genCode"
407 in GHC.Tuple . ()
408 )
409 failInp
410 buf
411 end
412 in let _ = "comment: negLook.ahead"
413 in let _ = "saveInput checkedHorizon=0"
414 in let _ = "comment: satisfy (GHC.Base.const GHC.Types.True)"
415 in let partialCont buf =
416 let readFail = onException
417 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
418 in if readMore buf failInp
419 then
420 let _ = "checkToken"
421 in let !(#
422 c,
423 cs
424 #) = readNext buf failInp
425 in let _ = "popValue"
426 in let _ = "commit"
427 in let _ = "loadInput checkedHorizon=0"
428 in let _ = "checkHorizon.noCheck"
429 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
430 else
431 let _ = "checkHorizon.newCheck.fail"
432 in let noMoreInput =
433 let failExp =
434 Data.Set.Internal.Bin
435 1
436 ( Symantic.Parser.Grammar.Combinators.SomeFailure
437 ( case inputToken of
438 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
439 )
440 )
441 Data.Set.Internal.Tip
442 Data.Set.Internal.Tip
443 in let (#
444 farInp,
445 farExp
446 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
447 GHC.Types.LT ->
448 (#
449 failInp,
450 failExp
451 #)
452 GHC.Types.EQ ->
453 (#
454 farInp,
455 failExp GHC.Base.<> farExp
456 #)
457 GHC.Types.GT ->
458 (#
459 farInp,
460 farExp
461 #)
462 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
463 in if end
464 then noMoreInput
465 else
466 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
467 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
468 ( \newInput ->
469 if Symantic.Parser.Machine.Input.nullInput newInput
470 then noMoreInput
471 else partialCont (append buf newInput)
472 )
473 )
474 in partialCont buf
475 else
476 let _ = "choicesBranch.else"
477 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
478 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
479 let _ = "pushValue"
480 in name
481 ( let _ = "onReturn"
482 in \farInp farExp v (!inp) buf end ->
483 let _ = "lift2Value checkedHorizon=0"
484 in let _ = "pushValue"
485 in let _ = "lift2Value checkedHorizon=0"
486 in do
487 sr <- GHC.STRef.readSTRef reg
488 let _ = "lift2Value checkedHorizon=0"
489 in do
490 let dupv = \u -> sr ((GHC.Types.:) v u)
491 GHC.STRef.writeSTRef reg dupv
492 let _ = "jump"
493 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)
494 )
495 callerInput
496 callerBuffer
497 callerEnded
498 (Data.Map.Internal.Bin 1 Symantic.Parser.Grammar.Combinators.ExceptionFailure (onException callerInput) Data.Map.Internal.Tip Data.Map.Internal.Tip)
499 in let _ = "jump"
500 in loop finalRet inp buf end Data.Map.Internal.Tip
501 )
502 initPos
503 buf
504 GHC.Types.False
505 Data.Map.Internal.Tip
506 else
507 let _ = "checkHorizon.newCheck.fail"
508 in let noMoreInput =
509 let failExp =
510 Data.Set.Internal.Bin
511 1
512 ( Symantic.Parser.Grammar.Combinators.SomeFailure
513 ( case inputToken of
514 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 4
515 )
516 )
517 Data.Set.Internal.Tip
518 Data.Set.Internal.Tip
519 in let (#
520 farInp,
521 farExp
522 #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
523 GHC.Types.LT ->
524 (#
525 initPos,
526 failExp
527 #)
528 GHC.Types.EQ ->
529 (#
530 initPos,
531 failExp GHC.Base.<> Data.Set.Internal.empty
532 #)
533 GHC.Types.GT ->
534 (#
535 initPos,
536 Data.Set.Internal.empty
537 #)
538 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.True
539 in if GHC.Types.False
540 then noMoreInput
541 else
542 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
543 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
544 ( \newInput ->
545 if Symantic.Parser.Machine.Input.nullInput newInput
546 then noMoreInput
547 else partialCont (append buf newInput)
548 )
549 )
550 in partialCont initBuffer