tree.ml (3485B)
1 (* Unison file synchronizer: src/tree.ml *) 2 (* Copyright 1999-2020, Benjamin C. Pierce 3 4 This program is free software: you can redistribute it and/or modify 5 it under the terms of the GNU General Public License as published by 6 the Free Software Foundation, either version 3 of the License, or 7 (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU General Public License for more details. 13 14 You should have received a copy of the GNU General Public License 15 along with this program. If not, see <http://www.gnu.org/licenses/>. 16 *) 17 18 19 type ('a, 'b) t = 20 Node of ('a * ('a, 'b) t) list * 'b option 21 | Leaf of 'b 22 23 let m_rec ma mb m = 24 Umarshal.(sum2 25 (prod2 (list (prod2 ma m id id)) (option mb) id id) 26 mb 27 (function 28 | Node (a, b) -> I21 (a, b) 29 | Leaf a -> I22 a) 30 (function 31 | I21 (a, b) -> Node (a, b) 32 | I22 a -> Leaf a)) 33 34 let m ma mb = Umarshal.rec1 (m_rec ma mb) 35 36 type ('a, 'b) u = 37 { anc: (('a, 'b) u * 'a) option; 38 node: 'b option; 39 children: ('a * ('a, 'b) t) list} 40 41 let start = 42 {anc = None; node = None; children = []} 43 44 let add t v = 45 {t with node = Some v} 46 47 let enter t n = {anc = Some (t, n); node = None; children = []} 48 49 let leave t = 50 match t with 51 {anc = Some (t, n); node = None; children = []} -> 52 t 53 | {anc = Some (t, n); node = Some v; children = []} -> 54 {t with children = (n, Leaf v) :: t.children} 55 | {anc = Some (t, n); node = v; children = l} -> 56 {t with children = (n, (Node (Safelist.rev l, v))) :: t.children} 57 | {anc = None} -> 58 invalid_arg "Tree.leave" 59 60 let finish t = 61 match t with 62 {anc = Some _} -> 63 invalid_arg "Tree.finish" 64 | {anc = None; node = Some v; children = []} -> 65 Leaf v 66 | {anc = None; node = v; children = l} -> 67 Node (Safelist.rev l, v) 68 69 let rec leave_all t = 70 if t.anc = None then t else leave_all (leave t) 71 72 let rec empty t = 73 {anc = 74 begin match t.anc with 75 Some (t', n) -> Some (empty t', n) 76 | None -> None 77 end; 78 node = None; 79 children = []} 80 81 let slice t = 82 (finish (leave_all t), empty t) 83 84 (****) 85 86 let is_empty t = 87 match t with 88 Node ([], None) -> true 89 | _ -> false 90 91 let rec map f g t = 92 match t with 93 Node (l, v) -> 94 Node (Safelist.map (fun (n, t') -> (f n, map f g t')) l, 95 match v with None -> None | Some v -> Some (g v)) 96 | Leaf v -> 97 Leaf (g v) 98 99 let rec iteri t path pcons f = 100 match t with 101 Node (l, v) -> 102 begin match v with 103 Some v -> f path v 104 | None -> () 105 end; 106 Safelist.iter (fun (n, t') -> iteri t' (pcons path n) pcons f) l 107 | Leaf v -> 108 f path v 109 110 let rec size_rec s t = 111 match t with 112 Node (l, v) -> 113 let s' = if v = None then s else s + 1 in 114 Safelist.fold_left (fun s (_, t') -> size_rec s t') s' l 115 | Leaf v -> 116 s + 1 117 118 let size t = size_rec 0 t 119 120 let rec flatten t path pcons result = 121 match t with 122 Leaf v -> 123 (path, v) :: result 124 | Node (l, v) -> 125 let rem = 126 Safelist.fold_right 127 (fun (name, t') rem -> 128 flatten t' (pcons path name) pcons rem) 129 l result 130 in 131 match v with 132 None -> rem 133 | Some v -> (path, v) :: rem