git.iko.soy/elk
on master help sign in
Allow multiple different imports of the same module, clean up `canonicalize` code
commit6948858f780caaad1b8d911d5eb94ac4e7127774 authorEvan Czaplicki <info@elm-lang.org> dateFri 26 Jul 2013, 12:56 (13 years ago) parent9386751
2 files changed+40−32
compare with master
unifiedsplit
compiler/SourceSyntax/Module.hs+35−19 compiler/Type/Inference.hs+5−13
compiler/SourceSyntax/Module.hs+35−19
@@ -51,25 +51,41 @@ instance Binary ModuleInterface where
5151 get = ModuleInterface <$> get <*> get
5252
5353
54−canonicalize :: String -> ImportMethod -> ModuleInterface -> ModuleInterface
55−canonicalize prefix importMethod interface =
56− let addPrefix name = prefix ++ "." ++ name
57−
58− newName (tipe,_,_) =
59− case importMethod of
60− As name -> (tipe, name ++ "." ++ tipe)
61− Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
62− Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
63− newNames = Map.fromList . map newName $ iAdts interface
64−
65− rename name = Map.findWithDefault name name newNames
66−
67− renameADT (name, tvars, ctors) =
68− (rename name, tvars, map (second (map (renameType rename))) ctors)
69− in ModuleInterface {
70− iTypes = Map.map (renameType rename) (iTypes interface),
71− iAdts = map renameADT (iAdts interface)
72− }
54+canonicalize :: String -> [ImportMethod] -> ModuleInterface -> ModuleInterface
55+canonicalize prefix importMethods interface =
56+ ModuleInterface { iTypes = Map.unions (map iTypes ifaces)
57+ , iAdts = concatMap iAdts ifaces }
58+ where
59+ ifaces = map (canonicalizeHelp prefix interface) importMethods
60+
61+
62+canonicalizeHelp :: String -> ModuleInterface -> ImportMethod -> ModuleInterface
63+canonicalizeHelp prefix interface importMethod =
64+ ModuleInterface {
65+ iTypes = renameNames $ Map.map (renameType rename) (iTypes interface),
66+ iAdts = map renameADT (iAdts interface)
67+ }
68+ where
69+ addPrefix name = prefix ++ "." ++ name
70+
71+ newName (tipe,_,_) =
72+ case importMethod of
73+ As name -> (tipe, name ++ "." ++ tipe)
74+ Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
75+ Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
76+ newNames = Map.fromList . map newName $ iAdts interface
77+
78+ rename name = Map.findWithDefault name name newNames
79+
80+ renameADT (name, tvars, ctors) =
81+ (rename name, tvars, map (second (map (renameType rename))) ctors)
82+
83+ renameNames tipes =
84+ case importMethod of
85+ As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
86+ Hiding hidens -> foldr Map.delete tipes hidens
87+ Importing visibles ->
88+ Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
7389
7490renameType :: (String -> String) -> Type -> Type
7591renameType find tipe =
compiler/Type/Inference.hs+5−13
@@ -8,7 +8,7 @@ import qualified Type.Constrain.Expression as TcExpr
88import qualified Type.Constrain.Declaration as TcDecl
99import qualified Type.Solve as Solve
1010
11−import SourceSyntax.Module
11+import SourceSyntax.Module as Module
1212import qualified SourceSyntax.Expression as Expr
1313import SourceSyntax.PrettyPrint
1414import Text.PrettyPrint
@@ -23,8 +23,9 @@ import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
2323
2424infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
2525infer interfaces' modul = unsafePerformIO $ do
26− let localImports = Map.fromList (imports modul)
27− interfaces = Map.intersectionWithKey canonicalize localImports interfaces'
26+ let insert (name,method) dict = Map.insertWith (++) name [method] dict
27+ localImports = foldr insert Map.empty (imports modul)
28+ interfaces = Map.intersectionWithKey Module.canonicalize localImports interfaces'
2829
2930-- mapM print (concatMap iAdts (Map.elems interfaces))
3031
@@ -33,20 +34,11 @@ infer interfaces' modul = unsafePerformIO $ do
3334 do (_, vars, args, result) <- Env.freshDataScheme env name
3435 return (name, (vars, foldr (T.==>) result args))
3536
36− let locals = Map.intersectionWithKey combine localImports interfaces
37− combine name importMethod interface =
38− let tipes = iTypes interface in
39− case importMethod of
40− As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
41− Hiding hidens -> foldr Map.delete tipes hidens
42− Importing visibles ->
43− Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
44−
4537-- mapM print (map Map.toList $ Map.elems locals)
4638-- mapM print (imports modul)
4739
4840 importedVars <-
49− forM (concatMap Map.toList $ Map.elems locals) $ \(name,tipe) ->
41+ forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->
5042 (,) name `fmap` Env.instantiateType env tipe Map.empty
5143
5244 let allTypes = ctors ++ importedVars