@@ -52,10 +52,7 @@ moduleToIL
5252 -> m (Text, [Text], [AST], Text, Text)
5353moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
5454 do
55− let usedNames = concatMap getNames decls
56− let mnLookup = renameImports usedNames imps
57− let decls' = renameModules mnLookup decls
58− ilDecls <- mapM (bindToIL ModuleDecl) decls'
55+ ilDecls <- mapM (bindToIL ModuleDecl) decls
5956 optimized <- traverse (traverse (optimize modName')) ilDecls
6057 let optimized' = concat optimized
6158 values = annotValue <$> optimized'
@@ -80,27 +77,6 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
8077 getNames (NonRec _ ident _) = [ident]
8178 getNames (Rec vals) = map (snd . fst) vals
8279
83− -- | Creates alternative names for each module to ensure they don't collide
84− -- with declaration names.
85− renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
86− renameImports = go M.empty
87− where
88− go :: M.Map ModuleName (Ann, ModuleName) -> [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
89− go acc used ((ann, mn') : mns') =
90− let mni = Ident $ runModuleName mn'
91− in if mn' /= mn && mni `elem` used
92− then let newName = freshModuleName 1 mn' used
93− in go (M.insert mn' (ann, newName) acc) (Ident (runModuleName newName) : used) mns'
94− else go (M.insert mn' (ann, mn') acc) used mns'
95− go acc _ [] = acc
96−
97− freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName
98− freshModuleName i mn'@(ModuleName pns) used =
99− let newName = ModuleName $ init pns ++ [ProperName $ runProperName (last pns) <> "_" <> T.pack (show i)]
100− in if Ident (runModuleName newName) `elem` used
101− then freshModuleName (i + 1) mn' used
102− else newName
103−
10480 -- | Generates IL code for a module import
10581 --
10682 importToIL :: AST -> [Text]
@@ -112,25 +88,6 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
11288 extract :: Text -> Text
11389 extract = T.replace "_" "." . T.dropWhileEnd (=='_')
11490
115− -- | Replaces the `ModuleName`s in the AST so that the generated code refers to
116− -- the collision-avoiding renamed module imports.
117− renameModules :: M.Map ModuleName (Ann, ModuleName) -> [Bind Ann] -> [Bind Ann]
118− renameModules mnLookup binds =
119− let (f, _, _) = everywhereOnValues id ilExpr goBinder
120− in map f binds
121− where
122− ilExpr :: Expr a -> Expr a
123− ilExpr (Var ann q) = Var ann (renameQual q)
124− ilExpr e = e
125− goBinder :: Binder a -> Binder a
126− goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs
127− goBinder b = b
128− renameQual :: Qualified a -> Qualified a
129− renameQual (Qualified (Just mn') a) =
130− let (_,mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
131− in Qualified (Just mnSafe) a
132− renameQual q = q
133−
13491 -- |
13592 -- Generate code in the simplified intermediate representation for a declaration
13693 --
@@ -180,7 +137,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
180137 updates <- mapM (sndM valueToIL) ps
181138 obj' <- freshName'
182139 let objVar = AST.Var Nothing obj'
183− copy = AST.VariableIntroduction Nothing obj' (Just $ AST.App Nothing (AST.StringLiteral Nothing (mkString dictType)) [obj])
140+ copy = AST.VariableIntroduction Nothing obj' (Just $ copyDict obj)
184141 assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v
185142 sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]
186143 return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []
@@ -244,7 +201,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
244201 -- | Generate code in the simplified intermediate representation for a reference to a
245202 -- variable that may have a qualified name.
246203 qualifiedToIL :: (a -> Ident) -> Qualified a -> AST
247− qualifiedToIL f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a
204+ qualifiedToIL f (Qualified (Just (ModuleName mn')) a) | mn' == C.prim = AST.Var Nothing . moduleIdentToIL $ f a
248205 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
249206 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
250207
@@ -359,3 +316,6 @@ emptyAnn = (SourceSpan "" (SourcePos 0 0) (SourcePos 0 0), [], Nothing, Nothing)
359316arrayLength :: AST -> AST
360317arrayLength a = AST.App Nothing (AST.Var Nothing arrayLengthFn) [a]
361318-- arrayLength a = AST.Var Nothing (arrayLengthFn <> "(" <> prettyPrintIL1 a <> ")")
319+
320+copyDict :: AST -> AST
321+copyDict a = AST.App Nothing (AST.Var Nothing copyDictFn) [a]