git.iko.soy/elk
on master help sign in
Get rid of current canonicalization code
eb96d7aEvan Czaplicki
compiler/SourceSyntax/Module.hs−49
compare with master
unifiedsplit
@@ -50,52 +50,3 @@ data ModuleInterface = ModuleInterface {
50instance Binary ModuleInterface where
50instance Binary ModuleInterface where
51 put modul = put (iTypes modul) >> put (iAdts modul) >> put (iAliases modul)
51 put modul = put (iTypes modul) >> put (iAdts modul) >> put (iAliases modul)
52 get = ModuleInterface <$> get <*> get <*> get
52 get = ModuleInterface <$> get <*> get <*> get
53−
54−
55−canonicalize :: String -> [ImportMethod] -> ModuleInterface -> ModuleInterface
56−canonicalize prefix importMethods interface =
57− ModuleInterface { iTypes = Map.unions (map iTypes ifaces)
58− , iAdts = concatMap iAdts ifaces
59− , iAliases = concatMap iAliases ifaces }
60− where
61− ifaces = map (canonicalizeHelp prefix interface) importMethods
62−
63−
64−canonicalizeHelp :: String -> ModuleInterface -> ImportMethod -> ModuleInterface
65−canonicalizeHelp prefix interface importMethod =
66− ModuleInterface {
67− iTypes = renameNames $ Map.map (renameType rename) (iTypes interface),
68− iAdts = map renameADT (iAdts interface),
69− iAliases = iAliases interface
70− }
71− where
72− addPrefix name = prefix ++ "." ++ name
73−
74− newName (tipe,_,_) =
75− case importMethod of
76− As name -> (tipe, name ++ "." ++ tipe)
77− Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
78− Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
79− newNames = Map.fromList . map newName $ iAdts interface
80−
81− rename name = Map.findWithDefault name name newNames
82−
83− renameADT (name, tvars, ctors) =
84− (rename name, tvars, map (second (map (renameType rename))) ctors)
85−
86− renameNames tipes =
87− case importMethod of
88− As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
89− Hiding hidens -> foldr Map.delete tipes hidens
90− Importing visibles ->
91− Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
92−
93−renameType :: (String -> String) -> Type -> Type
94−renameType find tipe =
95− let rnm = renameType find in
96− case tipe of
97− Lambda a b -> Lambda (rnm a) (rnm b)
98− Var x -> Var x
99− Data name ts -> Data (find name) (map rnm ts)
100− EmptyRecord -> EmptyRecord
101− Record fields ext -> Record (map (second rnm) fields) (rnm ext)
compiler/Type/Inference.hs+2−9
@@ -18,15 +18,11 @@ import Control.Arrow (second)
18import Transform.SortDefinitions as Sort
18import Transform.SortDefinitions as Sort
19
19
20import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
20import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
21− -- the IO monad. Not sure if that'd be worthwhile.
21+ -- the IO monad. I don't think that'd be worthwhile.
22
22
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)
25−infer interfaces' modul = unsafePerformIO $ do
25+infer interfaces modul = unsafePerformIO $ do
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'
29−
30 env <- Env.initialEnvironment
26 env <- Env.initialEnvironment
31 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
27 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
32 (aliases modul ++ concatMap iAliases (Map.elems interfaces))
28 (aliases modul ++ concatMap iAliases (Map.elems interfaces))
@@ -34,9 +30,6 @@ infer interfaces' modul = unsafePerformIO $ do
34 do (_, vars, args, result) <- Env.freshDataScheme env name
30 do (_, vars, args, result) <- Env.freshDataScheme env name
35 return (name, (vars, foldr (T.==>) result args))
31 return (name, (vars, foldr (T.==>) result args))
36
32
37−-- mapM print . Map.toList $ Env.aliases env
38−-- mapM print (imports modul)
39−
40 importedVars <-
33 importedVars <-
41 forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->
34 forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->
42 (,) name `fmap` Env.instantiateType env tipe Map.empty
35 (,) name `fmap` Env.instantiateType env tipe Map.empty