Commits

Sébastien Ferré committed e256763

new [intrel2.ml] as specialization of [intreln] for binary relation

  • Participants
  • Parent commits 456ee21

Comments (0)

Files changed (2)

+
+module Intset = Intset.Intmap
+
+module type T =
+  sig
+    type t
+    val empty : t
+    val is_empty : t -> bool
+    val cardinal : t -> int
+    val mem : int -> int -> t -> bool
+    val singleton : int -> int -> t
+    val add : int -> int -> t -> t
+    val remove : int -> int -> t -> t
+    val union : t -> t -> t
+    val inter : t -> t -> t
+    val diff : t -> t -> t
+    val union_r : t list -> t
+    val inter_r : t list -> t
+    val fold : ('a -> int -> int -> 'a) -> 'a -> t -> 'a
+(*
+    val fold_mu : (string * int) list -> string list -> ('a -> (string * int) list -> 'a) -> 'a -> t -> 'a
+    val fold_restr : (string * int) list -> string list -> ('a -> (string * int) list -> 'a) -> 'a -> t -> 'a
+    val filter_restr : (string * int) list -> string list -> ((string * int) list -> bool) -> t -> t
+*)
+    val iter : (int -> int -> unit) -> t -> unit
+
+    (* functions for accessing a relation as an association/map *)
+    val mem_assoc : int -> t -> bool
+    val assoc : int -> t -> Intset.t
+    val keys : t -> Intset.t
+    val fold_assoc : ('a -> int -> Intset.t -> 'a) -> 'a -> t -> 'a
+
+    val memory_size : t -> int
+  end
+
+
+module Intmap : T =
+  struct
+    module Intmap = Intmap.M
+
+    type t = Intset.t Intmap.t
+
+    let empty = Intmap.empty
+
+    let is_empty r = Intmap.is_empty r
+
+    let cardinal r = Common.prof "Intrel2.cardinal" (fun () ->
+      Intmap.fold
+	(fun acc x oids -> acc + Intset.cardinal oids)
+	0 r)
+
+    let mem x y r = Common.prof "Intrel2.mem" (fun () ->
+      try Intset.mem y (Intmap.get x r)
+      with _ -> false)
+
+    let singleton x y = Common.prof "Intrel2.singleton" (fun () ->
+      Intmap.set x (Intset.singleton y) Intmap.empty)
+
+    let add x y r = Common.prof "Intrel2.add" (fun () ->
+      try
+	let oids = Intmap.get x r in
+	Intmap.set x (Intset.add y oids) r
+      with Not_found ->
+	Intmap.set x (Intset.singleton y) r)
+
+    let remove x y r = Common.prof "Intrel2.remove" (fun () ->
+      try
+	let oids = Intmap.get x r in
+	let oids' = Intset.remove y oids in
+	if Intset.is_empty oids'
+	then Intmap.remove x r
+	else Intmap.set x oids' r
+      with _ -> r)
+
+    let union r1 r2 = Common.prof "Intrel2.union" (fun () ->
+      Intmap.map_union
+	(fun x oids1_opt oids2_opt ->
+	  match oids1_opt, oids2_opt with
+	  | None, None -> None
+	  | None, Some _ -> oids2_opt
+	  | Some _, None -> oids1_opt
+	  | Some oids1, Some oids2 -> Some (Intset.union oids1 oids2))
+	r1 r2)
+
+    let inter r1 r2 = Common.prof "Intrel2.inter" (fun () ->
+      Intmap.map_inter
+	(fun x oids1 oids2 ->
+	  let oids = Intset.inter oids1 oids2 in
+	  if Intset.is_empty oids
+	  then None
+	  else Some oids)
+	r1 r2)
+
+    let diff r1 r2 = Common.prof "Intrel2.diff" (fun () ->
+      Intmap.map_diff
+	(fun x oids1 oids2_opt ->
+	  match oids2_opt with
+	  | None -> Some oids1
+	  | Some oids2 ->
+	      let oids = Intset.diff oids1 oids2 in
+	      if Intset.is_empty oids
+	      then None
+	      else Some oids)
+	r1 r2)
+
+    let union_r = function
+      | [] -> invalid_arg "Intreln.Intmap.union_r: empty list of relations"
+      | r::rs -> List.fold_left union r rs
+
+    let inter_r = function
+      | [] -> invalid_arg "Intreln.Intmap.inter_r : empty list of relations"
+      | r::rs -> List.fold_left inter r rs
+
+    let fold f init r = Common.prof "Intrel2.fold" (fun () ->
+      Intmap.fold
+	(fun acc x oids ->
+	  Intset.fold
+	    (fun acc y ->
+	      f acc x y)
+	    acc oids)
+	init r)
+
+    let iter f r = Common.prof "Intrel2.iter" (fun () ->
+      Intmap.iter
+	(fun x oids ->
+	  Intset.iter
+	    (fun y -> f x y)
+	    oids)
+	r)
+	
+    let mem_assoc x r = Common.prof "Intrel2.mem_assoc" (fun () ->
+      Intmap.mem x r)
+
+    let assoc x r = Common.prof "Intrel2.assoc" (fun () ->
+      Intmap.get x r)
+
+    let keys r = Common.prof "Intrel2.keys" (fun () ->
+      Intmap.domain r)
+
+    let fold_assoc f init r = Common.prof "Intrel2.fold_assoc" (fun () ->
+      Intmap.fold f init r)
+
+    let memory_size r =
+      Intmap.memory_size ~f:Intset.memory_size r
+
+  end
 .SUFFIXES: .mll .ml .mli .cmo .cmi
 
 # Make all
-all: common.cmo threads_common.cmo unicode.cmo tokens.cmo lexer.cmo syntax.cmo bintree.cmo lSet.cmo cis.cmi cis.cmo iterator.cmo intmap.cmo intset.cmo intrel.cmo intreln.cmo text_index.cmo setset.cmo term.cmo cache.cmi cache.cmo ext.cmo suffix_tree.cmo index.cmo seq.cmo logdag.cmi logdag.cmo persindex.cmo genid.cmo persintset.cmo persintset.cmo stringset.cmo seqset.cmo
+all: common.cmo threads_common.cmo unicode.cmo tokens.cmo lexer.cmo syntax.cmo bintree.cmo lSet.cmo cis.cmi cis.cmo iterator.cmo intmap.cmo intset.cmo intrel.cmo intrel2.cmo intreln.cmo text_index.cmo setset.cmo term.cmo cache.cmi cache.cmo ext.cmo suffix_tree.cmo index.cmo seq.cmo logdag.cmi logdag.cmo persindex.cmo genid.cmo persintset.cmo persintset.cmo stringset.cmo seqset.cmo
 	echo
 
 # archiving