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