git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1425 from purescript/preserve-export-info

Preserve import/export info in externs files

commit456588a1e5f8a5dfd220ef80d43a172cd234d412 authorPhil Freeman <paf31@cantab.net> dateTue 25 Aug 2015, 15:19 (11 years ago) parentec1210f0367dd0
2 files changed+27−18
compare with golang
unifiedsplit
src/Language/PureScript/CodeGen/Externs.hs+20−12 src/Language/PureScript/Sugar/Names.hs+7−6
src/Language/PureScript/CodeGen/Externs.hs+20−12
@@ -38,26 +38,29 @@ import Language.PureScript.Types
3838moduleToPs :: Module -> Environment -> String
3939moduleToPs (Module _ _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
4040moduleToPs (Module _ _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
41− let exps = listExports exts
41+ let exps = listRefs exts
4242 tell ["module " ++ runModuleName moduleName ++ (if null exps then "" else " (" ++ exps ++ ")") ++ " where"]
4343 mapM_ declToPs ds
4444 mapM_ exportToPs exts
4545 where
4646
47− listExports :: [DeclarationRef] -> String
48− listExports = intercalate ", " . mapMaybe listExport
47+ listRefs :: [DeclarationRef] -> String
48+ listRefs = intercalate ", " . mapMaybe listRef
4949
50− listExport :: DeclarationRef -> Maybe String
51− listExport (PositionedDeclarationRef _ _ d) = listExport d
52− listExport (TypeRef name Nothing) = Just $ show name ++ "()"
53− listExport (TypeRef name (Just dctors)) = Just $ show name ++ "(" ++ intercalate ", " (map show dctors) ++ ")"
54− listExport (ValueRef name) = Just $ show name
55− listExport (TypeClassRef name) = Just $ show name
56− listExport (ModuleRef name) = Just $ "module " ++ show name
57− listExport _ = Nothing
50+ listRef :: DeclarationRef -> Maybe String
51+ listRef (PositionedDeclarationRef _ _ d) = listRef d
52+ listRef (TypeRef name Nothing) = Just $ show name ++ "()"
53+ listRef (TypeRef name (Just dctors)) = Just $ show name ++ "(" ++ intercalate ", " (map show dctors) ++ ")"
54+ listRef (ValueRef name) = Just $ show name
55+ listRef (TypeClassRef name) = Just $ show name
56+ listRef (ModuleRef name) = Just $ "module " ++ show name
57+ listRef _ = Nothing
5858
5959 declToPs :: Declaration -> Writer [String] ()
60− declToPs (ImportDeclaration mn _ _) = tell ["import " ++ show mn ++ " ()"]
60+ declToPs (ImportDeclaration mn imp Nothing) =
61+ tell ["import " ++ show mn ++ importToPs imp]
62+ declToPs (ImportDeclaration mn imp (Just qual)) =
63+ tell ["import qualified " ++ show mn ++ importToPs imp ++ " as " ++ show qual]
6164 declToPs (FixityDeclaration (Fixity assoc prec) op) =
6265 case find exportsOp exts of
6366 Nothing -> return ()
@@ -70,6 +73,11 @@ moduleToPs (Module _ _ moduleName ds (Just exts)) env = intercalate "\n" . execW
7073 declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d
7174 declToPs _ = return ()
7275
76+ importToPs :: ImportDeclarationType -> String
77+ importToPs Implicit = ""
78+ importToPs (Explicit refs) = " (" ++ listRefs refs ++ ")"
79+ importToPs (Hiding refs) = " hiding (" ++ listRefs refs ++ ")"
80+
7381 commentToPs :: Comment -> Writer [String] ()
7482 commentToPs (LineComment s) = tell ["-- " ++ s]
7583 commentToPs (BlockComment s) = tell ["{- " ++ s ++ " -}"]
src/Language/PureScript/Sugar/Names.hs+7−6
@@ -62,7 +62,7 @@ desugarImports modules = do
6262 renameInModule' env m@(Module _ _ mn _ _) =
6363 rethrow (onErrorMessages (ErrorInModule mn)) $ do
6464 let (_, imps, exps) = fromMaybe (error "Module is missing in renameInModule'") $ M.lookup mn env
65− elaborateImports <$> renameInModule env imps (elaborateExports exps m)
65+ elaborateImports imps <$> renameInModule env imps (elaborateExports exps m)
6666
6767-- |
6868-- Make all exports for a module explicit. This may still effect modules that
@@ -70,11 +70,12 @@ desugarImports modules = do
7070-- explicit.
7171--
7272elaborateExports :: Exports -> Module -> Module
73−elaborateExports exps (Module ss coms mn decls _) =
73+elaborateExports exps (Module ss coms mn decls refs) =
7474 Module ss coms mn decls $
7575 Just $ map (\(ctor, dctors) -> TypeRef ctor (Just dctors)) (my exportedTypes) ++
7676 map TypeClassRef (my exportedTypeClasses) ++
77− map ValueRef (my exportedValues)
77+ map ValueRef (my exportedValues) ++
78+ maybe [] (filter isModuleRef) refs
7879 where
7980 -- Extracts a list of values from the exports and filters out any values that
8081 -- are re-exports from other modules.
@@ -85,15 +86,15 @@ elaborateExports exps (Module ss coms mn decls _) =
8586-- Add `import X ()` for any modules where there are only fully qualified references to members.
8687-- This ensures transitive instances are included when using a member from a module.
8788--
88−elaborateImports :: Module -> Module
89−elaborateImports (Module ss coms mn decls exps) = Module ss coms mn decls' exps
89+elaborateImports :: Imports -> Module -> Module
90+elaborateImports imps (Module ss coms mn decls exps) = Module ss coms mn decls' exps
9091 where
9192 decls' :: [Declaration]
9293 decls' =
9394 let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues (const []) (const []) (const [])
9495 in mkImport `map` nub (f `concatMap` decls) ++ decls
9596 fqValues :: Expr -> [ModuleName]
96− fqValues (Var (Qualified (Just mn') _)) = [mn']
97+ fqValues (Var (Qualified (Just mn') _)) | notElem mn' (importedModules imps) = [mn']
9798 fqValues _ = []
9899 mkImport :: ModuleName -> Declaration
99100 mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing