]> Git — Sourcephile - haskell/symantic-parser.git/blob - parsers/Parsers/Brainfuck/SymanticParser.hs
sourcephile / git / haskell / symantic-parser.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
tests: fix Nandlang
[haskell/symantic-parser.git] / parsers / Parsers / Brainfuck / SymanticParser.hs
1 {-# LANGUAGE AllowAmbiguousTypes #-}
2 {-# LANGUAGE BangPatterns #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4 {-# LANGUAGE TemplateHaskell #-}
5 {-# LANGUAGE TypeApplications #-}
6 {-# LANGUAGE ViewPatterns #-}
7 -- for Symantic.Parser's TemplateHaskell
8 {-# LANGUAGE MagicHash #-}
9 {-# LANGUAGE ScopedTypeVariables #-}
10 {-# LANGUAGE RankNTypes #-}
11 {-# LANGUAGE UnboxedTuples #-}
12 {-# OPTIONS_GHC -Wno-unused-matches #-}
13 {-# OPTIONS_GHC -Wno-unused-local-binds #-}
14 module Parsers.Brainfuck.SymanticParser
15 ( module Parsers.Brainfuck.SymanticParser
16 , module Parsers.Brainfuck.SymanticParser.Grammar
17 ) where
18
19 import Data.String (String)
20 import qualified Data.ByteString as BS
21 import qualified Data.ByteString.Lazy as BSL
22 import qualified Data.Text as T
23 --import qualified Data.Text.Lazy as TL
24 import qualified Symantic.Parser as SP
25 import qualified Data.Function
26 import qualified Data.Text.Unsafe
27 import qualified Data.Text.Internal
28 import qualified GHC.Num
29 import qualified GHC.Err
30 import qualified GHC.Classes
31 import qualified GHC.Base
32 import qualified GHC.Maybe
33 import qualified Data.Set.Internal
34 import qualified Data.Proxy
35 import qualified GHC.STRef
36 import qualified Data.Map.Strict.Internal
37 import qualified Data.Map.Internal
38 import qualified GHC.Types
39
40 -- 'grammar' must be in an another module because of GHC's stage restriction.
41 import Parsers.Brainfuck.SymanticParser.Grammar (grammar)
42 import Parsers.Brainfuck.Types (Instruction(..))
43 {-
44 parserByteString :: BS.ByteString -> SP.Parsed BS.ByteString [Instruction]
45 parserByteString = $$(SP.runParser @BS.ByteString grammar)
46
47 parserByteStringLazy :: BSL.ByteString -> SP.Parsed BSL.ByteString [Instruction]
48 parserByteStringLazy = $$(SP.runParser @BSL.ByteString grammar)
49
50 parserString :: String -> SP.Parsed String [Instruction]
51 parserString = $$(SP.runParser @String grammar)
52 -}
53
54 parserText :: T.Text -> SP.Parsed T.Text [Instruction]
55 parserText = $$(SP.runParser @T.Text grammar)
56
57 --parserTextLazy :: TL.Text -> Either (SP.ParsingError TL.Text) [Instruction]
58 --parserTextLazy = $$(SP.runParser @TL.Text grammar)
59 {-
60 parserText :: T.Text -> SP.Parsed T.Text [Instruction]
61 parserText =
62 \ (input_a6uU :: inp_aahm)
63 -> let
64 !(# init_a6uW, readMore_a6uX, readNext_a6uY #)
65 = let _ = "cursorOf" in
66 let
67 next_a6v1
68 t_a6v2@(Data.Text.Internal.Text arr_a6v3 off_a6v4 unconsumed_a6v5)
69 = let
70 !(Data.Text.Unsafe.Iter c_a6v6 d_a6v7)
71 = (Data.Text.Unsafe.iter t_a6v2) 0
72 in
73 (# c_a6v6,
74 ((Data.Text.Internal.Text arr_a6v3) (off_a6v4 GHC.Num.+ d_a6v7))
75 (unconsumed_a6v5 GHC.Num.- d_a6v7) #)
76 more_a6v0 (Data.Text.Internal.Text _ _ unconsumed_a6v8)
77 = (unconsumed_a6v8 GHC.Classes.> 0)
78 in (# input_a6uU, more_a6v0, next_a6v1 #)
79 finalRet_a6uV
80 = \ _farInp_a6v9 _farExp_a6va v_a6vb _inp_a6vc
81 -> (SP.returnST GHC.Base.$ SP.ResultDone v_a6vb)
82 finalRaise_a6uZ :: forall b_a6vd. SP.OnException inp_aahm b_a6vd
83 = \ !exn_a6ve _failInp_a6vf !farInp_a6vg !farExp_a6vh
84 -> (SP.returnST
85 GHC.Base.$
86 SP.ResultError
87 SP.ParsingError
88 {SP.parsingErrorOffset = SP.offset farInp_a6vg,
89 SP.parsingErrorException = exn_a6ve,
90 SP.parsingErrorUnexpected = if readMore_a6uX farInp_a6vg then
91 GHC.Maybe.Just
92 (let
93 (# c_a6vi, _ #)
94 = readNext_a6uY farInp_a6vg
95 in c_a6vi)
96 else
97 GHC.Maybe.Nothing,
98 SP.parsingErrorExpecting = let
99 (minHoriz_a6vj, res_a6vk)
100 = ((Data.Set.Internal.foldr
101 (\ f_a6vl (minH_a6vm, acc_a6vn)
102 -> case
103 SP.unSomeFailure f_a6vl
104 of
105 GHC.Maybe.Just (SP.FailureHorizon h_a6vo :: SP.Failure (SP.CombSatisfiable (SP.InputToken inp_aahm)))
106 | GHC.Maybe.Just old_a6vp <- minH_a6vm
107 -> (GHC.Maybe.Just
108 ((GHC.Classes.min
109 old_a6vp)
110 h_a6vo),
111 acc_a6vn)
112 | GHC.Base.otherwise
113 -> (GHC.Maybe.Just
114 h_a6vo,
115 acc_a6vn)
116 _ -> (minH_a6vm,
117 (f_a6vl
118 : acc_a6vn))))
119 (GHC.Maybe.Nothing, []))
120 farExp_a6vh
121 in
122 (Data.Set.Internal.fromList
123 GHC.Base.$
124 (case minHoriz_a6vj of
125 GHC.Maybe.Just h_a6vq
126 -> (SP.SomeFailure
127 ((SP.FailureHorizon
128 @(SP.InputToken inp_aahm))
129 h_a6vq)
130 : res_a6vk)
131 GHC.Maybe.Nothing
132 -> res_a6vk))}) in
133 let
134 inputToken
135 = Data.Proxy.Proxy :: Data.Proxy.Proxy (SP.InputToken inp_aahm) in
136 let _ = "checkHorizon.noCheck" in
137 let name_2 = \ !callerOnReturn_a6vr
138 !callerInput_a6vs
139 !callerOnExceptionStackByLabel_a6vt
140 -> let _ = "pushValue" in
141 let _ = "pushValue"
142 in
143 do let dupv_a6vu = \ x_a6vv -> x_a6vv
144 reg_1g <- GHC.STRef.newSTRef dupv_a6vu
145 --let _ = "iter" in
146 let onException_a6vw loopInput_a6vx
147 = let _ = "onException"
148 in
149 \ !_exn_a6vy !failInp_a6vz !farInp_a6vA !farExp_a6vB
150 -> let _ = "comment: raiseAgainIfConsumed" in
151 let _ = "saveInput checkedHorizon=0" in
152 let _ = "lift2Value checkedHorizon=0"
153 in
154 if ((\ (Data.Text.Internal.Text _ i_a6vC _)
155 (Data.Text.Internal.Text _ j_a6vD _)
156 -> (i_a6vC GHC.Classes.== j_a6vD))
157 loopInput_a6vx)
158 failInp_a6vz then
159 let _ = "choicesBranch checkedHorizon=0"
160 in
161 do sr_a6vE <- GHC.STRef.readSTRef reg_1g
162 --let _ = "pushValue" in
163 --let _ = "lift2Value checkedHorizon=0" in
164 --let _ = "lift2Value checkedHorizon=0" in
165 --let _ = "resume" in
166 (((callerOnReturn_a6vr farInp_a6vA) farExp_a6vB)
167 (let _ = "resume.genCode" in ()))
168 failInp_a6vz
169 else
170 let _ = "choicesBranch.else"
171 in
172 ((((((Data.Map.Strict.Internal.findWithDefault
173 finalRaise_a6uZ)
174 SP.ExceptionFailure)
175 callerOnExceptionStackByLabel_a6vt)
176 SP.ExceptionFailure)
177 failInp_a6vz)
178 farInp_a6vA)
179 farExp_a6vB
180 loop_1h
181 = \ _callerOnReturn_a6vF
182 callerInput_a6vG
183 callerOnExceptionStackByLabel_a6vH
184 -> -- let _ = "pushValue" in
185 -- let _ = "comment: satisfy (\c_0 -> GHC.Classes.not (('<' GHC.Classes.== c_0) GHC.Classes.|| (('>' GHC.Classes.== c_0) GHC.Classes.|| (('+' GHC.Classes.== c_0) GHC.Classes.|| (('-' GHC.Classes.== c_0) GHC.Classes.|| ((',' GHC.Classes.== c_0) GHC.Classes.|| (('.' GHC.Classes.== c_0) GHC.Classes.|| (('[' GHC.Classes.== c_0) GHC.Classes.|| ((']' GHC.Classes.== c_0) GHC.Classes.|| GHC.Types.False)))))))))" in
186 let inp_a6vI = callerInput_a6vG in
187 let readFail_a6vJ = onException_a6vw callerInput_a6vG in
188 --let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1" in
189 if readMore_a6uX inp_a6vI then
190 let _ = "checkToken" in
191 let !(# c_a6vK, cs_a6vL #) = readNext_a6uY inp_a6vI
192 in
193 if (\ c_a6vM
194 -> GHC.Classes.not
195 (('<' GHC.Classes.== c_a6vM)
196 GHC.Classes.||
197 (('>' GHC.Classes.== c_a6vM)
198 GHC.Classes.||
199 (('+' GHC.Classes.== c_a6vM)
200 GHC.Classes.||
201 (('-' GHC.Classes.== c_a6vM)
202 GHC.Classes.||
203 ((','
204 GHC.Classes.==
205 c_a6vM)
206 GHC.Classes.||
207 (('.'
208 GHC.Classes.==
209 c_a6vM)
210 GHC.Classes.||
211 (('['
212 GHC.Classes.==
213 c_a6vM)
214 GHC.Classes.||
215 ((']'
216 GHC.Classes.==
217 c_a6vM)
218 GHC.Classes.||
219 GHC.Types.False)))))))))
220 c_a6vK then
221 let _ = "lift2Value checkedHorizon=1"
222 in
223 do sr_a6vN <- GHC.STRef.readSTRef reg_1g
224 --let _ = "lift2Value checkedHorizon=1" in
225 do let dupv_a6vO = sr_a6vN
226 (GHC.STRef.writeSTRef reg_1g) dupv_a6vO
227 --let _ = "jump" in
228 ((loop_1h
229 (GHC.Err.error "invalid onReturn"))
230 cs_a6vL)
231 (((((Data.Map.Internal.Bin 1)
232 SP.ExceptionFailure)
233 readFail_a6vJ)
234 Data.Map.Internal.Tip)
235 Data.Map.Internal.Tip)
236 else
237 let _ = "checkToken.fail"
238 in
239 (((readFail_a6vJ SP.ExceptionFailure) inp_a6vI)
240 init_a6uW)
241 Data.Set.Internal.empty
242 else
243 let _ = "checkHorizon.newCheck.fail" in
244 let
245 failExp_a6vP
246 = (Data.Set.Internal.singleton
247 GHC.Base.$
248 (SP.SomeFailure
249 GHC.Base.$
250 (SP.FailureHorizon
251 @(SP.InputToken inp_aagU))
252 1)) in
253 let
254 (# farInp_a6vQ, farExp_a6vR #)
255 = case
256 ((GHC.Classes.compare
257 `Data.Function.on` SP.offset)
258 init_a6uW)
259 inp_a6vI
260 of
261 GHC.Types.LT -> (# inp_a6vI, failExp_a6vP #)
262 GHC.Types.EQ
263 -> (# init_a6uW,
264 (failExp_a6vP
265 GHC.Base.<> Data.Set.Internal.empty) #)
266 GHC.Types.GT
267 -> (# init_a6uW, Data.Set.Internal.empty #)
268 in
269 (((readFail_a6vJ SP.ExceptionFailure) inp_a6vI)
270 farInp_a6vQ)
271 farExp_a6vR
272 in loop_1h callerOnReturn_a6vr callerInput_a6vs
273 (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure)
274 (((Data.Map.Strict.Internal.findWithDefault finalRaise_a6uZ)
275 SP.ExceptionFailure)
276 callerOnExceptionStackByLabel_a6vt))
277 Data.Map.Internal.Tip)
278 Data.Map.Internal.Tip)
279 name_1 = \ !callerOnReturn_a6vS
280 !callerInput_a6vT
281 !callerOnExceptionStackByLabel_a6vU
282 -> let _ = "pushValue"
283 in
284 do let dupv_a6vV = \ x_a6vW -> x_a6vW
285 reg_1i <- GHC.STRef.newSTRef dupv_a6vV
286 let _ = "iter"
287 let onException_a6vX loopInput_a6vY =
288 let _ = "onException"
289 in
290 \ !_exn_a6vZ !failInp_a6w0 !farInp_a6w1 !farExp_a6w2
291 -> let _ = "comment: raiseAgainIfConsumed" in
292 let _ = "saveInput checkedHorizon=0" in
293 let _ = "lift2Value checkedHorizon=0"
294 in
295 if ((\ (Data.Text.Internal.Text _ i_a6w3 _)
296 (Data.Text.Internal.Text _ j_a6w4 _)
297 -> (i_a6w3 GHC.Classes.== j_a6w4))
298 loopInput_a6vY)
299 failInp_a6w0 then
300 let _ = "choicesBranch checkedHorizon=0"
301 in
302 do sr_a6w5 <- GHC.STRef.readSTRef reg_1i
303 let _ = "pushValue"
304 let _ = "lift2Value checkedHorizon=0"
305 let _ = "resume" in
306 (((callerOnReturn_a6vS farInp_a6w1) farExp_a6w2)
307 (let _ = "resume.genCode" in sr_a6w5 []))
308 failInp_a6w0
309 else
310 let _ = "choicesBranch.else"
311 in
312 ((((((Data.Map.Strict.Internal.findWithDefault
313 finalRaise_a6uZ)
314 SP.ExceptionFailure)
315 callerOnExceptionStackByLabel_a6vU)
316 SP.ExceptionFailure)
317 failInp_a6w0)
318 farInp_a6w1)
319 farExp_a6w2
320 loop_1j = \ _callerOnReturn_a6w6
321 callerInput_a6w7
322 callerOnExceptionStackByLabel_a6w8
323 -> let _ = "pushValue" in
324 let
325 join_1k
326 = \ farInp_a6w9 farExp_a6wa v_a6wb !inp_a6wc
327 -> let _ = "lift2Value checkedHorizon=0"
328 in
329 ((name_2
330 (let _ = "onReturn"
331 in
332 \ farInp_a6wd farExp_a6we v_a6wf !inp_a6wg
333 -> let
334 _ = "lift2Value checkedHorizon=0" in
335 let _ = "pushValue" in
336 let _ = "lift2Value checkedHorizon=0"
337 in
338 do sr_a6wh <- GHC.STRef.readSTRef
339 reg_1i
340 let
341 _ = "lift2Value checkedHorizon=0"
342 in
343 do let dupv_a6wi
344 = \ x_a6wj
345 -> sr_a6wh
346 (((:) v_a6wb)
347 x_a6wj)
348 (GHC.STRef.writeSTRef
349 reg_1i)
350 dupv_a6wi
351 let _ = "jump"
352 in
353 ((loop_1j
354 (GHC.Err.error
355 "invalid onReturn"))
356 inp_a6wg)
357 (((((Data.Map.Internal.Bin
358 1)
359 SP.ExceptionFailure)
360 (onException_a6vX
361 callerInput_a6w7))
362 Data.Map.Internal.Tip)
363 Data.Map.Internal.Tip)))
364 inp_a6wc)
365 (((((Data.Map.Internal.Bin 1)
366 SP.ExceptionFailure)
367 (onException_a6vX callerInput_a6w7))
368 Data.Map.Internal.Tip)
369 Data.Map.Internal.Tip) in
370 let _ = "comment: look" in
371 let _ = "saveInput checkedHorizon=0" in
372 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
373 let inp_a6wk = callerInput_a6w7 in
374 let readFail_a6wl = onException_a6vX callerInput_a6w7 in
375 let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
376 in
377 if readMore_a6uX inp_a6wk then
378 let _ = "checkToken" in
379 let !(# c_a6wm, cs_a6wn #) = readNext_a6uY inp_a6wk in
380 let _ = "loadInput checkedHorizon=0" in
381 let inp_a6wo = callerInput_a6w7 in
382 let readFail_a6wp = readFail_a6wl in
383 let
384 _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
385 in
386 if readMore_a6uX inp_a6wo then
387 if (\ x_a6wq -> ((GHC.Classes.==) '<') x_a6wq)
388 c_a6wm then
389 let _ = "choicesBranch checkedHorizon=1" in
390 let _ = "pushValue" in
391 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
392 let
393 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
394 let _ = "checkToken" in
395 let
396 !(# c_a6wr, cs_a6ws #)
397 = readNext_a6uY inp_a6wo in
398 let _ = "lift2Value checkedHorizon=0" in
399 let _ = "resume"
400 in
401 (((join_1k init_a6uW)
402 Data.Set.Internal.empty)
403 (let _ = "resume.genCode"
404 in Parsers.Brainfuck.Types.Backward))
405 cs_a6ws
406 else
407 let _ = "choicesBranch.else"
408 in
409 if (\ x_a6wt -> ((GHC.Classes.==) '>') x_a6wt)
410 c_a6wm then
411 let
412 _ = "choicesBranch checkedHorizon=1" in
413 let _ = "pushValue" in
414 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
415 let
416 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
417 let _ = "checkToken" in
418 let
419 !(# c_a6wu, cs_a6wv #)
420 = readNext_a6uY inp_a6wo in
421 let _ = "lift2Value checkedHorizon=0" in
422 let _ = "resume"
423 in
424 (((join_1k init_a6uW)
425 Data.Set.Internal.empty)
426 (let _ = "resume.genCode"
427 in Parsers.Brainfuck.Types.Forward))
428 cs_a6wv
429 else
430 let _ = "choicesBranch.else"
431 in
432 if (\ x_a6ww
433 -> ((GHC.Classes.==) '+') x_a6ww)
434 c_a6wm then
435 let
436 _ = "choicesBranch checkedHorizon=1" in
437 let _ = "pushValue" in
438 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
439 let
440 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
441 let _ = "checkToken" in
442 let
443 !(# c_a6wx, cs_a6wy #)
444 = readNext_a6uY inp_a6wo in
445 let
446 _ = "lift2Value checkedHorizon=0" in
447 let _ = "resume"
448 in
449 (((join_1k init_a6uW)
450 Data.Set.Internal.empty)
451 (let _ = "resume.genCode"
452 in
453 Parsers.Brainfuck.Types.Increment))
454 cs_a6wy
455 else
456 let _ = "choicesBranch.else"
457 in
458 if (\ x_a6wz
459 -> ((GHC.Classes.==) '-')
460 x_a6wz)
461 c_a6wm then
462 let
463 _ = "choicesBranch checkedHorizon=1" in
464 let _ = "pushValue" in
465 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
466 let
467 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
468 let _ = "checkToken" in
469 let
470 !(# c_a6wA, cs_a6wB #)
471 = readNext_a6uY
472 inp_a6wo in
473 let
474 _ = "lift2Value checkedHorizon=0" in
475 let _ = "resume"
476 in
477 (((join_1k init_a6uW)
478 Data.Set.Internal.empty)
479 (let _ = "resume.genCode"
480 in
481 Parsers.Brainfuck.Types.Decrement))
482 cs_a6wB
483 else
484 let _ = "choicesBranch.else"
485 in
486 if (\ x_a6wC
487 -> ((GHC.Classes.==)
488 ',')
489 x_a6wC)
490 c_a6wm then
491 let
492 _ = "choicesBranch checkedHorizon=1" in
493 let _ = "pushValue" in
494 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
495 let
496 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
497 let _ = "checkToken" in
498 let
499 !(# c_a6wD, cs_a6wE #)
500 = readNext_a6uY
501 inp_a6wo in
502 let
503 _ = "lift2Value checkedHorizon=0" in
504 let _ = "resume"
505 in
506 (((join_1k init_a6uW)
507 Data.Set.Internal.empty)
508 (let
509 _ = "resume.genCode"
510 in
511 Parsers.Brainfuck.Types.Input))
512 cs_a6wE
513 else
514 let
515 _ = "choicesBranch.else"
516 in
517 if (\ x_a6wF
518 -> ((GHC.Classes.==)
519 '.')
520 x_a6wF)
521 c_a6wm then
522 let
523 _ = "choicesBranch checkedHorizon=1" in
524 let
525 _ = "pushValue" in
526 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
527 let
528 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
529 let
530 _ = "checkToken" in
531 let
532 !(# c_a6wG,
533 cs_a6wH #)
534 = readNext_a6uY
535 inp_a6wo in
536 let
537 _ = "lift2Value checkedHorizon=0" in
538 let _ = "resume"
539 in
540 (((join_1k
541 init_a6uW)
542 Data.Set.Internal.empty)
543 (let
544 _ = "resume.genCode"
545 in
546 Parsers.Brainfuck.Types.Output))
547 cs_a6wH
548 else
549 let
550 _ = "choicesBranch.else"
551 in
552 if (\ x_a6wI
553 -> ((GHC.Classes.==)
554 '[')
555 x_a6wI)
556 c_a6wm then
557 let
558 _ = "choicesBranch checkedHorizon=1" in
559 let
560 _ = "pushValue" in
561 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
562 let
563 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
564 let
565 _ = "checkToken" in
566 let
567 !(# c_a6wJ,
568 cs_a6wK #)
569 = readNext_a6uY
570 inp_a6wo in
571 let
572 _ = "lift2Value checkedHorizon=0"
573 in
574 ((name_2
575 (let
576 _ = "onReturn"
577 in
578 \ farInp_a6wL
579 farExp_a6wM
580 v_a6wN
581 !inp_a6wO
582 -> let
583 _ = "lift2Value checkedHorizon=0"
584 in
585 ((name_1
586 (let
587 _ = "onReturn"
588 in
589 \ farInp_a6wP
590 farExp_a6wQ
591 v_a6wR
592 !inp_a6wS
593 -> let
594 _ = "lift2Value checkedHorizon=0" in
595 let
596 _ = "comment: satisfy ((GHC.Classes.==) ']')" in
597 let
598 inp_a6wT
599 = inp_a6wS in
600 let
601 readFail_a6wU
602 = readFail_a6wp in
603 let
604 _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
605 in
606 if readMore_a6uX
607 inp_a6wT then
608 let
609 _ = "checkToken" in
610 let
611 !(# c_a6wV,
612 cs_a6wW #)
613 = readNext_a6uY
614 inp_a6wT
615 in
616 if ((GHC.Classes.==)
617 ']')
618 c_a6wV then
619 let
620 _ = "lift2Value checkedHorizon=1" in
621 let
622 _ = "resume"
623 in
624 (((join_1k
625 farInp_a6wP)
626 farExp_a6wQ)
627 (let
628 _ = "resume.genCode"
629 in
630 Parsers.Brainfuck.Types.Loop
631 v_a6wR))
632 cs_a6wW
633 else
634 let
635 _ = "checkToken.fail"
636 in
637 (((readFail_a6wU
638 SP.ExceptionFailure)
639 inp_a6wT)
640 farInp_a6wP)
641 farExp_a6wQ
642 else
643 let
644 _ = "checkHorizon.newCheck.fail" in
645 let
646 failExp_a6wX
647 = (Data.Set.Internal.singleton
648 GHC.Base.$
649 (SP.SomeFailure
650 GHC.Base.$
651 (SP.FailureHorizon
652 @(SP.InputToken inp_aagU))
653 1)) in
654 let
655 (# farInp_a6wY,
656 farExp_a6wZ #)
657 = case
658 ((GHC.Classes.compare
659 `Data.Function.on`
660 SP.offset)
661 farInp_a6wP)
662 inp_a6wT
663 of
664 GHC.Types.LT
665 -> (# inp_a6wT,
666 failExp_a6wX #)
667 GHC.Types.EQ
668 -> (# farInp_a6wP,
669 (failExp_a6wX
670 GHC.Base.<>
671 farExp_a6wQ) #)
672 GHC.Types.GT
673 -> (# farInp_a6wP,
674 farExp_a6wQ #)
675 in
676 (((readFail_a6wU
677 SP.ExceptionFailure)
678 inp_a6wT)
679 farInp_a6wY)
680 farExp_a6wZ))
681 inp_a6wO)
682 (((((Data.Map.Internal.Bin
683 1)
684 SP.ExceptionFailure)
685 readFail_a6wp)
686 Data.Map.Internal.Tip)
687 Data.Map.Internal.Tip)))
688 cs_a6wK)
689 (((((Data.Map.Internal.Bin
690 1)
691 SP.ExceptionFailure)
692 readFail_a6wp)
693 Data.Map.Internal.Tip)
694 Data.Map.Internal.Tip)
695 else
696 let
697 _ = "choicesBranch.else" in
698 let
699 failExp_a6x0
700 = (((Data.Set.Internal.Bin
701 1)
702 (SP.SomeFailure
703 SP.FailureEmpty))
704 Data.Set.Internal.Tip)
705 Data.Set.Internal.Tip in
706 let
707 (# farInp_a6x1,
708 farExp_a6x2 #)
709 = case
710 ((GHC.Classes.compare
711 `Data.Function.on`
712 SP.offset)
713 init_a6uW)
714 inp_a6wo
715 of
716 GHC.Types.LT
717 -> (# inp_a6wo,
718 failExp_a6x0 #)
719 GHC.Types.EQ
720 -> (# init_a6uW,
721 (failExp_a6x0
722 GHC.Base.<>
723 Data.Set.Internal.empty) #)
724 GHC.Types.GT
725 -> (# init_a6uW,
726 Data.Set.Internal.empty #)
727 in
728 (((readFail_a6wp
729 SP.ExceptionFailure)
730 inp_a6wo)
731 farInp_a6x1)
732 farExp_a6x2
733 else
734 let _ = "checkHorizon.newCheck.fail" in
735 let
736 failExp_a6x3
737 = (Data.Set.Internal.singleton
738 GHC.Base.$
739 (SP.SomeFailure
740 GHC.Base.$
741 (SP.FailureHorizon
742 @(SP.InputToken inp_aagU))
743 1)) in
744 let
745 (# farInp_a6x4, farExp_a6x5 #)
746 = case
747 ((GHC.Classes.compare
748 `Data.Function.on` SP.offset)
749 init_a6uW)
750 inp_a6wo
751 of
752 GHC.Types.LT -> (# inp_a6wo, failExp_a6x3 #)
753 GHC.Types.EQ
754 -> (# init_a6uW,
755 (failExp_a6x3
756 GHC.Base.<>
757 Data.Set.Internal.empty) #)
758 GHC.Types.GT
759 -> (# init_a6uW,
760 Data.Set.Internal.empty #)
761 in
762 (((readFail_a6wp SP.ExceptionFailure) inp_a6wo)
763 farInp_a6x4)
764 farExp_a6x5
765 else
766 let _ = "checkHorizon.newCheck.fail" in
767 let
768 failExp_a6x6
769 = (Data.Set.Internal.singleton
770 GHC.Base.$
771 (SP.SomeFailure
772 GHC.Base.$
773 (SP.FailureHorizon
774 @(SP.InputToken inp_aagU))
775 1)) in
776 let
777 (# farInp_a6x7, farExp_a6x8 #)
778 = case
779 ((GHC.Classes.compare
780 `Data.Function.on` SP.offset)
781 init_a6uW)
782 inp_a6wk
783 of
784 GHC.Types.LT -> (# inp_a6wk, failExp_a6x6 #)
785 GHC.Types.EQ
786 -> (# init_a6uW,
787 (failExp_a6x6
788 GHC.Base.<> Data.Set.Internal.empty) #)
789 GHC.Types.GT
790 -> (# init_a6uW, Data.Set.Internal.empty #)
791 in
792 (((readFail_a6wl SP.ExceptionFailure) inp_a6wk)
793 farInp_a6x7)
794 farExp_a6x8
795 in let _ = "jump" in
796 ((loop_1j callerOnReturn_a6vS) callerInput_a6vT)
797 (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure)
798 (((Data.Map.Strict.Internal.findWithDefault finalRaise_a6uZ)
799 SP.ExceptionFailure)
800 callerOnExceptionStackByLabel_a6vU))
801 Data.Map.Internal.Tip)
802 Data.Map.Internal.Tip)
803 in
804 let _ = "pushValue" in
805 ((name_2
806 (let _ = "onReturn"
807 in
808 \ farInp_a6x9 farExp_a6xa v_a6xb !inp_a6xc
809 -> let _ = "lift2Value checkedHorizon=0"
810 in
811 ((name_1
812 (let _ = "onReturn"
813 in
814 \ farInp_a6xd farExp_a6xe v_a6xf !inp_a6xg
815 -> let _ = "lift2Value checkedHorizon=0" in
816 let _ = "resume"
817 in
818 (((finalRet_a6uV farInp_a6xd) farExp_a6xe)
819 (let _ = "resume.genCode" in v_a6xf))
820 inp_a6xg))
821 inp_a6xc)
822 Data.Map.Internal.Tip))
823 init_a6uW)
824 Data.Map.Internal.Tip
825 -}
Library for parsing