]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice/G12.expected.txt
!fixup impl: move `liftTypedString` to `Language.Haskell.TH.Show`
[haskell/symantic-parser.git] / tests / Golden / Splice / G12.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 _ = "checkHorizon.noCheck"
80 in let
81 in let _ = "pushValue"
82 in let _ = "pushValue"
83 in do
84 let dupv = \u -> u
85 reg <- GHC.STRef.newSTRef dupv
86 let _ = "iter"
87 in let onException loopInput =
88 let _ = "onException"
89 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
90 let _ = "comment: raiseAgainIfConsumed"
91 in let _ = "saveInput checkedHorizon=0"
92 in let _ = "lift2Value checkedHorizon=0"
93 in if (GHC.Classes.==) @GHC.Types.Int loopInput failInp
94 then
95 let _ = "choicesBranch checkedHorizon=0"
96 in do
97 sr <- GHC.STRef.readSTRef reg
98 let _ = "pushValue"
99 in let _ = "lift2Value checkedHorizon=0"
100 in let _ = "lift2Value checkedHorizon=0"
101 in let join = \farInp farExp v (!inp) buf end ->
102 let _ = "lift2Value checkedHorizon=0"
103 in let _ = "resume"
104 in finalRet
105 farInp
106 farExp
107 ( let _ = "resume.genCode"
108 in GHC.Show.show (sr GHC.Types . [])
109 )
110 inp
111 buf
112 end
113 in let _ = "catch ExceptionFailure checkedHorizon=0"
114 in let onException =
115 let _ = "onException"
116 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
117 let _ = "comment: raiseAgainIfConsumed"
118 in let _ = "saveInput checkedHorizon=0"
119 in let _ = "lift2Value checkedHorizon=0"
120 in if (GHC.Classes.==) @GHC.Types.Int failInp failInp
121 then
122 let _ = "choicesBranch checkedHorizon=0"
123 in let _ = "comment: eof.fail"
124 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
125 in let (#
126 farInp,
127 farExp
128 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
129 GHC.Types.LT ->
130 (#
131 failInp,
132 failExp
133 #)
134 GHC.Types.EQ ->
135 (#
136 farInp,
137 failExp GHC.Base.<> farExp
138 #)
139 GHC.Types.GT ->
140 (#
141 farInp,
142 farExp
143 #)
144 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
145 else
146 let _ = "choicesBranch.else"
147 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
148 in let _ = "comment: negLook"
149 in let _ = "catch ExceptionFailure checkedHorizon=0"
150 in let onException =
151 let _ = "onException"
152 in \(!_exn) (!failInp) (!farInp) (!farExp) buf end ->
153 let _ = "comment: negLook.reset"
154 in let _ = "loadInput checkedHorizon=0"
155 in let _ = "checkHorizon.noCheck"
156 in let _ = "pushValue"
157 in let _ = "commit"
158 in let _ = "resume"
159 in join
160 farInp
161 farExp
162 ( let _ = "resume.genCode"
163 in GHC.Tuple . ()
164 )
165 failInp
166 buf
167 end
168 in let _ = "comment: negLook.ahead"
169 in let _ = "saveInput checkedHorizon=0"
170 in let _ = "comment: satisfy (GHC.Base.const GHC.Types.True)"
171 in let partialCont buf =
172 let readFail = onException
173 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
174 in if readMore buf failInp
175 then
176 let _ = "checkToken"
177 in let !(#
178 c,
179 cs
180 #) = readNext buf failInp
181 in let _ = "popValue"
182 in let _ = "commit"
183 in let _ = "loadInput checkedHorizon=0"
184 in let _ = "checkHorizon.noCheck"
185 in onException Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
186 else
187 let _ = "checkHorizon.newCheck.fail"
188 in let noMoreInput =
189 let failExp =
190 Data.Set.Internal.Bin
191 1
192 ( Symantic.Parser.Grammar.Combinators.SomeFailure
193 ( case inputToken of
194 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
195 )
196 )
197 Data.Set.Internal.Tip
198 Data.Set.Internal.Tip
199 in let (#
200 farInp,
201 farExp
202 #) = case GHC.Classes.compare @GHC.Types.Int farInp failInp of
203 GHC.Types.LT ->
204 (#
205 failInp,
206 failExp
207 #)
208 GHC.Types.EQ ->
209 (#
210 farInp,
211 failExp GHC.Base.<> farExp
212 #)
213 GHC.Types.GT ->
214 (#
215 farInp,
216 farExp
217 #)
218 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf GHC.Types.True
219 in if end
220 then noMoreInput
221 else
222 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
223 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
224 ( \newInput ->
225 if Symantic.Parser.Machine.Input.nullInput newInput
226 then noMoreInput
227 else partialCont (append buf newInput)
228 )
229 )
230 in partialCont buf
231 else
232 let _ = "choicesBranch.else"
233 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
234 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
235 let _ = "pushValue"
236 in let _ = "comment: satisfy (\\t_0 -> ('a' GHC.Classes.== t_0) GHC.Classes.|| (('b' GHC.Classes.== t_0) GHC.Classes.|| (('c' GHC.Classes.== t_0) GHC.Classes.|| (('d' GHC.Classes.== t_0) GHC.Classes.|| GHC.Types.False))))"
237 in let partialCont buf =
238 let readFail = onException callerInput
239 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
240 in if readMore buf callerInput
241 then
242 let _ = "checkToken"
243 in let !(#
244 c,
245 cs
246 #) = readNext buf callerInput
247 in if (\t -> ('a' GHC.Classes.== t) GHC.Classes.|| (('b' GHC.Classes.== t) GHC.Classes.|| (('c' GHC.Classes.== t) GHC.Classes.|| (('d' GHC.Classes.== t) GHC.Classes.|| GHC.Types.False)))) c
248 then
249 let _ = "lift2Value checkedHorizon=1"
250 in let _ = "pushValue"
251 in let _ = "lift2Value checkedHorizon=1"
252 in do
253 sr <- GHC.STRef.readSTRef reg
254 let _ = "lift2Value checkedHorizon=1"
255 in do
256 let dupv = \u -> sr ((GHC.Types.:) c u)
257 GHC.STRef.writeSTRef reg dupv
258 let _ = "jump"
259 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)
260 else
261 let _ = "checkToken.fail"
262 in let failExp =
263 Data.Set.Internal.Bin
264 4
265 ( Symantic.Parser.Grammar.Combinators.SomeFailure
266 ( case inputToken of
267 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'b'
268 )
269 )
270 ( Data.Set.Internal.Bin
271 1
272 ( Symantic.Parser.Grammar.Combinators.SomeFailure
273 ( case inputToken of
274 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
275 )
276 )
277 Data.Set.Internal.Tip
278 Data.Set.Internal.Tip
279 )
280 ( Data.Set.Internal.Bin
281 2
282 ( Symantic.Parser.Grammar.Combinators.SomeFailure
283 ( case inputToken of
284 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'c'
285 )
286 )
287 Data.Set.Internal.Tip
288 ( Data.Set.Internal.Bin
289 1
290 ( Symantic.Parser.Grammar.Combinators.SomeFailure
291 ( case inputToken of
292 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'd'
293 )
294 )
295 Data.Set.Internal.Tip
296 Data.Set.Internal.Tip
297 )
298 )
299 in let (#
300 farInp,
301 farExp
302 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
303 GHC.Types.LT ->
304 (#
305 callerInput,
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 readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnded
319 else
320 let _ = "checkHorizon.newCheck.fail"
321 in let noMoreInput =
322 let failExp =
323 Data.Set.Internal.Bin
324 1
325 ( Symantic.Parser.Grammar.Combinators.SomeFailure
326 ( case inputToken of
327 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
328 )
329 )
330 Data.Set.Internal.Tip
331 Data.Set.Internal.Tip
332 in let (#
333 farInp,
334 farExp
335 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
336 GHC.Types.LT ->
337 (#
338 callerInput,
339 failExp
340 #)
341 GHC.Types.EQ ->
342 (#
343 initPos,
344 failExp GHC.Base.<> Data.Set.Internal.empty
345 #)
346 GHC.Types.GT ->
347 (#
348 initPos,
349 Data.Set.Internal.empty
350 #)
351 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
352 in if callerEnded
353 then noMoreInput
354 else
355 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
356 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
357 ( \newInput ->
358 if Symantic.Parser.Machine.Input.nullInput newInput
359 then noMoreInput
360 else partialCont (append buf newInput)
361 )
362 )
363 in partialCont callerBuffer
364 in let _ = "jump"
365 in loop finalRet initPos initBuffer GHC.Types.False Data.Map.Internal.Tip