Skip to content
This repository
tag: v285
Fetching contributors…

Cannot retrieve contributors at this time

file 104 lines (84 sloc) 2.831 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)

(* Note for hacker :
size is an indicator of how many elt are in the set.
it is just a hint, because inhabitants of a set may deleted by the GC.
it is used in union for optimization purpose.
*)
type ('a, 'b) t = { mutable link : ('a, 'b) node }

and ('a, 'b) immediate = { size : int ;
key : 'a ;
value : 'b }

and ('a, 'b) node = | Immediate of ('a, 'b) immediate
                    | Link of ('a, 'b) t

let make k v =
  { link = Immediate { size = 1 ; key = k ; value = v } }

let rec follow = function
  | { link = Immediate _ } as root ->
      root
        
  | { link = Link link } as child ->
      let root = follow link in
      begin
(* Collapsing rule *)
child.link <- Link root;
root
      end

let info x =
  match follow x with
  | { link = Immediate imm } as root ->
      root, imm.size, imm.key, imm.value
  | { link = Link _ } -> assert false

(* The fact to split find in 2 function in inefficent in case
of we need the 2 at the same time : factorization of lookup
(call to function info) and simplification of API *)

let find x =
  match follow x with
  | { link = Immediate imm } -> imm.key, imm.value
  | _ -> assert false

let key x =
  match follow x with
  | { link = Immediate imm } -> imm.key
  | _ -> assert false

let value x =
  match follow x with
  | { link = Immediate imm } -> imm.value
  | _ -> assert false


let union a b =
  let ca, sa, _, _ = info a
  and cb, sb, k, v = info b in
  (* Weighted Union rule *)
  let tall, low, low_o =
    (if sa > sb
     then ca, cb, b
     else cb, ca, a)
  in
  begin
    (* optimisation : origin of low can be collapsed there as well as low.link *)
    low_o.link <- Link tall ;
    low.link <- Link tall ;
    tall.link <- Immediate { size = sa + sb ; key = k ; value = v }
  end

let replace ~replaced ~keeped = union replaced keeped

let changeval x v =
  let root = follow x in
  match root.link with
  | Immediate imm -> root.link <- Immediate { imm with value = v }
  | Link _ -> assert false

(*
let refresh_singleton x k v =
match x.link with
| Link _ -> assert false
| Immediate _ ->
x.link <- Immediate {size = 1; key = k; value = v}
*)
Something went wrong with that request. Please try again.