git.iko.soy/elk
on master help sign in
Redo the Parser type to allocate less and do less computation
f4707e6Evan Czaplicki
compiler/src/Parse/Primitives.hs+243−143
compare with master
unifiedsplit
@@ -1,228 +1,328 @@
1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1+{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}
2−{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, OverloadedStrings #-}
3module Parse.Primitives
3module Parse.Primitives
4+ ( Result(..)
5+ , fromByteString
6+ , fromFile
4− ( I.Parser
7+ , Parser(..)
8+ , State(..)
9+ , Context(..)
5− , I.oneOf
10+ , oneOf
6− , run, runAt
7− , try, deadend, hint, endOfFile
8− , noFloatsAllowedInPatterns
9− , getPosition, getCol
10− , pushContext, popContext
11+ , pushContext, popContext, inContext
12+ , getPosition, getCol, addLocation
11 , getIndent, setIndent
13 , getIndent, setIndent
12− , W.SPos
14+ , word1, word2
13− , SParser
15+ , unsafeIndex, isWord, getCharWidth
14− , addLocation, inContext
15− , spaces, noSpace, checkSpace, checkAligned, checkFreshLine
16 )
16 )
17 where
17 where
18
18
19
19
20import Prelude hiding (length)
20import Prelude hiding (length)
21+import qualified Control.Applicative as Applicative (Applicative(..))
22+import Control.Monad
21import qualified Data.ByteString.Internal as B
23import qualified Data.ByteString.Internal as B
24+import Data.Word (Word8, Word16)
25+import Foreign.Ptr (Ptr, plusPtr)
26+import Foreign.Storable (peek)
27+import GHC.ForeignPtr (touchForeignPtr, unsafeForeignPtrToPtr)
22
28
23−import Parse.Primitives.Internals (Parser(..), State(..), expect, noError)
29+import qualified File.IO as IO
24−import qualified Parse.Primitives.Internals as I
25−import qualified Parse.Primitives.Whitespace as W
26import qualified Reporting.Annotation as A
30import qualified Reporting.Annotation as A
27−import qualified Reporting.Error.Syntax as E
28−import qualified Reporting.Region as R
29
31
30
32
31
33
32−-- RUN
34+-- PARSER
33
35
34
36
35−run :: Parser a -> B.ByteString -> Either E.Error a
37+newtype Parser c x a =
36−run parser bytes =
38+ Parser (
37− runAt 1 1 parser bytes
39+ forall b.
40+ State c
41+ -> (a -> State c -> b) -- consumed ok
42+ -> (a -> State c -> b) -- empty ok
43+ -> (Word16 -> Word16 -> Context c -> x -> b) -- consumed err
44+ -> (Word16 -> Word16 -> Context c -> x -> b) -- empty err
45+ -> b
46+ )
47+
48+
49+data State c =
50+ State
51+ { _pos :: !(Ptr Word8)
52+ , _end :: !(Ptr Word8)
53+ , _indent :: !Word16
54+ , _row :: !Word16
55+ , _col :: !Word16
56+ , _context :: Context c
57+ }
58+
59+
60+data Context c
61+ = NoContext
62+ | Frame {-# UNPACK #-} !Word16 {-# UNPACK #-} !Word16 c (Context c)
63+
38
64
39
65
40−runAt :: Int -> Int -> Parser a -> B.ByteString -> Either E.Error a
66+-- FUNCTOR
41−runAt startRow startColumn (Parser parser) (B.PS fp offset length) =
42− case parser (State fp offset (offset + length) 0 startRow startColumn []) Ok Err Ok Err of
43− Ok value _ _ ->
44− Right value
45
67
46− Err (E.ParseError row col problem) ->
68+
69+instance Functor (Parser c x) where
70+ {-# INLINE fmap #-}
71+ fmap f (Parser parser) =
72+ Parser $ \state cok eok cerr eerr ->
47 let
73 let
48− pos = R.Position row col
74+ cok' a s = cok (f a) s
49− mkError overallRegion subRegion =
75+ eok' a s = eok (f a) s
50− Left (E.Parse overallRegion subRegion problem)
51 in
76 in
52− case problem of
77+ parser state cok' eok' cerr eerr
53− E.BadChar endCol ->
78+
54− mkError (R.Region pos (R.Position row endCol)) Nothing
79+
80+
81+-- APPLICATIVE
82+
55
83
56− E.BadEscape width _ ->
84+instance Applicative.Applicative (Parser c x) where
57− mkError (R.Region pos (R.Position row (col + width))) Nothing
85+ {-# INLINE pure #-}
86+ pure = return
58
87
59− E.BadUnderscore badCol ->
88+ {-# INLINE (<*>) #-}
60− mkError (R.Region pos (R.Position row badCol)) Nothing
89+ (<*>) = ap
61
90
62− E.BadOp _ ((_, start) : _) ->
63− mkError (R.Region start pos) (Just (R.Region pos pos))
64
91
65− E.Theories ((_, start) : _) _ ->
66− mkError (R.Region start pos) (Just (R.Region pos pos))
67
92
68− _ ->
93+-- ONE OF
69− mkError (R.Region pos pos) Nothing
70
94
71
95
96+{-# INLINE oneOf #-}
97+oneOf :: x -> [Parser c x a] -> Parser c x a
98+oneOf x parsers =
99+ Parser $ \state cok eok cerr eerr ->
100+ oneOfHelp state cok eok cerr eerr x parsers
72
101
73−-- RESULT
74
102
103+oneOfHelp
104+ :: State c
105+ -> (a -> State c -> b)
106+ -> (a -> State c -> b)
107+ -> (Word16 -> Word16 -> Context c -> x -> b)
108+ -> (Word16 -> Word16 -> Context c -> x -> b)
109+ -> x
110+ -> [Parser c x a]
111+ -> b
112+oneOfHelp state cok eok cerr eerr x parsers =
113+ case parsers of
114+ Parser parser : parsers ->
115+ let
116+ eerr' _ _ _ _ =
117+ oneOfHelp state cok eok cerr eerr x parsers
118+ in
119+ parser state cok eok cerr eerr'
75
120
76−data Result a
121+ [] ->
77− = Ok a State E.ParseError
122+ let
78− | Err E.ParseError
123+ (State _ _ _ row col ctx) = state
124+ in
125+ eerr row col ctx x
79
126
80
127
81
128
82−-- COMBINATORS
129+-- MONAD
83
130
84
131
85−try :: Parser a -> Parser a
132+instance Monad (Parser c x) where
86−try (Parser parser) =
133+ {-# INLINE return #-}
134+ return value =
87− Parser $ \state cok _ eok eerr ->
135+ Parser $ \state _ eok _ _ ->
88− parser state cok eerr eok eerr
136+ eok value state
89
137
138+ {-# INLINE (>>=) #-}
139+ (Parser parserA) >>= callback =
140+ Parser $ \state cok eok cerr eerr ->
141+ let
142+ cok' a s =
143+ case callback a of
144+ Parser parserB -> parserB s cok cok cerr cerr
90
145
91−deadend :: [E.Theory] -> Parser a
146+ eok' a s =
92−deadend thrys =
147+ case callback a of
93− Parser $ \(State _ _ _ _ row col ctx) _ _ _ eerr ->
148+ Parser parserB -> parserB s cok eok cerr eerr
94− eerr (E.ParseError row col (E.Theories ctx thrys))
149+ in
150+ parserA state cok' eok' cerr eerr
95
151
96
152
97−hint :: E.Next -> Parser a -> Parser a
98−hint next (Parser parser) =
99− Parser $ \state@(State _ _ _ _ row col ctx) cok cerr eok eerr ->
100− let
101− eok' x s _ =
102− eok x s (expect row col ctx (E.Expecting next))
103
153
104− eerr' _ =
154+-- FROM BYTESTRING
105− eerr (expect row col ctx (E.Expecting next))
155+
156+
157+data Result c x a
158+ = Ok a (State c)
159+ | Err Word16 Word16 (Context c) x
160+
161+
162+fromByteString :: Parser c x a -> B.ByteString -> Result c x a
163+fromByteString (Parser parser) (B.PS fp offset length) =
164+ B.accursedUnutterablePerformIO $
165+ let
166+ !pos = plusPtr (unsafeForeignPtrToPtr fp) offset
167+ !end = plusPtr pos length
168+ !result = parser (State pos end 0 1 1 NoContext) Ok Ok Err Err
106 in
169 in
107− parser state cok cerr eok' eerr'
170+ do touchForeignPtr fp
171+ return result
108
172
109
173
110−endOfFile :: Parser ()
174+fromFile :: Parser c x a -> FilePath -> IO (Result c x a)
111−endOfFile =
175+fromFile parser path =
112− Parser $ \state@(State _ offset terminal _ _ _ _) _ _ eok eerr ->
176+ fromByteString parser <$> IO.readUtf8 path -- TODO try mmap
113− if offset < terminal then
114− eerr noError
115− else
116− eok () state noError
117
177
118
178
119−noFloatsAllowedInPatterns :: Parser a
120−noFloatsAllowedInPatterns =
121− Parser $ \(State _ _ _ _ row col _) _ cerr _ _ ->
122− cerr (E.ParseError row col E.FloatInPattern)
123
179
180+-- POSITION
124
181
125
182
126−-- STATE
183+getCol :: Parser c x Word16
184+getCol =
185+ Parser $ \state@(State _ _ _ _ col _) _ eok _ _ ->
186+ eok col state
127
187
128
188
129{-# INLINE getPosition #-}
189{-# INLINE getPosition #-}
130−getPosition :: Parser R.Position
190+getPosition :: Parser c x A.Position
131getPosition =
191getPosition =
132− Parser $ \state@(State _ _ _ _ row col _) _ _ eok _ ->
192+ Parser $ \state@(State _ _ _ row col _) _ eok _ _ ->
133− eok (R.Position row col) state noError
193+ eok (A.Position row col) state
134
194
135
195
136−getIndent :: Parser Int
196+addLocation :: Parser c x a -> Parser c x (A.Located a)
137−getIndent =
197+addLocation (Parser parser) =
138− Parser $ \state@(State _ _ _ indent _ _ _) _ _ eok _ ->
198+ Parser $ \state@(State _ _ _ srow scol _) cok eok cerr eerr ->
139− eok indent state noError
199+ let
140−
200+ cok' a s@(State _ _ _ erow ecol _) = cok (A.At (A.Region (A.Position srow scol) (A.Position erow ecol)) a) s
201+ eok' a s@(State _ _ _ erow ecol _) = eok (A.At (A.Region (A.Position srow scol) (A.Position erow ecol)) a) s
202+ in
203+ parser state cok' eok' cerr eerr
141
204
142−getCol :: Parser Int
143−getCol =
144− Parser $ \state@(State _ _ _ _ _ col _) _ _ eok _ ->
145− eok col state noError
146
205
147
206
148−pushContext :: R.Position -> E.Context -> Parser ()
207+-- INDENT
149−pushContext pos ctx =
150− Parser $ \state@(State _ _ _ _ _ _ context) _ _ eok _ ->
151− eok () (state { _context = (ctx, pos) : context }) noError
152
208
153
209
154−popContext :: a -> Parser a
210+getIndent :: Parser c x Word16
155−popContext value =
211+getIndent =
156− Parser $ \state@(State _ _ _ _ _ _ context) _ _ eok _ ->
212+ Parser $ \state@(State _ _ indent _ _ _) _ eok _ _ ->
157− eok value (state { _context = tail context }) noError
213+ eok indent state
158
214
159
215
160−setIndent :: Int -> Parser ()
216+setIndent :: Word16 -> Parser c x ()
161setIndent indent =
217setIndent indent =
162− Parser $ \state _ _ eok _ ->
218+ Parser $ \(State pos end _ row col context) _ eok _ _ ->
163− eok () (state { _indent = indent }) noError
219+ let
164−
220+ !newState =
221+ State pos end indent row col context
222+ in
223+ eok () newState
165
224
166
225
167−-- SPACE PARSER
168
226
227+-- CONTEXT
169
228
170−type SParser a =
171− Parser (a, R.Position, W.SPos)
172
229
230+pushContext :: A.Position -> c -> Parser c x ()
231+pushContext (A.Position r c) ctx =
232+ Parser $ \(State pos end indent row col context) _ eok _ _ ->
233+ let
234+ !newContext = Frame r c ctx context
235+ !newState = State pos end indent row col newContext
236+ in
237+ eok () newState
173
238
174
239
175−-- LOCATION
240+popContext :: a -> Parser c x a
241+popContext value =
242+ Parser $ \(State pos end indent row col context) _ eok _ _ ->
243+ case context of
244+ Frame _ _ _ context ->
245+ let
246+ !newState =
247+ State pos end indent row col context
248+ in
249+ eok value newState
250+
251+ NoContext ->
252+ error "compiler error, trying to popContext on NoContext"
253+
254+
255+inContext :: c -> Parser c x start -> Parser c x a -> Parser c x a
256+inContext tag (Parser parserStart) (Parser parserA) =
257+ Parser $ \state@(State _ _ _ frow fcol _) cok eok cerr eerr ->
258+ let
259+ cokS _ (State pos end indent row col ctx) =
260+ let
261+ !newContext = Frame frow fcol tag ctx
262+ !newState = State pos end indent row col newContext
263+ cokA a s = cok a (s { _context = ctx })
264+ in
265+ parserA newState cokA cokA cerr cerr
266+
267+ eokS _ (State pos end indent row col ctx) =
268+ let
269+ !newContext = Frame frow fcol tag ctx
270+ !newState = State pos end indent row col newContext
271+ cokA a s = cok a (s { _context = ctx })
272+ eokA a s = eok a (s { _context = ctx })
273+ in
274+ parserA newState cokA eokA cerr eerr
275+ in
276+ parserStart state cokS eokS cerr eerr
176
277
177
278
178−addLocation :: Parser a -> Parser (A.Located a)
179−addLocation parser =
180− do start <- getPosition
181− value <- parser
182− end <- getPosition
183− return (A.at start end value)
184
279
280+-- SYMBOLS
185
281
186−inContext :: R.Position -> E.Context -> Parser a -> Parser a
187−inContext pos ctx parser =
188− do pushContext pos ctx
189− a <- parser
190− popContext a
191
282
283+word1 :: Word8 -> x -> Parser c x ()
284+word1 word x =
285+ Parser $ \(State pos end indent row col ctx) cok _ _ eerr ->
286+ if pos < end && unsafeIndex pos == word then
287+ let !newState = State (plusPtr pos 1) end indent row (col + 1) ctx in
288+ cok () newState
289+ else
290+ eerr row col ctx x
192
291
193−-- WHITESPACE VARIATIONS
194
292
293+word2 :: Word8 -> Word8 -> x -> Parser c x ()
294+word2 w1 w2 x =
295+ Parser $ \(State pos end indent row col ctx) cok _ _ eerr ->
296+ let
297+ !pos1 = plusPtr pos 1
298+ in
299+ if pos1 < end && unsafeIndex pos == w1 && unsafeIndex pos1 == w2 then
300+ let !newState = State (plusPtr pos 2) end indent row (col + 2) ctx in
301+ cok () newState
302+ else
303+ eerr row col ctx x
195
304
196−spaces :: Parser ()
197−spaces =
198− checkSpace =<< W.whitespace
199
305
200
306
201−noSpace :: R.Position -> W.SPos -> Parser ()
307+-- LOW-LEVEL CHECKS
202−noSpace pos (W.SPos spos) =
203− if pos == spos
204− then return ()
205− else deadend []
206
308
207
309
208−checkSpace :: W.SPos -> Parser ()
310+unsafeIndex :: Ptr Word8 -> Word8
209−checkSpace (W.SPos (R.Position _ col)) =
311+unsafeIndex ptr =
210− do indent <- getIndent
312+ B.accursedUnutterablePerformIO (peek ptr)
211− if col > indent && col > 1
212− then return ()
213− else deadend [E.BadSpace]
214
313
215
314
216−checkAligned :: W.SPos -> Parser ()
315+{-# INLINE isWord #-}
217−checkAligned (W.SPos (R.Position _ col)) =
316+isWord :: Ptr Word8 -> Ptr Word8 -> Word8 -> Bool
218− do indent <- getIndent
317+isWord pos end word =
219− if col == indent
318+ pos < end && unsafeIndex pos == word
220− then return ()
221− else deadend [E.BadSpace]
222
319
223
320
224−checkFreshLine :: W.SPos -> Parser ()
321+getCharWidth :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int
225−checkFreshLine (W.SPos (R.Position _ col)) =
322+getCharWidth _pos _end word
226− if col == 1
323+ | word < 0x80 = 1
227− then return ()
324+ | word < 0xc0 = error "Need UTF-8 encoded input. Ran into unrecognized bits."
228− else deadend [E.BadSpace]
325+ | word < 0xe0 = 2
326+ | word < 0xf0 = 3
327+ | word < 0xf8 = 4
328+ | True = error "Need UTF-8 encoded input. Ran into unrecognized bits."
compiler/src/Parse/Primitives/Internals.hsdeleted−243
@@ -1,243 +0,0 @@
1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, OverloadedStrings #-}
3−module Parse.Primitives.Internals
4− ( Parser(..)
5− , State(..)
6− , noError, expect
7− , unsafeIndex, isWord, getCharWidth
8− , isSubstring, isNonNewlineAscii
9− , oneOf
10− )
11− where
12−
13−
14−import Prelude hiding (length)
15−import qualified Control.Applicative as Applicative (Applicative(..))
16−import Control.Monad
17−import qualified Data.ByteString.Internal as B
18−import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
19−import Foreign.Ptr (plusPtr)
20−import Foreign.Storable (peekByteOff)
21−import GHC.ForeignPtr (touchForeignPtr, unsafeForeignPtrToPtr)
22−import GHC.Word (Word8)
23−
24−import qualified Reporting.Error.Syntax as E
25−
26−
27−
28−-- PARSER
29−
30−
31−newtype Parser a =
32− Parser (
33− forall b.
34− State
35− -> (a -> State -> E.ParseError -> b) -- consumed ok
36− -> ( E.ParseError -> b) -- consumed err
37− -> (a -> State -> E.ParseError -> b) -- empty ok
38− -> ( E.ParseError -> b) -- empty err
39− -> b
40− )
41−
42−
43−data State =
44− State
45− { _source :: !(ForeignPtr Word8)
46− , _offset :: !Int
47− , _terminal :: !Int
48− , _indent :: !Int
49− , _row :: !Int
50− , _col :: !Int
51− , _context :: E.ContextStack
52− }
53−
54−
55−
56−-- ERRORS
57−
58−
59−{-# NOINLINE noError #-}
60−noError :: E.ParseError
61−noError =
62− E.ParseError 0 0 (E.Theories [] [])
63−
64−
65−{-# INLINE expect #-}
66−expect :: Int -> Int -> E.ContextStack -> E.Theory -> E.ParseError
67−expect row col ctx theory =
68− E.ParseError row col (E.Theories ctx [theory])
69−
70−
71−
72−-- LOW-LEVEL CHECKS
73−
74−
75−unsafeIndex :: ForeignPtr Word8 -> Int -> Word8
76−unsafeIndex fp offset =
77− B.accursedUnutterablePerformIO $
78− do word <- peekByteOff (unsafeForeignPtrToPtr fp) offset
79− touchForeignPtr fp
80− return word
81−
82−
83−{-# INLINE isWord #-}
84−isWord :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Bool
85−isWord fp offset terminal word =
86− offset < terminal && unsafeIndex fp offset == word
87−
88−
89−getCharWidth :: ForeignPtr Word8 -> Int -> Int -> Word8 -> Int
90−getCharWidth _fp _offset _terminal word
91− | word < 0x80 = 1
92− | word < 0xc0 = error "Need UTF-8 encoded input. Ran into unrecognized bits."
93− | word < 0xe0 = 2
94− | word < 0xf0 = 3
95− | word < 0xf8 = 4
96− | True = error "Need UTF-8 encoded input. Ran into unrecognized bits."
97−
98−
99−{-# INLINE isSubstring #-}
100−isSubstring :: ForeignPtr Word8 -> Int -> Int -> ForeignPtr Word8 -> Int -> Int -> Bool
101−isSubstring subFp subOffset subLength fp offset terminal =
102− offset + subLength <= terminal
103− &&
104− equals fp offset subFp subOffset subLength
105−
106−
107−equals :: ForeignPtr Word8 -> Int -> ForeignPtr Word8 -> Int -> Int -> Bool
108−equals fp1 offset1 fp2 offset2 length =
109− B.accursedUnutterablePerformIO $
110− withForeignPtr fp1 $ \ptr1 ->
111− withForeignPtr fp2 $ \ptr2 ->
112− do i <- B.memcmp (plusPtr ptr1 offset1) (plusPtr ptr2 offset2) (fromIntegral length)
113− return $! i == 0
114−
115−
116−
117−-- VERIFY BYTESTRING STRUCTURE
118−
119−
120−-- Written weird to try to make TCE more likely
121−isNonNewlineAscii :: ForeignPtr Word8 -> Int -> Int -> Bool
122−isNonNewlineAscii !fp !offset !terminal =
123− if offset < terminal then
124− let !word = unsafeIndex fp offset in
125− if word < 128 && word /= 0x0A {- \n -} then
126− isNonNewlineAscii fp (offset + 1) terminal
127− else
128− False
129−
130− else
131− True
132−
133−
134−
135−-- FUNCTOR
136−
137−
138−instance Functor Parser where
139− {-# INLINE fmap #-}
140− fmap f (Parser parser) =
141− Parser $ \state cok cerr eok eerr ->
142− let
143− cok' x s e = cok (f x) s e
144− eok' x s e = eok (f x) s e
145− in
146− parser state cok' cerr eok' eerr
147−
148−
149−
150−-- APPLICATIVE
151−
152−
153−instance Applicative.Applicative Parser where
154− {-# INLINE pure #-}
155− pure = return
156−
157− {-# INLINE (<*>) #-}
158− (<*>) = ap
159−
160−
161−oneOf :: [Parser a] -> Parser a
162−oneOf parsers =
163− foldr oneOfHelp allTheOptionsFailed parsers
164−
165−
166−allTheOptionsFailed :: Parser a
167−allTheOptionsFailed =
168− Parser $ \_ _ _ _ eerr ->
169− eerr noError
170−
171−
172−oneOfHelp :: Parser a -> Parser a -> Parser a
173−oneOfHelp (Parser parser1) (Parser parser2) =
174− Parser $ \state cok cerr eok eerr ->
175− let
176− eerr1 e1 =
177− let
178− eok2 y s e2 = eok y s (mergeErrors e1 e2)
179− eerr2 e2 = eerr (mergeErrors e1 e2)
180− in
181− parser2 state cok cerr eok2 eerr2
182− in
183− parser1 state cok cerr eok eerr1
184−
185−
186−mergeErrors :: E.ParseError -> E.ParseError -> E.ParseError
187−mergeErrors e1@(E.ParseError r1 c1 p1) e2@(E.ParseError r2 c2 p2) =
188− case compare r1 r2 of
189− LT -> e2
190− GT -> e1
191− EQ ->
192− case compare c1 c2 of
193− LT -> e2
194− GT -> e1
195− EQ ->
196− case (p1, p2) of
197− (E.Theories _ [], E.Theories _ _) ->
198− e2
199−
200− (E.Theories _ _, E.Theories _ []) ->
201− e1
202−
203− (E.Theories ctx ts1, E.Theories _ ts2) ->
204− E.ParseError r1 c1 (E.Theories ctx (ts1 ++ ts2))
205−
206− (E.Theories _ _, _) ->
207− e2
208−
209− (_, _) ->
210− e1
211−
212−
213−
214−-- MONAD
215−
216−
217−instance Monad Parser where
218− {-# INLINE return #-}
219− return value =
220− Parser $ \state _ _ eok _ ->
221− eok value state noError
222−
223− {-# INLINE (>>=) #-}
224− (Parser parser) >>= callback =
225− Parser $ \state cok cerr eok eerr ->
226− let
227− cok1 x s1 e1 =
228− let
229− eok2 y s2 e2 = cok y s2 (mergeErrors e1 e2)
230− eerr2 e2 = cerr (mergeErrors e1 e2)
231− in
232− case callback x of
233− Parser parser2 -> parser2 s1 cok cerr eok2 eerr2
234−
235− eok1 x s1 e1 =
236− let
237− eok2 y s2 e2 = eok y s2 (mergeErrors e1 e2)
238− eerr2 e2 = eerr (mergeErrors e1 e2)
239− in
240− case callback x of
241− Parser parser2 -> parser2 s1 cok cerr eok2 eerr2
242− in
243− parser state cok1 cerr eok1 eerr