09a60c7 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Whitespace upgrade + many important fixes in Parse.Expr

09a60c7Evan Czaplicki10 years ago

src/Parse/Expression.hs+125−102

compare with master

unifiedsplit

@@ -26,18 +26,51 @@ term :: Parser Src.RawExpr

26term =

27 do start <- getPosition

28 oneOf

29− [ do literal <- Literal.literal

29+ [ variable start >>= accessible start

30− end <- getPosition

30+ , literal start

31− return (A.at start end (Src.Literal literal))

32 , list start

31 , list start

32+ , record start >>= accessible start

33 , tuple start

34− , record start

34+ , accessor start

35− , do var <- qualifiedVar

36− end <- getPosition

37− return (A.at start end (Src.var var))

38 ]

35 ]

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+

42-- LISTS

75-- LISTS

@@ -47,8 +80,8 @@ list start =

47 do leftSquare

80 do leftSquare

48 spaces

81 spaces

49 oneOf

82 oneOf

50− [ do (entry, _, space) <- expression

83+ [ do (entry, _, pos) <- expression

51− checkSpaces space

84+ checkSpace pos

52 listHelp start [entry]

85 listHelp start [entry]

53 , do rightSquare

86 , do rightSquare

54 end <- getPosition

87 end <- getPosition

@@ -61,8 +94,8 @@ listHelp start entries =

61 oneOf

94 oneOf

62 [ do comma

95 [ do comma

63 spaces

96 spaces

64− (entry, _, space) <- expression

97+ (entry, _, pos) <- expression

65− checkSpaces space

98+ checkSpace pos

66 listHelp start (entry:entries)

99 listHelp start (entry:entries)

67 , do rightSquare

100 , do rightSquare

68 end <- getPosition

101 end <- getPosition

@@ -100,8 +133,8 @@ tuple start =

100 return (foldr (mkLambda start end) result args)

133 return (foldr (mkLambda start end) result args)

101

134

102 , do spaces

135 , do spaces

103− (entry, _, space) <- expression

136+ (entry, _, pos) <- expression

104− checkSpaces space

137+ checkSpace pos

105 tupleHelp start [entry]

138 tupleHelp start [entry]

106 ]

139 ]

107

140

@@ -124,8 +157,8 @@ tupleHelp start entries =

124 oneOf

157 oneOf

125 [ do comma

158 [ do comma

126 spaces

159 spaces

127− (entry, _, space) <- expression

160+ (entry, _, pos) <- expression

128− checkSpaces space

161+ checkSpace pos

129 tupleHelp start (entry:entries)

162 tupleHelp start (entry:entries)

130 , do rightParen

163 , do rightParen

131 end <- getPosition

164 end <- getPosition

@@ -161,8 +194,8 @@ record start =

161 return (A.at start end (Src.Update (A.map Src.var starter) fields))

194 return (A.at start end (Src.Update (A.map Src.var starter) fields))

162 , do equals

195 , do equals

163 spaces

196 spaces

164− (value, _, nextSpace) <- expression

197+ (value, _, nextPos) <- expression

165− checkSpaces nextSpace

198+ checkSpace nextPos

166 fields <- chompFields [(starter, value)]

199 fields <- chompFields [(starter, value)]

167 end <- getPosition

200 end <- getPosition

168 return (A.at start end (Src.Record fields))

201 return (A.at start end (Src.Record fields))

@@ -191,8 +224,8 @@ chompField =

191 spaces

224 spaces

192 equals

225 equals

193 spaces

226 spaces

194− (value, _, endSpace) <- expression

227+ (value, _, pos) <- expression

195− checkSpaces endSpace

228+ checkSpace pos

196 return (key, value)

229 return (key, value)

197

230

198

231

@@ -212,7 +245,7 @@ expression =

212 , if_ start

245 , if_ start

213 , case_ start

246 , case_ start

214 , function start

247 , function start

215− , do starter <- term

248+ , do starter <- possiblyNegativeTerm start

216 end <- getPosition

249 end <- getPosition

217 space <- whitespace

250 space <- whitespace

218 exprHelp start (State [] starter end space)

251 exprHelp start (State [] starter end space)

@@ -221,68 +254,46 @@ expression =

221

254

222data State =

255data State =

223 State

256 State

224− { _ops :: ![(Src.RawExpr, A.Located Text)]

257+ { _ops :: ![(Src.RawExpr, A.Located Text)]

225− , _last :: !Src.RawExpr

258+ , _last :: !Src.RawExpr

226− , _end :: !R.Position

259+ , _end :: !R.Position

227− , _space :: !Space

260+ , _pos :: !SPos

228 }

261 }

229

262

230

263

231exprHelp :: R.Position -> State -> ExprParser

264exprHelp :: R.Position -> State -> ExprParser

232−exprHelp start (State ops lastExpr end space) =

265+exprHelp start (State ops lastExpr end pos) =

233 oneOf

266 oneOf

234 [ -- infix operator

267 [ -- infix operator

235− do checkSpaces space

268+ do checkSpace pos

236− op <- addLocation infixOp

269+ opStart <- getPosition

237− opSpace <- whitespace

270+ opName <- infixOp

271+ opEnd <- getPosition

272+ let op = A.at opStart opEnd opName

273+ spaces

274+ newStart <- getPosition

238 oneOf

275 oneOf

239 [ -- negative terms

276 [ -- negative terms

240− do guard (space /= None && opSpace == None && A.drop op == "-")

277+ do guard ("-" == opName && end /= opStart && opEnd == newStart)

241 rawTerm <- term

278 rawTerm <- term

242 newEnd <- getPosition

279 newEnd <- getPosition

243− newSpace <- whitespace

280+ newPos <- whitespace

244

281

245 let ann x = A.merge op rawTerm x

282 let ann x = A.merge op rawTerm x

246 let negatedTerm = ann (Src.Binop [(ann Src.zero, op)] rawTerm)

283 let negatedTerm = ann (Src.Binop [(ann Src.zero, op)] rawTerm)

247 let newLast = A.merge lastExpr rawTerm (Src.App lastExpr negatedTerm)

284 let newLast = A.merge lastExpr rawTerm (Src.App lastExpr negatedTerm)

248

285

249− exprHelp start (State ops newLast newEnd newSpace)

286+ exprHelp start (State ops newLast newEnd newPos)

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)

273

287

274 , -- term

288 , -- term

275− do checkSpaces opSpace

289+ do newLast <- possiblyNegativeTerm newStart

276− newLast <- term

277 newEnd <- getPosition

290 newEnd <- getPosition

278− newSpace <- whitespace

291+ newPos <- whitespace

279 let newOps = (lastExpr, op) : ops

292 let newOps = (lastExpr, op) : ops

280− exprHelp start (State newOps newLast newEnd newSpace)

293+ exprHelp start (State newOps newLast newEnd newPos)

281

294

282 , -- final term

295 , -- final term

283− do checkSpaces opSpace

284− newStart <- getPosition

285− (newLast, newEnd, newSpace) <-

296+ do (newLast, newEnd, newPos) <-

286 oneOf

297 oneOf

287 [ let_ newStart

298 [ let_ newStart

288 , case_ newStart

299 , case_ newStart

@@ -291,28 +302,40 @@ exprHelp start (State ops lastExpr end space) =

291 ]

302 ]

292 let newOps = (lastExpr, op) : ops

303 let newOps = (lastExpr, op) : ops

293 let finalExpr = A.at start newEnd (Src.Binop (reverse newOps) newLast)

304 let finalExpr = A.at start newEnd (Src.Binop (reverse newOps) newLast)

294− return ( finalExpr, newEnd, newSpace )

305+ return ( finalExpr, newEnd, newPos )

295 ]

306 ]

296

307

297 , -- argument

308 , -- argument

298− do checkSpaces space

309+ do checkSpace pos

299 arg <- term

310 arg <- term

300 newEnd <- getPosition

311 newEnd <- getPosition

301− newSpace <- whitespace

312+ newPos <- whitespace

302 let newLast = A.merge lastExpr arg (Src.App lastExpr arg)

313 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)

304

315

305 , -- done

316 , -- done

306 case ops of

317 case ops of

307 [] ->

318 [] ->

308− return ( lastExpr, end, space )

319+ return ( lastExpr, end, pos )

309

320

310 _ ->

321 _ ->

311 let

322 let

312 finalExpr =

323 finalExpr =

313 A.at start end (Src.Binop (reverse ops) lastExpr)

324 A.at start end (Src.Binop (reverse ops) lastExpr)

314 in

325 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

316 ]

339 ]

317

340

318

341

@@ -329,12 +352,12 @@ ifHelp :: R.Position -> [(Src.RawExpr, Src.RawExpr)] -> ExprParser

329ifHelp start branches =

352ifHelp start branches =

330 do keyword "if"

353 do keyword "if"

331 spaces

354 spaces

332− (condition, _, condSpace) <- expression

355+ (condition, _, condPos) <- expression

333− checkSpaces condSpace

356+ checkSpace condPos

334 keyword "then"

357 keyword "then"

335 spaces

358 spaces

336− (thenBranch, _, thenSpace) <- expression

359+ (thenBranch, _, thenPos) <- expression

337− checkSpaces thenSpace

360+ checkSpace thenPos

338 keyword "else"

361 keyword "else"

339 spaces

362 spaces

340 let newBranches = (condition, thenBranch) : branches

363 let newBranches = (condition, thenBranch) : branches

@@ -382,42 +405,41 @@ case_ :: R.Position -> ExprParser

382case_ start =

405case_ start =

383 do keyword "case"

406 do keyword "case"

384 spaces

407 spaces

385− (switcher, _, switcherSpace) <- expression

408+ (switcher, _, switcherPos) <- expression

386− checkSpaces switcherSpace

409+ checkSpace switcherPos

387 keyword "of"

410 keyword "of"

388 spaces

411 spaces

389 oldIndent <- getIndent

412 oldIndent <- getIndent

390 newIndent <- getCol

413 newIndent <- getCol

391 setIndent newIndent

414 setIndent newIndent

392− (firstBranch, firstEnd, firstSpace) <- branchHelp

415+ (firstBranch, firstEnd, firstPos) <- branchHelp

393− (branches, end, space) <- caseHelp [firstBranch] firstEnd firstSpace

416+ (branches, end, pos) <- caseHelp [firstBranch] firstEnd firstPos

394 setIndent oldIndent

417 setIndent oldIndent

395 return

418 return

396 ( A.at start end (Src.Case switcher branches)

419 ( A.at start end (Src.Case switcher branches)

397 , end

420 , end

398− , space

421+ , pos

399 )

422 )

400

423

401

424

402branchHelp :: SParser (P.Raw, Src.RawExpr)

425branchHelp :: SParser (P.Raw, Src.RawExpr)

403branchHelp =

426branchHelp =

404− do (pattern, patternSpace) <- Pattern.expression

427+ do (pattern, patternPos) <- Pattern.expression

405− checkSpaces patternSpace

428+ checkSpace patternPos

406 rightArrow

429 rightArrow

407 spaces

430 spaces

408− (branchExpr, end, space) <- expression

431+ (branchExpr, end, pos) <- expression

409− return ( (pattern, branchExpr), end, space )

432+ return ( (pattern, branchExpr), end, pos )

410

433

411

434

412−caseHelp :: [(P.Raw, Src.RawExpr)] -> R.Position -> Space -> SParser [(P.Raw, Src.RawExpr)]

435+caseHelp :: [(P.Raw, Src.RawExpr)] -> R.Position -> SPos -> SParser [(P.Raw, Src.RawExpr)]

413−caseHelp branches end space =

436+caseHelp branches end pos =

414− case space of

437+ oneOf

415− Aligned ->

438+ [ do checkAligned pos

416− do (branch, newEnd, newSpace) <- branchHelp

439+ (branch, newEnd, newPos) <- branchHelp

417− caseHelp (branch:branches) newEnd newSpace

440+ caseHelp (branch:branches) newEnd newPos

418−

419− _ ->

420− return ( reverse branches, end, space )

441+ , return ( reverse branches, end, pos )

442+ ]

421

443

422

444

423

445

@@ -437,23 +459,24 @@ let_ start =

437 letHelp start oldIndent [def] end space

459 letHelp start oldIndent [def] end space

438

460

439

461

440−letHelp :: R.Position -> Int -> [Src.RawDef] -> R.Position -> Space -> ExprParser

462+letHelp :: R.Position -> Int -> [Src.RawDef] -> R.Position -> SPos -> ExprParser

441−letHelp start oldIndent defs end space =

463+letHelp start oldIndent defs end pos =

442− case space of

464+ oneOf

443− Aligned ->

465+ [ do checkAligned pos

444− do (def, newEnd, newSpace) <- definition

466+ (def, newEnd, newPos) <- definition

445− letHelp start oldIndent (def:defs) newEnd newSpace

467+ letHelp start oldIndent (def:defs) newEnd newPos

446

468

447− Freshline ->

469+ , do checkFreshline pos

448− failure (error "TODO missing `in`")

470+ failure (error "TODO missing `in`")

449

471

450− _ ->

451− do keyword "in"

452− setIndent oldIndent

472+ , do setIndent oldIndent

473+ keyword "in"

474+ checkSpace pos

453 spaces

475 spaces

454− (body, newEnd, newSpace) <- expression

476+ (body, newEnd, newPos) <- expression

455 let letExpr = A.at start end (Src.Let defs body)

477 let letExpr = A.at start end (Src.Let defs body)

456− return ( letExpr, newEnd, newSpace )

478+ return ( letExpr, newEnd, newPos )

479+ ]

457

480

458

481

459

482