Browse files

not happy with this representation

  • Loading branch information...
1 parent 0396ea2 commit 6c3890cf3463f62170082c97a3697e471ac27804 Romain Slootmaekers committed Oct 10, 2011
Showing with 678 additions and 3 deletions.
  1. +2 −0 .hgignore
  2. +1 −0 doc/interface.ml
  3. +6 −0 src/.ocamlinit
  4. +3 −0 src/_tags
  5. +127 −0 src/dot.ml
  6. +182 −0 src/entry.ml
  7. +30 −0 src/log.ml
  8. +36 −0 src/mlog.ml
  9. +41 −0 src/play.ml
  10. +62 −0 src/test.ml
  11. +161 −0 src/tree.ml
  12. +27 −3 toys/test.ml
View
2 .hgignore
@@ -1,3 +1,5 @@
syntax: glob
+**/*~
doc/_build/*
+src/_build/*
View
1 doc/interface.ml
@@ -5,5 +5,6 @@ module type DB = sig
val set : t -> k -> v -> unit
val get : t -> k -> v
+ val get': t -> k -> (v -> 'a) -> 'a
val del : t -> k -> unit
end
View
6 src/.ocamlinit
@@ -0,0 +1,6 @@
+# directory "_build";;
+# load "entry.cmo";;
+# load "log.cmo";;
+# load "mlog.cmo";;
+# load "tree.cmo";;
+# load "dot.cmo";;
View
3 src/_tags
@@ -0,0 +1,3 @@
+true: annot
+true: debug
+<test.{ml,byte,native}>: package(oUnit)
View
127 src/dot.ml
@@ -0,0 +1,127 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open Log
+open Entry
+module Dot = functor (L:LOG) -> struct
+
+ let dot_tree ?(f= stdout) log =
+ Printf.fprintf f "digraph Tree{\n";
+ let rec walk pos =
+ match L.read log pos with
+ | NIL -> ()
+ | Value v -> Printf.fprintf f "\tnode%i [shape = box label = %S];\n" pos v
+ | Leaf kps ->
+ List.iter (fun (_,p) -> walk p) kps;
+ Printf.fprintf f "\tnode%i [shape = record label = \"" pos;
+ let rec loop = function
+ | [] -> ()
+ | [k,p] -> Printf.fprintf f "<%i> %s" p k
+ | (k,p):: tail -> Printf.fprintf f "<%i> %s | " p k; loop tail
+ in
+ loop kps;
+ Printf.fprintf f "\"]\n";
+ List.iter
+ (fun (k,p) ->
+ Printf.fprintf f "\tnode%i:<%i> -> node%i\n" pos p p) kps
+
+ | Index (pp,kps) ->
+ walk pp;
+ List.iter (fun (_, p) -> walk p) kps;
+ Printf.fprintf f "\nnode%i [shape = record label=\"" pos;
+ let rec loop = function
+ | [] -> ()
+ | [k,p] -> Printf.fprintf f "<%i> %s" p k
+ | (k,p):: tail -> Printf.fprintf f "<%i> %s | " p k; loop tail
+ in
+ loop kps;
+ Printf.fprintf f "\"]\n";
+ Printf.fprintf f "\tnode%i -> node%i\n" pos pp;
+ List.iter (fun (_, p) -> Printf.fprintf f "\tnode%i -> node%i;\n" pos p) kps
+ in
+ walk (L.root log);
+ Printf.fprintf f "}\n"
+
+
+ let dot_log ?(f= stdout) log =
+ Printf.fprintf f "digraph Log{\n";
+ Printf.fprintf f "\trankdir=\"RL\";\n";
+ Printf.fprintf f "\tnode [shape= record];\n";
+ let too_far = L.next log in
+ let rec loop i =
+ if i = too_far then ()
+ else
+ let e = L.read log i in
+ let () = match e with
+ | NIL -> ()
+ | Value v -> Printf.fprintf f "\tnode%i [label = \"{%i | %s}\"];\n" i i v;
+ | Leaf kps ->
+ begin
+ Printf.fprintf f "\tnode%i [label = \"{ %i | {" i i;
+ let rec loop = function
+ | [] -> ()
+ | [k,p] -> Printf.fprintf f "<%i> %s" p k
+ | (k,p)::tail -> Printf.fprintf f "<%i> %s | " p k ; loop tail
+ in
+ loop kps;
+ Printf.fprintf f "}}\"];\n";
+ List.iter
+ (fun (_,p) ->
+ Printf.fprintf f "\tnode%i:<%i> -> node%i;\n" i p p
+ ) kps
+ end
+ | Index (pp,kps) ->
+ Printf.fprintf f "\tnode%i [label = \"{%i | { " i i;
+ let rec loop = function
+ | [] -> ()
+ | [k,p] -> Printf.fprintf f "<%i> %s" p k
+ | (k,p) :: tail -> Printf.fprintf f "<%i> %s | " p k; loop tail
+ in
+ loop kps;
+ Printf.fprintf f "}}\"];\n";
+ Printf.fprintf f "\tnode%i -> node%i;\n" i pp;
+ List.iter
+ (fun (_, p) ->
+ Printf.fprintf f "\tnode%i -> node%i;\n" i p) kps
+ in
+ let () =
+ if e <> NIL && i > 0
+ then Printf.fprintf f "\tnode%i -> node%i [style = invis];\n" i (i-1)
+ in
+ loop (i+1)
+ in
+ loop 0;
+ Printf.fprintf f "}\n"
+
+ let view ?(v=dot_tree) log =
+ let root = "test" in
+ let dot = Filename.temp_file root ".dot" in
+ let png = Filename.temp_file root ".png" in
+ let oc = open_out dot in
+ let () = v ~f:oc log in
+ close_out oc;
+ let convert_cmd = Printf.sprintf "dot -Tpng -o %s %s" png dot in
+ let _ = Sys.command convert_cmd in
+ let cmd = Printf.sprintf "evince %s" png in
+ Sys.command cmd
+
+
+ let view_tree log = view ~v:dot_tree log
+ let view_log log = view ~v:dot_log log
+end
View
182 src/entry.ml
@@ -0,0 +1,182 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+let d = 2
+
+type k = string
+type v = string
+type pos = int
+
+type kps = (k * pos) list
+type l_o_r = L | R (* siblings *)
+
+type dir =
+ | INSERT
+ | REPLACE of (int * pos)
+
+
+type entry =
+ | NIL
+ | Index of (pos * kps)
+ | Leaf of kps
+ | Value of v
+
+let kps2s (kps:kps) =
+ let b = Buffer.create 128 in
+ Buffer.add_string b "[";
+ let rec inner = function
+ | [] -> ()
+ | [(k,p)] ->
+ Buffer.add_string b (Printf.sprintf "(%s,%i)" k p)
+ | (k,p) :: t ->
+ Buffer.add_string b (Printf.sprintf "(%s,%i);" k p );
+ inner t
+ in
+ inner kps;
+ Buffer.add_string b "]";
+ Buffer.contents b
+
+
+let leaf_dir (k:k) (kps: kps) =
+ let rec loop i = function
+ | [] -> INSERT
+ | (k0,p0) :: _ when k0 = k -> REPLACE (i,p0)
+ | _ :: rest -> loop (i+1) rest
+ in
+ loop 0 kps
+
+let leaf_size (kps:kps) = 1
+
+let index_size (pp, kps) = 1
+
+let leaf_remove i (kps : kps) =
+ let rec loop acc i = function
+ | [] -> List.rev acc
+ | h :: tail ->
+ let acc' = if i = 0 then acc else h :: acc in
+ loop acc' (i-1) tail
+ in
+ loop [] i kps
+
+let index_replace i (lpos:pos) pp (kps:kps) =
+ if i = 0 then
+ (lpos, kps)
+ else
+ let rec loop acc i = function
+ | [] -> (pp,List.rev acc)
+ | (kh,ph) as h :: tail ->
+ let kp' =
+ if i = 1
+ then (kh,lpos)
+ else h
+ in
+ loop (kp' :: acc) (i-1) tail
+ in
+ loop [] i kps
+
+
+let leaf_overflow kps = List.length kps > (2 * d - 1)
+
+let index_overflow (pp,kps) = List.length kps = (2 * d - 1)
+let leaf_underflow kps = List.length kps < d
+
+let leaf_split kps =
+ let rec loop acc i = function
+ | [] -> failwith "can't happen"
+ | (k,p) as h :: tail ->
+ if i = 0
+ then List.rev (h :: acc), k, tail
+ else loop (h::acc) (i-1) tail
+ in
+ loop [] (d-1) kps
+
+let leaf_merge lr kps0 kps1 =
+ match lr with
+ | R -> kps0 @ kps1
+ | L -> kps1 @ kps0
+
+let leaf_replace i p (kps:kps) =
+ let rec loop acc i = function
+ | [] -> List.rev acc
+ | (k,_) as kp :: tail ->
+ let kp' = if i = 0 then (k,p) else kp in
+ loop (kp' :: acc) (i-1) tail
+ in
+ loop [] i kps
+
+let leaf_insert k p (kps:kps) =
+ let rec loop acc = function
+ | [] -> List.rev ((k,p) :: acc)
+ | (kh,ph) as kph :: tail when kh < k-> loop (kph ::acc) tail
+ | tail -> (List.rev ((k,p):: acc)) @ tail
+ in
+ loop [] kps
+
+
+
+let index_dir k pp kps =
+ let rec loop i pp = function
+ | [] -> (i,pp)
+ | (k0,p0) :: tail ->
+ if k <= k0
+ then (i,pp)
+ else loop (i+1) p0 tail
+ in
+ loop 0 pp kps
+
+let index_insert i0 lpos sep rpos pp kps =
+ match kps with
+ | [k0,r0] ->
+ if sep > k0
+ then pp, [k0,lpos;sep, rpos]
+ else failwith "todo"
+
+let index_remove i0 lpos pp kps =
+ match kps with
+ | [(k0,p0); (k1,p1)] ->
+ if i0 = 0
+ then lpos, [k1,p1]
+ else
+ if i0 = 1
+ then pp,[k0,lpos]
+ else failwith "todo"
+
+
+
+
+
+let index_n_seps pp kps = List.length kps
+
+let pick_sibling i0 me pp kps =
+ let rec loop i pp kps =
+ match kps with
+ | [] -> pp,R
+ | [(k,p)] ->
+ if i0 = 0 then p,R
+ else pp,L
+ | (k,p) :: t ->
+ if i > 0 then loop (i-1) p t
+ else
+ if pp = me
+ then p,R
+ else pp,L
+
+
+ in loop i0 pp kps
+
View
30 src/log.ml
@@ -0,0 +1,30 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open Entry
+
+module type LOG = sig
+ type t
+
+ val write : t -> entry list -> unit
+ val root : t -> pos
+ val next : t -> pos
+ val read : t -> pos -> entry
+ val size : entry -> pos
+end
View
36 src/mlog.ml
@@ -0,0 +1,36 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open Entry
+
+type t = { es : entry array; mutable next:int}
+
+let make cap = {es = Array.make cap NIL; next = 0}
+let write t es =
+ let do_one e =
+ t.es.(t.next) <- e;
+ t.next <- t.next + 1
+ in
+ List.iter do_one es
+
+let root t = t.next -1
+let next t = t.next
+let size e = 1
+let read t pos = if pos < 0 then NIL else t.es.(pos)
+
View
41 src/play.ml
@@ -0,0 +1,41 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open Dot
+open Tree
+open Entry
+
+module MDB = DB(Mlog);;
+
+module MDot = Dot(Mlog);;
+
+let t0 = Mlog.make 40;;
+let kvs = ["a", "A";
+ "d", "D";
+ "g", "G";
+ "j", "J";
+ "m", "M";
+ "q", "Q";
+ ];;
+
+let () = List.iter (fun (k,v) -> MDB.set t0 k v) kvs;;
+let check () = List.iter (fun (k,v) -> assert (MDB.get t0 k =v)) kvs;;
+(* now delete "q" "Q" *)
+
+let test () = pick_sibling 1 15 7 [("d",14);("j",15)];;
View
62 src/test.ml
@@ -0,0 +1,62 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open OUnit
+open Log
+open Tree
+open Entry
+module MDB = DB(Mlog)
+
+type 'a q = 'a * ('a -> k -> v -> unit) * ('a -> k -> v) * ('a -> k -> unit)
+
+let mem_setup () = (Mlog.make 40 , MDB.set, MDB.get, MDB.delete)
+
+let mem_teardown q = ()
+
+let mem_wrap t = OUnit.bracket mem_setup t mem_teardown
+
+let check (log,_,get,_) kvs =
+ List.iter (fun (k,v) -> OUnit.assert_equal v (get log k)) kvs
+
+let split_1 ((log,set,get,delete) as q) =
+ let kvs0 = ["a","A"; "d","D"; "g","G";] in
+ List.iter (fun (k,v) -> set log k v) kvs0;
+ set log "j" "J";
+ check q (("j","J")::kvs0);
+ delete log "j";
+ check q kvs0
+
+
+let split_2 ((log,set,get,delete) as q) =
+ let kvs0 = ["a","A"; "d","D"; "g","G"; "j","J"; "m","M";] in
+ List.iter (fun (k,v) -> set log k v) kvs0;
+ set log "q" "Q";
+ check q (("q","Q")::kvs0);
+ delete log "q";
+ check q kvs0
+
+let suite =
+ "correctness" >::: [
+ "split_1" >:: mem_wrap split_1;
+ "split_2" >:: mem_wrap split_2;
+ ]
+
+
+let _ =
+ run_test_tt_main suite;;
View
161 src/tree.ml
@@ -0,0 +1,161 @@
+(*
+ * This file is part of Baardskeerder.
+ *
+ * Copyright (C) 2011 Incubaid BVBA
+ *
+ * Baardskeerder is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * Baardskeerder 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 Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with Baardskeerder. If not, see <http://www.gnu.org/licenses/>.
+ *)
+
+open Entry
+open Log
+
+type trail = (dir * entry) list
+
+exception ExTrail of trail * string
+let etrail t s= raise (ExTrail (t,s))
+
+exception ExLeaf of kps * string
+let eleaf kps s = raise (ExLeaf(kps,s))
+
+module DB = functor (L:LOG) -> struct
+
+ let get log k =
+ let rec descend pos =
+ let e = L.read log pos in
+ match e with
+ | NIL -> raise Not_found
+ | Value v -> v
+ | Index (pp,kps) ->
+ let (_,pos) = index_dir k pp kps in
+ descend pos
+ | Leaf kps ->
+ match leaf_dir k kps with
+ | INSERT -> raise Not_found
+ | REPLACE (_, pos) -> descend pos
+ in
+ descend (L.root log)
+
+ let set log k v =
+ let rec build_set start trail =
+ let vv = Value v in
+ let start' = start + L.size vv in
+ vv :: do_start start start' trail
+ and do_start vpos start trail =
+ match trail with
+ | [] -> [Leaf [k,vpos]]
+ | (ir, Leaf kps) :: rest ->
+ begin
+ match ir with
+ | INSERT ->
+ let kps' = leaf_insert k vpos kps in
+ if leaf_overflow kps'
+ then
+ let l,sep,r = leaf_split kps' in
+ let lpos = vpos + (leaf_size l) in
+ let rpos = lpos + (leaf_size r) in
+ Leaf l :: Leaf r :: do_rest_overflow l lpos sep r rpos rest
+ else
+ let lpos = vpos + (leaf_size kps') in
+ Leaf kps' :: do_rest lpos rest
+ | REPLACE (i,p0) ->
+ let kps' = leaf_replace i vpos kps in
+ let lpos = vpos + (leaf_size kps') in
+ Leaf kps' :: do_rest lpos rest
+ end
+ | _ -> etrail trail "do_start"
+ and do_rest_overflow l lpos sep r rpos rest =
+ match rest with
+ | [] -> [Index (lpos,[sep,rpos])]
+ | (REPLACE (i0,p0), Index (pp,kps)) :: t ->
+ let index' = index_insert i0 lpos sep rpos pp kps in
+ if index_overflow index' then
+ etrail rest "index_overflow"
+ else
+ let index_pos = rpos + leaf_size r in
+ let start = index_pos + index_size index' in
+ Index index' :: do_rest start t
+ and do_rest lpos trail =
+ match trail with
+ | [] -> []
+ | [REPLACE (i,pos), Index (pp,kps) ] ->
+ let index' = index_replace i lpos pp kps in
+ [Index (index')]
+ | index :: rest -> etrail trail "do_rest"
+ in
+
+ let rec descend trail pos =
+ let e = L.read log pos in
+ match e with
+ | NIL -> trail
+ | Value v -> failwith "corrupt"
+ | Leaf kps ->
+ let x= leaf_dir k kps in
+ (x,e) :: trail
+ | Index (pp,kps) ->
+ let (d,p) as x = index_dir k pp kps in
+ let trail' = (REPLACE x,e) :: trail in
+ descend trail' p
+ in
+ let trail = descend [] (L.root log) in
+ let update = build_set (L.next log) trail in
+ L.write log update
+
+ let delete log k =
+ let build_delete start trail =
+ match trail with
+ | [] -> failwith "build_delete empty trail???"
+ | [REPLACE (i0,p0) , Leaf kps] -> [Leaf (leaf_remove i0 kps) ]
+ | [REPLACE (i0,p0) , Leaf lkps;
+ REPLACE (i1,p1) , Index (pp,ikps)] ->
+ let lkps1 = leaf_remove i0 lkps in
+ if leaf_underflow lkps1
+ then
+ begin
+ let me = p1 in
+ let sibling_p,lr = pick_sibling i0 me pp ikps in
+ let sibling = L.read log sibling_p in
+ match sibling with
+ | Leaf sibling_kps ->
+ let lkps2 = leaf_merge lr lkps1 sibling_kps in
+ if (index_n_seps pp ikps) = 1
+ then [Leaf lkps2]
+ else let (pp',kps') = index_remove i0 start pp ikps in
+ [Leaf lkps2; Index (pp', kps')]
+ | _ -> failwith "corrupt"
+ end
+ else etrail trail "no_underflow"
+
+ | _ -> etrail trail "build_delete"
+ in
+ let rec descend trail pos =
+ let e = L.read log pos in
+ match e with
+ | NIL -> raise Not_found
+ | Value v -> failwith "corrupt"
+ | Leaf kps ->
+ begin
+ match leaf_dir k kps with
+ | INSERT -> raise Not_found
+ | x -> (x,e) :: trail
+ end
+ | Index (pp, kps) ->
+ let (i,pos) = index_dir k pp kps in
+ let x = REPLACE (i,pos) in
+ let trail' = (x,e) :: trail in
+ descend trail' pos
+ in
+ let trail = descend [] (L.root log) in
+ let update = build_delete (L.next log) trail in
+ L.write log update
+end
View
30 toys/test.ml
@@ -66,6 +66,12 @@ and do_rest start visited =
in
e :: do_rest (start + 1) t
+let rec build_delete k start trail = do_start start k trail
+and do_start start k visited = match visited with
+ | [] -> []
+ | [(Hit, L(k0,p0),pe)] -> [L(k0,-1)]
+ | _ -> todo visited "do_start"
+
let set log k v =
let rec descend trail pos =
match get_entry log pos with
@@ -85,6 +91,24 @@ let set log k v =
let update = build_set k v log.next trail in
write log update
+let delete log k =
+ let rec descend trail pos =
+ match get_entry log pos with
+ | NIL -> failwith "not_found"
+ | V v -> failwith "corrupt"
+ | L (k0,p0) as e -> let dir =
+ if k = k0
+ then Hit
+ else failwith "Not_found"
+ in
+ (dir, e, pos) :: trail
+ | N (l,k0,r) as e when k <= k0 -> descend ((Left, e, pos) :: trail) l
+ | N (l,k0,r) as e -> descend ((Left, e, pos) :: trail) r
+ in
+ let trail = descend [] (root_pos log) in
+ let update = build_delete k log.next trail in
+ write log update
+
let dump log =
Array.iteri (fun i e->
let () = Printf.printf "%2i: " i in
@@ -108,7 +132,7 @@ let dot_log ?(f = stdout) log =
Printf.fprintf f
"\tnode%i [label = \"{%i | { %s | <f1> %i} }\"];\n"
i i k p;
- Printf.fprintf f "\tnode%i:<f1> -> node%i;\n" i p
+ if p >= 0 then Printf.fprintf f "\tnode%i:<f1> -> node%i;\n" i p
| N(l,k0,r) -> Printf.fprintf f "\tnode%i [label = \"{%i| { <f1> %i | %s | <f2> %i}}\"];\n" i i l k0 r;
Printf.fprintf f "\tnode%i:<f1> -> node%i;\n" i l;
Printf.fprintf f "\tnode%i:<f2> -> node%i;\n" i r;
@@ -140,7 +164,7 @@ let dot_tree ?(f= stdout) log =
| L(k,p) ->
walk p;
Printf.fprintf f "\tnode%i [label = %S shape = oval];\n" pos k;
- Printf.fprintf f "\tnode%i -> node%i\n" pos p;
+ if p <> -1 then Printf.fprintf f "\tnode%i -> node%i\n" pos p;
| N(l,k,r) ->
walk l;
@@ -167,7 +191,7 @@ let inserts =
List.iter (fun (k,v) -> set t0 k v) inserts;;
let t1 = make 10;;
-let i1s = ["d","D"; "f","F";];;
+let i1s = ["d","D"; (* "f","F"; *)];;
List.iter (fun (k,v) -> set t1 k v) i1s;;
let check () =

0 comments on commit 6c3890c

Please sign in to comment.