@@ -183,35 +183,38 @@ actuallyUnify region variable1 variable2 = do
183 let mkRecord fs ext =
183 let mkRecord fs ext =
184 fresh (Just (Record1 fs ext))
184 fresh (Just (Record1 fs ext))
186+ let uniqueFields1 = diffFields fields1 fields2
187+ let uniqueFields2 = diffFields fields2 fields1
186− case (Map.null fields1', Map.null fields2') of
189+ case (Map.null uniqueFields1, Map.null uniqueFields2) of
187 (True, True) ->
190 (True, True) ->
188 unify' ext1 ext2
191 unify' ext1 ext2
190 (True, False) ->
193 (True, False) ->
191− do record2' <- mkRecord fields2' ext2
194+ do record2' <- mkRecord uniqueFields2 ext2
192 unify' ext1 record2'
195 unify' ext1 record2'
194 (False, True) ->
197 (False, True) ->
195− do record1' <- mkRecord fields1' ext1
198+ do record1' <- mkRecord uniqueFields1 ext1
196 unify' record1' ext2
199 unify' record1' ext2
198 (False, False) ->
201 (False, False) ->
199− do record1' <- mkRecord fields1' =<< fresh Nothing
202+ do record1' <- mkRecord uniqueFields1 =<< fresh Nothing
200− record2' <- mkRecord fields2' =<< fresh Nothing
203+ record2' <- mkRecord uniqueFields2 =<< fresh Nothing
201 unify' record1' ext2
204 unify' record1' ext2
202 unify' ext1 record2'
205 unify' ext1 record2'
204− fields1' = unmerged fields1 fields2
205− fields2' = unmerged fields2 fields1
207− unmerged a b =
207+ _ -> TS.addError region Nothing variable1 variable2
208− Map.union (Map.intersectionWith eat a b) a
208+
209− |> Map.filter (not . null)
210+diffFields :: Map.Map String [a] -> Map.Map String [a] -> Map.Map String [a]
211+diffFields fields1 fields2 =
211− eat (_:xs) (_:ys) = eat xs ys
212+ let eat (_:xs) (_:ys) = eat xs ys
212− eat xs _ = xs
213+ eat xs _ = xs
215+ Map.union (Map.intersectionWith eat fields1 fields2) fields1
216+ |> Map.filter (not . null)
214− _ -> TS.addError region Nothing variable1 variable2
216combinedDescriptors :: Descriptor -> Descriptor
219combinedDescriptors :: Descriptor -> Descriptor
217 -> (Maybe Var.Canonical, Flex, Int, Maybe Var.Canonical)
220 -> (Maybe Var.Canonical, Flex, Int, Maybe Var.Canonical)