c5da7c0 · elk · git.iko.soy

git.iko.soy/elk

Get parse error messages working again

The most important addition is the concept of a stack of “context” so the error message can say what the parser thinks it is doing. This commit also adds custom error messages for all the different scenarios that may come up.

commitc5da7c0b1816f67dfad0a71c38c8c3bea4017007 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 14 Dec 2016, 16:01 (10 years ago) parentf284fab

10 files changed+649−398

compare with master

unifiedsplit

src/Docs/Check.hs+3−2 src/Parse/Declaration.hs+25−21 src/Parse/Expression.hs+102−90 src/Parse/Helpers.hs+30−18 src/Parse/Module.hs+13−14 src/Parse/Parse.hs+2−1 src/Parse/Pattern.hs+26−21 src/Parse/Primitives.hs+176−114 src/Parse/Type.hs+42−37 src/Reporting/Error/Syntax.hs+230−80

src/Docs/Check.hs+3−2

@@ -12,11 +12,12 @@ import Elm.Utils ((|>))

1212import qualified Reporting.Annotation as A

1313import qualified Reporting.Error as Error

1414import qualified Reporting.Error.Docs as E

15+import qualified Reporting.Error.Syntax as SE

1516import qualified Reporting.Helpers as Help (nearbyNames)

1617import qualified Reporting.Region as R

1718import qualified Reporting.Result as R

1819import Parse.Helpers

19− ( Parser, addLocation, getPosition

20+ ( Parser, addLocation, getPosition, inContext

2021 , spaces, checkSpace, whitespace, SPos(..)

2122 , capVar, lowVar, leftParen, rightParen, infixOp, runAt

2223 , chompUntilDocs, comma, oneOf

@@ -161,7 +162,7 @@ checkModuleComment docRegion exports locatedDocNames =

161162

162163parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]

163164parseNames (R.Region (R.Position row col) _) comment =

164− case runAt row (col + 3) (namesParser []) comment of

165+ case runAt row (col + 3) (inContext SE.DocComment (namesParser [])) comment of

165166 Left (A.A region parseError) ->

166167 R.throw region (Error.Syntax parseError)

167168

src/Parse/Declaration.hs+25−21

@@ -10,6 +10,7 @@ import qualified Parse.Expression as Expr

1010import Parse.Helpers as Help

1111import qualified Parse.Type as Type

1212import qualified Reporting.Annotation as A

13+import qualified Reporting.Error.Syntax as E

1314import qualified Reporting.Region as R

1415

1516

@@ -61,16 +62,18 @@ typeDecl start =

6162 spaces

6263 oneOf

6364 [ do keyword "alias"

64− spaces

65− (name, args) <- nameArgsEquals

66− (tipe, end, pos) <- Type.expression

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

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

69− , do (name, args) <- nameArgsEquals

70− (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

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

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

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

65+ inContext E.TypeAlias $

66+ do spaces

67+ (name, args) <- nameArgsEquals

68+ (tipe, end, pos) <- Type.expression

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

70+ return ( Decl.Whatever decl, end, pos )

71+ , inContext E.TypeUnion $

72+ do (name, args) <- nameArgsEquals

73+ (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

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

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

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

7477 ]

7578

7679

@@ -113,11 +116,11 @@ infixDecl :: R.Position -> SParser Decl.Source

113116infixDecl start =

114117 oneOf

115118 [ do keyword "infixl"

116− infixDeclHelp start Decl.L

119+ inContext E.Infix $ infixDeclHelp start Decl.L

117120 , do keyword "infixr"

118− infixDeclHelp start Decl.R

121+ inContext E.Infix $ infixDeclHelp start Decl.R

119122 , do keyword "infix"

120− infixDeclHelp start Decl.N

123+ inContext E.Infix $ infixDeclHelp start Decl.N

121124 ]

122125

123126

@@ -140,12 +143,13 @@ infixDeclHelp start assoc =

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

141144portDecl start =

142145 do keyword "port"

143− spaces

144− name <- lowVar

145− spaces

146− hasType

147− spaces

148− (tipe, end, pos) <- Type.expression

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

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

146+ inContext E.Port $

147+ do spaces

148+ name <- lowVar

149+ spaces

150+ hasType

151+ spaces

152+ (tipe, end, pos) <- Type.expression

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

154+ return ( Decl.Whatever decl, end, pos )

151155

src/Parse/Expression.hs+102−90

@@ -15,6 +15,7 @@ import qualified Parse.Type as Type

1515import qualified AST.Expression.Source as Src

1616import qualified AST.Pattern as P

1717import qualified Reporting.Annotation as A

18+import qualified Reporting.Error.Syntax as E

1819import qualified Reporting.Region as R

1920

2021

@@ -24,6 +25,7 @@ import qualified Reporting.Region as R

2425

2526term :: Parser Src.RawExpr

2627term =

28+ hint E.Expr $

2729 do start <- getPosition

2830 oneOf

2931 [ variable start >>= accessible start

@@ -79,15 +81,16 @@ accessible start expr =

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

8082list start =

8183 do leftSquare

82− spaces

83− oneOf

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

85− checkSpace pos

86− listHelp start [entry]

87− , do rightSquare

88− end <- getPosition

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

90− ]

84+ inContext E.ExprList $

85+ do spaces

86+ oneOf

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

88+ checkSpace pos

89+ listHelp start [entry]

90+ , do rightSquare

91+ end <- getPosition

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

93+ ]

9194

9295

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

@@ -111,33 +114,33 @@ listHelp start entries =

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

112115tuple start =

113116 do leftParen

114− oneOf

115− [ do op <- infixOp

116− rightParen

117− end <- getPosition

118− let x = A.at start end (Src.var "x")

119− let y = A.at start end (Src.var "y")

120− return $ mkLambda start end "x" $ mkLambda start end "y" $

121− A.at start end (Src.Binop [(x, A.at start end op)] y)

122−

123− , do rightParen

124− end <- getPosition

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

126−

127− , do comma

128− arity <- chompCommas 2

129− rightParen

130− end <- getPosition

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

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

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

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

135−

136− , do spaces

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

138− checkSpace pos

139− tupleHelp start [entry]

140− ]

117+ inContext E.ExprTuple $ oneOf $

118+ [ do op <- infixOp

119+ rightParen

120+ end <- getPosition

121+ let x = A.at start end (Src.var "x")

122+ let y = A.at start end (Src.var "y")

123+ return $ mkLambda start end "x" $ mkLambda start end "y" $

124+ A.at start end (Src.Binop [(x, A.at start end op)] y)

125+

126+ , do rightParen

127+ end <- getPosition

128+ return (A.at start end (Src.tuple []))

129+

130+ , do comma

131+ arity <- chompCommas 2

132+ rightParen

133+ end <- getPosition

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

135+ let ann x = A.at start end x

136+ let result = ann (Src.tuple (map (ann . Src.var) args))

137+ return (foldr (mkLambda start end) result args)

138+

139+ , do spaces

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

141+ checkSpace pos

142+ tupleHelp start [entry]

143+ ]

141144

142145

143146mkLambda :: R.Position -> R.Position -> Text -> Src.RawExpr -> Src.RawExpr

@@ -179,29 +182,30 @@ tupleHelp start entries =

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

180183record start =

181184 do leftCurly

182− spaces

183− oneOf

184− [ do rightCurly

185− end <- getPosition

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

187− , do starter <- addLocation lowVar

188− spaces

189− oneOf

190− [ do pipe

191− spaces

192− firstField <- chompField

193− fields <- chompFields [firstField]

194− end <- getPosition

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

196− , do equals

197− spaces

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

199− checkSpace nextPos

200− fields <- chompFields [(starter, value)]

201− end <- getPosition

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

203− ]

204− ]

185+ inContext E.ExprRecord $

186+ do spaces

187+ oneOf

188+ [ do rightCurly

189+ end <- getPosition

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

191+ , do starter <- addLocation lowVar

192+ spaces

193+ oneOf

194+ [ do pipe

195+ spaces

196+ firstField <- chompField

197+ fields <- chompFields [firstField]

198+ end <- getPosition

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

200+ , do equals

201+ spaces

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

203+ checkSpace nextPos

204+ fields <- chompFields [(starter, value)]

205+ end <- getPosition

206+ return (A.at start end (Src.Record fields))

207+ ]

208+ ]

205209

206210

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

@@ -240,6 +244,7 @@ type ExprParser =

240244

241245expression :: ExprParser

242246expression =

247+ hint E.Expr $

243248 do start <- getPosition

244249 oneOf

245250 [ let_ start

@@ -346,24 +351,25 @@ possiblyNegativeTerm start =

346351

347352if_ :: R.Position -> ExprParser

348353if_ start =

349− ifHelp start []

354+ do keyword "if"

355+ inContext E.ExprIf $ ifHelp start []

350356

351357

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

353359ifHelp start branches =

354− do keyword "if"

355− spaces

360+ do spaces

356361 (condition, _, condPos) <- expression

357362 checkSpace condPos

358363 keyword "then"

359364 spaces

360365 (thenBranch, _, thenPos) <- expression

361− checkSpace thenPos

362− keyword "else"

366+ hint E.ElseBranch $ checkSpace thenPos

367+ hint E.ElseBranch $ keyword "else"

363368 spaces

364369 let newBranches = (condition, thenBranch) : branches

365370 oneOf

366− [ ifHelp start newBranches

371+ [ do keyword "if"

372+ ifHelp start newBranches

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

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

369375 return ( ifExpr, elseEnd, elseSpace )

@@ -377,14 +383,15 @@ ifHelp start branches =

377383function :: R.Position -> ExprParser

378384function start =

379385 do lambda

380− spaces

381− arg <- Pattern.term

382− spaces

383− revArgs <- gatherArgs [arg]

384− spaces

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

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

387− return ( func, end, space )

386+ inContext E.ExprFunc $

387+ do spaces

388+ arg <- Pattern.term

389+ spaces

390+ revArgs <- gatherArgs [arg]

391+ spaces

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

393+ let func = List.foldl' (\e x -> A.at start end (Src.Lambda x e)) body revArgs

394+ return ( func, end, space )

388395

389396

390397gatherArgs :: [P.Raw] -> Parser [P.Raw]

@@ -409,18 +416,19 @@ case_ start =

409416 (switcher, _, switcherPos) <- expression

410417 checkSpace switcherPos

411418 keyword "of"

412− spaces

413− oldIndent <- getIndent

414− newIndent <- getCol

415− setIndent newIndent

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

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

418− setIndent oldIndent

419− return

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

421− , end

422− , pos

423− )

419+ inContext E.ExprCase $

420+ do spaces

421+ oldIndent <- getIndent

422+ newIndent <- getCol

423+ setIndent newIndent

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

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

426+ setIndent oldIndent

427+ return

428+ ( A.at start end (Src.Case switcher branches)

429+ , end

430+ , pos

431+ )

424432

425433

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

@@ -452,6 +460,7 @@ let_ start =

452460 do oldIndent <- getIndent

453461 letIndent <- getCol

454462 keyword "let"

463+ pushContext E.ExprLet

455464 setIndent letIndent

456465 spaces

457466 defIndent <- getCol

@@ -470,6 +479,7 @@ letHelp start oldIndent defs end pos =

470479 , do setIndent oldIndent

471480 checkSpace pos

472481 keyword "in"

482+ popContext ()

473483 spaces

474484 (body, newEnd, newPos) <- expression

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

@@ -490,10 +500,12 @@ definition =

490500 P.Var name ->

491501 oneOf

492502 [ do hasType

493− spaces

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

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

496− , definitionHelp start root []

503+ inContext (E.Annotation name) $

504+ do spaces

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

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

507+ , inContext (E.Definition name) $

508+ definitionHelp start root []

497509 ]

498510

499511 _ ->

@@ -514,7 +526,7 @@ rootPattern start =

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

515527definitionHelp start root revArgs =

516528 oneOf

517− [ do arg <- Pattern.term

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

518530 spaces

519531 definitionHelp start root (arg : revArgs)

520532 , do equals

src/Parse/Helpers.hs+30−18

@@ -6,8 +6,8 @@ module Parse.Helpers

66 , qualifiedVar, qualifiedCapVar

77 , equals, rightArrow, hasType, comma, pipe, cons, dot, minus, underscore, lambda

88 , leftParen, rightParen, leftSquare, rightSquare, leftCurly, rightCurly

9− , addLocation

10− , spaces, checkSpace, checkAligned, checkFreshline

9+ , addLocation, inContext

10+ , spaces, checkSpace, checkAligned, checkFreshLine

1111 )

1212 where

1313

@@ -15,6 +15,7 @@ import qualified Data.Text as Text

1515import Data.Text (Text)

1616

1717import Parse.Primitives

18+import qualified Parse.Primitives as P

1819import qualified Reporting.Annotation as A

1920import qualified Reporting.Error.Syntax as E

2021import qualified Reporting.Region as R

@@ -35,7 +36,13 @@ type SParser a =

3536qualifiedCapVar :: Parser Text

3637qualifiedCapVar =

3738 do var <- capVar

38− qualifiedVarHelp True [var]

39+ qualifiedVarHelp qualifiedCapVarHelp [var]

40+

41+

42+qualifiedCapVarHelp :: Parser a

43+qualifiedCapVarHelp =

44+ do ctx <- getContext

45+ failure (E.Theories ctx [E.CapVar])

3946

4047

4148qualifiedVar :: Parser Text

@@ -43,22 +50,19 @@ qualifiedVar =

4350 oneOf

4451 [ lowVar

4552 , do var <- capVar

46− qualifiedVarHelp False [var]

53+ qualifiedVarHelp lowVar [var]

4754 ]

4855

4956

50−qualifiedVarHelp :: Bool -> [Text] -> Parser Text

51−qualifiedVarHelp allCaps vars =

57+qualifiedVarHelp :: Parser Text -> [Text] -> Parser Text

58+qualifiedVarHelp altEnding vars =

5259 oneOf

5360 [ do dot

5461 oneOf

5562 [ do var <- capVar

56− qualifiedVarHelp allCaps (var:vars)

57− , if allCaps then

58− failure E.BadChunkInQualifiedCapVar

59− else

60− do var <- lowVar

61− return (Text.intercalate "." (reverse (var:vars)))

63+ qualifiedVarHelp altEnding (var:vars)

64+ , do var <- altEnding

65+ return (Text.intercalate "." (reverse (var:vars)))

6266 ]

6367 , return (Text.intercalate "." (reverse vars))

6468 ]

@@ -182,6 +186,12 @@ addLocation parser =

182186 return (A.at start end value)

183187

184188

189+inContext :: E.Context -> Parser a -> Parser a

190+inContext ctx parser =

191+ do P.pushContext ctx

192+ a <- parser

193+ P.popContext a

194+

185195

186196-- WHITESPACE VARIATIONS

187197

@@ -192,7 +202,9 @@ spaces =

192202 indent <- getIndent

193203 if col > indent && col > 1

194204 then return ()

195− else failure (E.Theories [E.BadIndent])

205+ else

206+ do ctx <- getContext

207+ failure (E.Theories ctx [E.BadSpace])

196208

197209

198210checkSpace :: SPos -> Parser ()

@@ -200,7 +212,7 @@ checkSpace (SPos (R.Position _ col)) =

200212 do indent <- getIndent

201213 if col > indent && col > 1

202214 then return ()

203− else deadend E.BadIndent

215+ else deadend [E.BadSpace]

204216

205217

206218checkAligned :: SPos -> Parser ()

@@ -208,11 +220,11 @@ checkAligned (SPos (R.Position _ col)) =

208220 do indent <- getIndent

209221 if col == indent

210222 then return ()

211− else deadend E.BadIndent

223+ else deadend [E.BadSpace]

212224

213225

214−checkFreshline :: SPos -> Parser ()

215−checkFreshline (SPos (R.Position _ col)) =

226+checkFreshLine :: E.NextDecl -> SPos -> Parser ()

227+checkFreshLine nextDecl (SPos (R.Position _ col)) =

216228 if col == 1

217229 then return ()

218− else deadend E.FreshLine

230+ else deadend [E.FreshLine nextDecl]

src/Parse/Module.hs+13−14

@@ -8,6 +8,7 @@ import qualified AST.Module as Module

88import qualified AST.Variable as Var

99import Parse.Helpers

1010import qualified Reporting.Annotation as A

11+import qualified Reporting.Error.Syntax as E

1112import qualified Reporting.Region as R

1213

1314

@@ -18,7 +19,7 @@ import qualified Reporting.Region as R

1819header :: Parser (Module.Header [Module.UserImport])

1920header =

2021 do start <- getPosition

21− freshLine

22+ freshLine E.ModuleDecl

2223 end <- getPosition

2324 oneOf

2425 [ fullHeader

@@ -34,14 +35,14 @@ fullHeader :: Parser (Module.Header [Module.UserImport])

3435fullHeader =

3536 do tag <- sourceTag

3637 spaces

37− name <- qualifiedCapVar -- TODO <?> "the name of this module"

38+ name <- qualifiedCapVar

3839 spaces

3940 settings <- effectSettings

40− keyword "exposing" -- TODO <?> "something like `exposing (..)` which replaced `where` in 0.17"

41+ hint E.Exposing $ keyword "exposing"

4142 spaces

4243 exports <- listing (addLocation listingValue)

4344 start <- getPosition

44− freshLine

45+ freshLine E.DocCommentDecl

4546 end <- getPosition

4647 docs <- maybeDocComment start end

4748 imports <- chompImports []

@@ -127,7 +128,7 @@ maybeDocComment :: R.Position -> R.Position -> Parser (A.Located (Maybe Text))

127128maybeDocComment start end =

128129 oneOf

129130 [ do doc <- addLocation docComment

130− freshLine

131+ freshLine E.ImportDecl

131132 return (A.map Just doc)

132133 , return (A.at start end Nothing)

133134 ]

@@ -147,7 +148,7 @@ chompImports imports =

147148 end <- getPosition

148149 pos <- whitespace

149150 oneOf

150− [ do checkFreshline pos

151+ [ do checkFreshLine E.ImportDecl pos

151152 let userImport = method start end name Nothing Var.closedListing

152153 chompImports (userImport:imports)

153154 , do checkSpace pos

@@ -168,7 +169,7 @@ chompAs start name imports =

168169 end <- getPosition

169170 pos <- whitespace

170171 oneOf

171− [ do checkFreshline pos

172+ [ do checkFreshLine E.ImportDecl pos

172173 let userImport = method start end name (Just alias) Var.closedListing

173174 chompImports (userImport:imports)

174175 , do checkSpace pos

@@ -182,7 +183,7 @@ chompExposing start name maybeAlias imports =

182183 spaces

183184 exposed <- listing listingValue

184185 end <- getPosition

185− freshLine

186+ freshLine E.ImportDecl

186187 let userImport = method start end name maybeAlias exposed

187188 chompImports (userImport:imports)

188189

@@ -198,7 +199,7 @@ method start end name maybeAlias exposed =

198199

199200listing :: Parser a -> Parser (Var.Listing a)

200201listing parser =

201− expecting "a listing of values and types to expose, like (..)" $

202+ hint E.Listing $

202203 do leftParen

203204 spaces

204205 oneOf

@@ -231,9 +232,7 @@ listingValue =

231232 oneOf

232233 [ Var.Value <$> lowVar

233234 , do leftParen

234− spaces

235235 op <- infixOp

236− spaces

237236 rightParen

238237 return (Var.Value op)

239238 , do name <- capVar

@@ -249,8 +248,8 @@ listingValue =

249248-- FRESH LINES

250249

251250

252−freshLine :: Parser ()

253−freshLine =

251+freshLine :: E.NextDecl -> Parser ()

252+freshLine nextDecl =

254253 do pos <- whitespace

255− checkFreshline pos

254+ checkFreshLine nextDecl pos

256255

src/Parse/Parse.hs+2−1

@@ -11,6 +11,7 @@ import Parse.Helpers

1111import qualified Parse.Module as Parse (header)

1212import qualified Parse.Declaration as Parse (declaration)

1313import qualified Reporting.Annotation as A

14+import qualified Reporting.Error.Syntax as E

1415import qualified Reporting.Result as Result

1516import qualified Validate

1617

@@ -44,7 +45,7 @@ chompDeclarations :: [Decl.Source] -> Parser [Decl.Source]

4445chompDeclarations decls =

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

4647 oneOf

47− [ do checkFreshline pos

48+ [ do checkFreshLine E.OtherDecl pos

4849 chompDeclarations (decl:decls)

4950 , return (reverse (decl:decls))

5051 ]

src/Parse/Pattern.hs+26−21

@@ -10,6 +10,7 @@ import qualified AST.Variable as Var

1010import Parse.Helpers

1111import qualified Parse.Literal as Literal

1212import qualified Reporting.Annotation as A

13+import qualified Reporting.Error.Syntax as E

1314import qualified Reporting.Region as R

1415

1516

@@ -19,7 +20,8 @@ import qualified Reporting.Region as R

1920

2021term :: Parser P.Raw

2122term =

22− oneOf [ record, tuple, list, termHelp ]

23+ hint E.Pattern $

24+ oneOf [ record, tuple, list, termHelp ]

2325

2426

2527termHelp :: Parser P.Raw

@@ -55,14 +57,15 @@ record :: Parser P.Raw

5557record =

5658 addLocation $

5759 do leftCurly

58− spaces

59− oneOf

60− [ do var <- lowVar

61− spaces

62− recordHelp [var]

63− , do rightCurly

64− return (P.Record [])

65− ]

60+ inContext E.ExprRecord $

61+ do spaces

62+ oneOf

63+ [ do var <- lowVar

64+ spaces

65+ recordHelp [var]

66+ , do rightCurly

67+ return (P.Record [])

68+ ]

6669

6770

6871recordHelp :: [Text] -> Parser P.Raw'

@@ -86,15 +89,16 @@ tuple :: Parser P.Raw

8689tuple =

8790 do start <- getPosition

8891 leftParen

89− spaces

90− oneOf

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

92− checkSpace sPos

93− tupleHelp start [pattern]

94− , do rightParen

95− end <- getPosition

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

97− ]

92+ inContext E.ExprTuple $

93+ do spaces

94+ oneOf

95+ [ do (pattern, sPos) <- expression

96+ checkSpace sPos

97+ tupleHelp start [pattern]

98+ , do rightParen

99+ end <- getPosition

100+ return (A.at start end (P.tuple []))

101+ ]

98102

99103

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

@@ -154,9 +158,10 @@ listHelp patterns =

154158

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

156160expression =

157− do start <- getPosition

158− cTerm <- consTerm

159− exprHelp start [] cTerm

161+ hint E.Pattern $

162+ do start <- getPosition

163+ cTerm <- consTerm

164+ exprHelp start [] cTerm

160165

161166

162167consTerm :: SParser P.Raw

src/Parse/Primitives.hs+176−114

@@ -3,11 +3,12 @@

33module Parse.Primitives

44 ( Parser

55 , run, runAt

6− , try, failure, deadend, expecting, endOfFile

6+ , try, failure, deadend, hint, endOfFile

77 , oneOf

88 , symbol, keyword, keywords

99 , lowVar, capVar, infixOp

1010 , getPosition, getCol

11+ , getContext, pushContext, popContext

1112 , getIndent, setIndent

1213 , SPos(..), whitespace

1314 , docComment, chompUntilDocs

@@ -38,8 +39,11 @@ import qualified AST.Helpers as Help (isSymbol)

3839import qualified AST.Literal as L

3940import qualified Reporting.Annotation as A

4041import qualified Reporting.Error.Syntax as E

41−import Reporting.Error.Syntax ( ParseError(..), Problem(..), Theory(..) )

4242import qualified Reporting.Region as Region

43+import Reporting.Error.Syntax

44+ ( ParseError(..), Problem(..), Theory(..)

45+ , Context(..), BadOp(..)

46+ )

4347

4448

4549

@@ -51,10 +55,10 @@ newtype Parser a =

5155 { _run

5256 :: forall b.

5357 State

54− -> (a -> State -> b) -- consumed ok

55− -> (ParseError -> b) -- consumed err

56− -> (a -> State -> b) -- empty ok

57− -> (ParseError -> b) -- empty err

58+ -> (a -> State -> ParseError -> b) -- consumed ok

59+ -> ( ParseError -> b) -- consumed err

60+ -> (a -> State -> ParseError -> b) -- empty ok

61+ -> ( ParseError -> b) -- empty err

5862 -> b

5963 }

6064

@@ -67,24 +71,20 @@ data State =

6771 , _indent :: !Int

6872 , _row :: !Int

6973 , _col :: !Int

74+ , _context :: [Context]

7075 }

7176

7277

73−data Result a

74− = Ok a State

75− | Err ParseError

76−

78+{-# NOINLINE noError #-}

79+noError :: ParseError

80+noError =

81+ ParseError 0 0 (Theories [] [])

7782

78−{-# INLINE noTheory #-}

79−noTheory :: Int -> Int -> ParseError

80−noTheory row col =

81− ParseError row col (Theories [])

8283

83−

84−{-# INLINE loneTheory #-}

85−loneTheory :: Int -> Int -> Theory -> ParseError

86−loneTheory row col theory =

87− ParseError row col (Theories [theory])

84+{-# INLINE expect #-}

85+expect :: Int -> Int -> [Context] -> Theory -> ParseError

86+expect row col ctx theory =

87+ ParseError row col (Theories ctx [theory])

8888

8989

9090

@@ -98,8 +98,8 @@ run parser text =

9898

9999runAt :: Int -> Int -> Parser a -> Text -> Either (A.Located E.Error) a

100100runAt sRow sCol parser (Text.Text array offset length) =

101− case _run parser (State array offset length 0 sRow sCol) Ok Err Ok Err of

102− Ok value _ ->

101+ case _run parser (State array offset length 0 sRow sCol []) Ok Err Ok Err of

102+ Ok value _ _ ->

103103 Right value

104104

105105 Err (ParseError row col problem) ->

@@ -110,6 +110,11 @@ runAt sRow sCol parser (Text.Text array offset length) =

110110 Left (A.A region (E.Parse problem))

111111

112112

113+data Result a

114+ = Ok a State ParseError

115+ | Err ParseError

116+

117+

113118

114119-- COMBINATORS

115120

@@ -122,7 +127,7 @@ try parser =

122127

123128failure :: Problem -> Parser a

124129failure problem =

125− Parser $ \(State _ _ _ _ row col) _ cerr _ _ ->

130+ Parser $ \(State _ _ _ _ row col _) _ cerr _ _ ->

126131 cerr (ParseError row col problem)

127132

128133

@@ -132,33 +137,33 @@ shaderFailure row col msg =

132137 cerr (ParseError row col (BadShader msg))

133138

134139

135−deadend :: Theory -> Parser a

136−deadend theory =

137− Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->

138− eerr (loneTheory row col theory)

140+deadend :: [Theory] -> Parser a

141+deadend thrys =

142+ Parser $ \(State _ _ _ _ row col ctx) _ _ _ eerr ->

143+ eerr (ParseError row col (Theories ctx thrys))

139144

140145

141−expecting :: Text -> Parser a -> Parser a

142−expecting description parser =

143− Parser $ \state@(State _ _ _ _ row col) cok cerr eok eerr ->

146+hint :: E.Next -> Parser a -> Parser a

147+hint next parser =

148+ Parser $ \state@(State _ _ _ _ row col ctx) cok cerr eok eerr ->

144149 let

145− eok' x s =

146− eok x s

150+ eok' x s _ =

151+ eok x s (expect row col ctx (Expecting next))

147152

148153 eerr' _ =

149− eerr (loneTheory row col (Expecting description))

154+ eerr (expect row col ctx (Expecting next))

150155 in

151156 _run parser state cok cerr eok' eerr'

152157

153158

154159endOfFile :: Parser ()

155160endOfFile =

156− Parser $ \state@(State _ _ length _ row col) _ _ eok eerr ->

161+ Parser $ \state@(State _ _ length _ row col ctx) _ _ eok eerr ->

157162 if length == 0 then

158− eok () state

163+ eok () state (expect row col ctx EndOfFile)

159164

160165 else

161− eerr (noTheory row col)

166+ eerr (expect row col ctx EndOfFile)

162167

163168

164169

@@ -169,8 +174,8 @@ instance Functor Parser where

169174 fmap f parser =

170175 Parser $ \state cok cerr eok eerr ->

171176 let

172− cok' x s = cok (f x) s

173− eok' x s = eok (f x) s

177+ cok' x s e = cok (f x) s e

178+ eok' x s e = eok (f x) s e

174179 in

175180 _run parser state cok' cerr eok' eerr

176181

@@ -196,18 +201,18 @@ oneOf parsers =

196201

197202allTheOptionsFailed :: Parser a

198203allTheOptionsFailed =

199− Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->

200− eerr (noTheory row col)

204+ Parser $ \_ _ _ _ eerr ->

205+ eerr noError

201206

202207

203208oneOfHelp :: Parser a -> Parser a -> Parser a

204209oneOfHelp parser1 parser2 =

205210 Parser $ \state cok cerr eok eerr ->

206211 let

207− eerr1 err1 =

212+ eerr1 e1 =

208213 let

209− eok2 y state' = eok y state'

210− eerr2 err2 = eerr (mergeErrors err1 err2)

214+ eok2 y s e2 = eok y s (mergeErrors e1 e2)

215+ eerr2 e2 = eerr (mergeErrors e1 e2)

211216 in

212217 _run parser2 state cok cerr eok2 eerr2

213218 in

@@ -215,16 +220,30 @@ oneOfHelp parser1 parser2 =

215220

216221

217222mergeErrors :: ParseError -> ParseError -> ParseError

218−mergeErrors error1@(ParseError row col problem1) error2@(ParseError _ _ problem2) =

219− case (problem1, problem2) of

220− (Theories theories1, Theories theories2) ->

221− ParseError row col (Theories (theories1 ++ theories2))

223+mergeErrors e1@(ParseError r1 c1 p1) e2@(ParseError r2 c2 p2) =

224+ case compare r1 r2 of

225+ LT -> e2

226+ GT -> e1

227+ EQ ->

228+ case compare c1 c2 of

229+ LT -> e2

230+ GT -> e1

231+ EQ ->

232+ case (p1, p2) of

233+ (Theories _ [], Theories _ _) ->

234+ e2

235+

236+ (Theories _ _, Theories _ []) ->

237+ e1

222238

223− (Theories _, _) ->

224− error2

239+ (Theories ctx ts1, Theories _ ts2) ->

240+ ParseError r1 c1 (Theories ctx (ts1 ++ ts2))

225241

226− (_, _) ->

227− error1

242+ (Theories _ _, _) ->

243+ e2

244+

245+ (_, _) ->

246+ e1

228247

229248

230249

@@ -234,18 +253,26 @@ mergeErrors error1@(ParseError row col problem1) error2@(ParseError _ _ problem2

234253instance Monad Parser where

235254 return value =

236255 Parser $ \state _ _ eok _ ->

237− eok value state

256+ eok value state noError

238257

239258 parser >>= callback =

240259 Parser $ \state cok cerr eok eerr ->

241260 let

242− cok' value newState =

243− _run (callback value) newState cok cerr cok cerr

261+ cok1 x s1 e1 =

262+ let

263+ eok2 y s2 e2 = cok y s2 (mergeErrors e1 e2)

264+ eerr2 e2 = cerr (mergeErrors e1 e2)

265+ in

266+ _run (callback x) s1 cok cerr eok2 eerr2

244267

245− eok' value newState =

246− _run (callback value) newState cok cerr eok eerr

268+ eok1 x s1 e1 =

269+ let

270+ eok2 y s2 e2 = eok y s2 (mergeErrors e1 e2)

271+ eerr2 e2 = eerr (mergeErrors e1 e2)

272+ in

273+ _run (callback x) s1 cok cerr eok2 eerr2

247274 in

248− _run parser state cok' cerr eok' eerr

275+ _run parser state cok1 cerr eok1 eerr

249276

250277

251278

@@ -254,16 +281,19 @@ instance Monad Parser where

254281

255282symbol :: Text -> Parser ()

256283symbol sym@(Text.Text tArray tOffset tLen) =

257− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

284+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

258285 if tLen <= length && Text.equal tArray tOffset array offset tLen then

259286 let

260287 (# newRow, newCol #) =

261288 moveCursor tArray tOffset tLen row col

289+

290+ !newState =

291+ State array (offset + tLen) (length - tLen) indent newRow newCol ctx

262292 in

263− cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

293+ cok () newState noError

264294

265295 else

266− eerr (loneTheory row col (Symbol sym))

296+ eerr (expect row col ctx (Symbol sym))

267297

268298

269299moveCursor :: Text.Array -> Int -> Int -> Int -> Int -> (# Int, Int #)

@@ -291,21 +321,24 @@ moveCursor array offset length row col =

291321

292322keyword :: Text -> Parser ()

293323keyword kwd@(Text.Text tArray tOffset tLen) =

294− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

324+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

295325 if tLen <= length && Text.equal tArray tOffset array offset tLen then

296326

297327 if isInnerVarChar (peekChar array (offset + tLen)) then

298− eerr (loneTheory row col (Keyword kwd))

328+ eerr (expect row col ctx (Keyword kwd))

299329

300330 else

301331 let

302332 (# newRow, newCol #) =

303333 moveCursor tArray tOffset tLen row col

334+

335+ !newState =

336+ State array (offset + tLen) (length - tLen) indent newRow newCol ctx

304337 in

305− cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

338+ cok () newState noError

306339

307340 else

308− eerr (loneTheory row col (Keyword kwd))

341+ eerr (expect row col ctx (Keyword kwd))

309342

310343

311344keywords :: Set.Set Text

@@ -328,20 +361,20 @@ keywords =

328361

329362lowVar :: Parser Text.Text

330363lowVar =

331− varPrim Char.isLower

364+ varPrim LowVar Char.isLower

332365

333366

334367capVar :: Parser Text.Text

335368capVar =

336− varPrim Char.isUpper

369+ varPrim CapVar Char.isUpper

337370

338371

339372{-# INLINE varPrim #-}

340−varPrim :: (Char -> Bool) -> Parser Text.Text

341−varPrim isGoodFirstChar =

342− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

373+varPrim :: Theory -> (Char -> Bool) -> Parser Text.Text

374+varPrim theory isGoodFirstChar =

375+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

343376 if length == 0 then

344− eerr (loneTheory row col Variable)

377+ eerr (expect row col ctx theory)

345378

346379 else

347380 let

@@ -356,12 +389,12 @@ varPrim isGoodFirstChar =

356389 copyText array offset (newOffset - offset)

357390 in

358391 if Set.member copiedText keywords then

359− eerr (loneTheory row newCol Variable)

392+ eerr (expect row newCol ctx theory)

360393 else

361− cok copiedText (State array newOffset newLength indent row newCol)

394+ cok copiedText (State array newOffset newLength indent row newCol ctx) noError

362395

363396 else

364− eerr (loneTheory row col Variable)

397+ eerr (expect row col ctx theory)

365398

366399

367400{-# INLINE copyText #-}

@@ -428,16 +461,16 @@ isInnerVarChar char =

428461

429462infixOp :: Parser Text

430463infixOp =

431− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

464+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

432465 if length == 0 then

433− eerr (loneTheory row col InfixOp)

466+ eerr (expect row col ctx InfixOp)

434467

435468 else

436469 let

437470 (Text.Iter char size) = peek array offset

438471 in

439472 if not (Help.isSymbol char) then

440− eerr (loneTheory row col InfixOp)

473+ eerr (expect row col ctx InfixOp)

441474 else

442475 case infixOpHelp array (offset + size) (length - size) row (col + 1) of

443476 Left err ->

@@ -445,12 +478,12 @@ infixOp =

445478

446479 Right ( newOffset, newLength, newCol ) ->

447480 case copyText array offset (newOffset - offset) of

448− "=" -> cerr (ParseError row col Dot)

449− "|" -> cerr (ParseError row col Pipe)

450− ":" -> cerr (ParseError row col Arrow)

451− "." -> cerr (ParseError row col Equals)

452− "->" -> cerr (ParseError row col HasType)

453− op -> cok op (State array newOffset newLength indent row newCol)

481+ "." -> cerr (ParseError row col (BadOp Dot ctx))

482+ "|" -> cerr (ParseError row col (BadOp Pipe ctx))

483+ "->" -> cerr (ParseError row col (BadOp Arrow ctx))

484+ "=" -> cerr (ParseError row col (BadOp Equals ctx))

485+ ":" -> cerr (ParseError row col (BadOp HasType ctx))

486+ op -> cok op (State array newOffset newLength indent row newCol ctx) noError

454487

455488

456489infixOpHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError (Int, Int, Int)

@@ -474,26 +507,44 @@ infixOpHelp array offset length row col =

474507

475508getPosition :: Parser Region.Position

476509getPosition =

477− Parser $ \state@(State _ _ _ _ row col) _ _ eok _ ->

478− eok (Region.Position row col) state

510+ Parser $ \state@(State _ _ _ _ row col _) _ _ eok _ ->

511+ eok (Region.Position row col) state noError

479512

480513

481514getIndent :: Parser Int

482515getIndent =

483− Parser $ \state@(State _ _ _ indent _ _) _ _ eok _ ->

484− eok indent state

516+ Parser $ \state@(State _ _ _ indent _ _ _) _ _ eok _ ->

517+ eok indent state noError

485518

486519

487520getCol :: Parser Int

488521getCol =

489− Parser $ \state@(State _ _ _ _ _ col) _ _ eok _ ->

490− eok col state

522+ Parser $ \state@(State _ _ _ _ _ col _) _ _ eok _ ->

523+ eok col state noError

524+

525+

526+getContext :: Parser [E.Context]

527+getContext =

528+ Parser $ \state@(State _ _ _ _ _ _ ctx) _ _ eok _ ->

529+ eok ctx state noError

530+

531+

532+pushContext :: E.Context -> Parser ()

533+pushContext ctx =

534+ Parser $ \state@(State _ _ _ _ _ _ context) _ _ eok _ ->

535+ eok () (state { _context = ctx : context }) noError

536+

537+

538+popContext :: a -> Parser a

539+popContext value =

540+ Parser $ \state@(State _ _ _ _ _ _ context) _ _ eok _ ->

541+ eok value (state { _context = tail context }) noError

491542

492543

493544setIndent :: Int -> Parser ()

494545setIndent indent =

495546 Parser $ \state _ _ eok _ ->

496− eok () (state { _indent = indent })

547+ eok () (state { _indent = indent }) noError

497548

498549

499550

@@ -506,7 +557,7 @@ newtype SPos =

506557

507558whitespace :: Parser SPos

508559whitespace =

509− Parser $ \(State array offset length indent row col) cok cerr _ _ ->

560+ Parser $ \(State array offset length indent row col ctx) cok cerr _ _ ->

510561 case eatSpaces array offset length row col of

511562 Left err ->

512563 cerr err

@@ -514,7 +565,8 @@ whitespace =

514565 Right (newOffset, newLength, newRow, newCol) ->

515566 cok

516567 (SPos (Region.Position newRow newCol))

517− (State array newOffset newLength indent newRow newCol)

568+ (State array newOffset newLength indent newRow newCol ctx)

569+ noError

518570

519571

520572eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

@@ -646,7 +698,7 @@ eatMultiCommentHelp array offset length row col openComments =

646698docComment :: Parser Text

647699docComment =

648700 do symbol "{-|"

649− Parser $ \(State array offset length indent row col) cok cerr _ _ ->

701+ Parser $ \(State array offset length indent row col ctx) cok cerr _ _ ->

650702 case eatMultiCommentHelp array offset length row col 1 of

651703 Left err ->

652704 cerr err

@@ -654,17 +706,21 @@ docComment =

654706 Right (newOffset, newLength, newRow, newCol) ->

655707 cok

656708 (copyText array offset (newOffset - offset))

657− (State array newOffset newLength indent newRow newCol)

709+ (State array newOffset newLength indent newRow newCol ctx)

710+ noError

658711

659712

660713chompUntilDocs :: Parser Bool

661714chompUntilDocs =

662− Parser $ \(State array offset length indent row col) cok _ _ _ ->

715+ Parser $ \(State array offset length indent row col ctx) cok _ _ _ ->

663716 let

664717 (# isStart, newOffset, newLength, newRow, newCol #) =

665718 eatDocs array offset length row col

719+

720+ !newState =

721+ State array newOffset newLength indent newRow newCol ctx

666722 in

667− cok isStart (State array newOffset newLength indent newRow newCol)

723+ cok isStart newState noError

668724

669725

670726eatDocs :: Text.Array -> Int -> Int -> Int -> Int -> (# Bool, Int, Int, Int, Int #)

@@ -705,16 +761,16 @@ isDocsStart array offset length =

705761

706762string :: Parser Text.Text

707763string =

708− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

764+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

709765 if length == 0 then

710− eerr (noTheory row col)

766+ eerr noError

711767

712768 else

713769 let

714770 !word = Text.unsafeIndex array offset

715771 in

716772 if word /= 0x0022 {- " -} then

717− eerr (noTheory row col)

773+ eerr noError

718774

719775 else

720776 let

@@ -731,7 +787,8 @@ string =

731787 Right ( newOffset, newLength, newCol, builder ) ->

732788 cok

733789 (LT.toStrict (LB.toLazyText builder))

734− (State array newOffset newLength indent row newCol)

790+ (State array newOffset newLength indent row newCol ctx)

791+ noError

735792

736793

737794{-# INLINE isQuote #-}

@@ -880,13 +937,13 @@ multiString array offset length row col initialOffset builder =

880937

881938character :: Parser Text

882939character =

883− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

940+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

884941 if length == 0 then

885− eerr (noTheory row col)

942+ eerr noError

886943

887944 else

888945 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then

889− eerr (noTheory row col)

946+ eerr noError

890947

891948 else if length < 3 then

892949 cerr (ParseError row col BadChar)

@@ -907,7 +964,8 @@ character =

907964 else

908965 cok

909966 (copyText array (offset + 1) size)

910− (State array (newOffset + 1) (newLength - 1) indent row endCol)

967+ (State array (newOffset + 1) (newLength - 1) indent row endCol ctx)

968+ noError

911969

912970

913971characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int )

@@ -938,9 +996,9 @@ characterHelp array offset length row col =

938996

939997digit :: Parser Int

940998digit =

941− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

999+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

9421000 if length == 0 then

943− eerr (loneTheory row col Digit)

1001+ eerr (expect row col ctx Digit)

9441002

9451003 else

9461004 let

@@ -949,9 +1007,10 @@ digit =

9491007 if isDigit word then

9501008 cok

9511009 (fromIntegral (word - 0x0030))

952− (State array (offset + 1) (length - 1) indent row (col + 1))

1010+ (State array (offset + 1) (length - 1) indent row (col + 1) ctx)

1011+ noError

9531012 else

954− eerr (loneTheory row col Digit)

1013+ eerr (expect row col ctx Digit)

9551014

9561015

9571016

@@ -960,16 +1019,16 @@ digit =

9601019

9611020number :: Parser L.Literal

9621021number =

963− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

1022+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

9641023 if length == 0 then

965− eerr (noTheory row col)

1024+ eerr noError

9661025

9671026 else

9681027 let

9691028 !word = Text.unsafeIndex array offset

9701029 in

9711030 if not (isDigit word) then

972− eerr (noTheory row col)

1031+ eerr noError

9731032

9741033 else

9751034 let

@@ -988,7 +1047,10 @@ number =

9881047 cerr (ParseError row (col + (newOffset - offset)) BadNumberEnd)

9891048

9901049 else

991− cok literal (State array newOffset newLength indent row (col + (newOffset - offset)))

1050+ cok

1051+ literal

1052+ (State array newOffset newLength indent row (col + (newOffset - offset)) ctx)

1053+ noError

9921054

9931055

9941056isDirtyEnd :: Text.Array -> Int -> Int -> Bool

@@ -1182,7 +1244,7 @@ readFloat array startOffset endOffset =

11821244shaderSource :: Parser Text

11831245shaderSource =

11841246 do symbol "[glsl|"

1185− Parser $ \(State array offset length indent row col) cok cerr _ _ ->

1247+ Parser $ \(State array offset length indent row col ctx) cok cerr _ _ ->

11861248 case eatShader array offset length row col of

11871249 Nothing ->

11881250 cerr (ParseError row col EndOfFile_Shader)

@@ -1190,10 +1252,10 @@ shaderSource =

11901252 Just ( shaderEndOffset, newRow, newCol ) ->

11911253 let

11921254 !size = shaderEndOffset - offset

1255+ !newState =

1256+ State array (shaderEndOffset + 2) (length - size - 2) indent newRow newCol ctx

11931257 in

1194− cok

1195− (copyText array offset size)

1196− (State array (shaderEndOffset + 2) (length - size - 2) indent newRow newCol)

1258+ cok (copyText array offset size) newState noError

11971259

11981260

11991261eatShader :: Text.Array -> Int -> Int -> Int -> Int -> Maybe (Int, Int, Int)

src/Parse/Type.hs+42−37

@@ -8,6 +8,7 @@ import qualified AST.Type as Type

88import qualified AST.Variable as Var

99import Parse.Helpers

1010import qualified Reporting.Annotation as A

11+import qualified Reporting.Error.Syntax as E

1112import qualified Reporting.Region as R

1213

1314

@@ -17,12 +18,13 @@ import qualified Reporting.Region as R

1718

1819term :: Parser Type.Raw

1920term =

20− oneOf

21− [ constructor

22− , variable

23− , tuple

24− , record

25− ]

21+ hint E.Type $

22+ oneOf

23+ [ constructor

24+ , variable

25+ , tuple

26+ , record

27+ ]

2628

2729

2830

@@ -31,7 +33,7 @@ term =

3133

3234variable :: Parser Type.Raw

3335variable =

34− expecting "a type variable" $ addLocation $

36+ addLocation $

3537 Type.RVar <$> lowVar

3638

3739

@@ -41,6 +43,7 @@ variable =

4143

4244expression :: SParser Type.Raw

4345expression =

46+ hint E.Type $

4447 do start <- getPosition

4548 (tipe1, end1, pos1) <-

4649 oneOf

@@ -64,7 +67,7 @@ expression =

6467

6568constructor :: Parser Type.Raw

6669constructor =

67− expecting "a type constructor, like Maybe or List" $ addLocation $

70+ addLocation $

6871 fmap (Type.RType . Var.Raw) qualifiedCapVar

6972

7073

@@ -115,15 +118,16 @@ tuple :: Parser Type.Raw

115118tuple =

116119 do start <- getPosition

117120 leftParen

118− oneOf

119− [ do rightParen

120− end <- getPosition

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

122− , do spaces

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

124− checkSpace pos

125− tupleEnding start [tipe]

126− ]

121+ inContext E.TypeTuple $

122+ oneOf

123+ [ do rightParen

124+ end <- getPosition

125+ return (Type.tuple (R.Region start end) [])

126+ , do spaces

127+ (tipe, _, pos) <- expression

128+ checkSpace pos

129+ tupleEnding start [tipe]

130+ ]

127131

128132

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

@@ -153,26 +157,27 @@ record :: Parser Type.Raw

153157record =

154158 addLocation $

155159 do leftCurly

156− spaces

157− oneOf

158− [ do rightCurly

159− return (Type.RRecord [] Nothing)

160− , do var <- addLocation lowVar

161− spaces

162− oneOf

163− [ do pipe

164− spaces

165− firstField <- field

166− fields <- chompFields [firstField]

167− return (Type.RRecord fields (Just (A.map Type.RVar var)))

168− , do hasType

169− spaces

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

171− checkSpace nextPos

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

173− return (Type.RRecord fields Nothing)

174− ]

175− ]

160+ inContext E.TypeRecord $

161+ do spaces

162+ oneOf

163+ [ do rightCurly

164+ return (Type.RRecord [] Nothing)

165+ , do var <- addLocation lowVar

166+ spaces

167+ oneOf

168+ [ do pipe

169+ spaces

170+ firstField <- field

171+ fields <- chompFields [firstField]

172+ return (Type.RRecord fields (Just (A.map Type.RVar var)))

173+ , do hasType

174+ spaces

175+ (tipe, _, nextPos) <- expression

176+ checkSpace nextPos

177+ fields <- chompFields [(var, tipe)]

178+ return (Type.RRecord fields Nothing)

179+ ]

180+ ]

176181

177182

178183type Field = ( A.Located Text, Type.Raw )

src/Reporting/Error/Syntax.hs+230−80

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

33module Reporting.Error.Syntax

44 ( Error(..)

55 , ParseError(..)

6− , Problem(..), Theory(..)

6+ , Problem(..), Theory(..), Context(..)

7+ , BadOp(..), Next(..), NextDecl(..)

78 , toReport

89 )

910 where

@@ -54,8 +55,7 @@ data Error

5455-- PARSE ERRORS

5556

5657

57−data ParseError

58− = ParseError !Int !Int !Problem

58+data ParseError = ParseError !Int !Int !Problem

5959

6060

6161data Problem

@@ -73,25 +73,62 @@ data Problem

7373 | BadNumberHex

7474 | BadNumberZero

7575 | BadShader Text

76− | BadChunkInQualifiedCapVar

77− | HasType

78− | Equals

79− | Arrow

80− | Pipe

81− | Dot

82− | Theories [Theory]

76+ | BadOp BadOp [Context]

77+ | Theories [Context] [Theory]

78+

79+

80+data BadOp = HasType | Equals | Arrow | Pipe | Dot

8381

8482

8583data Theory

86− = Keyword Text

84+ = Expecting Next

85+ | Keyword Text

8786 | Symbol Text

88− | Variable

87+ | LowVar

88+ | CapVar

8989 | InfixOp

9090 | Digit

91− | BadIndent

92− | FreshLine

93− | Expecting Text

94− deriving (Eq, Ord)

91+ | EndOfFile

92+ | FreshLine NextDecl

93+ | BadSpace

94+ deriving (Eq, Ord, Show)

95+

96+

98+ deriving (Eq, Ord, Show)

99+

100+

101+data NextDecl = ModuleDecl | DocCommentDecl | ImportDecl | OtherDecl

102+ deriving (Eq, Ord, Show)

103+

104+

105+data Context

106+ = ExprIf

107+ | ExprLet

108+ | ExprFunc

109+ | ExprCase

110+ | ExprList

111+ | ExprTuple

112+ | ExprRecord

113+ ----------------

114+ | Definition Text

115+ | Annotation Text

116+ ----------------

117+ | TypeTuple

118+ | TypeRecord

119+ ----------------

120+ | PatternList

121+ | PatternTuple

122+ | PatternRecord

123+ ----------------

124+ | Module

125+ | Import

126+ | DocComment

127+ | TypeUnion

128+ | TypeAlias

129+ | Infix

130+ | Port

131+ deriving (Eq, Ord, Show)

95132

96133

97134

@@ -149,8 +186,8 @@ toReport _localizer err =

149186 "A normal module can expose values, but not settings like this."

150187 ( reflowParagraph $

151188 "If you want a normal module, just remove this stuff. If you want to create\

152− \ an `effect module` you just forgot to use the `effect` keyword. In that\

153− \ case, just change `module` to `effect module` and you should be headed in\

189+ \ an `effect module` you forgot to use the `effect` keyword. In that\

190+ \ case, change `module` to `effect module` and you should be headed in\

154191 \ the right direction!"

155192 )

156193

@@ -161,7 +198,7 @@ toReport _localizer err =

161198 "A port module can expose values, but not have settings like this."

162199 ( reflowParagraph $

163200 "If you want a port module, just remove this stuff. If you want to create\

164− \ a custom effect module instead (which is rare) just change `port module`\

201+ \ a custom effect module instead (which is rare) change `port module`\

165202 \ to `effect module` and you should be headed in the right direction!"

166203 )

167204

@@ -214,7 +251,7 @@ toReport _localizer err =

214251 Nothing

215252 ("You are declaring port " <> Help.functionName name <> " in a normal module.")

216253 ( reflowParagraph $

217− "All ports must be defined in a `port module`. You should probably have just\

254+ "All ports must be defined in a `port module`. You should probably have only\

218255 \ one of these for your project. This way all of your foreign interactions\

219256 \ stay relatively organized."

220257 )

@@ -429,7 +466,7 @@ problemToReport problem =

429466 "Ran into a bad use of single quotes."

430467 ( Help.stack

431468 [ reflowParagraph $

432− "If you want to create a string, just switch to double quotes:"

469+ "If you want to create a string, switch to double quotes:"

433470 , Help.indent 4 $

434471 dullyellow (text "'this'")

435472 <> text " => "

@@ -483,48 +520,47 @@ problemToReport problem =

483520 "I ran into a problem while parsing this GLSL block."

484521 (reflowParagraph msg)

485522

486− BadChunkInQualifiedCapVar ->

487− error "TODO"

488−

489− HasType ->

490− parseReport

491− "Single colons should only show up in types."

492− ( reflowParagraph $

493− "Maybe you want :: instead? Or maybe you are defining\

494− \ a type annotation but there are extra spaces before it?"

495− )

496−

497− Equals ->

498− parseReport

499− "The = operator is reserved for defining variables."

500− ( reflowParagraph $

501− "Maybe you want == instead? Or maybe you are defining a\

502− \ variable but there are extra spaces before it?"

503− )

504−

505− Arrow ->

506− parseReport

507− "Arrows are reserved for cases and anonymous functions."

508− ( reflowParagraph $

509− "Maybe you want > or >= instead?"

510− )

511−

512− Pipe ->

513− parseReport

514− "Vertical bars are reserved for use in type declarations."

515− ( reflowParagraph $

523+ BadOp op context ->

524+ case op of

525+ HasType ->

526+ badOp context "the \"has type\" operator (:)"

527+ "type annotations and record types"

528+ "Maybe you want :: instead? Or maybe your indentation is a bit off?"

529+

530+ Equals ->

531+ badOp context "an equals sign (=)"

532+ "definitions"

533+ "Maybe you want == instead? Or maybe your indentation is a bit off?"

534+

535+ Arrow ->

536+ if isCaseRelated context then

537+ parseReport

538+ "I am parsing a case expression, but this arrow (->) is out of place."

539+ ( reflowParagraph $

540+ "Each branch in a case expression needs to start on the same\

541+ \ column, so maybe this branch is indented too much?"

542+ )

543+

544+ else

545+ badOp context "an arrow (->)"

546+ "cases expressions and anonymous functions"

547+ "Maybe you want > or >= instead?"

548+

549+ Pipe ->

550+ badOp context "a vertical bar (|)"

551+ "type declarations"

516552 "Maybe you want || instead?"

517− )

518553

519− Dot ->

520− parseReport

521− "Dots are for record access and decimal points."

522− ( reflowParagraph $

523− "They cannot float around on their own though, so\

524− \ maybe there is some extra whitespace?"

525− )

554+ Dot ->

555+ parseReport

556+ "I was not expecting a dot (.) here."

557+ ( reflowParagraph $

558+ "Dots are for record access and decimal points, so\

559+ \ they cannot float around on their own. Maybe\

560+ \ there is some extra whitespace?"

561+ )

526562

527− Theories allTheories ->

563+ Theories context allTheories ->

528564 case Set.toList (Set.fromList allTheories) of

529565 [] ->

530566 parseReport

@@ -536,33 +572,147 @@ problemToReport problem =

536572 \ That way we can figure out how to give better advice!"

537573 )

538574

575+ [theory] ->

576+ parseReport

577+ "I got confused while trying to parse your code."

578+ ( reflowParagraph $

579+ contextToText context

580+ <> " right now, so I was expecting "

581+ <> theoryToText theory

582+ )

583+

539584 theories ->

540− error "TODO" (map theoryToText theories)

585+ parseReport

586+ "I got confused while trying to parse your code."

587+ ( Help.vcat $

588+ [ reflowParagraph $

589+ contextToText context <> ", so I was expecting:"

590+ , text ""

591+ ]

592+ ++ map (bullet . theoryToText) theories

593+ )

594+

595+

596+bullet :: Text -> Help.Doc

597+bullet point =

598+ Help.indent 2 (reflowParagraph point)

599+

600+

601+badOp :: [Context] -> Text -> Text -> Text -> Report.Report

602+badOp context opName setting hint =

603+ parseReport ("I was not expecting " <> opName <> " here.") $

604+ reflowParagraph $

605+ "It should only appear in " <> setting <> ", but "

606+ <> contextToText context <> ". " <> hint

607+

608+

609+contextToText :: [Context] -> Text

610+contextToText contextStack =

611+ case contextStack of

612+ [] ->

613+ "I am in between top-level declarations right now."

614+

615+ context : rest ->

616+ let anchor = getAnchor rest in

617+ "I think I am parsing " <>

618+ case context of

619+ ExprIf -> "an `if`" <> anchor

620+ ExprLet -> "a `let`" <> anchor

621+ ExprFunc -> "an anonymous function" <> anchor

622+ ExprCase -> "a `case`" <> anchor

623+ ExprList -> "a list" <> anchor

624+ ExprTuple -> "a tuple" <> anchor

625+ ExprRecord -> "a record" <> anchor

626+ Definition name -> "the definition of `" <> name <> "`"

627+ Annotation name -> "the type annotation for `" <> name <> "`"

628+ TypeTuple -> "a tuple type" <> anchor

629+ TypeRecord -> "a record type" <> anchor

630+ PatternList -> "a pattern" <> anchor

631+ PatternTuple -> "a pattern" <> anchor

632+ PatternRecord -> "a pattern" <> anchor

633+ Module -> "a module declaration"

634+ Import -> "an import"

635+ DocComment -> "a documentation comment"

636+ TypeUnion -> "a union type"

637+ TypeAlias -> "a type alias"

638+ Infix -> "an infix declaration"

639+ Port -> "a port declaration"

640+

641+

642+getAnchor :: [Context] -> Text

643+getAnchor context =

644+ case context of

645+ [] -> ""

646+ Definition name : _ -> " in the definition of `" <> name <> "`"

647+ Annotation name : _ -> " in the type annotation for `" <> name <> "`"

648+ _ : rest -> getAnchor rest

649+

650+

651+isCaseRelated :: [Context] -> Bool

652+isCaseRelated context =

653+ case context of

654+ [] -> False

655+ ExprCase : _ -> True

656+ _ : rest -> isCaseRelated rest

541657

542658

543659theoryToText :: Theory -> Text

544660theoryToText theory =

545661 case theory of

546− Keyword _ ->

547− ""

548−

549− Symbol _ ->

550− ""

551−

552− Variable ->

553− ""

662+ Keyword keyword ->

663+ "the `" <> keyword <> "` keyword"

664+

665+ Symbol symbol ->

666+ case symbol of

667+ "=" -> "an equals sign (=)"

668+ "->" -> "an arrow (->) followed by an expression"

669+ ":" -> "the \"has type\" symbol (:) followed by a type"

670+ "," -> "a comma"

671+ "|" -> "a vertical bar (|)"

672+ "::" -> "the cons operator (::)"

673+ "." -> "a dot (.)"

674+ "-" -> "a minus sign (-)"

675+ "_" -> "an underscore"

676+ "(" -> "a left paren, for grouping or starting tuples"

677+ ")" -> "a closing paren"

678+ "[" -> "a left square bracket, for starting lists"

679+ "]" -> "a right square bracket, to end a list"

680+ "{" -> "a left curly brace, for starting records"

681+ "}" -> "a right curly brace, to end a record"

682+ _ -> "the (" <> symbol <> ") symbol"

683+

684+ LowVar ->

685+ "a lower-case variable, like `x` or `user`"

686+

687+ CapVar ->

688+ "an upper-case variable, like `Maybe` or `Just`"

554689

555690 InfixOp ->

556− ""

691+ "an infix operator, like + or =="

557692

558693 Digit ->

559− "a digit, like 0 or 6"

560−

561− BadIndent ->

562− ""

563−

564− FreshLine ->

565− ""

566−

567− Expecting _ ->

568− ""

694+ "a digit from 0 to 9"

695+

696+ EndOfFile ->

697+ "the end of the file"

698+

699+ BadSpace ->

700+ "more indentation"

701+

702+ FreshLine nextDecl ->

703+ "a fresh line with no indentation for " <>

704+ case nextDecl of

705+ ModuleDecl -> "an `import`"

706+ DocCommentDecl -> "an `import`"

707+ ImportDecl -> "an `import` or a declarations"

708+ OtherDecl -> "a top-level declaration"

709+

710+ Expecting next ->

711+ case next of

712+ Expr -> "an expression, like x or 42"

713+ ElseBranch -> "an `else` branch. An `if` must handle both possibilities!"

714+ Arg -> "an argument, like `name` or `total`"

715+ Pattern -> "a pattern, like `name` or (Just x)"

716+ Type -> "a type, like Int or (List String)"

717+ Listing -> "a list of exposed values and types, like (..) or (x,y,z)"

718+ Exposing -> "something like `exposing (..)`"