abde79f · rowtype-yoga/purescript-native

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

on golang help sign in

Fix remaining bugs related to source position information

abde79fPhil Freeman13 years ago

src/Language/PureScript/Sugar/Names.hs+1

compare with golang

unifiedsplit

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

216

217 letBoundVariable :: Declaration -> Ident

218 letBoundVariable (ValueDeclaration ident _ _ _ _) = ident

219+ letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

219 letBoundVariable _ = error "Invalid argument to letBoundVariable"

220 letBoundVariable _ = error "Invalid argument to letBoundVariable"

220 go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name

221 go (ValueDeclaration name _ _ _ _) = error $ "Binders should have been desugared in " ++ show name

221 go (ExternDeclaration fit name js ty) =

222 go (ExternDeclaration fit name js ty) =

src/Language/PureScript/TypeChecker.hs+5−1

@@ -124,8 +124,10 @@ typeCheckAll mainModuleName moduleName (d@(DataBindingGroupDeclaration tys) : re

124 return $ d : ds

125 where

126 toTypeSynonym (TypeSynonymDeclaration nm args ty) = Just (nm, args, ty)

127+ toTypeSynonym (PositionedDeclaration _ d') = toTypeSynonym d'

127 toTypeSynonym _ = Nothing

128 toTypeSynonym _ = Nothing

128 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)

129 toDataDecl (DataDeclaration nm args dctors) = Just (nm, args, dctors)

130+ toDataDecl (PositionedDeclaration _ d') = toDataDecl d'

129 toDataDecl _ = Nothing

131 toDataDecl _ = Nothing

130typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do

132typeCheckAll mainModuleName moduleName (d@(TypeSynonymDeclaration name args ty) : rest) = do

131 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do

133 rethrow (strMsg ("Error in type synonym " ++ show name) <>) $ do

@@ -195,4 +197,6 @@ typeCheckAll mainModuleName moduleName (d@(ExternInstanceDeclaration dictName de

195 ds <- typeCheckAll mainModuleName moduleName rest

197 ds <- typeCheckAll mainModuleName moduleName rest

196 return $ d : ds

198 return $ d : ds

197typeCheckAll mainModuleName moduleName (PositionedDeclaration pos d : rest) =

199typeCheckAll mainModuleName moduleName (PositionedDeclaration pos d : rest) =

200+ rethrowWithPosition pos $ do

198− rethrowWithPosition pos $ typeCheckAll mainModuleName moduleName (d : rest)

201+ (d' : rest') <- typeCheckAll mainModuleName moduleName (d : rest)

202+ return (PositionedDeclaration pos d' : rest')

src/Language/PureScript/TypeChecker/Types.hs+5−1

@@ -238,6 +238,7 @@ typeForBindingGroupElement moduleName e@(_, (val, _)) dict untypedDict = do

238isFunction :: Value -> Bool

239isFunction (Abs _ _) = True

240isFunction (TypedValue _ val _) = isFunction val

241+isFunction (PositionedValue _ val) = isFunction val

241isFunction _ = False

242isFunction _ = False

242

243

243-- |

244-- |

@@ -594,7 +595,10 @@ inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do

594 (ident, (val', _)) <- typeForBindingGroupElement moduleName e dict untypedDict

595 (ident, (val', _)) <- typeForBindingGroupElement moduleName e dict untypedDict

595 return $ (ident, LocalVariable, val')

596 return $ (ident, LocalVariable, val')

596 bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

597 bindNames dict $ inferLetBinding (seen ++ [BindingGroupDeclaration ds']) rest ret j

598+inferLetBinding seen (PositionedDeclaration pos d : ds) ret j = do

599+ ((d' : ds'), val') <- inferLetBinding seen (d : ds) ret j

600+ return (PositionedDeclaration pos d' : ds', val')

597−inferLetBinding _ _ _ _ = error "Invalid argument to fromValueDeclaration"

601+inferLetBinding _ _ _ _ = error "Invalid argument to inferLetBinding"

598

602

599-- |

603-- |

600-- Infer the type of a property inside a record with a given type

604-- Infer the type of a property inside a record with a given type