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
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
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(..))
44 parserByteString :: BS.ByteString -> SP.Parsed BS.ByteString [Instruction]
45 parserByteString = $$(SP.runParser @BS.ByteString grammar)
47 parserByteStringLazy :: BSL.ByteString -> SP.Parsed BSL.ByteString [Instruction]
48 parserByteStringLazy = $$(SP.runParser @BSL.ByteString grammar)
50 parserString :: String -> SP.Parsed String [Instruction]
51 parserString = $$(SP.runParser @String grammar)
54 parserText :: T.Text -> SP.Parsed T.Text [Instruction]
55 parserText = $$(SP.runParser @T.Text grammar)
57 --parserTextLazy :: TL.Text -> Either (SP.ParsingError TL.Text) [Instruction]
58 --parserTextLazy = $$(SP.runParser @TL.Text grammar)
60 parserText :: T.Text -> SP.Parsed T.Text [Instruction]
62 \ (input_a6uU :: inp_aahm)
64 !(# init_a6uW, readMore_a6uX, readNext_a6uY #)
65 = let _ = "cursorOf" in
68 t_a6v2@(Data.Text.Internal.Text arr_a6v3 off_a6v4 unconsumed_a6v5)
70 !(Data.Text.Unsafe.Iter c_a6v6 d_a6v7)
71 = (Data.Text.Unsafe.iter t_a6v2) 0
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 #)
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
88 {SP.parsingErrorOffset = SP.offset farInp_a6vg,
89 SP.parsingErrorException = exn_a6ve,
90 SP.parsingErrorUnexpected = if readMore_a6uX farInp_a6vg then
94 = readNext_a6uY farInp_a6vg
98 SP.parsingErrorExpecting = let
99 (minHoriz_a6vj, res_a6vk)
100 = ((Data.Set.Internal.foldr
101 (\ f_a6vl (minH_a6vm, acc_a6vn)
103 SP.unSomeFailure f_a6vl
105 GHC.Maybe.Just (SP.FailureHorizon h_a6vo :: SP.Failure (SP.CombSatisfiable (SP.InputToken inp_aahm)))
106 | GHC.Maybe.Just old_a6vp <- minH_a6vm
119 (GHC.Maybe.Nothing, []))
122 (Data.Set.Internal.fromList
124 (case minHoriz_a6vj of
125 GHC.Maybe.Just h_a6vq
128 @(SP.InputToken inp_aahm))
135 = Data.Proxy.Proxy :: Data.Proxy.Proxy (SP.InputToken inp_aahm) in
136 let _ = "checkHorizon.noCheck" in
137 let name_2 = \ !callerOnReturn_a6vr
139 !callerOnExceptionStackByLabel_a6vt
140 -> let _ = "pushValue" in
143 do let dupv_a6vu = \ x_a6vv -> x_a6vv
144 reg_1g <- GHC.STRef.newSTRef dupv_a6vu
146 let onException_a6vw loopInput_a6vx
147 = let _ = "onException"
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"
154 if ((\ (Data.Text.Internal.Text _ i_a6vC _)
155 (Data.Text.Internal.Text _ j_a6vD _)
156 -> (i_a6vC GHC.Classes.== j_a6vD))
159 let _ = "choicesBranch checkedHorizon=0"
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 ()))
170 let _ = "choicesBranch.else"
172 ((((((Data.Map.Strict.Internal.findWithDefault
175 callerOnExceptionStackByLabel_a6vt)
181 = \ _callerOnReturn_a6vF
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
195 (('<' GHC.Classes.== c_a6vM)
197 (('>' GHC.Classes.== c_a6vM)
199 (('+' GHC.Classes.== c_a6vM)
201 (('-' GHC.Classes.== c_a6vM)
219 GHC.Types.False)))))))))
221 let _ = "lift2Value checkedHorizon=1"
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
229 (GHC.Err.error "invalid onReturn"))
231 (((((Data.Map.Internal.Bin 1)
234 Data.Map.Internal.Tip)
235 Data.Map.Internal.Tip)
237 let _ = "checkToken.fail"
239 (((readFail_a6vJ SP.ExceptionFailure) inp_a6vI)
241 Data.Set.Internal.empty
243 let _ = "checkHorizon.newCheck.fail" in
246 = (Data.Set.Internal.singleton
251 @(SP.InputToken inp_aagU))
254 (# farInp_a6vQ, farExp_a6vR #)
256 ((GHC.Classes.compare
257 `Data.Function.on` SP.offset)
261 GHC.Types.LT -> (# inp_a6vI, failExp_a6vP #)
265 GHC.Base.<> Data.Set.Internal.empty) #)
267 -> (# init_a6uW, Data.Set.Internal.empty #)
269 (((readFail_a6vJ SP.ExceptionFailure) inp_a6vI)
272 in loop_1h callerOnReturn_a6vr callerInput_a6vs
273 (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure)
274 (((Data.Map.Strict.Internal.findWithDefault finalRaise_a6uZ)
276 callerOnExceptionStackByLabel_a6vt))
277 Data.Map.Internal.Tip)
278 Data.Map.Internal.Tip)
279 name_1 = \ !callerOnReturn_a6vS
281 !callerOnExceptionStackByLabel_a6vU
282 -> let _ = "pushValue"
284 do let dupv_a6vV = \ x_a6vW -> x_a6vW
285 reg_1i <- GHC.STRef.newSTRef dupv_a6vV
287 let onException_a6vX loopInput_a6vY =
288 let _ = "onException"
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"
295 if ((\ (Data.Text.Internal.Text _ i_a6w3 _)
296 (Data.Text.Internal.Text _ j_a6w4 _)
297 -> (i_a6w3 GHC.Classes.== j_a6w4))
300 let _ = "choicesBranch checkedHorizon=0"
302 do sr_a6w5 <- GHC.STRef.readSTRef reg_1i
304 let _ = "lift2Value checkedHorizon=0"
306 (((callerOnReturn_a6vS farInp_a6w1) farExp_a6w2)
307 (let _ = "resume.genCode" in sr_a6w5 []))
310 let _ = "choicesBranch.else"
312 ((((((Data.Map.Strict.Internal.findWithDefault
315 callerOnExceptionStackByLabel_a6vU)
320 loop_1j = \ _callerOnReturn_a6w6
322 callerOnExceptionStackByLabel_a6w8
323 -> let _ = "pushValue" in
326 = \ farInp_a6w9 farExp_a6wa v_a6wb !inp_a6wc
327 -> let _ = "lift2Value checkedHorizon=0"
332 \ farInp_a6wd farExp_a6we v_a6wf !inp_a6wg
334 _ = "lift2Value checkedHorizon=0" in
335 let _ = "pushValue" in
336 let _ = "lift2Value checkedHorizon=0"
338 do sr_a6wh <- GHC.STRef.readSTRef
341 _ = "lift2Value checkedHorizon=0"
348 (GHC.STRef.writeSTRef
357 (((((Data.Map.Internal.Bin
362 Data.Map.Internal.Tip)
363 Data.Map.Internal.Tip)))
365 (((((Data.Map.Internal.Bin 1)
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"
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
384 _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
386 if readMore_a6uX inp_a6wo then
387 if (\ x_a6wq -> ((GHC.Classes.==) '<') x_a6wq)
389 let _ = "choicesBranch checkedHorizon=1" in
390 let _ = "pushValue" in
391 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
393 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
394 let _ = "checkToken" in
396 !(# c_a6wr, cs_a6ws #)
397 = readNext_a6uY inp_a6wo in
398 let _ = "lift2Value checkedHorizon=0" in
401 (((join_1k init_a6uW)
402 Data.Set.Internal.empty)
403 (let _ = "resume.genCode"
404 in Parsers.Brainfuck.Types.Backward))
407 let _ = "choicesBranch.else"
409 if (\ x_a6wt -> ((GHC.Classes.==) '>') x_a6wt)
412 _ = "choicesBranch checkedHorizon=1" in
413 let _ = "pushValue" in
414 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
416 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
417 let _ = "checkToken" in
419 !(# c_a6wu, cs_a6wv #)
420 = readNext_a6uY inp_a6wo in
421 let _ = "lift2Value checkedHorizon=0" in
424 (((join_1k init_a6uW)
425 Data.Set.Internal.empty)
426 (let _ = "resume.genCode"
427 in Parsers.Brainfuck.Types.Forward))
430 let _ = "choicesBranch.else"
433 -> ((GHC.Classes.==) '+') x_a6ww)
436 _ = "choicesBranch checkedHorizon=1" in
437 let _ = "pushValue" in
438 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
440 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
441 let _ = "checkToken" in
443 !(# c_a6wx, cs_a6wy #)
444 = readNext_a6uY inp_a6wo in
446 _ = "lift2Value checkedHorizon=0" in
449 (((join_1k init_a6uW)
450 Data.Set.Internal.empty)
451 (let _ = "resume.genCode"
453 Parsers.Brainfuck.Types.Increment))
456 let _ = "choicesBranch.else"
459 -> ((GHC.Classes.==) '-')
463 _ = "choicesBranch checkedHorizon=1" in
464 let _ = "pushValue" in
465 -- let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
467 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
468 let _ = "checkToken" in
470 !(# c_a6wA, cs_a6wB #)
474 _ = "lift2Value checkedHorizon=0" in
477 (((join_1k init_a6uW)
478 Data.Set.Internal.empty)
479 (let _ = "resume.genCode"
481 Parsers.Brainfuck.Types.Decrement))
484 let _ = "choicesBranch.else"
492 _ = "choicesBranch checkedHorizon=1" in
493 let _ = "pushValue" in
494 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
496 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
497 let _ = "checkToken" in
499 !(# c_a6wD, cs_a6wE #)
503 _ = "lift2Value checkedHorizon=0" in
506 (((join_1k init_a6uW)
507 Data.Set.Internal.empty)
511 Parsers.Brainfuck.Types.Input))
515 _ = "choicesBranch.else"
523 _ = "choicesBranch checkedHorizon=1" in
526 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
528 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
537 _ = "lift2Value checkedHorizon=0" in
542 Data.Set.Internal.empty)
546 Parsers.Brainfuck.Types.Output))
550 _ = "choicesBranch.else"
558 _ = "choicesBranch checkedHorizon=1" in
561 --let _ = "comment: satisfy ((\x_0 -> \x_1 -> x_0) GHC.Types.True)" in
563 _ = "checkHorizon.oldCheck: checkedHorizon=1" in
572 _ = "lift2Value checkedHorizon=0"
583 _ = "lift2Value checkedHorizon=0"
594 _ = "lift2Value checkedHorizon=0" in
596 _ = "comment: satisfy ((GHC.Classes.==) ']')" in
604 _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
620 _ = "lift2Value checkedHorizon=1" in
630 Parsers.Brainfuck.Types.Loop
635 _ = "checkToken.fail"
644 _ = "checkHorizon.newCheck.fail" in
647 = (Data.Set.Internal.singleton
652 @(SP.InputToken inp_aagU))
658 ((GHC.Classes.compare
682 (((((Data.Map.Internal.Bin
686 Data.Map.Internal.Tip)
687 Data.Map.Internal.Tip)))
689 (((((Data.Map.Internal.Bin
693 Data.Map.Internal.Tip)
694 Data.Map.Internal.Tip)
697 _ = "choicesBranch.else" in
700 = (((Data.Set.Internal.Bin
704 Data.Set.Internal.Tip)
705 Data.Set.Internal.Tip in
710 ((GHC.Classes.compare
723 Data.Set.Internal.empty) #)
726 Data.Set.Internal.empty #)
734 let _ = "checkHorizon.newCheck.fail" in
737 = (Data.Set.Internal.singleton
742 @(SP.InputToken inp_aagU))
745 (# farInp_a6x4, farExp_a6x5 #)
747 ((GHC.Classes.compare
748 `Data.Function.on` SP.offset)
752 GHC.Types.LT -> (# inp_a6wo, failExp_a6x3 #)
757 Data.Set.Internal.empty) #)
760 Data.Set.Internal.empty #)
762 (((readFail_a6wp SP.ExceptionFailure) inp_a6wo)
766 let _ = "checkHorizon.newCheck.fail" in
769 = (Data.Set.Internal.singleton
774 @(SP.InputToken inp_aagU))
777 (# farInp_a6x7, farExp_a6x8 #)
779 ((GHC.Classes.compare
780 `Data.Function.on` SP.offset)
784 GHC.Types.LT -> (# inp_a6wk, failExp_a6x6 #)
788 GHC.Base.<> Data.Set.Internal.empty) #)
790 -> (# init_a6uW, Data.Set.Internal.empty #)
792 (((readFail_a6wl SP.ExceptionFailure) inp_a6wk)
796 ((loop_1j callerOnReturn_a6vS) callerInput_a6vT)
797 (((((Data.Map.Internal.Bin 1) SP.ExceptionFailure)
798 (((Data.Map.Strict.Internal.findWithDefault finalRaise_a6uZ)
800 callerOnExceptionStackByLabel_a6vU))
801 Data.Map.Internal.Tip)
802 Data.Map.Internal.Tip)
804 let _ = "pushValue" in
808 \ farInp_a6x9 farExp_a6xa v_a6xb !inp_a6xc
809 -> let _ = "lift2Value checkedHorizon=0"
814 \ farInp_a6xd farExp_a6xe v_a6xf !inp_a6xg
815 -> let _ = "lift2Value checkedHorizon=0" in
818 (((finalRet_a6uV farInp_a6xd) farExp_a6xe)
819 (let _ = "resume.genCode" in v_a6xf))
822 Data.Map.Internal.Tip))
824 Data.Map.Internal.Tip