2a95e77 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #723 from purescript/432

2a95e77Phil Freeman12 years ago

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

compare with golang

unifiedsplit

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

68 -- |

69 -- A binder with source position information

70 --

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

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

73-- |

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

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

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

57 -- |

58 -- A declaration reference with source position information

59 --

60− | PositionedDeclarationRef SourcePos DeclarationRef

60+ | PositionedDeclarationRef SourceSpan DeclarationRef

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

63instance Eq DeclarationRef where

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

147 -- |

148 -- A declaration with source position information

149 --

150− | PositionedDeclaration SourcePos Declaration

150+ | PositionedDeclaration SourceSpan Declaration

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

152

153-- |

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

324 -- |

325 -- A value with source position information

326 --

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

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

328

329-- |

330-- An alternative in a case statement

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

359 -- |

360 -- A do notation element with source position information

361 --

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

23--

24data SourcePos = SourcePos

25 { -- |

26− -- Source name

27− --

28− sourceName :: String

29− -- |

30 -- Line number

26 -- Line number

31 --

27 --

32− , sourcePosLine :: Int

28+ sourcePosLine :: Int

33 -- |

29 -- |

34 -- Column number

30 -- Column number

35 --

31 --

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

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

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

39instance Show SourcePos where

35instance 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

56 -- |

57 -- Optional source position information

58 --

59− , compileErrorPosition :: Maybe SourcePos

59+ , compileErrorPosition :: Maybe SourceSpan

60 }

61 deriving (Show)

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

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

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

111

112−positionError :: SourcePos -> ErrorStack

112+positionError :: SourceSpan -> ErrorStack

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

114

115-- |

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

121-- |

122-- Rethrow an error with source position information

123--

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

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

125rethrowWithPosition pos = rethrow (positionError pos <>)

126

127-- |

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

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

48-- |

49-- Read source position information

50--

51−sourcePos :: P.Parsec s u SourcePos

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

52−sourcePos = toSourcePos <$> P.getPosition

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

53 where

58 where

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

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

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

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

57kindedIdent = (, Nothing) <$> identifier

62kindedIdent = (, Nothing) <$> identifier

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

165

170

166

171

167parseDeclarationRef :: P.Parsec String ParseState DeclarationRef

172parseDeclarationRef :: P.Parsec String ParseState DeclarationRef

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

173+parseDeclarationRef = withSourceSpan PositionedDeclarationRef $

169− (ValueRef <$> parseIdent

174+ ValueRef <$> parseIdent

170− <|> do name <- properName

175+ <|> do name <- properName

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

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

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

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

173

178

174parseTypeClassDeclaration :: P.Parsec String ParseState Declaration

179parseTypeClassDeclaration :: P.Parsec String ParseState Declaration

175parseTypeClassDeclaration = do

180parseTypeClassDeclaration = do

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

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

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

204

209

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

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

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

211+positioned d = withSourceSpan PositionedDeclaration d

207

212

208-- |

213-- |

209-- Parse a single declaration

214-- Parse a single declaration

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

222 ]) P.<?> "declaration"

227 ]) P.<?> "declaration"

223

228

224parseLocalDeclaration :: P.Parsec String ParseState Declaration

229parseLocalDeclaration :: P.Parsec String ParseState Declaration

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

230+parseLocalDeclaration = positioned (P.choice

226 [ parseTypeDeclaration

231 [ parseTypeDeclaration

227 , parseValueDeclaration

232 , parseValueDeclaration

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

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

229

234

230-- |

235-- |

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

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

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

374-- Parse a value

379-- Parse a value

375--

380--

376parseValue :: P.Parsec String ParseState Expr

381parseValue :: P.Parsec String ParseState Expr

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

382+parseValue = withSourceSpan PositionedValue

378 (P.buildExpressionParser operators

383 (P.buildExpressionParser operators

379− . C.buildPostfixParser postfixTable2

384+ . C.buildPostfixParser postfixTable2

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

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

381 where

386 where

382 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

387 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

383 postfixTable1 = [ parseAccessor

388 postfixTable1 = [ parseAccessor

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

439-- Parse a binder

444-- Parse a binder

440--

445--

441parseBinder :: P.Parsec String ParseState Binder

446parseBinder :: 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")

444 where

448 where

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

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

446 parseBinderAtom :: P.Parsec String ParseState Binder

450 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) =

198 where

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

200

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

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

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

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

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

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

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

217 updateDecl s d = return (s, d)

218

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

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

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

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

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

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

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

235 updateValue s v = return (s, v)

236

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

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

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

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

240 updateBinder s v = return (s, v)

241

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

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

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

244

245 letBoundVariable :: Declaration -> Maybe Ident

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

247 letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

248 letBoundVariable _ = Nothing

249

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

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

251 updateTypesEverywhere pos0 = everywhereOnTypesM (updateType pos0)

252 where

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

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

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

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

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

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

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

270 -> (Exports -> a -> Bool)

271 -> Qualified a

272− -> Maybe SourcePos

272+ -> Maybe SourceSpan

273 -> Either ErrorStack (Qualified a)

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

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

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

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

386-- explicitly imported declarations.

387--

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

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

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

390 where

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

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

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

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

405 -- for the module

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

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

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

408

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

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

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

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

412 positioned $ resolveImport currentModule mn modExports imp impQual typ

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

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

76 go (Parens val) = val

77 go val = val

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

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

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

81 where

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

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

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

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

85 collect _ = []

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

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

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

89 where

90 go [] = return ()