@@ -29,7 +29,8 @@ import Prelude ()
2929import Prelude.Compat
3030
3131import Data.List ((\\), delete, intersect)
32−import Data.Maybe (isNothing)
32+import Data.Maybe (isNothing, fromMaybe)
33+import qualified Data.Map as M
3334import qualified Data.Traversable as T (traverse)
3435
3536import Control.Arrow ((&&&))
@@ -60,8 +61,11 @@ moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSup
6061 => Module Ann -> Maybe JS -> m [JS]
6162moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
6263 rethrow (addHint (ErrorInModule mn)) $ do
63− jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
64− jsDecls <- mapM bindToJs decls
64+ let usedNames = concatMap getNames decls
65+ let mnLookup = renameImports usedNames imps
66+ jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
67+ let decls' = renameModules mnLookup decls
68+ jsDecls <- mapM bindToJs decls'
6569 optimized <- T.traverse (T.traverse optimize) jsDecls
6670 comments <- not <$> asks optionsNoComments
6771 let strict = JSStringLiteral "use strict"
@@ -77,13 +81,66 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
7781 where
7882
7983 -- |
80− -- Generates Javascript code for a module import.
84+ -- Extracts all declaration names from a binding group.
8185 --
82− importToJs :: ModuleName -> m JS
83− importToJs mn' = do
86+ getNames :: Bind Ann -> [Ident]
87+ getNames (NonRec ident _) = [ident]
88+ getNames (Rec vals) = map fst vals
89+
90+ -- |
91+ -- Creates alternative names for each module to ensure they don't collide
92+ -- with declaration names.
93+ --
94+ renameImports :: [Ident] -> [ModuleName] -> M.Map ModuleName ModuleName
95+ renameImports ids mns = go M.empty ids mns
96+ where
97+ go :: M.Map ModuleName ModuleName -> [Ident] -> [ModuleName] -> M.Map ModuleName ModuleName
98+ go acc used (mn' : mns') =
99+ let mni = Ident $ runModuleName mn'
100+ in if mni `elem` used
101+ then let newName = freshModuleName 1 mn' used
102+ in go (M.insert mn' newName acc) (Ident (runModuleName newName) : used) mns'
103+ else go (M.insert mn' mn' acc) (mni : used) mns'
104+ go acc _ [] = acc
105+
106+ freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName
107+ freshModuleName i mn'@(ModuleName pns) used =
108+ let newName = ModuleName $ init pns ++ [ProperName $ runProperName (last pns) ++ "_" ++ show i]
109+ in if Ident (runModuleName newName) `elem` used
110+ then freshModuleName (i + 1) mn' used
111+ else newName
112+
113+ -- |
114+ -- Generates Javascript code for a module import, binding the required module
115+ -- to the alternative
116+ --
117+ importToJs :: M.Map ModuleName ModuleName -> ModuleName -> m JS
118+ importToJs mnLookup mn' = do
84119 path <- asks optionsRequirePath
120+ let mnSafe = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
85121 let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
86− return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
122+ return $ JSVariableIntroduction (moduleNameToJs mnSafe) (Just moduleBody)
123+
124+ -- |
125+ -- Replaces the `ModuleName`s in the AST so that the generated code refers to
126+ -- the collision-avoiding renamed module imports.
127+ --
128+ renameModules :: M.Map ModuleName ModuleName -> [Bind Ann] -> [Bind Ann]
129+ renameModules mnLookup binds =
130+ let (f, _, _) = everywhereOnValues id goExpr goBinder
131+ in map f binds
132+ where
133+ goExpr :: Expr a -> Expr a
134+ goExpr (Var ann q) = Var ann (renameQual q)
135+ goExpr e = e
136+ goBinder :: Binder a -> Binder a
137+ goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs
138+ goBinder b = b
139+ renameQual :: Qualified a -> Qualified a
140+ renameQual (Qualified (Just mn') a) =
141+ let mnSafe = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
142+ in Qualified (Just mnSafe) a
143+ renameQual q = q
87144
88145 -- |
89146 -- Generate code in the simplified Javascript intermediate representation for a declaration