8e5c677 · rowtype-yoga/purescript-native

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

on golang help sign in

Explicit exports

8e5c677Gary Burgess13 years ago

examples/failing/ExportExplicit2.pursnew file+13

compare with golang

unifiedsplit

@@ -0,0 +1,13 @@

1+module M1 (x) where

3+ x = 1

4+ y = 0

6+module Main where

8+ import M1

10+ -- should fail as y is not exported from M1

11+ testY = y

12+

13+ main = Debug.Trace.trace "Done"

examples/passing/ExportExplicit.purs+4−1

@@ -1,7 +1,9 @@

1−module M1 (X(X), Z) where

1+module M1 (X(X), Z(..), foo) where

3 data X = X | Y

4 data Z = Z

6+ foo = 0

6module Main where

8module Main where

@@ -9,5 +11,6 @@ module Main where

10 testX = X

12 testX = X

11 testZ = Z

13 testZ = Z

14+ testFoo = foo

13 main = Debug.Trace.trace "Done"

16 main = Debug.Trace.trace "Done"

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

@@ -82,7 +82,7 @@ data DeclarationRef

82 -- A type class

83 --

84 | TypeClassRef ProperName

85− deriving (Show, D.Data, D.Typeable)

85+ deriving (Show, Eq, D.Data, D.Typeable)

87-- |

88-- The data type of declarations

src/Language/PureScript/Sugar/Names.hs+49−12

@@ -20,6 +20,7 @@ import Data.Maybe (fromMaybe)

20import Data.Data

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

22import Data.Generics.Extras (mkS, extS, everywhereWithContextM')

23+import Data.List (find)

24import Control.Applicative (Applicative(..), (<$>), (<*>))

25import Control.Applicative (Applicative(..), (<$>), (<*>))

25import Control.Monad (foldM)

26import Control.Monad (foldM)

@@ -97,11 +98,21 @@ addEmptyModule env name = M.insert name (Exports S.empty S.empty S.empty) env

97-- |

98-- |

98-- Adds a type belonging to a module to the export environment.

99-- Adds a type belonging to a module to the export environment.

99--

100--

100−addType :: ExportEnvironment -> ModuleName -> ProperName -> [ProperName] -> Either String ExportEnvironment

101+addType :: ExportEnvironment -> ModuleName -> ProperName -> Either String ExportEnvironment

101−addType env mn name dctors = updateExportedModule env mn $ \m -> do

102+addType env mn name = updateExportedModule env mn $ \m -> do

102− types <- addExport (exportedTypes m) (name, dctors)

103+ types <- addExport (exportedTypes m) (name, [])

103 return $ m { exportedTypes = types }

104 return $ m { exportedTypes = types }

104

105

106+-- |

107+-- Adds a data constructor belonging to a type and module to the export environment.

108+--

109+addDataConstructor :: ExportEnvironment -> ModuleName -> ProperName -> ProperName -> Either String ExportEnvironment

110+addDataConstructor env mn tcon dcon = updateExportedModule env mn $ \m -> do

111+ let types = exportedTypes m

112+ let dcons = fromMaybe (error $ "Type '" ++ show tcon ++ "' is missing from exportedTypes") (tcon `lookup` (S.toList types))

113+ let types' = S.insert (tcon, dcon : dcons) $ S.delete (tcon, dcons) types

114+ return $ m { exportedTypes = types' }

115+

105-- |

116-- |

106-- Adds a class to the export environment.

117-- Adds a class to the export environment.

107--

118--

@@ -197,16 +208,42 @@ renameInModule imports (Module mn decls exps) =

197findExports :: [Module] -> Either String ExportEnvironment

208findExports :: [Module] -> Either String ExportEnvironment

198findExports = foldM addModule M.empty

209findExports = foldM addModule M.empty

199 where

210 where

211+

212+ -- Add all of the exported declarations from a module to the global export environment

213+ addModule :: ExportEnvironment -> Module -> Either String ExportEnvironment

200− addModule env m@(Module mn ds exps) = rethrowForModule m $ foldM (addDecl mn) (addEmptyModule env mn) ds

214+ addModule env m@(Module mn ds exps) = rethrowForModule m $ foldM (addDecl mn exps) (addEmptyModule env mn) ds

215+

216+ -- Add a declaration from a module to the global export environment, ensuring it is exported

217+ -- from the module it resides within

218+ addDecl :: ModuleName -> Maybe [DeclarationRef] -> ExportEnvironment -> Declaration -> Either String ExportEnvironment

201− addDecl mn env (TypeClassDeclaration tcn _ ds) = do

219+ addDecl mn exps env (TypeClassDeclaration tcn _ ds) | isExported (TypeClassRef tcn) exps = do

202 env' <- addTypeClass env mn tcn

220 env' <- addTypeClass env mn tcn

203− foldM (\env'' (TypeDeclaration name _) -> addValue env'' mn name) env' ds

221+ foldM (addClassMember mn exps) env' ds

204− addDecl mn env (DataDeclaration tn _ dcs) = addType env mn tn (map fst dcs)

222+ addDecl mn exps env (DataDeclaration tn _ dcs) | isExported (TypeRef tn Nothing) exps = do

223+ env' <- addType env mn tn

224+ foldM (\env'' -> addDataConstructor env'' mn tn) env' (map fst dcs)

205− addDecl mn env (TypeSynonymDeclaration tn _ _) = addType env mn tn []

225+ addDecl mn exps env (TypeSynonymDeclaration tn _ _) | isExported (TypeRef tn Nothing) exps = addType env mn tn

206− addDecl mn env (ExternDataDeclaration tn _) = addType env mn tn []

226+ addDecl mn exps env (ExternDataDeclaration tn _) | isExported (TypeRef tn Nothing) exps = addType env mn tn

207− addDecl mn env (ValueDeclaration name _ _ _) = addValue env mn name

227+ addDecl mn exps env (ValueDeclaration name _ _ _) | isExported (ValueRef name) exps = addValue env mn name

208− addDecl mn env (ExternDeclaration _ name _ _) = addValue env mn name

228+ addDecl mn exps env (ExternDeclaration _ name _ _) | isExported (ValueRef name) exps = addValue env mn name

209− addDecl _ env _ = return env

229+ addDecl _ _ env _ = return env

230+

231+ -- Add a class member from a module to the global export environment, ensuring it is exported

232+ -- from the module it resides within

233+ addClassMember :: ModuleName -> Maybe [DeclarationRef] -> ExportEnvironment -> Declaration -> Either String ExportEnvironment

234+ addClassMember mn exps env (TypeDeclaration name _) | isExported (ValueRef name) exps = addValue env mn name

235+ addClassMember mn exps env _ = return env

236+

237+ -- Check whether a declaration is exported from a module. When checking if a type is exported

238+ -- the specific data constructors are ignored, only the export for the type constructor is

239+ -- tested for.

240+ isExported :: DeclarationRef -> Maybe [DeclarationRef] -> Bool

241+ isExported (TypeRef tn _) (Just exps) = any (typeMatches tn) exps

242+ where

243+ typeMatches tn (TypeRef tn' _) = tn == tn'

244+ typeMatches _ _ = False

245+ isExported dec (Just exps) = dec `elem` exps

246+ isExported dec Nothing = True

210

247

211-- |

248-- |

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

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