087045f · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Update the parser code for AST changes

087045fEvan Czaplicki9 years ago

src/Parse/Declaration.hs+65−63

compare with master

unifiedsplit

@@ -1,13 +1,19 @@

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

2{-# LANGUAGE OverloadedStrings #-}

3−module Parse.Declaration where

3+module Parse.Declaration

4+ ( declaration

5+ )

6+ where

5import Data.Text (Text)

9import Data.Text (Text)

6import qualified Data.Text.Encoding as Text

10import qualified Data.Text.Encoding as Text

8−import qualified AST.Declaration as Decl

12+import qualified AST.Expression.Source as Src

13+import qualified AST.Pattern as Pattern

9import qualified AST.Type as Type

14import qualified AST.Type as Type

10import qualified Parse.Expression as Expr

15import qualified Parse.Expression as Expr

16+import qualified Parse.Pattern as Pattern

11import Parse.Primitives

17import Parse.Primitives

12import qualified Parse.Primitives.Keyword as Keyword

18import qualified Parse.Primitives.Keyword as Keyword

13import qualified Parse.Primitives.Symbol as Symbol

19import qualified Parse.Primitives.Symbol as Symbol

@@ -23,16 +29,15 @@ import qualified Reporting.Region as R

23-- DECLARATION

29-- DECLARATION

26−declaration :: SParser Decl.Source

32+declaration :: SParser Src.Decl

27declaration =

33declaration =

28 hint E.Decl $

34 hint E.Decl $

29 do start <- getPosition

35 do start <- getPosition

30 oneOf

36 oneOf

31− [ docDecl start

32− , typeDecl start

37+ [ doc_ start

33− , infixDecl start

38+ , type_ start

34− , portDecl start

39+ , port_ start

35− , defDecl start

40+ , def_ start

36 ]

41 ]

@@ -40,30 +45,58 @@ declaration =

40-- DOC COMMENTS

45-- DOC COMMENTS

48+{-# INLINE doc_ #-}

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

49+doc_ :: R.Position -> SParser Src.Decl

44−docDecl start =

50+doc_ start =

45 do doc <- W.docComment

51 do doc <- W.docComment

46 end <- getPosition

52 end <- getPosition

47 pos <- W.whitespace

53 pos <- W.whitespace

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

54+ return ( A.at start end (Src.Docs (Text.decodeUtf8 doc)), end, pos )

55+

51−-- TYPE ANNOTATIONS and DEFINITIONS

58+-- DEFINITION and ANNOTATION

61+{-# INLINE def_ #-}

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

62+def_ :: R.Position -> SParser Src.Decl

55−defDecl start =

63+def_ start =

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

64+ do name <- Var.lower

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

65+ nameEnd <- getPosition

66+ let locatedName = A.at start nameEnd name

67+ spaces

68+ oneOf

69+ [ do Symbol.hasType

70+ inContext start (E.Annotation name) $

71+ do spaces

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

73+ return ( A.at start end (Src.Annotation locatedName tipe), end, space )

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

75+ definitionHelp start locatedName []

76+ ]

77+

78+

79+definitionHelp :: R.Position -> A.Located Text -> [Pattern.Raw] -> SParser Src.Decl

80+definitionHelp start name revArgs =

81+ oneOf

82+ [ do arg <- hint E.Arg Pattern.term

83+ spaces

84+ definitionHelp start name (arg : revArgs)

85+ , do Symbol.equals

86+ spaces

87+ (body, end, space) <- Expr.expression

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

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

89+ return ( def, end, space )

90+ ]

62-- TYPE ALIAS and UNION TYPES

94-- TYPE ALIAS and UNION TYPES

97+{-# INLINE type_ #-}

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

98+type_ :: R.Position -> SParser Src.Decl

66−typeDecl start =

99+type_ start =

67 do Keyword.type_

100 do Keyword.type_

68 spaces

101 spaces

69 oneOf

102 oneOf

@@ -72,28 +105,26 @@ typeDecl start =

72 do spaces

105 do spaces

73 (name, args) <- nameArgsEquals

106 (name, args) <- nameArgsEquals

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

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

75− let decl = A.at start end (Decl.Alias (Decl.Type name args tipe))

108+ return ( A.at start end (Src.Alias name args tipe), end, pos )

76− return ( Decl.Whatever decl, end, pos )

77 , inContext start E.TypeUnion $

109 , inContext start E.TypeUnion $

78 do (name, args) <- nameArgsEquals

110 do (name, args) <- nameArgsEquals

79 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

111 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

80 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace

112 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace

81− let decl = A.at start end (Decl.Union (Decl.Type name args ctors))

113+ return ( A.at start end (Src.Union name args ctors), end, pos )

82− return ( Decl.Whatever decl, end, pos )

83 ]

114 ]

115

116

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

117+nameArgsEquals :: Parser (A.Located Text, [A.Located Text])

87nameArgsEquals =

118nameArgsEquals =

88− do name <- Var.upper

119+ do name <- addLocation Var.upper

89 spaces

120 spaces

90 nameArgsEqualsHelp name []

121 nameArgsEqualsHelp name []

122

123

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

124+nameArgsEqualsHelp :: A.Located Text -> [A.Located Text] -> Parser (A.Located Text, [A.Located Text])

94nameArgsEqualsHelp name args =

125nameArgsEqualsHelp name args =

95 oneOf

126 oneOf

96− [ do arg <- Var.lower

127+ [ do arg <- addLocation Var.lower

97 spaces

128 spaces

98 nameArgsEqualsHelp name (arg:args)

129 nameArgsEqualsHelp name (arg:args)

99 , do Symbol.equals

130 , do Symbol.equals

@@ -102,7 +133,7 @@ nameArgsEqualsHelp name args =

102 ]

133 ]

103

134

104

135

105−chompConstructors :: [(Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(Text, [Type.Raw])]

136+chompConstructors :: [(A.Located Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(A.Located Text, [Type.Raw])]

106chompConstructors ctors end pos =

137chompConstructors ctors end pos =

107 oneOf

138 oneOf

108 [ do checkSpace pos

139 [ do checkSpace pos

@@ -115,47 +146,18 @@ chompConstructors ctors end pos =

115

146

116

147

117

148

118−-- INFIX

149+-- PORT

119

150

120

151

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

152+{-# INLINE port_ #-}

122−infixDecl start =

123− oneOf

124− [ do Keyword.infixl_

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

126− , do Keyword.infixr_

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

128− , do Keyword.infix_

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

130− ]

131−

132−

133−infixDeclHelp :: R.Position -> Decl.Assoc -> SParser Decl.Source

153+port_ :: R.Position -> SParser Src.Decl

134−infixDeclHelp start assoc =

135− do spaces

136− n <- digit

137− spaces

138− op <- Symbol.binop

139− end <- getPosition

140− pos <- W.whitespace

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

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

143−

144−

145−

146−-- FOREIGN

147−

148−

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

150−portDecl start =

154+port_ start =

151 do Keyword.port_

155 do Keyword.port_

152 inContext start E.Port $

156 inContext start E.Port $

153 do spaces

157 do spaces

154− name <- Var.lower

158+ name <- addLocation Var.lower

155 spaces

159 spaces

156 Symbol.hasType

160 Symbol.hasType

157 spaces

161 spaces

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

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

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

163+ return ( A.at start end (Src.Port name tipe), end, pos )

160− return ( Decl.Whatever decl, end, pos )

161−

src/Parse/Expression.hs+57−52

@@ -1,6 +1,10 @@

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

2{-# LANGUAGE OverloadedStrings #-}

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

3+module Parse.Expression

4+ ( expression

5+ )

6+ where

5import Control.Monad (guard)

9import Control.Monad (guard)

6import qualified Data.List as List

10import qualified Data.List as List

@@ -26,7 +30,7 @@ import qualified Reporting.Region as R

26-- TERMS

30-- TERMS

29−term :: Parser Src.RawExpr

33+term :: Parser Src.Expr

30term =

34term =

31 hint E.Expr $

35 hint E.Expr $

32 do start <- getPosition

36 do start <- getPosition

@@ -41,14 +45,14 @@ term =

41 ]

45 ]

44−literal :: R.Position -> Parser Src.RawExpr

48+literal :: R.Position -> Parser Src.Expr

45literal start =

49literal start =

46 do value <- Literal.literal

50 do value <- Literal.literal

47 end <- getPosition

51 end <- getPosition

48 return (A.at start end (Src.Literal value))

52 return (A.at start end (Src.Literal value))

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

55+accessor :: R.Position -> Parser Src.Expr

52accessor start =

56accessor start =

53 do Symbol.dot

57 do Symbol.dot

54 field <- Var.lower

58 field <- Var.lower

@@ -56,14 +60,14 @@ accessor start =

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

60 return (A.at start end (Src.Accessor field))

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

63+variable :: R.Position -> Parser Src.Expr

60variable start =

64variable start =

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

65 do (maybePrefix, name) <- Var.foreignAlpha

62 end <- getPosition

66 end <- getPosition

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

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

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

70+accessible :: R.Position -> Src.Expr -> Parser Src.Expr

67accessible start expr =

71accessible start expr =

68 oneOf

72 oneOf

69 [ do Symbol.dot

73 [ do Symbol.dot

@@ -79,7 +83,7 @@ accessible start expr =

79-- LISTS

83-- LISTS

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

86+list :: R.Position -> Parser Src.Expr

83list start =

87list start =

84 do Symbol.leftSquare

88 do Symbol.leftSquare

85 inContext start E.ExprList $

89 inContext start E.ExprList $

@@ -94,7 +98,7 @@ list start =

94 ]

98 ]

100

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

101+listHelp :: R.Position -> [Src.Expr] -> Parser Src.Expr

98listHelp start entries =

102listHelp start entries =

99 oneOf

103 oneOf

100 [ do Symbol.comma

104 [ do Symbol.comma

@@ -112,7 +116,7 @@ listHelp start entries =

112-- TUPLES

116-- TUPLES

113

117

114

118

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

119+tuple :: R.Position -> Parser Src.Expr

116tuple start =

120tuple start =

117 do Symbol.leftParen

121 do Symbol.leftParen

118 pos <- getPosition

122 pos <- getPosition

@@ -142,7 +146,7 @@ tuple start =

142 ]

146 ]

143

147

144

148

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

149+tupleHelp :: R.Position -> Src.Expr -> [Src.Expr] -> Parser Src.Expr

146tupleHelp start firstExpr revExprs =

150tupleHelp start firstExpr revExprs =

147 oneOf

151 oneOf

148 [ do Symbol.comma

152 [ do Symbol.comma

@@ -165,7 +169,7 @@ tupleHelp start firstExpr revExprs =

165-- RECORDS

169-- RECORDS

166

170

167

171

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

172+record :: R.Position -> Parser Src.Expr

169record start =

173record start =

170 do Symbol.leftCurly

174 do Symbol.leftCurly

171 inContext start E.ExprRecord $

175 inContext start E.ExprRecord $

@@ -194,7 +198,7 @@ record start =

194 ]

198 ]

195

199

196

200

197−type Field = ( A.Located Text, Src.RawExpr )

201+type Field = ( A.Located Text, Src.Expr )

198

202

199

203

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

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

@@ -225,7 +229,7 @@ chompField =

225

229

226

230

227type ExprParser =

231type ExprParser =

228− SParser Src.RawExpr

232+ SParser Src.Expr

229

233

230

234

231expression :: ExprParser

235expression :: ExprParser

@@ -237,24 +241,25 @@ expression =

237 , if_ start

241 , if_ start

238 , case_ start

242 , case_ start

239 , function start

243 , function start

240− , do starter <- possiblyNegativeTerm start

244+ , do expr <- possiblyNegativeTerm start

241 end <- getPosition

245 end <- getPosition

242 space <- W.whitespace

246 space <- W.whitespace

243− exprHelp start (State [] starter end space)

247+ exprHelp start (State [] expr [] end space)

244 ]

248 ]

245

249

246

250

247data State =

251data State =

248 State

252 State

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

253+ { _ops :: ![(Src.Expr, A.Located Text)]

250− , _last :: !Src.RawExpr

254+ , _expr :: !Src.Expr

255+ , _args :: ![Src.Expr]

251 , _end :: !R.Position

256 , _end :: !R.Position

252 , _pos :: !SPos

257 , _pos :: !SPos

253 }

258 }

254

259

255

260

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

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

257−exprHelp start (State ops lastExpr end pos) =

262+exprHelp start (State ops expr args end pos) =

258 oneOf

263 oneOf

259 [ -- argument

264 [ -- argument

260 hint E.Arg $

265 hint E.Arg $

@@ -262,8 +267,7 @@ exprHelp start (State ops lastExpr end pos) =

262 arg <- term

267 arg <- term

263 newEnd <- getPosition

268 newEnd <- getPosition

264 newPos <- W.whitespace

269 newPos <- W.whitespace

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

266− exprHelp start (State ops newLast newEnd newPos)

270+ exprHelp start (State ops expr (arg:args) newEnd newPos)

267

271

268 , -- infix operator

272 , -- infix operator

269 do checkSpace pos

273 do checkSpace pos

@@ -280,19 +284,15 @@ exprHelp start (State ops lastExpr end pos) =

280 rawTerm <- term

284 rawTerm <- term

281 newEnd <- getPosition

285 newEnd <- getPosition

282 newPos <- W.whitespace

286 newPos <- W.whitespace

283−

287+ let arg = A.at opStart newEnd (Src.Negate rawTerm)

284− let ann x = A.merge op rawTerm x

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

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

287−

288− exprHelp start (State ops newLast newEnd newPos)

288+ exprHelp start (State ops expr (arg:args) newEnd newPos)

289

290 , -- term

291− do newLast <- possiblyNegativeTerm newStart

291+ do newExpr <- possiblyNegativeTerm newStart

292 newEnd <- getPosition

293 newPos <- W.whitespace

294− let newOps = (lastExpr, op) : ops

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

295− exprHelp start (State newOps newLast newEnd newPos)

295+ exprHelp start (State newOps newExpr [] newEnd newPos)

296

297 , -- final term

298 do (newLast, newEnd, newPos) <-

@@ -302,37 +302,43 @@ exprHelp start (State ops lastExpr end pos) =

302 , if_ newStart

303 , function newStart

304 ]

305− let newOps = (lastExpr, op) : ops

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

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

306+ let finalExpr = A.at start newEnd (Src.Binops (reverse newOps) newLast)

307 return ( finalExpr, newEnd, newPos )

308 ]

309

310 , -- done

311+ let finalExpr = toCall expr args in

311 case ops of

312 case ops of

312 [] ->

313 [] ->

313− return ( lastExpr, end, pos )

314+ return ( finalExpr, end, pos )

314

315

315 _ ->

316 _ ->

316− let

317− finalExpr =

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

317+ return ( A.at start end (Src.Binops (reverse ops) finalExpr), end, pos )

319− in

320− return ( finalExpr, end, pos )

321 ]

318 ]

322

319

323

320

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

321+possiblyNegativeTerm :: R.Position -> Parser Src.Expr

325possiblyNegativeTerm start =

322possiblyNegativeTerm start =

326 oneOf

323 oneOf

327 [ do Symbol.minus

324 [ do Symbol.minus

328 expr <- term

325 expr <- term

329 end <- getPosition

326 end <- getPosition

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

327+ return (A.at start end (Src.Negate expr))

331− return (ann (Src.Binop [(ann Src.zero, ann "-")] expr))

332 , term

328 , term

333 ]

329 ]

334

330

335

331

332+toCall :: Src.Expr -> [Src.Expr] -> Src.Expr

333+toCall func revArgs =

334+ case revArgs of

335+ [] ->

336+ func

337+

338+ lastArg : _ ->

339+ A.merge func lastArg (Src.Call func (reverse revArgs))

340+

341+

336

342

337-- IF EXPRESSION

343-- IF EXPRESSION

338

344

@@ -343,7 +349,7 @@ if_ start =

343 inContext start E.ExprIf $ ifHelp start []

349 inContext start E.ExprIf $ ifHelp start []

344

350

345

351

346−ifHelp :: R.Position -> [(Src.RawExpr, Src.RawExpr)] -> ExprParser

352+ifHelp :: R.Position -> [(Src.Expr, Src.Expr)] -> ExprParser

347ifHelp start branches =

353ifHelp start branches =

348 do spaces

354 do spaces

349 (condition, _, condPos) <- expression

355 (condition, _, condPos) <- expression

@@ -419,7 +425,7 @@ case_ start =

419 )

425 )

420

426

421

427

422−branchHelp :: SParser (P.Raw, Src.RawExpr)

428+branchHelp :: SParser (P.Raw, Src.Expr)

423branchHelp =

429branchHelp =

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

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

425 checkSpace patternPos

431 checkSpace patternPos

@@ -429,7 +435,7 @@ branchHelp =

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

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

430

436

431

437

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

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

433caseHelp branches end pos =

439caseHelp branches end pos =

434 oneOf

440 oneOf

435 [ do checkAligned pos

441 [ do checkAligned pos

@@ -457,7 +463,7 @@ let_ start =

457 letHelp start oldIndent [def] end space

463 letHelp start oldIndent [def] end space

458

464

459

465

460−letHelp :: R.Position -> Int -> [Src.RawDef] -> R.Position -> SPos -> ExprParser

466+letHelp :: R.Position -> Int -> [A.Located Src.Def] -> R.Position -> SPos -> ExprParser

461letHelp start oldIndent revDefs end pos =

467letHelp start oldIndent revDefs end pos =

462 oneOf

468 oneOf

463 [ do checkAligned pos

469 [ do checkAligned pos

@@ -479,7 +485,7 @@ letHelp start oldIndent revDefs end pos =

479-- LET DEFINITIONS

485-- LET DEFINITIONS

480

486

481

487

482−letDef :: SParser Src.RawDef

488+letDef :: SParser (A.Located Src.Def)

483letDef =

489letDef =

484 oneOf

490 oneOf

485 [ definition

491 [ definition

@@ -491,7 +497,7 @@ letDef =

491-- DEFINITION

497-- DEFINITION

492

498

493

499

494−definition :: SParser Src.RawDef

500+definition :: SParser (A.Located Src.Def)

495definition =

501definition =

496 do start <- getPosition

502 do start <- getPosition

497 name <- Var.lower

503 name <- Var.lower

@@ -501,13 +507,13 @@ definition =

501 inContext start (E.Annotation name) $

507 inContext start (E.Annotation name) $

502 do spaces

508 do spaces

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

509 (tipe, end, space) <- Type.expression

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

510+ return ( A.at start end (Src.Annotate name tipe), end, space )

505 , inContext start (E.Definition name) $

511 , inContext start (E.Definition name) $

506 definitionHelp start name []

512 definitionHelp start name []

507 ]

513 ]

508

514

509

515

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

516+definitionHelp :: R.Position -> Text -> [P.Raw] -> SParser (A.Located Src.Def)

511definitionHelp start name revArgs =

517definitionHelp start name revArgs =

512 oneOf

518 oneOf

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

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

@@ -516,7 +522,7 @@ definitionHelp start name revArgs =

516 , do Symbol.equals

522 , do Symbol.equals

517 spaces

523 spaces

518 (body, end, space) <- expression

524 (body, end, space) <- expression

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

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

520 return ( def, end, space )

526 return ( def, end, space )

521 ]

527 ]

522

528

@@ -525,7 +531,7 @@ definitionHelp start name revArgs =

525-- DESTRUCTURE

531-- DESTRUCTURE

526

532

527

533

528−destructure :: SParser Src.RawDef

534+destructure :: SParser (A.Located Src.Def)

529destructure =

535destructure =

530 do start <- getPosition

536 do start <- getPosition

531 pattern <- Pattern.term

537 pattern <- Pattern.term

@@ -533,5 +539,4 @@ destructure =

533 Symbol.equals

539 Symbol.equals

534 spaces

540 spaces

535 (expr, end, space) <- expression

541 (expr, end, space) <- expression

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

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

537− return ( def, end, space )

src/Parse/Kernel.hs+8−5

@@ -22,7 +22,7 @@ import Generate.JavaScript.Helpers as Help (toFieldName)

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

23import Parse.Primitives (Parser)

24import qualified Parse.Primitives.Kernel as K

25−import qualified Parse.Module as Parse

25+import qualified Parse.Module as Module

26import qualified Reporting.Annotation as A

@@ -32,8 +32,11 @@ import qualified Reporting.Annotation as A

33parser :: Parser Kernel.Content

34parser =

35− do header <- Parse.kernelHeader

35+ do Symbol.jsMultiCommentOpen

36+ freshLine

37+ rawImports <- chompImports []

38+ Symbol.jsMultiCommentClose

36− let imports = Map.unions (map headerToImport header)

39+ let imports = Map.unions (map destructImport rawImports)

37 chunks <- parserHelp imports Map.empty Map.empty []

40 chunks <- parserHelp imports Map.empty Map.empty []

38 return (Kernel.Content (Map.elems imports) chunks)

41 return (Kernel.Content (Map.elems imports) chunks)

@@ -135,8 +138,8 @@ type Imports =

135 Map.Map Text (Module.Raw, Text)

138 Map.Map Text (Module.Raw, Text)

136

139

137

140

138−headerToImport :: Module.UserImport -> Imports

141+destructImport :: Import.ByUser -> Imports

139−headerToImport (A.A _ ( A.A _ fullName, Module.ImportMethod maybeAlias exposed )) =

142+destructImport (A.A _ ( A.A _ fullName, Module.ImportMethod maybeAlias exposed )) =

140 let

143 let

141 shortName =

144 shortName =

142 case maybeAlias of

145 case maybeAlias of

src/Parse/Literal.hs+1−1

@@ -36,7 +36,7 @@ literal =

36-- SHADERS

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

39+shader :: R.Position -> Parser Src.Expr

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

41 do src <- Shader.block

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

src/Parse/Module.hs+141−132

@@ -1,8 +1,8 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module Parse.Module

4− ( header

4+ ( module_

5− , kernelHeader

5+ , chompImports

6 )

7 where

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

10import qualified Data.ByteString as B

11import Data.Text (Text)

13−import qualified AST.Exposing as Exposing

13+import qualified AST.Expression.Source as Src

14−import qualified AST.Module as Module

14+import qualified Elm.Name as N

15import Parse.Primitives (Parser, oneOf)

16import qualified Parse.Primitives as P

17import qualified Parse.Primitives.Keyword as Keyword

@@ -24,122 +24,131 @@ import qualified Reporting.Region as R

27−-- MODULE HEADER

27+-- HEADER

30−header :: Parser (Module.Header [Module.UserImport])

30+module_ :: Parser decls -> Parser (Src.Module decls)

31−header =

31+module_ chompDecls =

32 do freshLine

33− Module.Header <$> maybeHeaderDecl <*> chompImports []

34−

35−

36−kernelHeader :: Parser [Module.UserImport]

37−kernelHeader =

38− do Symbol.jsMultiCommentOpen

39− freshLine

40− imports <- chompImports []

41− Symbol.jsMultiCommentClose

42− return imports

43−

44−

45−

46−-- HEADER DECL

47−

48−

49−maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)

50−maybeHeaderDecl =

51− oneOf

33+ oneOf

52− [ Just <$> headerDecl

53− , return Nothing

54− ]

55−

56−

57−headerDecl :: Parser Module.HeaderDecl

58−headerDecl =

59− do start <- P.getPosition

34+ [ do start <- P.getPosition

60− P.pushContext start E.Module

35+ P.pushContext start E.Module

61− tag <- sourceTag

36+ (name, effects) <- chompNameAndEffects

62− P.spaces

63− name <- Var.moduleName

64− P.spaces

65− settings <- effectSettings

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

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

67− P.spaces

38+ P.spaces

68− exports <- exposing exposingEntry

39+ exports <- exposing

69− P.popContext ()

40+ P.popContext ()

70− docs <- maybeDocComment

41+ docs <- maybeDocComment

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

42+ imports <- chompImports []

72−

43+ decls <- chompDecls

73−

44+ return (Src.Module name effects docs exports imports decls)

45+ , Src.defaultModule

46+ <$> chompImports []

47+ <*> chompDecls

48+ ]

75−-- MODULE TAGS - module, effect module, port module

78−sourceTag :: Parser Module.SourceTag

52+-- MODULE NAME

79−sourceTag =

53+--

54+-- module MyThing

55+-- port module MyThing

56+-- effect module MyThing where { command = MyCmd }

57+--

58+chompNameAndEffects :: Parser (N.Name, Src.Effects)

59+chompNameAndEffects =

80 oneOf

60 oneOf

81 [

61 [

82 do Keyword.module_

62 do Keyword.module_

83− return Module.Normal

63+ P.spaces

64+ name <- Var.moduleName

65+ P.spaces

66+ return ( name, Src.NoEffects )

84 ,

67 ,

85 do start <- P.getPosition

68 do start <- P.getPosition

86 Keyword.port_

69 Keyword.port_

87 P.spaces

70 P.spaces

88 Keyword.module_

71 Keyword.module_

89 end <- P.getPosition

72 end <- P.getPosition

73+ P.spaces

74+ name <- Var.moduleName

75+ P.spaces

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

76+ return ( name, Src.Ports (R.Region start end) )

91 ,

77 ,

92 do start <- P.getPosition

78 do start <- P.getPosition

93 Keyword.effect_

79 Keyword.effect_

94 P.spaces

80 P.spaces

95 Keyword.module_

81 Keyword.module_

96 end <- P.getPosition

82 end <- P.getPosition

83+ P.spaces

84+ name <- Var.moduleName

85+ P.spaces

86+ manager <- chompManager

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

87+ return ( name, Src.Effects (R.Region start end) manager )

98 ]

88 ]

100

101

92+-- MANAGER

93+--

102−-- EFFECTS - where { command = MyCmd }

94+-- where { command = MyCmd }

103−

95+-- where { subscription = MySub }

104−

96+-- where { command = MyCmd, subscription = MySub }

105−effectSettings :: Parser Module.SourceSettings

97+--

106−effectSettings =

98+chompManager :: Parser Src.Manager

107− oneOf

99+chompManager =

108− [ do Keyword.where_

100+ do Keyword.where_

109− P.spaces

101+ P.spaces

110− start <- P.getPosition

111− Symbol.leftCurly

102+ Symbol.leftCurly

112− P.spaces

103+ P.spaces

113− entry <- setting

104+ oneOf

105+ [ do cmd <- chompCommand

114− P.spaces

106+ P.spaces

115− effectSettingsHelp start [entry]

107+ oneOf

116− , return Module.emptySettings

108+ [ do Symbol.rightCurly

109+ P.spaces

110+ return (Src.Cmd cmd)

111+ , do Symbol.comma

112+ P.spaces

113+ sub <- chompSubscription

114+ P.spaces

115+ Symbol.rightCurly

116+ P.spaces

117+ return (Src.Fx cmd sub)

118+ ]

119+ , do sub <- chompSubscription

120+ P.spaces

121+ oneOf

122+ [ do Symbol.rightCurly

123+ P.spaces

124+ return (Src.Sub sub)

125+ , do Symbol.comma

126+ P.spaces

127+ cmd <- chompCommand

128+ P.spaces

129+ Symbol.rightCurly

130+ P.spaces

131+ return (Src.Fx cmd sub)

132+ ]

117− ]

133+ ]

118

134

119

135

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

136+chompCommand :: Parser (A.Located Text)

121−effectSettingsHelp start entries =

137+chompCommand =

122− oneOf

138+ do Keyword.command_

123− [ do Symbol.comma

124− P.spaces

139+ P.spaces

125− entry <- setting

126− P.spaces

127− effectSettingsHelp start (entry:entries)

128− , do Symbol.rightCurly

140+ Symbol.equals

129− end <- P.getPosition

141+ P.spaces

130− P.spaces

142+ P.addLocation Var.upper

131− return (A.at start end entries)

132− ]

133

143

134

144

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

145+chompSubscription :: Parser (A.Located Text)

136−setting =

146+chompSubscription =

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

147+ do Keyword.subscription_

138 P.spaces

148 P.spaces

139 Symbol.equals

149 Symbol.equals

140 P.spaces

150 P.spaces

141− tipe <- P.addLocation Var.upper

151+ P.addLocation Var.upper

142− return (name, tipe)

143

152

144

153

145

154

@@ -164,7 +173,7 @@ maybeDocComment =

164-- IMPORTS

173-- IMPORTS

165

174

166

175

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

176+chompImports :: [Src.Import] -> Parser [Src.Import]

168chompImports imports =

177chompImports imports =

169 oneOf

178 oneOf

170 [ do start <- P.getPosition

179 [ do start <- P.getPosition

@@ -172,106 +181,106 @@ chompImports imports =

172 P.pushContext start E.Import

181 P.pushContext start E.Import

173 P.spaces

182 P.spaces

174 name <- P.addLocation Var.moduleName

183 name <- P.addLocation Var.moduleName

175− end <- P.getPosition

176 pos <- W.whitespace

184 pos <- W.whitespace

177 oneOf

185 oneOf

178 [ do P.checkFreshLine pos

186 [ do P.checkFreshLine pos

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

180 P.popContext ()

187 P.popContext ()

181− chompImports (userImport:imports)

188+ chompImports $

189+ Src.Import name Nothing (Src.Explicit []) : imports

182 , do P.checkSpace pos

190 , do P.checkSpace pos

183 oneOf

191 oneOf

184− [ chompAs start name imports

192+ [ chompAs name imports

185− , chompExposing start name Nothing imports

193+ , chompExposing name Nothing imports

186 ]

194 ]

187 ]

195 ]

188 , return (reverse imports)

196 , return (reverse imports)

189 ]

197 ]

190

198

191

199

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

200+chompAs :: A.Located Text -> [Src.Import] -> Parser [Src.Import]

193−chompAs start name imports =

201+chompAs name imports =

194 do Keyword.as_

202 do Keyword.as_

195 P.spaces

203 P.spaces

196 alias <- Var.upper

204 alias <- Var.upper

197− end <- P.getPosition

198 pos <- W.whitespace

205 pos <- W.whitespace

199 oneOf

206 oneOf

200 [ do P.checkFreshLine pos

207 [ do P.checkFreshLine pos

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

202 P.popContext ()

208 P.popContext ()

203− chompImports (userImport:imports)

209+ chompImports $

210+ Src.Import name (Just alias) (Src.Explicit []) : imports

204 , do P.checkSpace pos

211 , do P.checkSpace pos

205− chompExposing start name (Just alias) imports

212+ chompExposing name (Just alias) imports

206 ]

213 ]

207

214

208

215

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

216+chompExposing :: A.Located Text -> Maybe Text -> [Src.Import] -> Parser [Src.Import]

210−chompExposing start name maybeAlias imports =

217+chompExposing name maybeAlias imports =

211 do Keyword.exposing_

218 do Keyword.exposing_

212 P.spaces

219 P.spaces

213− exposed <- exposing exposingEntry

220+ exposed <- exposing

214− end <- P.getPosition

215 freshLine

221 freshLine

216− let userImport = method start end name maybeAlias exposed

217 P.popContext ()

222 P.popContext ()

218− chompImports (userImport:imports)

223+ chompImports $

219−

224+ Src.Import name maybeAlias exposed : imports

220−

221−method :: R.Position -> R.Position -> A.Located Text -> Maybe Text -> Exposing.Raw -> Module.UserImport

222−method start end name maybeAlias exposed =

223− A.at start end ( name, Module.ImportMethod maybeAlias exposed )

224

225

226

227

227-- LISTING

228-- LISTING

228

229

230

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

231+exposing :: Parser Src.Exposing

231−exposing parser =

232+exposing =

232 P.hint E.Listing $

233 P.hint E.Listing $

233 do Symbol.leftParen

234 do Symbol.leftParen

234 P.spaces

235 P.spaces

235 oneOf

236 oneOf

236− [ do Symbol.dot

237+ [ do Symbol.doubleDot

237− Symbol.dot

238 P.spaces

239 Symbol.rightParen

240− return Exposing.Open

240+ return Src.Open

241− , do value <- P.addLocation parser

241+ , do entry <- P.addLocation chompEntry

242 P.spaces

243− exposingHelp parser [value]

243+ exposingHelp [entry]

244 ]

245

246

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

247+exposingHelp :: [A.Located Src.Exposed] -> Parser Src.Exposing

248−exposingHelp parser values =

248+exposingHelp revEntries =

249 oneOf

250 [ do Symbol.comma

251 P.spaces

252− value <- P.addLocation parser

252+ entry <- P.addLocation chompEntry

253 P.spaces

254− exposingHelp parser (value:values)

254+ exposingHelp (entry:revEntries)

255 , do Symbol.rightParen

256− return (Exposing.Explicit (reverse values))

256+ return (Src.Explicit (reverse revEntries))

257 ]

258

259

260−exposingEntry :: Parser Exposing.Entry

260+chompEntry :: Parser Src.Exposed

261−exposingEntry =

261+chompEntry =

262 oneOf

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

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

264 , do Symbol.leftParen

265 op <- Symbol.binop

266 Symbol.rightParen

267− return (Exposing.Lower op)

267+ return (Src.Lower op)

268 , do name <- Var.upper

269 P.spaces

270− Exposing.Upper name <$>

270+ Src.Upper name <$> privacy

271+ ]

272+

273+

274+privacy :: Parser Src.Privacy

275+privacy =

271− oneOf

276+ oneOf

272− [ Just <$> exposing Var.upper

277+ [ do Symbol.leftParen

278+ P.spaces

279+ Symbol.doubleDot

280+ P.spaces

281+ Symbol.rightParen

282+ return Src.Public

273− , return Nothing

283+ , return Src.Private

274− ]

275 ]

284 ]

276

285

277

286

src/Parse/Parse.hs+26−32

@@ -1,15 +1,17 @@

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

1+{-# OPTIONS_GHC -Wall #-}

2−module Parse.Parse (program) where

2+module Parse.Parse

3−

3+ ( program

4+ )

5+ where

4−import Data.Text (Text)

8+import qualified Data.ByteString as B

5−

10+import qualified AST.Expression.Source as Src

6−import qualified AST.Declaration as Decl

11+import qualified AST.Expression.Valid as Valid

12+import qualified Parse.Declaration as Decl

7−import qualified AST.Module as Module

13+import qualified Parse.Module as Module

8−import qualified AST.Module.Name as ModuleName

14+import qualified Parse.Primitives as P

9−import qualified Elm.Package as Package

10−import Parse.Helpers

11−import qualified Parse.Module as Parse (header)

12−import qualified Parse.Declaration as Parse (declaration)

13import qualified Reporting.Annotation as A

15import qualified Reporting.Annotation as A

14import qualified Reporting.Result as Result

16import qualified Reporting.Result as Result

15import qualified Validate

17import qualified Validate

@@ -19,9 +21,9 @@ import qualified Validate

19-- PROGRAM

21-- PROGRAM

22−program :: Package.Name -> Text -> Validate.Result wrn Module.Valid

24+program :: B.ByteString -> Validate.Result wrn Valid.Module

23−program pkgName src =

25+program src =

24− case run (chompProgram pkgName) src of

26+ case P.run chompProgram src of

25 Right modul ->

27 Right modul ->

26 Validate.validate modul

28 Validate.validate modul

@@ -29,26 +31,18 @@ program pkgName src =

29 Result.throw region syntaxError

31 Result.throw region syntaxError

32−

33−chompProgram :: Package.Name -> Parser Module.Source

34+chompProgram :: P.Parser (Src.Module [Src.Decl])

34−chompProgram pkgName =

35+chompProgram =

35− do (Module.Header maybeHeaderDecl imports) <- Parse.header

36− decls <- chompDeclarations []

36+ do srcModule <- Module.module_ (chompDeclarations [])

37− endOfFile

37+ P.endOfFile

38−

38+ return srcModule

39− let (Module.HeaderDecl tag name exports settings docs) =

40− maybe Module.defaultHeaderDecl id maybeHeaderDecl

41−

42− let moduleName = ModuleName.Canonical pkgName name

43− let source = Module.Source tag settings docs exports imports decls

44− return (Module.Module moduleName source)

47−chompDeclarations :: [Decl.Source] -> Parser [Decl.Source]

41+chompDeclarations :: [Src.Decl] -> P.Parser [Src.Decl]

48chompDeclarations decls =

42chompDeclarations decls =

49− do (decl, _, pos) <- Parse.declaration

43+ do (decl, _, pos) <- Decl.declaration

50− oneOf

44+ P.oneOf

51− [ do checkFreshLine pos

45+ [ do P.checkFreshLine pos

52 chompDeclarations (decl:decls)

46 chompDeclarations (decl:decls)

53 , return (reverse (decl:decls))

47 , return (reverse (decl:decls))

54 ]

48 ]

src/Parse/Primitives/Keyword.hs+10−18

@@ -6,7 +6,7 @@ module Parse.Primitives.Keyword

6 , case_, of_

7 , let_, in_

8 , module_, import_, exposing_, as_, where_, effect_

9− , infix_, infixr_, infixl_

9+ , command_, subscription_

10 )

11 where

@@ -168,24 +168,16 @@ effect_ =

168

169

170

171−-- INFIX

171+-- EFFECTS

172

173

174−{-# NOINLINE infix_ #-}

174+{-# NOINLINE command_ #-}

175−infix_ :: Parser ()

175+command_ :: Parser ()

176−infix_ =

176+command_ =

177− keyword "infix"

177+ keyword "command"

178−

179−

180−{-# NOINLINE infixr_ #-}

181−infixr_ :: Parser ()

182−infixr_ =

183− keyword "infixr"

184−

185−

186−{-# NOINLINE infixl_ #-}

187−infixl_ :: Parser ()

188−infixl_ =

189− keyword "infixl"

190

178

191

179

180+{-# NOINLINE subscription_ #-}

181+subscription_ :: Parser ()

182+subscription_ =

183+ keyword "subscription"

src/Parse/Primitives/Symbol.hs+7−1

@@ -3,7 +3,7 @@

3module Parse.Primitives.Symbol

4 ( underscore

5 , binop, binopTable

6− , equals, rightArrow, hasType, comma, pipe, cons, dot, minus, lambda

6+ , equals, rightArrow, hasType, comma, pipe, cons, dot, doubleDot, minus, lambda

7 , leftParen, rightParen, leftSquare, rightSquare, leftCurly, rightCurly

8 , elmDocCommentOpen, jsMultiCommentOpen, jsMultiCommentClose

9 , shaderBlockOpen

@@ -178,6 +178,12 @@ dot =

178 symbol "."

179

180

181+{-# NOINLINE doubleDot #-}

182+doubleDot :: Parser ()

183+doubleDot =

184+ symbol ".."

185+

186+

181{-# NOINLINE minus #-}

187{-# NOINLINE minus #-}

182minus :: Parser ()

188minus :: Parser ()

183minus =

189minus =

src/Parse/Type.hs+4−3

@@ -90,13 +90,14 @@ app start =

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

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

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

94unionConstructor =

95+ do start <- getPosition

95− do name <- Var.upper

96+ name <- Var.upper

96 nameEnd <- getPosition

97 nameEnd <- getPosition

97 namePos <- whitespace

98 namePos <- whitespace

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

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

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

100+ return ( (A.at start nameEnd name, args), end, pos )

100

101

102

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

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