]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice/G6.expected.txt
impl: add `programWriter`
[haskell/symantic-parser.git] / tests / Golden / Splice / G6.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 _ = "pushValue"
109 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
110 in let partialCont buf =
111 let readFail = Symantic.Parser.Machine.Generate.unForallOnException finalRaise
112 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=2"
113 in if readMore buf ((GHC.Num.+) @GHC.Types.Int 1 failInp)
114 then
115 let _ = "checkToken"
116 in let !(#
117 c,
118 cs
119 #) = readNext buf failInp
120 in if (GHC.Classes.==) 'a' c
121 then
122 let _ = "lift2Value checkedHorizon=2"
123 in let _ = "comment: satisfy ((GHC.Classes.==) 'b')"
124 in let _ = "checkHorizon.oldCheck: checkedHorizon=2"
125 in let _ = "checkToken"
126 in let !(#
127 c,
128 cs
129 #) = readNext buf cs
130 in if (GHC.Classes.==) 'b' c
131 then
132 let _ = "lift2Value checkedHorizon=1"
133 in let _ = "resume"
134 in join
135 farInp
136 farExp
137 ( let _ = "resume.genCode"
138 in (GHC.Types.:) 'a' ((GHC.Types.:) 'b' GHC.Types . [])
139 )
140 cs
141 buf
142 end
143 else
144 let _ = "checkToken.fail"
145 in let failExp =
146 Data.Set.Internal.Bin
147 1
148 ( Symantic.Parser.Grammar.Combinators.SomeFailure
149 ( case inputToken of
150 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b'
151 )
152 )
153 Data.Set.Internal.Tip
154 Data.Set.Internal.Tip
155 in let (#
156 farInp,
157 farExp
158 #) = case GHC.Classes.compare @GHC.Types.Int farInp cs of
159 GHC.Types.LT ->
160 (#
161 cs,
162 failExp
163 #)
164 GHC.Types.EQ ->
165 (#
166 farInp,
167 failExp GHC.Base.<> farExp
168 #)
169 GHC.Types.GT ->
170 (#
171 farInp,
172 farExp
173 #)
174 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf end
175 else
176 let _ = "checkToken.fail"
177 in let failExp =
178 Data.Set.Internal.Bin
179 1
180 ( Symantic.Parser.Grammar.Combinators.SomeFailure
181 ( case inputToken of
182 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
183 )
184 )
185 Data.Set.Internal.Tip
186 Data.Set.Internal.Tip
187 in let (#
188 farInp,
189 farExp
190 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
191 GHC.Types.LT ->
192 (#
193 failInp,
194 failExp
195 #)
196 GHC.Types.EQ ->
197 (#
198 farInp,
199 failExp GHC.Base.<> farExp
200 #)
201 GHC.Types.GT ->
202 (#
203 farInp,
204 farExp
205 #)
206 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
207 else
208 let _ = "checkHorizon.newCheck.fail"
209 in let noMoreInput =
210 let failExp =
211 Data.Set.Internal.Bin
212 1
213 ( Symantic.Parser.Grammar.Combinators.SomeFailure
214 ( case inputToken of
215 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
216 )
217 )
218 Data.Set.Internal.Tip
219 Data.Set.Internal.Tip
220 in let (#
221 farInp,
222 farExp
223 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
224 GHC.Types.LT ->
225 (#
226 failInp,
227 failExp
228 #)
229 GHC.Types.EQ ->
230 (#
231 farInp,
232 failExp GHC.Base.<> farExp
233 #)
234 GHC.Types.GT ->
235 (#
236 farInp,
237 farExp
238 #)
239 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
240 in if end
241 then noMoreInput
242 else
243 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
244 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
245 ( \newInput ->
246 if Symantic.Parser.Machine.Input.nullInput newInput
247 then noMoreInput
248 else partialCont (append buf newInput)
249 )
250 )
251 in partialCont buf
252 else
253 let _ = "choicesBranch.else"
254 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
255 in let _ = "pushValue"
256 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
257 in let _ = "checkHorizon.oldCheck: checkedHorizon=2"
258 in let _ = "checkToken"
259 in let !(#
260 c,
261 cs
262 #) = readNext buf initPos
263 in if (GHC.Classes.==) 'a' c
264 then
265 let _ = "lift2Value checkedHorizon=1"
266 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
267 in let _ = "checkHorizon.oldCheck: checkedHorizon=1"
268 in let _ = "checkToken"
269 in let !(#
270 c,
271 cs
272 #) = readNext buf cs
273 in if (GHC.Classes.==) 'a' c
274 then
275 let _ = "lift2Value checkedHorizon=0"
276 in let _ = "commit"
277 in let _ = "resume"
278 in join
279 initPos
280 Data.Set.Internal.empty
281 ( let _ = "resume.genCode"
282 in (GHC.Types.:) 'a' ((GHC.Types.:) 'a' GHC.Types . [])
283 )
284 cs
285 buf
286 GHC.Types.False
287 else
288 let _ = "checkToken.fail"
289 in let failExp =
290 Data.Set.Internal.Bin
291 1
292 ( Symantic.Parser.Grammar.Combinators.SomeFailure
293 ( case inputToken of
294 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
295 )
296 )
297 Data.Set.Internal.Tip
298 Data.Set.Internal.Tip
299 in let (#
300 farInp,
301 farExp
302 #) = case GHC.Classes.compare @GHC.Types.Int initPos cs of
303 GHC.Types.LT ->
304 (#
305 cs,
306 failExp
307 #)
308 GHC.Types.EQ ->
309 (#
310 initPos,
311 failExp GHC.Base.<> Data.Set.Internal.empty
312 #)
313 GHC.Types.GT ->
314 (#
315 initPos,
316 Data.Set.Internal.empty
317 #)
318 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure cs farInp farExp buf GHC.Types.False
319 else
320 let _ = "checkToken.fail"
321 in let failExp =
322 Data.Set.Internal.Bin
323 1
324 ( Symantic.Parser.Grammar.Combinators.SomeFailure
325 ( case inputToken of
326 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
327 )
328 )
329 Data.Set.Internal.Tip
330 Data.Set.Internal.Tip
331 in let (#
332 farInp,
333 farExp
334 #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
335 GHC.Types.LT ->
336 (#
337 initPos,
338 failExp
339 #)
340 GHC.Types.EQ ->
341 (#
342 initPos,
343 failExp GHC.Base.<> Data.Set.Internal.empty
344 #)
345 GHC.Types.GT ->
346 (#
347 initPos,
348 Data.Set.Internal.empty
349 #)
350 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.False
351 else
352 let _ = "checkHorizon.newCheck.fail"
353 in let noMoreInput =
354 let failExp =
355 Data.Set.Internal.Bin
356 1
357 ( Symantic.Parser.Grammar.Combinators.SomeFailure
358 ( case inputToken of
359 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 2
360 )
361 )
362 Data.Set.Internal.Tip
363 Data.Set.Internal.Tip
364 in let (#
365 farInp,
366 farExp
367 #) = case GHC.Classes.compare @GHC.Types.Int initPos initPos of
368 GHC.Types.LT ->
369 (#
370 initPos,
371 failExp
372 #)
373 GHC.Types.EQ ->
374 (#
375 initPos,
376 failExp GHC.Base.<> Data.Set.Internal.empty
377 #)
378 GHC.Types.GT ->
379 (#
380 initPos,
381 Data.Set.Internal.empty
382 #)
383 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure initPos farInp farExp buf GHC.Types.True
384 in if GHC.Types.False
385 then noMoreInput
386 else
387 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
388 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
389 ( \newInput ->
390 if Symantic.Parser.Machine.Input.nullInput newInput
391 then noMoreInput
392 else partialCont (append buf newInput)
393 )
394 )
395 in partialCont initBuffer