0367dd0 · rowtype-yoga/purescript-native

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

on golang help sign in

Preserve import/export info in externs files

0367dd0Gary Burgess11 years ago

src/Language/PureScript/CodeGen/Externs.hs+20−12

compare with golang

unifiedsplit

@@ -38,26 +38,29 @@ import Language.PureScript.Types

38moduleToPs :: Module -> Environment -> String

39moduleToPs (Module _ _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"

40moduleToPs (Module _ _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do

41− let exps = listExports exts

41+ let exps = listRefs exts

42 tell ["module " ++ runModuleName moduleName ++ (if null exps then "" else " (" ++ exps ++ ")") ++ " where"]

43 mapM_ declToPs ds

44 mapM_ exportToPs exts

45 where

47− listExports :: [DeclarationRef] -> String

47+ listRefs :: [DeclarationRef] -> String

48− listExports = intercalate ", " . mapMaybe listExport

48+ listRefs = intercalate ", " . mapMaybe listRef

50− listExport :: DeclarationRef -> Maybe String

50+ listRef :: DeclarationRef -> Maybe String

51− listExport (PositionedDeclarationRef _ _ d) = listExport d

51+ listRef (PositionedDeclarationRef _ _ d) = listRef d

52− listExport (TypeRef name Nothing) = Just $ show name ++ "()"

52+ listRef (TypeRef name Nothing) = Just $ show name ++ "()"

53− listExport (TypeRef name (Just dctors)) = Just $ show name ++ "(" ++ intercalate ", " (map show dctors) ++ ")"

53+ listRef (TypeRef name (Just dctors)) = Just $ show name ++ "(" ++ intercalate ", " (map show dctors) ++ ")"

54− listExport (ValueRef name) = Just $ show name

54+ listRef (ValueRef name) = Just $ show name

55− listExport (TypeClassRef name) = Just $ show name

55+ listRef (TypeClassRef name) = Just $ show name

56− listExport (ModuleRef name) = Just $ "module " ++ show name

56+ listRef (ModuleRef name) = Just $ "module " ++ show name

57− listExport _ = Nothing

57+ listRef _ = Nothing

59 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]

61 declToPs (FixityDeclaration (Fixity assoc prec) op) =

64 declToPs (FixityDeclaration (Fixity assoc prec) op) =

62 case find exportsOp exts of

65 case find exportsOp exts of

63 Nothing -> return ()

66 Nothing -> return ()

@@ -70,6 +73,11 @@ moduleToPs (Module _ _ moduleName ds (Just exts)) env = intercalate "\n" . execW

70 declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d

73 declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d

71 declToPs _ = return ()

74 declToPs _ = return ()

76+ importToPs :: ImportDeclarationType -> String

77+ importToPs Implicit = ""

78+ importToPs (Explicit refs) = " (" ++ listRefs refs ++ ")"

79+ importToPs (Hiding refs) = " hiding (" ++ listRefs refs ++ ")"

80+

73 commentToPs :: Comment -> Writer [String] ()

81 commentToPs :: Comment -> Writer [String] ()

74 commentToPs (LineComment s) = tell ["-- " ++ s]

82 commentToPs (LineComment s) = tell ["-- " ++ s]

75 commentToPs (BlockComment s) = tell ["{- " ++ s ++ " -}"]

83 commentToPs (BlockComment s) = tell ["{- " ++ s ++ " -}"]

src/Language/PureScript/Sugar/Names.hs+7−6

@@ -62,7 +62,7 @@ desugarImports modules = do

62 renameInModule' env m@(Module _ _ mn _ _) =

63 rethrow (onErrorMessages (ErrorInModule mn)) $ do

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

67-- |

68-- Make all exports for a module explicit. This may still effect modules that

@@ -70,11 +70,12 @@ desugarImports modules = do

70-- explicit.

71--

72elaborateExports :: Exports -> Module -> Module

73−elaborateExports exps (Module ss coms mn decls _) =

73+elaborateExports exps (Module ss coms mn decls refs) =

74 Module ss coms mn decls $

75 Just $ map (\(ctor, dctors) -> TypeRef ctor (Just dctors)) (my exportedTypes) ++

76 map TypeClassRef (my exportedTypeClasses) ++

77− map ValueRef (my exportedValues)

77+ map ValueRef (my exportedValues) ++

78+ maybe [] (filter isModuleRef) refs

78 where

79 where

79 -- Extracts a list of values from the exports and filters out any values that

80 -- Extracts a list of values from the exports and filters out any values that

80 -- are re-exports from other modules.

81 -- are re-exports from other modules.

@@ -85,15 +86,15 @@ elaborateExports exps (Module ss coms mn decls _) =

85-- Add `import X ()` for any modules where there are only fully qualified references to members.

86-- Add `import X ()` for any modules where there are only fully qualified references to members.

86-- This ensures transitive instances are included when using a member from a module.

87-- This ensures transitive instances are included when using a member from a module.

87--

88--

88−elaborateImports :: Module -> Module

89+elaborateImports :: Imports -> Module -> Module

89−elaborateImports (Module ss coms mn decls exps) = Module ss coms mn decls' exps

90+elaborateImports imps (Module ss coms mn decls exps) = Module ss coms mn decls' exps

90 where

91 where

91 decls' :: [Declaration]

92 decls' :: [Declaration]

92 decls' =

93 decls' =

93 let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues (const []) (const []) (const [])

94 let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues (const []) (const []) (const [])

94 in mkImport `map` nub (f `concatMap` decls) ++ decls

95 in mkImport `map` nub (f `concatMap` decls) ++ decls

95 fqValues :: Expr -> [ModuleName]

96 fqValues :: Expr -> [ModuleName]

96− fqValues (Var (Qualified (Just mn') _)) = [mn']

97+ fqValues (Var (Qualified (Just mn') _)) | notElem mn' (importedModules imps) = [mn']

97 fqValues _ = []

98 fqValues _ = []

98 mkImport :: ModuleName -> Declaration

99 mkImport :: ModuleName -> Declaration

99 mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing

100 mkImport mn' = ImportDeclaration mn' (Explicit []) Nothing