0367dd0 · rowtype-yoga/purescript-native

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

Preserve import/export info in externs files

commit0367dd0f51d1eb52979b8d20b375799d179ce74e authorGary Burgess <gary.burgess@gmail.com> dateTue 25 Aug 2015, 20:22 (11 years ago) parent95e014c

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