on master help sign in
Implement unification for records
commit2a51470fc172029c9885f0143a7bbde9e60cd2ad authorEvan Czaplicki <info@elm-lang.org> dateFri 26 Jul 2013, 19:04 (13 years ago) parent760ad90
2 files changed+31−4
compiler/Type/Type.hs+13−2 compiler/Type/Unify.hs+18−2
compiler/Type/Type.hs+13−2
@@ -112,6 +112,15 @@ var flex = UF.fresh $ Descriptor {
112112 mark = noMark
113113 }
114114
115+structuredVar structure = UF.fresh $ Descriptor {
116+ structure = Just structure,
117+ rank = noRank,
118+ flex = Flexible,
119+ name = Nothing,
120+ copy = Nothing,
121+ mark = noMark
122+ }
123+
115124
116125-- ex qs constraint == exists qs. constraint
117126ex :: [Variable] -> TypeConstraint -> TypeConstraint
@@ -158,9 +167,11 @@ instance PrettyType a => PrettyType (Term1 a) where
158167
159168 EmptyRecord1 -> P.braces P.empty
160169
161− Record1 fields ext ->
162− P.braces (prty ext <+> P.text "|" <+> commaSep prettyFields)
170+ Record1 fields ext -> P.braces (extend <+> commaSep prettyFields)
163171 where
172+ prettyExt = prty ext
173+ extend | P.render prettyExt == "{}" = P.empty
174+ | otherwise = prettyExt <+> P.text "|"
164175 mkPretty f t = P.text f <+> P.text ":" <+> prty t
165176 prettyFields = concatMap (\(f,ts) -> map (mkPretty f) ts) (Map.toList fields)
166177
compiler/Type/Unify.hs+18−2
@@ -2,6 +2,7 @@ module Type.Unify (unify) where
22
33import Type.Type
44import qualified Data.UnionFind.IO as UF
5+import qualified Data.Map as Map
56import qualified Type.State as TS
67import Control.Arrow (first,second)
78import Control.Monad.State
@@ -121,8 +122,23 @@ actuallyUnify variable1 variable2 = do
121122 (EmptyRecord1, EmptyRecord1) ->
122123 return ()
123124
125+ (Record1 fields ext, EmptyRecord1) | Map.null fields -> unify ext variable2
126+ (EmptyRecord1, Record1 fields ext) | Map.null fields -> unify ext variable1
127+
124128 (Record1 fields1 ext1, Record1 fields2 ext2) ->
125− TS.addError "did not write record unification yet" variable1 variable2
129+ do sequence . concat . Map.elems $ Map.intersectionWith (zipWith unify) fields1 fields2
130+ record1' <- liftIO $ (structuredVar . Record1 fields1') =<< var Flexible
131+ record2' <- liftIO $ (structuredVar . Record1 fields2') =<< var Flexible
132+ unify record1' ext2
133+ unify ext1 record2'
134+ where
135+ fields1' = unmerged fields1 fields2
136+ fields2' = unmerged fields2 fields1
137+
138+ unmerged a b = Map.filter (not . null) $ Map.unionWith eat a b
139+
140+ eat (x:xs) (y:ys) = eat xs ys
141+ eat xs ys = xs
126142
127− _ -> TS.addError "could not unify types" variable1 variable2
143+ _ -> TS.addError "The following types are not equal" variable1 variable2
128144