Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 57 lines (47 sloc) 1.793 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (** A module for general non empty tree.
19 If you need trees that may be empty, you can use an option on this type.
20 *)
21
22 module List = BaseList
23
24 module Tree : sig
25 type 'a t = Tree of 'a * 'a t list
26 val leaf : 'a -> 'a t
27 val is_leaf : 'a t -> bool
28 val value : 'a t -> 'a
29 val children : 'a t -> 'a t list
30 val to_string : ('a -> string) -> 'a t -> string
31 val get_path_opt : 'a t -> 'a list -> 'a t option
32 end = struct
33 type 'a t = Tree of 'a * 'a t list
34 let leaf a = Tree(a,[])
35 let is_leaf (Tree (_,l)) = l = []
36 let value (Tree (a,_)) = a
37 let children (Tree (_,l)) = l
38 let rec to_string f (Tree (s,l)) =
39 Printf.sprintf "(%s:%s)" (f s) (List.to_string (to_string f) l)
40 let rec get_path_opt (Tree (_,children) as tree) = function
41 | [] -> Some tree
42 | h :: t ->
43 match List.find_opt (fun tr -> value tr = h) children with
44 | None -> None
45 | Some tree -> get_path_opt tree t
46 end
47
48 include Tree
49
50 module S = struct
51 type 'a t = 'b Tree.t constraint 'a = 'b * 'c * 'd
52 let subs_cons (Tree (x,l)) = (fun l -> Tree(x,l)), l
53 end
54
55 (** defines map, fold, etc. *)
56 module Walk = Traverse.Make(S)
Something went wrong with that request. Please try again.