22a4264 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Get a bunch of Parser/* modules working with new error tracking

22a4264Evan Czaplicki8 years ago

compiler/src/Parse/Expression.hs+317−340

compare with master

unifiedsplit

@@ -7,19 +7,18 @@ module Parse.Expression

9import qualified Data.Name as Name

10−import Data.Word (Word16)

12import qualified AST.Source as Src

11import qualified AST.Source as Src

13import qualified Parse.Keyword as Keyword

12import qualified Parse.Keyword as Keyword

14import qualified Parse.Number as Number

13import qualified Parse.Number as Number

15import qualified Parse.Pattern as Pattern

14import qualified Parse.Pattern as Pattern

16import qualified Parse.Shader as Shader

15import qualified Parse.Shader as Shader

16+import qualified Parse.Space as Space

17import qualified Parse.Symbol as Symbol

18import qualified Parse.Type as Type

19import qualified Parse.Utf8 as Utf8

20import qualified Parse.Variable as Var

21−import Parse.Utils

22−import Parse.Primitives hiding (Parser, State)

21+import Parse.Primitives hiding (State)

23import qualified Parse.Primitives as P

22import qualified Parse.Primitives as P

24import qualified Reporting.Annotation as A

23import qualified Reporting.Annotation as A

25import qualified Reporting.Error.Syntax as E

24import qualified Reporting.Error.Syntax as E

@@ -29,10 +28,10 @@ import qualified Reporting.Error.Syntax as E

29-- TERMS

28-- TERMS

32−term :: Parser Src.Expr

31+term :: Parser E.Expr Src.Expr

33term =

32term =

34 do start <- getPosition

33 do start <- getPosition

35− oneOf E.XXX

34+ oneOf E.Start

36 [ variable start >>= accessible start

35 [ variable start >>= accessible start

37 , string start

36 , string start

38 , number start

37 , number start

@@ -45,90 +44,80 @@ term =

45 ]

44 ]

48−string :: A.Position -> Parser Src.Expr

47+string :: A.Position -> Parser E.Expr Src.Expr

49string start =

48string start =

50− do str <- Utf8.string

49+ do str <- Utf8.string E.Start E.String

51− end <- getPosition

52− return (A.at start end (Src.Str str))

50+ addEnd start (Src.Str str)

55−character :: A.Position -> Parser Src.Expr

53+character :: A.Position -> Parser E.Expr Src.Expr

56character start =

54character start =

57− do chr <- Utf8.character

55+ do chr <- Utf8.character E.Start E.Char

58− end <- getPosition

59− return (A.at start end (Src.Chr chr))

56+ addEnd start (Src.Chr chr)

62−number :: A.Position -> Parser Src.Expr

59+number :: A.Position -> Parser E.Expr Src.Expr

63number start =

60number start =

64− do nmbr <- Number.number

61+ do nmbr <- Number.number E.Start E.Number

65− end <- getPosition

62+ addEnd start $

66− return $ A.at start end $

67 case nmbr of

63 case nmbr of

68− Number.Int int ->

64+ Number.Int int -> Src.Int int

69− Src.Int int

65+ Number.Float float -> Src.Float float

71− Number.Float float ->

72− Src.Float float

74−

75−accessor :: A.Position -> Parser Src.Expr

68+accessor :: A.Position -> Parser E.Expr Src.Expr

76accessor start =

69accessor start =

77− do word1 0x2E {-.-} E.XXX

70+ do word1 0x2E {-.-} E.Dot

78− field <- Var.lower

71+ field <- Var.lower E.Access

79− end <- getPosition

80− return (A.at start end (Src.Accessor field))

72+ addEnd start (Src.Accessor field)

83−variable :: A.Position -> Parser Src.Expr

75+variable :: A.Position -> Parser E.Expr Src.Expr

84variable start =

76variable start =

85− do var <- Var.foreignAlpha

77+ do var <- Var.foreignAlpha E.Start

86− end <- getPosition

87− return (A.at start end var)

78+ addEnd start var

90−accessible :: A.Position -> Src.Expr -> Parser Src.Expr

81+accessible :: A.Position -> Src.Expr -> Parser E.Expr Src.Expr

91accessible start expr =

82accessible start expr =

92− oneOf E.XXX

83+ oneOfWithFallback

93− [ do word1 0x2E {-.-} E.XXX

84+ [ do word1 0x2E {-.-} E.Dot

94 pos <- getPosition

85 pos <- getPosition

95− field <- Var.lower

86+ field <- Var.lower E.Access

96 end <- getPosition

87 end <- getPosition

88+ accessible start $

97− let newExpr = A.at start end (Src.Access expr (A.at pos end field))

89+ A.at start end (Src.Access expr (A.at pos end field))

98− accessible start newExpr

99− , return expr

100 ]

90 ]

91+ expr

101

102

103

104-- LISTS

95-- LISTS

105

106

107−list :: A.Position -> Parser Src.Expr

98+list :: A.Position -> Parser E.Expr Src.Expr

108list start =

99list start =

109− inContext E.ExprList (word1 0x5B {-[-} E.XXX) $

100+ inContext E.List (word1 0x5B {-[-} E.Start) $

110− do spaces

101+ do Space.chompAndCheckIndent E.ListSpace E.ListIndentOpen

111− oneOf E.XXX

102+ oneOf E.ListOpen

112− [ do (entry, _, pos) <- expression

103+ [ do (entry, end) <- specialize E.ListExpr expression

113− checkSpace pos

104+ Space.checkIndent end E.ListIndentEnd

114− listHelp start [entry]

105+ chompListEnd start [entry]

115− , do word1 0x5D {-]-} E.XXX

106+ , do word1 0x5D {-]-} E.ListOpen

116− end <- getPosition

117− return (A.at start end (Src.List []))

107+ addEnd start (Src.List [])

118 ]

108 ]

119

109

120

110

121−listHelp :: A.Position -> [Src.Expr] -> Parser Src.Expr

111+chompListEnd :: A.Position -> [Src.Expr] -> Parser E.List Src.Expr

122−listHelp start entries =

112+chompListEnd start entries =

123− oneOf E.XXX

113+ oneOf E.ListEnd

124− [ do word1 0x2C {-,-} E.XXX

114+ [ do word1 0x2C {-,-} E.ListEnd

125− spaces

115+ Space.chompAndCheckIndent E.ListSpace E.ListIndentExpr

126− (entry, _, pos) <- expression

116+ (entry, end) <- specialize E.ListExpr expression

127− checkSpace pos

117+ Space.checkIndent end E.ListIndentEnd

128− listHelp start (entry:entries)

118+ chompListEnd start (entry:entries)

129− , do word1 0x5D {-]-} E.XXX

119+ , do word1 0x5D {-]-} E.ListEnd

130− end <- getPosition

131− return (A.at start end (Src.List (reverse entries)))

120+ addEnd start (Src.List (reverse entries))

132 ]

121 ]

133

122

134

123

@@ -136,52 +125,55 @@ listHelp start entries =

136-- TUPLES

125-- TUPLES

137

126

138

127

139−tuple :: A.Position -> Parser Src.Expr

128+tuple :: A.Position -> Parser E.Expr Src.Expr

140−tuple start =

129+tuple start@(A.Position row col) =

141− inContext E.ExprTuple (word1 0x28 {-(-} E.XXX) $

130+ inContext E.Tuple (word1 0x28 {-(-} E.Start) $

142− do pos <- getPosition

143− spos <- whitespace

144− oneOf E.XXX

131+ oneOf E.TupleOpen

145− [ do noSpace pos spos

132+ [

146− word2 0x2D 0x29 {--)-} E.XXX

133+ do op <- Symbol.operator E.TupleOpen E.TupleOperatorReserved

147− end <- getPosition

134+ if op == "-"

148− return $ A.at start end (Src.Op "-")

135+ then

149−

136+ oneOf E.TupleOperatorClose

150− , do checkSpace spos

137+ [

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

138+ do word1 0x29 {-)-} E.TupleOperatorClose

158− end <- getPosition

139+ addEnd start (Src.Op op)

159− return $ A.at start end (Src.Op op)

140+ ,

160−

141+ specialize E.TupleExpr $

161− , do noSpace pos spos

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

162− word1 0x29 {-)-} E.XXX

149+ do word1 0x29 {-)-} E.TupleOperatorClose

163− end <- getPosition

150+ addEnd start (Src.Op op)

151+ ,

152+ do word1 0x29 {-)-} E.TupleOpen

164− return (A.at start end Src.Unit)

153+ addEnd start Src.Unit

165−

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 []

166− ]

159+ ]

167−

160+

168−

161+

169−tupleHelp :: A.Position -> Src.Expr -> [Src.Expr] -> Parser Src.Expr

162+chompTupleEnd :: A.Position -> Src.Expr -> [Src.Expr] -> Parser E.Tuple Src.Expr

170−tupleHelp start firstExpr revExprs =

163+chompTupleEnd start firstExpr revExprs =

171− oneOf E.XXX

164+ oneOf E.TupleEnd

172− [ do word1 0x2C {-,-} E.XXX

165+ [ do word1 0x2C {-,-} E.TupleEnd

173− spaces

166+ Space.chompAndCheckIndent E.TupleSpace E.TupleIndentExpr

174− (entry, _, pos) <- expression

167+ (entry, end) <- specialize E.TupleExpr expression

175− checkSpace pos

168+ Space.checkIndent end E.TupleIndentEnd

176− tupleHelp start firstExpr (entry : revExprs)

169+ chompTupleEnd start firstExpr (entry : revExprs)

177− , do word1 0x29 {-)-} E.XXX

170+ , do word1 0x29 {-)-} E.TupleEnd

178− end <- getPosition

179 case reverse revExprs of

171 case reverse revExprs of

180 [] ->

172 [] ->

181 return firstExpr

173 return firstExpr

182

174

183− secondExpr : others ->

175+ secondExpr : otherExprs ->

184− return (A.at start end (Src.Tuple firstExpr secondExpr others))

176+ addEnd start (Src.Tuple firstExpr secondExpr otherExprs)

185 ]

177 ]

186

178

187

179

@@ -189,30 +181,27 @@ tupleHelp start firstExpr revExprs =

189-- RECORDS

181-- RECORDS

190

182

191

183

192−record :: A.Position -> Parser Src.Expr

184+record :: A.Position -> Parser E.Expr Src.Expr

193record start =

185record start =

194− inContext E.ExprRecord (word1 0x7B {- { -} E.XXX) $

186+ inContext E.Record (word1 0x7B {- { -} E.Start) $

195− do spaces

187+ do Space.chompAndCheckIndent E.RecordSpace E.RecordIndentOpen

196− oneOf E.XXX

188+ oneOf E.RecordOpen

197− [ do word1 0x7D {-}-} E.XXX

189+ [ do word1 0x7D {-}-} E.RecordOpen

198− end <- getPosition

199− return (A.at start end (Src.Record []))

190+ addEnd start (Src.Record [])

200− , do starter <- addLocation Var.lower

191+ , do starter <- addLocation (Var.lower E.RecordField)

201− spaces

192+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals

202− oneOf E.XXX

193+ oneOf E.RecordEquals

203− [ do word1 0x7C {-|-} E.XXX

194+ [ do word1 0x7C {-|-} E.RecordEquals

204− spaces

195+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentField

205 firstField <- chompField

196 firstField <- chompField

206 fields <- chompFields [firstField]

197 fields <- chompFields [firstField]

207− end <- getPosition

208− return (A.at start end (Src.Update starter fields))

198+ addEnd start (Src.Update starter fields)

209− , do word1 0x3D {-=-} E.XXX

199+ , do word1 0x3D {-=-} E.RecordEquals

210− spaces

200+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr

211− (value, _, nextPos) <- expression

201+ (value, end) <- specialize E.RecordExpr expression

212− checkSpace nextPos

202+ Space.checkIndent end E.RecordIndentEnd

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

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

214− end <- getPosition

215− return (A.at start end (Src.Record fields))

204+ addEnd start (Src.Record fields)

216 ]

205 ]

217 ]

206 ]

218

207

@@ -220,26 +209,26 @@ record start =

220type Field = ( A.Located Name.Name, Src.Expr )

209type Field = ( A.Located Name.Name, Src.Expr )

221

210

222

211

223−chompFields :: [Field] -> Parser [Field]

212+chompFields :: [Field] -> Parser E.Record [Field]

224chompFields fields =

213chompFields fields =

225− oneOf E.XXX

214+ oneOf E.RecordEnd

226− [ do word1 0x2C {-,-} E.XXX

215+ [ do word1 0x2C {-,-} E.RecordEnd

227− spaces

216+ Space.chompAndCheckIndent E.RecordSpace E.RecordField

228 f <- chompField

217 f <- chompField

229 chompFields (f : fields)

218 chompFields (f : fields)

230− , do word1 0x7D {-}-} E.XXX

219+ , do word1 0x7D {-}-} E.RecordEnd

231 return (reverse fields)

220 return (reverse fields)

232 ]

221 ]

233

222

234

223

235−chompField :: Parser Field

224+chompField :: Parser E.Record Field

236chompField =

225chompField =

237− do key <- addLocation Var.lower

226+ do key <- addLocation (Var.lower E.RecordField)

238− spaces

227+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals

239− word1 0x3D {-=-} E.XXX

228+ word1 0x3D {-=-} E.RecordEquals

240− spaces

229+ Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr

241− (value, _, pos) <- expression

230+ (value, end) <- specialize E.RecordExpr expression

242− checkSpace pos

231+ Space.checkIndent end E.RecordIndentEnd

243 return (key, value)

232 return (key, value)

244

233

245

234

@@ -247,22 +236,18 @@ chompField =

247-- EXPRESSIONS

236-- EXPRESSIONS

248

237

249

238

250−type ExprParser =

239+expression :: Space.Parser E.Expr Src.Expr

251− SParser Src.Expr

252−

253−

254−expression :: ExprParser

255expression =

240expression =

256 do start <- getPosition

241 do start <- getPosition

257− oneOf E.XXX

242+ oneOf E.Start

258 [ let_ start

243 [ let_ start

259 , if_ start

244 , if_ start

260 , case_ start

245 , case_ start

261 , function start

246 , function start

262 , do expr <- possiblyNegativeTerm start

247 , do expr <- possiblyNegativeTerm start

263 end <- getPosition

248 end <- getPosition

264− space <- whitespace

249+ Space.chomp E.Space

265− exprHelp start (State [] expr [] end space)

250+ chompExprEnd start (State [] expr [] end)

266 ]

251 ]

267

252

268

253

@@ -272,77 +257,76 @@ data State =

272 , _expr :: !Src.Expr

257 , _expr :: !Src.Expr

273 , _args :: ![Src.Expr]

258 , _args :: ![Src.Expr]

274 , _end :: !A.Position

259 , _end :: !A.Position

275− , _pos :: !SPos

276 }

260 }

277

261

278

262

279−exprHelp :: A.Position -> State -> ExprParser

263+chompExprEnd :: A.Position -> State -> Space.Parser E.Expr Src.Expr

280−exprHelp start (State ops expr args end pos) =

264+chompExprEnd start (State ops expr args end) =

281− oneOf E.XXX

265+ oneOfWithFallback

282 [ -- argument

266 [ -- argument

283− do checkSpace pos

267+ do Space.checkIndent end E.IndentMoreExpr

284 arg <- term

268 arg <- term

285 newEnd <- getPosition

269 newEnd <- getPosition

286− newPos <- whitespace

270+ Space.chomp E.Space

287− exprHelp start (State ops expr (arg:args) newEnd newPos)

271+ chompExprEnd start (State ops expr (arg:args) newEnd)

288−

272+

289− , -- infix operator

273+ , -- operator

290− do checkSpace pos

274+ do Space.checkIndent end E.IndentMoreExpr

291− opStart <- getPosition

275+ op@(A.At (A.Region opStart opEnd) opName) <- addLocation (Symbol.operator E.Start E.OperatorReserved)

292− opName <- Symbol.binop

276+ Space.chompAndCheckIndent E.Space E.IndentOperatorRight

293− opEnd <- getPosition

294− let op = A.at opStart opEnd opName

295− spos <- whitespace

296− checkSpace spos

297 newStart <- getPosition

277 newStart <- getPosition

298 if "-" == opName && end /= opStart && opEnd == newStart

278 if "-" == opName && end /= opStart && opEnd == newStart

299 then

279 then

300 -- negative terms

280 -- negative terms

301− do rawTerm <- term

281+ do negatedExpr <- term

302 newEnd <- getPosition

282 newEnd <- getPosition

303− newPos <- whitespace

283+ Space.chomp E.Space

304− let arg = A.at opStart newEnd (Src.Negate rawTerm)

284+ let arg = A.at opStart newEnd (Src.Negate negatedExpr)

305− exprHelp start (State ops expr (arg:args) newEnd newPos)

285+ chompExprEnd start (State ops expr (arg:args) newEnd)

306 else

286 else

307− oneOf E.XXX

287+ oneOf E.OperatorRight

308 [ -- term

288 [ -- term

309 do newExpr <- possiblyNegativeTerm newStart

289 do newExpr <- possiblyNegativeTerm newStart

310 newEnd <- getPosition

290 newEnd <- getPosition

311− newPos <- whitespace

291+ Space.chomp E.Space

312 let newOps = (toCall expr args, op) : ops

292 let newOps = (toCall expr args, op) : ops

313− exprHelp start (State newOps newExpr [] newEnd newPos)

293+ chompExprEnd start (State newOps newExpr [] newEnd)

314

294

315 , -- final term

295 , -- final term

316− do (newLast, newEnd, newPos) <-

296+ do (newLast, newEnd) <-

317− oneOf E.XXX

297+ oneOf E.OperatorRight

318 [ let_ newStart

298 [ let_ newStart

319 , case_ newStart

299 , case_ newStart

320 , if_ newStart

300 , if_ newStart

321 , function newStart

301 , function newStart

322 ]

302 ]

323 let newOps = (toCall expr args, op) : ops

303 let newOps = (toCall expr args, op) : ops

324− let finalExpr = A.at start newEnd (Src.Binops (reverse newOps) newLast)

304+ let finalExpr = Src.Binops (reverse newOps) newLast

325− return ( finalExpr, newEnd, newPos )

305+ return ( A.at start newEnd finalExpr, newEnd )

326 ]

306 ]

327

307

308+ ]

328− , -- done

309+ -- done

329− let finalExpr = toCall expr args in

310+ (

330 case ops of

311 case ops of

331 [] ->

312 [] ->

332− return ( finalExpr, end, pos )

313+ ( toCall expr args

314+ , end

315+ )

333

316

334 _ ->

317 _ ->

335− return ( A.at start end (Src.Binops (reverse ops) finalExpr), end, pos )

318+ ( A.at start end (Src.Binops (reverse ops) (toCall expr args))

336− ]

319+ , end

320+ )

321+ )

337

322

338

323

339−possiblyNegativeTerm :: A.Position -> Parser Src.Expr

324+possiblyNegativeTerm :: A.Position -> Parser E.Expr Src.Expr

340possiblyNegativeTerm start =

325possiblyNegativeTerm start =

341− oneOf E.XXX

326+ oneOf E.Start

342− [ do word1 0x2D {---} E.XXX

327+ [ do word1 0x2D {---} E.Start

343 expr <- term

328 expr <- term

344− end <- getPosition

345− return (A.at start end (Src.Negate expr))

329+ addEnd start (Src.Negate expr)

346 , term

330 , term

347 ]

331 ]

348

332

@@ -361,30 +345,32 @@ toCall func revArgs =

361-- IF EXPRESSION

345-- IF EXPRESSION

362

346

363

347

364−if_ :: A.Position -> ExprParser

348+if_ :: A.Position -> Space.Parser E.Expr Src.Expr

365if_ start =

349if_ start =

366− inContext E.ExprIf Keyword.if_ $

350+ inContext E.If (Keyword.if_ E.Start) $

367− ifHelp start []

351+ chompIfEnd start []

368−

352+

369−

353+

370−ifHelp :: A.Position -> [(Src.Expr, Src.Expr)] -> ExprParser

354+chompIfEnd :: A.Position -> [(Src.Expr, Src.Expr)] -> Space.Parser E.If Src.Expr

371−ifHelp start branches =

355+chompIfEnd start branches =

372− do spaces

356+ do Space.chompAndCheckIndent E.IfSpace E.IfIndentCondition

373− (condition, _, condPos) <- expression

357+ (condition, condEnd) <- specialize E.IfCondition expression

374− checkSpace condPos

358+ Space.checkIndent condEnd E.IfIndentThen

375− Keyword.then_

359+ Keyword.then_ E.IfThen

376− spaces

360+ Space.chompAndCheckIndent E.IfSpace E.IfIndentThenBranch

377− (thenBranch, _, thenPos) <- expression

361+ (thenBranch, thenEnd) <- specialize E.IfThenBranch expression

378− checkSpace thenPos

362+ Space.checkIndent thenEnd E.IfIndentElse

379− Keyword.else_

363+ Keyword.else_ E.IfElse

380− spaces

364+ Space.chompAndCheckIndent E.IfSpace E.IfIndentElseBranch

381 let newBranches = (condition, thenBranch) : branches

365 let newBranches = (condition, thenBranch) : branches

382− oneOf E.XXX

366+ oneOf E.IfElseBranchStart

367+ [

383− [ do Keyword.if_

368+ do Keyword.if_ E.IfElseBranchStart

384− ifHelp start newBranches

369+ chompIfEnd start newBranches

370+ ,

385− , do (elseBranch, elseEnd, elseSpace) <- expression

371+ do (elseBranch, elseEnd) <- specialize E.IfElseBranch expression

386− let ifExpr = A.at start elseEnd (Src.If (reverse newBranches) elseBranch)

372+ let ifExpr = Src.If (reverse newBranches) elseBranch

387− return ( ifExpr, elseEnd, elseSpace )

373+ return ( A.at start elseEnd ifExpr, elseEnd )

388 ]

374 ]

389

375

390

376

@@ -392,27 +378,27 @@ ifHelp start branches =

392-- LAMBDA EXPRESSION

378-- LAMBDA EXPRESSION

393

379

394

380

395−function :: A.Position -> ExprParser

381+function :: A.Position -> Space.Parser E.Expr Src.Expr

396function start =

382function start =

397− inContext E.ExprFunc (word1 0x5C {-\-} E.XXX) $

383+ inContext E.Func (word1 0x5C {-\-} E.Start) $

398− do spaces

384+ do Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArg

399− arg <- Pattern.term

385+ arg <- specialize E.FuncArg Pattern.term

400− spaces

386+ Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow

401− revArgs <- gatherArgs [arg]

387+ revArgs <- chompArgs [arg]

402− spaces

388+ Space.chompAndCheckIndent E.FuncSpace E.FuncIndentBody

403− (body, end, space) <- expression

389+ (body, end) <- specialize E.FuncBody expression

404− let func = A.at start end (Src.Lambda (reverse revArgs) body)

390+ let funcExpr = Src.Lambda (reverse revArgs) body

405− return ( func, end, space )

391+ return (A.at start end funcExpr, end)

406−

392+

407−

393+

408−gatherArgs :: [Src.Pattern] -> Parser [Src.Pattern]

394+chompArgs :: [Src.Pattern] -> Parser E.Func [Src.Pattern]

409−gatherArgs args =

395+chompArgs revArgs =

410− oneOf E.XXX

396+ oneOf E.FuncArrow

411− [ do arg <- Pattern.term

397+ [ do arg <- specialize E.FuncArg Pattern.term

412− spaces

398+ Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow

413− gatherArgs (arg:args)

399+ chompArgs (arg:revArgs)

414− , do word2 0x2D 0x3E {-->-} E.XXX

400+ , do word2 0x2D 0x3E {-->-} E.FuncArrow

415− return args

401+ return revArgs

416 ]

402 ]

417

403

418

404

@@ -420,90 +406,84 @@ gatherArgs args =

420-- CASE EXPRESSIONS

406-- CASE EXPRESSIONS

421

407

422

408

423−case_ :: A.Position -> ExprParser

409+case_ :: A.Position -> Space.Parser E.Expr Src.Expr

424case_ start =

410case_ start =

425− inContext E.ExprCase Keyword.case_ $

411+ inContext E.Case (Keyword.case_ E.Start) $

426− do spaces

412+ do Space.chompAndCheckIndent E.CaseSpace E.CaseIndentExpr

427− (switcher, _, switcherPos) <- expression

413+ (expr, exprEnd) <- specialize E.CaseExpr expression

428− checkSpace switcherPos

414+ Space.checkIndent exprEnd E.CaseIndentOf

429− Keyword.of_

415+ Keyword.of_ E.CaseOf

430− spaces

416+ Space.chompAndCheckIndent E.CaseSpace E.CaseIndentPattern

431− oldIndent <- getIndent

417+ withIndent $

432− newIndent <- getCol

433− setIndent newIndent

434− (firstBranch, firstEnd, firstPos) <- branchHelp

418+ do (firstBranch, firstEnd) <- chompBranch

435− (branches, end, pos) <- caseHelp [firstBranch] firstEnd firstPos

419+ (branches, end) <- chompCaseEnd [firstBranch] firstEnd

436− setIndent oldIndent

437− return

420+ return

438− ( A.at start end (Src.Case switcher branches)

421+ ( A.at start end (Src.Case expr branches)

439− , end

422+ , end

440− , pos

441− )

423+ )

442−

424+

443−

425+

444−branchHelp :: SParser (Src.Pattern, Src.Expr)

426+chompBranch :: Space.Parser E.Case (Src.Pattern, Src.Expr)

445−branchHelp =

427+chompBranch =

446− do (pattern, patternPos) <- Pattern.expression

428+ do (pattern, patternEnd) <- specialize E.CasePattern Pattern.expression

447− checkSpace patternPos

429+ Space.checkIndent patternEnd E.CaseIndentArrow

448− word2 0x2D 0x3E {-->-} E.XXX

430+ word2 0x2D 0x3E {-->-} E.CaseArrow

449− spaces

431+ Space.chompAndCheckIndent E.CaseSpace E.CaseIndentBranch

450− (branchExpr, end, pos) <- expression

432+ (branchExpr, end) <- specialize E.CaseBranch expression

451− return ( (pattern, branchExpr), end, pos )

433+ return ( (pattern, branchExpr), end )

452−

434+

453−

435+

454−caseHelp :: [(Src.Pattern, Src.Expr)] -> A.Position -> SPos -> SParser [(Src.Pattern, Src.Expr)]

436+chompCaseEnd :: [(Src.Pattern, Src.Expr)] -> A.Position -> Space.Parser E.Case [(Src.Pattern, Src.Expr)]

455−caseHelp branches end pos =

437+chompCaseEnd branches end =

456− oneOf E.XXX

438+ oneOfWithFallback

457− [ do checkAligned pos

439+ [ do Space.checkAligned E.CasePatternAlignment

458− (branch, newEnd, newPos) <- branchHelp

440+ (branch, newEnd) <- chompBranch

459− caseHelp (branch:branches) newEnd newPos

441+ chompCaseEnd (branch:branches) newEnd

460− , return ( reverse branches, end, pos )

461 ]

442 ]

443+ (reverse branches, end)

462

444

463

445

464

446

465-- LET EXPRESSION

447-- LET EXPRESSION

466

448

467

449

468−let_ :: A.Position -> ExprParser

450+let_ :: A.Position -> Space.Parser E.Expr Src.Expr

469let_ start =

451let_ start =

470− do oldIndent <- getIndent

471− letIndent <- getCol

472− Keyword.let_

452+ inContext E.Let (Keyword.let_ E.Start) $

473− pushContext start E.ExprLet

453+ do (defs, defsEnd) <-

474− setIndent letIndent

454+ withBacksetIndent 3 $

475− spaces

455+ do Space.chompAndCheckIndent E.LetSpace E.LetIndentDef

476− defIndent <- getCol

456+ withIndent $

477− setIndent defIndent

457+ do (def, end) <- chompLetDef

478− (def, end, space) <- letDef

458+ chompLetDefs [def] end

479− letHelp start oldIndent [def] end space

459+

480−

460+ Space.checkIndent defsEnd E.LetIndentIn

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_

461+ Keyword.in_ E.LetIn

492− popContext ()

462+ Space.chompAndCheckIndent E.LetSpace E.LetIndentBody

493− spaces

494− (body, newEnd, newPos) <- expression

463+ (body, end) <- specialize E.LetBody expression

464+ return

495− let letExpr = A.at start end (Src.Let (reverse revDefs) body)

465+ ( A.at start end (Src.Let defs body)

496− return ( letExpr, newEnd, newPos )

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

497 ]

476 ]

477+ (reverse revDefs, end)

498

478

499

479

500

480

501-- LET DEFINITIONS

481-- LET DEFINITIONS

502

482

503

483

504−letDef :: SParser (A.Located Src.Def)

484+chompLetDef :: Space.Parser E.Let (A.Located Src.Def)

505−letDef =

485+chompLetDef =

506− oneOf E.XXX

486+ oneOf E.LetDefName

507 [ definition

487 [ definition

508 , destructure

488 , destructure

509 ]

489 ]

@@ -513,61 +493,57 @@ letDef =

513-- DEFINITION

493-- DEFINITION

514

494

515

495

516−definition :: SParser (A.Located Src.Def)

496+definition :: Space.Parser E.Let (A.Located Src.Def)

517definition =

497definition =

518− do start <- getPosition

498+ do aname@(A.At (A.Region start _) name) <- addLocation (Var.lower E.LetDefName)

519− name <- Var.lower

499+ specialize (E.LetDef name) $

520− end <- getPosition

500+ do Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals

521− spaces

522− oneOf E.XXX

501+ oneOf E.DefEquals

523− [

502+ [

524− do word1 0x3A {-:-} E.XXX

503+ do word1 0x3A {-:-} E.DefEquals

525− pushContext start (E.Annotation name)

504+ Space.chompAndCheckIndent E.DefSpace E.DefIndentType

526− spaces

527− (tipe, _, space) <- Type.expression

505+ (tipe, _) <- specialize E.DefType Type.expression

528− popContext ()

529− checkAligned space

506+ Space.checkAligned E.DefAlignment

530− defName <- matchingName name

507+ defName <- chompMatchingName name

531− let (A.At (A.Region defStart _) _) = defName

508+ Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals

532− pushContext defStart (E.Definition name)

533− spaces

534− def <- definitionHelp start defName (Just tipe) []

509+ chompDefArgsAndBody start defName (Just tipe) []

535− popContext def

536− ,

510+ ,

537− do pushContext start (E.Definition name)

511+ chompDefArgsAndBody start aname Nothing []

538− def <- definitionHelp start (A.at start end name) Nothing []

539− popContext def

540− ]

512+ ]

541−

513+

542−

514+

543−definitionHelp :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> SParser (A.Located Src.Def)

515+chompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.Def (A.Located Src.Def)

544−definitionHelp start name tipe revArgs =

516+chompDefArgsAndBody start name tipe revArgs =

545− oneOf E.XXX

517+ oneOf E.DefEquals

546− [ do arg <- Pattern.term

518+ [ do arg <- specialize E.DefArg Pattern.term

547− spaces

519+ Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals

548− definitionHelp start name tipe (arg : revArgs)

520+ chompDefArgsAndBody start name tipe (arg : revArgs)

549− , do word1 0x3D {-=-} E.XXX

521+ , do word1 0x3D {-=-} E.DefEquals

550− spaces

522+ Space.chompAndCheckIndent E.DefSpace E.DefIndentBody

551− (body, end, space) <- expression

523+ (body, end) <- specialize E.DefBody expression

524+ return

552− let def = A.at start end (Src.Define name (reverse revArgs) body tipe)

525+ ( A.at start end (Src.Define name (reverse revArgs) body tipe)

553− return ( def, end, space )

526+ , end

527+ )

554 ]

528 ]

555

529

556

530

557−matchingName :: Name.Name -> Parser (A.Located Name.Name)

531+chompMatchingName :: Name.Name -> Parser E.Def (A.Located Name.Name)

558−matchingName expectedName =

532+chompMatchingName expectedName =

533+ let

559− let (P.Parser parserL) = Var.lower in

534+ (P.Parser parserL) = Var.lower (E.DefNameRepeat expectedName)

535+ in

560− P.Parser $ \state@(P.State _ _ _ sr sc ctx) cok eok cerr eerr ->

536+ P.Parser $ \state@(P.State _ _ _ sr sc) cok eok cerr eerr ->

561 let

537 let

562− cokL name newState@(P.State _ _ _ er ec _) =

538+ cokL name newState@(P.State _ _ _ er ec) =

563 if expectedName == name

539 if expectedName == name

564 then cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState

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

566

542

567− eokL name newState@(P.State _ _ _ er ec _) =

543+ eokL name newState@(P.State _ _ _ er ec) =

568 if expectedName == name

544 if expectedName == name

569 then eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState

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

571 in

547 in

572 parserL state cokL eokL cerr eerr

548 parserL state cokL eokL cerr eerr

573

549

@@ -577,12 +553,13 @@ matchingName expectedName =

577-- DESTRUCTURE

553-- DESTRUCTURE

578

554

579

555

580−destructure :: SParser (A.Located Src.Def)

556+destructure :: Space.Parser E.Let (A.Located Src.Def)

581destructure =

557destructure =

558+ specialize E.LetDestruct $

582 do start <- getPosition

559 do start <- getPosition

583− pattern <- Pattern.term

560+ pattern <- specialize E.DestructPattern Pattern.term

584− spaces

561+ Space.chompAndCheckIndent E.DestructSpace E.DestructIndentEquals

585− word1 0x3D {-=-} E.XXX

562+ word1 0x3D {-=-} E.DestructEquals

586− spaces

563+ Space.chompAndCheckIndent E.DestructSpace E.DestructIndentBody

587− (expr, end, space) <- expression

564+ (expr, end) <- specialize E.DestructBody expression

588− return ( A.at start end (Src.Destruct pattern expr), end, space )

565+ return ( A.at start end (Src.Destruct pattern expr), end )

compiler/src/Parse/Keyword.hs+83−84

@@ -16,112 +16,111 @@ module Parse.Keyword

16import Foreign.Ptr (plusPtr)

17import Data.Word (Word8)

19−import Parse.Utils (Parser)

19+import Parse.Primitives (Parser, Row, Col)

20import qualified Parse.Variable as Var

21import qualified Parse.Primitives as P

22−import qualified Reporting.Error.Syntax as E

26-- DECLARATIONS

25-- DECLARATIONS

29−type_ :: Parser ()

28+type_ :: (Row -> Col -> x) -> Parser x ()

30−type_ = k4 0x74 0x79 0x70 0x65 E.KeywordType

29+type_ tx = k4 0x74 0x79 0x70 0x65 tx

32−alias_ :: Parser ()

31+alias_ :: (Row -> Col -> x) -> Parser x ()

33−alias_ = k5 0x61 0x6C 0x69 0x61 0x73 E.KeywordAlias

32+alias_ tx = k5 0x61 0x6C 0x69 0x61 0x73 tx

35−port_ :: Parser ()

34+port_ :: (Row -> Col -> x) -> Parser x ()

36−port_ = k4 0x70 0x6F 0x72 0x74 E.KeywordPort

35+port_ tx = k4 0x70 0x6F 0x72 0x74 tx

40-- IF EXPRESSIONS

39-- IF EXPRESSIONS

43−if_ :: Parser ()

42+if_ :: (Row -> Col -> x) -> Parser x ()

44−if_ = k2 0x69 0x66 E.KeywordIf

43+if_ tx = k2 0x69 0x66 tx

46−then_ :: Parser ()

45+then_ :: (Row -> Col -> x) -> Parser x ()

47−then_ = k4 0x74 0x68 0x65 0x6E E.KeywordThen

46+then_ tx = k4 0x74 0x68 0x65 0x6E tx

49−else_ :: Parser ()

48+else_ :: (Row -> Col -> x) -> Parser x ()

50−else_ = k4 0x65 0x6C 0x73 0x65 E.KeywordElse

49+else_ tx = k4 0x65 0x6C 0x73 0x65 tx

54-- CASE EXPRESSIONS

53-- CASE EXPRESSIONS

57−case_ :: Parser ()

56+case_ :: (Row -> Col -> x) -> Parser x ()

58−case_ = k4 0x63 0x61 0x73 0x65 E.KeywordCase

57+case_ tx = k4 0x63 0x61 0x73 0x65 tx

60−of_ :: Parser ()

59+of_ :: (Row -> Col -> x) -> Parser x ()

61−of_ = k2 0x6F 0x66 E.KeywordOf

60+of_ tx = k2 0x6F 0x66 tx

65-- LET EXPRESSIONS

64-- LET EXPRESSIONS

68−let_ :: Parser ()

67+let_ :: (Row -> Col -> x) -> Parser x ()

69−let_ = k3 0x6C 0x65 0x74 E.KeywordLet

68+let_ tx = k3 0x6C 0x65 0x74 tx

71−in_ :: Parser ()

70+in_ :: (Row -> Col -> x) -> Parser x ()

72−in_ = k2 0x69 0x6E E.KeywordIn

71+in_ tx = k2 0x69 0x6E tx

76-- INFIXES

75-- INFIXES

79−infix_ :: Parser ()

78+infix_ :: (Row -> Col -> x) -> Parser x ()

80−infix_ = k5 0x69 0x6E 0x66 0x69 0x78 E.KeywordInfix

79+infix_ tx = k5 0x69 0x6E 0x66 0x69 0x78 tx

82−left_ :: Parser ()

81+left_ :: (Row -> Col -> x) -> Parser x ()

83−left_ = k4 0x6C 0x65 0x66 0x74 E.Associativity

82+left_ tx = k4 0x6C 0x65 0x66 0x74 tx

85−right_ :: Parser ()

84+right_ :: (Row -> Col -> x) -> Parser x ()

86−right_ = k5 0x72 0x69 0x67 0x68 0x74 E.Associativity

85+right_ tx = k5 0x72 0x69 0x67 0x68 0x74 tx

88−non_ :: Parser ()

87+non_ :: (Row -> Col -> x) -> Parser x ()

89−non_ = k3 0x6E 0x6F 0x6E E.Associativity

88+non_ tx = k3 0x6E 0x6F 0x6E tx

93-- IMPORTS

92-- IMPORTS

96−module_ :: Parser ()

95+module_ :: (Row -> Col -> x) -> Parser x ()

97−module_ = k6 0x6D 0x6F 0x64 0x75 0x6C 0x65 E.KeywordModule

96+module_ tx = k6 0x6D 0x6F 0x64 0x75 0x6C 0x65 tx

99−import_ :: Parser ()

98+import_ :: (Row -> Col -> x) -> Parser x ()

100−import_ = k6 0x69 0x6D 0x70 0x6F 0x72 0x74 E.KeywordImport

99+import_ tx = k6 0x69 0x6D 0x70 0x6F 0x72 0x74 tx

101

100

102−exposing_ :: Parser ()

101+exposing_ :: (Row -> Col -> x) -> Parser x ()

103−exposing_ = k8 0x65 0x78 0x70 0x6F 0x73 0x69 0x6E 0x67 E.KeywordExposing

102+exposing_ tx = k8 0x65 0x78 0x70 0x6F 0x73 0x69 0x6E 0x67 tx

104

103

105−as_ :: Parser ()

104+as_ :: (Row -> Col -> x) -> Parser x ()

106−as_ = k2 0x61 0x73 E.KeywordAs

105+as_ tx = k2 0x61 0x73 tx

107

106

108

107

109

108

110-- EFFECTS

109-- EFFECTS

111

110

112

111

113−effect_ :: Parser ()

112+effect_ :: (Row -> Col -> x) -> Parser x ()

114−effect_ = k6 0x65 0x66 0x66 0x65 0x63 0x74 E.EffectStuff

113+effect_ tx = k6 0x65 0x66 0x66 0x65 0x63 0x74 tx

115

114

116−where_ :: Parser ()

115+where_ :: (Row -> Col -> x) -> Parser x ()

117−where_ = k5 0x77 0x68 0x65 0x72 0x65 E.EffectStuff

116+where_ tx = k5 0x77 0x68 0x65 0x72 0x65 tx

118

117

119−command_ :: Parser ()

118+command_ :: (Row -> Col -> x) -> Parser x ()

120−command_ = k7 0x63 0x6F 0x6D 0x6D 0x61 0x6E 0x64 E.EffectStuff

119+command_ tx = k7 0x63 0x6F 0x6D 0x6D 0x61 0x6E 0x64 tx

121

120

122−subscription_ :: Parser ()

121+subscription_ :: (Row -> Col -> x) -> Parser x ()

123−subscription_ =

122+subscription_ toError =

124− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

123+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

125 let !pos12 = plusPtr pos 12 in

124 let !pos12 = plusPtr pos 12 in

126 if pos12 <= end

125 if pos12 <= end

127 && P.unsafeIndex ( pos ) == 0x73

126 && P.unsafeIndex ( pos ) == 0x73

@@ -138,32 +137,32 @@ subscription_ =

138 && P.unsafeIndex (plusPtr pos 11) == 0x6E

137 && P.unsafeIndex (plusPtr pos 11) == 0x6E

139 && Var.getInnerWidth pos12 end == 0

138 && Var.getInnerWidth pos12 end == 0

140 then

139 then

141− let !s = P.State pos12 end indent row (col + 12) ctx in cok () s

140+ let !s = P.State pos12 end indent row (col + 12) in cok () s

142 else

141 else

143− eerr row col ctx E.EffectStuff

142+ eerr row col toError

144

143

145

144

146

145

147-- KEYWORDS

146-- KEYWORDS

148

147

149

148

150−k2 :: Word8 -> Word8 -> x -> P.Parser c x ()

149+k2 :: Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

151−k2 w1 w2 x =

150+k2 w1 w2 toError =

152− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

151+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

153 let !pos2 = plusPtr pos 2 in

152 let !pos2 = plusPtr pos 2 in

154 if pos2 <= end

153 if pos2 <= end

155 && P.unsafeIndex ( pos ) == w1

154 && P.unsafeIndex ( pos ) == w1

156 && P.unsafeIndex (plusPtr pos 1) == w2

155 && P.unsafeIndex (plusPtr pos 1) == w2

157 && Var.getInnerWidth pos2 end == 0

156 && Var.getInnerWidth pos2 end == 0

158 then

157 then

159− let !s = P.State pos2 end indent row (col + 2) ctx in cok () s

158+ let !s = P.State pos2 end indent row (col + 2) in cok () s

160 else

159 else

161− eerr row col ctx x

160+ eerr row col toError

162

161

163

162

164−k3 :: Word8 -> Word8 -> Word8 -> x -> P.Parser c x ()

163+k3 :: Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

165−k3 w1 w2 w3 x =

164+k3 w1 w2 w3 toError =

166− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

165+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

167 let !pos3 = plusPtr pos 3 in

166 let !pos3 = plusPtr pos 3 in

168 if pos3 <= end

167 if pos3 <= end

169 && P.unsafeIndex ( pos ) == w1

168 && P.unsafeIndex ( pos ) == w1

@@ -171,14 +170,14 @@ k3 w1 w2 w3 x =

171 && P.unsafeIndex (plusPtr pos 2) == w3

170 && P.unsafeIndex (plusPtr pos 2) == w3

172 && Var.getInnerWidth pos3 end == 0

171 && Var.getInnerWidth pos3 end == 0

173 then

172 then

174− let !s = P.State pos3 end indent row (col + 3) ctx in cok () s

173+ let !s = P.State pos3 end indent row (col + 3) in cok () s

175 else

174 else

176− eerr row col ctx x

175+ eerr row col toError

177

176

178

177

179−k4 :: Word8 -> Word8 -> Word8 -> Word8 -> x -> P.Parser c x ()

178+k4 :: Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

180−k4 w1 w2 w3 w4 x =

179+k4 w1 w2 w3 w4 toError =

181− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

180+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

182 let !pos4 = plusPtr pos 4 in

181 let !pos4 = plusPtr pos 4 in

183 if pos4 <= end

182 if pos4 <= end

184 && P.unsafeIndex ( pos ) == w1

183 && P.unsafeIndex ( pos ) == w1

@@ -187,14 +186,14 @@ k4 w1 w2 w3 w4 x =

187 && P.unsafeIndex (plusPtr pos 3) == w4

186 && P.unsafeIndex (plusPtr pos 3) == w4

188 && Var.getInnerWidth pos4 end == 0

187 && Var.getInnerWidth pos4 end == 0

189 then

188 then

190− let !s = P.State pos4 end indent row (col + 4) ctx in cok () s

189+ let !s = P.State pos4 end indent row (col + 4) in cok () s

191 else

190 else

192− eerr row col ctx x

191+ eerr row col toError

193

192

194

193

195−k5 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> x -> P.Parser c x ()

194+k5 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

196−k5 w1 w2 w3 w4 w5 x =

195+k5 w1 w2 w3 w4 w5 toError =

197− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

196+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

198 let !pos5 = plusPtr pos 5 in

197 let !pos5 = plusPtr pos 5 in

199 if pos5 <= end

198 if pos5 <= end

200 && P.unsafeIndex ( pos ) == w1

199 && P.unsafeIndex ( pos ) == w1

@@ -204,14 +203,14 @@ k5 w1 w2 w3 w4 w5 x =

204 && P.unsafeIndex (plusPtr pos 4) == w5

203 && P.unsafeIndex (plusPtr pos 4) == w5

205 && Var.getInnerWidth pos5 end == 0

204 && Var.getInnerWidth pos5 end == 0

206 then

205 then

207− let !s = P.State pos5 end indent row (col + 5) ctx in cok () s

206+ let !s = P.State pos5 end indent row (col + 5) in cok () s

208 else

207 else

209− eerr row col ctx x

208+ eerr row col toError

210

209

211

210

212−k6 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> x -> P.Parser c x ()

211+k6 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

213−k6 w1 w2 w3 w4 w5 w6 x =

212+k6 w1 w2 w3 w4 w5 w6 toError =

214− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

213+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

215 let !pos6 = plusPtr pos 6 in

214 let !pos6 = plusPtr pos 6 in

216 if pos6 <= end

215 if pos6 <= end

217 && P.unsafeIndex ( pos ) == w1

216 && P.unsafeIndex ( pos ) == w1

@@ -222,14 +221,14 @@ k6 w1 w2 w3 w4 w5 w6 x =

222 && P.unsafeIndex (plusPtr pos 5) == w6

221 && P.unsafeIndex (plusPtr pos 5) == w6

223 && Var.getInnerWidth pos6 end == 0

222 && Var.getInnerWidth pos6 end == 0

224 then

223 then

225− let !s = P.State pos6 end indent row (col + 6) ctx in cok () s

224+ let !s = P.State pos6 end indent row (col + 6) in cok () s

226 else

225 else

227− eerr row col ctx x

226+ eerr row col toError

228

227

229

228

230−k7 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> x -> P.Parser c x ()

229+k7 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

231−k7 w1 w2 w3 w4 w5 w6 w7 x =

230+k7 w1 w2 w3 w4 w5 w6 w7 toError =

232− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

231+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

233 let !pos7 = plusPtr pos 7 in

232 let !pos7 = plusPtr pos 7 in

234 if pos7 <= end

233 if pos7 <= end

235 && P.unsafeIndex ( pos ) == w1

234 && P.unsafeIndex ( pos ) == w1

@@ -241,14 +240,14 @@ k7 w1 w2 w3 w4 w5 w6 w7 x =

241 && P.unsafeIndex (plusPtr pos 6) == w7

240 && P.unsafeIndex (plusPtr pos 6) == w7

242 && Var.getInnerWidth pos7 end == 0

241 && Var.getInnerWidth pos7 end == 0

243 then

242 then

244− let !s = P.State pos7 end indent row (col + 7) ctx in cok () s

243+ let !s = P.State pos7 end indent row (col + 7) in cok () s

245 else

244 else

246− eerr row col ctx x

245+ eerr row col toError

247

246

248

247

249−k8 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> x -> P.Parser c x ()

248+k8 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> (Row -> Col -> x) -> Parser x ()

250−k8 w1 w2 w3 w4 w5 w6 w7 w8 x =

249+k8 w1 w2 w3 w4 w5 w6 w7 w8 toError =

251− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

250+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

252 let !pos8 = plusPtr pos 8 in

251 let !pos8 = plusPtr pos 8 in

253 if pos8 <= end

252 if pos8 <= end

254 && P.unsafeIndex ( pos ) == w1

253 && P.unsafeIndex ( pos ) == w1

@@ -261,6 +260,6 @@ k8 w1 w2 w3 w4 w5 w6 w7 w8 x =

261 && P.unsafeIndex (plusPtr pos 7) == w8

260 && P.unsafeIndex (plusPtr pos 7) == w8

262 && Var.getInnerWidth pos8 end == 0

261 && Var.getInnerWidth pos8 end == 0

263 then

262 then

264− let !s = P.State pos8 end indent row (col + 8) ctx in cok () s

263+ let !s = P.State pos8 end indent row (col + 8) in cok () s

265 else

264 else

266− eerr row col ctx x

265+ eerr row col toError

compiler/src/Parse/Number.hs+25−25

@@ -16,7 +16,7 @@ import Data.Word (Word8)

16import Foreign.Ptr (Ptr, plusPtr, minusPtr)

18import qualified AST.Utils.Binop as Binop

19−import Parse.Utils (Parser)

19+import Parse.Primitives (Parser, Row, Col)

20import qualified Parse.Variable as Var

21import qualified Parse.Primitives as P

22import qualified Reporting.Error.Syntax as E

@@ -46,16 +46,16 @@ data Number

46 | Float (Utf8.Under256 Float)

49−number :: Parser Number

49+number :: (Row -> Col -> x) -> (E.Number -> Row -> Col -> x) -> Parser x Number

50−number =

50+number toExpectation toError =

51− P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->

51+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->

52 if pos >= end then

53− eerr row col ctx E.Number_Start

53+ eerr row col toExpectation

55 else

56 let !word = P.unsafeIndex pos in

57 if not (isDecimalDigit word) then

58− eerr row col ctx E.Number_Start

58+ eerr row col toExpectation

60 else

61 let

@@ -70,13 +70,13 @@ number =

70 let

71 !newCol = col + fromIntegral (minusPtr newPos pos)

72 in

73− cerr row newCol ctx problem

73+ cerr row newCol (toError problem)

75 OkInt newPos n ->

76 let

77 !newCol = col + fromIntegral (minusPtr newPos pos)

78 !integer = Int n

79− !newState = P.State newPos end indent row newCol ctx

79+ !newState = P.State newPos end indent row newCol

80 in

81 cok integer newState

@@ -85,7 +85,7 @@ number =

85 !newCol = col + fromIntegral (minusPtr newPos pos)

86 !copy = Utf8.fromPtr pos newPos

87 !float = Float copy

88− !newState = P.State newPos end indent row newCol ctx

88+ !newState = P.State newPos end indent row newCol

89 in

90 cok float newState

@@ -97,7 +97,7 @@ number =

97-- first Int is newPos

98--

99data Outcome

100− = Err (Ptr Word8) E.Expectation

100+ = Err (Ptr Word8) E.Number

101 | OkInt (Ptr Word8) Int

102 | OkFloat (Ptr Word8)

103

@@ -127,7 +127,7 @@ chompInt !pos end !n =

127 chompExponent (plusPtr pos 1) end

128

129 else if isDirtyEnd pos end word then

130− Err pos E.Number_End

130+ Err pos E.NumberEnd

131

132 else

133 OkInt pos n

@@ -140,13 +140,13 @@ chompInt !pos end !n =

140chompFraction :: Ptr Word8 -> Ptr Word8 -> Int -> Outcome

141chompFraction pos end n =

142 if pos >= end then

143− Err pos (E.Number_Dot n)

143+ Err pos (E.NumberDot n)

144

145 else if isDecimalDigit (P.unsafeIndex pos) then

146 chompFractionHelp (plusPtr pos 1) end

147

148 else

149− Err pos (E.Number_Dot n)

149+ Err pos (E.NumberDot n)

150

151

152chompFractionHelp :: Ptr Word8 -> Ptr Word8 -> Outcome

@@ -163,7 +163,7 @@ chompFractionHelp pos end =

163 chompExponent (plusPtr pos 1) end

164

165 else if isDirtyEnd pos end word then

166− Err pos E.Number_End

166+ Err pos E.NumberEnd

167

168 else

169 OkFloat pos

@@ -176,7 +176,7 @@ chompFractionHelp pos end =

176chompExponent :: Ptr Word8 -> Ptr Word8 -> Outcome

177chompExponent pos end =

178 if pos >= end then

179− Err pos E.Number_End

179+ Err pos E.NumberEnd

180

181 else

182 let !word = P.unsafeIndex pos in

@@ -189,10 +189,10 @@ chompExponent pos end =

189 if pos1 < end && isDecimalDigit (P.unsafeIndex pos1) then

190 chompExponentHelp (plusPtr pos 2) end

191 else

192− Err pos E.Number_End

192+ Err pos E.NumberEnd

193

194 else

195− Err pos E.Number_End

195+ Err pos E.NumberEnd

196

197

198chompExponentHelp :: Ptr Word8 -> Ptr Word8 -> Outcome

@@ -225,10 +225,10 @@ chompZero pos end =

225 chompFraction (plusPtr pos 1) end 0

226

227 else if isDecimalDigit word then

228− Err pos E.Number_NoLeadingZero

228+ Err pos E.NumberNoLeadingZero

229

230 else if isDirtyEnd pos end word then

231− Err pos E.Number_End

231+ Err pos E.NumberEnd

232

233 else

234 OkInt pos 0

@@ -238,7 +238,7 @@ chompHexInt :: Ptr Word8 -> Ptr Word8 -> Outcome

238chompHexInt pos end =

239 let (# newPos, answer #) = chompHex pos end in

240 if answer < 0 then

241− Err newPos E.Number_HexDigit

241+ Err newPos E.NumberHexDigit

242 else

243 OkInt newPos answer

244

@@ -285,18 +285,18 @@ stepHex pos end word acc

285-- PRECEDENCE

286

287

288−precedence :: Parser Binop.Precedence

288+precedence :: Parser E.Infix Binop.Precedence

289precedence =

290− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

290+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

291 if pos >= end then

292− eerr row col ctx E.Precedence

292+ eerr row col E.Precedence

293

294 else

295 let !word = P.unsafeIndex pos in

296 if isDecimalDigit word then

297 cok

298 (Binop.Precedence (fromIntegral (word - 0x30 {-0-})))

299− (P.State (plusPtr pos 1) end indent row (col + 1) ctx)

299+ (P.State (plusPtr pos 1) end indent row (col + 1))

300

301 else

302− eerr row col ctx E.Precedence

302+ eerr row col E.Precedence

compiler/src/Parse/Pattern.hs+103−120

@@ -9,16 +9,17 @@ module Parse.Pattern

10import qualified Data.List as List

11import qualified Data.Name as Name

12+import qualified Data.Utf8 as Utf8

13import qualified AST.Source as Src

14import qualified AST.Source as Src

14−import Parse.Utils (Parser, SParser, SPos, checkSpace, spaces, whitespace)

15import qualified Parse.Keyword as Keyword

16import qualified Parse.Number as Number

17+import qualified Parse.Space as Space

17import qualified Parse.Symbol as Symbol

18import qualified Parse.Symbol as Symbol

18import qualified Parse.Utf8 as Utf8

19import qualified Parse.Utf8 as Utf8

19import qualified Parse.Variable as Var

20import qualified Parse.Variable as Var

20import qualified Parse.Primitives as P

21import qualified Parse.Primitives as P

21−import Parse.Primitives (addLocation, getPosition, inContext, oneOf, word1)

22+import Parse.Primitives (Parser, addLocation, addEnd, getPosition, inContext, oneOf, oneOfWithFallback, word1, word2)

22import qualified Reporting.Annotation as A

23import qualified Reporting.Annotation as A

23import qualified Reporting.Error.Syntax as E

24import qualified Reporting.Error.Syntax as E

@@ -27,10 +28,10 @@ import qualified Reporting.Error.Syntax as E

27-- TERM

28-- TERM

30−term :: Parser Src.Pattern

31+term :: Parser E.Pattern Src.Pattern

31term =

32term =

32 do start <- getPosition

33 do start <- getPosition

33− oneOf E.XXX

34+ oneOf E.PStart

34 [ record start

35 [ record start

35 , tuple start

36 , tuple start

36 , list start

37 , list start

@@ -38,19 +39,17 @@ term =

38 ]

39 ]

41−termHelp :: A.Position -> Parser Src.Pattern

42+termHelp :: A.Position -> Parser E.Pattern Src.Pattern

42termHelp start =

43termHelp start =

43− oneOf E.XXX

44+ oneOf E.PStart

44 [

45 [

45− do Symbol.underscore

46+ do Symbol.wildcard

46− end <- getPosition

47− return (A.at start end Src.PAnything)

47+ addEnd start Src.PAnything

48 ,

49− do name <- Var.lower

49+ do name <- Var.lower E.PStart

50− end <- getPosition

51− return (A.at start end (Src.PVar name))

50+ addEnd start (Src.PVar name)

52 ,

51 ,

53− do upper <- Var.foreignUpper

52+ do upper <- Var.foreignUpper E.PStart

54 end <- getPosition

53 end <- getPosition

55 let region = A.Region start end

54 let region = A.Region start end

56 return $ A.at start end $

55 return $ A.at start end $

@@ -61,60 +60,51 @@ termHelp start =

61 Var.Qualified home name ->

60 Var.Qualified home name ->

62 Src.PCtorQual region home name []

61 Src.PCtorQual region home name []

63 ,

62 ,

64− do number <- Number.number

63+ do number <- Number.number E.PStart E.PNumber

65 end <- getPosition

64 end <- getPosition

66 case number of

65 case number of

67 Number.Int int ->

66 Number.Int int ->

68 return (A.at start end (Src.PInt int))

67 return (A.at start end (Src.PInt int))

70− Number.Float _ ->

69+ Number.Float float ->

71− noFloatsAllowedInPatterns

70+ P.Parser $ \(P.State _ _ _ row col) _ _ cerr _ ->

71+ cerr row col (E.PFloat (Utf8.size float))

72 ,

73− do str <- Utf8.string

73+ do str <- Utf8.string E.PStart E.PString

74− end <- getPosition

75− return (A.at start end (Src.PStr str))

74+ addEnd start (Src.PStr str)

76 ,

75 ,

77− do chr <- Utf8.character

76+ do chr <- Utf8.character E.PStart E.PChar

78− end <- getPosition

79− return (A.at start end (Src.PChr chr))

77+ addEnd start (Src.PChr chr)

80 ]

78 ]

83−noFloatsAllowedInPatterns :: Parser a

84−noFloatsAllowedInPatterns =

85− P.Parser $ \(P.State _ _ _ row col ctx) _ _ cerr _ ->

86− cerr row col ctx E.FloatInPattern

87−

88−

90-- RECORDS

82-- RECORDS

93−record :: A.Position -> Parser Src.Pattern

85+record :: A.Position -> Parser E.Pattern Src.Pattern

94record start =

86record start =

95− inContext E.ExprRecord (word1 0x7B {- { -} E.XXX) $

87+ inContext E.PRecord (word1 0x7B {- { -} E.PStart) $

96− do spaces

88+ do Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentOpen

97− oneOf E.XXX

89+ oneOf E.PRecordOpen

98− [ do var <- addLocation Var.lower

90+ [ do var <- addLocation (Var.lower E.PRecordField)

99− spaces

91+ Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd

100 recordHelp start [var]

92 recordHelp start [var]

101− , do word1 0x7D {-}-} E.XXX

93+ , do word1 0x7D {-}-} E.PRecordEnd

102− end <- getPosition

103− return (A.at start end (Src.PRecord []))

94+ addEnd start (Src.PRecord [])

104 ]

95 ]

105

106

107−recordHelp :: A.Position -> [A.Located Name.Name] -> Parser Src.Pattern

98+recordHelp :: A.Position -> [A.Located Name.Name] -> Parser E.PRecord Src.Pattern

108recordHelp start vars =

99recordHelp start vars =

109− oneOf E.XXX

100+ oneOf E.PRecordEnd

110− [ do word1 0x2C {-,-} E.XXX

101+ [ do word1 0x2C {-,-} E.PRecordEnd

111− spaces

102+ Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentField

112− var <- addLocation Var.lower

103+ var <- addLocation (Var.lower E.PRecordField)

113− spaces

104+ Space.chompAndCheckIndent E.PRecordSpace E.PRecordIndentEnd

114 recordHelp start (var:vars)

105 recordHelp start (var:vars)

115− , do word1 0x7D {-}-} E.XXX

106+ , do word1 0x7D {-}-} E.PRecordEnd

116− end <- getPosition

117− return (A.at start end (Src.PRecord vars))

107+ addEnd start (Src.PRecord vars)

118 ]

108 ]

119

109

120

110

@@ -122,36 +112,34 @@ recordHelp start vars =

122-- TUPLES

112-- TUPLES

123

113

124

114

125−tuple :: A.Position -> Parser Src.Pattern

115+tuple :: A.Position -> Parser E.Pattern Src.Pattern

126tuple start =

116tuple start =

127− inContext E.ExprTuple (word1 0x28 {-(-} E.XXX) $

117+ inContext E.PTuple (word1 0x28 {-(-} E.PStart) $

128− do spaces

118+ do Space.chompAndCheckIndent E.PTupleSpace E.PTupleIndentOpen

129− oneOf E.XXX

119+ oneOf E.PTupleOpen

130− [ do (pattern, sPos) <- expression

120+ [ do (pattern, end) <- P.specialize E.PTupleExpr expression

131− checkSpace sPos

121+ Space.checkIndent end E.PTupleIndentEnd

132 tupleHelp start pattern []

122 tupleHelp start pattern []

133− , do word1 0x29 {-)-} E.XXX

123+ , do word1 0x29 {-)-} E.PTupleEnd

134− end <- getPosition

135− return (A.at start end Src.PUnit)

124+ addEnd start Src.PUnit

136 ]

125 ]

137

126

138

127

139−tupleHelp :: A.Position -> Src.Pattern -> [Src.Pattern] -> Parser Src.Pattern

128+tupleHelp :: A.Position -> Src.Pattern -> [Src.Pattern] -> Parser E.PTuple Src.Pattern

140tupleHelp start firstPattern revPatterns =

129tupleHelp start firstPattern revPatterns =

141− oneOf E.XXX

130+ oneOf E.PTupleEnd

142− [ do word1 0x2C {-,-} E.XXX

131+ [ do word1 0x2C {-,-} E.PTupleEnd

143− spaces

132+ Space.chompAndCheckIndent E.PTupleSpace E.PTupleIndentExpr

144− (pattern, sPos) <- expression

133+ (pattern, end) <- P.specialize E.PTupleExpr expression

145− checkSpace sPos

134+ Space.checkIndent end E.PTupleIndentEnd

146 tupleHelp start firstPattern (pattern : revPatterns)

135 tupleHelp start firstPattern (pattern : revPatterns)

147− , do word1 0x29 {-)-} E.XXX

136+ , do word1 0x29 {-)-} E.PTupleEnd

148 case reverse revPatterns of

137 case reverse revPatterns of

149 [] ->

138 [] ->

150 return firstPattern

139 return firstPattern

151

140

152 secondPattern : otherPatterns ->

141 secondPattern : otherPatterns ->

153− do end <- getPosition

154− return (A.at start end (Src.PTuple firstPattern secondPattern otherPatterns))

142+ addEnd start (Src.PTuple firstPattern secondPattern otherPatterns)

155 ]

143 ]

156

144

157

145

@@ -159,31 +147,29 @@ tupleHelp start firstPattern revPatterns =

159-- LIST

147-- LIST

160

148

161

149

162−list :: A.Position -> Parser Src.Pattern

150+list :: A.Position -> Parser E.Pattern Src.Pattern

163list start =

151list start =

164− inContext E.PatternList (word1 0x5B {-[-} E.XXX) $

152+ inContext E.PList (word1 0x5B {-[-} E.PStart) $

165− do spaces

153+ do Space.chompAndCheckIndent E.PListSpace E.PListIndentOpen

166− oneOf E.XXX

154+ oneOf E.PListOpen

167− [ do (pattern, sPos) <- expression

155+ [ do (pattern, end) <- P.specialize E.PListExpr expression

168− checkSpace sPos

156+ Space.checkIndent end E.PListIndentEnd

169 listHelp start [pattern]

157 listHelp start [pattern]

170− , do word1 0x5D {-]-} E.XXX

158+ , do word1 0x5D {-]-} E.PListEnd

171− end <- getPosition

172− return (A.at start end (Src.PList []))

159+ addEnd start (Src.PList [])

173 ]

160 ]

174

161

175

162

176−listHelp :: A.Position -> [Src.Pattern] -> Parser Src.Pattern

163+listHelp :: A.Position -> [Src.Pattern] -> Parser E.PList Src.Pattern

177listHelp start patterns =

164listHelp start patterns =

178− oneOf E.XXX

165+ oneOf E.PListEnd

179− [ do word1 0x2C {-,-} E.XXX

166+ [ do word1 0x2C {-,-} E.PListEnd

180− spaces

167+ Space.chompAndCheckIndent E.PListSpace E.PListIndentExpr

181− (pattern, sPos) <- expression

168+ (pattern, end) <- P.specialize E.PListExpr expression

182− checkSpace sPos

169+ Space.checkIndent end E.PListIndentEnd

183 listHelp start (pattern:patterns)

170 listHelp start (pattern:patterns)

184− , do word1 0x5D {-]-} E.XXX

171+ , do word1 0x5D {-]-} E.PListEnd

185− end <- getPosition

186− return (A.at start end (Src.PList (reverse patterns)))

172+ addEnd start (Src.PList (reverse patterns))

187 ]

173 ]

188

174

189

175

@@ -191,38 +177,37 @@ listHelp start patterns =

191-- EXPRESSION

177-- EXPRESSION

192

178

193

179

194−expression :: Parser (Src.Pattern, SPos)

180+expression :: Space.Parser E.Pattern Src.Pattern

195expression =

181expression =

196 do start <- getPosition

182 do start <- getPosition

197 cTerm <- exprTerm

183 cTerm <- exprTerm

198 exprHelp start [] cTerm

184 exprHelp start [] cTerm

199

185

200

186

201−exprHelp :: A.Position -> [Src.Pattern] -> (Src.Pattern, A.Position, SPos) -> Parser (Src.Pattern, SPos)

187+exprHelp :: A.Position -> [Src.Pattern] -> (Src.Pattern, A.Position) -> Space.Parser E.Pattern Src.Pattern

202−exprHelp start patterns (pattern, _end, sPos) =

188+exprHelp start patterns (pattern, end) =

203− oneOf E.XXX

189+ oneOfWithFallback

204− [ do checkSpace sPos

190+ [ do Space.checkIndent end E.PIndentStart

205− word1 0x3A {-:-} E.XXX

191+ word2 0x3A 0x3A {-::-} E.PStart

206− spaces

192+ Space.chompAndCheckIndent E.PSpace E.PIndentStart

207 cTerm <- exprTerm

193 cTerm <- exprTerm

208 exprHelp start (pattern:patterns) cTerm

194 exprHelp start (pattern:patterns) cTerm

209− , do checkSpace sPos

195+ , do Space.checkIndent end E.PIndentStart

210− Keyword.as_

196+ Keyword.as_ E.PStart

211− spaces

197+ Space.chompAndCheckIndent E.PSpace E.PIndentAlias

212 nameStart <- getPosition

198 nameStart <- getPosition

213− name <- Var.lower

199+ name <- Var.lower E.PAlias

214 newEnd <- getPosition

200 newEnd <- getPosition

215− newSpace <- whitespace

201+ Space.chomp E.PSpace

216 let alias = A.at nameStart newEnd name

202 let alias = A.at nameStart newEnd name

217 return

203 return

218 ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern patterns) alias)

204 ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern patterns) alias)

219− , newSpace

205+ , newEnd

220 )

206 )

221− , return

222− ( List.foldl' cons pattern patterns

223− , sPos

224− )

225 ]

207 ]

208+ ( List.foldl' cons pattern patterns

209+ , end

210+ )

226

211

227

212

228cons :: Src.Pattern -> Src.Pattern -> Src.Pattern

213cons :: Src.Pattern -> Src.Pattern -> Src.Pattern

@@ -234,38 +219,36 @@ cons tl hd =

234-- EXPRESSION TERM

219-- EXPRESSION TERM

235

220

236

221

237−exprTerm :: SParser Src.Pattern

222+exprTerm :: Space.Parser E.Pattern Src.Pattern

238exprTerm =

223exprTerm =

239− oneOf E.XXX

224+ oneOf E.PStart

240 [

225 [

241 do start <- getPosition

226 do start <- getPosition

242− upper <- Var.foreignUpper

227+ upper <- Var.foreignUpper E.PStart

243 end <- getPosition

228 end <- getPosition

244 exprTermHelp (A.Region start end) upper start []

229 exprTermHelp (A.Region start end) upper start []

245 ,

230 ,

246− do t@(A.At (A.Region _ end) _) <- term

231+ do eterm@(A.At (A.Region _ end) _) <- term

247− pos <- whitespace

232+ Space.chomp E.PSpace

248− return (t, end, pos)

233+ return (eterm, end)

249 ]

234 ]

250

235

251

236

252−exprTermHelp :: A.Region -> Var.Upper -> A.Position -> [Src.Pattern] -> SParser Src.Pattern

237+exprTermHelp :: A.Region -> Var.Upper -> A.Position -> [Src.Pattern] -> Space.Parser E.Pattern Src.Pattern

253exprTermHelp region upper start revArgs =

238exprTermHelp region upper start revArgs =

254 do end <- getPosition

239 do end <- getPosition

255− sPos <- whitespace

240+ Space.chomp E.PSpace

256− oneOf E.XXX

241+ oneOfWithFallback

257− [ do checkSpace sPos

242+ [ do Space.checkIndent end E.PIndentStart

258 arg <- term

243 arg <- term

259 exprTermHelp region upper start (arg:revArgs)

244 exprTermHelp region upper start (arg:revArgs)

260− , return

261− ( A.at start end $

262− case upper of

263− Var.Unqualified name ->

264− Src.PCtor region name (reverse revArgs)

265−

266− Var.Qualified home name ->

267− Src.PCtorQual region home name (reverse revArgs)

268− , end

269− , sPos

270− )

271 ]

245 ]

246+ ( A.at start end $

247+ case upper of

248+ Var.Unqualified name ->

249+ Src.PCtor region name (reverse revArgs)

250+

251+ Var.Qualified home name ->

252+ Src.PCtorQual region home name (reverse revArgs)

253+ , end

254+ )

compiler/src/Parse/Shader.hs+17−17

@@ -10,8 +10,8 @@ import qualified Data.List as List

10import qualified Data.Map as Map

11import qualified Data.Name as Name

12import qualified Data.Utf8 as Utf8

13−import Data.Word (Word8, Word16)

13+import Data.Word (Word8)

14−import Foreign.Ptr (Ptr, plusPtr, minusPtr)

14+import Foreign.Ptr (Ptr, plusPtr)

15import qualified Language.GLSL.Parser as GLP

16import qualified Language.GLSL.Syntax as GLS

17import qualified Text.Parsec as Parsec

@@ -19,7 +19,7 @@ import qualified Text.Parsec.Error as Parsec

20import qualified AST.Source as Src

21import qualified AST.Utils.Shader as Shader

22−import Parse.Utils (Parser)

22+import Parse.Primitives (Parser, Row, Col)

23import qualified Parse.Primitives as P

24import qualified Reporting.Annotation as A

25import qualified Reporting.Error.Syntax as E

@@ -29,7 +29,7 @@ import qualified Reporting.Error.Syntax as E

29-- SHADER

32−shader :: A.Position -> Parser Src.Expr

32+shader :: A.Position -> Parser E.Expr Src.Expr

33shader start@(A.Position row col) =

34 do block <- parseBlock

35 shdr <- parseGlsl row col block

@@ -42,9 +42,9 @@ shader start@(A.Position row col) =

42-- BLOCK

45−parseBlock :: Parser String

45+parseBlock :: Parser E.Expr String

46parseBlock =

47− P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->

47+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->

48 let

49 !pos6 = plusPtr pos 6

50 in

@@ -63,17 +63,17 @@ parseBlock =

63 case status of

64 Good ->

65 let

66− !size = minusPtr newPos pos

66+ !block = Utf8.fromPtr pos newPos

67− !block = error "TODO get a GLSL block" size

67+ !source = Utf8.toChars block

68− !newState = P.State (plusPtr newPos 2) end indent newRow newCol ctx

68+ !newState = P.State (plusPtr newPos 2) end indent newRow newCol

69 in

70− cok block newState

70+ cok source newState

72 Unending ->

73− cerr row col ctx (E.ShaderEnd col (col + 6))

73+ cerr row col E.EndlessShader

75 else

76− eerr row col ctx E.ShaderStart

76+ eerr row col E.Start

79data Status

@@ -81,7 +81,7 @@ data Status

81 | Unending

84−eatShader :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> (# Status, Ptr Word8, Word16, Word16 #)

84+eatShader :: Ptr Word8 -> Ptr Word8 -> Row -> Col -> (# Status, Ptr Word8, Row, Col #)

85eatShader pos end row col =

86 if pos >= end then

87 (# Unending, pos, row, col #)

@@ -103,7 +103,7 @@ eatShader pos end row col =

103-- GLSL

104

105

106−parseGlsl :: Word16 -> Word16 -> String -> Parser Shader.Types

106+parseGlsl :: Row -> Col -> String -> Parser E.Expr Shader.Types

107parseGlsl startRow startCol src =

108 case GLP.parse src of

109 Right (GLS.TranslationUnit decls) ->

@@ -128,10 +128,10 @@ parseGlsl startRow startCol src =

128 else failure (startRow + row - 1) col msg

129

130

131−failure :: Word16 -> Word16 -> String -> Parser a

131+failure :: Row -> Col -> String -> Parser E.Expr a

132failure row col msg =

133− P.Parser $ \(P.State _ _ _ _ _ ctx) _ _ cerr _ ->

133+ P.Parser $ \(P.State _ _ _ _ _) _ _ cerr _ ->

134− cerr row col ctx (E.ShaderProblem msg)

134+ cerr row col (E.ShaderProblem msg)

135

136

137

compiler/src/Parse/Symbol.hs+18−18

@@ -2,7 +2,7 @@

2{-# LANGUAGE BangPatterns, UnboxedTuples, OverloadedStrings #-}

3module Parse.Symbol

4 ( wildcard

5− , binop

5+ , operator

6 )

7 where

@@ -14,7 +14,7 @@ import qualified Data.Vector as Vector

14import Foreign.Ptr (Ptr, plusPtr, minusPtr)

15import GHC.Word (Word8)

17−import Parse.Utils

17+import Parse.Primitives (Parser, Row, Col)

18import qualified Parse.Variable as Var

19import qualified Parse.Primitives as P

20import qualified Reporting.Error.Syntax as E

@@ -24,11 +24,11 @@ import qualified Reporting.Error.Syntax as E

24-- UNDERSCORE

27−wildcard :: Parser ()

27+wildcard :: Parser E.Pattern ()

28wildcard =

29− P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->

29+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->

30 if pos == end || P.unsafeIndex pos /= 0x5F {- _ -} then

31− eerr row col ctx E.Wildcard

31+ eerr row col E.PStart

32 else

33 let

34 !newPos = plusPtr pos 1

@@ -36,34 +36,34 @@ wildcard =

36 in

37 if Var.getInnerWidth newPos end > 0 then

38 let (# _, badCol #) = Var.chompInnerChars newPos end newCol in

39− cerr row col ctx (E.WildcardNotVar newCol badCol)

39+ cerr row col (E.PWildcardNotVar (fromIntegral (badCol - col)))

40 else

41− let !newState = P.State newPos end indent row newCol ctx in

41+ let !newState = P.State newPos end indent row newCol in

42 cok () newState

46−-- BINOP

46+-- OPERATOR

49−binop :: Parser Name.Name

49+operator :: (Row -> Col -> x) -> (E.Operator -> Row -> Col -> x) -> Parser x Name.Name

50−binop =

50+operator toExpectation toError =

51− P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->

51+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->

52 let !newPos = chompOps pos end in

53 if pos == newPos then

54− eerr row col ctx E.XXX

54+ eerr row col toExpectation

56 else

57 case Name.fromPtr pos newPos of

58− "." -> cerr row col ctx (E.ReservedOperator E.Dot)

58+ "." -> cerr row col (toError E.OpDot)

59− "|" -> cerr row col ctx (E.ReservedOperator E.Pipe)

59+ "|" -> cerr row col (toError E.OpPipe)

60− "->" -> cerr row col ctx (E.ReservedOperator E.Arrow)

60+ "->" -> cerr row col (toError E.OpArrow)

61− "=" -> cerr row col ctx (E.ReservedOperator E.Equals)

61+ "=" -> cerr row col (toError E.OpEquals)

62− ":" -> cerr row col ctx (E.ReservedOperator E.HasType)

62+ ":" -> cerr row col (toError E.OpHasType)

63 op ->

64 let

65 !newCol = col + fromIntegral (minusPtr newPos pos)

66− !newState = P.State newPos end indent row newCol ctx

66+ !newState = P.State newPos end indent row newCol

67 in

68 cok op newState

compiler/src/Parse/Type.hs+106−103

@@ -2,7 +2,7 @@

2{-# LANGUAGE OverloadedStrings #-}

3module Parse.Type

4 ( expression

5− , unionConstructor

5+ , variant

6 )

7 where

@@ -10,8 +10,8 @@ module Parse.Type

10import qualified Data.Name as Name

12import qualified AST.Source as Src

13−import Parse.Primitives (addLocation, getPosition, inContext, oneOf, word1, word2)

13+import Parse.Primitives (Parser, addLocation, addEnd, getPosition, inContext, specialize, oneOf, oneOfWithFallback, word1, word2)

14−import Parse.Utils (Parser, SParser, SPos, checkSpace, spaces, whitespace)

14+import qualified Parse.Space as Space

15import qualified Parse.Variable as Var

16import qualified Reporting.Annotation as A

17import qualified Reporting.Error.Syntax as E

@@ -21,13 +21,13 @@ import qualified Reporting.Error.Syntax as E

21-- TYPE TERMS

24−term :: Parser Src.Type

24+term :: Parser E.Type Src.Type

25term =

26 do start <- getPosition

27− oneOf E.XXX

27+ oneOf E.TStart

28 [

29 -- types with no arguments (Int, Float, etc.)

30− do upper <- Var.foreignUpper

30+ do upper <- Var.foreignUpper E.TStart

31 end <- getPosition

32 let region = A.Region start end

33 return $ A.At region $

@@ -39,45 +39,40 @@ term =

39 Src.TTypeQual region home name []

40 ,

41 -- type variables

42− do var <- Var.lower

42+ do var <- Var.lower E.TStart

43− end <- getPosition

44− return (A.at start end (Src.TVar var))

43+ addEnd start (Src.TVar var)

45 ,

44 ,

46 -- tuples

45 -- tuples

47− inContext E.TypeTuple (word1 0x28 {-(-} E.XXX) $

46+ inContext E.TTuple (word1 0x28 {-(-} E.TStart) $

48− oneOf E.XXX

47+ oneOf E.TTupleOpen

49− [ do word1 0x29 {-)-} E.XXX

48+ [ do word1 0x29 {-)-} E.TTupleOpen

50− end <- getPosition

51− return (A.at start end Src.TUnit)

49+ addEnd start Src.TUnit

52− , do spaces

50+ , do Space.chompAndCheckIndent E.TTupleSpace E.TTupleIndentType

53− (tipe, _, pos) <- expression

51+ (tipe, end) <- specialize E.TTupleType expression

54− checkSpace pos

52+ Space.checkIndent end E.TTupleIndentEnd

55− tupleEnding start tipe []

53+ chompTupleEnd start tipe []

56 ]

54 ]

57 ,

55 ,

58 -- records

56 -- records

59− inContext E.TypeRecord (word1 0x7B {- { -} E.XXX) $

57+ inContext E.TRecord (word1 0x7B {- { -} E.TStart) $

60− do spaces

58+ do Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentOpen

61− oneOf E.XXX

59+ oneOf E.TRecordOpen

62− [ do word1 0x7D {-}-} E.XXX

60+ [ do word1 0x7D {-}-} E.TRecordEnd

63− end <- getPosition

64− return (A.at start end (Src.TRecord [] Nothing))

61+ addEnd start (Src.TRecord [] Nothing)

65− , do var <- addLocation Var.lower

62+ , do name <- addLocation (Var.lower E.TRecordField)

66− spaces

63+ Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentColon

67− oneOf E.XXX

64+ oneOf E.TRecordColon

68− [ do word1 0x7C {-|-} E.XXX

65+ [ do word1 0x7C {-|-} E.TRecordColon

69− spaces

66+ Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentField

70− firstField <- field

67+ field <- chompField

71− fields <- chompFields [firstField]

68+ fields <- chompRecordEnd [field]

72− end <- getPosition

73− return (A.at start end (Src.TRecord fields (Just var)))

69+ addEnd start (Src.TRecord fields (Just name))

74− , do word1 0x3A {-:-} E.XXX

70+ , do word1 0x3A {-:-} E.TRecordColon

75− spaces

71+ Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentType

76− (tipe, _, nextPos) <- expression

72+ (tipe, end) <- specialize E.TRecordType expression

77− checkSpace nextPos

73+ Space.checkIndent end E.TRecordIndentEnd

78− fields <- chompFields [(var, tipe)]

74+ fields <- chompRecordEnd [(name, tipe)]

79− end <- getPosition

80− return (A.at start end (Src.TRecord fields Nothing))

75+ addEnd start (Src.TRecord fields Nothing)

81 ]

76 ]

82 ]

77 ]

83 ]

78 ]

@@ -87,37 +82,40 @@ term =

87-- TYPE EXPRESSIONS

82-- TYPE EXPRESSIONS

90−expression :: SParser Src.Type

85+expression :: Space.Parser E.Type Src.Type

91expression =

86expression =

92 do start <- getPosition

87 do start <- getPosition

93− (tipe1, end1, pos1) <-

88+ term1@(tipe1, end1) <-

94− oneOf E.XXX

89+ oneOf E.TStart

95 [ app start

90 [ app start

91+ , do eterm <- term

96− , (,,) <$> term <*> getPosition <*> whitespace

92+ end <- getPosition

93+ Space.chomp E.TSpace

94+ return (eterm, end)

97 ]

95 ]

98− oneOf E.XXX

96+ oneOfWithFallback

99− [ do checkSpace pos1

97+ [ do Space.checkIndent end1 E.TIndentStart -- should never trigger

100− word2 0x2D 0x3E {-->-} E.XXX

98+ word2 0x2D 0x3E {-->-} E.TArrow

101− spaces

99+ Space.chompAndCheckIndent E.TSpace E.TIndentStart

102− (tipe2, end2, pos2) <- expression

100+ (tipe2, end2) <- expression

103 let tipe = A.at start end2 (Src.TLambda tipe1 tipe2)

101 let tipe = A.at start end2 (Src.TLambda tipe1 tipe2)

104− return ( tipe, end2, pos2 )

102+ return ( tipe, end2 )

105− , return ( tipe1, end1, pos1 )

106 ]

103 ]

104+ term1

107

105

108

106

109

107

110-- TYPE CONSTRUCTORS

108-- TYPE CONSTRUCTORS

111

109

112

110

113−app :: A.Position -> SParser Src.Type

111+app :: A.Position -> Space.Parser E.Type Src.Type

114app start =

112app start =

115− do upper <- Var.foreignUpper

113+ do upper <- Var.foreignUpper E.TStart

116− nameEnd <- getPosition

114+ upperEnd <- getPosition

117− namePos <- whitespace

115+ Space.chomp E.TSpace

118− (args, end, pos) <- eatArgs [] nameEnd namePos

116+ (args, end) <- chompArgs [] upperEnd

119

117

120− let region = A.Region start nameEnd

118+ let region = A.Region start upperEnd

121 let tipe =

119 let tipe =

122 case upper of

120 case upper of

123 Var.Unqualified name ->

121 Var.Unqualified name ->

@@ -126,52 +124,40 @@ app start =

126 Var.Qualified home name ->

124 Var.Qualified home name ->

127 Src.TTypeQual region home name args

125 Src.TTypeQual region home name args

128

126

129− return ( A.at start end tipe, end, pos )

127+ return ( A.at start end tipe, end )

130

128

131

129

132−unionConstructor :: SParser (A.Located Name.Name, [Src.Type])

133−unionConstructor =

134− do start <- getPosition

135− name <- Var.upper

136− nameEnd <- getPosition

137− namePos <- whitespace

138− (args, end, pos) <- eatArgs [] nameEnd namePos

139− return ( (A.at start nameEnd name, args), end, pos )

140−

141−

142−eatArgs :: [Src.Type] -> A.Position -> SPos -> SParser [Src.Type]

130+chompArgs :: [Src.Type] -> A.Position -> Space.Parser E.Type [Src.Type]

143−eatArgs args end pos =

131+chompArgs args end =

144− oneOf E.XXX

132+ oneOfWithFallback

145− [ do checkSpace pos

133+ [ do Space.checkIndent end E.TIndentStart

146 arg <- term

134 arg <- term

147 newEnd <- getPosition

135 newEnd <- getPosition

148− newSpace <- whitespace

136+ Space.chomp E.TSpace

149− eatArgs (arg:args) newEnd newSpace

137+ chompArgs (arg:args) newEnd

150− , return ( reverse args, end, pos )

151 ]

138 ]

139+ (reverse args, end)

152

140

153

141

154

142

155-- TUPLES

143-- TUPLES

156

144

157

145

158−tupleEnding :: A.Position -> Src.Type -> [Src.Type] -> Parser Src.Type

146+chompTupleEnd :: A.Position -> Src.Type -> [Src.Type] -> Parser E.TTuple Src.Type

159−tupleEnding start firstType revTypes =

147+chompTupleEnd start firstType revTypes =

160− oneOf E.XXX

148+ oneOf E.TTupleEnd

161− [ do word1 0x2C {-,-} E.XXX

149+ [ do word1 0x2C {-,-} E.TTupleEnd

162− spaces

150+ Space.chompAndCheckIndent E.TTupleSpace E.TTupleIndentType

163− (tipe, _, pos) <- expression

151+ (tipe, end) <- specialize E.TTupleType expression

164− checkSpace pos

152+ Space.checkIndent end E.TTupleIndentEnd

165− tupleEnding start firstType (tipe : revTypes)

153+ chompTupleEnd start firstType (tipe : revTypes)

166− , do word1 0x29 {-)-} E.XXX

154+ , do word1 0x29 {-)-} E.TTupleEnd

167− end <- getPosition

168 case reverse revTypes of

155 case reverse revTypes of

169 [] ->

156 [] ->

170 return firstType

157 return firstType

171

158

172 secondType : otherTypes ->

159 secondType : otherTypes ->

173− return $ A.at start end $

174− Src.TTuple firstType secondType otherTypes

160+ addEnd start (Src.TTuple firstType secondType otherTypes)

175 ]

161 ]

176

162

177

163

@@ -182,24 +168,41 @@ tupleEnding start firstType revTypes =

182type Field = ( A.Located Name.Name, Src.Type )

168type Field = ( A.Located Name.Name, Src.Type )

183

169

184

170

185−chompFields :: [Field] -> Parser [Field]

171+chompRecordEnd :: [Field] -> Parser E.TRecord [Field]

186−chompFields fields =

172+chompRecordEnd fields =

187− oneOf E.XXX

173+ oneOf E.TRecordEnd

188− [ do word1 0x2C {-,-} E.XXX

174+ [ do word1 0x2C {-,-} E.TRecordEnd

189− spaces

175+ Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentField

190− f <- field

176+ field <- chompField

191− chompFields (f : fields)

177+ chompRecordEnd (field : fields)

192− , do word1 0x7D {-}-} E.XXX

178+ , do word1 0x7D {-}-} E.TRecordEnd

193 return (reverse fields)

179 return (reverse fields)

194 ]

180 ]

195

181

196

182

197−field :: Parser Field

183+chompField :: Parser E.TRecord Field

198−field =

184+chompField =

199− do name <- addLocation Var.lower

185+ do name <- addLocation (Var.lower E.TRecordField)

200− spaces

186+ Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentColon

201− word1 0x3A {-:-} E.XXX

187+ word1 0x3A {-:-} E.TRecordColon

202− spaces

188+ Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentType

203− (tipe, _, endPos) <- expression

189+ (tipe, end) <- specialize E.TRecordType expression

204− checkSpace endPos

190+ Space.checkIndent end E.TRecordIndentEnd

205 return (name, tipe)

191 return (name, tipe)

192+

193+

194+

195+-- VARIANT

196+

197+

198+variant :: Space.Parser E.CustomType (A.Located Name.Name, [Src.Type])

199+variant =

200+ do start <- getPosition

201+ name <- Var.upper E.CT_Variant

202+ nameEnd <- getPosition

203+ Space.chomp E.CT_Space

204+ (args, end) <- specialize E.CT_Type (chompArgs [] nameEnd)

205+ return

206+ ( (A.at start nameEnd name, args)

207+ , end

208+ )

compiler/src/Parse/Utf8.hs+57−45

@@ -11,7 +11,7 @@ import qualified Data.Utf8 as Utf8

11import Data.Word (Word8, Word16)

12import Foreign.Ptr (Ptr, plusPtr, minusPtr)

14−import Parse.Utils (Parser)

14+import Parse.Primitives (Parser, Row, Col)

15import qualified Parse.Number as Number

16import qualified Parse.Primitives as P

17import qualified Reporting.Error.Syntax as E

@@ -21,37 +21,41 @@ import qualified Reporting.Error.Syntax as E

21-- CHARACTER

24−character :: Parser Utf8.String

24+character :: (Row -> Col -> x) -> (E.Char -> Row -> Col -> x) -> Parser x Utf8.String

25−character =

25+character toExpectation toError =

26− P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->

26+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->

27 if pos >= end || P.unsafeIndex pos /= 0x27 {- ' -} then

28− eerr row col ctx E.CharStart

28+ eerr row col toExpectation

30 else

31 case chompChar (plusPtr pos 1) end (col + 1) 0 placeholder of

32 Good newPos newCol numChars mostRecent ->

33 if numChars /= 1 then

34− cerr row col ctx (E.CharNotString col newCol)

34+ cerr row col (toError (E.CharNotString (fromIntegral (newCol - col))))

35 else

36 let

37− !newState = P.State newPos end indent row newCol ctx

37+ !newState = P.State newPos end indent row newCol

38 !char = Utf8.fromChunks [mostRecent]

39 in

40 cok char newState

42− Bad newCol x ->

42+ CharEndless newCol ->

43+ cerr row newCol (toError E.CharEndless)

44+

45+ CharEscape newCol escape ->

43− cerr row newCol ctx x

46+ cerr row newCol (toError (E.CharEscape escape))

46data CharResult

49data CharResult

47− = Good (Ptr Word8) Word16 Int Utf8.Chunk

50+ = Good (Ptr Word8) Col Word16 Utf8.Chunk

48− | Bad Word16 E.Expectation

51+ | CharEndless Col

52+ | CharEscape Col E.Escape

51−chompChar :: Ptr Word8 -> Ptr Word8 -> Word16 -> Int -> Utf8.Chunk -> CharResult

55+chompChar :: Ptr Word8 -> Ptr Word8 -> Col -> Word16 -> Utf8.Chunk -> CharResult

52chompChar pos end col numChars mostRecent =

56chompChar pos end col numChars mostRecent =

53 if pos >= end then

57 if pos >= end then

54− Bad col E.CharEnd

58+ CharEndless col

56 else

60 else

57 let

61 let

@@ -61,7 +65,7 @@ chompChar pos end col numChars mostRecent =

61 Good (plusPtr pos 1) (col + 1) numChars mostRecent

65 Good (plusPtr pos 1) (col + 1) numChars mostRecent

63 else if word == 0x0A {- \n -} then

67 else if word == 0x0A {- \n -} then

64− Bad col E.CharEnd

68+ CharEndless col

66 else if word == 0x22 {- " -} then

70 else if word == 0x22 {- " -} then

67 chompChar (plusPtr pos 1) end (col + 1) (numChars + 1) doubleQuote

71 chompChar (plusPtr pos 1) end (col + 1) (numChars + 1) doubleQuote

@@ -74,11 +78,11 @@ chompChar pos end col numChars mostRecent =

74 EscapeUnicode delta code ->

78 EscapeUnicode delta code ->

75 chompChar (plusPtr pos delta) end (col + fromIntegral delta) (numChars + 1) (Utf8.CodePoint code)

79 chompChar (plusPtr pos delta) end (col + fromIntegral delta) (numChars + 1) (Utf8.CodePoint code)

77− EscapeProblem x ->

81+ EscapeProblem badEscape ->

78− Bad col x

82+ CharEscape col badEscape

80 EscapeEndOfFile ->

84 EscapeEndOfFile ->

81− Bad (col + 1) E.CharEnd

85+ CharEndless col

83 else

87 else

84 let

88 let

@@ -92,32 +96,40 @@ chompChar pos end col numChars mostRecent =

92-- STRINGS

96-- STRINGS

95−string :: Parser Utf8.String

99+string :: (Row -> Col -> x) -> (E.String -> Row -> Col -> x) -> Parser x Utf8.String

96−string =

100+string toExpectation toError =

97− P.Parser $ \(P.State pos end indent row col ctx) cok _ cerr eerr ->

101+ P.Parser $ \(P.State pos end indent row col) cok _ cerr eerr ->

98 if isDoubleQuote pos end then

102 if isDoubleQuote pos end then

103

100 let

104 let

101 !pos1 = plusPtr pos 1

105 !pos1 = plusPtr pos 1

102− result =

103− if isDoubleQuote pos1 end && isDoubleQuote (plusPtr pos 2) end then

104− multiString (plusPtr pos 3) end row (col + 3) (plusPtr pos 3) row col mempty

105− else

106− singleString pos1 end row (col + 1) pos1 mempty

107 in

106 in

108− case result of

107+ case

109− Ok newPos newRow newCol utf8 ->

108+ if isDoubleQuote pos1 end then

109+ let !pos2 = plusPtr pos 2 in

110+ if isDoubleQuote pos2 end then

110 let

111 let

111− !newState =

112+ !pos3 = plusPtr pos 3

112− P.State newPos end indent newRow newCol ctx

113+ !col3 = col + 3

113 in

114 in

115+ multiString pos3 end row col3 pos3 row col mempty

116+ else

117+ Ok pos2 row (col + 2) Utf8.empty

118+ else

119+ singleString pos1 end row (col + 1) pos1 mempty

120+ of

121+ Ok newPos newRow newCol utf8 ->

122+ let

123+ !newState =

124+ P.State newPos end indent newRow newCol

125+ in

114− cok utf8 newState

126+ cok utf8 newState

115−

127+

116− Err r c x ->

128+ Err r c x ->

117− cerr r c ctx x

129+ cerr r c (toError x)

118

130

119 else

131 else

120− eerr row col ctx E.StringStart

132+ eerr row col toExpectation

121

133

122

134

123{-# INLINE isDoubleQuote #-}

135{-# INLINE isDoubleQuote #-}

@@ -127,8 +139,8 @@ isDoubleQuote pos end =

127

139

128

140

129data StringResult

141data StringResult

130− = Ok (Ptr Word8) Word16 Word16 Utf8.String

142+ = Ok (Ptr Word8) Row Col !Utf8.String

131− | Err Word16 Word16 E.Expectation

143+ | Err Row Col E.String

132

144

133

145

134finalize :: Ptr Word8 -> Ptr Word8 -> [Utf8.Chunk] -> Utf8.String

146finalize :: Ptr Word8 -> Ptr Word8 -> [Utf8.Chunk] -> Utf8.String

@@ -155,7 +167,7 @@ addEscape chunk start end revChunks =

155singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Utf8.Chunk] -> StringResult

167singleString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> [Utf8.Chunk] -> StringResult

156singleString pos end row col initialPos revChunks =

168singleString pos end row col initialPos revChunks =

157 if pos >= end then

169 if pos >= end then

158− Err row col E.StringEnd_Single

170+ Err row col E.StringEndless_Single

159

171

160 else

172 else

161 let

173 let

@@ -166,7 +178,7 @@ singleString pos end row col initialPos revChunks =

166 finalize initialPos pos revChunks

178 finalize initialPos pos revChunks

167

179

168 else if word == 0x0A {- \n -} then

180 else if word == 0x0A {- \n -} then

169− Err row col E.StringEnd_Single

181+ Err row col E.StringEndless_Single

170

182

171 else if word == 0x27 {- ' -} then

183 else if word == 0x27 {- ' -} then

172 let !newPos = plusPtr pos 1 in

184 let !newPos = plusPtr pos 1 in

@@ -184,10 +196,10 @@ singleString pos end row col initialPos revChunks =

184 addEscape (Utf8.CodePoint code) initialPos pos revChunks

196 addEscape (Utf8.CodePoint code) initialPos pos revChunks

185

197

186 EscapeProblem x ->

198 EscapeProblem x ->

187− Err row col x

199+ Err row col (E.StringEscape x)

188

200

189 EscapeEndOfFile ->

201 EscapeEndOfFile ->

190− Err row (col + 1) E.StringEnd_Single

202+ Err row (col + 1) E.StringEndless_Single

191

203

192 else

204 else

193 let !newPos = plusPtr pos (P.getCharWidth pos end word) in

205 let !newPos = plusPtr pos (P.getCharWidth pos end word) in

@@ -201,7 +213,7 @@ singleString pos end row col initialPos revChunks =

201multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [Utf8.Chunk] -> StringResult

213multiString :: Ptr Word8 -> Ptr Word8 -> Word16 -> Word16 -> Ptr Word8 -> Word16 -> Word16 -> [Utf8.Chunk] -> StringResult

202multiString pos end row col initialPos sr sc revChunks =

214multiString pos end row col initialPos sr sc revChunks =

203 if pos >= end then

215 if pos >= end then

204− Err row col (E.StringEnd_Multi sr sc)

216+ Err sr sc E.StringEndless_Multi

205

217

206 else

218 else

207 let !word = P.unsafeIndex pos in

219 let !word = P.unsafeIndex pos in

@@ -235,10 +247,10 @@ multiString pos end row col initialPos sr sc revChunks =

235 addEscape (Utf8.CodePoint code) initialPos pos revChunks

247 addEscape (Utf8.CodePoint code) initialPos pos revChunks

236

248

237 EscapeProblem x ->

249 EscapeProblem x ->

238− Err row col x

250+ Err row col (E.StringEscape x)

239

251

240 EscapeEndOfFile ->

252 EscapeEndOfFile ->

241− Err row (col + 1) (E.StringEnd_Multi sr sc)

253+ Err sr sc E.StringEndless_Multi

242

254

243 else

255 else

244 let !newPos = plusPtr pos (P.getCharWidth pos end word) in

256 let !newPos = plusPtr pos (P.getCharWidth pos end word) in

@@ -253,7 +265,7 @@ data Escape

253 = EscapeNormal

265 = EscapeNormal

254 | EscapeUnicode !Int !Int

266 | EscapeUnicode !Int !Int

255 | EscapeEndOfFile

267 | EscapeEndOfFile

256− | EscapeProblem E.Expectation

268+ | EscapeProblem E.Escape

257

269

258

270

259eatEscape :: Ptr Word8 -> Ptr Word8 -> Word16 -> Escape

271eatEscape :: Ptr Word8 -> Ptr Word8 -> Word16 -> Escape

@@ -297,7 +309,7 @@ eatUnicode pos end startCol =

297 startCol

309 startCol

298 (startCol + fromIntegral (minusPtr newPos pos) + 1)

310 (startCol + fromIntegral (minusPtr newPos pos) + 1)

299 numDigits

311 numDigits

300− (Utf8.fromPtr digitPos newPos)

312+ code

301

313

302 else

314 else

303 EscapeUnicode (numDigits + 4) code

315 EscapeUnicode (numDigits + 4) code

compiler/src/Parse/Variable.hs+36−38

@@ -17,57 +17,55 @@ module Parse.Variable

17import qualified Data.Char as Char

18import qualified Data.Name as Name

19import qualified Data.Set as Set

20−import Data.Word (Word8, Word16)

20+import Data.Word (Word8)

21import Foreign.Ptr (Ptr, plusPtr)

22import GHC.Exts (Char(C#), Int#, (+#), (-#), chr#, uncheckedIShiftL#, word2Int#)

23import GHC.Word (Word8(W8#))

25import qualified AST.Source as Src

26−import Parse.Utils (Parser)

27−import Parse.Primitives (unsafeIndex)

26+import Parse.Primitives (Parser, Row, Col, unsafeIndex)

28import qualified Parse.Primitives as P

27import qualified Parse.Primitives as P

29−import qualified Reporting.Error.Syntax as E

33-- LOCAL UPPER

31-- LOCAL UPPER

36−upper :: Parser Name.Name

34+upper :: (Row -> Col -> x) -> Parser x Name.Name

37−upper =

35+upper toError =

38− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

36+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

39 let (# newPos, newCol #) = chompUpper pos end col in

37 let (# newPos, newCol #) = chompUpper pos end col in

40 if pos == newPos then

38 if pos == newPos then

41− eerr row col ctx E.Upper

39+ eerr row col toError

42 else

40 else

43 let !name = Name.fromPtr pos newPos in

41 let !name = Name.fromPtr pos newPos in

44− cok name (P.State newPos end indent row newCol ctx)

42+ cok name (P.State newPos end indent row newCol)

48-- LOCAL LOWER

46-- LOCAL LOWER

51−lower :: Parser Name.Name

49+lower :: (Row -> Col -> x) -> Parser x Name.Name

52−lower =

50+lower toError =

53− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

51+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

54 let (# newPos, newCol #) = chompLower pos end col in

52 let (# newPos, newCol #) = chompLower pos end col in

55 if pos == newPos then

53 if pos == newPos then

56− eerr row col ctx E.Lower

54+ eerr row col toError

57 else

55 else

58 let !name = Name.fromPtr pos newPos in

56 let !name = Name.fromPtr pos newPos in

59 if Set.member name reservedWords then

57 if Set.member name reservedWords then

60− eerr row col ctx E.Lower

58+ eerr row col toError

61 else

59 else

62 let

60 let

63 !newState =

61 !newState =

64− P.State newPos end indent row newCol ctx

62+ P.State newPos end indent row newCol

65 in

63 in

66 cok name newState

64 cok name newState

69{-# NOINLINE reservedWords #-}

67{-# NOINLINE reservedWords #-}

70−reservedWords :: Set.Set Name.Name

68+reservedWords :: Set.Set Name.Name -- TODO try using a trie instead

71reservedWords =

69reservedWords =

72 Set.fromList

70 Set.fromList

73 [ "if", "then", "else"

71 [ "if", "then", "else"

@@ -85,9 +83,9 @@ reservedWords =

85-- MODULE NAME

83-- MODULE NAME

88−moduleName :: Parser Name.Name

86+moduleName :: (Row -> Col -> x) -> Parser x Name.Name

89−moduleName =

87+moduleName toError =

90− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

88+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

91 let

89 let

92 (# pos1, col1 #) = chompUpper pos end col

90 (# pos1, col1 #) = chompUpper pos end col

93 (# status, newPos, newCol #) = moduleNameHelp pos1 end col1

91 (# status, newPos, newCol #) = moduleNameHelp pos1 end col1

@@ -96,12 +94,12 @@ moduleName =

96 Good ->

94 Good ->

97 let

95 let

98 !name = Name.fromPtr pos newPos

96 !name = Name.fromPtr pos newPos

99− !newState = P.State newPos end indent row newCol ctx

97+ !newState = P.State newPos end indent row newCol

100 in

98 in

101 cok name newState

99 cok name newState

102

100

103 Bad ->

101 Bad ->

104− eerr row newCol ctx E.ModuleName

102+ eerr row newCol toError

105

103

106

104

107data ModuleNameStatus

105data ModuleNameStatus

@@ -109,7 +107,7 @@ data ModuleNameStatus

109 | Bad

107 | Bad

110

108

111

109

112−moduleNameHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# ModuleNameStatus, Ptr Word8, Word16 #)

110+moduleNameHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# ModuleNameStatus, Ptr Word8, Col #)

113moduleNameHelp pos end col =

111moduleNameHelp pos end col =

114 if isDot pos end then

112 if isDot pos end then

115 let

113 let

@@ -134,15 +132,15 @@ data Upper

134 | Qualified Name.Name Name.Name

132 | Qualified Name.Name Name.Name

135

133

136

134

137−foreignUpper :: Parser Upper

135+foreignUpper :: (Row -> Col -> x) -> Parser x Upper

138−foreignUpper =

136+foreignUpper toError =

139− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

137+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

140 let (# upperStart, upperEnd, newCol #) = foreignUpperHelp pos end col in

138 let (# upperStart, upperEnd, newCol #) = foreignUpperHelp pos end col in

141 if upperStart == upperEnd then

139 if upperStart == upperEnd then

142− eerr row newCol ctx E.Upper

140+ eerr row newCol toError

143 else

141 else

144 let

142 let

145− !newState = P.State upperEnd end indent row newCol ctx

143+ !newState = P.State upperEnd end indent row newCol

146 !name = Name.fromPtr upperStart upperEnd

144 !name = Name.fromPtr upperStart upperEnd

147 !foreign =

145 !foreign =

148 if upperStart == pos then

146 if upperStart == pos then

@@ -154,7 +152,7 @@ foreignUpper =

154 cok foreign newState

152 cok foreign newState

155

153

156

154

157−foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Ptr Word8, Word16 #)

155+foreignUpperHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col #)

158foreignUpperHelp pos end col =

156foreignUpperHelp pos end col =

159 let

157 let

160 (# newPos, newCol #) = chompUpper pos end col

158 (# newPos, newCol #) = chompUpper pos end col

@@ -173,20 +171,20 @@ foreignUpperHelp pos end col =

173-- FOREIGN ALPHA

171-- FOREIGN ALPHA

174

172

175

173

176−foreignAlpha :: Parser Src.Expr_

174+foreignAlpha :: (Row -> Col -> x) -> Parser x Src.Expr_

177−foreignAlpha =

175+foreignAlpha toError =

178− P.Parser $ \(P.State pos end indent row col ctx) cok _ _ eerr ->

176+ P.Parser $ \(P.State pos end indent row col) cok _ _ eerr ->

179 let (# alphaStart, alphaEnd, newCol, varType #) = foreignAlphaHelp pos end col in

177 let (# alphaStart, alphaEnd, newCol, varType #) = foreignAlphaHelp pos end col in

180 if alphaStart == alphaEnd then

178 if alphaStart == alphaEnd then

181− eerr row newCol ctx E.Alpha

179+ eerr row newCol toError

182 else

180 else

183 let

181 let

184− !newState = P.State alphaEnd end indent row newCol ctx

182+ !newState = P.State alphaEnd end indent row newCol

185 !name = Name.fromPtr alphaStart alphaEnd

183 !name = Name.fromPtr alphaStart alphaEnd

186 in

184 in

187 if alphaStart == pos then

185 if alphaStart == pos then

188 if Set.member name reservedWords then

186 if Set.member name reservedWords then

189− eerr row col ctx E.Alpha

187+ eerr row col toError

190 else

188 else

191 cok (Src.Var varType name) newState

189 cok (Src.Var varType name) newState

192 else

190 else

@@ -194,7 +192,7 @@ foreignAlpha =

194 cok (Src.VarQual varType home name) newState

192 cok (Src.VarQual varType home name) newState

195

193

196

194

197−foreignAlphaHelp :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Ptr Word8, Word16, Src.VarType #)

195+foreignAlphaHelp :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Ptr Word8, Col, Src.VarType #)

198foreignAlphaHelp pos end col =

196foreignAlphaHelp pos end col =

199 let

197 let

200 (# lowerPos, lowerCol #) = chompLower pos end col

198 (# lowerPos, lowerCol #) = chompLower pos end col

@@ -234,7 +232,7 @@ isDot pos end =

234-- UPPER CHARS

232-- UPPER CHARS

235

233

236

234

237−chompUpper :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Word16 #)

235+chompUpper :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Col #)

238chompUpper pos end col =

236chompUpper pos end col =

239 let !width = getUpperWidth pos end in

237 let !width = getUpperWidth pos end in

240 if width == 0 then

238 if width == 0 then

@@ -267,7 +265,7 @@ getUpperWidthHelp pos _ word

267-- LOWER CHARS

265-- LOWER CHARS

268

266

269

267

270−chompLower :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Word16 #)

268+chompLower :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Col #)

271chompLower pos end col =

269chompLower pos end col =

272 let !width = getLowerWidth pos end in

270 let !width = getLowerWidth pos end in

273 if width == 0 then

271 if width == 0 then

@@ -300,7 +298,7 @@ getLowerWidthHelp pos _ word

300-- INNER CHARS

298-- INNER CHARS

301

299

302

300

303−chompInnerChars :: Ptr Word8 -> Ptr Word8 -> Word16 -> (# Ptr Word8, Word16 #)

301+chompInnerChars :: Ptr Word8 -> Ptr Word8 -> Col -> (# Ptr Word8, Col #)

304chompInnerChars !pos end !col =

302chompInnerChars !pos end !col =

305 let !width = getInnerWidth pos end in

303 let !width = getInnerWidth pos end in

306 if width == 0 then

304 if width == 0 then