da9e6b7 · elk · git.iko.soy

git.iko.soy/elk

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

Mainly changing imports for the new UTF-8 backing code and generating the more precise AST structures. It also removes the (,,) syntax. It also allows (x,y) = point within let expressions, but not as a top-level declaration.

commitda9e6b71edbff156311cf1f6f1e98b0c70de7068 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 11 Oct 2017, 15:21 (9 years ago) parent9111afa

8 files changed+397−409

compare with master

unifiedsplit

src/Parse/Declaration.hs+24−19 src/Parse/Expression.hs+106−122 src/Parse/Kernel.hs+9−9 src/Parse/Literal.hs+10−10 src/Parse/Module.hs+95−100 src/Parse/Pattern.hs+90−91 src/Parse/Repl.hs+15−15 src/Parse/Type.hs+48−43

src/Parse/Declaration.hs+24−19

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

33module Parse.Declaration where

55import Data.Text (Text)

6+import qualified Data.Text.Encoding as Text

78import qualified AST.Declaration as Decl

89import qualified AST.Type as Type

910import 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

1116import qualified Parse.Type as Type

1217import qualified Reporting.Annotation as A

1318import qualified Reporting.Error.Syntax as E

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

3742

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

3944docDecl start =

40− do comment <- docComment

45+ do doc <- W.docComment

4146 end <- getPosition

42− pos <- whitespace

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

47+ pos <- W.whitespace

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

4449

4550

4651-- TYPE ANNOTATIONS and DEFINITIONS

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

4853

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

5055defDecl start =

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

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

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

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

5459

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

5964

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

6166typeDecl start =

62− do keyword "type"

67+ do Keyword.type_

6368 spaces

6469 oneOf

65− [ do keyword "alias"

70+ [ do Keyword.alias_

6671 inContext start E.TypeAlias $

6772 do spaces

6873 (name, args) <- nameArgsEquals

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

8085

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

8287nameArgsEquals =

83− do name <- capVar

88+ do name <- Var.upper

8489 spaces

8590 nameArgsEqualsHelp name []

8691

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

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

8994nameArgsEqualsHelp name args =

9095 oneOf

91− [ do arg <- lowVar

96+ [ do arg <- Var.lower

9297 spaces

9398 nameArgsEqualsHelp name (arg:args)

94− , do equals

99+ , do Symbol.equals

95100 spaces

96101 return ( name, reverse args )

97102 ]

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

101106chompConstructors ctors end pos =

102107 oneOf

103108 [ do checkSpace pos

104− pipe

109+ Symbol.pipe

105110 spaces

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

107112 chompConstructors (ctor:ctors) newEnd newSpace

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

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

117122infixDecl start =

118123 oneOf

119− [ do keyword "infixl"

124+ [ do Keyword.infixl_

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

121− , do keyword "infixr"

126+ , do Keyword.infixr_

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

123− , do keyword "infix"

128+ , do Keyword.infix_

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

125130 ]

126131

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

130135 do spaces

131136 n <- digit

132137 spaces

133− op <- infixOp

138+ op <- Symbol.binop

134139 end <- getPosition

135− pos <- whitespace

140+ pos <- W.whitespace

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

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

138143

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

143148

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

145150portDecl start =

146− do keyword "port"

151+ do Keyword.port_

147152 inContext start E.Port $

148153 do spaces

149− name <- lowVar

154+ name <- Var.lower

150155 spaces

151− hasType

156+ Symbol.hasType

152157 spaces

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

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

src/Parse/Expression.hs+106−122

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

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

22{-# LANGUAGE OverloadedStrings #-}

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

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

55import Control.Monad (guard)

66import qualified Data.List as List

7−import qualified Data.Text as Text

87import 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

1114import qualified Parse.Literal as Literal

1215import qualified Parse.Pattern as Pattern

1316import qualified Parse.Type as Type

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

4750

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

4952accessor start =

50− do dot

51− field <- lowVar

53+ do Symbol.dot

54+ field <- Var.lower

5255 end <- getPosition

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

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

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

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

5657

5758

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

5960variable start =

60− do var <- qualifiedVar

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

6162 end <- getPosition

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

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

6364

6465

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

6667accessible start expr =

6768 oneOf

68− [ do dot

69− field <- lowVar

69+ [ do Symbol.dot

70+ field <- Var.lower

7071 end <- getPosition

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

7273 accessible start newExpr

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

8081

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

8283list start =

83− do leftSquare

84+ do Symbol.leftSquare

8485 inContext start E.ExprList $

8586 do spaces

8687 oneOf

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

8889 checkSpace pos

8990 listHelp start [entry]

90− , do rightSquare

91+ , do Symbol.rightSquare

9192 end <- getPosition

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

9394 ]

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

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

9798listHelp start entries =

9899 oneOf

99− [ do comma

100+ [ do Symbol.comma

100101 spaces

101102 (entry, _, pos) <- expression

102103 checkSpace pos

103104 listHelp start (entry:entries)

104− , do rightSquare

105+ , do Symbol.rightSquare

105106 end <- getPosition

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

107108 ]

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

113114

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

115116tuple start =

116− do leftParen

117+ do Symbol.leftParen

117118 pos <- getPosition

118− spos <- whitespace

119+ spos <- W.whitespace

119120 inContext start E.ExprTuple $ oneOf $

120121 [ do noSpace pos spos

121− try (minus >> rightParen)

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

122123 end <- getPosition

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

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

124125

125126 , do checkSpace spos

126127 (entry, _, spos2) <- expression

127128 checkSpace spos2

128− tupleHelp start [entry]

129+ tupleHelp start entry []

129130

130131 , do noSpace pos spos

131− op <- infixOp

132− rightParen

132+ op <- Symbol.binop

133+ Symbol.rightParen

133134 end <- getPosition

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

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

135136

136137 , do noSpace pos spos

137− rightParen

138+ Symbol.rightParen

138139 end <- getPosition

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

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

140141

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)

150142 ]

151143

152144

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

167−tupleHelp start entries =

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

146+tupleHelp start firstExpr revExprs =

168147 oneOf

169− [ do comma

148+ [ do Symbol.comma

170149 spaces

171150 (entry, _, pos) <- expression

172151 checkSpace pos

173− tupleHelp start (entry:entries)

174− , do rightParen

152+ tupleHelp start firstExpr (entry : revExprs)

153+ , do Symbol.rightParen

175154 end <- getPosition

176− case entries of

177− [entry] ->

178− return entry

155+ case reverse revExprs of

156+ [] ->

157+ return firstExpr

179158

180− _ ->

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

159+ secondExpr : others ->

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

182161 ]

183162

184163

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

188167

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

190169record start =

191− do leftCurly

170+ do Symbol.leftCurly

192171 inContext start E.ExprRecord $

193172 do spaces

194173 oneOf

195− [ do rightCurly

174+ [ do Symbol.rightCurly

196175 end <- getPosition

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

198− , do starter <- addLocation lowVar

177+ , do starter <- addLocation Var.lower

199178 spaces

200179 oneOf

201− [ do pipe

180+ [ do Symbol.pipe

202181 spaces

203182 firstField <- chompField

204183 fields <- chompFields [firstField]

205184 end <- getPosition

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

207− , do equals

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

186+ , do Symbol.equals

208187 spaces

209188 (value, _, nextPos) <- expression

210189 checkSpace nextPos

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

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

222201chompFields fields =

223202 oneOf

224− [ do comma

203+ [ do Symbol.comma

225204 spaces

226205 f <- chompField

227206 chompFields (f : fields)

228− , do rightCurly

207+ , do Symbol.rightCurly

229208 return (reverse fields)

230209 ]

231210

232211

233212chompField :: Parser Field

234213chompField =

235− do key <- addLocation lowVar

214+ do key <- addLocation Var.lower

236215 spaces

237− equals

216+ Symbol.equals

238217 spaces

239218 (value, _, pos) <- expression

240219 checkSpace pos

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

260239 , function start

261240 , do starter <- possiblyNegativeTerm start

262241 end <- getPosition

263− space <- whitespace

242+ space <- W.whitespace

264243 exprHelp start (State [] starter end space)

265244 ]

266245

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

282261 do checkSpace pos

283262 arg <- term

284263 newEnd <- getPosition

285− newPos <- whitespace

264+ newPos <- W.whitespace

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

287266 exprHelp start (State ops newLast newEnd newPos)

288267

289268 , -- infix operator

290269 do checkSpace pos

291270 opStart <- getPosition

292− opName <- infixOp

271+ opName <- Symbol.binop

293272 opEnd <- getPosition

294273 let op = A.at opStart opEnd opName

295− spos <- whitespace

274+ spos <- W.whitespace

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

297276 newStart <- getPosition

298277 hint (E.AfterOpExpr opName) $ oneOf $

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

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

301280 rawTerm <- term

302281 newEnd <- getPosition

303− newPos <- whitespace

282+ newPos <- W.whitespace

304283

305284 let ann x = A.merge op rawTerm x

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

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

311290 , -- term

312291 do newLast <- possiblyNegativeTerm newStart

313292 newEnd <- getPosition

314− newPos <- whitespace

293+ newPos <- W.whitespace

315294 let newOps = (lastExpr, op) : ops

316295 exprHelp start (State newOps newLast newEnd newPos)

317296

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

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

346325possiblyNegativeTerm start =

347326 oneOf

348− [ do minus

327+ [ do Symbol.minus

349328 expr <- term

350329 end <- getPosition

351330 let ann x = A.at start end x

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

360339

361340if_ :: R.Position -> ExprParser

362341if_ start =

363− do keyword "if"

342+ do Keyword.if_

364343 inContext start E.ExprIf $ ifHelp start []

365344

366345

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

369348 do spaces

370349 (condition, _, condPos) <- expression

371350 checkSpace condPos

372− keyword "then"

351+ Keyword.then_

373352 spaces

374353 (thenBranch, _, thenPos) <- expression

375354 hint E.ElseBranch $ checkSpace thenPos

376− hint E.ElseBranch $ keyword "else"

355+ hint E.ElseBranch $ Keyword.else_

377356 spaces

378357 let newBranches = (condition, thenBranch) : branches

379358 oneOf

380− [ do keyword "if"

359+ [ do Keyword.if_

381360 ifHelp start newBranches

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

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

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

391370

392371function :: R.Position -> ExprParser

393372function start =

394− do lambda

373+ do Symbol.lambda

395374 inContext start E.ExprFunc $

396375 do spaces

397376 arg <- Pattern.term

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

409388 [ do arg <- Pattern.term

410389 spaces

411390 gatherArgs (arg:args)

412− , do rightArrow

391+ , do Symbol.rightArrow

413392 return args

414393 ]

415394

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

420399

421400case_ :: R.Position -> ExprParser

422401case_ start =

423− do keyword "case"

402+ do Keyword.case_

424403 inContext start E.ExprCase $

425404 do spaces

426405 (switcher, _, switcherPos) <- expression

427406 checkSpace switcherPos

428− keyword "of"

407+ Keyword.of_

429408 spaces

430409 oldIndent <- getIndent

431410 newIndent <- getCol

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

444423branchHelp =

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

446425 checkSpace patternPos

447− rightArrow

426+ Symbol.rightArrow

448427 spaces

449428 (branchExpr, end, pos) <- expression

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

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

468447let_ start =

469448 do oldIndent <- getIndent

470449 letIndent <- getCol

471− keyword "let"

450+ Keyword.let_

472451 pushContext start E.ExprLet

473452 setIndent letIndent

474453 spaces

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

487466

488467 , do setIndent oldIndent

489468 checkSpace pos

490− keyword "in"

469+ Keyword.in_

491470 popContext ()

492471 spaces

493472 (body, newEnd, newPos) <- expression

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

497476

498477

499478

500−-- DEFINITIONS

479+-- LET DEFINITIONS

501480

502481

503482letDef :: SParser Src.RawDef

504483letDef =

505− definition $ \_ -> Pattern.term

484+ oneOf

485+ [ definition

486+ , destructure

487+ ]

488+

506489

507490

508−topLevelDef :: SParser Src.RawDef

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

491+-- DEFINITION

518492

519493

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

521−definition parseRoot =

494+definition :: SParser Src.RawDef

495+definition =

522496 do start <- getPosition

523− root <- parseRoot start

497+ name <- Var.lower

524498 spaces

525− case A.drop root of

526− P.Var name ->

527− oneOf

528− [ do hasType

529− inContext start (E.Annotation name) $

530− do spaces

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

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

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

534− definitionHelp start root []

535− ]

536−

537− _ ->

538− definitionHelp start root []

499+ oneOf

500+ [ do Symbol.hasType

501+ inContext start (E.Annotation name) $

502+ do spaces

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

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

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

506+ definitionHelp start name []

507+ ]

539508

540509

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

542−definitionHelp start root revArgs =

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

511+definitionHelp start name revArgs =

543512 oneOf

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

545514 spaces

546− definitionHelp start root (arg : revArgs)

547− , do equals

515+ definitionHelp start name (arg : revArgs)

516+ , do Symbol.equals

548517 spaces

549− (expr, 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)

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

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

552520 return ( def, end, space )

553521 ]

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

2020import qualified AST.Module.Name as Module

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

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

23−import Parse.Helpers (Parser)

24−import qualified Parse.Helpers as Parse

23+import Parse.Primitives (Parser)

24+import qualified Parse.Primitives.Kernel as K

2525import qualified Parse.Module as Parse

2626import qualified Reporting.Annotation as A

2727

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

4040

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

4242parserHelp imports enums fields chunks =

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

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

4444 case maybeTag of

4545 Nothing ->

4646 return (Kernel.JS javascript : chunks)

4747

4848 Just tag ->

4949 case tag of

50− Parse.KernelProd ->

50+ K.Prod ->

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

5252

53− Parse.KernelDebug ->

53+ K.Debug ->

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

5555

56− Parse.KernelImport var ->

56+ K.Import var ->

5757 case Map.lookup var imports of

5858 Nothing ->

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

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

6161 Just (home, name) ->

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

6363

64− Parse.KernelEnum n var ->

64+ K.Enum n var ->

6565 let

6666 (bytes, newEnums) =

6767 lookupEnum n var enums

6868 in

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

7070

71− Parse.KernelElmField name ->

71+ K.ElmField name ->

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

7373

74− Parse.KernelJsField name ->

74+ K.JsField name ->

7575 let

7676 (bytes, newFields) =

7777 lookupField name fields

src/Parse/Literal.hs+10−10

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

1313import qualified AST.Literal as L

1414import qualified Reporting.Annotation as A

1515import qualified Reporting.Region as R

16−import Parse.Helpers

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

18− , shaderSource, shaderFailure, string

19− )

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

17+import qualified Parse.Primitives.Number as Number

18+import qualified Parse.Primitives.Shader as Shader

19+import qualified Parse.Primitives.Utf8 as Utf8

2020

2121

2222

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

2626literal :: Parser L.Literal

2727literal =

2828 oneOf

29− [ L.Str <$> string

30− , L.Chr <$> character

31− , number

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

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

31+ , Number.number

3232 ]

3333

3434

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

3838

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

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

41− do src <- shaderSource

41+ do src <- Shader.block

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

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

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

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

6666 (Parsec.errorMessages err)

6767 in

6868 if row == 1 then

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

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

7070 else

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

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

7272

7373

7474emptyShader :: L.Shader

src/Parse/Module.hs+95−100

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

66 )

77 where

10+import qualified Data.ByteString as B

911import Data.Text (Text)

1012

1113import qualified AST.Exposing as Exposing

1214import 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

1421import qualified Reporting.Annotation as A

1522import qualified Reporting.Error.Syntax as E

1623import qualified Reporting.Region as R

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

2835

2936kernelHeader :: Parser [Module.UserImport]

3037kernelHeader =

31− do headerOpen

38+ do Symbol.jsMultiCommentOpen

3239 freshLine

3340 imports <- chompImports []

34− headerClose

41+ Symbol.jsMultiCommentClose

3542 return imports

3643

3744

38−{-# NOINLINE headerOpen #-}

39−headerOpen :: Parser ()

40−headerOpen =

41− symbol "/*"

42−

43−

44−{-# NOINLINE headerClose #-}

45−headerClose :: Parser ()

46−headerClose =

47− symbol "*/"

48−

49−

5045

5146-- HEADER DECL

5247

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

6156

6257headerDecl :: Parser Module.HeaderDecl

6358headerDecl =

64− do start <- getPosition

65− pushContext start E.Module

59+ do start <- P.getPosition

60+ P.pushContext start E.Module

6661 tag <- sourceTag

67− spaces

68− name <- qualifiedCapVar

69− spaces

62+ P.spaces

63+ name <- Var.moduleName

64+ P.spaces

7065 settings <- effectSettings

71− hint E.Exposing $ keyword "exposing"

72− spaces

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

67+ P.spaces

7368 exports <- exposing exposingEntry

74− popContext ()

69+ P.popContext ()

7570 docs <- maybeDocComment

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

7772

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

8479sourceTag =

8580 oneOf

8681 [

87− do keyword "module"

82+ do Keyword.module_

8883 return Module.Normal

8984 ,

90− do start <- getPosition

91− keyword "port"

92− spaces

93− keyword "module"

94− end <- getPosition

85+ do start <- P.getPosition

86+ Keyword.port_

87+ P.spaces

88+ Keyword.module_

89+ end <- P.getPosition

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

9691 ,

97− do start <- getPosition

98− keyword "effect"

99− spaces

100− keyword "module"

101− end <- getPosition

92+ do start <- P.getPosition

93+ Keyword.effect_

94+ P.spaces

95+ Keyword.module_

96+ end <- P.getPosition

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

10398 ]

10499

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

110105effectSettings :: Parser Module.SourceSettings

111106effectSettings =

112107 oneOf

113− [ do keyword "where"

114− spaces

115− start <- getPosition

116− leftCurly

117− spaces

108+ [ do Keyword.where_

109+ P.spaces

110+ start <- P.getPosition

111+ Symbol.leftCurly

112+ P.spaces

118113 entry <- setting

119− spaces

114+ P.spaces

120115 effectSettingsHelp start [entry]

121116 , return Module.emptySettings

122117 ]

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

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

126121effectSettingsHelp start entries =

127122 oneOf

128− [ do comma

129− spaces

123+ [ do Symbol.comma

124+ P.spaces

130125 entry <- setting

131− spaces

126+ P.spaces

132127 effectSettingsHelp start (entry:entries)

133− , do rightCurly

134− end <- getPosition

135− spaces

128+ , do Symbol.rightCurly

129+ end <- P.getPosition

130+ P.spaces

136131 return (A.at start end entries)

137132 ]

138133

139134

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

141136setting =

142− do name <- addLocation lowVar

143− spaces

144− equals

145− spaces

146− tipe <- addLocation capVar

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

138+ P.spaces

139+ Symbol.equals

140+ P.spaces

141+ tipe <- P.addLocation Var.upper

147142 return (name, tipe)

148143

149144

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

151146-- DOC COMMENTS

152147

153148

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

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

155150maybeDocComment =

156− do oldEnd <- getPosition

151+ do oldEnd <- P.getPosition

157152 freshLine

158− newStart <- getPosition

153+ newStart <- P.getPosition

159154 oneOf

160− [ do doc <- docComment

161− end <- getPosition

155+ [ do doc <- W.docComment

156+ end <- P.getPosition

162157 freshLine

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

164159 , return (A.at oldEnd newStart Nothing)

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

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

173168chompImports imports =

174169 oneOf

175− [ do start <- getPosition

176− keyword "import"

177− pushContext start E.Import

178− spaces

179− name <- addLocation qualifiedCapVar

180− end <- getPosition

181− pos <- whitespace

170+ [ do start <- P.getPosition

171+ Keyword.import_

172+ P.pushContext start E.Import

173+ P.spaces

174+ name <- P.addLocation Var.moduleName

175+ end <- P.getPosition

176+ pos <- W.whitespace

182177 oneOf

183− [ do checkFreshLine pos

178+ [ do P.checkFreshLine pos

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

185− popContext ()

180+ P.popContext ()

186181 chompImports (userImport:imports)

187− , do checkSpace pos

182+ , do P.checkSpace pos

188183 oneOf

189184 [ chompAs start name imports

190185 , chompExposing start name Nothing imports

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

196191

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

198193chompAs start name imports =

199− do keyword "as"

200− spaces

201− alias <- capVar

202− end <- getPosition

203− pos <- whitespace

194+ do Keyword.as_

195+ P.spaces

196+ alias <- Var.upper

197+ end <- P.getPosition

198+ pos <- W.whitespace

204199 oneOf

205− [ do checkFreshLine pos

200+ [ do P.checkFreshLine pos

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

207− popContext ()

202+ P.popContext ()

208203 chompImports (userImport:imports)

209− , do checkSpace pos

204+ , do P.checkSpace pos

210205 chompExposing start name (Just alias) imports

211206 ]

212207

213208

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

215210chompExposing start name maybeAlias imports =

216− do keyword "exposing"

217− spaces

211+ do Keyword.exposing_

212+ P.spaces

218213 exposed <- exposing exposingEntry

219− end <- getPosition

214+ end <- P.getPosition

220215 freshLine

221216 let userImport = method start end name maybeAlias exposed

222− popContext ()

217+ P.popContext ()

223218 chompImports (userImport:imports)

224219

225220

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

234229

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

236231exposing parser =

237− hint E.Listing $

238− do leftParen

239− spaces

232+ P.hint E.Listing $

233+ do Symbol.leftParen

234+ P.spaces

240235 oneOf

241− [ do dot

242− dot

243− spaces

244− rightParen

236+ [ do Symbol.dot

237+ Symbol.dot

238+ P.spaces

239+ Symbol.rightParen

245240 return Exposing.Open

246− , do value <- addLocation parser

247− spaces

241+ , do value <- P.addLocation parser

242+ P.spaces

248243 exposingHelp parser [value]

249244 ]

250245

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

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

253248exposingHelp parser values =

254249 oneOf

255− [ do comma

256− spaces

257− value <- addLocation parser

258− spaces

250+ [ do Symbol.comma

251+ P.spaces

252+ value <- P.addLocation parser

253+ P.spaces

259254 exposingHelp parser (value:values)

260− , do rightParen

255+ , do Symbol.rightParen

261256 return (Exposing.Explicit (reverse values))

262257 ]

263258

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

265260exposingEntry :: Parser Exposing.Entry

266261exposingEntry =

267262 oneOf

268− [ Exposing.Lower <$> lowVar

269− , do leftParen

270− op <- infixOp

271− rightParen

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

264+ , do Symbol.leftParen

265+ op <- Symbol.binop

266+ Symbol.rightParen

272267 return (Exposing.Lower op)

273− , do name <- capVar

274− spaces

268+ , do name <- Var.upper

269+ P.spaces

275270 Exposing.Upper name <$>

276271 oneOf

277− [ Just <$> exposing capVar

272+ [ Just <$> exposing Var.upper

278273 , return Nothing

279274 ]

280275 ]

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

286281

287282freshLine :: Parser ()

288283freshLine =

289− checkFreshLine =<< whitespace

284+ P.checkFreshLine =<< W.whitespace

290285

src/Parse/Pattern.hs+90−91

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

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

22{-# 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

511import Data.Text (Text)

612

713import qualified AST.Literal as L

814import qualified AST.Pattern as P

9−import qualified AST.Variable as Var

10−import Parse.Helpers

1115import 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)

1221import qualified Reporting.Annotation as A

1322import qualified Reporting.Error.Syntax as E

1423import qualified Reporting.Region as R

1524

1625

1726

18−-- PATTERN TERMS

27+-- TERM

1928

2029

2130term :: Parser P.Raw

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

3443termHelp start =

3544 do pattern <-

3645 oneOf

37− [ underscore >> return P.Anything

38− , P.Var <$> lowVar

39− , mkCtor <$> qualifiedCapVar

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

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

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

48+ , upperTerm <$> Var.foreignUpper

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

4150 ]

4251 end <- getPosition

4352 return (A.at start end pattern)

4453

4554

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

47−mkCtor ctor =

48− case ctor of

49− "True" ->

50− P.Literal (L.Boolean True)

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

56+upperTerm pair =

57+ case pair of

58+ (Nothing, "True") ->

59+ P.RLiteral (L.Boolean True)

5160

52− "False" ->

53− P.Literal (L.Boolean False)

61+ (Nothing, "False") ->

62+ P.RLiteral (L.Boolean False)

5463

55− _ ->

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

64+ (maybePrefix, name) ->

65+ P.RCtor maybePrefix name []

5766

5867

5968

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

6271

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

6473record start =

65− do leftCurly

74+ do Symbol.leftCurly

6675 inContext start E.ExprRecord $

6776 do spaces

6877 oneOf

69− [ do var <- lowVar

78+ [ do var <- Var.lower

7079 spaces

7180 recordHelp start [var]

72− , do rightCurly

81+ , do Symbol.rightCurly

7382 end <- getPosition

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

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

7584 ]

7685

7786

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

7988recordHelp start vars =

8089 oneOf

81− [ do comma

90+ [ do Symbol.comma

8291 spaces

83− var <- lowVar

92+ var <- Var.lower

8493 spaces

8594 recordHelp start (var:vars)

86− , do rightCurly

95+ , do Symbol.rightCurly

8796 end <- getPosition

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

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

8998 ]

9099

91100

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

95104

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

97106tuple start =

98− do leftParen

107+ do Symbol.leftParen

99108 inContext start E.ExprTuple $

100109 do spaces

101110 oneOf

102111 [ do (pattern, sPos) <- expression

103112 checkSpace sPos

104− tupleHelp start [pattern]

105− , do rightParen

113+ tupleHelp start pattern []

114+ , do Symbol.rightParen

106115 end <- getPosition

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

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

108117 ]

109118

110119

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

112−tupleHelp start patterns =

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

121+tupleHelp start firstPattern revPatterns =

113122 oneOf

114− [ do comma

123+ [ do Symbol.comma

115124 spaces

116125 (pattern, sPos) <- expression

117126 checkSpace sPos

118− tupleHelp start (pattern:patterns)

119− , do rightParen

120− case patterns of

121− [pattern] ->

122− return pattern

127+ tupleHelp start firstPattern (pattern : revPatterns)

128+ , do Symbol.rightParen

129+ case reverse revPatterns of

130+ [] ->

131+ return firstPattern

123132

124− _ ->

133+ secondPattern : otherPatterns ->

125134 do end <- getPosition

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

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

127136 ]

128137

129138

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

133142

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

135144list start =

136− do leftSquare

145+ do Symbol.leftSquare

137146 inContext start E.PatternList $

138147 do spaces

139148 oneOf

140149 [ do (pattern, sPos) <- expression

141150 checkSpace sPos

142− listHelp [pattern]

143− , do rightSquare

151+ listHelp start [pattern]

152+ , do Symbol.rightSquare

144153 end <- getPosition

145− return (P.list end [])

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

146155 ]

147156

148157

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

150−listHelp patterns =

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

159+listHelp start patterns =

151160 oneOf

152− [ do comma

161+ [ do Symbol.comma

153162 spaces

154163 (pattern, sPos) <- expression

155164 checkSpace sPos

156− listHelp (pattern:patterns)

157− , do end <- getPosition

158− rightSquare

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

165+ listHelp start (pattern:patterns)

166+ , do Symbol.rightSquare

167+ end <- getPosition

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

160169 ]

161170

162171

163172

164−-- PATTERN EXPRESSION

173+-- EXPRESSION

165174

166175

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

168177expression =

169178 hint E.Pattern $

170179 do start <- getPosition

171− cTerm <- consTerm

180+ cTerm <- exprTerm

172181 exprHelp start [] cTerm

173182

174183

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−

200184exprHelp :: 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) =

202186 oneOf

203187 [ do checkSpace sPos

204− cons

188+ Symbol.cons

205189 spaces

206− cTerm <- consTerm

190+ cTerm <- exprTerm

207191 exprHelp start (pattern:patterns) cTerm

208192 , do checkSpace sPos

209− keyword "as"

193+ Keyword.as_

210194 spaces

211− alias <- lowVar

195+ alias <- Var.lower

212196 newEnd <- getPosition

213197 newSpace <- whitespace

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

216200 , newSpace

217201 )

218202 , return

219− ( foldl (consHelp end) pattern patterns

203+ ( List.foldl' cons pattern patterns

220204 , sPos

221205 )

222206 ]

223207

224208

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

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

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

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

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

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

228227

229228

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

231−constructorHelp start ctor args =

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

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

232231 do end <- getPosition

233232 sPos <- whitespace

234233 oneOf

235234 [ do checkSpace sPos

236235 arg <- term

237− constructorHelp start ctor (arg:args)

236+ exprTermHelp start pair (arg:args)

238237 , return

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

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

240239 , end

241240 , sPos

242241 )

src/Parse/Repl.hs+15−15

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

77 where

10+import qualified Data.ByteString.UTF8 as Utf8

1011import qualified Data.Text as Text

1112import Data.Text (Text)

1213

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

1418import qualified Parse.Pattern as Pattern

1519

1620import qualified AST.Pattern as P

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

2832 | Other Text

2933 | Annotation

3034 | Port

31− | Infix

3235

3336

3437

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

4144 source =

4245 Text.pack rawEntry

4346 in

44− case run (entryParser source) source of

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

4548 Right entry ->

4649 entry

4750

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

5255entryParser :: Text -> Parser Entry

5356entryParser source =

5457 oneOf

55− [ do keyword "import"

58+ [ do Keyword.import_

5659 spaces

57− name <- qualifiedCapVar

60+ name <- Var.moduleName

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

5962

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

61− return Infix

62−

63− , do keyword "port"

63+ , do Keyword.port_

6464 return Port

6565

66− , do keyword "type"

66+ , do Keyword.type_

6767 spaces

6868 oneOf

69− [ do keyword "alias"

69+ [ do Keyword.alias_

7070 spaces

7171 , return ()

7272 ]

73− name <- capVar

73+ name <- Var.upper

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

7575

7676 , do root <- Pattern.term

7777 spaces

7878 case A.drop root of

79− P.Var name ->

79+ P.RVar name ->

8080 oneOf

81− [ do hasType

81+ [ do Symbol.hasType

8282 return Annotation

8383 , do chompArgs

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

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

9696 [ do Pattern.term

9797 spaces

9898 chompArgs

99− , do equals

99+ , do Symbol.equals

100100 return ()

101101 ]

src/Parse/Type.hs+48−43

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

55import Data.Text (Text)

77import qualified AST.Type as Type

8−import qualified AST.Variable as Var

9−import Parse.Helpers

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

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+

1014import qualified Reporting.Annotation as A

1115import qualified Reporting.Error.Syntax as E

1216import qualified Reporting.Region as R

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

3438

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

3640variable start =

37− do var <- lowVar

41+ do var <- Var.lower

3842 end <- getPosition

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

4044

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

5458 ]

5559 oneOf

5660 [ do checkSpace pos1

57− rightArrow

61+ Symbol.rightArrow

5862 spaces

5963 (tipe2, end2, pos2) <- expression

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

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

7074app0 :: Parser Type.Raw

7175app0 =

7276 do start <- getPosition

73− name <- qualifiedCapVar

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

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

7681

7782

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

7984app start =

80− do ctor <- qualifiedCapVar

81− ctorEnd <- getPosition

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

83− ctorPos <- whitespace

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

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

86− return ( tipe, end, pos )

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

86+ nameEnd <- getPosition

87+ namePos <- whitespace

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

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

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

8791

8892

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

9094unionConstructor =

91− do ctor <- capVar

92− ctorEnd <- getPosition

93− ctorSpace <- whitespace

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

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

95+ do name <- Var.upper

96+ nameEnd <- getPosition

97+ namePos <- whitespace

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

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

96100

97101

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

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

113117

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

115119tuple start =

116− do leftParen

117− inContext start E.TypeTuple $

120+ do Symbol.leftParen

121+ P.inContext start E.TypeTuple $

118122 oneOf

119− [ do rightParen

123+ [ do Symbol.rightParen

120124 end <- getPosition

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

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

122126 , do spaces

123127 (tipe, _, pos) <- expression

124128 checkSpace pos

125− tupleEnding start [tipe]

129+ tupleEnding start tipe []

126130 ]

127131

128132

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

130−tupleEnding start tipes =

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

134+tupleEnding start firstType revTypes =

131135 oneOf

132− [ do comma

136+ [ do Symbol.comma

133137 spaces

134138 (tipe, _, pos) <- expression

135139 checkSpace pos

136− tupleEnding start (tipe : tipes)

137− , do rightParen

140+ tupleEnding start firstType (tipe : revTypes)

141+ , do Symbol.rightParen

138142 end <- getPosition

139− case reverse tipes of

140− [tipe] ->

141− return tipe

143+ case reverse revTypes of

144+ [] ->

145+ return firstType

142146

143− tupleTypes ->

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

147+ secondType : otherTypes ->

148+ return $ A.at start end $

149+ Type.RTuple firstType secondType otherTypes

145150 ]

146151

147152

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

151156

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

153158record start =

154− do leftCurly

155− inContext start E.TypeRecord $

159+ do Symbol.leftCurly

160+ P.inContext start E.TypeRecord $

156161 do spaces

157162 oneOf

158− [ do rightCurly

163+ [ do Symbol.rightCurly

159164 end <- getPosition

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

161− , do var <- addLocation lowVar

166+ , do var <- addLocation Var.lower

162167 spaces

163168 oneOf

164− [ do pipe

169+ [ do Symbol.pipe

165170 spaces

166171 firstField <- field

167172 fields <- chompFields [firstField]

168173 end <- getPosition

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

170− , do hasType

175+ , do Symbol.hasType

171176 spaces

172177 (tipe, _, nextPos) <- expression

173178 checkSpace nextPos

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

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

185190chompFields fields =

186191 oneOf

187− [ do comma

192+ [ do Symbol.comma

188193 spaces

189194 f <- field

190195 chompFields (f : fields)

191− , do rightCurly

196+ , do Symbol.rightCurly

192197 return (reverse fields)

193198 ]

194199

195200

196201field :: Parser Field

197202field =

198− do name <- addLocation lowVar

203+ do name <- addLocation Var.lower

199204 spaces

200− hasType

205+ Symbol.hasType

201206 spaces

202207 (tipe, _, endPos) <- expression

203208 checkSpace endPos