@@ -7,19 +7,18 @@ module Parse.Expression
77
88
99import qualified Data.Name as Name
10−import Data.Word (Word16)
1110
1211import qualified AST.Source as Src
1312import qualified Parse.Keyword as Keyword
1413import qualified Parse.Number as Number
1514import qualified Parse.Pattern as Pattern
1615import qualified Parse.Shader as Shader
16+import qualified Parse.Space as Space
1717import qualified Parse.Symbol as Symbol
1818import qualified Parse.Type as Type
1919import qualified Parse.Utf8 as Utf8
2020import qualified Parse.Variable as Var
21−import Parse.Utils
22−import Parse.Primitives hiding (Parser, State)
21+import Parse.Primitives hiding (State)
2322import qualified Parse.Primitives as P
2423import qualified Reporting.Annotation as A
2524import qualified Reporting.Error.Syntax as E
@@ -29,10 +28,10 @@ import qualified Reporting.Error.Syntax as E
2928-- TERMS
3029
3130
32−term :: Parser Src.Expr
31+term :: Parser E.Expr Src.Expr
3332term =
3433 do start <- getPosition
35− oneOf E.XXX
34+ oneOf E.Start
3635 [ variable start >>= accessible start
3736 , string start
3837 , number start
@@ -45,90 +44,80 @@ term =
4544 ]
4645
4746
48−string :: A.Position -> Parser Src.Expr
47+string :: A.Position -> Parser E.Expr Src.Expr
4948string start =
50− do str <- Utf8.string
51− end <- getPosition
52− return (A.at start end (Src.Str str))
49+ do str <- Utf8.string E.Start E.String
50+ addEnd start (Src.Str str)
5351
5452
55−character :: A.Position -> Parser Src.Expr
53+character :: A.Position -> Parser E.Expr Src.Expr
5654character start =
57− do chr <- Utf8.character
58− end <- getPosition
59− return (A.at start end (Src.Chr chr))
55+ do chr <- Utf8.character E.Start E.Char
56+ addEnd start (Src.Chr chr)
6057
6158
62−number :: A.Position -> Parser Src.Expr
59+number :: A.Position -> Parser E.Expr Src.Expr
6360number start =
64− do nmbr <- Number.number
65− end <- getPosition
66− return $ A.at start end $
61+ do nmbr <- Number.number E.Start E.Number
62+ addEnd start $
6763 case nmbr of
68− Number.Int int ->
69− Src.Int int
64+ Number.Int int -> Src.Int int
65+ Number.Float float -> Src.Float float
7066
71− Number.Float float ->
72− Src.Float float
7367
74−
75−accessor :: A.Position -> Parser Src.Expr
68+accessor :: A.Position -> Parser E.Expr Src.Expr
7669accessor start =
77− do word1 0x2E {-.-} E.XXX
78− field <- Var.lower
79− end <- getPosition
80− return (A.at start end (Src.Accessor field))
70+ do word1 0x2E {-.-} E.Dot
71+ field <- Var.lower E.Access
72+ addEnd start (Src.Accessor field)
8173
8274
83−variable :: A.Position -> Parser Src.Expr
75+variable :: A.Position -> Parser E.Expr Src.Expr
8476variable start =
85− do var <- Var.foreignAlpha
86− end <- getPosition
87− return (A.at start end var)
77+ do var <- Var.foreignAlpha E.Start
78+ addEnd start var
8879
8980
90−accessible :: A.Position -> Src.Expr -> Parser Src.Expr
81+accessible :: A.Position -> Src.Expr -> Parser E.Expr Src.Expr
9182accessible start expr =
92− oneOf E.XXX
93− [ do word1 0x2E {-.-} E.XXX
83+ oneOfWithFallback
84+ [ do word1 0x2E {-.-} E.Dot
9485 pos <- getPosition
95− field <- Var.lower
86+ field <- Var.lower E.Access
9687 end <- getPosition
97− let newExpr = A.at start end (Src.Access expr (A.at pos end field))
98− accessible start newExpr
99− , return expr
88+ accessible start $
89+ A.at start end (Src.Access expr (A.at pos end field))
10090 ]
91+ expr
10192
10293
10394
10495-- LISTS
10596
10697
107−list :: A.Position -> Parser Src.Expr
98+list :: A.Position -> Parser E.Expr Src.Expr
10899list start =
109− inContext E.ExprList (word1 0x5B {-[-} E.XXX) $
110− do spaces
111− oneOf E.XXX
112− [ do (entry, _, pos) <- expression
113− checkSpace pos
114− listHelp start [entry]
115− , do word1 0x5D {-]-} E.XXX
116− end <- getPosition
117− return (A.at start end (Src.List []))
100+ inContext E.List (word1 0x5B {-[-} E.Start) $
101+ do Space.chompAndCheckIndent E.ListSpace E.ListIndentOpen
102+ oneOf E.ListOpen
103+ [ do (entry, end) <- specialize E.ListExpr expression
104+ Space.checkIndent end E.ListIndentEnd
105+ chompListEnd start [entry]
106+ , do word1 0x5D {-]-} E.ListOpen
107+ addEnd start (Src.List [])
118108 ]
119109
120110
121−listHelp :: A.Position -> [Src.Expr] -> Parser Src.Expr
122−listHelp start entries =
123− oneOf E.XXX
124− [ do word1 0x2C {-,-} E.XXX
125− spaces
126− (entry, _, pos) <- expression
127− checkSpace pos
128− listHelp start (entry:entries)
129− , do word1 0x5D {-]-} E.XXX
130− end <- getPosition
131− return (A.at start end (Src.List (reverse entries)))
111+chompListEnd :: A.Position -> [Src.Expr] -> Parser E.List Src.Expr
112+chompListEnd start entries =
113+ oneOf E.ListEnd
114+ [ do word1 0x2C {-,-} E.ListEnd
115+ Space.chompAndCheckIndent E.ListSpace E.ListIndentExpr
116+ (entry, end) <- specialize E.ListExpr expression
117+ Space.checkIndent end E.ListIndentEnd
118+ chompListEnd start (entry:entries)
119+ , do word1 0x5D {-]-} E.ListEnd
120+ addEnd start (Src.List (reverse entries))
132121 ]
133122
134123
@@ -136,52 +125,55 @@ listHelp start entries =
136125-- TUPLES
137126
138127
139−tuple :: A.Position -> Parser Src.Expr
140−tuple start =
141− inContext E.ExprTuple (word1 0x28 {-(-} E.XXX) $
142− do pos <- getPosition
143− spos <- whitespace
144− oneOf E.XXX
145− [ do noSpace pos spos
146− word2 0x2D 0x29 {--)-} E.XXX
147− end <- getPosition
148− return $ A.at start end (Src.Op "-")
149−
150− , do checkSpace spos
151− (entry, _, spos2) <- expression
152− checkSpace spos2
153− tupleHelp start entry []
154−
155− , do noSpace pos spos
156− op <- Symbol.binop
157− word1 0x29 {-)-} E.XXX
158− end <- getPosition
159− return $ A.at start end (Src.Op op)
160−
161− , do noSpace pos spos
162− word1 0x29 {-)-} E.XXX
163− end <- getPosition
164− return (A.at start end Src.Unit)
165−
166− ]
167−
168−
169−tupleHelp :: A.Position -> Src.Expr -> [Src.Expr] -> Parser Src.Expr
170−tupleHelp start firstExpr revExprs =
171− oneOf E.XXX
172− [ do word1 0x2C {-,-} E.XXX
173− spaces
174− (entry, _, pos) <- expression
175− checkSpace pos
176− tupleHelp start firstExpr (entry : revExprs)
177− , do word1 0x29 {-)-} E.XXX
178− end <- getPosition
128+tuple :: A.Position -> Parser E.Expr Src.Expr
129+tuple start@(A.Position row col) =
130+ inContext E.Tuple (word1 0x28 {-(-} E.Start) $
131+ oneOf E.TupleOpen
132+ [
133+ do op <- Symbol.operator E.TupleOpen E.TupleOperatorReserved
134+ if op == "-"
135+ then
136+ oneOf E.TupleOperatorClose
137+ [
138+ do word1 0x29 {-)-} E.TupleOperatorClose
139+ addEnd start (Src.Op op)
140+ ,
141+ specialize E.TupleExpr $
142+ do negatedExpr@(A.At (A.Region _ end) _) <- term
143+ Space.chomp E.Space
144+ let exprStart = A.Position row (col + 2)
145+ let expr = A.at exprStart end (Src.Negate negatedExpr)
146+ fst <$> chompExprEnd exprStart (State [] expr [] end)
147+ ]
148+ else
149+ do word1 0x29 {-)-} E.TupleOperatorClose
150+ addEnd start (Src.Op op)
151+ ,
152+ do word1 0x29 {-)-} E.TupleOpen
153+ addEnd start Src.Unit
154+ ,
155+ do Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr
156+ (entry, end) <- specialize E.TupleExpr expression
157+ Space.checkIndent end E.TupleIndentEnd
158+ chompTupleEnd start entry []
159+ ]
160+
161+
162+chompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr
163+chompTupleEnd start firstExpr revExprs =
164+ oneOf E.TupleEnd
165+ [ do word1 0x2C {-,-} E.TupleEnd
166+ Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr
167+ (entry, end) <- specialize E.TupleExpr expression
168+ Space.checkIndent end E.TupleIndentEnd
169+ chompTupleEnd start firstExpr (entry : revExprs)
170+ , do word1 0x29 {-)-} E.TupleEnd
179171 case reverse revExprs of
180172 [] ->
181173 return firstExpr
182174
183− secondExpr : others ->
184− return (A.at start end (Src.Tuple firstExpr secondExpr others))
175+ secondExpr : otherExprs ->
176+ addEnd start (Src.Tuple firstExpr secondExpr otherExprs)
185177 ]
186178
187179
@@ -189,30 +181,27 @@ tupleHelp start firstExpr revExprs =
189181-- RECORDS
190182
191183
192−record :: A.Position -> Parser Src.Expr
184+record :: A.Position -> Parser E.Expr Src.Expr
193185record start =
194− inContext E.ExprRecord (word1 0x7B {- { -} E.XXX) $
195− do spaces
196− oneOf E.XXX
197− [ do word1 0x7D {-}-} E.XXX
198− end <- getPosition
199− return (A.at start end (Src.Record []))
200− , do starter <- addLocation Var.lower
201− spaces
202− oneOf E.XXX
203− [ do word1 0x7C {-|-} E.XXX
204− spaces
186+ inContext E.Record (word1 0x7B {- { -} E.Start) $
187+ do Space.chompAndCheckIndent E.RecordSpace E.RecordIndentOpen
188+ oneOf E.RecordOpen
189+ [ do word1 0x7D {-}-} E.RecordOpen
190+ addEnd start (Src.Record [])
191+ , do starter <- addLocation (Var.lower E.RecordField)
192+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals
193+ oneOf E.RecordEquals
194+ [ do word1 0x7C {-|-} E.RecordEquals
195+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentField
205196 firstField <- chompField
206197 fields <- chompFields [firstField]
207− end <- getPosition
208− return (A.at start end (Src.Update starter fields))
209− , do word1 0x3D {-=-} E.XXX
210− spaces
211− (value, _, nextPos) <- expression
212− checkSpace nextPos
198+ addEnd start (Src.Update starter fields)
199+ , do word1 0x3D {-=-} E.RecordEquals
200+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr
201+ (value, end) <- specialize E.RecordExpr expression
202+ Space.checkIndent end E.RecordIndentEnd
213203 fields <- chompFields [(starter, value)]
214− end <- getPosition
215− return (A.at start end (Src.Record fields))
204+ addEnd start (Src.Record fields)
216205 ]
217206 ]
218207
@@ -220,26 +209,26 @@ record start =
220209type Field = ( A.Located Name.Name, Src.Expr )
221210
222211
223−chompFields :: [Field] -> Parser [Field]
212+chompFields :: [Field] -> Parser E.Record [Field]
224213chompFields fields =
225− oneOf E.XXX
226− [ do word1 0x2C {-,-} E.XXX
227− spaces
214+ oneOf E.RecordEnd
215+ [ do word1 0x2C {-,-} E.RecordEnd
216+ Space.chompAndCheckIndent E.RecordSpace E.RecordField
228217 f <- chompField
229218 chompFields (f : fields)
230− , do word1 0x7D {-}-} E.XXX
219+ , do word1 0x7D {-}-} E.RecordEnd
231220 return (reverse fields)
232221 ]
233222
234223
235−chompField :: Parser Field
224+chompField :: Parser E.Record Field
236225chompField =
237− do key <- addLocation Var.lower
238− spaces
239− word1 0x3D {-=-} E.XXX
240− spaces
241− (value, _, pos) <- expression
242− checkSpace pos
226+ do key <- addLocation (Var.lower E.RecordField)
227+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals
228+ word1 0x3D {-=-} E.RecordEquals
229+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr
230+ (value, end) <- specialize E.RecordExpr expression
231+ Space.checkIndent end E.RecordIndentEnd
243232 return (key, value)
244233
245234
@@ -247,22 +236,18 @@ chompField =
247236-- EXPRESSIONS
248237
249238
250−type ExprParser =
251− SParser Src.Expr
252−
253−
254−expression :: ExprParser
239+expression :: Space.Parser E.Expr Src.Expr
255240expression =
256241 do start <- getPosition
257− oneOf E.XXX
242+ oneOf E.Start
258243 [ let_ start
259244 , if_ start
260245 , case_ start
261246 , function start
262247 , do expr <- possiblyNegativeTerm start
263248 end <- getPosition
264− space <- whitespace
265− exprHelp start (State [] expr [] end space)
249+ Space.chomp E.Space
250+ chompExprEnd start (State [] expr [] end)
266251 ]
267252
268253
@@ -272,77 +257,76 @@ data State =
272257 , _expr :: !Src.Expr
273258 , _args :: ![Src.Expr]
274259 , _end :: !A.Position
275− , _pos :: !SPos
276260 }
277261
278262
279−exprHelp :: A.Position -> State -> ExprParser
280−exprHelp start (State ops expr args end pos) =
281− oneOf E.XXX
263+chompExprEnd :: A.Position -> State -> Space.Parser E.Expr Src.Expr
264+chompExprEnd start (State ops expr args end) =
265+ oneOfWithFallback
282266 [ -- argument
283− do checkSpace pos
267+ do Space.checkIndent end E.IndentMoreExpr
284268 arg <- term
285269 newEnd <- getPosition
286− newPos <- whitespace
287− exprHelp start (State ops expr (arg:args) newEnd newPos)
288−
289− , -- infix operator
290− do checkSpace pos
291− opStart <- getPosition
292− opName <- Symbol.binop
293− opEnd <- getPosition
294− let op = A.at opStart opEnd opName
295− spos <- whitespace
296− checkSpace spos
270+ Space.chomp E.Space
271+ chompExprEnd start (State ops expr (arg:args) newEnd)
272+
273+ , -- operator
274+ do Space.checkIndent end E.IndentMoreExpr
275+ op@(A.At (A.Region opStart opEnd) opName) <- addLocation (Symbol.operator E.Start E.OperatorReserved)
276+ Space.chompAndCheckIndent E.Space E.IndentOperatorRight
297277 newStart <- getPosition
298278 if "-" == opName && end /= opStart && opEnd == newStart
299279 then
300280 -- negative terms
301− do rawTerm <- term
281+ do negatedExpr <- term
302282 newEnd <- getPosition
303− newPos <- whitespace
304− let arg = A.at opStart newEnd (Src.Negate rawTerm)
305− exprHelp start (State ops expr (arg:args) newEnd newPos)
283+ Space.chomp E.Space
284+ let arg = A.at opStart newEnd (Src.Negate negatedExpr)
285+ chompExprEnd start (State ops expr (arg:args) newEnd)
306286 else
307− oneOf E.XXX
287+ oneOf E.OperatorRight
308288 [ -- term
309289 do newExpr <- possiblyNegativeTerm newStart
310290 newEnd <- getPosition
311− newPos <- whitespace
291+ Space.chomp E.Space
312292 let newOps = (toCall expr args, op) : ops
313− exprHelp start (State newOps newExpr [] newEnd newPos)
293+ chompExprEnd start (State newOps newExpr [] newEnd)
314294
315295 , -- final term
316− do (newLast, newEnd, newPos) <-
317− oneOf E.XXX
296+ do (newLast, newEnd) <-
297+ oneOf E.OperatorRight
318298 [ let_ newStart
319299 , case_ newStart
320300 , if_ newStart
321301 , function newStart
322302 ]
323303 let newOps = (toCall expr args, op) : ops
324− let finalExpr = A.at start newEnd (Src.Binops (reverse newOps) newLast)
325− return ( finalExpr, newEnd, newPos )
304+ let finalExpr = Src.Binops (reverse newOps) newLast
305+ return ( A.at start newEnd finalExpr, newEnd )
326306 ]
327307
328− , -- done
329− let finalExpr = toCall expr args in
308+ ]
309+ -- done
310+ (
330311 case ops of
331312 [] ->
332− return ( finalExpr, end, pos )
313+ ( toCall expr args
314+ , end
315+ )
333316
334317 _ ->
335− return ( A.at start end (Src.Binops (reverse ops) finalExpr), end, pos )
336− ]
318+ ( A.at start end (Src.Binops (reverse ops) (toCall expr args))
319+ , end
320+ )
321+ )
337322
338323
339−possiblyNegativeTerm :: A.Position -> Parser Src.Expr
324+possiblyNegativeTerm :: A.Position -> Parser E.Expr Src.Expr
340325possiblyNegativeTerm start =
341− oneOf E.XXX
342− [ do word1 0x2D {---} E.XXX
326+ oneOf E.Start
327+ [ do word1 0x2D {---} E.Start
343328 expr <- term
344− end <- getPosition
345− return (A.at start end (Src.Negate expr))
329+ addEnd start (Src.Negate expr)
346330 , term
347331 ]
348332
@@ -361,30 +345,32 @@ toCall func revArgs =
361345-- IF EXPRESSION
362346
363347
364−if_ :: A.Position -> ExprParser
348+if_ :: A.Position -> Space.Parser E.Expr Src.Expr
365349if_ start =
366− inContext E.ExprIf Keyword.if_ $
367− ifHelp start []
368−
369−
370−ifHelp :: A.Position -> [(Src.Expr, Src.Expr)] -> ExprParser
371−ifHelp start branches =
372− do spaces
373− (condition, _, condPos) <- expression
374− checkSpace condPos
375− Keyword.then_
376− spaces
377− (thenBranch, _, thenPos) <- expression
378− checkSpace thenPos
379− Keyword.else_
380− spaces
350+ inContext E.If (Keyword.if_ E.Start) $
351+ chompIfEnd start []
352+
353+
354+chompIfEnd :: A.Position -> [(Src.Expr, Src.Expr)] -> Space.Parser E.If Src.Expr
355+chompIfEnd start branches =
356+ do Space.chompAndCheckIndent E.IfSpace E.IfIndentCondition
357+ (condition, condEnd) <- specialize E.IfCondition expression
358+ Space.checkIndent condEnd E.IfIndentThen
359+ Keyword.then_ E.IfThen
360+ Space.chompAndCheckIndent E.IfSpace E.IfIndentThenBranch
361+ (thenBranch, thenEnd) <- specialize E.IfThenBranch expression
362+ Space.checkIndent thenEnd E.IfIndentElse
363+ Keyword.else_ E.IfElse
364+ Space.chompAndCheckIndent E.IfSpace E.IfIndentElseBranch
381365 let newBranches = (condition, thenBranch) : branches
382− oneOf E.XXX
383− [ do Keyword.if_
384− ifHelp start newBranches
385− , do (elseBranch, elseEnd, elseSpace) <- expression
386− let ifExpr = A.at start elseEnd (Src.If (reverse newBranches) elseBranch)
387− return ( ifExpr, elseEnd, elseSpace )
366+ oneOf E.IfElseBranchStart
367+ [
368+ do Keyword.if_ E.IfElseBranchStart
369+ chompIfEnd start newBranches
370+ ,
371+ do (elseBranch, elseEnd) <- specialize E.IfElseBranch expression
372+ let ifExpr = Src.If (reverse newBranches) elseBranch
373+ return ( A.at start elseEnd ifExpr, elseEnd )
388374 ]
389375
390376
@@ -392,27 +378,27 @@ ifHelp start branches =
392378-- LAMBDA EXPRESSION
393379
394380
395−function :: A.Position -> ExprParser
381+function :: A.Position -> Space.Parser E.Expr Src.Expr
396382function start =
397− inContext E.ExprFunc (word1 0x5C {-\-} E.XXX) $
398− do spaces
399− arg <- Pattern.term
400− spaces
401− revArgs <- gatherArgs [arg]
402− spaces
403− (body, end, space) <- expression
404− let func = A.at start end (Src.Lambda (reverse revArgs) body)
405− return ( func, end, space )
406−
407−
408−gatherArgs :: [Src.Pattern] -> Parser [Src.Pattern]
409−gatherArgs args =
410− oneOf E.XXX
411− [ do arg <- Pattern.term
412− spaces
413− gatherArgs (arg:args)
414− , do word2 0x2D 0x3E {-->-} E.XXX
415− return args
383+ inContext E.Func (word1 0x5C {-\-} E.Start) $
384+ do Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArg
385+ arg <- specialize E.FuncArg Pattern.term
386+ Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow
387+ revArgs <- chompArgs [arg]
388+ Space.chompAndCheckIndent E.FuncSpace E.FuncIndentBody
389+ (body, end) <- specialize E.FuncBody expression
390+ let funcExpr = Src.Lambda (reverse revArgs) body
391+ return (A.at start end funcExpr, end)
392+
393+
394+chompArgs :: [Src.Pattern] -> Parser E.Func [Src.Pattern]
395+chompArgs revArgs =
396+ oneOf E.FuncArrow
397+ [ do arg <- specialize E.FuncArg Pattern.term
398+ Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow
399+ chompArgs (arg:revArgs)
400+ , do word2 0x2D 0x3E {-->-} E.FuncArrow
401+ return revArgs
416402 ]
417403
418404
@@ -420,90 +406,84 @@ gatherArgs args =
420406-- CASE EXPRESSIONS
421407
422408
423−case_ :: A.Position -> ExprParser
409+case_ :: A.Position -> Space.Parser E.Expr Src.Expr
424410case_ start =
425− inContext E.ExprCase Keyword.case_ $
426− do spaces
427− (switcher, _, switcherPos) <- expression
428− checkSpace switcherPos
429− Keyword.of_
430− spaces
431− oldIndent <- getIndent
432− newIndent <- getCol
433− setIndent newIndent
434− (firstBranch, firstEnd, firstPos) <- branchHelp
435− (branches, end, pos) <- caseHelp [firstBranch] firstEnd firstPos
436− setIndent oldIndent
437− return
438− ( A.at start end (Src.Case switcher branches)
439− , end
440− , pos
441− )
442−
443−
444−branchHelp :: SParser (Src.Pattern, Src.Expr)
445−branchHelp =
446− do (pattern, patternPos) <- Pattern.expression
447− checkSpace patternPos
448− word2 0x2D 0x3E {-->-} E.XXX
449− spaces
450− (branchExpr, end, pos) <- expression
451− return ( (pattern, branchExpr), end, pos )
452−
453−
454−caseHelp :: [(Src.Pattern, Src.Expr)] -> A.Position -> SPos -> SParser [(Src.Pattern, Src.Expr)]
455−caseHelp branches end pos =
456− oneOf E.XXX
457− [ do checkAligned pos
458− (branch, newEnd, newPos) <- branchHelp
459− caseHelp (branch:branches) newEnd newPos
460− , return ( reverse branches, end, pos )
411+ inContext E.Case (Keyword.case_ E.Start) $
412+ do Space.chompAndCheckIndent E.CaseSpace E.CaseIndentExpr
413+ (expr, exprEnd) <- specialize E.CaseExpr expression
414+ Space.checkIndent exprEnd E.CaseIndentOf
415+ Keyword.of_ E.CaseOf
416+ Space.chompAndCheckIndent E.CaseSpace E.CaseIndentPattern
417+ withIndent $
418+ do (firstBranch, firstEnd) <- chompBranch
419+ (branches, end) <- chompCaseEnd [firstBranch] firstEnd
420+ return
421+ ( A.at start end (Src.Case expr branches)
422+ , end
423+ )
424+
425+
426+chompBranch :: Space.Parser E.Case (Src.Pattern, Src.Expr)
427+chompBranch =
428+ do (pattern, patternEnd) <- specialize E.CasePattern Pattern.expression
429+ Space.checkIndent patternEnd E.CaseIndentArrow
430+ word2 0x2D 0x3E {-->-} E.CaseArrow
431+ Space.chompAndCheckIndent E.CaseSpace E.CaseIndentBranch
432+ (branchExpr, end) <- specialize E.CaseBranch expression
433+ return ( (pattern, branchExpr), end )
434+
435+
436+chompCaseEnd :: [(Src.Pattern, Src.Expr)] -> A.Position -> Space.Parser E.Case [(Src.Pattern, Src.Expr)]
437+chompCaseEnd branches end =
438+ oneOfWithFallback
439+ [ do Space.checkAligned E.CasePatternAlignment
440+ (branch, newEnd) <- chompBranch
441+ chompCaseEnd (branch:branches) newEnd
461442 ]
443+ (reverse branches, end)
462444
463445
464446
465447-- LET EXPRESSION
466448
467449
468−let_ :: A.Position -> ExprParser
450+let_ :: A.Position -> Space.Parser E.Expr Src.Expr
469451let_ start =
470− do oldIndent <- getIndent
471− letIndent <- getCol
472− Keyword.let_
473− pushContext start E.ExprLet
474− setIndent letIndent
475− spaces
476− defIndent <- getCol
477− setIndent defIndent
478− (def, end, space) <- letDef
479− letHelp start oldIndent [def] end space
480−
481−
482−letHelp :: A.Position -> Word16 -> [A.Located Src.Def] -> A.Position -> SPos -> ExprParser
483−letHelp start oldIndent revDefs end pos =
484− oneOf E.XXX
485− [ do checkAligned pos
486− (def, newEnd, newPos) <- letDef
487− letHelp start oldIndent (def:revDefs) newEnd newPos
488−
489− , do setIndent oldIndent
490− checkSpace pos
491− Keyword.in_
492− popContext ()
493− spaces
494− (body, newEnd, newPos) <- expression
495− let letExpr = A.at start end (Src.Let (reverse revDefs) body)
496− return ( letExpr, newEnd, newPos )
452+ inContext E.Let (Keyword.let_ E.Start) $
453+ do (defs, defsEnd) <-
454+ withBacksetIndent 3 $
455+ do Space.chompAndCheckIndent E.LetSpace E.LetIndentDef
456+ withIndent $
457+ do (def, end) <- chompLetDef
458+ chompLetDefs [def] end
459+
460+ Space.checkIndent defsEnd E.LetIndentIn
461+ Keyword.in_ E.LetIn
462+ Space.chompAndCheckIndent E.LetSpace E.LetIndentBody
463+ (body, end) <- specialize E.LetBody expression
464+ return
465+ ( A.at start end (Src.Let defs body)
466+ , end
467+ )
468+
469+
470+chompLetDefs :: [A.Located Src.Def] -> A.Position -> Space.Parser E.Let [A.Located Src.Def]
471+chompLetDefs revDefs end =
472+ oneOfWithFallback
473+ [ do Space.checkAligned E.LetDefAlignment
474+ (def, newEnd) <- chompLetDef
475+ chompLetDefs (def:revDefs) newEnd
497476 ]
477+ (reverse revDefs, end)
498478
499479
500480
501481-- LET DEFINITIONS
502482
503483
504−letDef :: SParser (A.Located Src.Def)
505−letDef =
506− oneOf E.XXX
484+chompLetDef :: Space.Parser E.Let (A.Located Src.Def)
485+chompLetDef =
486+ oneOf E.LetDefName
507487 [ definition
508488 , destructure
509489 ]
@@ -513,61 +493,57 @@ letDef =
513493-- DEFINITION
514494
515495
516−definition :: SParser (A.Located Src.Def)
496+definition :: Space.Parser E.Let (A.Located Src.Def)
517497definition =
518− do start <- getPosition
519− name <- Var.lower
520− end <- getPosition
521− spaces
522− oneOf E.XXX
523− [
524− do word1 0x3A {-:-} E.XXX
525− pushContext start (E.Annotation name)
526− spaces
527− (tipe, _, space) <- Type.expression
528− popContext ()
529− checkAligned space
530− defName <- matchingName name
531− let (A.At (A.Region defStart _) _) = defName
532− pushContext defStart (E.Definition name)
533− spaces
534− def <- definitionHelp start defName (Just tipe) []
535− popContext def
536− ,
537− do pushContext start (E.Definition name)
538− def <- definitionHelp start (A.at start end name) Nothing []
539− popContext def
540− ]
541−
542−
543−definitionHelp :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> SParser (A.Located Src.Def)
544−definitionHelp start name tipe revArgs =
545− oneOf E.XXX
546− [ do arg <- Pattern.term
547− spaces
548− definitionHelp start name tipe (arg : revArgs)
549− , do word1 0x3D {-=-} E.XXX
550− spaces
551− (body, end, space) <- expression
552− let def = A.at start end (Src.Define name (reverse revArgs) body tipe)
553− return ( def, end, space )
498+ do aname@(A.At (A.Region start _) name) <- addLocation (Var.lower E.LetDefName)
499+ specialize (E.LetDef name) $
500+ do Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals
501+ oneOf E.DefEquals
502+ [
503+ do word1 0x3A {-:-} E.DefEquals
504+ Space.chompAndCheckIndent E.DefSpace E.DefIndentType
505+ (tipe, _) <- specialize E.DefType Type.expression
506+ Space.checkAligned E.DefAlignment
507+ defName <- chompMatchingName name
508+ Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals
509+ chompDefArgsAndBody start defName (Just tipe) []
510+ ,
511+ chompDefArgsAndBody start aname Nothing []
512+ ]
513+
514+
515+chompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.Def (A.Located Src.Def)
516+chompDefArgsAndBody start name tipe revArgs =
517+ oneOf E.DefEquals
518+ [ do arg <- specialize E.DefArg Pattern.term
519+ Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals
520+ chompDefArgsAndBody start name tipe (arg : revArgs)
521+ , do word1 0x3D {-=-} E.DefEquals
522+ Space.chompAndCheckIndent E.DefSpace E.DefIndentBody
523+ (body, end) <- specialize E.DefBody expression
524+ return
525+ ( A.at start end (Src.Define name (reverse revArgs) body tipe)
526+ , end
527+ )
554528 ]
555529
556530
557−matchingName :: Name.Name -> Parser (A.Located Name.Name)
558−matchingName expectedName =
559− let (P.Parser parserL) = Var.lower in
560− P.Parser $ \state@(P.State _ _ _ sr sc ctx) cok eok cerr eerr ->
531+chompMatchingName :: Name.Name -> Parser E.Def (A.Located Name.Name)
532+chompMatchingName expectedName =
533+ let
534+ (P.Parser parserL) = Var.lower (E.DefNameRepeat expectedName)
535+ in
536+ P.Parser $ \state@(P.State _ _ _ sr sc) cok eok cerr eerr ->
561537 let
562− cokL name newState@(P.State _ _ _ er ec _) =
538+ cokL name newState@(P.State _ _ _ er ec) =
563539 if expectedName == name
564540 then cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState
565− else cerr sr sc ctx (E.MatchingName expectedName)
541+ else cerr sr sc (E.DefNameMatch expectedName name)
566542
567− eokL name newState@(P.State _ _ _ er ec _) =
543+ eokL name newState@(P.State _ _ _ er ec) =
568544 if expectedName == name
569545 then eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState
570− else eerr sr sc ctx (E.MatchingName expectedName)
546+ else eerr sr sc (E.DefNameMatch expectedName name)
571547 in
572548 parserL state cokL eokL cerr eerr
573549
@@ -577,12 +553,13 @@ matchingName expectedName =
577553-- DESTRUCTURE
578554
579555
580−destructure :: SParser (A.Located Src.Def)
556+destructure :: Space.Parser E.Let (A.Located Src.Def)
581557destructure =
558+ specialize E.LetDestruct $
582559 do start <- getPosition
583− pattern <- Pattern.term
584− spaces
585− word1 0x3D {-=-} E.XXX
586− spaces
587− (expr, end, space) <- expression
588− return ( A.at start end (Src.Destruct pattern expr), end, space )
560+ pattern <- specialize E.DestructPattern Pattern.term
561+ Space.chompAndCheckIndent E.DestructSpace E.DestructIndentEquals
562+ word1 0x3D {-=-} E.DestructEquals
563+ Space.chompAndCheckIndent E.DestructSpace E.DestructIndentBody
564+ (expr, end) <- specialize E.DestructBody expression
565+ return ( A.at start end (Src.Destruct pattern expr), end )