diff --git a/src/misc/roseTree.ml b/src/misc/roseTree.ml index d779b15e..f78670c2 100644 --- a/src/misc/roseTree.ml +++ b/src/misc/roseTree.ml @@ -1,11 +1,48 @@ + +(* +copyright (c) 2013-2014, Simon Cruanes, Emmanuel Surleau +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + + type +'a t = [`Node of 'a * 'a t list] type 'a tree = 'a t +type 'a sequence = ('a -> unit) -> unit +type 'a printer = Format.formatter -> 'a -> unit + let rec fold ~f init_acc (`Node (value, children)) = let acc = f value init_acc in List.fold_left (fun acc' child_node -> fold ~f acc' child_node) acc children +let to_seq t yield = + let rec iter (`Node (value, children)) = + yield value; + List.iter iter children + in + iter t + let split_at_length_minus_1 l = let rev_list = List.rev l in match rev_list with @@ -13,7 +50,7 @@ let split_at_length_minus_1 l = | [item] -> ([], Some item) | item::items -> (List.rev items, Some item) -let print formatter string_of_value tree = +let print pp_val formatter tree = let rec print_children children indent_string = let non_last_children, maybe_last_child = split_at_length_minus_1 children @@ -26,7 +63,7 @@ let print formatter string_of_value tree = List.iter (fun (`Node (child_value, grandchildren)) -> Format.pp_print_string formatter indent_string; Format.pp_print_string formatter "|- "; - string_of_value child_value |> Format.pp_print_string formatter; + pp_val formatter child_value; Format.pp_force_newline formatter (); let indent_string' = indent_string ^ "| " in print_children grandchildren indent_string' @@ -34,13 +71,13 @@ let print formatter string_of_value tree = and print_last_child (`Node (last_child_value, last_grandchildren)) indent_string = Format.pp_print_string formatter indent_string; Format.pp_print_string formatter "'- "; - string_of_value last_child_value |> Format.pp_print_string formatter; + pp_val formatter last_child_value; Format.pp_force_newline formatter (); let indent_string' = indent_string ^ " " in print_children last_grandchildren indent_string' in let print_root (`Node (root_value, root_children)) = - string_of_value root_value |> Format.pp_print_string formatter; + pp_val formatter root_value; Format.pp_force_newline formatter (); print_children root_children "" in diff --git a/src/misc/roseTree.mli b/src/misc/roseTree.mli index 84803093..00773464 100644 --- a/src/misc/roseTree.mli +++ b/src/misc/roseTree.mli @@ -1,39 +1,67 @@ -(** - {1 Rose Tree} + +(* +copyright (c) 2013-2014, Simon Cruanes, Emmanuel Surleau +all rights reserved. + +redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. redistributions in binary +form must reproduce the above copyright notice, this list of conditions and the +following disclaimer in the documentation and/or other materials provided with +the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +*) + +(** {1 Rose Tree} A persistent, non-lazy tree where each node may have an arbitrary number of children. - @since NEXT_RELEASE -*) + @since NEXT_RELEASE *) -(** - The type of a tree node - a (value, children) pair. -*) +(** The type of a tree node - a (value, children) pair. *) type +'a t = [`Node of 'a * 'a t list] type 'a tree = 'a t +type 'a sequence = ('a -> unit) -> unit +type 'a printer = Format.formatter -> 'a -> unit + (** Folds over the tree. Takes a function [f node accumulator], an initial value for the accumulator, and the tree to operate on. *) val fold : f : ('a -> 'b -> 'b) -> 'b -> 'a t -> 'b +(** Iterate over the tree *) +val to_seq : 'a t -> 'a sequence + (** Tree pretty-printer. Takes a [Formatter], a function turning a node into a string, and the tree itself as parameters. Appends the result to the formatter. *) -val print : Format.formatter -> ('a -> string) -> 'a t -> unit +val print : 'a printer -> 'a t printer +(** + {2 Zipper} + + A zipper to navigate and return modified versions of the tree. +*) module Zipper : sig - (** - {2 Zipper} - - A zipper to navigate and return modified versions of the tree. - *) type 'a t (** diff --git a/tests/test_RoseTree.ml b/tests/test_RoseTree.ml index 5bb080f4..c967d8c1 100644 --- a/tests/test_RoseTree.ml +++ b/tests/test_RoseTree.ml @@ -1,11 +1,10 @@ open Containers_misc open OUnit -let format_node value = Printf.sprintf "%d" value +let format_node = Format.pp_print_int let string_of_tree tree = - CCFormat.sprintf "%a" (fun formatter value -> - RoseTree.print formatter format_node tree) tree + CCFormat.sprintf "%a" (RoseTree.print format_node) tree let assert_equal_tree expected_tree_rep tree = let expected_tree_rep_string = @@ -66,8 +65,8 @@ let new_tree_strings = [ "|- 1000" ; "| '- 10000" ; "'- 1001" ; - " |- 10010" ; - " '- 10012" ; + " |- 10010" ; + " '- 10012" ; ] let test_print_single_node_tree () = @@ -78,12 +77,12 @@ let test_print_normal_tree () = let expected = normal_tree_strings in assert_equal_tree expected normal_tree -let test_fold_single_node_tree () = +let test_fold_single_node_tree () = let tree_double_sum = RoseTree.fold ~f:(fun value acc -> acc + value * 2) 0 single_node_tree in assert_equal 20 tree_double_sum -let test_fold_normal_tree () = +let test_fold_normal_tree () = let tree_sum = RoseTree.fold ~f:(fun value acc -> acc + value) 0 normal_tree in assert_equal 150 tree_sum @@ -325,8 +324,8 @@ let test_insert_left_sibling () = "| | |- 1000" ; "| | | '- 10000" ; "| | '- 1001" ; - "| | |- 10010" ; - "| | '- 10012" ; + "| | |- 10010" ; + "| | '- 10012" ; "| '- 10" ; "|- 2" ; "| |- 20" ; @@ -375,8 +374,8 @@ let test_insert_right_sibling () = "| |- 1000" ; "| | '- 10000" ; "| '- 1001" ; - "| |- 10010" ; - "| '- 10012" ; + "| |- 10010" ; + "| '- 10012" ; "|- 2" ; "| |- 20" ; "| '- 21" ; @@ -428,8 +427,8 @@ let test_append_child () = " |- 1000" ; " | '- 10000" ; " '- 1001" ; - " |- 10010" ; - " '- 10012" ; + " |- 10010" ; + " '- 10012" ; ] in assert_equal_zipper expected zipper @@ -459,8 +458,8 @@ let test_replace () = "| |- 1000" ; "| | '- 10000" ; "| '- 1001" ; - "| |- 10010" ; - "| '- 10012" ; + "| |- 10010" ; + "| '- 10012" ; "'- 3" ; " |- 30" ; " |- 31" ;