e97d799 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Add span information to errors

commite97d7996c302a64eea909f6c6b5ad648d04fb05d authorPhil Freeman <paf31@cantab.net> dateSat 22 Nov 2014, 16:45 (12 years ago) parenta2f58c5

7 files changed+60−43

compare with golang

unifiedsplit

src/Language/PureScript/AST/Binders.hs+1−1 src/Language/PureScript/AST/Declarations.hs+4−4 src/Language/PureScript/AST/SourcePos.hs+19−6 src/Language/PureScript/Errors.hs+3−3 src/Language/PureScript/Parser/Declarations.hs+20−16 src/Language/PureScript/Sugar/Names.hs+10−10 src/Language/PureScript/Sugar/Operators.hs+3−3

src/Language/PureScript/AST/Binders.hs+1−1

@@ -68,7 +68,7 @@ data Binder

6868 -- |

6969 -- A binder with source position information

7070 --

71− | PositionedBinder SourcePos Binder deriving (Show, D.Data, D.Typeable)

71+ | PositionedBinder SourceSpan Binder deriving (Show, D.Data, D.Typeable)

7272

7373-- |

7474-- Collect all names introduced in binders in an expression

src/Language/PureScript/AST/Declarations.hs+4−4

@@ -57,7 +57,7 @@ data DeclarationRef

5757 -- |

5858 -- A declaration reference with source position information

5959 --

60− | PositionedDeclarationRef SourcePos DeclarationRef

60+ | PositionedDeclarationRef SourceSpan DeclarationRef

6161 deriving (Show, D.Data, D.Typeable)

6262

6363instance Eq DeclarationRef where

@@ -147,7 +147,7 @@ data Declaration

147147 -- |

148148 -- A declaration with source position information

149149 --

150− | PositionedDeclaration SourcePos Declaration

150+ | PositionedDeclaration SourceSpan Declaration

151151 deriving (Show, D.Data, D.Typeable)

152152

153153-- |

@@ -324,7 +324,7 @@ data Expr

324324 -- |

325325 -- A value with source position information

326326 --

327− | PositionedValue SourcePos Expr deriving (Show, D.Data, D.Typeable)

327+ | PositionedValue SourceSpan Expr deriving (Show, D.Data, D.Typeable)

328328

329329-- |

330330-- An alternative in a case statement

@@ -359,4 +359,4 @@ data DoNotationElement

359359 -- |

360360 -- A do notation element with source position information

361361 --

362− | PositionedDoNotationElement SourcePos DoNotationElement deriving (Show, D.Data, D.Typeable)

362+ | PositionedDoNotationElement SourceSpan DoNotationElement deriving (Show, D.Data, D.Typeable)

src/Language/PureScript/AST/SourcePos.hs+19−6

@@ -23,13 +23,9 @@ import qualified Data.Data as D

2323--

2424data SourcePos = SourcePos

2525 { -- |

26− -- Source name

27− --

28− sourceName :: String

29− -- |

3026 -- Line number

3127 --

32− , sourcePosLine :: Int

28+ sourcePosLine :: Int

3329 -- |

3430 -- Column number

3531 --

@@ -37,4 +33,21 @@ data SourcePos = SourcePos

3733 } deriving (D.Data, D.Typeable)

3834

3935instance Show SourcePos where

40− show sp = sourceName sp ++ " line " ++ show (sourcePosLine sp) ++ ", column " ++ show (sourcePosColumn sp)

36+ show sp = "line " ++ show (sourcePosLine sp) ++ ", column " ++ show (sourcePosColumn sp)

37+

38+data SourceSpan = SourceSpan

39+ { -- |

40+ -- Source name

41+ --

42+ spanName :: String

43+ -- |

44+ -- Start of the span

45+ --

46+ , spanStart :: SourcePos

47+ -- End of the span

48+ --

49+ , spanEnd :: SourcePos

50+ } deriving (D.Data, D.Typeable)

51+

52+instance Show SourceSpan where

53+ show sp = spanName sp ++ " " ++ show (spanStart sp) ++ " - " ++ show (spanEnd sp)

src/Language/PureScript/Errors.hs+3−3

@@ -56,7 +56,7 @@ data CompileError

5656 -- |

5757 -- Optional source position information

5858 --

59− , compileErrorPosition :: Maybe SourcePos

59+ , compileErrorPosition :: Maybe SourceSpan

6060 }

6161 deriving (Show)

6262

@@ -109,7 +109,7 @@ showError (CompileError msg (Just (TypeError ty)) _) = "Error in type " ++ prett

109109mkErrorStack :: String -> Maybe ErrorSource -> ErrorStack

110110mkErrorStack msg t = ErrorStack [CompileError msg t Nothing]

111111

112−positionError :: SourcePos -> ErrorStack

112+positionError :: SourceSpan -> ErrorStack

113113positionError pos = ErrorStack [CompileError "" Nothing (Just pos)]

114114

115115-- |

@@ -121,7 +121,7 @@ rethrow f = flip catchError $ \e -> throwError (f e)

121121-- |

122122-- Rethrow an error with source position information

123123--

124−rethrowWithPosition :: (MonadError ErrorStack m) => SourcePos -> m a -> m a

124+rethrowWithPosition :: (MonadError ErrorStack m) => SourceSpan -> m a -> m a

125125rethrowWithPosition pos = rethrow (positionError pos <>)

126126

127127-- |

src/Language/PureScript/Parser/Declarations.hs+20−16

@@ -48,10 +48,15 @@ import qualified Text.Parsec.Expr as P

4848-- |

4949-- Read source position information

5050--

51−sourcePos :: P.Parsec s u SourcePos

52−sourcePos = toSourcePos <$> P.getPosition

51+withSourceSpan :: (SourceSpan -> a -> a) -> P.Parsec s u a -> P.Parsec s u a

52+withSourceSpan f p = do

53+ start <- P.getPosition

54+ x <- p

55+ end <- P.getPosition

56+ let sp = SourceSpan (P.sourceName start) (toSourcePos start) (toSourcePos end)

57+ return $ f sp x

5358 where

54− toSourcePos p = SourcePos (P.sourceName p) (P.sourceLine p) (P.sourceColumn p)

59+ toSourcePos pos = SourcePos (P.sourceLine pos) (P.sourceColumn pos)

5560

5661kindedIdent :: P.Parsec String ParseState (String, Maybe Kind)

5762kindedIdent = (, Nothing) <$> identifier

@@ -165,11 +170,11 @@ parseImportDeclaration = do

165170

166171

167172parseDeclarationRef :: P.Parsec String ParseState DeclarationRef

168−parseDeclarationRef = PositionedDeclarationRef <$> sourcePos <*>

169− (ValueRef <$> parseIdent

170− <|> do name <- properName

171− dctors <- P.optionMaybe $ parens (lexeme (P.string "..") *> pure Nothing <|> Just <$> commaSep properName)

172− return $ maybe (TypeClassRef name) (TypeRef name) dctors)

173+parseDeclarationRef = withSourceSpan PositionedDeclarationRef $

174+ ValueRef <$> parseIdent

175+ <|> do name <- properName

176+ dctors <- P.optionMaybe $ parens (lexeme (P.string "..") *> pure Nothing <|> Just <$> commaSep properName)

177+ return $ maybe (TypeClassRef name) (TypeRef name) dctors

173178

174179parseTypeClassDeclaration :: P.Parsec String ParseState Declaration

175180parseTypeClassDeclaration = do

@@ -203,7 +208,7 @@ parseTypeInstanceDeclaration = do

203208 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty members

204209

205210positioned :: P.Parsec String ParseState Declaration -> P.Parsec String ParseState Declaration

206−positioned d = PositionedDeclaration <$> sourcePos <*> d

211+positioned d = withSourceSpan PositionedDeclaration d

207212

208213-- |

209214-- Parse a single declaration

@@ -222,10 +227,10 @@ parseDeclaration = positioned (P.choice

222227 ]) P.<?> "declaration"

223228

224229parseLocalDeclaration :: P.Parsec String ParseState Declaration

225−parseLocalDeclaration = PositionedDeclaration <$> sourcePos <*> P.choice

230+parseLocalDeclaration = positioned (P.choice

226231 [ parseTypeDeclaration

227232 , parseValueDeclaration

228− ] P.<?> "local declaration"

233+ ] P.<?> "local declaration")

229234

230235-- |

231236-- Parse a module header and a collection of declarations

@@ -374,10 +379,10 @@ parseDoNotationElement = P.choice

374379-- Parse a value

375380--

376381parseValue :: P.Parsec String ParseState Expr

377−parseValue = PositionedValue <$> sourcePos <*>

382+parseValue = withSourceSpan PositionedValue

378383 (P.buildExpressionParser operators

379− . C.buildPostfixParser postfixTable2

380− $ indexersAndAccessors) P.<?> "expression"

384+ . C.buildPostfixParser postfixTable2

385+ $ indexersAndAccessors) P.<?> "expression"

381386 where

382387 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

383388 postfixTable1 = [ parseAccessor

@@ -439,8 +444,7 @@ parseIdentifierAndBinder = do

439444-- Parse a binder

440445--

441446parseBinder :: P.Parsec String ParseState Binder

442−parseBinder = PositionedBinder <$> sourcePos <*>

443− P.buildExpressionParser operators parseBinderAtom P.<?> "expression"

447+parseBinder = withSourceSpan PositionedBinder (P.buildExpressionParser operators parseBinderAtom P.<?> "expression")

444448 where

445449 operators = [ [ P.Infix ( C.lexeme (P.try $ C.indented *> C.reservedOp ":") >> return ConsBinder) P.AssocRight ] ]

446450 parseBinderAtom :: P.Parsec String ParseState Binder

src/Language/PureScript/Sugar/Names.hs+10−10

@@ -198,7 +198,7 @@ renameInModule imports exports (Module mn decls exps) =

198198 where

199199 (go, _, _, _, _) = everywhereWithContextOnValuesM (Nothing, []) updateDecl updateValue updateBinder updateCase defS

200200

201− updateDecl :: (Maybe SourcePos, [Ident]) -> Declaration -> Either ErrorStack ((Maybe SourcePos, [Ident]), Declaration)

201+ updateDecl :: (Maybe SourceSpan, [Ident]) -> Declaration -> Either ErrorStack ((Maybe SourceSpan, [Ident]), Declaration)

202202 updateDecl (_, bound) d@(PositionedDeclaration pos _) = return ((Just pos, bound), d)

203203 updateDecl (pos, bound) (DataDeclaration dtype name args dctors) =

204204 (,) (pos, bound) <$> (DataDeclaration dtype name args <$> mapM (sndM (mapM (updateTypesEverywhere pos))) dctors)

@@ -216,7 +216,7 @@ renameInModule imports exports (Module mn decls exps) =

216216 (,) (pos, name : bound) <$> (ExternDeclaration fit name js <$> updateTypesEverywhere pos ty)

217217 updateDecl s d = return (s, d)

218218

219− updateValue :: (Maybe SourcePos, [Ident]) -> Expr -> Either ErrorStack ((Maybe SourcePos, [Ident]), Expr)

219+ updateValue :: (Maybe SourceSpan, [Ident]) -> Expr -> Either ErrorStack ((Maybe SourceSpan, [Ident]), Expr)

220220 updateValue (_, bound) v@(PositionedValue pos' _) = return ((Just pos', bound), v)

221221 updateValue (pos, bound) (Abs (Left arg) val') = return ((pos, arg : bound), Abs (Left arg) val')

222222 updateValue (pos, bound) (Let ds val') =

@@ -234,12 +234,12 @@ renameInModule imports exports (Module mn decls exps) =

234234 updateValue s@(pos, _) (TypedValue check val ty) = (,) s <$> (TypedValue check val <$> updateTypesEverywhere pos ty)

235235 updateValue s v = return (s, v)

236236

237− updateBinder :: (Maybe SourcePos, [Ident]) -> Binder -> Either ErrorStack ((Maybe SourcePos, [Ident]), Binder)

237+ updateBinder :: (Maybe SourceSpan, [Ident]) -> Binder -> Either ErrorStack ((Maybe SourceSpan, [Ident]), Binder)

238238 updateBinder (_, bound) v@(PositionedBinder pos _) = return ((Just pos, bound), v)

239239 updateBinder s@(pos, _) (ConstructorBinder name b) = (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)

240240 updateBinder s v = return (s, v)

241241

242− updateCase :: (Maybe SourcePos, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourcePos, [Ident]), CaseAlternative)

242+ updateCase :: (Maybe SourceSpan, [Ident]) -> CaseAlternative -> Either ErrorStack ((Maybe SourceSpan, [Ident]), CaseAlternative)

243243 updateCase (pos, bound) c@(CaseAlternative bs _) = return ((pos, concatMap binderNames bs ++ bound), c)

244244

245245 letBoundVariable :: Declaration -> Maybe Ident

@@ -247,10 +247,10 @@ renameInModule imports exports (Module mn decls exps) =

247247 letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

248248 letBoundVariable _ = Nothing

249249

250− updateTypesEverywhere :: Maybe SourcePos -> Type -> Either ErrorStack Type

250+ updateTypesEverywhere :: Maybe SourceSpan -> Type -> Either ErrorStack Type

251251 updateTypesEverywhere pos0 = everywhereOnTypesM (updateType pos0)

252252 where

253− updateType :: Maybe SourcePos -> Type -> Either ErrorStack Type

253+ updateType :: Maybe SourceSpan -> Type -> Either ErrorStack Type

254254 updateType pos (TypeConstructor name) = TypeConstructor <$> updateTypeName name pos

255255 updateType pos (SaturatedTypeSynonym name tys) = SaturatedTypeSynonym <$> updateTypeName name pos <*> pure tys

256256 updateType pos (ConstrainedType cs t) = ConstrainedType <$> updateConstraints pos cs <*> pure t

@@ -269,7 +269,7 @@ renameInModule imports exports (Module mn decls exps) =

269269 -> (ImportEnvironment -> M.Map (Qualified a) (Qualified a))

270270 -> (Exports -> a -> Bool)

271271 -> Qualified a

272− -> Maybe SourcePos

272+ -> Maybe SourceSpan

273273 -> Either ErrorStack (Qualified a)

274274 update t getI checkE qname@(Qualified mn' name) pos = positioned $ case (M.lookup qname imports', mn') of

275275 (Just qname', _) -> return qname'

@@ -385,7 +385,7 @@ filterExports mn exps env = do

385385-- Finds the imports within a module, mapping the imported module name to an optional set of

386386-- explicitly imported declarations.

387387--

388−findImports :: [Declaration] -> M.Map ModuleName (Maybe SourcePos, ImportDeclarationType, Maybe ModuleName)

388+findImports :: [Declaration] -> M.Map ModuleName (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)

389389findImports = foldl (findImports' Nothing) M.empty

390390 where

391391 findImports' pos result (ImportDeclaration mn typ qual) = M.insert mn (pos, typ, qual) result

@@ -403,10 +403,10 @@ resolveImports env (Module currentModule decls _) =

403403 -- A Map from module name to the source position for the import, the list of imports from that

404404 -- module (where Nothing indicates everything is to be imported), and optionally a qualified name

405405 -- for the module

406− scope :: M.Map ModuleName (Maybe SourcePos, ImportDeclarationType, Maybe ModuleName)

406+ scope :: M.Map ModuleName (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)

407407 scope = M.insert currentModule (Nothing, Unqualified, Nothing) (findImports decls)

408408

409− resolveImport' :: ImportEnvironment -> (ModuleName, (Maybe SourcePos, ImportDeclarationType, Maybe ModuleName)) -> Either ErrorStack ImportEnvironment

409+ resolveImport' :: ImportEnvironment -> (ModuleName, (Maybe SourceSpan, ImportDeclarationType, Maybe ModuleName)) -> Either ErrorStack ImportEnvironment

410410 resolveImport' imp (mn, (pos, typ, impQual)) = do

411411 modExports <- positioned $ maybe (throwError $ mkErrorStack ("Cannot import unknown module '" ++ show mn ++ "'") Nothing) return $ mn `M.lookup` env

412412 positioned $ resolveImport currentModule mn modExports imp impQual typ

src/Language/PureScript/Sugar/Operators.hs+3−3

@@ -76,15 +76,15 @@ removeParens =

7676 go (Parens val) = val

7777 go val = val

7878

79−collectFixities :: Module -> [(Qualified Ident, SourcePos, Fixity)]

79+collectFixities :: Module -> [(Qualified Ident, SourceSpan, Fixity)]

8080collectFixities (Module moduleName ds _) = concatMap collect ds

8181 where

82− collect :: Declaration -> [(Qualified Ident, SourcePos, Fixity)]

82+ collect :: Declaration -> [(Qualified Ident, SourceSpan, Fixity)]

8383 collect (PositionedDeclaration pos (FixityDeclaration fixity name)) = [(Qualified (Just moduleName) (Op name), pos, fixity)]

8484 collect FixityDeclaration{} = error "Fixity without srcpos info"

8585 collect _ = []

8686

87−ensureNoDuplicates :: [(Qualified Ident, SourcePos)] -> Either ErrorStack ()

87+ensureNoDuplicates :: [(Qualified Ident, SourceSpan)] -> Either ErrorStack ()

8888ensureNoDuplicates m = go $ sortBy (compare `on` fst) m

8989 where

9090 go [] = return ()