-let diff_ex alist1 alist2 =
- let head1 = List.hd alist1
- and tail1 = List.tl alist1
- and head2 = List.hd alist2
- and tail2 = List.tl alist2 (* e fin qui ... *)
- in
- match (head1, head2) with
- ([], _) -> assert false (* gli header non devono mai essere vuoti *)
- | (_, []) -> assert false (* devono contenere almeno [retVal] *)
- | (_, _) -> let headr = (head2 @
- (List.find_all
- (function t -> not (List.mem t head2))
- head1)
- ) in (* header del risultato finale *)
- List.append (* il risultato finale e' la concatenazione ...*)
- [headr] (* ... dell'header costruito prima ...*)
- (match (tail1, tail2) with (* e di una coda "unione" *)
- ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *)
- | (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *)
- | (_, _) ->
- let first = (* parte dell'unione che riguarda solo il primo set *)
- List.map (fun l -> [List.hd l] @
- xres_fill_context
- (List.tl headr) (List.tl head1) (List.tl l)
- ) tail1
- in
- List.fold_left
- (fun par x ->
- let y = (* elemento candidato ad entrare *)
- [List.hd x]
- @
- xres_fill_context
- (List.tl headr) (List.tl head2) (List.tl x)
- in
- par @ if (List.find_all (fun t -> t = y) par) = [] then
- [y]
- else
- []
- )
- first
- tail2
-(* first @
- List.map (fun l -> [List.hd l] @
- xres_fill_context
- (List.tl headr) (List.tl head2) (List.tl l)
- ) tail2
-*)
- ) (* match *)
+let rec diff_ex l1 l2 =
+ let module S = Mathql_semantics in
+ match (l1, l2) with
+ [],_ -> []
+ | l,[] -> l
+ | {S.uri = uri1}::_, {S.uri = uri2}::tl2 when uri2 < uri1 ->
+ (diff_ex l1 tl2)
+ | {S.uri = uri1 ; S.attributes = attributes1}::tl1,
+ {S.uri = uri2}::_ when uri1 < uri2 ->
+ {S.uri = uri1 ; S.attributes = attributes1 ; S.extra = ""}::(diff_ex tl1 l2)
+ | {S.uri = uri1 ; S.attributes = attributes1}::tl1,
+ {S.uri = uri2 ; S.attributes = attributes2}::tl2 ->
+ try
+ let attributes' = intersect_attributes (attributes1, attributes2) in
+ diff_ex tl1 tl2
+ with
+ NotCompatible ->
+ {S.uri = uri1 ; S.attributes = attributes1 ; S.extra = ""}::(diff_ex tl1 tl2)