@@ -26,18 +26,51 @@ term :: Parser Src.RawExpr
2626term =
2727 do start <- getPosition
2828 oneOf
29− [ do literal <- Literal.literal
30− end <- getPosition
31− return (A.at start end (Src.Literal literal))
29+ [ variable start >>= accessible start
30+ , literal start
3231 , list start
32+ , record start >>= accessible start
3333 , tuple start
34− , record start
35− , do var <- qualifiedVar
36− end <- getPosition
37− return (A.at start end (Src.var var))
34+ , accessor start
3835 ]
3936
4037
38+literal :: R.Position -> Parser Src.RawExpr
39+literal start =
40+ do value <- Literal.literal
41+ end <- getPosition
42+ return (A.at start end (Src.Literal value))
43+
44+
45+accessor :: R.Position -> Parser Src.RawExpr
46+accessor start =
47+ do dot
48+ field <- lowVar
49+ end <- getPosition
50+ let ann x = A.at start end x
51+ let body = ann (Src.Access (ann (Src.var "r")) field)
52+ return (mkLambda start end "r" body)
53+
54+
55+variable :: R.Position -> Parser Src.RawExpr
56+variable start =
57+ do var <- qualifiedVar
58+ end <- getPosition
59+ return (A.at start end (Src.var var))
60+
61+
62+accessible :: R.Position -> Src.RawExpr -> Parser Src.RawExpr
63+accessible start expr =
64+ oneOf
65+ [ do dot
66+ field <- lowVar
67+ end <- getPosition
68+ let newExpr = A.at start end (Src.Access expr field)
69+ accessible start newExpr
70+ , return expr
71+ ]
72+
73+
4174
4275-- LISTS
4376
@@ -47,8 +80,8 @@ list start =
4780 do leftSquare
4881 spaces
4982 oneOf
50− [ do (entry, _, space) <- expression
51− checkSpaces space
83+ [ do (entry, _, pos) <- expression
84+ checkSpace pos
5285 listHelp start [entry]
5386 , do rightSquare
5487 end <- getPosition
@@ -61,8 +94,8 @@ listHelp start entries =
6194 oneOf
6295 [ do comma
6396 spaces
64− (entry, _, space) <- expression
65− checkSpaces space
97+ (entry, _, pos) <- expression
98+ checkSpace pos
6699 listHelp start (entry:entries)
67100 , do rightSquare
68101 end <- getPosition
@@ -100,8 +133,8 @@ tuple start =
100133 return (foldr (mkLambda start end) result args)
101134
102135 , do spaces
103− (entry, _, space) <- expression
104− checkSpaces space
136+ (entry, _, pos) <- expression
137+ checkSpace pos
105138 tupleHelp start [entry]
106139 ]
107140
@@ -124,8 +157,8 @@ tupleHelp start entries =
124157 oneOf
125158 [ do comma
126159 spaces
127− (entry, _, space) <- expression
128− checkSpaces space
160+ (entry, _, pos) <- expression
161+ checkSpace pos
129162 tupleHelp start (entry:entries)
130163 , do rightParen
131164 end <- getPosition
@@ -161,8 +194,8 @@ record start =
161194 return (A.at start end (Src.Update (A.map Src.var starter) fields))
162195 , do equals
163196 spaces
164− (value, _, nextSpace) <- expression
165− checkSpaces nextSpace
197+ (value, _, nextPos) <- expression
198+ checkSpace nextPos
166199 fields <- chompFields [(starter, value)]
167200 end <- getPosition
168201 return (A.at start end (Src.Record fields))
@@ -191,8 +224,8 @@ chompField =
191224 spaces
192225 equals
193226 spaces
194− (value, _, endSpace) <- expression
195− checkSpaces endSpace
227+ (value, _, pos) <- expression
228+ checkSpace pos
196229 return (key, value)
197230
198231
@@ -212,7 +245,7 @@ expression =
212245 , if_ start
213246 , case_ start
214247 , function start
215− , do starter <- term
248+ , do starter <- possiblyNegativeTerm start
216249 end <- getPosition
217250 space <- whitespace
218251 exprHelp start (State [] starter end space)
@@ -221,68 +254,46 @@ expression =
221254
222255data State =
223256 State
224− { _ops :: ![(Src.RawExpr, A.Located Text)]
225− , _last :: !Src.RawExpr
226− , _end :: !R.Position
227− , _space :: !Space
257+ { _ops :: ![(Src.RawExpr, A.Located Text)]
258+ , _last :: !Src.RawExpr
259+ , _end :: !R.Position
260+ , _pos :: !SPos
228261 }
229262
230263
231264exprHelp :: R.Position -> State -> ExprParser
232−exprHelp start (State ops lastExpr end space) =
265+exprHelp start (State ops lastExpr end pos) =
233266 oneOf
234267 [ -- infix operator
235− do checkSpaces space
236− op <- addLocation infixOp
237− opSpace <- whitespace
268+ do checkSpace pos
269+ opStart <- getPosition
270+ opName <- infixOp
271+ opEnd <- getPosition
272+ let op = A.at opStart opEnd opName
273+ spaces
274+ newStart <- getPosition
238275 oneOf
239276 [ -- negative terms
240− do guard (space /= None && opSpace == None && A.drop op == "-")
277+ do guard ("-" == opName && end /= opStart && opEnd == newStart)
241278 rawTerm <- term
242279 newEnd <- getPosition
243− newSpace <- whitespace
280+ newPos <- whitespace
244281
245282 let ann x = A.merge op rawTerm x
246283 let negatedTerm = ann (Src.Binop [(ann Src.zero, op)] rawTerm)
247284 let newLast = A.merge lastExpr rawTerm (Src.App lastExpr negatedTerm)
248285
249− exprHelp start (State ops newLast newEnd newSpace)
250−
251− , -- accessor
252− do guard (space /= None && opSpace == None && A.drop op == ".")
253− field <- lowVar
254− newEnd <- getPosition
255− newSpace <- whitespace
256−
257− let (A.A (R.Region opStart _) _) = op
258− let ann x = A.at opStart newEnd x
259− let body = ann (Src.Access (ann (Src.var "r")) field)
260− let accessor = mkLambda opStart newEnd "r" body
261− let newLast = A.merge lastExpr accessor (Src.App lastExpr accessor)
262−
263− exprHelp start (State ops newLast newEnd newSpace)
264−
265− , -- access
266− do guard (space == None && opSpace == None && A.drop op == ".")
267− field <- lowVar
268− newEnd <- getPosition
269− newSpace <- whitespace
270− let (A.A (R.Region lastStart _) _) = lastExpr
271− let newLast = A.at lastStart newEnd (Src.Access lastExpr field)
272− exprHelp start (State ops newLast newEnd newSpace)
286+ exprHelp start (State ops newLast newEnd newPos)
273287
274288 , -- term
275− do checkSpaces opSpace
276− newLast <- term
289+ do newLast <- possiblyNegativeTerm newStart
277290 newEnd <- getPosition
278− newSpace <- whitespace
291+ newPos <- whitespace
279292 let newOps = (lastExpr, op) : ops
280− exprHelp start (State newOps newLast newEnd newSpace)
293+ exprHelp start (State newOps newLast newEnd newPos)
281294
282295 , -- final term
283− do checkSpaces opSpace
284− newStart <- getPosition
285− (newLast, newEnd, newSpace) <-
296+ do (newLast, newEnd, newPos) <-
286297 oneOf
287298 [ let_ newStart
288299 , case_ newStart
@@ -291,28 +302,40 @@ exprHelp start (State ops lastExpr end space) =
291302 ]
292303 let newOps = (lastExpr, op) : ops
293304 let finalExpr = A.at start newEnd (Src.Binop (reverse newOps) newLast)
294− return ( finalExpr, newEnd, newSpace )
305+ return ( finalExpr, newEnd, newPos )
295306 ]
296307
297308 , -- argument
298− do checkSpaces space
309+ do checkSpace pos
299310 arg <- term
300311 newEnd <- getPosition
301− newSpace <- whitespace
312+ newPos <- whitespace
302313 let newLast = A.merge lastExpr arg (Src.App lastExpr arg)
303− exprHelp start (State ops newLast newEnd newSpace)
314+ exprHelp start (State ops newLast newEnd newPos)
304315
305316 , -- done
306317 case ops of
307318 [] ->
308− return ( lastExpr, end, space )
319+ return ( lastExpr, end, pos )
309320
310321 _ ->
311322 let
312323 finalExpr =
313324 A.at start end (Src.Binop (reverse ops) lastExpr)
314325 in
315− return ( finalExpr, end, space )
326+ return ( finalExpr, end, pos )
327+ ]
328+
329+
330+possiblyNegativeTerm :: R.Position -> Parser Src.RawExpr
331+possiblyNegativeTerm start =
332+ oneOf
333+ [ do minus
334+ expr <- term
335+ end <- getPosition
336+ let ann x = A.at start end x
337+ return (ann (Src.Binop [(ann Src.zero, ann "-")] expr))
338+ , term
316339 ]
317340
318341
@@ -329,12 +352,12 @@ ifHelp :: R.Position -> [(Src.RawExpr, Src.RawExpr)] -> ExprParser
329352ifHelp start branches =
330353 do keyword "if"
331354 spaces
332− (condition, _, condSpace) <- expression
333− checkSpaces condSpace
355+ (condition, _, condPos) <- expression
356+ checkSpace condPos
334357 keyword "then"
335358 spaces
336− (thenBranch, _, thenSpace) <- expression
337− checkSpaces thenSpace
359+ (thenBranch, _, thenPos) <- expression
360+ checkSpace thenPos
338361 keyword "else"
339362 spaces
340363 let newBranches = (condition, thenBranch) : branches
@@ -382,42 +405,41 @@ case_ :: R.Position -> ExprParser
382405case_ start =
383406 do keyword "case"
384407 spaces
385− (switcher, _, switcherSpace) <- expression
386− checkSpaces switcherSpace
408+ (switcher, _, switcherPos) <- expression
409+ checkSpace switcherPos
387410 keyword "of"
388411 spaces
389412 oldIndent <- getIndent
390413 newIndent <- getCol
391414 setIndent newIndent
392− (firstBranch, firstEnd, firstSpace) <- branchHelp
393− (branches, end, space) <- caseHelp [firstBranch] firstEnd firstSpace
415+ (firstBranch, firstEnd, firstPos) <- branchHelp
416+ (branches, end, pos) <- caseHelp [firstBranch] firstEnd firstPos
394417 setIndent oldIndent
395418 return
396419 ( A.at start end (Src.Case switcher branches)
397420 , end
398− , space
421+ , pos
399422 )
400423
401424
402425branchHelp :: SParser (P.Raw, Src.RawExpr)
403426branchHelp =
404− do (pattern, patternSpace) <- Pattern.expression
405− checkSpaces patternSpace
427+ do (pattern, patternPos) <- Pattern.expression
428+ checkSpace patternPos
406429 rightArrow
407430 spaces
408− (branchExpr, end, space) <- expression
409− return ( (pattern, branchExpr), end, space )
431+ (branchExpr, end, pos) <- expression
432+ return ( (pattern, branchExpr), end, pos )
410433
411434
412−caseHelp :: [(P.Raw, Src.RawExpr)] -> R.Position -> Space -> SParser [(P.Raw, Src.RawExpr)]
413−caseHelp branches end space =
414− case space of
415− Aligned ->
416− do (branch, newEnd, newSpace) <- branchHelp
417− caseHelp (branch:branches) newEnd newSpace
418−
419− _ ->
420− return ( reverse branches, end, space )
435+caseHelp :: [(P.Raw, Src.RawExpr)] -> R.Position -> SPos -> SParser [(P.Raw, Src.RawExpr)]
436+caseHelp branches end pos =
437+ oneOf
438+ [ do checkAligned pos
439+ (branch, newEnd, newPos) <- branchHelp
440+ caseHelp (branch:branches) newEnd newPos
441+ , return ( reverse branches, end, pos )
442+ ]
421443
422444
423445
@@ -437,23 +459,24 @@ let_ start =
437459 letHelp start oldIndent [def] end space
438460
439461
440−letHelp :: R.Position -> Int -> [Src.RawDef] -> R.Position -> Space -> ExprParser
441−letHelp start oldIndent defs end space =
442− case space of
443− Aligned ->
444− do (def, newEnd, newSpace) <- definition
445− letHelp start oldIndent (def:defs) newEnd newSpace
462+letHelp :: R.Position -> Int -> [Src.RawDef] -> R.Position -> SPos -> ExprParser
463+letHelp start oldIndent defs end pos =
464+ oneOf
465+ [ do checkAligned pos
466+ (def, newEnd, newPos) <- definition
467+ letHelp start oldIndent (def:defs) newEnd newPos
446468
447− Freshline ->
448− failure (error "TODO missing `in`")
469+ , do checkFreshline pos
470+ failure (error "TODO missing `in`")
449471
450− _ ->
451− do keyword "in"
452− setIndent oldIndent
472+ , do setIndent oldIndent
473+ keyword "in"
474+ checkSpace pos
453475 spaces
454− (body, newEnd, newSpace) <- expression
476+ (body, newEnd, newPos) <- expression
455477 let letExpr = A.at start end (Src.Let defs body)
456− return ( letExpr, newEnd, newSpace )
478+ return ( letExpr, newEnd, newPos )
479+ ]
457480
458481
459482