git.iko.soy/elk
on master help sign in
Start to track context in errors only
cb2368fEvan Czaplicki
compiler/src/Parse/Primitives.hs+139−104
compare with master
unifiedsplit
@@ -5,11 +5,12 @@ module Parse.Primitives
5 , fromByteString
5 , fromByteString
6 , Parser(..)
6 , Parser(..)
7 , State(..)
7 , State(..)
8− , Context(..)
8+ , Row
9− , oneOf
9+ , Col
10− , pushContext, popContext, inContext
10+ , oneOf, oneOfWithFallback
11+ , inContext, specialize
11− , getPosition, getCol, addLocation
12+ , getPosition, getCol, addLocation, addEnd
12− , getIndent, setIndent
13+ , getIndent, setIndent, withIndent, withBacksetIndent
13 , word1, word2
14 , word1, word2
14 , unsafeIndex, isWord, getCharWidth
15 , unsafeIndex, isWord, getCharWidth
15 )
16 )
@@ -32,39 +33,37 @@ import qualified Reporting.Annotation as A
32-- PARSER
33-- PARSER
33
34
34
35
35−newtype Parser c x a =
36+newtype Parser x a =
36 Parser (
37 Parser (
37 forall b.
38 forall b.
38− State c
39+ State
39− -> (a -> State c -> b) -- consumed ok
40+ -> (a -> State -> b) -- consumed ok
40− -> (a -> State c -> b) -- empty ok
41+ -> (a -> State -> b) -- empty ok
41− -> (Word16 -> Word16 -> Context c -> x -> b) -- consumed err
42+ -> (Row -> Col -> (Row -> Col -> x) -> b) -- consumed err
42− -> (Word16 -> Word16 -> Context c -> x -> b) -- empty err
43+ -> (Row -> Col -> (Row -> Col -> x) -> b) -- empty err
43 -> b
44 -> b
44 )
45 )
45
46
46
47
47−data State c =
48+data State = -- TODO try adding UNPACK to everything
48 State
49 State
49 { _pos :: !(Ptr Word8)
50 { _pos :: !(Ptr Word8)
50 , _end :: !(Ptr Word8)
51 , _end :: !(Ptr Word8)
51 , _indent :: !Word16
52 , _indent :: !Word16
52− , _row :: !Word16
53+ , _row :: !Row
53− , _col :: !Word16
54+ , _col :: !Col
54− , _context :: Context c
55 }
55 }
56
56
57
57
58−data Context c
58+type Row = Word16
59− = NoContext
59+type Col = Word16
60− | Frame {-# UNPACK #-} !Word16 {-# UNPACK #-} !Word16 c (Context c)
61
60
62
61
63
62
64-- FUNCTOR
63-- FUNCTOR
65
64
66
65
67−instance Functor (Parser c x) where
66+instance Functor (Parser x) where
68 {-# INLINE fmap #-}
67 {-# INLINE fmap #-}
69 fmap f (Parser parser) =
68 fmap f (Parser parser) =
70 Parser $ \state cok eok cerr eerr ->
69 Parser $ \state cok eok cerr eerr ->
@@ -79,7 +78,7 @@ instance Functor (Parser c x) where
79-- APPLICATIVE
78-- APPLICATIVE
80
79
81
80
82−instance Applicative.Applicative (Parser c x) where
81+instance Applicative.Applicative (Parser x) where
83 {-# INLINE pure #-}
82 {-# INLINE pure #-}
84 pure = return
83 pure = return
85
84
@@ -92,42 +91,74 @@ instance Applicative.Applicative (Parser c x) where
92
91
93
92
94{-# INLINE oneOf #-}
93{-# INLINE oneOf #-}
95−oneOf :: x -> [Parser c x a] -> Parser c x a
94+oneOf :: (Row -> Col -> x) -> [Parser x a] -> Parser x a
96−oneOf x parsers =
95+oneOf toError parsers =
97 Parser $ \state cok eok cerr eerr ->
96 Parser $ \state cok eok cerr eerr ->
98− oneOfHelp state cok eok cerr eerr x parsers
97+ oneOfHelp state cok eok cerr eerr toError parsers
99
98
100
99
101oneOfHelp
100oneOfHelp
102− :: State c
101+ :: State
103− -> (a -> State c -> b)
102+ -> (a -> State -> b)
104− -> (a -> State c -> b)
103+ -> (a -> State -> b)
105− -> (Word16 -> Word16 -> Context c -> x -> b)
104+ -> (Row -> Col -> (Row -> Col -> x) -> b)
106− -> (Word16 -> Word16 -> Context c -> x -> b)
105+ -> (Row -> Col -> (Row -> Col -> x) -> b)
107− -> x
106+ -> (Row -> Col -> x)
108− -> [Parser c x a]
107+ -> [Parser x a]
109 -> b
108 -> b
110−oneOfHelp state cok eok cerr eerr x parsers =
109+oneOfHelp state cok eok cerr eerr toError parsers =
111 case parsers of
110 case parsers of
112 Parser parser : parsers ->
111 Parser parser : parsers ->
113 let
112 let
114− eerr' _ _ _ _ =
113+ eerr' _ _ _ =
115− oneOfHelp state cok eok cerr eerr x parsers
114+ oneOfHelp state cok eok cerr eerr toError parsers
116 in
115 in
117 parser state cok eok cerr eerr'
116 parser state cok eok cerr eerr'
118
117
119 [] ->
118 [] ->
120 let
119 let
121− (State _ _ _ row col ctx) = state
120+ (State _ _ _ row col) = state
122 in
121 in
123− eerr row col ctx x
122+ eerr row col toError
123+
124+
125+
126+-- ONE OF WITH FALLBACK
127+
128+
129+{-# INLINE oneOfWithFallback #-}
130+oneOfWithFallback :: [Parser x a] -> a -> Parser x a -- TODO is this function okay? Worried about allocation/laziness with fallback values.
131+oneOfWithFallback parsers fallback =
132+ Parser $ \state cok eok cerr _ ->
133+ oowfHelp state cok eok cerr parsers fallback
134+
135+
136+oowfHelp
137+ :: State
138+ -> (a -> State -> b)
139+ -> (a -> State -> b)
140+ -> (Row -> Col -> (Row -> Col -> x) -> b)
141+ -> [Parser x a]
142+ -> a
143+ -> b
144+oowfHelp state cok eok cerr parsers fallback =
145+ case parsers of
146+ [] ->
147+ eok fallback state
148+
149+ Parser parser : parsers ->
150+ let
151+ eerr' _ _ _ =
152+ oowfHelp state cok eok cerr parsers fallback
153+ in
154+ parser state cok eok cerr eerr'
124
155
125
156
126
157
127-- MONAD
158-- MONAD
128
159
129
160
130−instance Monad (Parser c x) where
161+instance Monad (Parser x) where
131 {-# INLINE return #-}
162 {-# INLINE return #-}
132 return value =
163 return value =
133 Parser $ \state _ eok _ _ ->
164 Parser $ \state _ eok _ _ ->
@@ -152,148 +183,152 @@ instance Monad (Parser c x) where
152-- FROM BYTESTRING
183-- FROM BYTESTRING
153
184
154
185
155−data Result c x a
186+data Result x a
156− = Ok !a (State c)
187+ = Ok !a State
157− | Err Word16 Word16 (Context c) x
188+ | Err x
158
189
159
190
160−fromByteString :: Parser c x a -> B.ByteString -> Result c x a
191+fromByteString :: Parser x a -> B.ByteString -> Result x a
161fromByteString (Parser parser) (B.PS fp offset length) =
192fromByteString (Parser parser) (B.PS fp offset length) =
162 B.accursedUnutterablePerformIO $
193 B.accursedUnutterablePerformIO $
163 let
194 let
164 !pos = plusPtr (unsafeForeignPtrToPtr fp) offset
195 !pos = plusPtr (unsafeForeignPtrToPtr fp) offset
165 !end = plusPtr pos length
196 !end = plusPtr pos length
166− !result = parser (State pos end 0 1 1 NoContext) Ok Ok Err Err
197+ !result = parser (State pos end 0 1 1) Ok Ok toErr toErr
167 in
198 in
168 do touchForeignPtr fp
199 do touchForeignPtr fp
169 return result
200 return result
170
201
171
202
203+toErr :: Row -> Col -> (Row -> Col -> x) -> Result x a
204+toErr row col toError =
205+ Err (toError row col)
206+
207+
172
208
173-- POSITION
209-- POSITION
174
210
175
211
176−getCol :: Parser c x Word16
212+getCol :: Parser x Word16
177getCol =
213getCol =
178− Parser $ \state@(State _ _ _ _ col _) _ eok _ _ ->
214+ Parser $ \state@(State _ _ _ _ col) _ eok _ _ ->
179 eok col state
215 eok col state
180
216
181
217
182{-# INLINE getPosition #-}
218{-# INLINE getPosition #-}
183−getPosition :: Parser c x A.Position
219+getPosition :: Parser x A.Position
184getPosition =
220getPosition =
185− Parser $ \state@(State _ _ _ row col _) _ eok _ _ ->
221+ Parser $ \state@(State _ _ _ row col) _ eok _ _ ->
186 eok (A.Position row col) state
222 eok (A.Position row col) state
187
223
188
224
189−addLocation :: Parser c x a -> Parser c x (A.Located a)
225+addLocation :: Parser x a -> Parser x (A.Located a)
190addLocation (Parser parser) =
226addLocation (Parser parser) =
191− Parser $ \state@(State _ _ _ srow scol _) cok eok cerr eerr ->
227+ Parser $ \state@(State _ _ _ sr sc) cok eok cerr eerr ->
192 let
228 let
193− cok' a s@(State _ _ _ erow ecol _) = cok (A.At (A.Region (A.Position srow scol) (A.Position erow ecol)) a) s
229+ cok' a s@(State _ _ _ er ec) = cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) a) s
194− eok' a s@(State _ _ _ erow ecol _) = eok (A.At (A.Region (A.Position srow scol) (A.Position erow ecol)) a) s
230+ eok' a s@(State _ _ _ er ec) = eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) a) s
195 in
231 in
196 parser state cok' eok' cerr eerr
232 parser state cok' eok' cerr eerr
197
233
198
234
235+addEnd :: A.Position -> a -> Parser x (A.Located a)
236+addEnd start value =
237+ Parser $ \state@(State _ _ _ row col) _ eok _ _ ->
238+ eok (A.at start (A.Position row col) value) state
239+
240+
199
241
200-- INDENT
242-- INDENT
201
243
202
244
203−getIndent :: Parser c x Word16
245+getIndent :: Parser x Word16
204getIndent =
246getIndent =
205− Parser $ \state@(State _ _ indent _ _ _) _ eok _ _ ->
247+ Parser $ \state@(State _ _ indent _ _) _ eok _ _ ->
206 eok indent state
248 eok indent state
207
249
208
250
209−setIndent :: Word16 -> Parser c x ()
251+setIndent :: Word16 -> Parser x ()
210setIndent indent =
252setIndent indent =
211− Parser $ \(State pos end _ row col context) _ eok _ _ ->
253+ Parser $ \(State pos end _ row col) _ eok _ _ ->
212 let
254 let
213− !newState =
214− State pos end indent row col context
255+ !newState = State pos end indent row col
215 in
256 in
216 eok () newState
257 eok () newState
217
258
218
259
219−
260+withIndent :: Parser x a -> Parser x a
220−-- CONTEXT
261+withIndent (Parser parser) =
262+ Parser $ \(State pos end oldIndent row col) cok eok cerr eerr ->
263+ let
264+ cok' a (State p e _ r c) = cok a (State p e oldIndent r c)
265+ eok' a (State p e _ r c) = eok a (State p e oldIndent r c)
266+ in
267+ parser (State pos end col row col) cok' eok' cerr eerr
221
268
222
269
223−pushContext :: A.Position -> c -> Parser c x ()
270+withBacksetIndent :: Word16 -> Parser x a -> Parser x a
224−pushContext (A.Position r c) ctx =
271+withBacksetIndent backset (Parser parser) =
225− Parser $ \(State pos end indent row col context) _ eok _ _ ->
272+ Parser $ \(State pos end oldIndent row col) cok eok cerr eerr ->
226 let
273 let
227− !newContext = Frame r c ctx context
274+ cok' a (State p e _ r c) = cok a (State p e oldIndent r c)
228− !newState = State pos end indent row col newContext
275+ eok' a (State p e _ r c) = eok a (State p e oldIndent r c)
229 in
276 in
230− eok () newState
277+ parser (State pos end (col - backset) row col) cok' eok' cerr eerr
231
278
232
279
233−popContext :: a -> Parser c x a
234−popContext value =
235− Parser $ \(State pos end indent row col context) _ eok _ _ ->
236− case context of
237− Frame _ _ _ context ->
238− let
239− !newState =
240− State pos end indent row col context
241− in
242− eok value newState
243
280
244− NoContext ->
281+-- CONTEXT
245− error "compiler error, trying to popContext on NoContext"
246
282
247
283
248−inContext :: c -> Parser c x start -> Parser c x a -> Parser c x a
284+inContext :: (x -> Row -> Col -> y) -> Parser y start -> Parser x a -> Parser y a
249−inContext tag (Parser parserStart) (Parser parserA) =
285+inContext addContext (Parser parserStart) (Parser parserA) =
250− Parser $ \state@(State _ _ _ frow fcol _) cok eok cerr eerr ->
286+ Parser $ \state@(State _ _ _ row col) cok eok cerr eerr ->
251 let
287 let
252− cokS _ (State pos end indent row col ctx) =
288+ cerrA r c tx = cerr row col (addContext (tx r c))
253− let
289+ eerrA r c tx = eerr row col (addContext (tx r c))
254− !newContext = Frame frow fcol tag ctx
290+
255− !newState = State pos end indent row col newContext
291+ cokS _ s = parserA s cok cok cerrA cerrA
256− cokA a s = cok a (s { _context = ctx })
292+ eokS _ s = parserA s cok eok cerrA eerrA
257− in
258− parserA newState cokA cokA cerr cerr
259−
260− eokS _ (State pos end indent row col ctx) =
261− let
262− !newContext = Frame frow fcol tag ctx
263− !newState = State pos end indent row col newContext
264− cokA a s = cok a (s { _context = ctx })
265− eokA a s = eok a (s { _context = ctx })
266− in
267− parserA newState cokA eokA cerr eerr
268 in
293 in
269 parserStart state cokS eokS cerr eerr
294 parserStart state cokS eokS cerr eerr
270
295
271
296
297+specialize :: (x -> Row -> Col -> y) -> Parser x a -> Parser y a
298+specialize addContext (Parser parser) =
299+ Parser $ \state@(State _ _ _ row col) cok eok cerr eerr ->
300+ let
301+ cerr' r c tx = cerr row col (addContext (tx r c))
302+ eerr' r c tx = eerr row col (addContext (tx r c))
303+ in
304+ parser state cok eok cerr' eerr'
305+
306+
272
307
273-- SYMBOLS
308-- SYMBOLS
274
309
275
310
276−word1 :: Word8 -> x -> Parser c x ()
311+word1 :: Word8 -> (Row -> Col -> x) -> Parser x ()
277−word1 word x =
312+word1 word toError =
278− Parser $ \(State pos end indent row col ctx) cok _ _ eerr ->
313+ Parser $ \(State pos end indent row col) cok _ _ eerr ->
279 if pos < end && unsafeIndex pos == word then
314 if pos < end && unsafeIndex pos == word then
280− let !newState = State (plusPtr pos 1) end indent row (col + 1) ctx in
315+ let !newState = State (plusPtr pos 1) end indent row (col + 1) in
281 cok () newState
316 cok () newState
282 else
317 else
283− eerr row col ctx x
318+ eerr row col toError
284
319
285
320
286−word2 :: Word8 -> Word8 -> x -> Parser c x ()
321+word2 :: Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()
287−word2 w1 w2 x =
322+word2 w1 w2 toError =
288− Parser $ \(State pos end indent row col ctx) cok _ _ eerr ->
323+ Parser $ \(State pos end indent row col) cok _ _ eerr ->
289 let
324 let
290 !pos1 = plusPtr pos 1
325 !pos1 = plusPtr pos 1
291 in
326 in
292 if pos1 < end && unsafeIndex pos == w1 && unsafeIndex pos1 == w2 then
327 if pos1 < end && unsafeIndex pos == w1 && unsafeIndex pos1 == w2 then
293− let !newState = State (plusPtr pos 2) end indent row (col + 2) ctx in
328+ let !newState = State (plusPtr pos 2) end indent row (col + 2) in
294 cok () newState
329 cok () newState
295 else
330 else
296− eerr row col ctx x
331+ eerr row col toError
297
332
298
333
299
334