Source

ocaml-lib / intrel.ml

Diff from to

File intrel.ml

       val add : int * int -> t -> t
       val remove : int * int -> t -> t
       val domain : t -> R1.t
+      val domain_inter : R1.t -> t -> R1.t
       val range : t -> R1.t
+      val range_inter : R1.t -> t -> R1.t
       val forward : t -> R1.t -> R1.t
       val backward : t -> R1.t -> R1.t
-      val domain_inter : R1.t -> t -> t
-      val domain_diff : R1.t -> t -> t
-      val range_inter : R1.t -> t -> t
-      val range_diff : R1.t -> t -> t
+      val inter_domain : t -> R1.t -> t
+      val diff_domain : t -> R1.t -> t
+      val inter_range : t -> R1.t -> t
+      val diff_range : t -> R1.t -> t
       val union : t -> t -> t
       val inter : t -> t -> t
       val diff : t -> t -> t
       val fold : ('a -> int * int -> 'a) -> 'a -> t -> 'a
       val memory_size : t -> int
     end
+
+(*
+    module R : sig
+      type 'a t
+      val dim : 'a t -> int
+      val empty : 'a t
+      val cardinal : 'a t -> int
+      val mem : 'a -> 'a t -> bool
+      val add : 'a -> 'a t -> 'a t
+      val union : 'a t -> 'a t -> 'a t
+    end	
+*)
   end
 
 module Map : T =
 
 	let domain p = M.fold (fun x ran res -> R1.add x res) p R1.empty
 
+	let domain_inter a p = M.fold (fun x ran res -> if R1.mem x a then R1.add x res else res) p R1.empty
+
 	let range p = M.fold (fun x ran res -> R1.union ran res) p R1.empty
 
-	let domain_inter a p = M.fold (fun x ran res -> if R1.mem x a then M.add x ran res else res) p M.empty
+	let range_inter b p = M.fold (fun x ran res -> let ran' = R1.inter ran b in if R1.is_empty ran' then R1.union ran' res else res) p R1.empty
+
+	let inter_domain p a = M.fold (fun x ran res -> if R1.mem x a then M.add x ran res else res) p M.empty
 
-	let domain_diff a p = M.fold (fun x ran res -> if R1.mem x a then res else M.add x ran res) p M.empty
+	let diff_domain p a = M.fold (fun x ran res -> if R1.mem x a then res else M.add x ran res) p M.empty
 
-	let range_inter b p = M.fold (fun x ran res -> let ran' = R1.inter ran b in if R1.is_empty ran' then res else M.add x ran' res) p M.empty
+	let inter_range p b = M.fold (fun x ran res -> let ran' = R1.inter ran b in if R1.is_empty ran' then res else M.add x ran' res) p M.empty
 
-	let range_diff b p = M.fold (fun x ran res -> let ran' = R1.diff ran b in if R1.is_empty ran' then res else M.add x ran' res) p M.empty
+	let diff_range p b = M.fold (fun x ran res -> let ran' = R1.diff ran b in if R1.is_empty ran' then res else M.add x ran' res) p M.empty
 
 	let forward p a = M.fold (fun x ran res -> if R1.mem x a then R1.union ran res else res) p R1.empty
 
 
 	let domain p = M.domain p
 
+	let domain_inter a p = M.domain_inter a p
+
 	let range p = M.fold (fun res x ran -> R1.union res ran) R1.empty p
 
-	let domain_inter a p =
-	  M.map (fun x ran -> if R1.mem x a then Some ran else None) p
-	  (* M.map_inter (fun x _ ran -> Some ran) a p *)
+	let range_inter b p = M.fold (fun res x ran -> let ran' = R1.inter ran b in if R1.is_empty ran' then res else R1.union res ran') R1.empty p
+
+	let inter_domain p a =
+	  (* M.map (fun x ran -> if R1.mem x a then Some ran else None) p *)
+	  M.map_inter (fun x ran _ -> Some ran) p a
 
-	let domain_diff a p = M.map (fun x ran -> if R1.mem x a then None else Some ran) p
+	let diff_domain p a =
+	  (* M.map (fun x ran -> if R1.mem x a then None else Some ran) p *)
+	  M.map_diff (fun x ran -> function None -> Some ran | Some _ -> None) p a
 
-	let range_inter b p = M.map (fun x ran -> let ran' = R1.inter ran b in if R1.is_empty ran' then None else Some ran') p
+	let inter_range p b = M.map (fun x ran -> let ran' = R1.inter ran b in if R1.is_empty ran' then None else Some ran') p
 
-	let range_diff b p = M.map (fun x ran -> let ran' = R1.diff ran b in if R1.is_empty ran' then None else Some ran') p
+	let diff_range p b = M.map (fun x ran -> let ran' = R1.diff ran b in if R1.is_empty ran' then None else Some ran') p
 
-	let forward p a =
-	  M.fold (fun res x ran -> if R1.mem x a then R1.union res ran else res) R1.empty p
-	  (* range (M.map_inter (fun x ran _ -> Some ran) p a) *) (* M.map_inter looks buggy *)
-	  (* should be: M.fold_inter (fun res x ran _ -> R1.union res ran) R1.empty p a) *)
+	let forward p a = M.fold_inter (fun res x ran _ -> R1.union res ran) R1.empty p a
 
 	let backward p b = M.domain ~filter:(fun x ran -> let ran' = R1.inter ran b in not (R1.is_empty ran')) p
 
 
 	let memory_size p = M.memory_size ~f:R1.memory_size p
       end
+
   end
 
+
+
 module Test (X : T) =
   struct
     module R1 = X.R1