]> Git — Sourcephile - haskell/symantic-parser.git/blob - tests/Golden/Splice/G3.expected.txt
impl: add `programWriter`
[haskell/symantic-parser.git] / tests / Golden / Splice / G3.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 _ = "resume"
102 in finalRet
103 farInp
104 farExp
105 ( let _ = "resume.genCode"
106 in GHC.Show.show (sr GHC.Types . [])
107 )
108 failInp
109 buf
110 end
111 else
112 let _ = "choicesBranch.else"
113 in Symantic.Parser.Machine.Generate.unForallOnException finalRaise Symantic.Parser.Grammar.Combinators.ExceptionFailure failInp farInp farExp buf end
114 loop = \_callerOnReturn callerInput callerBuffer callerEnded callerOnExceptionStackByLabel ->
115 let _ = "pushValue"
116 in let _ = "comment: satisfy ((GHC.Classes.==) 'a')"
117 in let partialCont buf =
118 let readFail = onException callerInput
119 in let _ = "checkHorizon.newCheck: checkedHorizon=0 minHoriz=1"
120 in if readMore buf callerInput
121 then
122 let _ = "checkToken"
123 in let !(#
124 c,
125 cs
126 #) = readNext buf callerInput
127 in if (GHC.Classes.==) 'a' c
128 then
129 let _ = "lift2Value checkedHorizon=1"
130 in let _ = "pushValue"
131 in let _ = "lift2Value checkedHorizon=1"
132 in do
133 sr <- GHC.STRef.readSTRef reg
134 let _ = "lift2Value checkedHorizon=1"
135 in do
136 let dupv = \u -> sr ((GHC.Types.:) 'a' u)
137 GHC.STRef.writeSTRef reg dupv
138 let _ = "jump"
139 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)
140 else
141 let _ = "checkToken.fail"
142 in let failExp =
143 Data.Set.Internal.Bin
144 1
145 ( Symantic.Parser.Grammar.Combinators.SomeFailure
146 ( case inputToken of
147 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureToken 'a'
148 )
149 )
150 Data.Set.Internal.Tip
151 Data.Set.Internal.Tip
152 in let (#
153 farInp,
154 farExp
155 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
156 GHC.Types.LT ->
157 (#
158 callerInput,
159 failExp
160 #)
161 GHC.Types.EQ ->
162 (#
163 initPos,
164 failExp GHC.Base.<> Data.Set.Internal.empty
165 #)
166 GHC.Types.GT ->
167 (#
168 initPos,
169 Data.Set.Internal.empty
170 #)
171 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf callerEnded
172 else
173 let _ = "checkHorizon.newCheck.fail"
174 in let noMoreInput =
175 let failExp =
176 Data.Set.Internal.Bin
177 1
178 ( Symantic.Parser.Grammar.Combinators.SomeFailure
179 ( case inputToken of
180 (Data.Proxy.Proxy :: Data.Proxy.Proxy tok') -> Symantic.Parser.Grammar.Combinators.FailureHorizon @tok' 1
181 )
182 )
183 Data.Set.Internal.Tip
184 Data.Set.Internal.Tip
185 in let (#
186 farInp,
187 farExp
188 #) = case GHC.Classes.compare @GHC.Types.Int initPos callerInput of
189 GHC.Types.LT ->
190 (#
191 callerInput,
192 failExp
193 #)
194 GHC.Types.EQ ->
195 (#
196 initPos,
197 failExp GHC.Base.<> Data.Set.Internal.empty
198 #)
199 GHC.Types.GT ->
200 (#
201 initPos,
202 Data.Set.Internal.empty
203 #)
204 in readFail Symantic.Parser.Grammar.Combinators.ExceptionFailure callerInput farInp farExp buf GHC.Types.True
205 in if callerEnded
206 then noMoreInput
207 else
208 Symantic.Parser.Machine.Generate.returnST GHC.Base.$
209 ( Symantic.Parser.Machine.Generate.ResultPartial GHC.Base.$
210 ( \newInput ->
211 if Symantic.Parser.Machine.Input.nullInput newInput
212 then noMoreInput
213 else partialCont (append buf newInput)
214 )
215 )
216 in partialCont callerBuffer
217 in let _ = "jump"
218 in loop finalRet initPos initBuffer GHC.Types.False Data.Map.Internal.Tip