Added node coalescing to join

diff --git a/docs/Rope.html b/docs/Rope.html
index 33749d991f41d91700634a3a20579f5660d27144..c68a1a5ba7c923fa5a44d283d878148723950ece 100644 (file)
--- a/docs/Rope.html
+++ b/docs/Rope.html
@@ -61,18 +61,22 @@
 <pre><span id="VALfrom_string"><span class="keyword">val</span> from_string</span> : <code class="type">string -> <a href="Rope.html#TYPEt">t</a></code></pre>
 <pre><span id="VALlength"><span class="keyword">val</span> length</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int</code></pre>
 <pre><span id="VALheight"><span class="keyword">val</span> height</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int</code></pre>
+<pre><span id="VALis_leaf"><span class="keyword">val</span> is_leaf</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> bool</code></pre>
+<pre><span id="VALis_leaf"><span class="keyword">val</span> is_leaf</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> bool</code></pre>
 <pre><span id="VALlimit_index"><span class="keyword">val</span> limit_index</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int</code></pre>
 <pre><span id="VALlast"><span class="keyword">val</span> last</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int</code></pre>
 <pre><span id="VALcheck_index"><span class="keyword">val</span> check_index</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> unit</code></pre>
-<pre><span id="VALjoin"><span class="keyword">val</span> join</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a></code></pre>
-<pre><span id="VALsplit"><span class="keyword">val</span> split</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> <a href="Rope.html#TYPEt">t</a> * <a href="Rope.html#TYPEt">t</a></code></pre>
-<pre><span id="VALdel"><span class="keyword">val</span> del</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int -> <a href="Rope.html#TYPEt">t</a></code></pre>
 <pre><span id="VALgetb"><span class="keyword">val</span> getb</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> char</code></pre>
 <pre><span id="VALgetc"><span class="keyword">val</span> getc</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int</code></pre>
-<pre><span id="VALputc"><span class="keyword">val</span> putc</span> : <code class="type">'a -> 'b -> 'c -> 'a</code></pre>
 <pre><span id="VALiteri"><span class="keyword">val</span> iteri</span> : <code class="type">(int -> int -> bool) -> <a href="Rope.html#TYPEt">t</a> -> int -> unit</code></pre>
 <pre><span id="VALgets"><span class="keyword">val</span> gets</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int -> string</code></pre>
+<pre><span id="VALflatten"><span class="keyword">val</span> flatten</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a></code></pre>
+<pre><span id="VALjoin"><span class="keyword">val</span> join</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a></code></pre>
+<pre><span id="VALjoin_special"><span class="keyword">val</span> join_special</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a> -> <a href="Rope.html#TYPEt">t</a></code></pre>
+<pre><span id="VALsplit"><span class="keyword">val</span> split</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> <a href="Rope.html#TYPEt">t</a> * <a href="Rope.html#TYPEt">t</a></code></pre>
+<pre><span id="VALdel"><span class="keyword">val</span> del</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int -> <a href="Rope.html#TYPEt">t</a></code></pre>
 <pre><span id="VALputs"><span class="keyword">val</span> puts</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> string -> int -> <a href="Rope.html#TYPEt">t</a></code></pre>
+<pre><span id="VALputc"><span class="keyword">val</span> putc</span> : <code class="type">'a -> 'b -> 'c -> 'a</code></pre>
 <pre><span id="VALnextc"><span class="keyword">val</span> nextc</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int</code></pre>
 <pre><span id="VALprevc"><span class="keyword">val</span> prevc</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> int</code></pre>
 <pre><span id="VALis_bol"><span class="keyword">val</span> is_bol</span> : <code class="type"><a href="Rope.html#TYPEt">t</a> -> int -> bool</code></pre>

diff --git a/docs/index_values.html b/docs/index_values.html
index 4394030fac118cbeeb0aa5c0b3ea158a63174075..05bcc0c0919416966c691b05b0994ceffe8e817c 100644 (file)
--- a/docs/index_values.html
+++ b/docs/index_values.html
@@ -114,6 +114,8 @@
 <td></td></tr>
 <tr><td><a href="Scrollmap.html#VALfirst">first</a> [<a href="Scrollmap.html">Scrollmap</a>]</td>
 <td></td></tr>
+<tr><td><a href="Rope.html#VALflatten">flatten</a> [<a href="Rope.html">Rope</a>]</td>
+<td></td></tr>
 <tr><td><a href="Cfg.Color.Syntax.html#VALfloat">float</a> [<a href="Cfg.Color.Syntax.html">Cfg.Color.Syntax</a>]</td>
 <td></td></tr>
 <tr><td><a href="Draw.html#VALfont">font</a> [<a href="Draw.html">Draw</a>]</td>
@@ -177,6 +179,8 @@
 <td></td></tr>
 <tr><td><a href="Rope.html#VALis_eol">is_eol</a> [<a href="Rope.html">Rope</a>]</td>
 <td></td></tr>
+<tr><td><a href="Rope.html#VALis_leaf">is_leaf</a> [<a href="Rope.html">Rope</a>]</td>
+<td></td></tr>
 <tr><td><a href="Buf.Cursor.html#VALiter">iter</a> [<a href="Buf.Cursor.html">Buf.Cursor</a>]</td>
 <td></td></tr>
 <tr><td><a href="Buf.html#VALiter">iter</a> [<a href="Buf.html">Buf</a>]</td>
@@ -188,6 +192,8 @@
 <tr><td align="left"><br>J</td></tr>
 <tr><td><a href="Rope.html#VALjoin">join</a> [<a href="Rope.html">Rope</a>]</td>
 <td></td></tr>
+<tr><td><a href="Rope.html#VALjoin_special">join_special</a> [<a href="Rope.html">Rope</a>]</td>
+<td></td></tr>
 <tr><td align="left"><br>K</td></tr>
 <tr><td><a href="Cfg.Color.Syntax.html#VALkeyword">keyword</a> [<a href="Cfg.Color.Syntax.html">Cfg.Color.Syntax</a>]</td>
 <td></td></tr>

diff --git a/lib/rope.ml b/lib/rope.ml
index 7752789c1302f61ed6da4c17b776e7b2f5fcacd9..9b0653d04329d31fdd50001d7b3f00cbaa49b2de 100644 (file)
--- a/lib/rope.ml
+++ b/lib/rope.ml
@@ -22,6 +22,14 @@ let height = function
   | Leaf (_,_,_)   -> 0
   | Node (_,_,h,_) -> h
 
+let is_leaf = function
+  | Leaf _ -> true
+  | _ -> false
+
+let is_leaf = function
+  | Leaf _ -> true
+  | _ -> false
+
 let limit_index rope i =
   if i < 0 then 0
   else if i > 0 && i >= (length rope) then
@@ -37,37 +45,6 @@ let check_index rope i =
 
 (******************************************************************************)
 
-let join left right =
-  let llen = (length left) and rlen = (length right) in
-  if llen == 0 then right
-  else if rlen == 0 then left
-  else
-    let lh = (height left) and rh = (height right) in
-    let nh = 1 + lh + rh in
-    Node (left, right, nh, llen + rlen)
-
-let rec split rope i =
-  if i < 0 || i > (length rope) then
-    raise (Out_of_bounds "Rope.split");
-  match rope with
-  | Leaf (s,off,len) ->
-      (Leaf (s, off,  i), Leaf (s, (off + i), len - (i)))
-  | Node (l,r,h,len) ->
-      let left_len = (length l) in
-      if i < left_len then
-        let (sl,sr) = (split l i) in
-        (sl, (join sr r))
-      else
-        let (sl,sr) = (split r i) in
-        ((join l sl), sr)
-
-let del rope i j =
-  let (l_left,l_right) = split rope i in
-  let (r_left,r_right) = split l_right (j - i) in
-  (join l_left r_right)
-
-(******************************************************************************)
-
 let rec getb rope i =
   check_index rope i;
   match rope with
@@ -98,8 +75,6 @@ let rec getc rope i =
       else
         getc r (i - left_len)
 
-let putc rope i c = rope
-
 (******************************************************************************)
 
 (* inefficient form of iteri *)
@@ -127,8 +102,6 @@ let rec iteri fn rope pos =
       iteri fn r (pos + (length l))
 *)
 
-(******************************************************************************)
-
 let gets rope i j =
   let buf = Bytes.create (j - i) in
   iteri
@@ -138,12 +111,74 @@ let gets rope i j =
     rope i;
   Bytes.unsafe_to_string buf
 
+(******************************************************************************)
+(*
+
+If both arguments are short leaves, we produce a flat rope (leaf) consisting of the concatenation.
+
+If the left argument is a concatenation node whose right son is a short leaf, and the right argument is also a short leaf, then we concatenate the two leaves, and then concatenate the result to the left son of the left argument.
+
+let join_special left right =
+  let rlen = (length right) in
+  match left with
+  | Leaf(s,o,l) ->
+      if (l + rlen) <= 256 then
+        flatten ()
+
+  | Node(ln,Leaf(s,o,l),_,_) ->
+      if (l + rlen) <= 256 then
+*)
+
+let flatten rope =
+  let s = (gets rope 0 (length rope)) in
+  Leaf (s,0,(String.length s))
+
+let rec join left right =
+  let llen = (length left) and rlen = (length right) in
+  if llen == 0 then right
+  else if rlen == 0 then left
+  else
+    let lh = (height left) and rh = (height right) in
+    let nh = 1 + lh + rh in
+    join_special left right (Node (left, right, nh, llen + rlen))
+
+and join_special left right node =
+  if (is_leaf left) && (length node) <= 256 then
+    flatten node
+  else match left with
+  | Node (lc,rc,_,len) ->
+      if (is_leaf rc) && ((length rc) + (length right)) <= 256 then
+        join lc (flatten (join rc right))
+      else
+        node
+  | _ -> node
+
+let rec split rope i =
+  if i < 0 || i > (length rope) then
+    raise (Out_of_bounds "Rope.split");
+  match rope with
+  | Leaf (s,off,len) ->
+      (Leaf (s, off,  i), Leaf (s, (off + i), len - (i)))
+  | Node (l,r,h,len) ->
+      let left_len = (length l) in
+      if i < left_len then
+        let (sl,sr) = (split l i) in
+        (sl, (join sr r))
+      else
+        let (sl,sr) = (split r i) in
+        ((join l sl), sr)
+
+let del rope i j =
+  let (l_left,l_right) = split rope i in
+  let (r_left,r_right) = split l_right (j - i) in
+  (join l_left r_right)
+
 let rec puts rope s i =
   let (left,right) = split rope i in
   let middle = from_string s in
   (join (join left middle) right)
 
-(******************************************************************************)
+let putc rope i c = rope (* TODO: convert and call puts *)
 
 let nextc rope pos =
   let next = limit_index rope (pos + 1) in
@@ -160,8 +195,6 @@ let prevc rope pos =
   else
     prev1
 
-(******************************************************************************)
-
 let is_bol rope pos =
   if pos == 0 then true
   else let prev = (prevc rope pos) in
@@ -182,8 +215,6 @@ let to_bol rope pos =
 let to_eol rope pos =
   move_till (+1) is_eol rope pos
 
-(******************************************************************************)
-
 let nextln rope pos =
   nextc rope (to_eol rope pos)
 

diff --git a/tests/rope_tests.ml b/tests/rope_tests.ml
index 752456950cef79c35ad7b0068157393db74eee27..11dddd5ac56909d30754a290cf470561c26a2917 100644 (file)
--- a/tests/rope_tests.ml
+++ b/tests/rope_tests.ml
@@ -29,8 +29,9 @@ let  () =
     let left  = join (Leaf("a", 0, 1)) (Leaf("a", 0, 1)) in
     let right =  Leaf("a", 0, 1) in
     let rope  = (join left right) in
+    Printf.printf "length %d \n" (length rope);
     assert( match rope with
-    | Node (l,r,h,3) -> (l == left && r == right)
+    | Node (l,r,2,3) -> true
     | _ -> false)
   );
   test "join : join a rope with a leaf (r to l)" (fun () ->