1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*    Hongbo Zhang (University of Pennsylvania)                           *)
6(*                                                                        *)
7(*   Copyright 2007 Institut National de Recherche en Informatique et     *)
8(*     en Automatique.                                                    *)
9(*                                                                        *)
10(*   All rights reserved.  This file is distributed under the terms of    *)
11(*   the GNU Lesser General Public License version 2.1, with the          *)
12(*   special exception on linking described in the file LICENSE.          *)
13(*                                                                        *)
14(**************************************************************************)
15
16
17(*
18  This module is mainly used to diff two parsetree, it helps to automate the
19  test for parsing/pprintast.ml
20 *)
21
22
23open Parsetree
24let curry f (g, h) = f g h
25let eq_int : (int*int)->bool = curry (=)
26let eq_char : (char*char)->bool=curry (=)
27let eq_string : (string*string)->bool = curry (=)
28let eq_int32 : (int32*int32)->bool=curry (=)
29let eq_int64 : (int64*int64)->bool =curry (=)
30let eq_nativeint : (nativeint*nativeint)->bool= curry (=)
31let eq_bool :(bool*bool) -> bool = curry (=)
32let eq_list mf_a (xs, ys) =
33  let rec loop =
34    function
35      | ([], []) -> true
36        | (x :: xs, y :: ys) -> (mf_a (x, y)) && (loop (xs, ys))
37        | (_, _) -> false
38  in loop (xs, ys)
39let eq_option mf_a (x, y) =
40  match (x, y) with
41  | (None, None) -> true
42  | (Some x, Some y) -> mf_a (x, y)
43  | (_, _) -> false
44
45module Location =struct
46  include Location
47  let eq_t : (t*t) -> bool = fun (_,_) -> true
48end
49module Longident = struct
50  include Longident
51  let rec eq_t : (t * t) -> 'result =
52    function
53    | (Lident a0, Lident b0) -> eq_string (a0, b0)
54    | (Ldot (a0, a1), Ldot (b0, b1)) ->
55      (eq_t (a0, b0)) && (eq_string (a1, b1))
56    | (Lapply (a0, a1), Lapply (b0, b1)) ->
57      (eq_t (a0, b0)) && (eq_t (a1, b1))
58    | (_, _) -> false
59end
60module Asttypes = struct
61  open Asttypes
62  let eq_constant : (constant * constant) -> 'result =
63    function
64    | (Const_int a0, Const_int b0) -> eq_int (a0, b0)
65    | (Const_char a0, Const_char b0) -> eq_char (a0, b0)
66    | (Const_string a0, Const_string b0) -> eq_string (a0, b0)
67    | (Const_float a0, Const_float b0) -> eq_string (a0, b0)
68    | (Const_int32 a0, Const_int32 b0) -> eq_int32 (a0, b0)
69    | (Const_int64 a0, Const_int64 b0) -> eq_int64 (a0, b0)
70    | (Const_nativeint a0, Const_nativeint b0) -> eq_nativeint (a0, b0)
71    | (_, _) -> false
72
73  let eq_rec_flag : (rec_flag * rec_flag) -> 'result =
74    function
75    | (Nonrecursive, Nonrecursive) -> true
76    | (Recursive, Recursive) -> true
77    | (Default, Default) -> true
78    | (_, _) -> false
79
80  let eq_direction_flag :
81    (direction_flag * direction_flag) -> 'result =
82    function
83    | (Upto, Upto) -> true
84    | (Downto, Downto) -> true
85    | (_, _) -> false
86
87  let eq_private_flag : (private_flag * private_flag) -> 'result =
88    function
89    | (Private, Private) -> true
90    | (Public, Public) -> true
91    | (_, _) -> false
92
93  let eq_mutable_flag : (mutable_flag * mutable_flag) -> 'result =
94    function
95    | (Immutable, Immutable) -> true
96    | (Mutable, Mutable) -> true
97    | (_, _) -> false
98
99  let eq_virtual_flag : (virtual_flag * virtual_flag) -> 'result =
100    function
101    | (Virtual, Virtual) -> true
102    | (Concrete, Concrete) -> true
103    | (_, _) -> false
104
105  let eq_override_flag : (override_flag * override_flag) -> 'result =
106    function
107    | (Override, Override) -> true
108    | (Fresh, Fresh) -> true
109    | (_, _) -> false
110
111  let eq_closed_flag : (closed_flag * closed_flag) -> 'result =
112    function
113    | (Closed, Closed) -> true
114    | (Open, Open) -> true
115    | (_, _) -> false
116
117  let eq_label : (label * label) -> 'result =
118    fun (a0, a1) -> eq_string (a0, a1)
119
120  let  eq_loc :
121    'all_a0.
122      (('all_a0 * 'all_a0) -> 'result) ->
123        (('all_a0 loc) * ('all_a0 loc)) -> 'result =
124    fun mf_a ({ txt = a0; loc = a1 }, { txt = b0; loc = b1 }) ->
125      (mf_a (a0, b0)) && (Location.eq_t (a1, b1))
126
127end
128
129let rec eq_row_field : (row_field * row_field) -> 'result =
130  function
131  | (Rtag (a0, a1, a2), Rtag (b0, b1, b2)) ->
132      ((Asttypes.eq_label (a0, b0)) && (eq_bool (a1, b1))) &&
133        (eq_list eq_core_type (a2, b2))
134  | (Rinherit a0, Rinherit b0) -> eq_core_type (a0, b0)
135  | (_, _) -> false
136and eq_core_field_desc :
137  (core_field_desc * core_field_desc) -> 'result =
138  function
139  | (Pfield (a0, a1), Pfield (b0, b1)) ->
140      (eq_string (a0, b0)) && (eq_core_type (a1, b1))
141  | (Pfield_var, Pfield_var) -> true
142  | (_, _) -> false
143and eq_core_field_type :
144  (core_field_type * core_field_type) -> 'result =
145  fun
146    ({ pfield_desc = a0; pfield_loc = a1 },
147     { pfield_desc = b0; pfield_loc = b1 })
148    -> (eq_core_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
149and eq_package_type : (package_type * package_type) -> 'result =
150  fun (a0, a1) ->
151    (fun ((a0, a1), (b0, b1)) ->
152       (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
153         (eq_list
154            (fun ((a0, a1), (b0, b1)) ->
155               (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
156                 (eq_core_type (a1, b1)))
157            (a1, b1)))
158      (a0, a1)
159and eq_core_type_desc :
160  (core_type_desc * core_type_desc) -> 'result =
161  function
162  | (Ptyp_any, Ptyp_any) -> true
163  | (Ptyp_var a0, Ptyp_var b0) -> eq_string (a0, b0)
164  | (Ptyp_arrow (a0, a1, a2), Ptyp_arrow (b0, b1, b2)) ->
165      ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
166        (eq_core_type (a2, b2))
167  | (Ptyp_tuple a0, Ptyp_tuple b0) -> eq_list eq_core_type (a0, b0)
168  | (Ptyp_constr (a0, a1), Ptyp_constr (b0, b1)) ->
169      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
170        (eq_list eq_core_type (a1, b1))
171  | (Ptyp_object a0, Ptyp_object b0) ->
172      eq_list eq_core_field_type (a0, b0)
173  | (Ptyp_class (a0, a1, a2), Ptyp_class (b0, b1, b2)) ->
174      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
175         (eq_list eq_core_type (a1, b1)))
176        && (eq_list Asttypes.eq_label (a2, b2))
177  | (Ptyp_alias (a0, a1), Ptyp_alias (b0, b1)) ->
178      (eq_core_type (a0, b0)) && (eq_string (a1, b1))
179  | (Ptyp_variant (a0, a1, a2), Ptyp_variant (b0, b1, b2)) ->
180      ((eq_list eq_row_field (a0, b0)) && (eq_bool (a1, b1))) &&
181        (eq_option (eq_list Asttypes.eq_label) (a2, b2))
182  | (Ptyp_poly (a0, a1), Ptyp_poly (b0, b1)) ->
183      (eq_list eq_string (a0, b0)) && (eq_core_type (a1, b1))
184  | (Ptyp_package a0, Ptyp_package b0) -> eq_package_type (a0, b0)
185  | (_, _) -> false
186and eq_core_type : (core_type * core_type) -> 'result =
187  fun
188    ({ ptyp_desc = a0; ptyp_loc = a1 },
189     { ptyp_desc = b0; ptyp_loc = b1 })
190    -> (eq_core_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
191
192let eq_class_infos :
193  'all_a0.
194    (('all_a0 * 'all_a0) -> 'result) ->
195      (('all_a0 class_infos) * ('all_a0 class_infos)) -> 'result =
196  fun mf_a
197    ({
198       pci_virt = a0;
199       pci_params = a1;
200       pci_name = a2;
201       pci_expr = a3;
202       pci_variance = a4;
203       pci_loc = a5
204     },
205     {
206       pci_virt = b0;
207       pci_params = b1;
208       pci_name = b2;
209       pci_expr = b3;
210       pci_variance = b4;
211       pci_loc = b5
212     })
213    ->
214    (((((Asttypes.eq_virtual_flag (a0, b0)) &&
215          ((fun ((a0, a1), (b0, b1)) ->
216              (eq_list (Asttypes.eq_loc eq_string) (a0, b0)) &&
217                (Location.eq_t (a1, b1)))
218             (a1, b1)))
219         && (Asttypes.eq_loc eq_string (a2, b2)))
220        && (mf_a (a3, b3)))
221       &&
222       (eq_list
223          (fun ((a0, a1), (b0, b1)) ->
224             (eq_bool (a0, b0)) && (eq_bool (a1, b1)))
225          (a4, b4)))
226      && (Location.eq_t (a5, b5))
227
228let rec eq_pattern_desc : (pattern_desc * pattern_desc) -> 'result =
229  function
230  | (Ppat_any, Ppat_any) -> true
231  | (Ppat_var a0, Ppat_var b0) -> Asttypes.eq_loc eq_string (a0, b0)
232  | (Ppat_alias (a0, a1), Ppat_alias (b0, b1)) ->
233      (eq_pattern (a0, b0)) && (Asttypes.eq_loc eq_string (a1, b1))
234  | (Ppat_constant a0, Ppat_constant b0) ->
235      Asttypes.eq_constant (a0, b0)
236  | (Ppat_tuple a0, Ppat_tuple b0) -> eq_list eq_pattern (a0, b0)
237  | (Ppat_construct (a0, a1), Ppat_construct (b0, b1)) ->
238      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
239         (eq_option eq_pattern (a1, b1)))
240  | (Ppat_variant (a0, a1), Ppat_variant (b0, b1)) ->
241      (Asttypes.eq_label (a0, b0)) && (eq_option eq_pattern (a1, b1))
242  | (Ppat_record (a0, a1), Ppat_record (b0, b1)) ->
243      (eq_list
244         (fun ((a0, a1), (b0, b1)) ->
245            (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
246              (eq_pattern (a1, b1)))
247         (a0, b0))
248        && (Asttypes.eq_closed_flag (a1, b1))
249  | (Ppat_array a0, Ppat_array b0) -> eq_list eq_pattern (a0, b0)
250  | (Ppat_or (a0, a1), Ppat_or (b0, b1)) ->
251      (eq_pattern (a0, b0)) && (eq_pattern (a1, b1))
252  | (Ppat_constraint (a0, a1), Ppat_constraint (b0, b1)) ->
253      (eq_pattern (a0, b0)) && (eq_core_type (a1, b1))
254  | (Ppat_type a0, Ppat_type b0) ->
255      Asttypes.eq_loc Longident.eq_t (a0, b0)
256  | (Ppat_lazy a0, Ppat_lazy b0) -> eq_pattern (a0, b0)
257  | (Ppat_unpack a0, Ppat_unpack b0) ->
258      Asttypes.eq_loc eq_string (a0, b0)
259  | (_, _) -> false
260and eq_pattern : (pattern * pattern) -> 'result =
261  fun
262    ({ ppat_desc = a0; ppat_loc = a1 },
263     { ppat_desc = b0; ppat_loc = b1 })
264    -> (eq_pattern_desc (a0, b0)) && (Location.eq_t (a1, b1))
265
266let rec eq_structure_item_desc :
267  (structure_item_desc * structure_item_desc) -> 'result =
268  function
269  | (Pstr_eval a0, Pstr_eval b0) -> eq_expression (a0, b0)
270  | (Pstr_value (a0, a1), Pstr_value (b0, b1)) ->
271      (Asttypes.eq_rec_flag (a0, b0)) &&
272        (eq_list
273           (fun ((a0, a1), (b0, b1)) ->
274              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
275           (a1, b1))
276  | (Pstr_primitive (a0, a1), Pstr_primitive (b0, b1)) ->
277      (Asttypes.eq_loc eq_string (a0, b0)) &&
278        (eq_value_description (a1, b1))
279  | (Pstr_type (a0, a1), Pstr_type (b0, b1)) ->
280      (Asttypes.eq_rec_flag (a0, b0)) &&
281      eq_list
282        (fun ((a0, a1), (b0, b1)) ->
283           (Asttypes.eq_loc eq_string (a0, b0)) &&
284             (eq_type_declaration (a1, b1)))
285        (a1, b1)
286  | (Pstr_exception (a0, a1), Pstr_exception (b0, b1)) ->
287      (Asttypes.eq_loc eq_string (a0, b0)) &&
288        (eq_exception_declaration (a1, b1))
289  | (Pstr_exn_rebind (a0, a1), Pstr_exn_rebind (b0, b1)) ->
290      (Asttypes.eq_loc eq_string (a0, b0)) &&
291        (Asttypes.eq_loc Longident.eq_t (a1, b1))
292  | (Pstr_module (a0, a1), Pstr_module (b0, b1)) ->
293      (Asttypes.eq_loc eq_string (a0, b0)) &&
294        (eq_module_expr (a1, b1))
295  | (Pstr_recmodule a0, Pstr_recmodule b0) ->
296      eq_list
297        (fun ((a0, a1, a2), (b0, b1, b2)) ->
298           ((Asttypes.eq_loc eq_string (a0, b0)) &&
299              (eq_module_type (a1, b1)))
300             && (eq_module_expr (a2, b2)))
301        (a0, b0)
302  | (Pstr_modtype (a0, a1), Pstr_modtype (b0, b1)) ->
303      (Asttypes.eq_loc eq_string (a0, b0)) &&
304        (eq_module_type (a1, b1))
305  | (Pstr_open a0, Pstr_open b0) ->
306      Asttypes.eq_loc Longident.eq_t (a0, b0)
307  | (Pstr_class a0, Pstr_class b0) ->
308      eq_list eq_class_declaration (a0, b0)
309  | (Pstr_class_type a0, Pstr_class_type b0) ->
310      eq_list eq_class_type_declaration (a0, b0)
311  | (Pstr_include a0, Pstr_include b0) -> eq_module_expr (a0, b0)
312  | (_, _) -> false
313and eq_structure_item :
314  (structure_item * structure_item) -> 'result =
315  fun
316    ({ pstr_desc = a0; pstr_loc = a1 },
317     { pstr_desc = b0; pstr_loc = b1 })
318    -> (eq_structure_item_desc (a0, b0)) && (Location.eq_t (a1, b1))
319and eq_structure : (structure * structure) -> 'result =
320  fun (a0, a1) -> eq_list eq_structure_item (a0, a1)
321and eq_module_expr_desc :
322  (module_expr_desc * module_expr_desc) -> 'result =
323  function
324  | (Pmod_ident a0, Pmod_ident b0) ->
325      Asttypes.eq_loc Longident.eq_t (a0, b0)
326  | (Pmod_structure a0, Pmod_structure b0) -> eq_structure (a0, b0)
327  | (Pmod_functor (a0, a1, a2), Pmod_functor (b0, b1, b2)) ->
328      ((Asttypes.eq_loc eq_string (a0, b0)) &&
329         (eq_module_type (a1, b1)))
330        && (eq_module_expr (a2, b2))
331  | (Pmod_apply (a0, a1), Pmod_apply (b0, b1)) ->
332      (eq_module_expr (a0, b0)) && (eq_module_expr (a1, b1))
333  | (Pmod_constraint (a0, a1), Pmod_constraint (b0, b1)) ->
334      (eq_module_expr (a0, b0)) && (eq_module_type (a1, b1))
335  | (Pmod_unpack a0, Pmod_unpack b0) -> eq_expression (a0, b0)
336  | (_, _) -> false
337and eq_module_expr : (module_expr * module_expr) -> 'result =
338  fun
339    ({ pmod_desc = a0; pmod_loc = a1 },
340     { pmod_desc = b0; pmod_loc = b1 })
341    -> (eq_module_expr_desc (a0, b0)) && (Location.eq_t (a1, b1))
342and eq_with_constraint :
343  (with_constraint * with_constraint) -> 'result =
344  function
345  | (Pwith_type a0, Pwith_type b0) -> eq_type_declaration (a0, b0)
346  | (Pwith_module a0, Pwith_module b0) ->
347      Asttypes.eq_loc Longident.eq_t (a0, b0)
348  | (Pwith_typesubst a0, Pwith_typesubst b0) ->
349      eq_type_declaration (a0, b0)
350  | (Pwith_modsubst a0, Pwith_modsubst b0) ->
351      Asttypes.eq_loc Longident.eq_t (a0, b0)
352  | (_, _) -> false
353and eq_modtype_declaration :
354  (modtype_declaration * modtype_declaration) -> 'result =
355  function
356  | (Pmodtype_abstract, Pmodtype_abstract) -> true
357  | (Pmodtype_manifest a0, Pmodtype_manifest b0) ->
358      eq_module_type (a0, b0)
359  | (_, _) -> false
360and eq_signature_item_desc :
361  (signature_item_desc * signature_item_desc) -> 'result =
362  function
363  | (Psig_value (a0, a1), Psig_value (b0, b1)) ->
364      (Asttypes.eq_loc eq_string (a0, b0)) &&
365        (eq_value_description (a1, b1))
366  | (Psig_type (a0, a1), Psig_type (b0, b1)) ->
367      (Asttypes.eq_rec_flag (a0, b0)) &&
368      eq_list
369        (fun ((a0, a1), (b0, b1)) ->
370           (Asttypes.eq_loc eq_string (a0, b0)) &&
371             (eq_type_declaration (a1, b1)))
372        (a1, b1)
373  | (Psig_exception (a0, a1), Psig_exception (b0, b1)) ->
374      (Asttypes.eq_loc eq_string (a0, b0)) &&
375        (eq_exception_declaration (a1, b1))
376  | (Psig_module (a0, a1), Psig_module (b0, b1)) ->
377      (Asttypes.eq_loc eq_string (a0, b0)) &&
378        (eq_module_type (a1, b1))
379  | (Psig_recmodule a0, Psig_recmodule b0) ->
380      eq_list
381        (fun ((a0, a1), (b0, b1)) ->
382           (Asttypes.eq_loc eq_string (a0, b0)) &&
383             (eq_module_type (a1, b1)))
384        (a0, b0)
385  | (Psig_modtype (a0, a1), Psig_modtype (b0, b1)) ->
386      (Asttypes.eq_loc eq_string (a0, b0)) &&
387        (eq_modtype_declaration (a1, b1))
388  | (Psig_open a0, Psig_open b0) ->
389      Asttypes.eq_loc Longident.eq_t (a0, b0)
390  | (Psig_include a0, Psig_include b0) -> eq_module_type (a0, b0)
391  | (Psig_class a0, Psig_class b0) ->
392      eq_list eq_class_description (a0, b0)
393  | (Psig_class_type a0, Psig_class_type b0) ->
394      eq_list eq_class_type_declaration (a0, b0)
395  | (_, _) -> false
396and eq_signature_item :
397  (signature_item * signature_item) -> 'result =
398  fun
399    ({ psig_desc = a0; psig_loc = a1 },
400     { psig_desc = b0; psig_loc = b1 })
401    -> (eq_signature_item_desc (a0, b0)) && (Location.eq_t (a1, b1))
402and eq_signature : (signature * signature) -> 'result =
403  fun (a0, a1) -> eq_list eq_signature_item (a0, a1)
404and eq_module_type_desc :
405  (module_type_desc * module_type_desc) -> 'result =
406  function
407  | (Pmty_ident a0, Pmty_ident b0) ->
408      Asttypes.eq_loc Longident.eq_t (a0, b0)
409  | (Pmty_signature a0, Pmty_signature b0) -> eq_signature (a0, b0)
410  | (Pmty_functor (a0, a1, a2), Pmty_functor (b0, b1, b2)) ->
411      ((Asttypes.eq_loc eq_string (a0, b0)) &&
412         (eq_module_type (a1, b1)))
413        && (eq_module_type (a2, b2))
414  | (Pmty_with (a0, a1), Pmty_with (b0, b1)) ->
415      (eq_module_type (a0, b0)) &&
416        (eq_list
417           (fun ((a0, a1), (b0, b1)) ->
418              (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
419                (eq_with_constraint (a1, b1)))
420           (a1, b1))
421  | (Pmty_typeof a0, Pmty_typeof b0) -> eq_module_expr (a0, b0)
422  | (_, _) -> false
423and eq_module_type : (module_type * module_type) -> 'result =
424  fun
425    ({ pmty_desc = a0; pmty_loc = a1 },
426     { pmty_desc = b0; pmty_loc = b1 })
427    -> (eq_module_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
428and eq_class_declaration :
429  (class_declaration * class_declaration) -> 'result =
430  fun (a0, a1) -> eq_class_infos eq_class_expr (a0, a1)
431and eq_class_field_desc :
432  (class_field_desc * class_field_desc) -> 'result =
433  function
434  | (Pcf_inher (a0, a1, a2), Pcf_inher (b0, b1, b2)) ->
435      ((Asttypes.eq_override_flag (a0, b0)) &&
436         (eq_class_expr (a1, b1)))
437        && (eq_option eq_string (a2, b2))
438  | (Pcf_valvirt a0, Pcf_valvirt b0) ->
439      (fun ((a0, a1, a2), (b0, b1, b2)) ->
440         ((Asttypes.eq_loc eq_string (a0, b0)) &&
441            (Asttypes.eq_mutable_flag (a1, b1)))
442           && (eq_core_type (a2, b2)))
443        (a0, b0)
444  | (Pcf_val a0, Pcf_val b0) ->
445      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
446         (((Asttypes.eq_loc eq_string (a0, b0)) &&
447             (Asttypes.eq_mutable_flag (a1, b1)))
448            && (Asttypes.eq_override_flag (a2, b2)))
449           && (eq_expression (a3, b3)))
450        (a0, b0)
451  | (Pcf_virt a0, Pcf_virt b0) ->
452      (fun ((a0, a1, a2), (b0, b1, b2)) ->
453         ((Asttypes.eq_loc eq_string (a0, b0)) &&
454            (Asttypes.eq_private_flag (a1, b1)))
455           && (eq_core_type (a2, b2)))
456        (a0, b0)
457  | (Pcf_meth a0, Pcf_meth b0) ->
458      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
459         (((Asttypes.eq_loc eq_string (a0, b0)) &&
460             (Asttypes.eq_private_flag (a1, b1)))
461            && (Asttypes.eq_override_flag (a2, b2)))
462           && (eq_expression (a3, b3)))
463        (a0, b0)
464  | (Pcf_constr a0, Pcf_constr b0) ->
465      (fun ((a0, a1), (b0, b1)) ->
466         (eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
467        (a0, b0)
468  | (Pcf_init a0, Pcf_init b0) -> eq_expression (a0, b0)
469  | (_, _) -> false
470and eq_class_field : (class_field * class_field) -> 'result =
471  fun
472    ({ pcf_desc = a0; pcf_loc = a1 }, { pcf_desc = b0; pcf_loc = b1
473     })
474    -> (eq_class_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
475and eq_class_structure :
476  (class_structure * class_structure) -> 'result =
477  fun
478    ({ pcstr_self = a0; pcstr_fields = a1 },
479     { pcstr_self = b0; pcstr_fields = b1 })
480    -> (eq_pattern (a0, b0)) && (eq_list eq_class_field (a1, b1))
481and eq_class_expr_desc :
482  (class_expr_desc * class_expr_desc) -> 'result =
483  function
484  | (Pcl_constr (a0, a1), Pcl_constr (b0, b1)) ->
485      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
486        (eq_list eq_core_type (a1, b1))
487  | (Pcl_structure a0, Pcl_structure b0) ->
488      eq_class_structure (a0, b0)
489  | (Pcl_fun (a0, a1, a2, a3), Pcl_fun (b0, b1, b2, b3)) ->
490      (((Asttypes.eq_label (a0, b0)) &&
491          (eq_option eq_expression (a1, b1)))
492         && (eq_pattern (a2, b2)))
493        && (eq_class_expr (a3, b3))
494  | (Pcl_apply (a0, a1), Pcl_apply (b0, b1)) ->
495      (eq_class_expr (a0, b0)) &&
496        (eq_list
497           (fun ((a0, a1), (b0, b1)) ->
498              (Asttypes.eq_label (a0, b0)) &&
499                (eq_expression (a1, b1)))
500           (a1, b1))
501  | (Pcl_let (a0, a1, a2), Pcl_let (b0, b1, b2)) ->
502      ((Asttypes.eq_rec_flag (a0, b0)) &&
503         (eq_list
504            (fun ((a0, a1), (b0, b1)) ->
505               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
506            (a1, b1)))
507        && (eq_class_expr (a2, b2))
508  | (Pcl_constraint (a0, a1), Pcl_constraint (b0, b1)) ->
509      (eq_class_expr (a0, b0)) && (eq_class_type (a1, b1))
510  | (_, _) -> false
511and eq_class_expr : (class_expr * class_expr) -> 'result =
512  fun
513    ({ pcl_desc = a0; pcl_loc = a1 }, { pcl_desc = b0; pcl_loc = b1
514     })
515    -> (eq_class_expr_desc (a0, b0)) && (Location.eq_t (a1, b1))
516and eq_class_type_declaration :
517  (class_type_declaration * class_type_declaration) -> 'result =
518  fun (a0, a1) -> eq_class_infos eq_class_type (a0, a1)
519and eq_class_description :
520  (class_description * class_description) -> 'result =
521  fun (a0, a1) -> eq_class_infos eq_class_type (a0, a1)
522and eq_class_type_field_desc :
523  (class_type_field_desc * class_type_field_desc) -> 'result =
524  function
525  | (Pctf_inher a0, Pctf_inher b0) -> eq_class_type (a0, b0)
526  | (Pctf_val a0, Pctf_val b0) ->
527      (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
528         (((eq_string (a0, b0)) &&
529             (Asttypes.eq_mutable_flag (a1, b1)))
530            && (Asttypes.eq_virtual_flag (a2, b2)))
531           && (eq_core_type (a3, b3)))
532        (a0, b0)
533  | (Pctf_virt a0, Pctf_virt b0) ->
534      (fun ((a0, a1, a2), (b0, b1, b2)) ->
535         ((eq_string (a0, b0)) && (Asttypes.eq_private_flag (a1, b1)))
536           && (eq_core_type (a2, b2)))
537        (a0, b0)
538  | (Pctf_meth a0, Pctf_meth b0) ->
539      (fun ((a0, a1, a2), (b0, b1, b2)) ->
540         ((eq_string (a0, b0)) && (Asttypes.eq_private_flag (a1, b1)))
541           && (eq_core_type (a2, b2)))
542        (a0, b0)
543  | (Pctf_cstr a0, Pctf_cstr b0) ->
544      (fun ((a0, a1), (b0, b1)) ->
545         (eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
546        (a0, b0)
547  | (_, _) -> false
548and eq_class_type_field :
549  (class_type_field * class_type_field) -> 'result =
550  fun
551    ({ pctf_desc = a0; pctf_loc = a1 },
552     { pctf_desc = b0; pctf_loc = b1 })
553    ->
554    (eq_class_type_field_desc (a0, b0)) && (Location.eq_t (a1, b1))
555and eq_class_signature :
556  (class_signature * class_signature) -> 'result =
557  fun
558    ({ pcsig_self = a0; pcsig_fields = a1; pcsig_loc = a2 },
559     { pcsig_self = b0; pcsig_fields = b1; pcsig_loc = b2 })
560    ->
561    ((eq_core_type (a0, b0)) &&
562       (eq_list eq_class_type_field (a1, b1)))
563      && (Location.eq_t (a2, b2))
564and eq_class_type_desc :
565  (class_type_desc * class_type_desc) -> 'result =
566  function
567  | (Pcty_constr (a0, a1), Pcty_constr (b0, b1)) ->
568      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
569        (eq_list eq_core_type (a1, b1))
570  | (Pcty_signature a0, Pcty_signature b0) ->
571      eq_class_signature (a0, b0)
572  | (Pcty_arrow (a0, a1, a2), Pcty_arrow (b0, b1, b2)) ->
573      ((Asttypes.eq_label (a0, b0)) && (eq_core_type (a1, b1))) &&
574        (eq_class_type (a2, b2))
575  | (_, _) -> false
576and eq_class_type : (class_type * class_type) -> 'result =
577  fun
578    ({ pcty_desc = a0; pcty_loc = a1 },
579     { pcty_desc = b0; pcty_loc = b1 })
580    -> (eq_class_type_desc (a0, b0)) && (Location.eq_t (a1, b1))
581and eq_exception_declaration :
582  (exception_declaration * exception_declaration) -> 'result =
583  fun (a0, a1) -> eq_list eq_core_type (a0, a1)
584and eq_type_kind : (type_kind * type_kind) -> 'result =
585  function
586  | (Ptype_abstract, Ptype_abstract) -> true
587  | (Ptype_variant a0, Ptype_variant b0) ->
588      eq_list
589        (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
590           (((Asttypes.eq_loc eq_string (a0, b0)) &&
591               (eq_list eq_core_type (a1, b1)))
592              && (eq_option eq_core_type (a2, b2)))
593             && (Location.eq_t (a3, b3)))
594        (a0, b0)
595  | (Ptype_record a0, Ptype_record b0) ->
596      eq_list
597        (fun ((a0, a1, a2, a3), (b0, b1, b2, b3)) ->
598           (((Asttypes.eq_loc eq_string (a0, b0)) &&
599               (Asttypes.eq_mutable_flag (a1, b1)))
600              && (eq_core_type (a2, b2)))
601             && (Location.eq_t (a3, b3)))
602        (a0, b0)
603  | (_, _) -> false
604and eq_type_declaration :
605  (type_declaration * type_declaration) -> 'result =
606  fun
607    ({
608       ptype_params = a0;
609       ptype_cstrs = a1;
610       ptype_kind = a2;
611       ptype_private = a3;
612       ptype_manifest = a4;
613       ptype_variance = a5;
614       ptype_loc = a6
615     },
616     {
617       ptype_params = b0;
618       ptype_cstrs = b1;
619       ptype_kind = b2;
620       ptype_private = b3;
621       ptype_manifest = b4;
622       ptype_variance = b5;
623       ptype_loc = b6
624     })
625    ->
626    ((((((eq_list (eq_option (Asttypes.eq_loc eq_string)) (a0, b0))
627           &&
628           (eq_list
629              (fun ((a0, a1, a2), (b0, b1, b2)) ->
630                 ((eq_core_type (a0, b0)) && (eq_core_type (a1, b1)))
631                   && (Location.eq_t (a2, b2)))
632              (a1, b1)))
633          && (eq_type_kind (a2, b2)))
634         && (Asttypes.eq_private_flag (a3, b3)))
635        && (eq_option eq_core_type (a4, b4)))
636       &&
637       (eq_list
638          (fun ((a0, a1), (b0, b1)) ->
639             (eq_bool (a0, b0)) && (eq_bool (a1, b1)))
640          (a5, b5)))
641      && (Location.eq_t (a6, b6))
642and eq_value_description :
643  (value_description * value_description) -> 'result =
644  fun
645    ({ pval_type = a0; pval_prim = a1; pval_loc = a2 },
646     { pval_type = b0; pval_prim = b1; pval_loc = b2 })
647    ->
648    ((eq_core_type (a0, b0)) && (eq_list eq_string (a1, b1))) &&
649      (Location.eq_t (a2, b2))
650and eq_expression_desc :
651  (expression_desc * expression_desc) -> 'result =
652  function
653  | (Pexp_ident a0, Pexp_ident b0) ->
654      Asttypes.eq_loc Longident.eq_t (a0, b0)
655  | (Pexp_constant a0, Pexp_constant b0) ->
656      Asttypes.eq_constant (a0, b0)
657  | (Pexp_let (a0, a1, a2), Pexp_let (b0, b1, b2)) ->
658      ((Asttypes.eq_rec_flag (a0, b0)) &&
659         (eq_list
660            (fun ((a0, a1), (b0, b1)) ->
661               (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
662            (a1, b1)))
663        && (eq_expression (a2, b2))
664  | Pexp_fun (a1, a1, a2, a3), Pexp_function (b0, b1, b2, b3) ->
665      ((Asttypes.eq_label (a0, b0)) &&
666       (eq_option eq_expression (a1, b1)) &&
667       (eq_pattern a2 b2) &&
668       (eq_expression (a3, b3)))
669  | (Pexp_function (a0, a1, a2), Pexp_function (b0, b1, b2)) ->
670      (* FIX *)
671      eq_list
672        (fun ((a0, a1), (b0, b1)) ->
673          (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
674        (a2, b2)
675  | (Pexp_apply (a0, a1), Pexp_apply (b0, b1)) ->
676      (eq_expression (a0, b0)) &&
677        (eq_list
678           (fun ((a0, a1), (b0, b1)) ->
679              (Asttypes.eq_label (a0, b0)) &&
680                (eq_expression (a1, b1)))
681           (a1, b1))
682  | (Pexp_match (a0, a1), Pexp_match (b0, b1)) ->
683      (eq_expression (a0, b0)) &&
684        (eq_list
685           (fun ((a0, a1), (b0, b1)) ->
686              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
687           (a1, b1))
688  | (Pexp_try (a0, a1), Pexp_try (b0, b1)) ->
689      (eq_expression (a0, b0)) &&
690        (eq_list
691           (fun ((a0, a1), (b0, b1)) ->
692              (eq_pattern (a0, b0)) && (eq_expression (a1, b1)))
693           (a1, b1))
694  | (Pexp_tuple a0, Pexp_tuple b0) -> eq_list eq_expression (a0, b0)
695  | (Pexp_construct (a0, a1), Pexp_construct (b0, b1)) ->
696      ((Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
697         (eq_option eq_expression (a1, b1)))
698  | (Pexp_variant (a0, a1), Pexp_variant (b0, b1)) ->
699      (Asttypes.eq_label (a0, b0)) &&
700        (eq_option eq_expression (a1, b1))
701  | (Pexp_record (a0, a1), Pexp_record (b0, b1)) ->
702      (eq_list
703         (fun ((a0, a1), (b0, b1)) ->
704            (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
705              (eq_expression (a1, b1)))
706         (a0, b0))
707        && (eq_option eq_expression (a1, b1))
708  | (Pexp_field (a0, a1), Pexp_field (b0, b1)) ->
709      (eq_expression (a0, b0)) &&
710        (Asttypes.eq_loc Longident.eq_t (a1, b1))
711  | (Pexp_setfield (a0, a1, a2), Pexp_setfield (b0, b1, b2)) ->
712      ((eq_expression (a0, b0)) &&
713         (Asttypes.eq_loc Longident.eq_t (a1, b1)))
714        && (eq_expression (a2, b2))
715  | (Pexp_array a0, Pexp_array b0) -> eq_list eq_expression (a0, b0)
716  | (Pexp_ifthenelse (a0, a1, a2), Pexp_ifthenelse (b0, b1, b2)) ->
717      ((eq_expression (a0, b0)) && (eq_expression (a1, b1))) &&
718        (eq_option eq_expression (a2, b2))
719  | (Pexp_sequence (a0, a1), Pexp_sequence (b0, b1)) ->
720      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
721  | (Pexp_while (a0, a1), Pexp_while (b0, b1)) ->
722      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
723  | (Pexp_for (a0, a1, a2, a3, a4), Pexp_for (b0, b1, b2, b3, b4)) ->
724      ((((Asttypes.eq_loc eq_string (a0, b0)) &&
725           (eq_expression (a1, b1)))
726          && (eq_expression (a2, b2)))
727         && (Asttypes.eq_direction_flag (a3, b3)))
728        && (eq_expression (a4, b4))
729  | (Pexp_constraint (a0, a1, a2), Pexp_constraint (b0, b1, b2)) ->
730      ((eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1)))
731        && (eq_option eq_core_type (a2, b2))
732  | (Pexp_when (a0, a1), Pexp_when (b0, b1)) ->
733      (eq_expression (a0, b0)) && (eq_expression (a1, b1))
734  | (Pexp_send (a0, a1), Pexp_send (b0, b1)) ->
735      (eq_expression (a0, b0)) && (eq_string (a1, b1))
736  | (Pexp_new a0, Pexp_new b0) ->
737      Asttypes.eq_loc Longident.eq_t (a0, b0)
738  | (Pexp_setinstvar (a0, a1), Pexp_setinstvar (b0, b1)) ->
739      (Asttypes.eq_loc eq_string (a0, b0)) &&
740        (eq_expression (a1, b1))
741  | (Pexp_override a0, Pexp_override b0) ->
742      eq_list
743        (fun ((a0, a1), (b0, b1)) ->
744           (Asttypes.eq_loc eq_string (a0, b0)) &&
745             (eq_expression (a1, b1)))
746        (a0, b0)
747  | (Pexp_letmodule (a0, a1, a2), Pexp_letmodule (b0, b1, b2)) ->
748      ((Asttypes.eq_loc eq_string (a0, b0)) &&
749         (eq_module_expr (a1, b1)))
750        && (eq_expression (a2, b2))
751  | (Pexp_assert a0, Pexp_assert b0) -> eq_expression (a0, b0)
752  | (Pexp_lazy a0, Pexp_lazy b0) -> eq_expression (a0, b0)
753  | (Pexp_poly (a0, a1), Pexp_poly (b0, b1)) ->
754      (eq_expression (a0, b0)) && (eq_option eq_core_type (a1, b1))
755  | (Pexp_object a0, Pexp_object b0) -> eq_class_structure (a0, b0)
756  | (Pexp_newtype (a0, a1), Pexp_newtype (b0, b1)) ->
757      (eq_string (a0, b0)) && (eq_expression (a1, b1))
758  | (Pexp_pack a0, Pexp_pack b0) -> eq_module_expr (a0, b0)
759  | (Pexp_open (a0, a1), Pexp_open (b0, b1)) ->
760      (Asttypes.eq_loc Longident.eq_t (a0, b0)) &&
761        (eq_expression (a1, b1))
762  | (_, _) -> false
763and eq_expression : (expression * expression) -> 'result =
764  fun
765    ({ pexp_desc = a0; pexp_loc = a1 },
766     { pexp_desc = b0; pexp_loc = b1 })
767    -> (eq_expression_desc (a0, b0)) && (Location.eq_t (a1, b1))
768
769let rec eq_directive_argument :
770  (directive_argument * directive_argument) -> 'result =
771  function
772  | (Pdir_none, Pdir_none) -> true
773  | (Pdir_string a0, Pdir_string b0) -> eq_string (a0, b0)
774  | (Pdir_int a0, Pdir_int b0) -> eq_int (a0, b0)
775  | (Pdir_ident a0, Pdir_ident b0) -> Longident.eq_t (a0, b0)
776  | (Pdir_bool a0, Pdir_bool b0) -> eq_bool (a0, b0)
777  | (_, _) -> false
778and eq_toplevel_phrase :
779  (toplevel_phrase * toplevel_phrase) -> 'result =
780  function
781  | (Ptop_def a0, Ptop_def b0) -> eq_structure (a0, b0)
782  | (Ptop_dir (a0, a1), Ptop_dir (b0, b1)) ->
783      (eq_string (a0, b0)) && (eq_directive_argument (a1, b1))
784  | (_, _) -> false
785