@@ -175,36 +175,59 @@ actuallyUnify region variable1 variable2 = do
175 (EmptyRecord1, Record1 fields ext) | Map.null fields -> unify' ext variable1
175 (EmptyRecord1, Record1 fields ext) | Map.null fields -> unify' ext variable1
177 (Record1 fields1 ext1, Record1 fields2 ext2) ->
177 (Record1 fields1 ext1, Record1 fields2 ext2) ->
178− do Map.intersectionWith (zipWith unify') fields1 fields2
178+ recordUnify region fresh fields1 ext1 fields2 ext2
183− let mkRecord fs ext =
180+ _ -> TS.addError region Nothing variable1 variable2
184− fresh (Just (Record1 fs ext))
186− let uniqueFields1 = diffFields fields1 fields2
187− let uniqueFields2 = diffFields fields2 fields1
189− case (Map.null uniqueFields1, Map.null uniqueFields2) of
194− do record2' <- mkRecord uniqueFields2 ext2
195− unify' ext1 record2'
198− do record1' <- mkRecord uniqueFields1 ext1
199− unify' record1' ext2
202− do record1' <- mkRecord uniqueFields1 =<< fresh Nothing
203− record2' <- mkRecord uniqueFields2 =<< fresh Nothing
204− unify' record1' ext2
205− unify' ext1 record2'
207− _ -> TS.addError region Nothing variable1 variable2
183+-- RECORD UNIFICATION
187+ -> (Maybe (Term1 Variable) -> StateT TS.SolverState IO Variable)
188+ -> Map.Map String [Variable]
190+ -> Map.Map String [Variable]
192+ -> StateT TS.SolverState IO ()
193+recordUnify region fresh fields1 ext1 fields2 ext2 =
194+ do unifyOverlappingFields region fields1 fields2
196+ let mkRecord fs ext =
197+ fresh (Just (Record1 fs ext))
199+ let uniqueFields1 = diffFields fields1 fields2
200+ let uniqueFields2 = diffFields fields2 fields1
202+ case (Map.null uniqueFields1, Map.null uniqueFields2) of
204+ unify region ext1 ext2
207+ do record2' <- mkRecord uniqueFields2 ext2
208+ unify region ext1 record2'
211+ do record1' <- mkRecord uniqueFields1 ext1
212+ unify region record1' ext2
215+ do record1' <- mkRecord uniqueFields1 =<< fresh Nothing
216+ record2' <- mkRecord uniqueFields2 =<< fresh Nothing
217+ unify region record1' ext2
218+ unify region ext1 record2'
221+unifyOverlappingFields
223+ -> Map.Map String [Variable]
224+ -> Map.Map String [Variable]
225+ -> StateT TS.SolverState IO ()
226+unifyOverlappingFields region fields1 fields2 =
227+ Map.intersectionWith (zipWith (unify region)) fields1 fields2
210diffFields :: Map.Map String [a] -> Map.Map String [a] -> Map.Map String [a]
233diffFields :: Map.Map String [a] -> Map.Map String [a] -> Map.Map String [a]