1029861 · rowtype-yoga/purescript-native

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

Improve explicit import handling

commit10298618a3c9d5957428e5459257c958750a3a6f authorGary Burgess <gary.burgess@gmail.com> dateFri 28 Feb 2014, 13:00 (13 years ago) parentb57566f

4 files changed+52−14

compare with golang

unifiedsplit

src/Language/PureScript/Declarations.hs+38−1 src/Language/PureScript/Parser/Declarations.hs+1−1 src/Language/PureScript/Sugar/Names.hs+11−10 src/Language/PureScript/TypeChecker.hs+2−2

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

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

6565 --

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

6767

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+

6882-- |

6983-- The data type of declarations

7084--

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

108122 -- |

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

110124 --

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

125+ | ImportDeclaration ModuleName (Maybe [ImportType])

112126 -- |

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

114128 --

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

169183isTypeClassDeclaration TypeClassDeclaration{} = True

170184isTypeClassDeclaration TypeInstanceDeclaration{} = True

171185isTypeClassDeclaration _ = 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

8787 reserved "import"

8888 indented

8989 moduleName' <- moduleName

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

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

9191 return $ ImportDeclaration moduleName' idents

9292

9393parseTypeClassDeclaration :: P.Parsec String ParseState Declaration

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

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

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

2020import Control.Monad (foldM, liftM)

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

22+import Data.List (intersect)

2223import qualified Data.Map as M

2324import qualified Data.Set as S

2425import Language.PureScript.Declarations

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

159160-- |

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

161162--

162−type ExplicitImports = [Either Ident ProperName]

163+type ExplicitImports = [ImportType]

163164

164165-- |

165166-- 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

174175

175176-- |

176177-- Constructs a local environment for a module.

178+-- TODO: check explicit imports actually exist

177179--

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

179181resolveImports env (Module currentModule decls) = do

180− types <- resolve exportedTypes (resolveDefs filterTypes)

182+ types <- resolve exportedTypes (resolveDefs typeImports)

181183 dataConstructors <- resolve exportedDataConstructors resolveDcons

182− typeClasses <- resolve exportedTypeClasses (resolveDefs filterClasses)

184+ typeClasses <- resolve exportedTypeClasses (resolveDefs classImports)

183185 return $ ImportEnvironment types dataConstructors typeClasses

184186 where

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

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

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

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

190192 Nothing -> Right result

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

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

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

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

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

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

199− Just (Just expl) ->

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

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

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

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

202+ where

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

204+ explTypeImports = typeImports expl

202205 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

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

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

180180 Just idents' -> do

181− shadowIdents (lefts idents') env

182− shadowTypes (rights idents') env

181+ shadowIdents (nameImports idents') env

182+ shadowTypes (typeImports idents') env

183183 shadowTypeClassInstances env

184184 ds <- typeCheckAll mainModuleName currentModule rest

185185 return $ d : ds