da9e6b7 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Update parser, remove (,,) syntax, and disallow top-level destructures

da9e6b7Evan Czaplicki9 years ago

src/Parse/Declaration.hs+24−19

compare with master

unifiedsplit

@@ -3,11 +3,16 @@

3module Parse.Declaration where

5import Data.Text (Text)

6+import qualified Data.Text.Encoding as Text

7import qualified AST.Declaration as Decl

8import qualified AST.Declaration as Decl

8import qualified AST.Type as Type

9import qualified AST.Type as Type

9import qualified Parse.Expression as Expr

10import qualified Parse.Expression as Expr

10−import Parse.Helpers as Help

11+import Parse.Primitives

12+import qualified Parse.Primitives.Keyword as Keyword

13+import qualified Parse.Primitives.Symbol as Symbol

14+import qualified Parse.Primitives.Variable as Var

15+import qualified Parse.Primitives.Whitespace as W

11import qualified Parse.Type as Type

16import qualified Parse.Type as Type

12import qualified Reporting.Annotation as A

17import qualified Reporting.Annotation as A

13import qualified Reporting.Error.Syntax as E

18import qualified Reporting.Error.Syntax as E

@@ -37,10 +42,10 @@ declaration =

38docDecl :: R.Position -> SParser Decl.Source

43docDecl :: R.Position -> SParser Decl.Source

39docDecl start =

44docDecl start =

40− do comment <- docComment

45+ do doc <- W.docComment

41 end <- getPosition

46 end <- getPosition

42− pos <- whitespace

47+ pos <- W.whitespace

43− return ( Decl.Comment (A.at start end comment), end, pos )

48+ return ( Decl.Comment (A.at start end (Text.decodeUtf8 doc)), end, pos )

46-- TYPE ANNOTATIONS and DEFINITIONS

51-- TYPE ANNOTATIONS and DEFINITIONS

@@ -48,7 +53,7 @@ docDecl start =

49defDecl :: R.Position -> SParser Decl.Source

54defDecl :: R.Position -> SParser Decl.Source

50defDecl start =

55defDecl start =

51− do (def, end, pos) <- Expr.topLevelDef

56+ do (def, end, pos) <- Expr.definition

52 let decl = A.at start end (Decl.Def def)

57 let decl = A.at start end (Decl.Def def)

53 return ( Decl.Whatever decl, end, pos )

58 return ( Decl.Whatever decl, end, pos )

@@ -59,10 +64,10 @@ defDecl start =

60typeDecl :: R.Position -> SParser Decl.Source

65typeDecl :: R.Position -> SParser Decl.Source

61typeDecl start =

66typeDecl start =

62− do keyword "type"

67+ do Keyword.type_

63 spaces

68 spaces

64 oneOf

69 oneOf

65− [ do keyword "alias"

70+ [ do Keyword.alias_

66 inContext start E.TypeAlias $

71 inContext start E.TypeAlias $

67 do spaces

72 do spaces

68 (name, args) <- nameArgsEquals

73 (name, args) <- nameArgsEquals

@@ -80,7 +85,7 @@ typeDecl start =

81nameArgsEquals :: Parser (Text, [Text])

86nameArgsEquals :: Parser (Text, [Text])

82nameArgsEquals =

87nameArgsEquals =

83− do name <- capVar

88+ do name <- Var.upper

84 spaces

89 spaces

85 nameArgsEqualsHelp name []

90 nameArgsEqualsHelp name []

@@ -88,10 +93,10 @@ nameArgsEquals =

88nameArgsEqualsHelp :: Text -> [Text] -> Parser (Text, [Text])

93nameArgsEqualsHelp :: Text -> [Text] -> Parser (Text, [Text])

89nameArgsEqualsHelp name args =

94nameArgsEqualsHelp name args =

90 oneOf

95 oneOf

91− [ do arg <- lowVar

96+ [ do arg <- Var.lower

92 spaces

97 spaces

93 nameArgsEqualsHelp name (arg:args)

98 nameArgsEqualsHelp name (arg:args)

94− , do equals

99+ , do Symbol.equals

95 spaces

100 spaces

96 return ( name, reverse args )

101 return ( name, reverse args )

97 ]

102 ]

@@ -101,7 +106,7 @@ chompConstructors :: [(Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(Tex

101chompConstructors ctors end pos =

106chompConstructors ctors end pos =

102 oneOf

107 oneOf

103 [ do checkSpace pos

108 [ do checkSpace pos

104− pipe

109+ Symbol.pipe

105 spaces

110 spaces

106 (ctor, newEnd, newSpace) <- Type.unionConstructor

111 (ctor, newEnd, newSpace) <- Type.unionConstructor

107 chompConstructors (ctor:ctors) newEnd newSpace

112 chompConstructors (ctor:ctors) newEnd newSpace

@@ -116,11 +121,11 @@ chompConstructors ctors end pos =

116infixDecl :: R.Position -> SParser Decl.Source

121infixDecl :: R.Position -> SParser Decl.Source

117infixDecl start =

122infixDecl start =

118 oneOf

123 oneOf

119− [ do keyword "infixl"

124+ [ do Keyword.infixl_

120 inContext start E.Infix $ infixDeclHelp start Decl.Left

125 inContext start E.Infix $ infixDeclHelp start Decl.Left

121− , do keyword "infixr"

126+ , do Keyword.infixr_

122 inContext start E.Infix $ infixDeclHelp start Decl.Right

127 inContext start E.Infix $ infixDeclHelp start Decl.Right

123− , do keyword "infix"

128+ , do Keyword.infix_

124 inContext start E.Infix $ infixDeclHelp start Decl.Non

129 inContext start E.Infix $ infixDeclHelp start Decl.Non

125 ]

130 ]

126

131

@@ -130,9 +135,9 @@ infixDeclHelp start assoc =

130 do spaces

135 do spaces

131 n <- digit

136 n <- digit

132 spaces

137 spaces

133− op <- infixOp

138+ op <- Symbol.binop

134 end <- getPosition

139 end <- getPosition

135− pos <- whitespace

140+ pos <- W.whitespace

136 let decl = A.at start end (Decl.Fixity (Decl.Infix op assoc n))

141 let decl = A.at start end (Decl.Fixity (Decl.Infix op assoc n))

137 return ( Decl.Whatever decl, end, pos )

142 return ( Decl.Whatever decl, end, pos )

138

143

@@ -143,12 +148,12 @@ infixDeclHelp start assoc =

143

148

144portDecl :: R.Position -> SParser Decl.Source

149portDecl :: R.Position -> SParser Decl.Source

145portDecl start =

150portDecl start =

146− do keyword "port"

151+ do Keyword.port_

147 inContext start E.Port $

152 inContext start E.Port $

148 do spaces

153 do spaces

149− name <- lowVar

154+ name <- Var.lower

150 spaces

155 spaces

151− hasType

156+ Symbol.hasType

152 spaces

157 spaces

153 (tipe, end, pos) <- Type.expression

158 (tipe, end, pos) <- Type.expression

154 let decl = A.at start end (Decl.Port name tipe)

159 let decl = A.at start end (Decl.Port name tipe)

src/Parse/Expression.hs+106−122

@@ -1,13 +1,16 @@

1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2{-# LANGUAGE OverloadedStrings #-}

3−module Parse.Expression (term, expression, topLevelDef) where

3+module Parse.Expression (term, expression, definition) where

5import Control.Monad (guard)

6import qualified Data.List as List

7−import qualified Data.Text as Text

8import Data.Text (Text)

7import Data.Text (Text)

10−import Parse.Helpers

9+import Parse.Primitives

10+import qualified Parse.Primitives.Keyword as Keyword

11+import qualified Parse.Primitives.Symbol as Symbol

12+import qualified Parse.Primitives.Variable as Var

13+import qualified Parse.Primitives.Whitespace as W

11import qualified Parse.Literal as Literal

14import qualified Parse.Literal as Literal

12import qualified Parse.Pattern as Pattern

15import qualified Parse.Pattern as Pattern

13import qualified Parse.Type as Type

16import qualified Parse.Type as Type

@@ -47,26 +50,24 @@ literal start =

48accessor :: R.Position -> Parser Src.RawExpr

51accessor :: R.Position -> Parser Src.RawExpr

49accessor start =

52accessor start =

50− do dot

53+ do Symbol.dot

51− field <- lowVar

54+ field <- Var.lower

52 end <- getPosition

55 end <- getPosition

53− let ann x = A.at start end x

56+ return (A.at start end (Src.Accessor field))

54− let body = ann (Src.Access (ann (Src.var "r")) field)

55− return (mkLambda start end "r" body)

58variable :: R.Position -> Parser Src.RawExpr

59variable :: R.Position -> Parser Src.RawExpr

59variable start =

60variable start =

60− do var <- qualifiedVar

61+ do (maybePrefix, name) <- Var.foreignAlpha

61 end <- getPosition

62 end <- getPosition

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

63+ return (A.at start end (Src.Var maybePrefix name))

65accessible :: R.Position -> Src.RawExpr -> Parser Src.RawExpr

66accessible :: R.Position -> Src.RawExpr -> Parser Src.RawExpr

66accessible start expr =

67accessible start expr =

67 oneOf

68 oneOf

68− [ do dot

69+ [ do Symbol.dot

69− field <- lowVar

70+ field <- Var.lower

70 end <- getPosition

71 end <- getPosition

71 let newExpr = A.at start end (Src.Access expr field)

72 let newExpr = A.at start end (Src.Access expr field)

72 accessible start newExpr

73 accessible start newExpr

@@ -80,14 +81,14 @@ accessible start expr =

81list :: R.Position -> Parser Src.RawExpr

82list :: R.Position -> Parser Src.RawExpr

82list start =

83list start =

83− do leftSquare

84+ do Symbol.leftSquare

84 inContext start E.ExprList $

85 inContext start E.ExprList $

85 do spaces

86 do spaces

86 oneOf

87 oneOf

87 [ do (entry, _, pos) <- expression

88 [ do (entry, _, pos) <- expression

88 checkSpace pos

89 checkSpace pos

89 listHelp start [entry]

90 listHelp start [entry]

90− , do rightSquare

91+ , do Symbol.rightSquare

91 end <- getPosition

92 end <- getPosition

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

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

93 ]

94 ]

@@ -96,12 +97,12 @@ list start =

96listHelp :: R.Position -> [Src.RawExpr] -> Parser Src.RawExpr

97listHelp :: R.Position -> [Src.RawExpr] -> Parser Src.RawExpr

97listHelp start entries =

98listHelp start entries =

98 oneOf

99 oneOf

99− [ do comma

100+ [ do Symbol.comma

100 spaces

101 spaces

101 (entry, _, pos) <- expression

102 (entry, _, pos) <- expression

102 checkSpace pos

103 checkSpace pos

103 listHelp start (entry:entries)

104 listHelp start (entry:entries)

104− , do rightSquare

105+ , do Symbol.rightSquare

105 end <- getPosition

106 end <- getPosition

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

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

107 ]

108 ]

@@ -113,72 +114,50 @@ listHelp start entries =

113

114

114tuple :: R.Position -> Parser Src.RawExpr

115tuple :: R.Position -> Parser Src.RawExpr

115tuple start =

116tuple start =

116− do leftParen

117+ do Symbol.leftParen

117 pos <- getPosition

118 pos <- getPosition

118− spos <- whitespace

119+ spos <- W.whitespace

119 inContext start E.ExprTuple $ oneOf $

120 inContext start E.ExprTuple $ oneOf $

120 [ do noSpace pos spos

121 [ do noSpace pos spos

121− try (minus >> rightParen)

122+ try (Symbol.minus >> Symbol.rightParen)

122 end <- getPosition

123 end <- getPosition

123− return $ A.at start end (Src.var "-")

124+ return $ A.at start end (Src.Op "-")

124

125

125 , do checkSpace spos

126 , do checkSpace spos

126 (entry, _, spos2) <- expression

127 (entry, _, spos2) <- expression

127 checkSpace spos2

128 checkSpace spos2

128− tupleHelp start [entry]

129+ tupleHelp start entry []

129

130

130 , do noSpace pos spos

131 , do noSpace pos spos

131− op <- infixOp

132+ op <- Symbol.binop

132− rightParen

133+ Symbol.rightParen

133 end <- getPosition

134 end <- getPosition

134− return $ A.at start end (Src.var op)

135+ return $ A.at start end (Src.Op op)

135

136

136 , do noSpace pos spos

137 , do noSpace pos spos

137− rightParen

138+ Symbol.rightParen

138 end <- getPosition

139 end <- getPosition

139− return (A.at start end (Src.tuple []))

140+ return (A.at start end Src.Unit)

140

141

141− , do noSpace pos spos

142− comma

143− arity <- chompCommas 2

144− rightParen

145− end <- getPosition

146− let args = map (\n -> Text.pack ("v" ++ show n)) [ 1 .. arity ]

147− let ann x = A.at start end x

148− let result = ann (Src.tuple (map (ann . Src.var) args))

149− return (foldr (mkLambda start end) result args)

150 ]

142 ]

151

143

152

144

153−mkLambda :: R.Position -> R.Position -> Text -> Src.RawExpr -> Src.RawExpr

154−mkLambda start end arg body =

155− A.at start end (Src.Lambda (A.at start end (P.Var arg)) body)

156−

157−

158−chompCommas :: Int -> Parser Int

159−chompCommas n =

160− oneOf

161− [ comma >> chompCommas (n + 1)

162− , return n

163− ]

164−

165−

166−tupleHelp :: R.Position -> [Src.RawExpr] -> Parser Src.RawExpr

145+tupleHelp :: R.Position -> Src.RawExpr -> [Src.RawExpr] -> Parser Src.RawExpr

167−tupleHelp start entries =

146+tupleHelp start firstExpr revExprs =

168 oneOf

147 oneOf

169− [ do comma

148+ [ do Symbol.comma

170 spaces

149 spaces

171 (entry, _, pos) <- expression

150 (entry, _, pos) <- expression

172 checkSpace pos

151 checkSpace pos

173− tupleHelp start (entry:entries)

152+ tupleHelp start firstExpr (entry : revExprs)

174− , do rightParen

153+ , do Symbol.rightParen

175 end <- getPosition

154 end <- getPosition

176− case entries of

155+ case reverse revExprs of

177− [entry] ->

156+ [] ->

178− return entry

157+ return firstExpr

179

158

180− _ ->

159+ secondExpr : others ->

181− return (A.at start end (Src.tuple (reverse entries)))

160+ return (A.at start end (Src.Tuple firstExpr secondExpr others))

182 ]

161 ]

183

162

184

163

@@ -188,23 +167,23 @@ tupleHelp start entries =

188

167

189record :: R.Position -> Parser Src.RawExpr

168record :: R.Position -> Parser Src.RawExpr

190record start =

169record start =

191− do leftCurly

170+ do Symbol.leftCurly

192 inContext start E.ExprRecord $

171 inContext start E.ExprRecord $

193 do spaces

172 do spaces

194 oneOf

173 oneOf

195− [ do rightCurly

174+ [ do Symbol.rightCurly

196 end <- getPosition

175 end <- getPosition

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

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

198− , do starter <- addLocation lowVar

177+ , do starter <- addLocation Var.lower

199 spaces

178 spaces

200 oneOf

179 oneOf

201− [ do pipe

180+ [ do Symbol.pipe

202 spaces

181 spaces

203 firstField <- chompField

182 firstField <- chompField

204 fields <- chompFields [firstField]

183 fields <- chompFields [firstField]

205 end <- getPosition

184 end <- getPosition

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

185+ return (A.at start end (Src.Update starter fields))

207− , do equals

186+ , do Symbol.equals

208 spaces

187 spaces

209 (value, _, nextPos) <- expression

188 (value, _, nextPos) <- expression

210 checkSpace nextPos

189 checkSpace nextPos

@@ -221,20 +200,20 @@ type Field = ( A.Located Text, Src.RawExpr )

221chompFields :: [Field] -> Parser [Field]

200chompFields :: [Field] -> Parser [Field]

222chompFields fields =

201chompFields fields =

223 oneOf

202 oneOf

224− [ do comma

203+ [ do Symbol.comma

225 spaces

204 spaces

226 f <- chompField

205 f <- chompField

227 chompFields (f : fields)

206 chompFields (f : fields)

228− , do rightCurly

207+ , do Symbol.rightCurly

229 return (reverse fields)

208 return (reverse fields)

230 ]

209 ]

231

210

232

211

233chompField :: Parser Field

212chompField :: Parser Field

234chompField =

213chompField =

235− do key <- addLocation lowVar

214+ do key <- addLocation Var.lower

236 spaces

215 spaces

237− equals

216+ Symbol.equals

238 spaces

217 spaces

239 (value, _, pos) <- expression

218 (value, _, pos) <- expression

240 checkSpace pos

219 checkSpace pos

@@ -260,7 +239,7 @@ expression =

260 , function start

239 , function start

261 , do starter <- possiblyNegativeTerm start

240 , do starter <- possiblyNegativeTerm start

262 end <- getPosition

241 end <- getPosition

263− space <- whitespace

242+ space <- W.whitespace

264 exprHelp start (State [] starter end space)

243 exprHelp start (State [] starter end space)

265 ]

244 ]

266

245

@@ -282,17 +261,17 @@ exprHelp start (State ops lastExpr end pos) =

282 do checkSpace pos

261 do checkSpace pos

283 arg <- term

262 arg <- term

284 newEnd <- getPosition

263 newEnd <- getPosition

285− newPos <- whitespace

264+ newPos <- W.whitespace

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

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

287 exprHelp start (State ops newLast newEnd newPos)

266 exprHelp start (State ops newLast newEnd newPos)

288

267

289 , -- infix operator

268 , -- infix operator

290 do checkSpace pos

269 do checkSpace pos

291 opStart <- getPosition

270 opStart <- getPosition

292− opName <- infixOp

271+ opName <- Symbol.binop

293 opEnd <- getPosition

272 opEnd <- getPosition

294 let op = A.at opStart opEnd opName

273 let op = A.at opStart opEnd opName

295− spos <- whitespace

274+ spos <- W.whitespace

296 hint (E.AfterOpExpr opName) (checkSpace spos)

275 hint (E.AfterOpExpr opName) (checkSpace spos)

297 newStart <- getPosition

276 newStart <- getPosition

298 hint (E.AfterOpExpr opName) $ oneOf $

277 hint (E.AfterOpExpr opName) $ oneOf $

@@ -300,7 +279,7 @@ exprHelp start (State ops lastExpr end pos) =

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

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

301 rawTerm <- term

280 rawTerm <- term

302 newEnd <- getPosition

281 newEnd <- getPosition

303− newPos <- whitespace

282+ newPos <- W.whitespace

304

283

305 let ann x = A.merge op rawTerm x

284 let ann x = A.merge op rawTerm x

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

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

@@ -311,7 +290,7 @@ exprHelp start (State ops lastExpr end pos) =

311 , -- term

290 , -- term

312 do newLast <- possiblyNegativeTerm newStart

291 do newLast <- possiblyNegativeTerm newStart

313 newEnd <- getPosition

292 newEnd <- getPosition

314− newPos <- whitespace

293+ newPos <- W.whitespace

315 let newOps = (lastExpr, op) : ops

294 let newOps = (lastExpr, op) : ops

316 exprHelp start (State newOps newLast newEnd newPos)

295 exprHelp start (State newOps newLast newEnd newPos)

317

296

@@ -345,7 +324,7 @@ exprHelp start (State ops lastExpr end pos) =

345possiblyNegativeTerm :: R.Position -> Parser Src.RawExpr

324possiblyNegativeTerm :: R.Position -> Parser Src.RawExpr

346possiblyNegativeTerm start =

325possiblyNegativeTerm start =

347 oneOf

326 oneOf

348− [ do minus

327+ [ do Symbol.minus

349 expr <- term

328 expr <- term

350 end <- getPosition

329 end <- getPosition

351 let ann x = A.at start end x

330 let ann x = A.at start end x

@@ -360,7 +339,7 @@ possiblyNegativeTerm start =

360

339

361if_ :: R.Position -> ExprParser

340if_ :: R.Position -> ExprParser

362if_ start =

341if_ start =

363− do keyword "if"

342+ do Keyword.if_

364 inContext start E.ExprIf $ ifHelp start []

343 inContext start E.ExprIf $ ifHelp start []

365

344

366

345

@@ -369,15 +348,15 @@ ifHelp start branches =

369 do spaces

348 do spaces

370 (condition, _, condPos) <- expression

349 (condition, _, condPos) <- expression

371 checkSpace condPos

350 checkSpace condPos

372− keyword "then"

351+ Keyword.then_

373 spaces

352 spaces

374 (thenBranch, _, thenPos) <- expression

353 (thenBranch, _, thenPos) <- expression

375 hint E.ElseBranch $ checkSpace thenPos

354 hint E.ElseBranch $ checkSpace thenPos

376− hint E.ElseBranch $ keyword "else"

355+ hint E.ElseBranch $ Keyword.else_

377 spaces

356 spaces

378 let newBranches = (condition, thenBranch) : branches

357 let newBranches = (condition, thenBranch) : branches

379 oneOf

358 oneOf

380− [ do keyword "if"

359+ [ do Keyword.if_

381 ifHelp start newBranches

360 ifHelp start newBranches

382 , do (elseBranch, elseEnd, elseSpace) <- expression

361 , do (elseBranch, elseEnd, elseSpace) <- expression

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

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

@@ -391,7 +370,7 @@ ifHelp start branches =

391

370

392function :: R.Position -> ExprParser

371function :: R.Position -> ExprParser

393function start =

372function start =

394− do lambda

373+ do Symbol.lambda

395 inContext start E.ExprFunc $

374 inContext start E.ExprFunc $

396 do spaces

375 do spaces

397 arg <- Pattern.term

376 arg <- Pattern.term

@@ -409,7 +388,7 @@ gatherArgs args =

409 [ do arg <- Pattern.term

388 [ do arg <- Pattern.term

410 spaces

389 spaces

411 gatherArgs (arg:args)

390 gatherArgs (arg:args)

412− , do rightArrow

391+ , do Symbol.rightArrow

413 return args

392 return args

414 ]

393 ]

415

394

@@ -420,12 +399,12 @@ gatherArgs args =

420

399

421case_ :: R.Position -> ExprParser

400case_ :: R.Position -> ExprParser

422case_ start =

401case_ start =

423− do keyword "case"

402+ do Keyword.case_

424 inContext start E.ExprCase $

403 inContext start E.ExprCase $

425 do spaces

404 do spaces

426 (switcher, _, switcherPos) <- expression

405 (switcher, _, switcherPos) <- expression

427 checkSpace switcherPos

406 checkSpace switcherPos

428− keyword "of"

407+ Keyword.of_

429 spaces

408 spaces

430 oldIndent <- getIndent

409 oldIndent <- getIndent

431 newIndent <- getCol

410 newIndent <- getCol

@@ -444,7 +423,7 @@ branchHelp :: SParser (P.Raw, Src.RawExpr)

444branchHelp =

423branchHelp =

445 do (pattern, patternPos) <- Pattern.expression

424 do (pattern, patternPos) <- Pattern.expression

446 checkSpace patternPos

425 checkSpace patternPos

447− rightArrow

426+ Symbol.rightArrow

448 spaces

427 spaces

449 (branchExpr, end, pos) <- expression

428 (branchExpr, end, pos) <- expression

450 return ( (pattern, branchExpr), end, pos )

429 return ( (pattern, branchExpr), end, pos )

@@ -468,7 +447,7 @@ let_ :: R.Position -> ExprParser

468let_ start =

447let_ start =

469 do oldIndent <- getIndent

448 do oldIndent <- getIndent

470 letIndent <- getCol

449 letIndent <- getCol

471− keyword "let"

450+ Keyword.let_

472 pushContext start E.ExprLet

451 pushContext start E.ExprLet

473 setIndent letIndent

452 setIndent letIndent

474 spaces

453 spaces

@@ -487,7 +466,7 @@ letHelp start oldIndent revDefs end pos =

487

466

488 , do setIndent oldIndent

467 , do setIndent oldIndent

489 checkSpace pos

468 checkSpace pos

490− keyword "in"

469+ Keyword.in_

491 popContext ()

470 popContext ()

492 spaces

471 spaces

493 (body, newEnd, newPos) <- expression

472 (body, newEnd, newPos) <- expression

@@ -497,57 +476,62 @@ letHelp start oldIndent revDefs end pos =

497

476

498

477

499

478

500−-- DEFINITIONS

479+-- LET DEFINITIONS

501

480

502

481

503letDef :: SParser Src.RawDef

482letDef :: SParser Src.RawDef

504letDef =

483letDef =

484+ oneOf

505− definition $ \_ -> Pattern.term

485+ [ definition

486+ , destructure

487+ ]

488+

506

489

507

490

508−topLevelDef :: SParser Src.RawDef

491+-- DEFINITION

509−topLevelDef =

510− definition $ \start ->

511− oneOf

512− [ do op <- try (leftParen >> infixOp)

513− rightParen

514− end <- getPosition

515− return (A.at start end (P.Var op))

516− , Pattern.term

517− ]

518

492

519

493

520−definition :: (R.Position -> Parser P.Raw) -> SParser Src.RawDef

494+definition :: SParser Src.RawDef

521−definition parseRoot =

495+definition =

522 do start <- getPosition

496 do start <- getPosition

523− root <- parseRoot start

497+ name <- Var.lower

524 spaces

498 spaces

525− case A.drop root of

526− P.Var name ->

527− oneOf

499+ oneOf

528− [ do hasType

500+ [ do Symbol.hasType

529− inContext start (E.Annotation name) $

501+ inContext start (E.Annotation name) $

530− do spaces

502+ do spaces

531− (tipe, end, space) <- Type.expression

503+ (tipe, end, space) <- Type.expression

532− return ( A.at start end (Src.Annotation name tipe), end, space )

504+ return ( A.at start end (Src.Annotation name tipe), end, space )

533− , inContext start (E.Definition name) $

505+ , inContext start (E.Definition name) $

534− definitionHelp start root []

506+ definitionHelp start name []

535− ]

507+ ]

536−

537− _ ->

538− definitionHelp start root []

539

508

540

509

541−definitionHelp :: R.Position -> P.Raw -> [P.Raw] -> SParser Src.RawDef

510+definitionHelp :: R.Position -> Text -> [P.Raw] -> SParser Src.RawDef

542−definitionHelp start root revArgs =

511+definitionHelp start name revArgs =

543 oneOf

512 oneOf

544 [ do arg <- hint E.Arg Pattern.term

513 [ do arg <- hint E.Arg Pattern.term

545 spaces

514 spaces

546− definitionHelp start root (arg : revArgs)

515+ definitionHelp start name (arg : revArgs)

547− , do equals

516+ , do Symbol.equals

548 spaces

517 spaces

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

518+ (body, end, space) <- expression

550− let body = List.foldl' (\e x -> A.at start end (Src.Lambda x e)) expr revArgs

551− let def = A.at start end (Src.Definition root body)

519+ let def = A.at start end (Src.Definition name (reverse revArgs) body)

552 return ( def, end, space )

520 return ( def, end, space )

553 ]

521 ]

522+

523+

524+

525+-- DESTRUCTURE

526+

527+

528+destructure :: SParser Src.RawDef

529+destructure =

530+ do start <- getPosition

531+ pattern <- Pattern.term

532+ spaces

533+ Symbol.equals

534+ spaces

535+ (expr, end, space) <- expression

536+ let def = A.at start end (Src.Destructure pattern expr)

537+ return ( def, end, space )

src/Parse/Kernel.hs+9−9

@@ -20,8 +20,8 @@ import qualified AST.Module as Module

20import qualified AST.Module.Name as Module

21import Generate.JavaScript.Helpers as Help (toFieldName)

22import Generate.JavaScript.Variable as Var (intToAscii)

23−import Parse.Helpers (Parser)

23+import Parse.Primitives (Parser)

24−import qualified Parse.Helpers as Parse

24+import qualified Parse.Primitives.Kernel as K

25import qualified Parse.Module as Parse

26import qualified Reporting.Annotation as A

@@ -40,20 +40,20 @@ parser =

41parserHelp :: Imports -> Enums -> Fields -> [Kernel.Chunk] -> Parser [Kernel.Chunk]

42parserHelp imports enums fields chunks =

43− do (javascript, maybeTag) <- Parse.kernelChunk

43+ do (javascript, maybeTag) <- K.chunk

44 case maybeTag of

45 Nothing ->

46 return (Kernel.JS javascript : chunks)

48 Just tag ->

49 case tag of

50− Parse.KernelProd ->

50+ K.Prod ->

51 parserHelp imports enums fields (Kernel.Prod : Kernel.JS javascript : chunks)

53− Parse.KernelDebug ->

53+ K.Debug ->

54 parserHelp imports enums fields (Kernel.Debug : Kernel.JS javascript : chunks)

56− Parse.KernelImport var ->

56+ K.Import var ->

57 case Map.lookup var imports of

58 Nothing ->

59 error ("Bad kernel symbol: " ++ Text.unpack var)

@@ -61,17 +61,17 @@ parserHelp imports enums fields chunks =

61 Just (home, name) ->

62 parserHelp imports enums fields (Kernel.Var home name : Kernel.JS javascript : chunks)

64− Parse.KernelEnum n var ->

64+ K.Enum n var ->

65 let

66 (bytes, newEnums) =

67 lookupEnum n var enums

68 in

69 parserHelp imports newEnums fields (Kernel.JS bytes : Kernel.JS javascript : chunks)

71− Parse.KernelElmField name ->

71+ K.ElmField name ->

72 parserHelp imports enums fields (Kernel.Field name : Kernel.JS javascript : chunks)

74− Parse.KernelJsField name ->

74+ K.JsField name ->

75 let

76 (bytes, newFields) =

77 lookupField name fields

src/Parse/Literal.hs+10−10

@@ -13,10 +13,10 @@ import qualified AST.Expression.Source as Src

13import qualified AST.Literal as L

14import qualified Reporting.Annotation as A

15import qualified Reporting.Region as R

16−import Parse.Helpers

17− ( Parser, character, getPosition, number, oneOf

16+import Parse.Primitives (Parser, getPosition, oneOf)

18− , shaderSource, shaderFailure, string

17+import qualified Parse.Primitives.Number as Number

19− )

18+import qualified Parse.Primitives.Shader as Shader

19+import qualified Parse.Primitives.Utf8 as Utf8

@@ -26,9 +26,9 @@ import Parse.Helpers

26literal :: Parser L.Literal

27literal =

28 oneOf

29− [ L.Str <$> string

29+ [ L.Str <$> Utf8.string

30− , L.Chr <$> character

30+ , L.Chr <$> Utf8.character

31− , number

31+ , Number.number

32 ]

@@ -38,7 +38,7 @@ literal =

39shader :: R.Position -> Parser Src.RawExpr

40shader start@(R.Position row col) =

41− do src <- shaderSource

41+ do src <- Shader.block

42 shdr <- parseSource row col (Text.unpack src)

43 end@(R.Position row2 col2) <- getPosition

44 let uid = List.intercalate ":" (map show [row, col, row2, col2])

@@ -66,9 +66,9 @@ parseSource startRow startCol src =

66 (Parsec.errorMessages err)

67 in

68 if row == 1 then

69− shaderFailure startRow (startCol + 6 + col) (Text.pack msg)

69+ Shader.failure startRow (startCol + 6 + col) (Text.pack msg)

70 else

71− shaderFailure (startRow + row - 1) col (Text.pack msg)

71+ Shader.failure (startRow + row - 1) col (Text.pack msg)

74emptyShader :: L.Shader

src/Parse/Module.hs+95−100

@@ -6,11 +6,18 @@ module Parse.Module

6 )

7 where

10+import qualified Data.ByteString as B

9import Data.Text (Text)

11import Data.Text (Text)

11import qualified AST.Exposing as Exposing

13import qualified AST.Exposing as Exposing

12import qualified AST.Module as Module

14import qualified AST.Module as Module

13−import Parse.Helpers

15+import Parse.Primitives (Parser, oneOf)

16+import qualified Parse.Primitives as P

17+import qualified Parse.Primitives.Keyword as Keyword

18+import qualified Parse.Primitives.Symbol as Symbol

19+import qualified Parse.Primitives.Variable as Var

20+import qualified Parse.Primitives.Whitespace as W

14import qualified Reporting.Annotation as A

21import qualified Reporting.Annotation as A

15import qualified Reporting.Error.Syntax as E

22import qualified Reporting.Error.Syntax as E

16import qualified Reporting.Region as R

23import qualified Reporting.Region as R

@@ -28,25 +35,13 @@ header =

29kernelHeader :: Parser [Module.UserImport]

36kernelHeader :: Parser [Module.UserImport]

30kernelHeader =

37kernelHeader =

31− do headerOpen

38+ do Symbol.jsMultiCommentOpen

32 freshLine

39 freshLine

33 imports <- chompImports []

40 imports <- chompImports []

34− headerClose

41+ Symbol.jsMultiCommentClose

35 return imports

42 return imports

38−{-# NOINLINE headerOpen #-}

39−headerOpen :: Parser ()

40−headerOpen =

41− symbol "/*"

42−

43−

44−{-# NOINLINE headerClose #-}

45−headerClose :: Parser ()

46−headerClose =

47− symbol "*/"

48−

49−

51-- HEADER DECL

46-- HEADER DECL

@@ -61,17 +56,17 @@ maybeHeaderDecl =

62headerDecl :: Parser Module.HeaderDecl

57headerDecl :: Parser Module.HeaderDecl

63headerDecl =

58headerDecl =

64− do start <- getPosition

59+ do start <- P.getPosition

65− pushContext start E.Module

60+ P.pushContext start E.Module

66 tag <- sourceTag

61 tag <- sourceTag

67− spaces

62+ P.spaces

68− name <- qualifiedCapVar

63+ name <- Var.moduleName

69− spaces

64+ P.spaces

70 settings <- effectSettings

65 settings <- effectSettings

71− hint E.Exposing $ keyword "exposing"

66+ P.hint E.Exposing $ Keyword.exposing_

72− spaces

67+ P.spaces

73 exports <- exposing exposingEntry

68 exports <- exposing exposingEntry

74− popContext ()

69+ P.popContext ()

75 docs <- maybeDocComment

70 docs <- maybeDocComment

76 return (Module.HeaderDecl tag name exports settings docs)

71 return (Module.HeaderDecl tag name exports settings docs)

@@ -84,21 +79,21 @@ sourceTag :: Parser Module.SourceTag

84sourceTag =

79sourceTag =

85 oneOf

80 oneOf

86 [

81 [

87− do keyword "module"

82+ do Keyword.module_

88 return Module.Normal

83 return Module.Normal

89 ,

84 ,

90− do start <- getPosition

85+ do start <- P.getPosition

91− keyword "port"

86+ Keyword.port_

92− spaces

87+ P.spaces

93− keyword "module"

88+ Keyword.module_

94− end <- getPosition

89+ end <- P.getPosition

95 return (Module.Port (R.Region start end))

90 return (Module.Port (R.Region start end))

96 ,

91 ,

97− do start <- getPosition

92+ do start <- P.getPosition

98− keyword "effect"

93+ Keyword.effect_

99− spaces

94+ P.spaces

100− keyword "module"

95+ Keyword.module_

101− end <- getPosition

96+ end <- P.getPosition

102 return (Module.Effect (R.Region start end))

97 return (Module.Effect (R.Region start end))

103 ]

98 ]

104

@@ -110,13 +105,13 @@ sourceTag =

110effectSettings :: Parser Module.SourceSettings

105effectSettings :: Parser Module.SourceSettings

111effectSettings =

106effectSettings =

112 oneOf

107 oneOf

113− [ do keyword "where"

108+ [ do Keyword.where_

114− spaces

109+ P.spaces

115− start <- getPosition

110+ start <- P.getPosition

116− leftCurly

111+ Symbol.leftCurly

117− spaces

112+ P.spaces

118 entry <- setting

113 entry <- setting

119− spaces

114+ P.spaces

120 effectSettingsHelp start [entry]

115 effectSettingsHelp start [entry]

121 , return Module.emptySettings

116 , return Module.emptySettings

122 ]

117 ]

@@ -125,25 +120,25 @@ effectSettings =

125effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings

120effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings

126effectSettingsHelp start entries =

121effectSettingsHelp start entries =

127 oneOf

122 oneOf

128− [ do comma

123+ [ do Symbol.comma

129− spaces

124+ P.spaces

130 entry <- setting

125 entry <- setting

131− spaces

126+ P.spaces

132 effectSettingsHelp start (entry:entries)

127 effectSettingsHelp start (entry:entries)

133− , do rightCurly

128+ , do Symbol.rightCurly

134− end <- getPosition

129+ end <- P.getPosition

135− spaces

130+ P.spaces

136 return (A.at start end entries)

131 return (A.at start end entries)

137 ]

132 ]

138

133

139

134

140setting :: Parser (A.Located Text, A.Located Text)

135setting :: Parser (A.Located Text, A.Located Text)

141setting =

136setting =

142− do name <- addLocation lowVar

137+ do name <- P.addLocation Var.lower

143− spaces

138+ P.spaces

144− equals

139+ Symbol.equals

145− spaces

140+ P.spaces

146− tipe <- addLocation capVar

141+ tipe <- P.addLocation Var.upper

147 return (name, tipe)

142 return (name, tipe)

148

143

149

144

@@ -151,14 +146,14 @@ setting =

151-- DOC COMMENTS

146-- DOC COMMENTS

152

147

153

148

154−maybeDocComment :: Parser (A.Located (Maybe Text))

149+maybeDocComment :: Parser (A.Located (Maybe B.ByteString))

155maybeDocComment =

150maybeDocComment =

156− do oldEnd <- getPosition

151+ do oldEnd <- P.getPosition

157 freshLine

152 freshLine

158− newStart <- getPosition

153+ newStart <- P.getPosition

159 oneOf

154 oneOf

160− [ do doc <- docComment

155+ [ do doc <- W.docComment

161− end <- getPosition

156+ end <- P.getPosition

162 freshLine

157 freshLine

163 return (A.at newStart end (Just doc))

158 return (A.at newStart end (Just doc))

164 , return (A.at oldEnd newStart Nothing)

159 , return (A.at oldEnd newStart Nothing)

@@ -172,19 +167,19 @@ maybeDocComment =

172chompImports :: [Module.UserImport] -> Parser [Module.UserImport]

167chompImports :: [Module.UserImport] -> Parser [Module.UserImport]

173chompImports imports =

168chompImports imports =

174 oneOf

169 oneOf

175− [ do start <- getPosition

170+ [ do start <- P.getPosition

176− keyword "import"

171+ Keyword.import_

177− pushContext start E.Import

172+ P.pushContext start E.Import

178− spaces

173+ P.spaces

179− name <- addLocation qualifiedCapVar

174+ name <- P.addLocation Var.moduleName

180− end <- getPosition

175+ end <- P.getPosition

181− pos <- whitespace

176+ pos <- W.whitespace

182 oneOf

177 oneOf

183− [ do checkFreshLine pos

178+ [ do P.checkFreshLine pos

184 let userImport = method start end name Nothing Exposing.closed

179 let userImport = method start end name Nothing Exposing.closed

185− popContext ()

180+ P.popContext ()

186 chompImports (userImport:imports)

181 chompImports (userImport:imports)

187− , do checkSpace pos

182+ , do P.checkSpace pos

188 oneOf

183 oneOf

189 [ chompAs start name imports

184 [ chompAs start name imports

190 , chompExposing start name Nothing imports

185 , chompExposing start name Nothing imports

@@ -196,30 +191,30 @@ chompImports imports =

196

191

197chompAs :: R.Position -> A.Located Text -> [Module.UserImport] -> Parser [Module.UserImport]

192chompAs :: R.Position -> A.Located Text -> [Module.UserImport] -> Parser [Module.UserImport]

198chompAs start name imports =

193chompAs start name imports =

199− do keyword "as"

194+ do Keyword.as_

200− spaces

195+ P.spaces

201− alias <- capVar

196+ alias <- Var.upper

202− end <- getPosition

197+ end <- P.getPosition

203− pos <- whitespace

198+ pos <- W.whitespace

204 oneOf

199 oneOf

205− [ do checkFreshLine pos

200+ [ do P.checkFreshLine pos

206 let userImport = method start end name (Just alias) (Exposing.Explicit [])

201 let userImport = method start end name (Just alias) (Exposing.Explicit [])

207− popContext ()

202+ P.popContext ()

208 chompImports (userImport:imports)

203 chompImports (userImport:imports)

209− , do checkSpace pos

204+ , do P.checkSpace pos

210 chompExposing start name (Just alias) imports

205 chompExposing start name (Just alias) imports

211 ]

206 ]

212

207

213

208

214chompExposing :: R.Position -> A.Located Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]

209chompExposing :: R.Position -> A.Located Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]

215chompExposing start name maybeAlias imports =

210chompExposing start name maybeAlias imports =

216− do keyword "exposing"

211+ do Keyword.exposing_

217− spaces

212+ P.spaces

218 exposed <- exposing exposingEntry

213 exposed <- exposing exposingEntry

219− end <- getPosition

214+ end <- P.getPosition

220 freshLine

215 freshLine

221 let userImport = method start end name maybeAlias exposed

216 let userImport = method start end name maybeAlias exposed

222− popContext ()

217+ P.popContext ()

223 chompImports (userImport:imports)

218 chompImports (userImport:imports)

224

219

225

220

@@ -234,17 +229,17 @@ method start end name maybeAlias exposed =

234

229

235exposing :: Parser a -> Parser (Exposing.Exposing a)

230exposing :: Parser a -> Parser (Exposing.Exposing a)

236exposing parser =

231exposing parser =

237− hint E.Listing $

232+ P.hint E.Listing $

238− do leftParen

233+ do Symbol.leftParen

239− spaces

234+ P.spaces

240 oneOf

235 oneOf

241− [ do dot

236+ [ do Symbol.dot

242− dot

237+ Symbol.dot

243− spaces

238+ P.spaces

244− rightParen

239+ Symbol.rightParen

245 return Exposing.Open

240 return Exposing.Open

246− , do value <- addLocation parser

241+ , do value <- P.addLocation parser

247− spaces

242+ P.spaces

248 exposingHelp parser [value]

243 exposingHelp parser [value]

249 ]

244 ]

250

245

@@ -252,12 +247,12 @@ exposing parser =

252exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)

247exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)

253exposingHelp parser values =

248exposingHelp parser values =

254 oneOf

249 oneOf

255− [ do comma

250+ [ do Symbol.comma

256− spaces

251+ P.spaces

257− value <- addLocation parser

252+ value <- P.addLocation parser

258− spaces

253+ P.spaces

259 exposingHelp parser (value:values)

254 exposingHelp parser (value:values)

260− , do rightParen

255+ , do Symbol.rightParen

261 return (Exposing.Explicit (reverse values))

256 return (Exposing.Explicit (reverse values))

262 ]

257 ]

263

258

@@ -265,16 +260,16 @@ exposingHelp parser values =

265exposingEntry :: Parser Exposing.Entry

260exposingEntry :: Parser Exposing.Entry

266exposingEntry =

261exposingEntry =

267 oneOf

262 oneOf

268− [ Exposing.Lower <$> lowVar

263+ [ Exposing.Lower <$> Var.lower

269− , do leftParen

264+ , do Symbol.leftParen

270− op <- infixOp

265+ op <- Symbol.binop

271− rightParen

266+ Symbol.rightParen

272 return (Exposing.Lower op)

267 return (Exposing.Lower op)

273− , do name <- capVar

268+ , do name <- Var.upper

274− spaces

269+ P.spaces

275 Exposing.Upper name <$>

270 Exposing.Upper name <$>

276 oneOf

271 oneOf

277− [ Just <$> exposing capVar

272+ [ Just <$> exposing Var.upper

278 , return Nothing

273 , return Nothing

279 ]

274 ]

280 ]

275 ]

@@ -286,5 +281,5 @@ exposingEntry =

286

281

287freshLine :: Parser ()

282freshLine :: Parser ()

288freshLine =

283freshLine =

289− checkFreshLine =<< whitespace

284+ P.checkFreshLine =<< W.whitespace

290

285

src/Parse/Pattern.hs+90−91

@@ -1,21 +1,30 @@

1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2{-# LANGUAGE OverloadedStrings #-}

3−module Parse.Pattern (term, expression) where

3+module Parse.Pattern

4+ ( term

5+ , expression

6+ )

7+ where

10+import qualified Data.List as List

5import Data.Text (Text)

11import Data.Text (Text)

7import qualified AST.Literal as L

13import qualified AST.Literal as L

8import qualified AST.Pattern as P

14import qualified AST.Pattern as P

9−import qualified AST.Variable as Var

10−import Parse.Helpers

11import qualified Parse.Literal as Literal

15import qualified Parse.Literal as Literal

16+import Parse.Primitives (Parser, SParser, SPos, checkSpace, getPosition, hint, inContext, spaces, oneOf)

17+import qualified Parse.Primitives.Keyword as Keyword

18+import qualified Parse.Primitives.Symbol as Symbol

19+import qualified Parse.Primitives.Variable as Var

20+import Parse.Primitives.Whitespace (whitespace)

12import qualified Reporting.Annotation as A

21import qualified Reporting.Annotation as A

13import qualified Reporting.Error.Syntax as E

22import qualified Reporting.Error.Syntax as E

14import qualified Reporting.Region as R

23import qualified Reporting.Region as R

18−-- PATTERN TERMS

27+-- TERM

21term :: Parser P.Raw

30term :: Parser P.Raw

@@ -34,26 +43,26 @@ termHelp :: R.Position -> Parser P.Raw

34termHelp start =

43termHelp start =

35 do pattern <-

44 do pattern <-

36 oneOf

45 oneOf

37− [ underscore >> return P.Anything

46+ [ Symbol.underscore >> return P.RAnything

38− , P.Var <$> lowVar

47+ , P.RVar <$> Var.lower

39− , mkCtor <$> qualifiedCapVar

48+ , upperTerm <$> Var.foreignUpper

40− , P.Literal <$> Literal.literal

49+ , P.RLiteral <$> Literal.literal

41 ]

50 ]

42 end <- getPosition

51 end <- getPosition

43 return (A.at start end pattern)

52 return (A.at start end pattern)

46−mkCtor :: Text -> P.Raw'

55+upperTerm :: (Maybe Text, Text) -> P.Raw_

47−mkCtor ctor =

56+upperTerm pair =

48− case ctor of

57+ case pair of

49− "True" ->

58+ (Nothing, "True") ->

50− P.Literal (L.Boolean True)

59+ P.RLiteral (L.Boolean True)

52− "False" ->

61+ (Nothing, "False") ->

53− P.Literal (L.Boolean False)

62+ P.RLiteral (L.Boolean False)

55− _ ->

64+ (maybePrefix, name) ->

56− P.Ctor (Var.Raw ctor) []

65+ P.RCtor maybePrefix name []

@@ -62,30 +71,30 @@ mkCtor ctor =

63record :: R.Position -> Parser P.Raw

72record :: R.Position -> Parser P.Raw

64record start =

73record start =

65− do leftCurly

74+ do Symbol.leftCurly

66 inContext start E.ExprRecord $

75 inContext start E.ExprRecord $

67 do spaces

76 do spaces

68 oneOf

77 oneOf

69− [ do var <- lowVar

78+ [ do var <- Var.lower

70 spaces

79 spaces

71 recordHelp start [var]

80 recordHelp start [var]

72− , do rightCurly

81+ , do Symbol.rightCurly

73 end <- getPosition

82 end <- getPosition

74− return (A.at start end (P.Record []))

83+ return (A.at start end (P.RRecord []))

75 ]

84 ]

78recordHelp :: R.Position -> [Text] -> Parser P.Raw

87recordHelp :: R.Position -> [Text] -> Parser P.Raw

79recordHelp start vars =

88recordHelp start vars =

80 oneOf

89 oneOf

81− [ do comma

90+ [ do Symbol.comma

82 spaces

91 spaces

83− var <- lowVar

92+ var <- Var.lower

84 spaces

93 spaces

85 recordHelp start (var:vars)

94 recordHelp start (var:vars)

86− , do rightCurly

95+ , do Symbol.rightCurly

87 end <- getPosition

96 end <- getPosition

88− return (A.at start end (P.Record vars))

97+ return (A.at start end (P.RRecord vars))

89 ]

98 ]

100

@@ -95,35 +104,35 @@ recordHelp start vars =

104

96tuple :: R.Position -> Parser P.Raw

105tuple :: R.Position -> Parser P.Raw

97tuple start =

106tuple start =

98− do leftParen

107+ do Symbol.leftParen

99 inContext start E.ExprTuple $

108 inContext start E.ExprTuple $

100 do spaces

109 do spaces

101 oneOf

110 oneOf

102 [ do (pattern, sPos) <- expression

111 [ do (pattern, sPos) <- expression

103 checkSpace sPos

112 checkSpace sPos

104− tupleHelp start [pattern]

113+ tupleHelp start pattern []

105− , do rightParen

114+ , do Symbol.rightParen

106 end <- getPosition

115 end <- getPosition

107− return (A.at start end (P.tuple []))

116+ return (A.at start end P.RUnit)

108 ]

117 ]

109

118

110

119

111−tupleHelp :: R.Position -> [P.Raw] -> Parser P.Raw

120+tupleHelp :: R.Position -> P.Raw -> [P.Raw] -> Parser P.Raw

112−tupleHelp start patterns =

121+tupleHelp start firstPattern revPatterns =

113 oneOf

122 oneOf

114− [ do comma

123+ [ do Symbol.comma

115 spaces

124 spaces

116 (pattern, sPos) <- expression

125 (pattern, sPos) <- expression

117 checkSpace sPos

126 checkSpace sPos

118− tupleHelp start (pattern:patterns)

127+ tupleHelp start firstPattern (pattern : revPatterns)

119− , do rightParen

128+ , do Symbol.rightParen

120− case patterns of

129+ case reverse revPatterns of

121− [pattern] ->

130+ [] ->

122− return pattern

131+ return firstPattern

123

132

124− _ ->

133+ secondPattern : otherPatterns ->

125 do end <- getPosition

134 do end <- getPosition

126− return (A.at start end (P.tuple (reverse patterns)))

135+ return (A.at start end (P.RTuple firstPattern secondPattern otherPatterns))

127 ]

136 ]

128

137

129

138

@@ -133,110 +142,100 @@ tupleHelp start patterns =

133

142

134list :: R.Position -> Parser P.Raw

143list :: R.Position -> Parser P.Raw

135list start =

144list start =

136− do leftSquare

145+ do Symbol.leftSquare

137 inContext start E.PatternList $

146 inContext start E.PatternList $

138 do spaces

147 do spaces

139 oneOf

148 oneOf

140 [ do (pattern, sPos) <- expression

149 [ do (pattern, sPos) <- expression

141 checkSpace sPos

150 checkSpace sPos

142− listHelp [pattern]

151+ listHelp start [pattern]

143− , do rightSquare

152+ , do Symbol.rightSquare

144 end <- getPosition

153 end <- getPosition

145− return (P.list end [])

154+ return (A.at start end (P.RList []))

146 ]

155 ]

147

156

148

157

149−listHelp :: [P.Raw] -> Parser P.Raw

158+listHelp :: R.Position -> [P.Raw] -> Parser P.Raw

150−listHelp patterns =

159+listHelp start patterns =

151 oneOf

160 oneOf

152− [ do comma

161+ [ do Symbol.comma

153 spaces

162 spaces

154 (pattern, sPos) <- expression

163 (pattern, sPos) <- expression

155 checkSpace sPos

164 checkSpace sPos

156− listHelp (pattern:patterns)

165+ listHelp start (pattern:patterns)

166+ , do Symbol.rightSquare

157− , do end <- getPosition

167+ end <- getPosition

158− rightSquare

159− return (P.list end (reverse patterns))

168+ return (A.at start end (P.RList (reverse patterns)))

160 ]

169 ]

161

170

162

171

163

172

164−-- PATTERN EXPRESSION

173+-- EXPRESSION

165

174

166

175

167expression :: Parser (P.Raw, SPos)

176expression :: Parser (P.Raw, SPos)

168expression =

177expression =

169 hint E.Pattern $

178 hint E.Pattern $

170 do start <- getPosition

179 do start <- getPosition

171− cTerm <- consTerm

180+ cTerm <- exprTerm

172 exprHelp start [] cTerm

181 exprHelp start [] cTerm

173

182

174

183

175−consTerm :: SParser P.Raw

176−consTerm =

177− oneOf

178− [ do start <- getPosition

179− ctor <- qualifiedCapVar

180− case ctor of

181− "True" -> boolEnd start True

182− "False" -> boolEnd start False

183− _ -> constructorHelp start ctor []

184−

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

186− ]

187−

188−

189−boolEnd :: R.Position -> Bool -> SParser P.Raw

190−boolEnd start bool =

191− do end <- getPosition

192− sPos <- whitespace

193− return

194− ( A.at start end $ P.Literal (L.Boolean bool)

195− , end

196− , sPos

197− )

198−

199−

200exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, SPos) -> Parser (P.Raw, SPos)

184exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, SPos) -> Parser (P.Raw, SPos)

201−exprHelp start patterns (pattern, end, sPos) =

185+exprHelp start patterns (pattern, _end, sPos) =

202 oneOf

186 oneOf

203 [ do checkSpace sPos

187 [ do checkSpace sPos

204− cons

188+ Symbol.cons

205 spaces

189 spaces

206− cTerm <- consTerm

190+ cTerm <- exprTerm

207 exprHelp start (pattern:patterns) cTerm

191 exprHelp start (pattern:patterns) cTerm

208 , do checkSpace sPos

192 , do checkSpace sPos

209− keyword "as"

193+ Keyword.as_

210 spaces

194 spaces

211− alias <- lowVar

195+ alias <- Var.lower

212 newEnd <- getPosition

196 newEnd <- getPosition

213 newSpace <- whitespace

197 newSpace <- whitespace

214 return

198 return

215− ( A.at start newEnd (P.Alias alias (foldl (consHelp end) pattern patterns))

199+ ( A.at start newEnd (P.RAlias alias (List.foldl' cons pattern patterns))

216 , newSpace

200 , newSpace

217 )

201 )

218 , return

202 , return

219− ( foldl (consHelp end) pattern patterns

203+ ( List.foldl' cons pattern patterns

220 , sPos

204 , sPos

221 )

205 )

222 ]

206 ]

223

207

224

208

225−consHelp :: R.Position -> P.Raw -> P.Raw -> P.Raw

209+cons :: P.Raw -> P.Raw -> P.Raw

226−consHelp end tl hd@(A.A (R.Region start _) _) =

210+cons tl@(A.A (R.Region _ end) _) hd@(A.A (R.Region start _) _) =

227− A.at start end (P.Ctor (Var.Raw "::") [hd, tl])

211+ A.at start end (P.RCons hd tl)

212+

213+

214+

215+-- EXPRESSION TERM

216+

217+

218+exprTerm :: SParser P.Raw

219+exprTerm =

220+ oneOf

221+ [ do start <- getPosition

222+ pair <- Var.foreignUpper

223+ exprTermHelp start pair []

224+

225+ , (,,) <$> term <*> getPosition <*> whitespace

226+ ]

228

227

229

228

230−constructorHelp :: R.Position -> Text -> [P.Raw] -> SParser P.Raw

229+exprTermHelp :: R.Position -> (Maybe Text, Text) -> [P.Raw] -> SParser P.Raw

231−constructorHelp start ctor args =

230+exprTermHelp start pair@(prefix, name) args =

232 do end <- getPosition

231 do end <- getPosition

233 sPos <- whitespace

232 sPos <- whitespace

234 oneOf

233 oneOf

235 [ do checkSpace sPos

234 [ do checkSpace sPos

236 arg <- term

235 arg <- term

237− constructorHelp start ctor (arg:args)

236+ exprTermHelp start pair (arg:args)

238 , return

237 , return

239− ( A.at start end (P.Ctor (Var.Raw ctor) (reverse args))

238+ ( A.at start end (P.RCtor prefix name (reverse args))

240 , end

239 , end

241 , sPos

240 , sPos

242 )

241 )

src/Parse/Repl.hs+15−15

@@ -7,10 +7,14 @@ module Parse.Repl

7 where

10+import qualified Data.ByteString.UTF8 as Utf8

10import qualified Data.Text as Text

11import qualified Data.Text as Text

11import Data.Text (Text)

12import Data.Text (Text)

13−import Parse.Helpers

14+import Parse.Primitives

15+import qualified Parse.Primitives.Keyword as Keyword

16+import qualified Parse.Primitives.Symbol as Symbol

17+import qualified Parse.Primitives.Variable as Var

14import qualified Parse.Pattern as Pattern

18import qualified Parse.Pattern as Pattern

16import qualified AST.Pattern as P

20import qualified AST.Pattern as P

@@ -28,7 +32,6 @@ data Entry

28 | Other Text

32 | Other Text

29 | Annotation

33 | Annotation

30 | Port

34 | Port

31− | Infix

@@ -41,7 +44,7 @@ parseEntry rawEntry =

41 source =

44 source =

42 Text.pack rawEntry

45 Text.pack rawEntry

43 in

46 in

44− case run (entryParser source) source of

47+ case run (entryParser source) (Utf8.fromString rawEntry) of

45 Right entry ->

48 Right entry ->

46 entry

49 entry

@@ -52,33 +55,30 @@ parseEntry rawEntry =

52entryParser :: Text -> Parser Entry

55entryParser :: Text -> Parser Entry

53entryParser source =

56entryParser source =

54 oneOf

57 oneOf

55− [ do keyword "import"

58+ [ do Keyword.import_

56 spaces

59 spaces

57− name <- qualifiedCapVar

60+ name <- Var.moduleName

58 return (Import (Text.unpack name) source)

61 return (Import (Text.unpack name) source)

60− , do oneOf (map keyword ["infix","infixl","infixr"])

63+ , do Keyword.port_

61− return Infix

62−

63− , do keyword "port"

64 return Port

66− , do keyword "type"

66+ , do Keyword.type_

67 spaces

68 oneOf

69− [ do keyword "alias"

69+ [ do Keyword.alias_

70 spaces

71 , return ()

72 ]

73− name <- capVar

73+ name <- Var.upper

74 return (Type (Text.unpack name) source)

76 , do root <- Pattern.term

77 spaces

78 case A.drop root of

79− P.Var name ->

79+ P.RVar name ->

80 oneOf

81− [ do hasType

81+ [ do Symbol.hasType

82 return Annotation

83 , do chompArgs

84 return (Def (Just (Text.unpack name)) source)

@@ -96,6 +96,6 @@ chompArgs =

96 [ do Pattern.term

97 spaces

98 chompArgs

99− , do equals

99+ , do Symbol.equals

100 return ()

101 ]

src/Parse/Type.hs+48−43

@@ -5,8 +5,12 @@ module Parse.Type (expression, unionConstructor) where

5import Data.Text (Text)

7import qualified AST.Type as Type

8−import qualified AST.Variable as Var

8+import Parse.Primitives (Parser, SParser, addLocation, checkSpace, getPosition, hint, spaces, oneOf)

9−import Parse.Helpers

9+import qualified Parse.Primitives as P

10+import qualified Parse.Primitives.Symbol as Symbol

11+import qualified Parse.Primitives.Variable as Var

12+import Parse.Primitives.Whitespace (SPos, whitespace)

13+

10import qualified Reporting.Annotation as A

14import qualified Reporting.Annotation as A

11import qualified Reporting.Error.Syntax as E

15import qualified Reporting.Error.Syntax as E

12import qualified Reporting.Region as R

16import qualified Reporting.Region as R

@@ -34,7 +38,7 @@ term =

35variable :: R.Position -> Parser Type.Raw

39variable :: R.Position -> Parser Type.Raw

36variable start =

40variable start =

37− do var <- lowVar

41+ do var <- Var.lower

38 end <- getPosition

42 end <- getPosition

39 return (A.at start end (Type.RVar var))

43 return (A.at start end (Type.RVar var))

@@ -54,7 +58,7 @@ expression =

54 ]

58 ]

55 oneOf

59 oneOf

56 [ do checkSpace pos1

60 [ do checkSpace pos1

57− rightArrow

61+ Symbol.rightArrow

58 spaces

62 spaces

59 (tipe2, end2, pos2) <- expression

63 (tipe2, end2, pos2) <- expression

60 let tipe = A.at start end2 (Type.RLambda tipe1 tipe2)

64 let tipe = A.at start end2 (Type.RLambda tipe1 tipe2)

@@ -70,29 +74,29 @@ expression =

70app0 :: Parser Type.Raw

74app0 :: Parser Type.Raw

71app0 =

75app0 =

72 do start <- getPosition

76 do start <- getPosition

73− name <- qualifiedCapVar

77+ (maybeQualifier, name) <- Var.foreignUpper

74 end <- getPosition

78 end <- getPosition

75− return (A.at start end (Type.RType (A.at start end (Var.Raw name)) []))

79+ return $ A.at start end $

80+ Type.RType (R.Region start end) maybeQualifier name []

78app :: R.Position -> SParser Type.Raw

83app :: R.Position -> SParser Type.Raw

79app start =

84app start =

80− do ctor <- qualifiedCapVar

85+ do (maybeQualifier, name) <- Var.foreignUpper

81− ctorEnd <- getPosition

86+ nameEnd <- getPosition

82− let name = A.at start ctorEnd (Var.Raw ctor)

83− ctorPos <- whitespace

87+ namePos <- whitespace

84− (args, end, pos) <- eatArgs [] ctorEnd ctorPos

88+ (args, end, pos) <- eatArgs [] nameEnd namePos

85− let tipe = A.at start end (Type.RType name args)

89+ let tipe = Type.RType (R.Region start nameEnd) maybeQualifier name args

86− return ( tipe, end, pos )

90+ return ( A.at start end tipe, end, pos )

89unionConstructor :: SParser (Text, [Type.Raw])

93unionConstructor :: SParser (Text, [Type.Raw])

90unionConstructor =

94unionConstructor =

91− do ctor <- capVar

95+ do name <- Var.upper

92− ctorEnd <- getPosition

96+ nameEnd <- getPosition

93− ctorSpace <- whitespace

97+ namePos <- whitespace

94− (args, end, space) <- eatArgs [] ctorEnd ctorSpace

98+ (args, end, pos) <- eatArgs [] nameEnd namePos

95− return ( (ctor, args), end, space )

99+ return ( (name, args), end, pos )

100

101

98eatArgs :: [Type.Raw] -> R.Position -> SPos -> SParser [Type.Raw]

102eatArgs :: [Type.Raw] -> R.Position -> SPos -> SParser [Type.Raw]

@@ -113,35 +117,36 @@ eatArgs args end pos =

113

117

114tuple :: R.Position -> Parser Type.Raw

118tuple :: R.Position -> Parser Type.Raw

115tuple start =

119tuple start =

116− do leftParen

120+ do Symbol.leftParen

117− inContext start E.TypeTuple $

121+ P.inContext start E.TypeTuple $

118 oneOf

122 oneOf

119− [ do rightParen

123+ [ do Symbol.rightParen

120 end <- getPosition

124 end <- getPosition

121− return (Type.tuple (R.Region start end) [])

125+ return (A.at start end Type.RUnit)

122 , do spaces

126 , do spaces

123 (tipe, _, pos) <- expression

127 (tipe, _, pos) <- expression

124 checkSpace pos

128 checkSpace pos

125− tupleEnding start [tipe]

129+ tupleEnding start tipe []

126 ]

130 ]

127

131

128

132

129−tupleEnding :: R.Position -> [Type.Raw] -> Parser Type.Raw

133+tupleEnding :: R.Position -> Type.Raw -> [Type.Raw] -> Parser Type.Raw

130−tupleEnding start tipes =

134+tupleEnding start firstType revTypes =

131 oneOf

135 oneOf

132− [ do comma

136+ [ do Symbol.comma

133 spaces

137 spaces

134 (tipe, _, pos) <- expression

138 (tipe, _, pos) <- expression

135 checkSpace pos

139 checkSpace pos

136− tupleEnding start (tipe : tipes)

140+ tupleEnding start firstType (tipe : revTypes)

137− , do rightParen

141+ , do Symbol.rightParen

138 end <- getPosition

142 end <- getPosition

139− case reverse tipes of

143+ case reverse revTypes of

140− [tipe] ->

144+ [] ->

141− return tipe

145+ return firstType

142

146

143− tupleTypes ->

147+ secondType : otherTypes ->

144− return (Type.tuple (R.Region start end) tupleTypes)

148+ return $ A.at start end $

149+ Type.RTuple firstType secondType otherTypes

145 ]

150 ]

146

151

147

152

@@ -151,23 +156,23 @@ tupleEnding start tipes =

151

156

152record :: R.Position -> Parser Type.Raw

157record :: R.Position -> Parser Type.Raw

153record start =

158record start =

154− do leftCurly

159+ do Symbol.leftCurly

155− inContext start E.TypeRecord $

160+ P.inContext start E.TypeRecord $

156 do spaces

161 do spaces

157 oneOf

162 oneOf

158− [ do rightCurly

163+ [ do Symbol.rightCurly

159 end <- getPosition

164 end <- getPosition

160 return (A.at start end (Type.RRecord [] Nothing))

165 return (A.at start end (Type.RRecord [] Nothing))

161− , do var <- addLocation lowVar

166+ , do var <- addLocation Var.lower

162 spaces

167 spaces

163 oneOf

168 oneOf

164− [ do pipe

169+ [ do Symbol.pipe

165 spaces

170 spaces

166 firstField <- field

171 firstField <- field

167 fields <- chompFields [firstField]

172 fields <- chompFields [firstField]

168 end <- getPosition

173 end <- getPosition

169 return (A.at start end (Type.RRecord fields (Just (A.map Type.RVar var))))

174 return (A.at start end (Type.RRecord fields (Just (A.map Type.RVar var))))

170− , do hasType

175+ , do Symbol.hasType

171 spaces

176 spaces

172 (tipe, _, nextPos) <- expression

177 (tipe, _, nextPos) <- expression

173 checkSpace nextPos

178 checkSpace nextPos

@@ -184,20 +189,20 @@ type Field = ( A.Located Text, Type.Raw )

184chompFields :: [Field] -> Parser [Field]

189chompFields :: [Field] -> Parser [Field]

185chompFields fields =

190chompFields fields =

186 oneOf

191 oneOf

187− [ do comma

192+ [ do Symbol.comma

188 spaces

193 spaces

189 f <- field

194 f <- field

190 chompFields (f : fields)

195 chompFields (f : fields)

191− , do rightCurly

196+ , do Symbol.rightCurly

192 return (reverse fields)

197 return (reverse fields)

193 ]

198 ]

194

199

195

200

196field :: Parser Field

201field :: Parser Field

197field =

202field =

198− do name <- addLocation lowVar

203+ do name <- addLocation Var.lower

199 spaces

204 spaces

200− hasType

205+ Symbol.hasType

201 spaces

206 spaces

202 (tipe, _, endPos) <- expression

207 (tipe, _, endPos) <- expression

203 checkSpace endPos

208 checkSpace endPos