ocaml-lib / persintset.ml

Sébastien Ferré d3620a6 


Sébastien Ferré ab36342 





Sébastien Ferré d3620a6 

Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 
Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 






Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 











Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 



Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 




Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 

Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 

Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 


Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 
Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 



Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 






Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 





































































Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 



Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 




Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 



Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 

Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 


Sébastien Ferré ab36342 

Sébastien Ferré d3620a6 












Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 
















Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 



Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 





Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 



Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 




Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 


Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 





Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 






Sébastien Ferré ab36342 
Sébastien Ferré d3620a6 































open Persindex

module type PARAM =
  sig
    val chunk : int
  end

module DefaultParam : PARAM =
  struct
    let chunk = 1024
  end

module Make (Param : PARAM) (Intset2 : Intset.T) =
  struct
    let lazy_val = Lazy.lazy_from_val
    let force = Lazy.force

    module M (* : Intset.T with type t = (int * Intset2.t Lazy.t) list *) =
      struct
	type t = (int * Intset2.t Lazy.t) list
	      (* sorted in decreasing order of first part *)
	      (* the second part contains only integers x mod Param.chunk, s.t. x/Param.chunk = first part *)
	      (* trying to avoid empty intsets as second part *)
	      
	let empty = []
	    
	let is_empty e = e = []

	let cardinal e =
	  List.fold_left
	    (fun res (p,e2) -> res + Intset2.cardinal (force e2))
	    0 e

	let mem x =
	  let x1, x2 = x / Param.chunk, x mod Param.chunk in
	  let rec aux = function
	    | [] -> false
	    | (p,e2)::l ->
		if x1 < p then aux l
		else if x1 = p then Intset2.mem x2 (force e2)
		else (* x1 > p *) false
	  in
	  aux

	let singleton x =
	  let e2 = Intset2.singleton (x mod Param.chunk) in
	  [(x / Param.chunk, lazy_val e2)]

	let add x =
	  let x1, x2 = x / Param.chunk, x mod Param.chunk in
	  let rec aux pe =
	    match pe with
	    | [] -> [(x1,lazy_val (Intset2.singleton x2))]
	    | (pos,e2 as pe2)::l ->
		if x1 < pos then pe2 :: aux l
		else if x1 = pos then
		  (pos,lazy_val (Intset2.add x2 (force e2)))::l
		else (* x1 > pos *)
		  (x1,lazy_val (Intset2.singleton x2))::pe
	  in
	  aux
	    
	let remove x =
	  let x1, x2 = x / Param.chunk, x mod Param.chunk in
	  let rec aux pe =
	    match pe with
	    | [] -> []
	    | (pos,e2 as pe2)::l ->
		if x1 < pos then
		  pe2 :: aux l
		else if x1 = pos then
		  let new_e2 = Intset2.remove x2 (force e2) in
		  if Intset2.is_empty new_e2
		  then l
		  else (pos,lazy_val (new_e2))::l
		else (* x1 > pos *)
		  pe
	  in
	  aux
		    
	let rec subset e f =
	  match e, f with
	  | [], _ -> true
	  | _, [] -> false
	  | (pos,e2)::l, (pos',e2')::l' ->
	      if pos > pos' then
		if Intset2.is_empty (force e2)
		then subset l f
		else false
	      else if pos = pos' then
		Intset2.subset (force e2) (force e2')
	      else (* pos < pos' *)
		subset e l'

	let rec union e f =
	  match e, f with
	  | [], _ -> f
	  | _, [] -> e
	  | (pos,e2 as pe2)::l, (pos',e2' as pe2')::l' ->
	      if pos > pos' then pe2::union l f
	      else if pos = pos' then (pos,lazy_val (Intset2.union (force e2) (force e2')))::union l l'
	      else (* pos < pos' *) pe2'::union e l'

	let rec inter e f =
	  match e, f with
	  | [], _ -> []
	  | _, [] -> []
	  | (pos,e2)::l, (pos',e2')::l' ->
	      if pos > pos' then
		inter l f
	      else if pos = pos' then
		let inter_e2 = Intset2.inter (force e2) (force e2') in
		if Intset2.is_empty inter_e2
		then inter l l'
		else (pos,lazy_val inter_e2)::inter l l'
	      else (* pos < pos' *)
		inter e l'

	let rec diff e f =
	  match e, f with
	  | [], _ -> []
	  | _, [] -> e
	  | (pos,e2 as pe2)::l, (pos',e2')::l' ->
	      if pos > pos' then
		pe2::diff l f
	      else if pos = pos' then
		let new_e2 = Intset2.diff (force e2) (force e2') in
		if Intset2.is_empty new_e2
		then diff l l'
		else (pos,lazy_val new_e2)::diff l l'
	      else (* pos < pos' *)
		diff e l'

	let union_r le =
	  List.fold_left union empty le

	let inter_r = function
	  | [] -> invalid_arg "inter_r : empty list of sets"
	  | e::le -> List.fold_left inter e le

	let rec fold f acc = function
	  | [] -> acc
	  | (x1,e2)::l ->
	      fold f (Intset2.fold (fun acc2 x2 -> f acc2 (x1*Param.chunk + x2)) acc (force e2)) l

	let map f =
	  let rec aux acc = function
	    | [] -> acc
	    | (x1,e2)::l ->
		aux (Intset2.fold (fun res x2 -> f (x1*Param.chunk + x2) :: res) acc (force e2)) l
	  in
	  aux []

	let rec iter f = function
	  | [] -> ()
	  | (x1,e2)::l ->
	      Intset2.iter (fun x2 -> f (x1*Param.chunk + x2)) (force e2);
	      iter f l

	let rec filter f = function
	  | [] -> []
	  | (x1,e2)::l ->
	      let new_e2 = Intset2.filter (fun x2 -> f (x1*Param.chunk + x2)) (force e2) in
	      if Intset2.is_empty new_e2
	      then filter f l
	      else (x1,lazy_val new_e2)::filter f l

	let rec elements = function
	  | [] -> LSet.empty ()
	  | (x1,e2)::l ->
	      LSet.union (List.map (fun x2 -> x1*Param.chunk + x2) (Intset2.elements (force e2))) (elements l)

      end


    type extid = int

    type t = (int * extid) list

    let empty : t = []

    class c (name : string) (db : database) =
      object (self)
	val genid = new Genid.genid (name ^ ".genid") db
	val id2ext : (extid,Intset2.t) index = new varray_vector_opt 13 Param.chunk (fun id -> Intset2.empty) db

	initializer
	  id2ext # locate (name ^ "_extid") name "id2ext"

	method sync =
	  genid # sync;
	  id2ext # sync

	method unload (p : int) =
	  id2ext # unload p

	method is_empty : t -> bool =
	  fun e ->
	    e = []

	method mem : int -> t -> bool =
	  fun x ->
	    let x1, x2 = x / Param.chunk, x mod Param.chunk in
	    let rec aux = function
	      | [] -> false
	      | (p,id)::l ->
		  if x1 < p then aux l
		  else if x1 = p then Intset2.mem x2 (id2ext # get id)
		  else (* x1 > p *) false
	    in
	    aux

	method add : int -> t -> t =
	  fun x ->
	    let x1, x2 = x / Param.chunk, x mod Param.chunk in
	    let rec aux pe =
	      match pe with
	      | [] ->
		  let new_id = genid # alloc in
		  id2ext # set new_id (Intset2.singleton x2);
		  (x1,new_id)::[]
	      | (p,id as pid)::l ->
		  if x1 < p then
		    pid::aux l
		  else if x1 = p then begin 
		    id2ext # update id (Intset2.add x2);
		    pe end
		  else (* x1 > p *) begin
		    let new_id = genid # alloc in
		    id2ext # set new_id (Intset2.singleton x2);
		    (x1,new_id)::pe end
	    in
	    aux

	method remove : int -> t -> t =
	  fun x ->
	    let x1, x2 = x / Param.chunk, x mod Param.chunk in
	    let rec aux pe =
	      match pe with
	      | [] -> []
	      | (p,id as pid)::l ->
		  if x1 < p then
		    pid::aux l
		  else if x1 = p then
		    let ext = Intset2.remove x2 (id2ext # get id) in
		    if Intset2.is_empty ext
		    then begin id2ext # reset id; genid # free id; l end
		    else begin id2ext # set id ext; pe end
		  else (* x1 > p *)
		    pe
	    in
	    aux

	method inter : t -> M.t -> M.t =
	  let rec aux e f =
	    match e, f with
	    | [], _ -> []
	    | _, [] -> []
	    | (pos,id)::l, (pos',e2')::l' ->
		if pos > pos' then
		  aux l f
		else if pos = pos' then
		  let inter_e2 = Intset2.inter (id2ext # get id) (force e2') in
		  if Intset2.is_empty inter_e2
		  then aux l l'
		  else (pos,lazy_val inter_e2)::aux l l'
		else (* pos < pos' *)
		  aux e l'
	  in
	  aux


	method as_ext : t -> M.t =
	  List.map (fun (pos,id) -> (pos, lazy (id2ext # get id)))

      end

  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.