Commits

Sébastien Ferré  committed 1c2283d

Reverse of 'compare' for compatibility with LSet.

  • Participants
  • Parent commits a291d5c

Comments (0)

Files changed (1)

+(** Sets of sets represented by tries. *)
+
+let compare x y = Pervasives.compare y x (* for compatibility with LSet (Oops!) *)
 
 type ('a,'b) t = Add of (('a * ('a,'b) t * ('a,'b) t) * 'b option) | Empty of 'b option
 
     | [] -> Empty (Some v)
     | x::xs -> Add ((x,singleton xs v,empty), None)
 
-(*
 let rec add : ('b -> 'b -> 'b) -> 'a LSet.t -> 'b -> ('a,'b) t -> ('a,'b) t =
   fun u xs v yss ->
     match xs, yss with
-    | _, Empty vopt ->
-       singleton xs v
+    | [], Empty vopt ->
+	Empty (add_vopt u vopt v)
+    | x::xs1, Empty vopt ->
+	Add ((x,add u xs1 v empty,empty), vopt)
     | [], Add (y, vopt) ->
-       Add (y, Some v)
+       Add (y, add_vopt u vopt v)
     | x::xs1, Add ((y,yss1,yss2), vopt) ->
        let c = compare x y in
        if c = 0 then Add ((y,add u xs1 v yss1,yss2), vopt)
        else if c < 0 then
          let yss', vopt' = yss_vopt yss in
-         Add ((x,singleton xs1 v,yss'), vopt')
+         Add ((x,add u xs1 v empty,yss'), vopt')
        else
-         let yss2', vopt' = yss_vopt (add u xs v yss2) in
-         Add ((y,yss1,yss2'), add_vopt u vopt vopt')
-and add_vopt u vopt1 vopt2 =
-  match vopt1, vopt2 with
-  | None, _ -> vopt2
-  | _, None -> vopt1
-  | Some v1, Some v2 -> Some (u v1 v2)
-*)
+(*         let yss2', vopt' = yss_vopt (add xs v yss2) in*)
+         Add ((y,yss1,add u xs v yss2), vopt)
+and add_vopt u vopt v =
+  match vopt with
+  | None -> Some v
+  | Some v0 -> Some (u v0 v)
+
+let replace xs v yss = add (fun _ v -> v) xs v yss
 
 let rec find : ('a,'b) t -> 'a LSet.t -> 'b (* raise Not_found *) =
   fun yss xs ->
   | vopt1, None -> vopt1
   | Some v1, Some v2 -> Some (u v1 v2)
 
+(*
 let add : ('b -> 'b -> 'b) -> 'a LSet.t -> 'b -> ('a,'b) t -> ('a,'b) t =
   fun u xs v yss ->
     union u (singleton xs v) yss
+*)
 
 let rec subtract : ('b -> 'b -> 'b) -> ('a,'b) t -> ('a,'b) t -> ('a,'b) t =
   fun u yss1 yss2 ->
 and map_inter2 f u yss xs ys ys' =
   match xs, yss with
   | _, Empty vopt -> Empty (map_inter_vopt f vopt ys ys')
+(*
+  | [], Add ((_,_,_), Some v) ->
+      let vopt' = map_inter_vopt f (Some v) ys ys' in
+      Empty vopt'
+*)
   | [], Add ((y,yss1,yss2), vopt) ->
-     let yss1' = map_inter2 f u yss1 xs (ys@[y]) ys' in
-     let yss2' = map_inter2 f u yss2 xs ys ys' in
-     let vopt' = map_inter_vopt f vopt ys ys' in
-     union u (Empty vopt') (union u yss1' yss2')
+      let yss1' = map_inter2 f u yss1 xs (ys@[y]) ys' in
+      let yss2' = map_inter2 f u yss2 xs ys ys' in
+      let vopt' = map_inter_vopt f vopt ys ys' in
+      union u (Empty vopt') (union u yss1' yss2')
   | x::xs1, Add ((y,yss1,yss2), vopt) ->
      let c = compare x y in
      if c = 0 then