ocaml-lib / intrel2.ml

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
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.