abde79f · rowtype-yoga/purescript-native

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

Fix remaining bugs related to source position information

commitabde79f860d0467fb7a1a6415af6d6ed5e821439 authorPhil Freeman <paf31@cantab.net> dateFri 28 Mar 2014, 17:17 (13 years ago) parent2a0553a

3 files changed+11−2

compare with golang

unifiedsplit

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

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

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

216216

217217 letBoundVariable :: Declaration -> Ident

218218 letBoundVariable (ValueDeclaration ident _ _ _ _) = ident

219+ letBoundVariable (PositionedDeclaration _ d) = letBoundVariable d

219220 letBoundVariable _ = error "Invalid argument to letBoundVariable"

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

221222 go (ExternDeclaration fit name js ty) =

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

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

124124 return $ d : ds

125125 where

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

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

127128 toTypeSynonym _ = Nothing

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

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

129131 toDataDecl _ = Nothing

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

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

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

195197 ds <- typeCheckAll mainModuleName moduleName rest

196198 return $ d : ds

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

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

200+ rethrowWithPosition pos $ do

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

238238isFunction :: Value -> Bool

239239isFunction (Abs _ _) = True

240240isFunction (TypedValue _ val _) = isFunction val

241+isFunction (PositionedValue _ val) = isFunction val

241242isFunction _ = False

242243

243244-- |

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

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

595596 return $ (ident, LocalVariable, val')

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

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

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

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

598602

599603-- |

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