git.iko.soy/elk
on master help sign in
Small improvement on constraint generation optimization
c1e2729Evan Czaplicki
src/Type/Inference.hs+27−21
compare with master
unifiedsplit
@@ -47,8 +47,9 @@ genConstraints
47 :: Module.Interfaces
47 :: Module.Interfaces
48 -> Module.Canonical
48 -> Module.Canonical
49 -> IO (Map.Map Text T.Type, T.Constraint)
49 -> IO (Map.Map Text T.Type, T.Constraint)
50−genConstraints interfaces modul@(Module.Module _ info) =
50+genConstraints allInterfaces modul@(Module.Module _ info) =
51+ do let directDeps = toDirectDeps (Set.fromList (Module.imports info)) allInterfaces
51− do let env = Env.initialize (canonicalizeUnions interfaces modul)
52+ let env = Env.initialize (canonicalizeUnions directDeps modul)
52
53
53 ctors <-
54 ctors <-
54 {-# SCC elm_compiler_mk_ctor_types #-}
55 {-# SCC elm_compiler_mk_ctor_types #-}
@@ -56,10 +57,7 @@ genConstraints interfaces modul@(Module.Module _ info) =
56 do (_, vars, args, result) <- Env.freshDataScheme env name
57 do (_, vars, args, result) <- Env.freshDataScheme env name
57 return (name, (vars, foldr T.FunN result args))
58 return (name, (vars, foldr T.FunN result args))
58
59
59− importedVars <-
60− {-# SCC elm_compiler_mk_value_types #-}
61− forM (Map.toList interfaces) $
62− canonicalizeValues env (Set.fromList (Module.imports info))
60+ importedVars <- mapM (canonicalizeValues env) directDeps
63
61
64 let allTypes = concat (ctors : importedVars)
62 let allTypes = concat (ctors : importedVars)
65 let vars = concatMap (fst . snd) allTypes
63 let vars = concatMap (fst . snd) allTypes
@@ -75,27 +73,35 @@ genConstraints interfaces modul@(Module.Module _ info) =
75 return (header, environ constraint)
73 return (header, environ constraint)
76
74
77
75
76+toDirectDeps :: Set.Set ModuleName.Raw -> Module.Interfaces -> [(ModuleName.Canonical, Module.Interface)]
77+toDirectDeps imports interfaces =
78+ let
79+ isDirect (ModuleName.Canonical _ name, _) =
80+ Set.member name imports
81+ in
82+ filter isDirect (Map.toList interfaces)
83+
84+
78canonicalizeValues
85canonicalizeValues
79 :: Env.Env
86 :: Env.Env
80− -> Set.Set ModuleName.Raw
81 -> (ModuleName.Canonical, Module.Interface)
87 -> (ModuleName.Canonical, Module.Interface)
82 -> IO [(Text, ([T.Variable], T.Type))]
88 -> IO [(Text, ([T.Variable], T.Type))]
83−canonicalizeValues env imports (moduleName@(ModuleName.Canonical _ rawName), iface) =
89+canonicalizeValues env (moduleName, iface) =
84− if Set.notMember rawName imports then
85− return []
86− else
87− forM (Map.toList (Module.iTypes iface)) $ \(name, tipe) ->
90+ forM (Map.toList (Module.iTypes iface)) $ \(name, tipe) ->
88− do (flexType, flexVars) <- Env.instantiateFlex env tipe
91+ do (flexType, flexVars) <- Env.instantiateFlex env tipe
89− return
92+ return
90− ( ModuleName.canonicalToText moduleName <> "." <> name
93+ ( ModuleName.canonicalToText moduleName <> "." <> name
91− , ( Map.elems flexVars
94+ , ( Map.elems flexVars
92− , flexType
95+ , flexType
93− )
94 )
96 )
97+ )
95
98
96
99
100+canonicalizeUnions
101+ :: [(ModuleName.Canonical, Module.Interface)]
102+ -> Module.Canonical
97−canonicalizeUnions :: Module.Interfaces -> Module.Canonical -> [Module.CanonicalUnion]
103+ -> [Module.CanonicalUnion]
98−canonicalizeUnions interfaces (Module.Module name info) =
104+canonicalizeUnions directDeps (Module.Module name info) =
99 localUnions ++ importedUnions
105 localUnions ++ importedUnions
100 where
106 where
101 localUnions :: [Module.CanonicalUnion]
107 localUnions :: [Module.CanonicalUnion]
@@ -104,7 +110,7 @@ canonicalizeUnions interfaces (Module.Module name info) =
104
110
105 importedUnions :: [Module.CanonicalUnion]
111 importedUnions :: [Module.CanonicalUnion]
106 importedUnions =
112 importedUnions =
107− concatMap (format . second Module.iUnions) (Map.toList interfaces)
113+ concatMap (format . second Module.iUnions) directDeps
108
114
109
115
110format :: (ModuleName.Canonical, Module.Unions) -> [Module.CanonicalUnion]
116format :: (ModuleName.Canonical, Module.Unions) -> [Module.CanonicalUnion]