ktrees

benchmark/make.sh

@@ -1064,9 +1064,10 @@ run_get () {
     -n $TWO_EXP_15,$TWO_EXP_18,$TWO_EXP_20,$TWO_EXP_24,$TWO_EXP_26 \
     -ops 100$K \
     -distance -1 \
+    -runs 3 \
     -output $result"
   ${CMD} -seq BraunTree
-  ${CMD} --append -seq ParrayNarytree -k 8,16,32
+  ${CMD} --append -seq Ktree -k 8,16,32
 }
 #     -runs 3 \
 
@@ -1106,8 +1107,8 @@ run_get_effects () {
     -distance -1 \
     -output $result"
   ${CMD} -seq BraunTree
-  ${CMD} --append -seq ParrayNarytree -k 16
-  ${CMD} --append -seq PdarrayNarytree -k 64,128
+  ${CMD} --append -seq Ktree -k 16
+  ${CMD} --append -seq Ktree_effects -k 64,128
 }
 
 plot_get_effects () {
@@ -1126,28 +1127,38 @@ plot_get_effects () {
   save_rfile $graphics
 }
 
+#  -runs 3 \
+
 # ------------------
 
-run_set_effects () {
+run_set () {
   benchmark=set
   make src/$benchmark
   run_prologue
-  result="set_effects.out"
+  result="set.out"
   CMD="prun -prog $prog \
     -n $TWO_EXP_15,$TWO_EXP_18,$TWO_EXP_20,$TWO_EXP_24,$TWO_EXP_26 \
     -ops 100$K \
+    -runs 3 \
     -distance -1 \
     -output $result"
   ${CMD} -seq BraunTree
-  ${CMD} --append -seq ParrayNarytree -k 16
-  ${CMD} --append -seq PdarrayNarytree -k 64,128
+  ${CMD} --append -seq Ktree -k 8,16,32
 }
 
-plot_set_effects () {
+#    -runs 3 \
+# -quota 0.05 \
+# Array,Vector,
+# ESek_get,PSek_get,PSek_reach,FmlibRbtrees,NumeriChunk,
+  # ,$TWO_EXP_22,$TWO_EXP_24,$TWO_EXP_18,$TWO_EXP_10,$TWO_EXP_15,, \
+  # 16,32,64,256, \
+     # $TWO_EXP_5,$TWO_EXP_10,
+
+plot_set () {
   #result="$1"
   # graphics="$2"
-  result="set_effects.out"
-  graphics="set_effects.pdf"
+  result="set.out"
+  graphics="set.pdf"
   series="$3"
   echo $graphics > $home/.graphics
   pplot scatter \
@@ -1159,35 +1170,28 @@ plot_set_effects () {
   save_rfile $graphics
 }
 
-
 # ------------------
 
-run_set () {
+run_set_effects () {
   benchmark=set
   make src/$benchmark
   run_prologue
-  result="set.out"
+  result="set_effects.out"
   CMD="prun -prog $prog \
     -n $TWO_EXP_15,$TWO_EXP_18,$TWO_EXP_20,$TWO_EXP_24,$TWO_EXP_26 \
     -ops 100$K \
     -distance -1 \
     -output $result"
   ${CMD} -seq BraunTree
-  ${CMD} --append -seq ParrayNarytree -k 8,16,32
+  ${CMD} --append -seq Ktree -k 16
+  ${CMD} --append -seq Ktree_effects -k 64,128
 }
-#    -runs 3 \
-# -quota 0.05 \
-# Array,Vector,
-# ESek_get,PSek_get,PSek_reach,FmlibRbtrees,NumeriChunk,
-  # ,$TWO_EXP_22,$TWO_EXP_24,$TWO_EXP_18,$TWO_EXP_10,$TWO_EXP_15,, \
-  # 16,32,64,256, \
-     # $TWO_EXP_5,$TWO_EXP_10,
 
-plot_set () {
+plot_set_effects () {
   #result="$1"
   # graphics="$2"
-  result="set.out"
-  graphics="set.pdf"
+  result="set_effects.out"
+  graphics="set_effects.pdf"
   series="$3"
   echo $graphics > $home/.graphics
   pplot scatter \
@@ -1199,6 +1203,7 @@ plot_set () {
   save_rfile $graphics
 }
 
+
 # ------------------
 
 run_getk () {
@@ -1210,8 +1215,9 @@ run_getk () {
     -n $TWO_EXP_24 \
     -ops 100$K \
     -distance -1 \
+    -runs 3 \
     -output $result"
-  ${CMD} -seq $2 -k 4,8,16,32,64,128,256,512,1024,2048
+  ${CMD} -seq $2 -k 4,8,16,32,64,128,256,512,1024
   # ,PdarrayNarytree
   # -quota 0.05 \
 }
@@ -1255,7 +1261,7 @@ run_setk () {
     -quota 0.05 \
     -distance -1 \
     -output $result"
-  ${CMD} -seq $2 -k 4,8,16,32,64,128,256,512,1024,2048
+  ${CMD} -seq $2 -k 4,8,16,32,64,128,256,512,1024
 }
 
 run_setks () {

benchmark/src/get/Main.ml

@@ -187,6 +187,32 @@ let benchmark =
         done;
         sink !r
 
+   end else if seq = "Ktree" then begin
+
+      let s = ref (Ktree.init ~base n (fun i -> i)) in
+      fun () ->
+        (* This is the timed section. *)
+        let r = ref 0 in
+        (* Calls to [replace i] for each target index. *)
+        for index = 0 to ops - 1 do
+          let j = a.(index) in
+          r := !r + Ktree.get !s j;
+        done;
+        sink !r
+
+   end else if seq = "KtreeEffects" then begin
+
+      let s = ref (Ktree_effects.init ~base n (fun i -> i)) in
+      fun () ->
+        (* This is the timed section. *)
+        let r = ref 0 in
+        (* Calls to [replace i] for each target index. *)
+        for index = 0 to ops - 1 do
+          let j = a.(index) in
+          r := !r + Ktree_effects.get !s j;
+        done;
+        sink !r
+
    end else if seq = "ParrayNarytree" then begin
 
       let s = ref (Parray_narytree.init ~base n (fun i -> i)) in

benchmark/src/ktree.ml

+
+let array_set (t: 'a array) (i: int) (v: 'a) : 'a array =
+  let u = Array.copy t in
+  u.(i) <- v;
+  u
+
+(*****************************************************************)
+
 (** This data structure represents a tree of arity [2^base].
     Each node is represented as an array of elements or as an array of subtrees. *)
 
@@ -23,6 +31,8 @@ let default_base = 8 (* chunk of size 256 *)
 
 (*****************************************************************)
 
+(* TODO : try another strategy for init *)
+
 let init1 base offset f =
    Array.init (1 lsl base) (fun i -> f (i+offset))
 
@@ -86,7 +96,7 @@ let init ?(base:int = default_base) (n:int) (f: int -> 'a) : 'a tree =
 
 (*****************************************************************)
 
-let get1 base s i =
+let get1 _base s i =
   Array.get s i
 
 let get2 base s i =
@@ -170,12 +180,7 @@ let get s i =
 
 (*****************************************************************)
 
-let array_set (t: 'a array) (i: int) (v: 'a) : 'a array =
-  let u = Array.copy t in
-  u.(i) <- v;
-  u
-
-let set1 base s i v =
+let set1 _base s i v =
   array_set s i v
 
 let set2 base s i v =
@@ -267,8 +272,6 @@ let set s i v =
 
 
 
-
-
 (*****************************************************************)
 
 let iter1 f s =
@@ -282,13 +285,14 @@ let iter3 f s =
 
 let iter f s =
   match s with
-  | Tree1 (base, t) -> iter1 f t
-  | Tree2 (base, t) -> iter2 f t
-  | Tree3 (base, t) -> iter3 f t
-  | _ -> failwith "unsupported"
+  | Tree1 (_base, t) -> iter1 f t
+  | Tree2 (_base, t) -> iter2 f t
+  | Tree3 (_base, t) -> iter3 f t
+  | _ -> failwith "unsupported" (* TODO *)
 
 
 (*****************************************************************)
+(*
 
 module Test = struct
 
@@ -316,7 +320,6 @@ let _test =
   pr "\n";
 
 end
-(*
 *)
 
 (* Test using:

benchmark/src/ktree_effects.ml

+(* COPY of ktree.ml with replacement of Array with Darray. *)
+
+type 'a darray = 'a Darray.t
+
+let darray_set = Darray.set
+
+(*--------------*)
+
+(** This data structure represents a tree of arity [2^base].
+    Each node is represented as an array of elements or as an array of subtrees. *)
+
+(* Store depth in the constructor,
+   store base in the first argument
+   (could store the length there, too *)
+
+type 'a tree =
+  | Tree1 of int * 'a darray
+  | Tree2 of int * 'a darray darray
+  | Tree3 of int * 'a darray darray darray
+  | Tree4 of int * 'a darray darray darray darray
+  | Tree5 of int * 'a darray darray darray darray darray
+  | Tree6 of int * 'a darray darray darray darray darray darray
+  | Tree7 of int * 'a darray darray darray darray darray darray darray
+  | Tree8 of int * 'a darray darray darray darray darray darray darray darray
+  | Tree9 of int * 'a darray darray darray darray darray darray darray darray darray
+  | Tree10 of int * 'a darray darray darray darray darray darray darray darray darray darray
+
+(* maximum length or the array for this implementation : base^10 *)
+
+let default_base = 8 (* chunk of size 256 *)
+
+(*****************************************************************)
+
+(* TODO : try another strategy for init *)
+
+let init1 base offset f =
+  Darray.init (1 lsl base) (fun i -> f (i+offset))
+
+let init2 base offset f =
+  Darray.init (1 lsl base) (fun i -> init1 base (offset+(i lsl (1*base))) f)
+
+let init3 base offset f =
+  Darray.init (1 lsl base) (fun i -> init2 base (offset+(i lsl (2*base))) f)
+
+let init4 base offset f =
+  Darray.init (1 lsl base) (fun i -> init3 base (offset+(i lsl (3*base))) f)
+
+let init5 base offset f =
+  Darray.init (1 lsl base) (fun i -> init4 base (offset+(i lsl (4*base))) f)
+
+let init6 base offset f =
+  Darray.init (1 lsl base) (fun i -> init5 base (offset+(i lsl (5*base))) f)
+
+let init7 base offset f =
+  Darray.init (1 lsl base) (fun i -> init6 base (offset+(i lsl (6*base))) f)
+
+let init8 base offset f =
+  Darray.init (1 lsl base) (fun i -> init7 base (offset+(i lsl (7*base))) f)
+
+let init9 base offset f =
+  Darray.init (1 lsl base) (fun i -> init8 base (offset+(i lsl (8*base))) f)
+
+let init10 base offset f =
+  Darray.init (1 lsl base) (fun i -> init9 base (offset+(i lsl (9*base))) f)
+
+
+(** [init ?base n f] return a sequence of length [n], with [f i] as [i]-th element.
+    The optional argument [base] can be used to specify that arrays used to
+    represent every node in the tree should have length [2^base].
+    Typically, [base] should be a value between [3] and [16]. *)
+
+let init ?(base:int = default_base) (n:int) (f: int -> 'a) : 'a tree =
+  if n <= (1 lsl (1*base)) then
+    Tree1 (base, init1 base 0 f)
+  else if n <= (1 lsl (2*base)) then
+    Tree2 (base, init2 base 0 f)
+  else if n <= (1 lsl (3*base)) then
+    Tree3 (base, init3 base 0 f)
+  else if n <= (1 lsl (4*base)) then
+    Tree4 (base, init4 base 0 f)
+  else if n <= (1 lsl (5*base)) then
+    Tree5 (base, init5 base 0 f)
+  else if n <= (1 lsl (6*base)) then
+    Tree6 (base, init6 base 0 f)
+  else if n <= (1 lsl (7*base)) then
+    Tree7 (base, init7 base 0 f)
+  else if n <= (1 lsl (8*base)) then
+    Tree8 (base, init8 base 0 f)
+  else if n <= (1 lsl (9*base)) then
+    Tree9 (base, init9 base 0 f)
+  else if n <= (1 lsl (10*base)) then
+    Tree10 (base, init10 base 0 f)
+  else
+    failwith "init: length too large for this base"
+
+
+(*****************************************************************)
+
+let get1 _base s i =
+  Darray.get s i
+
+let get2 base s i =
+  let w = 1*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get1 base t j
+
+let get3 base s i =
+  let w = 2*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get2 base t j
+
+let get4 base s i =
+  let w = 3*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get3 base t j
+
+let get5 base s i =
+  let w = 4*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get4 base t j
+
+let get6 base s i =
+  let w = 5*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get5 base t j
+
+let get7 base s i =
+  let w = 6*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get6 base t j
+
+let get8 base s i =
+  let w = 7*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get7 base t j
+
+let get9 base s i =
+  let w = 8*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get8 base t j
+
+let get10 base s i =
+  let w = 9*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  get9 base t j
+
+(** [get s i] returns the element at index [i].
+    Requires [0 <= i < length t]. *)
+let get s i =
+  match s with
+  | Tree1 (base, t) -> get1 base t i
+  | Tree2 (base, t) -> get2 base t i
+  | Tree3 (base, t) -> get3 base t i
+  | Tree4 (base, t) -> get4 base t i
+  | Tree5 (base, t) -> get5 base t i
+  | Tree6 (base, t) -> get6 base t i
+  | Tree7 (base, t) -> get7 base t i
+  | Tree8 (base, t) -> get8 base t i
+  | Tree9 (base, t) -> get9 base t i
+  | Tree10 (base, t) -> get10 base t i
+
+
+(*****************************************************************)
+
+let set1 _base s i v =
+  darray_set s i v
+
+let set2 base s i v =
+  let w = 1*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set1 base t j v in
+  darray_set s id u
+
+let set3 base s i v =
+  let w = 2*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set2 base t j v in
+  darray_set s id u
+
+let set4 base s i v =
+  let w = 3*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set3 base t j v in
+  darray_set s id u
+
+let set5 base s i v =
+  let w = 4*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set4 base t j v in
+  darray_set s id u
+
+let set6 base s i v =
+  let w = 5*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set5 base t j v in
+  darray_set s id u
+
+let set7 base s i v =
+  let w = 6*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set6 base t j v in
+  darray_set s id u
+
+let set8 base s i v =
+  let w = 7*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set7 base t j v in
+  darray_set s id u
+
+let set9 base s i v =
+  let w = 8*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set8 base t j v in
+  darray_set s id u
+
+let set10 base s i v =
+  let w = 9*base in
+  let id = i lsr w in
+  let j = i - id * (1 lsl w) in
+  let t = Darray.get s id in
+  let u = set9 base t j v in
+  darray_set s id u
+
+(** [set s i v] updates the element at index [i] with [v].
+    Requires [0 <= i < length t]. *)
+let set s i v =
+  match s with
+  | Tree1 (base, t) -> Tree1 (base, set1 base t i v)
+  | Tree2 (base, t) -> Tree2 (base, set2 base t i v)
+  | Tree3 (base, t) -> Tree3 (base, set3 base t i v)
+  | Tree4 (base, t) -> Tree4 (base, set4 base t i v)
+  | Tree5 (base, t) -> Tree5 (base, set5 base t i v)
+  | Tree6 (base, t) -> Tree6 (base, set6 base t i v)
+  | Tree7 (base, t) -> Tree7 (base, set7 base t i v)
+  | Tree8 (base, t) -> Tree8 (base, set8 base t i v)
+  | Tree9 (base, t) -> Tree9 (base, set9 base t i v)
+  | Tree10 (base, t) -> Tree10 (base, set10 base t i v)
+
+
+
+(*****************************************************************)
+
+let iter1 f s =
+  Darray.iter f s
+
+let iter2 f s =
+  Darray.iter (fun t -> iter1 f t) s
+
+let iter3 f s =
+  Darray.iter (fun t -> iter2 f t) s
+
+let iter f s =
+  match s with
+  | Tree1 (_base, t) -> iter1 f t
+  | Tree2 (_base, t) -> iter2 f t
+  | Tree3 (_base, t) -> iter3 f t
+  | _ -> failwith "unsupported" (* TODO *)
+
+
+(*****************************************************************)
+(*
+
+module Test = struct
+
+let _test =
+  let pr = Printf.printf in
+
+  let base = 2 in (* chunks of size 4 *)
+  let n = 64 in
+
+  let t = init ~base n (fun i -> i) in
+
+  iter (fun x -> pr " %d" x) t;
+  pr "\n";
+
+  for i = 0 to n-1 do
+    pr "%d " (get t i);
+  done;
+  pr "\n";
+
+  let u = ref t in
+  for i = 0 to n-1 do
+    u := set !u i (n-1-i);
+  done;
+  iter (fun x -> pr " %d" x) !u;
+  pr "\n";
+
+end
+*)
+
+(* Test using:
+ocamlc ktree.ml && ./a.out
+*)
+

benchmark/src/parray.ml

+(* A darray is a structure that represents persistent arrays as nodes,
+   which may be:
+   - either an ephemeral array
+   - or a diff on another node, describing the update of one cell.
+
+   Compared with semi-persistent arrays by Filliâtre and Conchon,
+   there are two new features:
+   - first, we bound the length of the chains to a constant,
+     defined to be N where N denotes the length of the array; (could be N/2 or anything else)
+     this is achieved by keeping in each node the maximum length
+     of a chain of diff that points to that node.
+   - second, if we have already flipped a chain of diff, then
+     we don't flip it a second time; instead, we introduce a
+     fresh ephemeral array.
+
+   Invariants:
+   - from a non-flipped diff, we eventually reach an array,
+     without ever traversing a flipped diff
+   - from a flipped diff, we may reach non-flipped diff, or an array
+   - there is a most one chain of non-flipped diff reaching a given array
+   - no chain every exceeds the maximum distance N
+   - nodes that are flipped diff are never modified
+*)
+
+(* Naive representation:
+
+type 'a t = {
+  mutable desc : 'a desc;
+  mutable dist : int; }
+
+and 'a desc =
+  | Pchunk_repr of 'a array
+  | PChunk_diff of 'a t * int * 'a
+
+*)
+
+(* Optimized representation, saving one indirection *)
+
+let cast = Obj.magic
+
+let index_repr = max_int
+
+let value_none : 'a = cast ()
+
+let _fresh_name = (* debug *)
+  let r = ref (-1) in
+  (fun () -> incr r; !r)
+
+type 'a t = {
+  mutable dist : int; (* bound on the length of a chain of diffs leading to this object *)
+  mutable index : int;  (* index of the update for a diff,
+                           or -index for an update whose chained has already been flipped,
+                           or [index_repr] if it is a repr *)
+  mutable value : 'a;  (* value of the update for a diff, or [value_none] if [index = -1] *)
+  mutable base : 'a array;  (* if [index = -1], it is a value of type ['a array] with the data;
+                               else it is a value of type ['a t] denoting the parent object *)
+ (* name : int; --debug *) }
+
+
+let nodes : int t list ref = ref [] (* debug *)
+
+let _register (type a) (t : a t) : a t = (* debug *)
+  nodes := (cast t) :: !nodes;
+  t
+
+let is_repr (t : 'a t) : bool =
+  t.index = index_repr
+
+let is_flipped_diff (t : 'a t) : bool =
+  t.index < 0
+
+let get_repr (t : 'a t) : 'a array =
+  assert (t.index = index_repr);
+  t.base
+
+let get_dist (t : 'a t) : int =
+  t.dist
+
+let get_parent (t : 'a t) : 'a t =
+  (* assert (t.index <> index_repr); *)
+  cast t.base
+
+let get_index_nonflipped (t : 'a t) : int =
+  (* assert (t.index <> index_repr && not (is_flipped_diff t)); *)
+  t.index
+
+let get_index (t : 'a t) : int =
+  (* assert (t.index <> index_repr); *)
+  abs t.index
+
+let get_value (t : 'a t) : 'a =
+  (* assert (t.index <> index_repr && value != value_none); *)
+  t.value
+
+let to_repr (t : 'a t) (dist : int) (a : 'a array) : unit =
+  t.dist <- dist;
+  t.index <- index_repr;
+  t.value <- value_none;
+  t.base <- a
+
+let to_diff (t : 'a t) ~(flipped:bool) (dist : int) (index : int) (value : 'a) (parent : 'a t) : unit =
+  t.dist <- dist;
+  t.index <- if flipped then -index else index;
+  t.value <- value;
+  t.base <- cast parent
+
+let mk_repr (type a) (dist : int) (a : a array) : a t =
+  (*_register*) {
+    dist = dist;
+    index = index_repr;
+    base = cast a;
+    value = cast value_none;
+    (*name = _fresh_name()*) }
+
+(** Parameters *)
+
+let dist_max (t : 'a t) : int =
+  (* assert (is_repr t); *)
+  Array.length (get_repr t) / 2
+  (* could be any constant *)
+
+
+(** Private Operations *)
+
+(* [get_fresh_array t] returns the array representation of [t], as a fresh array *)
+let rec get_fresh_array (t : 'a t) : 'a array =
+  if is_repr t then begin
+    Array.copy (get_repr t)
+  end else begin
+    let p = get_parent t in
+    let i = get_index t in
+    let v = get_value t in
+    let new_a = get_fresh_array p in
+    new_a.(i) <- v;
+    new_a
+  end
+
+(* [copy t] builds a representation of [t] totally independent from its input;
+   this function does not modify any existing chain *)
+let copy (t : 'a t) : 'a t =
+  let new_a = get_fresh_array t in
+  mk_repr 0 new_a
+
+(* [set_with_copy t i v] performs an update by working on a totally independent copy;
+   this function does not modify any existing chain *)
+let set_with_copy (t : 'a t) (i : int) (v : 'a) : 'a t =
+  let new_t = copy t in
+  (get_repr new_t).(i) <- v;
+  new_t
+
+(* [flip_chain new_parent t index value] flips a chain of nonflipped diffs;
+   it returns the array representation for the argument [parent],
+   obtained after applying the diffs, and it returns the length
+   of the chain that has been traversed. *)
+let rec flip_chain (new_parent : 'a t) (t : 'a t) (index : int) (value : 'a) : 'a array * int =
+  assert (not (is_flipped_diff t));
+  let a, d =
+    if is_repr t then begin
+      get_repr t, 0
+    end else begin
+      let p = get_parent t in
+      let i = get_index_nonflipped t in
+      let v = get_value t in
+      flip_chain t p i v
+    end in
+  to_diff t ~flipped:true d index a.(index) new_parent;
+  a.(index) <- value;
+  a, d+1
+
+(* [ensure_repr t] ensures that [t] becomes a "repr", either by flipping diffs,
+   or by creating an independent copy in case diffs are already flipped. *)
+let ensure_repr (t : 'a t) : unit =
+  if is_repr t then ()
+  else if is_flipped_diff t then begin
+    let new_a = get_fresh_array t in
+    to_repr t 0 new_a
+  end else begin
+    assert (not (is_flipped_diff t));
+    let d_old = get_dist t in
+    let p = get_parent t in
+    let i = get_index_nonflipped t in
+    let v = get_value t in
+    let a, d_flipped = flip_chain t p i v in
+    let d = max d_old d_flipped in
+    to_repr t d a
+  end
+
+(** Public Operations *)
+
+let length (t : 'a t) : int =
+  ensure_repr t;
+  Array.length (get_repr t)
+
+let get (t : 'a t) (i : int) : 'a =
+  ensure_repr t;
+  (get_repr t).(i)
+
+let set (t : 'a t) (i : int) (v : 'a) : 'a t =
+  if is_flipped_diff t then begin
+    (* this branch is just an optimization *)
+    set_with_copy t i v (* effectless recursive traversal *)
+  end else begin
+    ensure_repr t;
+    let d = t.dist in
+    if d < dist_max t then begin
+      let a = get_repr t in
+      let old_v = a.(i) in
+      a.(i) <- v;
+      let new_t = mk_repr (d+1) a in
+      to_diff t ~flipped:false d i old_v new_t;
+      new_t
+    end else begin
+      set_with_copy t i v  (* no recursive traversal, because [t] has already been made a repr *)
+    end
+  end
+
+let init (n : int) (f : int -> 'a) : 'a t =
+  let a = Array.init n f in
+  mk_repr 0 a
+
+let iter (f : 'a -> unit) (t : 'a t) : unit =
+  ensure_repr t;
+  Array.iter f (get_repr t)
+
+let of_array_with_transfer (a : 'a array) : 'a t =
+  mk_repr 0 a
+
+let to_array_with_transfer (t : 'a t) : 'a array =
+  if is_repr t
+    then get_repr t
+    else get_fresh_array t
+
+
+(*------------------------------------------
+
+let measure_time (f : unit -> 'a) : 'a * int =
+  let t0 = Unix.gettimeofday () in
+  let res = f() in
+  let t1 = Unix.gettimeofday () in
+  let millis = int_of_float (1000. *. (t1 -. t0)) in
+  res, millis
+
+let report_time (f : unit -> unit) : unit =
+  let _res, millis = measure_time f in
+  Printf.printf "%d ms\n" millis
+
+let _testperf =
+  (*Gc.set { (Gc.get()) with Gc.minor_heap_size = (262000) };*)
+
+  let nb = 330 in (* 10x slowdown when exit minor heap at 250 *)
+  let repeat = 100000 in
+  report_time (fun () ->
+    let r = ref (Array.init nb (fun i -> i)) in
+    for i = 1 to repeat do
+      r := Fmarray.replace (i mod nb) i !r;
+    done;
+  );
+  report_time (fun () ->
+    let r = ref (init nb (fun i -> i)) in
+    for i = 1 to repeat do
+      r := set !r (i mod nb) i;
+    done;
+  )
+*)
+
+(*------------------------------------------*)
+(*
+module Test = struct
+
+let _test  =
+  let pr = Printf.printf in
+
+  let print_array a =
+    pr "[";
+    Array.iter (fun x -> pr "%d; " x) a;
+    pr "]\n";
+    in
+
+  let print_node t =
+    pr "Node %d (dist %d) = " (t.name) (get_dist t);
+    if is_repr t then begin
+      pr "Repr ";
+      print_array (get_repr t)
+    end else begin
+      let p = get_parent t in
+      let i = get_index_nonflipped t in
+      let v = get_value t in
+      pr "Node(%d)[%d := %d] --> " p.name i v;
+      print_array (get_fresh_array t)
+    end in
+
+  let p () =
+    pr "-------------------\n";
+    List.iter print_node (List.rev !nodes) in
+
+  (*
+    for this test, use
+    let dist_max (t : 'a t) : int = Array.length (get_repr t) - 1
+
+  let n = 4 in
+  let t0 = init n (fun i -> i) in (* [0;1;2;3] *)
+  assert (get t0 2 = 2);
+  p();
+  let t1 = set t0 0 4 in  (* [4;1;2;3] chain *)
+  p();
+  let t2 = set t1 1 5 in  (* [4;5;2;3] chain *)
+  p();
+  let t3 = set t2 2 6 in  (* [4;5;6;3] chain *)
+  p();
+  let t4 = set t3 3 8 in  (* [4;5;6;8] indep *)
+  p();
+  let t5 = set t1 3 7 in  (* [4;1;2;7] flip *)
+  p();
+  let t6 = set t5 0 8 in  (* [8;1;2;7] chain *)
+  p();
+  let t7 = set t2 1 9 in  (* [4;9;2;3] indep *)
+  p();
+  let t8 = set t0 2 0 in  (* [0;1;0;3] flip *)
+  p();
+  *)
+
+  let n = 30 in
+  let r = ref (init n (fun i -> i)) in
+  for i = 0 to n-1 do
+    r := set !r i (-i);
+    p();
+  done
+
+
+end
+*)
+
+(* alternative:
+module type NullSig = sig val null : 'a end
+module NullImpl : NullSig = struct let null = cast () end
+let value_none : 'a = NullImpl.null
+*)
+
+
+(* DEPRECATED
+let mk_diff (dist : int) (index : int) (value : 'a) (parent : 'a t) : 'a t =
+  register {
+    dist = dist;
+    index = index; (* never flipped when created *)
+    base = cast parent;
+    value = value;
+    name = fresh_name() }
+
+*)

benchmark/src/set/Main.ml

@@ -166,6 +166,30 @@ let benchmark =
           Numerichunk.set s j value;
         done
 
+   end else if seq = "Ktree" then begin
+
+      let s = ref (Ktree.init ~base n (fun i -> i)) in
+      fun () ->
+        (* This is the timed section. *)
+        (* Calls to [replace i] for each target index. *)
+        for index = 0 to ops - 1 do
+          let j = a.(index) in
+          let value = index in
+          s := Ktree.set !s j value;
+        done
+
+   end else if seq = "KtreeEffects" then begin
+
+      let s = ref (Ktree_effects.init ~base n (fun i -> i)) in
+      fun () ->
+        (* This is the timed section. *)
+        (* Calls to [replace i] for each target index. *)
+        for index = 0 to ops - 1 do
+          let j = a.(index) in
+          let value = index in
+          s := Ktree_effects.set !s j value;
+        done
+
    end else if seq = "ParrayNarytree" then begin
 
       let s = ref (Parray_narytree.init ~base n (fun i -> i)) in