-(*****************************************************************************)
-(** safe implementation **)
-(*****************************************************************************)
-
-let closure_of u m =
- let ru = repr u m in
- let eq_c =
- let j = ru.one_s_eq in
- let _Uj = merge_closures (fun x -> x.eq_closure) j m in
- let one_step_eq = ru.one_s_eq in
- (SOF.union one_step_eq _Uj)
- in
- let ge_c =
- let j = SOF.union ru.one_s_ge (SOF.union ru.one_s_gt ru.one_s_eq) in
- let _Uj = merge_closures (fun x -> x.ge_closure) j m in
- let _Ux = j in
- (SOF.union _Uj _Ux)
- in
- let gt_c =
- let j = ru.one_s_gt in
- let k = ru.one_s_ge in
- let l = ru.one_s_eq in
- let _Uj = merge_closures (fun x -> x.ge_closure) j m in
- let _Uk = merge_closures (fun x -> x.gt_closure) k m in
- let _Ul = merge_closures (fun x -> x.gt_closure) l m in
- let one_step_gt = ru.one_s_gt in
- (SOF.union (SOF.union (SOF.union _Ul one_step_gt) _Uk) _Uj)
- in
- {
- eq_closure = eq_c;
- ge_closure = ge_c;
- gt_closure = gt_c;
- in_gegt_of = ru.in_gegt_of;
- one_s_eq = ru.one_s_eq;
- one_s_ge = ru.one_s_ge;
- one_s_gt = ru.one_s_gt
- }
-
-let rec simple_adjust m =
- let m' =
- MAL.mapi (fun x _ -> closure_of x m) m
- in
- if not (are_ugraph_eq m m') then(
- simple_adjust m')
- else
- m'
-
-let add_eq_arc u v m =
- let ru = repr u m in
- let rv = repr v m in
- let ru' = {ru with one_s_eq = SOF.add v ru.one_s_eq} in
- let m' = MAL.add u ru' m in
- let rv' = {rv with one_s_eq = SOF.add u rv.one_s_eq} in
- let m'' = MAL.add v rv' m' in
- simple_adjust m''
-
-let add_ge_arc u v m =
- let ru = repr u m in
- let ru' = { ru with one_s_ge = SOF.add v ru.one_s_ge} in
- let m' = MAL.add u ru' m in
- simple_adjust m'
-
-let add_gt_arc u v m =
- let ru = repr u m in
- let ru' = {ru with one_s_gt = SOF.add v ru.one_s_gt} in
- let m' = MAL.add u ru' m in
- simple_adjust m'
-
-\f
-(*****************************************************************************)
-(** Outhern interface, that chooses between _fast and safe **)
-(*****************************************************************************)
-
-(*
- given the 2 nodes plus the current bag, adds the arc, recomputes the
- closures and returns the new map
-*)
-let add_eq fast u v b =
- if fast then
- add_eq_arc_fast u v b
- else
- add_eq_arc u v b
-
-(*
- given the 2 nodes plus the current bag, adds the arc, recomputes the
- closures and returns the new map
-*)
-let add_ge fast u v b =
- if fast then
- add_ge_arc_fast u v b
- else
- add_ge_arc u v b
-(*
- given the 2 nodes plus the current bag, adds the arc, recomputes the
- closures and returns the new map
-*)
-let add_gt fast u v b =
- if fast then
- add_gt_arc_fast u v b
- else
- add_gt_arc u v b
-