1029861 · rowtype-yoga/purescript-native

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

on golang help sign in

Improve explicit import handling

1029861Gary Burgess13 years ago

src/Language/PureScript/Declarations.hs+38−1

compare with golang

unifiedsplit

@@ -65,6 +65,20 @@ data ForeignImportType

65 --

66 | TypeClassAccessorImport deriving (Show, Eq, D.Data, D.Typeable)

68+-- |

69+-- An item in a list of explicit imports

70+--

71+data ImportType

72+ -- |

73+ -- A type constructor import

74+ --

75+ = TypeImport ProperName

76+ -- |

77+ -- A declaration import

78+ --

79+ | NameImport Ident

80+ deriving (Show, D.Data, D.Typeable)

81+

68-- |

82-- |

69-- The data type of declarations

83-- The data type of declarations

70--

84--

@@ -108,7 +122,7 @@ data Declaration

108 -- |

122 -- |

109 -- A module import (module name, optional set of identifiers to import)

123 -- A module import (module name, optional set of identifiers to import)

110 --

124 --

111− | ImportDeclaration ModuleName (Maybe [Either Ident ProperName])

125+ | ImportDeclaration ModuleName (Maybe [ImportType])

112 -- |

126 -- |

113 -- A type class declaration (name, argument, member declarations)

127 -- A type class declaration (name, argument, member declarations)

114 --

128 --

@@ -169,3 +183,26 @@ isTypeClassDeclaration :: Declaration -> Bool

169isTypeClassDeclaration TypeClassDeclaration{} = True

183isTypeClassDeclaration TypeClassDeclaration{} = True

170isTypeClassDeclaration TypeInstanceDeclaration{} = True

184isTypeClassDeclaration TypeInstanceDeclaration{} = True

171isTypeClassDeclaration _ = False

185isTypeClassDeclaration _ = False

186+

187+-- |

188+-- Extracts names from a list of explicit imports.

189+--

190+nameImports :: [ImportType] -> [Ident]

191+nameImports ((NameImport ident):xs) = ident : nameImports xs

192+nameImports (_ : xs) = nameImports xs

193+nameImports _ = []

194+

195+-- |

196+-- Extracts types from a list of explicit imports.

197+--

198+typeImports :: [ImportType] -> [ProperName]

199+typeImports (TypeImport ident : xs) = ident : typeImports xs

200+typeImports (_ : xs) = typeImports xs

201+typeImports _ = []

202+

203+-- |

204+-- Extracts classes from a list of explicit imports.

205+-- note: class imports are indistinguishable from types at the moment

206+--

207+classImports :: [ImportType] -> [ProperName]

208+classImports = typeImports

src/Language/PureScript/Parser/Declarations.hs+1−1

@@ -87,7 +87,7 @@ parseImportDeclaration = do

87 reserved "import"

88 indented

89 moduleName' <- moduleName

90− idents <- P.optionMaybe $ parens $ commaSep1 (Left <$> parseIdent <|> Right <$> properName)

90+ idents <- P.optionMaybe $ parens $ commaSep1 (NameImport <$> parseIdent <|> TypeImport <$> properName)

91 return $ ImportDeclaration moduleName' idents

93parseTypeClassDeclaration :: P.Parsec String ParseState Declaration

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

@@ -19,6 +19,7 @@ module Language.PureScript.Sugar.Names (

19import Control.Applicative ((<$>))

20import Control.Monad (foldM, liftM)

21import Data.Generics (extM, mkM, everywhereM)

22+import Data.List (intersect)

22import qualified Data.Map as M

23import qualified Data.Map as M

23import qualified Data.Set as S

24import qualified Data.Set as S

24import Language.PureScript.Declarations

25import Language.PureScript.Declarations

@@ -159,7 +160,7 @@ findExports = foldM addModule (ExportEnvironment M.empty M.empty M.empty)

159-- |

160-- |

160-- Type representing a set of declarations being explicitly imported from a module

161-- Type representing a set of declarations being explicitly imported from a module

161--

162--

162−type ExplicitImports = [Either Ident ProperName]

163+type ExplicitImports = [ImportType]

163

164

164-- |

165-- |

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

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

@@ -174,19 +175,20 @@ findImports = foldl findImports' M.empty

174

175

175-- |

176-- |

176-- Constructs a local environment for a module.

177-- Constructs a local environment for a module.

178+-- TODO: check explicit imports actually exist

177--

179--

178resolveImports :: ExportEnvironment -> Module -> Either String ImportEnvironment

180resolveImports :: ExportEnvironment -> Module -> Either String ImportEnvironment

179resolveImports env (Module currentModule decls) = do

181resolveImports env (Module currentModule decls) = do

180− types <- resolve exportedTypes (resolveDefs filterTypes)

182+ types <- resolve exportedTypes (resolveDefs typeImports)

181 dataConstructors <- resolve exportedDataConstructors resolveDcons

183 dataConstructors <- resolve exportedDataConstructors resolveDcons

182− typeClasses <- resolve exportedTypeClasses (resolveDefs filterClasses)

184+ typeClasses <- resolve exportedTypeClasses (resolveDefs classImports)

183 return $ ImportEnvironment types dataConstructors typeClasses

185 return $ ImportEnvironment types dataConstructors typeClasses

184 where

186 where

185 scope = M.insert currentModule Nothing (findImports decls)

187 scope = M.insert currentModule Nothing (findImports decls)

186 resolve get f = foldM f M.empty (M.toList $ get env)

188 resolve get f = foldM f M.empty (M.toList $ get env)

187 resolveDefs filt result (mn, names) = case M.lookup mn scope of

189 resolveDefs filt result (mn, names) = case M.lookup mn scope of

188 Just Nothing -> foldM (resolveDef mn) result (S.toList names)

190 Just Nothing -> foldM (resolveDef mn) result (S.toList names)

189− Just (Just expl) -> foldM (resolveDef mn) result (S.toList (S.intersection names (foldl filt S.empty expl)))

191+ Just (Just expl) -> foldM (resolveDef mn) result (S.toList names `intersect` filt expl)

190 Nothing -> Right result

192 Nothing -> Right result

191 resolveDef mn result name = case M.lookup name result of

193 resolveDef mn result name = case M.lookup name result of

192 Nothing -> return $ M.insert name (Qualified (Just mn) name) result

194 Nothing -> return $ M.insert name (Qualified (Just mn) name) result

@@ -195,10 +197,9 @@ resolveImports env (Module currentModule decls) = do

195 then "' defines '" ++ show name ++ "' which conflicts with imported definition '" ++ show (Qualified (Just mn) name) ++ "'"

197 then "' defines '" ++ show name ++ "' which conflicts with imported definition '" ++ show (Qualified (Just mn) name) ++ "'"

196 else "' has conflicting imports for '" ++ show name ++ "': '" ++ show x ++ "', '" ++ show (Qualified (Just mn) name) ++ "'"

198 else "' has conflicting imports for '" ++ show name ++ "': '" ++ show x ++ "', '" ++ show (Qualified (Just mn) name) ++ "'"

197 resolveDcons result (mn, tcons) = case M.lookup mn scope of

199 resolveDcons result (mn, tcons) = case M.lookup mn scope of

198− Just Nothing -> foldM (\result (tcon, dcons) -> foldM (resolveDef mn) result dcons) result (S.toList tcons)

200+ Just Nothing -> foldM (foldM $ resolveDef mn) result (snd `map` S.toList tcons)

199− Just (Just expl) ->

201+ Just (Just expl) -> foldM (foldM $ resolveDef mn) result (snd `map` selectedTcons)

202+ where

200− let selectedTcons = filter (\(tcon, _) -> any (either (const False) (tcon ==)) expl) (S.toList tcons) in

203+ selectedTcons = filter ((`elem` explTypeImports) . fst) (S.toList tcons)

201− foldM (\result (tcon, dcons) -> foldM (resolveDef mn) result dcons) result selectedTcons

204+ explTypeImports = typeImports expl

202 Nothing -> Right result

205 Nothing -> Right result

203− filterTypes result = either (const result) (`S.insert` result)

204− filterClasses result _ = result

src/Language/PureScript/TypeChecker.hs+2−2

@@ -178,8 +178,8 @@ typeCheckAll mainModuleName currentModule (d@(ImportDeclaration moduleName ident

178 shadowIdents (map snd $ filterModule (names env)) env

179 shadowTypes (map (\(Qualified _ name) -> name) $ filterModuleQ (types env)) env

180 Just idents' -> do

181− shadowIdents (lefts idents') env

181+ shadowIdents (nameImports idents') env

182− shadowTypes (rights idents') env

182+ shadowTypes (typeImports idents') env

183 shadowTypeClassInstances env

184 ds <- typeCheckAll mainModuleName currentModule rest

185 return $ d : ds