@@ -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,54 +77,16 @@ 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]
10783 importToIL = AST.everything (++) modRef
10884 where
10985 modRef (AST.Indexer _ (AST.Var _ _) (AST.Var _ mname))
110− | not $ T.null mname = [mname]
86+ | not $ T.null mname = [extract mname]
11187 modRef _ = []
112−
113− -- | Replaces the `ModuleName`s in the AST so that the generated code refers to
114− -- the collision-avoiding renamed module imports.
115− renameModules :: M.Map ModuleName (Ann, ModuleName) -> [Bind Ann] -> [Bind Ann]
116− renameModules mnLookup binds =
117− let (f, _, _) = everywhereOnValues id ilExpr goBinder
118− in map f binds
119− where
120− ilExpr :: Expr a -> Expr a
121− ilExpr (Var ann q) = Var ann (renameQual q)
122− ilExpr e = e
123− goBinder :: Binder a -> Binder a
124− goBinder (ConstructorBinder ann q1 q2 bs) = ConstructorBinder ann (renameQual q1) (renameQual q2) bs
125− goBinder b = b
126− renameQual :: Qualified a -> Qualified a
127− renameQual (Qualified (Just mn') a) =
128− let (_,mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
129− in Qualified (Just mnSafe) a
130− renameQual q = q
88+ extract :: Text -> Text
89+ extract = T.replace "_" "." . T.dropWhileEnd (=='_')
13190
13291 -- |
13392 -- Generate code in the simplified intermediate representation for a declaration
@@ -178,7 +137,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
178137 updates <- mapM (sndM valueToIL) ps
179138 obj' <- freshName'
180139 let objVar = AST.Var Nothing obj'
181− copy = AST.VariableIntroduction Nothing obj' (Just $ AST.App Nothing (AST.StringLiteral Nothing (mkString dictType)) [obj])
140+ copy = AST.VariableIntroduction Nothing obj' (Just $ copyDict obj)
182141 assign (k, v) = AST.Assignment Nothing (accessorString k objVar) v
183142 sts = copy : (assign <$> updates) ++ [AST.Return Nothing objVar]
184143 return $ AST.App Nothing (AST.Function Nothing Nothing [] (AST.Block Nothing sts)) []
@@ -242,7 +201,7 @@ moduleToIL (Module _ coms mn _ imps _ foreigns decls) project =
242201 -- | Generate code in the simplified intermediate representation for a reference to a
243202 -- variable that may have a qualified name.
244203 qualifiedToIL :: (a -> Ident) -> Qualified a -> AST
245− 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
246205 qualifiedToIL f (Qualified (Just mn') a) | mn /= mn' = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing (moduleNameToIL mn'))
247206 qualifiedToIL f (Qualified _ a) = AST.Indexer Nothing (AST.Var Nothing . moduleIdentToIL $ f a) (AST.Var Nothing "")
248207
@@ -357,3 +316,6 @@ emptyAnn = (SourceSpan "" (SourcePos 0 0) (SourcePos 0 0), [], Nothing, Nothing)
357316arrayLength :: AST -> AST
358317arrayLength a = AST.App Nothing (AST.Var Nothing arrayLengthFn) [a]
359318-- arrayLength a = AST.Var Nothing (arrayLengthFn <> "(" <> prettyPrintIL1 a <> ")")
319+
320+copyDict :: AST -> AST
321+copyDict a = AST.App Nothing (AST.Var Nothing copyDictFn) [a]