git.iko.soy/elk
on master help sign in
Begin to canonicalize imported values and types
commit138e99cc810dfef7b84c407b2d6f1d307b24277a authorEvan Czaplicki <info@elm-lang.org> dateMon 22 Jul 2013, 14:42 (13 years ago) parenteb722a2
2 files changed+45−8
compare with master
unifiedsplit
compiler/SourceSyntax/Module.hs+34−2 compiler/Type/Inference.hs+11−6
compiler/SourceSyntax/Module.hs+34−2
@@ -6,8 +6,9 @@ import Data.Binary
66import Data.List (intercalate)
77import qualified Data.Map as Map
88import Control.Applicative ((<$>), (<*>))
9+import Control.Arrow (second)
910
10−import SourceSyntax.Expression
11+import SourceSyntax.Expression (LExpr)
1112import SourceSyntax.Declaration
1213import SourceSyntax.Type
1314import System.FilePath (joinPath)
@@ -46,4 +47,35 @@ data ModuleInterface = ModuleInterface {
4647
4748instance Binary ModuleInterface where
4849 put modul = put (iTypes modul) >> put (iAdts modul)
49− get = ModuleInterface <$> get <*> get
50+ get = ModuleInterface <$> get <*> get
51+
52+
53+canonicalize :: String -> ImportMethod -> ModuleInterface -> ModuleInterface
54+canonicalize prefix importMethod interface =
55+ let addPrefix name = prefix ++ "." ++ name
56+
57+ newName (tipe,_,_) =
58+ case importMethod of
59+ As name -> (tipe, name ++ "." ++ tipe)
60+ Hiding vs -> (tipe, if tipe `elem` vs then addPrefix tipe else tipe)
61+ Importing vs -> (tipe, if tipe `elem` vs then tipe else addPrefix tipe)
62+ newNames = Map.fromList . map newName $ iAdts interface
63+
64+ rename name = Map.findWithDefault name name newNames
65+
66+ renameADT (name, tvars, ctors) =
67+ (rename name, tvars, map (second (map (renameType rename))) ctors)
68+ in ModuleInterface {
69+ iTypes = Map.map (renameType rename) (iTypes interface),
70+ iAdts = map renameADT (iAdts interface)
71+ }
72+
73+renameType :: (String -> String) -> Type -> Type
74+renameType find tipe =
75+ let rnm = renameType find in
76+ case tipe of
77+ Lambda a b -> Lambda (rnm a) (rnm b)
78+ Var x -> Var x
79+ Data name ts -> Data (find name) (map rnm ts)
80+ EmptyRecord -> EmptyRecord
81+ Record fields ext -> Record (Map.map (map rnm) fields) (rnm ext)
compiler/Type/Inference.hs+11−6
@@ -22,14 +22,20 @@ import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
2222
2323
2424infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
25−infer interfaces modul = unsafePerformIO $ do
26− env <- Env.initialEnvironment (datatypes modul)
25+infer interfaces' modul = unsafePerformIO $ do
26+ let localImports = Map.fromList (imports modul)
27+ interfaces = Map.intersectionWithKey canonicalize localImports interfaces'
28+
29+-- mapM print (concatMap iAdts (Map.elems interfaces))
30+
31+ env <- Env.initialEnvironment (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
2732 var <- T.flexibleVar
2833 ctors <- forM (Map.keys (Env.constructor env)) $ \name ->
2934 do (_, vars, tipe) <- Env.freshDataScheme env name
3035 return (name, (vars, tipe))
3136
32− let combine name importMethod interface =
37+ let locals = Map.intersectionWithKey combine localImports interfaces
38+ combine name importMethod interface =
3339 let tipes = iTypes interface in
3440 case importMethod of
3541 As alias -> Map.mapKeys (\v -> alias ++ "." ++ v) tipes
@@ -37,9 +43,8 @@ infer interfaces modul = unsafePerformIO $ do
3743 Importing visibles ->
3844 Map.intersection tipes (Map.fromList [ (v,()) | v <- visibles ])
3945
40− locals = Map.intersectionWithKey combine (Map.fromList (imports modul)) interfaces
41−
42− mapM print (imports modul)
46+-- mapM print (map Map.toList $ Map.elems locals)
47+-- mapM print (imports modul)
4348
4449 importedVars <-
4550 forM (concatMap Map.toList $ Map.elems locals) $ \(name,tipe) ->