From: Michael D. Lowis Date: Thu, 9 Nov 2017 03:53:02 +0000 (-0500) Subject: Added node coalescing to join X-Git-Url: https://git.mdlowis.com/?a=commitdiff_plain;h=ed104af6b0faf40d4c83dd24a5e205d25c886e2f;p=archive%2Ftide-ocaml.git Added node coalescing to join --- diff --git a/docs/Rope.html b/docs/Rope.html index 33749d9..c68a1a5 100644 --- a/docs/Rope.html +++ b/docs/Rope.html @@ -61,18 +61,22 @@ 
val from_string : string -> t
val length : t -> int
val height : t -> int
+
val is_leaf : t -> bool
+
val is_leaf : t -> bool
val limit_index : t -> int -> int
val last : t -> int
val check_index : t -> int -> unit
-
val join : t -> t -> t
-
val split : t -> int -> t * t
-
val del : t -> int -> int -> t
val getb : t -> int -> char
val getc : t -> int -> int
-
val putc : 'a -> 'b -> 'c -> 'a
val iteri : (int -> int -> bool) -> t -> int -> unit
val gets : t -> int -> int -> string
+
val flatten : t -> t
+
val join : t -> t -> t
+
val join_special : t -> t -> t -> t
+
val split : t -> int -> t * t
+
val del : t -> int -> int -> t
val puts : t -> string -> int -> t
+
val putc : 'a -> 'b -> 'c -> 'a
val nextc : t -> int -> int
val prevc : t -> int -> int
val is_bol : t -> int -> bool
diff --git a/docs/index_values.html b/docs/index_values.html index 4394030..05bcc0c 100644 --- a/docs/index_values.html +++ b/docs/index_values.html @@ -114,6 +114,8 @@ first [Scrollmap] +flatten [Rope] + float [Cfg.Color.Syntax] font [Draw] @@ -177,6 +179,8 @@ is_eol [Rope] +is_leaf [Rope] + iter [Buf.Cursor] iter [Buf] @@ -188,6 +192,8 @@
J join [Rope] +join_special [Rope] +
K keyword [Cfg.Color.Syntax] diff --git a/lib/rope.ml b/lib/rope.ml index 7752789..9b0653d 100644 --- 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 7524569..11dddd5 100644 --- 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 () ->