git.iko.soy/elk
on master help sign in
Implement unification for records
2a51470Evan Czaplicki
compiler/Type/Type.hs+13−2
compare with master
unifiedsplit
@@ -112,6 +112,15 @@ var flex = UF.fresh $ Descriptor {
112 mark = noMark
112 mark = noMark
113 }
113 }
114
114
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+
115
124
116-- ex qs constraint == exists qs. constraint
125-- ex qs constraint == exists qs. constraint
117ex :: [Variable] -> TypeConstraint -> TypeConstraint
126ex :: [Variable] -> TypeConstraint -> TypeConstraint
@@ -158,9 +167,11 @@ instance PrettyType a => PrettyType (Term1 a) where
158
167
159 EmptyRecord1 -> P.braces P.empty
168 EmptyRecord1 -> P.braces P.empty
160
169
161− Record1 fields ext ->
162− P.braces (prty ext <+> P.text "|" <+> commaSep prettyFields)
170+ Record1 fields ext -> P.braces (extend <+> commaSep prettyFields)
163 where
171 where
172+ prettyExt = prty ext
173+ extend | P.render prettyExt == "{}" = P.empty
174+ | otherwise = prettyExt <+> P.text "|"
164 mkPretty f t = P.text f <+> P.text ":" <+> prty t
175 mkPretty f t = P.text f <+> P.text ":" <+> prty t
165 prettyFields = concatMap (\(f,ts) -> map (mkPretty f) ts) (Map.toList fields)
176 prettyFields = concatMap (\(f,ts) -> map (mkPretty f) ts) (Map.toList fields)
166
177
compiler/Type/Unify.hs+18−2
@@ -2,6 +2,7 @@ module Type.Unify (unify) where
2
2
3import Type.Type
3import Type.Type
4import qualified Data.UnionFind.IO as UF
4import qualified Data.UnionFind.IO as UF
5+import qualified Data.Map as Map
5import qualified Type.State as TS
6import qualified Type.State as TS
6import Control.Arrow (first,second)
7import Control.Arrow (first,second)
7import Control.Monad.State
8import Control.Monad.State
@@ -121,8 +122,23 @@ actuallyUnify variable1 variable2 = do
121 (EmptyRecord1, EmptyRecord1) ->
122 (EmptyRecord1, EmptyRecord1) ->
122 return ()
123 return ()
123
124
125+ (Record1 fields ext, EmptyRecord1) | Map.null fields -> unify ext variable2
126+ (EmptyRecord1, Record1 fields ext) | Map.null fields -> unify ext variable1
127+
124 (Record1 fields1 ext1, Record1 fields2 ext2) ->
128 (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
126
142
127− _ -> TS.addError "could not unify types" variable1 variable2
143+ _ -> TS.addError "The following types are not equal" variable1 variable2
128
144