1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
module Line = struct
[@@@coverage off]
type t =
| Root of { rev : Rev.t }
| Commit of
{ rev : Rev.t
; parent : Rev.t
}
| Merge of
{ rev : Rev.t
; parent1 : Rev.t
; parent2 : Rev.t
}
| Octopus_merge of
{ rev : Rev.t
; parent1 : Rev.t
; parent2 : Rev.t
; parent3 : Rev.t
; other_parents : Rev.t list
}
let to_dyn = function
| Root { rev } -> Dyn.inline_record "Root" [ "rev", Rev.to_dyn rev ]
| Commit { rev; parent } ->
Dyn.inline_record "Commit" [ "rev", Rev.to_dyn rev; "parent", Rev.to_dyn parent ]
| Merge { rev; parent1; parent2 } ->
Dyn.inline_record
"Merge"
[ "rev", Rev.to_dyn rev
; "parent1", Rev.to_dyn parent1
; "parent2", Rev.to_dyn parent2
]
| Octopus_merge { rev; parent1; parent2; parent3; other_parents } ->
Dyn.inline_record
"Octopus_merge"
(("rev", Rev.to_dyn rev)
:: ("parent1", Rev.to_dyn parent1)
:: ("parent2", Rev.to_dyn parent2)
:: ("parent3", Rev.to_dyn parent3)
:: List.mapi other_parents ~f:(fun i parent ->
Printf.sprintf "parent%d" (i + 4), Rev.to_dyn parent))
;;
let sexp_of_t t = Dyn.to_sexp (to_dyn t)
let equal a b =
phys_equal a b
||
match a, b with
| Root a, Root { rev } -> Rev.equal a.rev rev
| Commit a, Commit { rev; parent } -> Rev.equal a.rev rev && Rev.equal a.parent parent
| Merge a, Merge { rev; parent1; parent2 } ->
Rev.equal a.rev rev && Rev.equal a.parent1 parent1 && Rev.equal a.parent2 parent2
| Octopus_merge a, Octopus_merge { rev; parent1; parent2; parent3; other_parents } ->
Rev.equal a.rev rev
&& Rev.equal a.parent1 parent1
&& Rev.equal a.parent2 parent2
&& Rev.equal a.parent3 parent3
&& List.equal ~eq:Rev.equal a.other_parents other_parents
| (Root _ | Commit _ | Merge _ | Octopus_merge _), _ -> false
;;
let rev = function
| Root { rev } | Commit { rev; _ } | Merge { rev; _ } | Octopus_merge { rev; _ } ->
rev
;;
let parents = function
| Root { rev = _ } -> []
| Commit { rev = _; parent } -> [ parent ]
| Merge { rev = _; parent1; parent2 } -> [ parent1; parent2 ]
| Octopus_merge { rev = _; parent1; parent2; parent3; other_parents } ->
parent1 :: parent2 :: parent3 :: other_parents
;;
let parent_count = function
| Root { rev = _ } -> 0
| Commit { rev = _; parent = _ } -> 1
| Merge { rev = _; parent1 = _; parent2 = _ } -> 2
| Octopus_merge { rev = _; parent1 = _; parent2 = _; parent3 = _; other_parents } ->
3 + List.length other_parents
;;
let create ~rev ~parents =
match parents with
| [] -> Root { rev }
| [ parent ] -> Commit { rev; parent }
| [ parent1; parent2 ] -> Merge { rev; parent1; parent2 }
| parent1 :: parent2 :: parent3 :: other_parents ->
Octopus_merge { rev; parent1; parent2; parent3; other_parents }
;;
end
module T = struct
[@@@coverage off]
type t = Line.t list
let to_dyn t = Dyn.list Line.to_dyn t
let sexp_of_t t = sexp_of_list Line.sexp_of_t t
let equal a b = List.equal a b ~eq:Line.equal
end
include T
let roots (t : t) =
List.filter_map t ~f:(fun line ->
match (line : Line.t) with
| Root { rev } -> Some rev
| Commit _ | Merge _ | Octopus_merge _ -> None)
;;