f78904d · rowtype-yoga/purescript-native

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

Initial work for module exports

commitf78904d85ae449c2b404d13b2dad7b1b0ae53112 authorGary Burgess <gary.burgess@gmail.com> dateWed 5 Mar 2014, 09:46 (13 years ago) parenta705217

15 files changed+32−27

compare with golang

unifiedsplit

docgen/Main.hs+2−1

@@ -58,8 +58,9 @@ renderModules ms = do

5858 headerLevel 1 "Module Documentation"

5959 mapM_ renderModule ms

6060

61+-- TODO: filter everything by exports

6162renderModule :: P.Module -> Docs

62−renderModule (P.Module moduleName ds) = do

63+renderModule (P.Module moduleName ds exps) = do

6364 headerLevel 2 $ "Module " ++ P.runModuleName moduleName

6465 spacer

6566 headerLevel 3 "Types"

psci/Main.hs+3−2

@@ -161,6 +161,7 @@ quitMessage = "See ya!"

161161

162162-- |

163163-- Loads module, function, and file completions.

164+-- TODO: filter names to only include exported decls

164165--

165166completion :: CompletionFunc (StateT PSCiState IO)

166167completion = completeWord Nothing " \t\n\r" findCompletions

@@ -176,7 +177,7 @@ completion = completeWord Nothing " \t\n\r" findCompletions

176177 getDeclName _ = Nothing

177178 names :: [P.Module] -> [String]

178179 names ms = nub [ show qual

179− | P.Module moduleName ds <- ms

180+ | P.Module moduleName ds _ <- ms

180181 , ident <- mapMaybe getDeclName ds

181182 , qual <- [ P.Qualified Nothing ident

182183 , P.Qualified (Just moduleName) ident]

@@ -207,7 +208,7 @@ createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetB

207208 mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing mainValue

208209 decls = if exec then [itDecl, mainDecl] else [itDecl]

209210 in

210− P.Module moduleName $ map importDecl imports ++ decls

211+ P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing

211212

212213-- |

213214-- Takes a value declaration and evaluates it with the current state.

src/Language/PureScript.hs+3−3

@@ -33,7 +33,7 @@ import Language.PureScript.DeadCodeElimination as P

3333import Data.List (intercalate)

3434import Data.Maybe (mapMaybe)

3535import Control.Monad.State.Lazy

36−import Control.Applicative ((<$>))

36+import Control.Applicative ((<$>), (<*>), pure)

3737import qualified Data.Map as M

3838

3939-- |

@@ -59,9 +59,9 @@ compile :: Options -> [Module] -> Either String (String, String, Environment)

5959compile opts ms = do

6060 sorted <- sortModules ms

6161 desugared <- desugar sorted

62− (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName' decls) -> do

62+ (elaborated, env) <- runCheck $ forM desugared $ \(Module moduleName' decls exps) -> do

6363 modify (\s -> s { checkCurrentModule = Just moduleName' })

64− Module moduleName' <$> typeCheckAll mainModuleIdent moduleName' decls

64+ Module moduleName' <$> typeCheckAll mainModuleIdent moduleName' decls <*> pure exps

6565 regrouped <- createBindingGroupsModule . collapseBindingGroupsModule $ elaborated

6666 let entryPoints = moduleNameFromString `map` optionsModules opts

6767 let elim = if null entryPoints then regrouped else eliminateDeadCode env entryPoints regrouped

src/Language/PureScript/CodeGen/Externs.hs+2−1

@@ -27,9 +27,10 @@ import Data.List (intercalate)

2727

2828-- |

2929-- Generate foreign imports for all declarations in a module

30+-- TODO: only expose items listed in "exps"

3031--

3132moduleToPs :: Module -> Environment -> String

32−moduleToPs (Module mn decls) env =

33+moduleToPs (Module mn decls exps) env =

3334 "module " ++ runModuleName mn ++ " where\n" ++

3435 (intercalate "\n" . map (" " ++) . concatMap (declToPs mn env) $ decls)

3536

src/Language/PureScript/CodeGen/JS.hs+1−1

@@ -49,7 +49,7 @@ import Language.PureScript.CodeGen.Common

4949-- module.

5050--

5151moduleToJs :: Options -> Module -> Environment -> Maybe JS

52−moduleToJs opts (Module name decls) env =

52+moduleToJs opts (Module name decls exps) env =

5353 case jsDecls of

5454 [] -> Nothing

5555 _ -> Just $ JSAssignment (JSAccessor (moduleNameToJs name) (JSVar "_ps")) $

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

@@ -35,12 +35,12 @@ eliminateDeadCode env entryPoints ms =

3535 let declarations = concatMap (declarationsByModule env) ms

3636 (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations

3737 entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations

38− in flip map ms $ \(Module moduleName ds) -> Module moduleName (filter (isUsed moduleName graph vertexFor entryPointVertices) ds)

38+ in flip map ms $ \(Module moduleName ds exps) -> Module moduleName (filter (isUsed moduleName graph vertexFor entryPointVertices) ds) exps

3939

4040type Key = (ModuleName, Either Ident ProperName)

4141

4242declarationsByModule :: Environment -> Module -> [(Key, [Key])]

43−declarationsByModule env (Module moduleName ds) = concatMap go ds

43+declarationsByModule env (Module moduleName ds _) = concatMap go ds

4444 where

4545 go :: Declaration -> [(Key, [Key])]

4646 go d@(ValueDeclaration name _ _ _) = [((moduleName, Left name), dependencies moduleName d)]

src/Language/PureScript/Declarations.hs+3−2

@@ -40,9 +40,10 @@ data Associativity = Infixl | Infixr deriving (Show, D.Data, D.Typeable)

4040data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)

4141

4242-- |

43−-- A module declaration, consisting of a module name and a list of declarations

43+-- A module declaration, consisting of a module name, a list of declarations, and a list of the

44+-- declarations that are explicitly imported. If the export list is Nothing, everything is exported.

4445--

45−data Module = Module ModuleName [Declaration] deriving (Show, D.Data, D.Typeable)

46+data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)

4647

4748-- |

4849-- The type of a foreign import

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

@@ -51,7 +51,7 @@ usedModules = nub . everything (++) (mkQ [] qualifiedIdents `extQ` qualifiedProp

5151 imports _ = []

5252

5353getModuleName :: Module -> ModuleName

54−getModuleName (Module mn _) = mn

54+getModuleName (Module mn _ _) = mn

5555

5656-- |

5757-- Convert a strongly connected component of the module graph to a module

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

@@ -146,9 +146,10 @@ parseModule = do

146146 reserved "module"

147147 indented

148148 name <- moduleName

149+ exports <- P.optionMaybe $ parens $ commaSep1 parseDeclarationRef

149150 _ <- lexeme $ P.string "where"

150151 decls <- mark (P.many (same *> parseDeclaration))

151− return $ Module name decls

152+ return $ Module name decls exports

152153

153154-- |

154155-- Parse a collection of modules

src/Language/PureScript/Sugar/BindingGroups.hs+3−3

@@ -25,7 +25,7 @@ import Data.Data

2525import Data.Graph

2626import Data.Generics

2727import Data.List (nub, intersect)

28−import Control.Applicative ((<$>))

28+import Control.Applicative ((<$>), (<*>), pure)

2929

3030import Language.PureScript.Declarations

3131import Language.PureScript.Names

@@ -36,13 +36,13 @@ import Language.PureScript.Types

3636-- Replace all sets of mutually-recursive declarations in a module with binding groups

3737--

3838createBindingGroupsModule :: [Module] -> Either String [Module]

39−createBindingGroupsModule = mapM $ \(Module name ds) -> Module name <$> createBindingGroups name ds

39+createBindingGroupsModule = mapM $ \(Module name ds exps) -> Module name <$> createBindingGroups name ds <*> pure exps

4040

4141-- |

4242-- Collapse all binding groups in a module to individual declarations

4343--

4444collapseBindingGroupsModule :: [Module] -> [Module]

45−collapseBindingGroupsModule = map $ \(Module name ds) -> Module name (collapseBindingGroups ds)

45+collapseBindingGroupsModule = map $ \(Module name ds exps) -> Module name (collapseBindingGroups ds) exps

4646

4747-- |

4848-- Replace all sets of mutually-recursive declarations with binding groups

src/Language/PureScript/Sugar/CaseDeclarations.hs+1−1

@@ -35,7 +35,7 @@ import Language.PureScript.Scope

3535-- Replace all top-level binders in a module with case expressions.

3636--

3737desugarCasesModule :: [Module] -> Either String [Module]

38−desugarCasesModule ms = forM ms $ \(Module name ds) -> Module name <$> (desugarCases . desugarAbs $ ds)

38+desugarCasesModule ms = forM ms $ \(Module name ds exps) -> Module name <$> (desugarCases . desugarAbs $ ds) <*> pure exps

3939

4040desugarAbs :: [Declaration] -> [Declaration]

4141desugarAbs = everywhere (mkT replace)

src/Language/PureScript/Sugar/Names.hs+5−5

@@ -143,14 +143,14 @@ desugarImports modules = do

143143-- Rethrow an error with the name of the current module in the case of a failure

144144--

145145rethrowForModule :: Module -> Either String a -> Either String a

146−rethrowForModule (Module mn _) = flip catchError $ \e -> throwError ("Error in module '" ++ show mn ++ "':\n" ++ e)

146+rethrowForModule (Module mn _ _) = flip catchError $ \e -> throwError ("Error in module '" ++ show mn ++ "':\n" ++ e)

147147

148148-- |

149149-- Replaces all local names with qualified names within a module.

150150--

151151renameInModule :: ImportEnvironment -> Module -> Either String Module

152−renameInModule imports (Module mn decls) =

153− Module mn <$> mapM updateDecl decls >>= everywhereM (mkM updateType `extM` updateValue `extM` updateBinder `extM` updateVars)

152+renameInModule imports (Module mn decls exps) =

153+ Module mn <$> (mapM updateDecl decls >>= everywhereM (mkM updateType `extM` updateValue `extM` updateBinder `extM` updateVars)) <*> pure exps

154154 where

155155 updateDecl (TypeInstanceDeclaration name cs (Qualified Nothing cn) ts ds) =

156156 TypeInstanceDeclaration name <$> updateConstraints cs <*> updateClassName cn <*> pure ts <*> pure ds

@@ -197,7 +197,7 @@ renameInModule imports (Module mn decls) =

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

198198findExports = foldM addModule M.empty

199199 where

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

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

201201 addDecl mn env (TypeClassDeclaration tcn _ ds) = do

202202 env' <- addTypeClass env mn tcn

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

@@ -227,7 +227,7 @@ findImports = foldl findImports' M.empty

227227-- Constructs a local environment for a module.

228228--

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

230−resolveImports env (Module currentModule decls) =

230+resolveImports env (Module currentModule decls _) =

231231 foldM resolveImport' (ImportEnvironment M.empty M.empty M.empty M.empty) (M.toList scope)

232232 where

233233 -- A Map from module name to imports from that module, where Nothing indicates everything is to be imported

src/Language/PureScript/Sugar/Operators.hs+2−2

@@ -49,11 +49,11 @@ rebracket :: [Module] -> Either String [Module]

4949rebracket = go M.empty []

5050 where

5151 go _ rb [] = return . reverse $ rb

52− go m rb (Module name ds : ms) = do

52+ go m rb (Module name ds exps : ms) = do

5353 m' <- M.union m <$> collectFixities m name ds

5454 let opTable = customOperatorTable m'

5555 ds' <- G.everywhereM' (G.mkM (matchOperators name opTable)) ds

56− go m' (Module name (G.everywhere (G.mkT removeParens) ds') : rb) ms

56+ go m' (Module name (G.everywhere (G.mkT removeParens) ds') exps : rb) ms

5757

5858removeParens :: Value -> Value

5959removeParens (Parens val) = val

src/Language/PureScript/Sugar/TypeClasses.hs+1−1

@@ -47,7 +47,7 @@ desugarTypeClasses :: [Module] -> Either String [Module]

4747desugarTypeClasses = flip evalStateT M.empty . mapM desugarModule

4848

4949desugarModule :: Module -> Desugar Module

50−desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl name) decls

50+desugarModule (Module name decls exps) = Module name <$> concat <$> mapM (desugarDecl name) decls <*> pure exps

5151

5252-- |

5353-- Desugar type class and type class instance declarations

src/Language/PureScript/Sugar/TypeDeclarations.hs+1−1

@@ -30,7 +30,7 @@ import Language.PureScript.Values

3030-- Replace all top level type declarations in a module with type annotations

3131--

3232desugarTypeDeclarationsModule :: [Module] -> Either String [Module]

33−desugarTypeDeclarationsModule ms = forM ms $ \(Module name ds) -> Module name <$> desugarTypeDeclarations ds

33+desugarTypeDeclarationsModule ms = forM ms $ \(Module name ds exps) -> Module name <$> desugarTypeDeclarations ds <*> pure exps

3434

3535-- |

3636-- Replace all top level type declarations with type annotations