@@ -175,36 +175,59 @@ actuallyUnify region variable1 variable2 = do
175175 (EmptyRecord1, Record1 fields ext) | Map.null fields -> unify' ext variable1
176176
177177 (Record1 fields1 ext1, Record1 fields2 ext2) ->
178− do Map.intersectionWith (zipWith unify') fields1 fields2
179− |> Map.elems
180− |> concat
181− |> sequence
178+ recordUnify region fresh fields1 ext1 fields2 ext2
182179
183− let mkRecord fs ext =
184− fresh (Just (Record1 fs ext))
185−
186− let uniqueFields1 = diffFields fields1 fields2
187− let uniqueFields2 = diffFields fields2 fields1
188−
189− case (Map.null uniqueFields1, Map.null uniqueFields2) of
190− (True, True) ->
191− unify' ext1 ext2
192−
193− (True, False) ->
194− do record2' <- mkRecord uniqueFields2 ext2
195− unify' ext1 record2'
196−
197− (False, True) ->
198− do record1' <- mkRecord uniqueFields1 ext1
199− unify' record1' ext2
180+ _ -> TS.addError region Nothing variable1 variable2
200181
201− (False, False) ->
202− do record1' <- mkRecord uniqueFields1 =<< fresh Nothing
203− record2' <- mkRecord uniqueFields2 =<< fresh Nothing
204− unify' record1' ext2
205− unify' ext1 record2'
206182
207− _ -> TS.addError region Nothing variable1 variable2
183+-- RECORD UNIFICATION
184+
185+recordUnify
186+ :: A.Region
187+ -> (Maybe (Term1 Variable) -> StateT TS.SolverState IO Variable)
188+ -> Map.Map String [Variable]
189+ -> Variable
190+ -> Map.Map String [Variable]
191+ -> Variable
192+ -> StateT TS.SolverState IO ()
193+recordUnify region fresh fields1 ext1 fields2 ext2 =
194+ do unifyOverlappingFields region fields1 fields2
195+
196+ let mkRecord fs ext =
197+ fresh (Just (Record1 fs ext))
198+
199+ let uniqueFields1 = diffFields fields1 fields2
200+ let uniqueFields2 = diffFields fields2 fields1
201+
202+ case (Map.null uniqueFields1, Map.null uniqueFields2) of
203+ (True, True) ->
204+ unify region ext1 ext2
205+
206+ (True, False) ->
207+ do record2' <- mkRecord uniqueFields2 ext2
208+ unify region ext1 record2'
209+
210+ (False, True) ->
211+ do record1' <- mkRecord uniqueFields1 ext1
212+ unify region record1' ext2
213+
214+ (False, False) ->
215+ do record1' <- mkRecord uniqueFields1 =<< fresh Nothing
216+ record2' <- mkRecord uniqueFields2 =<< fresh Nothing
217+ unify region record1' ext2
218+ unify region ext1 record2'
219+
220+
221+unifyOverlappingFields
222+ :: A.Region
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
228+ |> Map.elems
229+ |> concat
230+ |> sequence_
208231
209232
210233diffFields :: Map.Map String [a] -> Map.Map String [a] -> Map.Map String [a]