git.iko.soy/elk
on master help sign in
Allow multiple different imports of the same module, clean up `canonicalize` code
6948858Evan Czaplicki
compiler/SourceSyntax/Module.hs+35−19
compare with master
unifiedsplit
@@ -51,25 +51,41 @@ instance Binary ModuleInterface where
51 get = ModuleInterface <$> get <*> get
51 get = ModuleInterface <$> get <*> get
52
52
53
53
54−canonicalize :: String -> ImportMethod -> ModuleInterface -> ModuleInterface
54+canonicalize :: String -> [ImportMethod] -> ModuleInterface -> ModuleInterface
55−canonicalize prefix importMethod interface =
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
56− let addPrefix name = prefix ++ "." ++ name
69+ addPrefix name = prefix ++ "." ++ name
57−
70+
58− newName (tipe,_,_) =
71+ newName (tipe,_,_) =
59− case importMethod of
72+ case importMethod of
60− As name -> (tipe, name ++ "." ++ tipe)
73+ As name -> (tipe, name ++ "." ++ tipe)
61− Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
74+ 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)
75+ Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
63− newNames = Map.fromList . map newName $ iAdts interface
76+ newNames = Map.fromList . map newName $ iAdts interface
64−
77+
65− rename name = Map.findWithDefault name name newNames
78+ rename name = Map.findWithDefault name name newNames
66−
79+
67− renameADT (name, tvars, ctors) =
80+ renameADT (name, tvars, ctors) =
68− (rename name, tvars, map (second (map (renameType rename))) ctors)
81+ (rename name, tvars, map (second (map (renameType rename))) ctors)
69− in ModuleInterface {
82+
70− iTypes = Map.map (renameType rename) (iTypes interface),
83+ renameNames tipes =
71− iAdts = map renameADT (iAdts interface)
84+ case importMethod of
72− }
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 ])
73
89
74renameType :: (String -> String) -> Type -> Type
90renameType :: (String -> String) -> Type -> Type
75renameType find tipe =
91renameType find tipe =
compiler/Type/Inference.hs+5−13
@@ -8,7 +8,7 @@ import qualified Type.Constrain.Expression as TcExpr
8import qualified Type.Constrain.Declaration as TcDecl
8import qualified Type.Constrain.Declaration as TcDecl
9import qualified Type.Solve as Solve
9import qualified Type.Solve as Solve
10
10
11−import SourceSyntax.Module
11+import SourceSyntax.Module as Module
12import qualified SourceSyntax.Expression as Expr
12import qualified SourceSyntax.Expression as Expr
13import SourceSyntax.PrettyPrint
13import SourceSyntax.PrettyPrint
14import Text.PrettyPrint
14import Text.PrettyPrint
@@ -23,8 +23,9 @@ import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
23
23
24infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
24infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
25infer interfaces' modul = unsafePerformIO $ do
25infer interfaces' modul = unsafePerformIO $ do
26+ let insert (name,method) dict = Map.insertWith (++) name [method] dict
26− let localImports = Map.fromList (imports modul)
27+ localImports = foldr insert Map.empty (imports modul)
27− interfaces = Map.intersectionWithKey canonicalize localImports interfaces'
28+ interfaces = Map.intersectionWithKey Module.canonicalize localImports interfaces'
28
29
29-- mapM print (concatMap iAdts (Map.elems interfaces))
30-- mapM print (concatMap iAdts (Map.elems interfaces))
30
31
@@ -33,20 +34,11 @@ infer interfaces' modul = unsafePerformIO $ do
33 do (_, vars, args, result) <- Env.freshDataScheme env name
34 do (_, vars, args, result) <- Env.freshDataScheme env name
34 return (name, (vars, foldr (T.==>) result args))
35 return (name, (vars, foldr (T.==>) result args))
35
36
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−
45-- mapM print (map Map.toList $ Map.elems locals)
37-- mapM print (map Map.toList $ Map.elems locals)
46-- mapM print (imports modul)
38-- mapM print (imports modul)
47
39
48 importedVars <-
40 importedVars <-
49− forM (concatMap Map.toList $ Map.elems locals) $ \(name,tipe) ->
41+ forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->
50 (,) name `fmap` Env.instantiateType env tipe Map.empty
42 (,) name `fmap` Env.instantiateType env tipe Map.empty
51
43
52 let allTypes = ctors ++ importedVars
44 let allTypes = ctors ++ importedVars