Commits

camlspotter  committed 5beac40

ported to 4.01.0

  • Participants
  • Parent commits a77f78a
  • Branches 4.01.0

Comments (0)

Files changed (8)

-^.*\.(cm.*)$
+^.*\.(cm.*|annot)$
 ^.*~$
-
+overload/main.ml
+overload/poorman
+overload/untypeast.ml
+overload/untypeast.mli
+retype/main.ml
+retype/retype
+retype/untypeast.ml
+retype/untypeast.mli
+vanilla/main.ml
+vanilla/optmain.ml
+vanilla/vanilla
+vanilla/vanillaopt
 A safe but strange way of modifying OCaml compiler
 =====================================================
 
+*Note: updated version for OCaml 4.01.0 is availabe in 4.01.0 branch*
+
 OCaml 4.00.0 is out! Have you tried it? GADT? Better first class modules? More warnings?
 
 I am talking something different, something more exciting at least for me. Compiler-libs.
 
 Anyway, building and playing this mod is very easy::
 
-    $ cd overlaod
+    $ cd overload
     $ make
 
 It creates a bytecode compiler ``poorman``. Well, compared to the full overloading by type classes, this is very simple, a poorman's overloading solution. We have a test code at ``test/test.ml`` so you can try compiling it by ``poorman``::

File overload/Makefile

 # Various commands and dir
 ##########################
 CAMLRUN= ocamlrun
-OCAMLC   = ocamlc -annot -bin-annot -w A-4-9 -warn-error A-4-9-10-27-32-33-34-39
-OCAMLOPT = ocamlopt -annot -bin-annot -w A-4-9 -warn-error A-4-9-32-33-34
+OCAMLC   = ocamlc -bin-annot -w A-4-9 -warn-error A-4-9-10-27-32-33-34-39-45
+OCAMLOPT = ocamlopt -bin-annot -w A-4-9 -warn-error A-4-9-32-33-34-45
 OCAMLDEP = ocamldep
 OCAMLLEX = ocamllex
 OCAMLYACC= ocamlyacc
 # Requires unix!
 COMPFLAGS= $(INCLUDES_DEP) -I +unix
 
-MODULES= ttmap untypeast pprintast mod compile main
+MODULES= ttmap untypeast mod compile main
 
 OBJS=		$(addsuffix .cmo, $(MODULES))
 
 untypeast.mli: ../ocaml/tools/untypeast.mli
 	cp $< $@
 
-pprintast.ml: ../ocaml/tools/pprintast.ml
-	cp $< $@
-
-beforedepend:: main.ml untypeast.ml untypeast.mli pprintast.ml
+beforedepend:: main.ml untypeast.ml untypeast.mli
 
 clean::
-	rm -f main.ml untypeast.ml untypeast.mli pprintast.ml
+	rm -f main.ml untypeast.ml untypeast.mli
 
 # generic rules :
 #################

File overload/compile.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: compile.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
-
 (* The batch compiler *)
 
 open Misc
 open Config
 open Format
 open Typedtree
-
-(* Initialize the search path.
-   The current directory is always searched first,
-   then the directories specified with the -I option (in command-line order),
-   then the standard library directory (unless the -nostdlib option is given).
- *)
-
-let init_path () =
-  let dirs =
-    if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
-    else if !Clflags.use_vmthreads then "+vmthreads" :: !Clflags.include_dirs
-    else !Clflags.include_dirs in
-  let exp_dirs =
-    List.map (expand_directory Config.standard_library) dirs in
-  load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
-  Env.reset_cache ()
-
-(* Return the initial environment in which compilation proceeds. *)
-
-(* Note: do not do init_path() in initial_env, this breaks
-   toplevel initialization (PR#1775) *)
-let initial_env () =
-  Ident.reinit();
-  try
-    if !Clflags.nopervasives
-    then Env.initial
-    else Env.open_pers_signature "Pervasives" Env.initial
-  with Not_found ->
-    fatal_error "cannot open pervasives.cmi"
-
-(* Note: this function is duplicated in optcompile.ml *)
-let check_unit_name ppf filename name =
-  try
-    begin match name.[0] with
-    | 'A'..'Z' -> ()
-    | _ ->
-       Location.print_warning (Location.in_file filename) ppf
-        (Warnings.Bad_module_name name);
-       raise Exit;
-    end;
-    for i = 1 to String.length name - 1 do
-      match name.[i] with
-      | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> ()
-      | _ ->
-         Location.print_warning (Location.in_file filename) ppf
-           (Warnings.Bad_module_name name);
-         raise Exit;
-    done;
-  with Exit -> ()
-;;
+open Compenv
 
 (* Compile a .mli file *)
 
 let interface ppf sourcefile outputprefix =
   Location.input_name := sourcefile;
-  init_path ();
+  Compmisc.init_path false;
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
   check_unit_name ppf sourcefile modulename;
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
-  let initial_env = initial_env () in
+  let initial_env = Compmisc.initial_env () in
   try
     let ast =
       Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
     if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
+    if !Clflags.dump_source then fprintf ppf "%a@." Pprintast.signature ast;
     let tsg = Typemod.transl_signature initial_env ast in
+    if !Clflags.dump_typedtree then fprintf ppf "%a@." Printtyped.interface tsg;
+    let sg = tsg.sig_type in
     if !Clflags.print_types then
-      fprintf std_formatter "%a@." Printtyp.signature
-                                   (Typemod.simplify_signature tsg.sig_type);
+      Printtyp.wrap_printing_env initial_env (fun () ->
+        fprintf std_formatter "%a@."
+          Printtyp.signature (Typemod.simplify_signature sg));
+    ignore (Includemod.signatures initial_env sg sg);
+    Typecore.force_delayed_checks ();
     Warnings.check_fatal ();
     if not !Clflags.print_types then begin
-      let sg = Env.save_signature tsg.sig_type modulename (outputprefix ^ ".cmi") in
+      let sg = Env.save_signature sg modulename (outputprefix ^ ".cmi") in
       Typemod.save_signature modulename tsg outputprefix sourcefile
-       initial_env sg ;
+        initial_env sg ;
     end;
     Pparse.remove_preprocessed inputfile
   with e ->
-    Pparse.remove_preprocessed_if_ast inputfile;
+    Pparse.remove_preprocessed inputfile;
     raise e
 
 (* Compile a .ml file *)
 
 let implementation ppf sourcefile outputprefix =
   Location.input_name := sourcefile;
-  init_path ();
+  Compmisc.init_path false;
   let modulename =
     String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
   check_unit_name ppf sourcefile modulename;
   Env.set_unit_name modulename;
   let inputfile = Pparse.preprocess sourcefile in
-  let env = initial_env() in
+  let env = Compmisc.initial_env() in
   if !Clflags.print_types then begin
     try ignore(
       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
-      ++ Typemod.type_implementation sourcefile outputprefix modulename env);
+      ++ print_if ppf Clflags.dump_source Pprintast.structure
+      ++ Typemod.type_implementation sourcefile outputprefix modulename env
+      ++ print_if ppf Clflags.dump_typedtree
+           Printtyped.implementation_with_coercion);
       Warnings.check_fatal ();
       Pparse.remove_preprocessed inputfile;
       Stypes.dump (Some (outputprefix ^ ".annot"));
     with x ->
-      Pparse.remove_preprocessed_if_ast inputfile;
+      Pparse.remove_preprocessed inputfile;
       Stypes.dump (Some (outputprefix ^ ".annot"));
       raise x
   end else begin
     try
       Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
       ++ print_if ppf Clflags.dump_parsetree Printast.implementation
+      ++ print_if ppf Clflags.dump_source Pprintast.structure
       ++ Typemod.type_implementation sourcefile outputprefix modulename env
-      ++ (fun (str, _) -> Mod.structure str)
+      ++ print_if ppf Clflags.dump_typedtree
+                  Printtyped.implementation_with_coercion
+
+      ++ (fun (str, _)   -> Mod.structure str)
       ++ (fun str -> 
         let ptree =  Untypeast.untype_structure str in
         Format.eprintf "%a@." Pprintast.structure ptree;
         ptree)
       ++ Typemod.type_implementation sourcefile outputprefix modulename env
+
       ++ Translmod.transl_implementation modulename
       ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
       ++ Simplif.simplify_lambda
     with x ->
       close_out oc;
       remove_file objfile;
-      Pparse.remove_preprocessed_if_ast inputfile;
+      Pparse.remove_preprocessed inputfile;
       Stypes.dump (Some (outputprefix ^ ".annot"));
       raise x
   end

File overload/mod.ml

         exp_type = exp.exp_type }
   | _ -> failwith "overload resolution failed: too ambiguous" 
 
-class map = object (self)
-  inherit Ttmap.map as super
+class map = object
+  inherit [unit] Ttmap.omap_pattern as super
 
-  method! expression = function
+  method ref f () r = 
+    let c = !r in
+    let (), c' = f () c in
+    let r' = if c == c' then r else ref c' in
+    (), r'
+
+  method option f () = function
+    | None -> (), None
+    | (Some v as o) -> 
+        let (), v' = f () v in
+        (), if v = v' then o else Some v'
+
+  method list f () xs = 
+    let xs' = List.map (fun x -> snd (f () x)) xs in
+    (), if List.for_all2 (==) xs xs' then xs else xs'
+
+  method! expression () = function
     | ({ exp_desc= Texp_ident (path, lidloc, vdesc) } as e)-> 
         begin match vdesc.val_kind with
         | Val_prim { Primitive.prim_name = "OVERLOADED" } ->
-            self, resolve_overloading e lidloc path
-        | _ -> super#expression e
+            (), resolve_overloading e lidloc path
+        | _ -> super#expression () e
         end
-    | e -> super#expression e
+    | e -> super#expression () e
 end
 
 let structure str = 
   let o = new map in
-  let _, str =  o#structure str in
+  let _, str =  o#structure () str in
   str
 

File overload/ttmap.ml

 open Typedtree
 
+class virtual ['st] omap_pattern =
+  object (self)
+    method virtual ref :
+      'a1. ('st -> 'a1 -> ('st * 'a1)) -> 'st -> 'a1 ref -> ('st * ('a1 ref))
+    method virtual option :
+      'a1.
+        ('st -> 'a1 -> ('st * 'a1)) ->
+          'st -> 'a1 option -> ('st * ('a1 option))
+    method virtual list :
+      'a1.
+        ('st -> 'a1 -> ('st * 'a1)) -> 'st -> 'a1 list -> ('st * ('a1 list))
+    method pattern : 'st -> pattern -> ('st * pattern) =
+      fun __st __value ->
+        let (__st, pat_desc) = self#pattern_desc __st __value.pat_desc in
+        let pat_loc = __value.pat_loc in
+        let (__st, pat_extra) =
+          self#list
+            (fun __st (((__x1, __x2) as __value)) ->
+               let (__st, __y1) = self#pat_extra __st __x1 in
+               let __y2 = __x2
+               in
+                 (__st,
+                  (if (__x2 == __y2) && (__x1 == __y1)
+                   then __value
+                   else (__y1, __y2))))
+            __st __value.pat_extra in
+        let pat_type = __value.pat_type in
+        let pat_env = __value.pat_env
+        in
+          (__st,
+           (if
+              (__value.pat_loc == pat_loc) &&
+                ((__value.pat_extra == pat_extra) &&
+                   ((__value.pat_type == pat_type) &&
+                      ((__value.pat_env == pat_env) &&
+                         (__value.pat_desc == pat_desc))))
+            then __value
+            else
+              {
+                pat_desc = pat_desc;
+                pat_loc = pat_loc;
+                pat_extra = pat_extra;
+                pat_type = pat_type;
+                pat_env = pat_env;
+              }))
+    method pat_extra : 'st -> pat_extra -> ('st * pat_extra) =
+      fun __st __value ->
+        match __value with
+        | Tpat_constraint __x1 ->
+            let (__st, __y1) = self#core_type __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Tpat_constraint __y1))
+        | Tpat_type (__x1, __x2) -> (__st, __value)
+        | Tpat_unpack -> (__st, __value)
+    method pattern_desc : 'st -> pattern_desc -> ('st * pattern_desc) =
+      fun __st __value ->
+        match __value with
+        | Tpat_any -> (__st, __value)
+        | Tpat_var (__x1, __x2) -> (__st, __value)
+        | Tpat_alias (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#pattern __st __x1 in
+            let __y2 = __x2 in
+            let __y3 = __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tpat_alias (__y1, __y2, __y3)))
+        | Tpat_constant __x1 -> (__st, __value)
+        | Tpat_tuple __x1 ->
+            let (__st, __y1) = self#list self#pattern __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tpat_tuple __y1))
+        | Tpat_construct (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#pattern __st __x3 in
+            let __y4 = __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Tpat_construct (__y1, __y2, __y3, __y4)))
+        | Tpat_variant (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#option self#pattern __st __x2 in
+            let (__st, __y3) = self#ref (fun __st v -> (__st, v)) __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tpat_variant (__y1, __y2, __y3)))
+        | Tpat_record (__x1, __x2) ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#pattern __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1 in
+            let __y2 = __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tpat_record (__y1, __y2)))
+        | Tpat_array __x1 ->
+            let (__st, __y1) = self#list self#pattern __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tpat_array __y1))
+        | Tpat_or (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#pattern __st __x1 in
+            let (__st, __y2) = self#pattern __st __x2 in
+            let (__st, __y3) =
+              self#option (fun __st v -> (__st, v)) __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tpat_or (__y1, __y2, __y3)))
+        | Tpat_lazy __x1 ->
+            let (__st, __y1) = self#pattern __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tpat_lazy __y1))
+    method expression : 'st -> expression -> ('st * expression) =
+      fun __st __value ->
+        let (__st, exp_desc) = self#expression_desc __st __value.exp_desc in
+        let exp_loc = __value.exp_loc in
+        let (__st, exp_extra) =
+          self#list
+            (fun __st (((__x1, __x2) as __value)) ->
+               let (__st, __y1) = self#exp_extra __st __x1 in
+               let __y2 = __x2
+               in
+                 (__st,
+                  (if (__x2 == __y2) && (__x1 == __y1)
+                   then __value
+                   else (__y1, __y2))))
+            __st __value.exp_extra in
+        let exp_type = __value.exp_type in
+        let exp_env = __value.exp_env
+        in
+          (__st,
+           (if
+              (__value.exp_loc == exp_loc) &&
+                ((__value.exp_extra == exp_extra) &&
+                   ((__value.exp_type == exp_type) &&
+                      ((__value.exp_env == exp_env) &&
+                         (__value.exp_desc == exp_desc))))
+            then __value
+            else
+              {
+                exp_desc = exp_desc;
+                exp_loc = exp_loc;
+                exp_extra = exp_extra;
+                exp_type = exp_type;
+                exp_env = exp_env;
+              }))
+    method exp_extra : 'st -> exp_extra -> ('st * exp_extra) =
+      fun __st __value ->
+        match __value with
+        | Texp_constraint (__x1, __x2) ->
+            let (__st, __y1) = self#option self#core_type __st __x1 in
+            let (__st, __y2) = self#option self#core_type __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_constraint (__y1, __y2)))
+        | Texp_open (__x1, __x2, __x3, __x4) -> (__st, __value)
+        | Texp_poly __x1 ->
+            let (__st, __y1) = self#option self#core_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Texp_poly __y1))
+        | Texp_newtype __x1 -> (__st, __value)
+    method expression_desc :
+      'st -> expression_desc -> ('st * expression_desc) =
+      fun __st __value ->
+        match __value with
+        | Texp_ident (__x1, __x2, __x3) -> (__st, __value)
+        | Texp_constant __x1 -> (__st, __value)
+        | Texp_let (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let (__st, __y1) = self#pattern __st __x1 in
+                   let (__st, __y2) = self#expression __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x2 in
+            let (__st, __y3) = self#expression __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Texp_let (__y1, __y2, __y3)))
+        | Texp_function (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let (__st, __y1) = self#pattern __st __x1 in
+                   let (__st, __y2) = self#expression __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x2 in
+            let __y3 = __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Texp_function (__y1, __y2, __y3)))
+        | Texp_apply (__x1, __x2) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let (__st, __y2) =
+                     self#option self#expression __st __x2 in
+                   let __y3 = __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_apply (__y1, __y2)))
+        | Texp_match (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let (__st, __y1) = self#pattern __st __x1 in
+                   let (__st, __y2) = self#expression __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x2 in
+            let __y3 = __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Texp_match (__y1, __y2, __y3)))
+        | Texp_try (__x1, __x2) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let (__st, __y1) = self#pattern __st __x1 in
+                   let (__st, __y2) = self#expression __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_try (__y1, __y2)))
+        | Texp_tuple __x1 ->
+            let (__st, __y1) = self#list self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Texp_tuple __y1))
+        | Texp_construct (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#expression __st __x3 in
+            let __y4 = __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Texp_construct (__y1, __y2, __y3, __y4)))
+        | Texp_variant (__x1, __x2) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#option self#expression __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_variant (__y1, __y2)))
+        | Texp_record (__x1, __x2) ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#expression __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1 in
+            let (__st, __y2) = self#option self#expression __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_record (__y1, __y2)))
+        | Texp_field (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let __y2 = __x2 in
+            let __y3 = __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Texp_field (__y1, __y2, __y3)))
+        | Texp_setfield (__x1, __x2, __x3, __x4) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let __y2 = __x2 in
+            let __y3 = __x3 in
+            let (__st, __y4) = self#expression __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Texp_setfield (__y1, __y2, __y3, __y4)))
+        | Texp_array __x1 ->
+            let (__st, __y1) = self#list self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Texp_array __y1))
+        | Texp_ifthenelse (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) = self#expression __st __x2 in
+            let (__st, __y3) = self#option self#expression __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Texp_ifthenelse (__y1, __y2, __y3)))
+        | Texp_sequence (__x1, __x2) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) = self#expression __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_sequence (__y1, __y2)))
+        | Texp_while (__x1, __x2) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) = self#expression __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_while (__y1, __y2)))
+        | Texp_for (__x1, __x2, __x3, __x4, __x5, __x6) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#expression __st __x3 in
+            let (__st, __y4) = self#expression __st __x4 in
+            let __y5 = __x5 in
+            let (__st, __y6) = self#expression __st __x6
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) &&
+                       ((__x4 == __y4) &&
+                          ((__x5 == __y5) &&
+                             ((__x6 == __y6) && (__x1 == __y1)))))
+                then __value
+                else Texp_for (__y1, __y2, __y3, __y4, __y5, __y6)))
+        | Texp_when (__x1, __x2) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) = self#expression __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_when (__y1, __y2)))
+        | Texp_send (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let (__st, __y2) = self#meth __st __x2 in
+            let (__st, __y3) = self#option self#expression __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Texp_send (__y1, __y2, __y3)))
+        | Texp_new (__x1, __x2, __x3) -> (__st, __value)
+        | Texp_instvar (__x1, __x2, __x3) -> (__st, __value)
+        | Texp_setinstvar (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let __y3 = __x3 in
+            let (__st, __y4) = self#expression __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Texp_setinstvar (__y1, __y2, __y3, __y4)))
+        | Texp_override (__x1, __x2) ->
+            let __y1 = __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#expression __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_override (__y1, __y2)))
+        | Texp_letmodule (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_expr __st __x3 in
+            let (__st, __y4) = self#expression __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Texp_letmodule (__y1, __y2, __y3, __y4)))
+        | Texp_assert __x1 ->
+            let (__st, __y1) = self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Texp_assert __y1))
+        | Texp_assertfalse -> (__st, __value)
+        | Texp_lazy __x1 ->
+            let (__st, __y1) = self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Texp_lazy __y1))
+        | Texp_object (__x1, __x2) ->
+            let (__st, __y1) = self#class_structure __st __x1 in
+            let (__st, __y2) = self#list (fun __st v -> (__st, v)) __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Texp_object (__y1, __y2)))
+        | Texp_pack __x1 ->
+            let (__st, __y1) = self#module_expr __st __x1
+            in (__st, (if __x1 == __y1 then __value else Texp_pack __y1))
+    method meth : 'st -> meth -> ('st * meth) =
+      fun __st __value -> (__st, __value)
+    method class_expr : 'st -> class_expr -> ('st * class_expr) =
+      fun __st __value ->
+        let (__st, cl_desc) = self#class_expr_desc __st __value.cl_desc in
+        let cl_loc = __value.cl_loc in
+        let cl_type = __value.cl_type in
+        let cl_env = __value.cl_env
+        in
+          (__st,
+           (if
+              (__value.cl_loc == cl_loc) &&
+                ((__value.cl_type == cl_type) &&
+                   ((__value.cl_env == cl_env) &&
+                      (__value.cl_desc == cl_desc)))
+            then __value
+            else
+              {
+                cl_desc = cl_desc;
+                cl_loc = cl_loc;
+                cl_type = cl_type;
+                cl_env = cl_env;
+              }))
+    method class_expr_desc :
+      'st -> class_expr_desc -> ('st * class_expr_desc) =
+      fun __st __value ->
+        match __value with
+        | Tcl_ident (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#core_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tcl_ident (__y1, __y2, __y3)))
+        | Tcl_structure __x1 ->
+            let (__st, __y1) = self#class_structure __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tcl_structure __y1))
+        | Tcl_fun (__x1, __x2, __x3, __x4, __x5) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#pattern __st __x2 in
+            let (__st, __y3) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#expression __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x3 in
+            let (__st, __y4) = self#class_expr __st __x4 in
+            let __y5 = __x5
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) &&
+                       ((__x4 == __y4) && ((__x5 == __y5) && (__x1 == __y1))))
+                then __value
+                else Tcl_fun (__y1, __y2, __y3, __y4, __y5)))
+        | Tcl_apply (__x1, __x2) ->
+            let (__st, __y1) = self#class_expr __st __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let (__st, __y2) =
+                     self#option self#expression __st __x2 in
+                   let __y3 = __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tcl_apply (__y1, __y2)))
+        | Tcl_let (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let (__st, __y1) = self#pattern __st __x1 in
+                   let (__st, __y2) = self#expression __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x2 in
+            let (__st, __y3) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#expression __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x3 in
+            let (__st, __y4) = self#class_expr __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Tcl_let (__y1, __y2, __y3, __y4)))
+        | Tcl_constraint (__x1, __x2, __x3, __x4, __x5) ->
+            let (__st, __y1) = self#class_expr __st __x1 in
+            let (__st, __y2) = self#option self#class_type __st __x2 in
+            let (__st, __y3) =
+              self#list (fun __st v -> (__st, v)) __st __x3 in
+            let (__st, __y4) =
+              self#list (fun __st v -> (__st, v)) __st __x4 in
+            let __y5 = __x5
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) &&
+                       ((__x4 == __y4) && ((__x5 == __y5) && (__x1 == __y1))))
+                then __value
+                else Tcl_constraint (__y1, __y2, __y3, __y4, __y5)))
+    method class_structure :
+      'st -> class_structure -> ('st * class_structure) =
+      fun __st __value ->
+        let (__st, cstr_pat) = self#pattern __st __value.cstr_pat in
+        let (__st, cstr_fields) =
+          self#list self#class_field __st __value.cstr_fields in
+        let cstr_type = __value.cstr_type in
+        let cstr_meths = __value.cstr_meths
+        in
+          (__st,
+           (if
+              (__value.cstr_fields == cstr_fields) &&
+                ((__value.cstr_type == cstr_type) &&
+                   ((__value.cstr_meths == cstr_meths) &&
+                      (__value.cstr_pat == cstr_pat)))
+            then __value
+            else
+              {
+                cstr_pat = cstr_pat;
+                cstr_fields = cstr_fields;
+                cstr_type = cstr_type;
+                cstr_meths = cstr_meths;
+              }))
+    method class_field : 'st -> class_field -> ('st * class_field) =
+      fun __st __value ->
+        let (__st, cf_desc) = self#class_field_desc __st __value.cf_desc in
+        let cf_loc = __value.cf_loc
+        in
+          (__st,
+           (if (__value.cf_loc == cf_loc) && (__value.cf_desc == cf_desc)
+            then __value
+            else { cf_desc = cf_desc; cf_loc = cf_loc; }))
+    method class_field_kind :
+      'st -> class_field_kind -> ('st * class_field_kind) =
+      fun __st __value ->
+        match __value with
+        | Tcfk_virtual __x1 ->
+            let (__st, __y1) = self#core_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tcfk_virtual __y1))
+        | Tcfk_concrete __x1 ->
+            let (__st, __y1) = self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tcfk_concrete __y1))
+    method class_field_desc :
+      'st -> class_field_desc -> ('st * class_field_desc) =
+      fun __st __value ->
+        match __value with
+        | Tcf_inher (__x1, __x2, __x3, __x4, __x5) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#class_expr __st __x2 in
+            let (__st, __y3) =
+              self#option (fun __st v -> (__st, v)) __st __x3 in
+            let (__st, __y4) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) -> (__st, __value))
+                __st __x4 in
+            let (__st, __y5) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) -> (__st, __value))
+                __st __x5
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) &&
+                       ((__x4 == __y4) && ((__x5 == __y5) && (__x1 == __y1))))
+                then __value
+                else Tcf_inher (__y1, __y2, __y3, __y4, __y5)))
+        | Tcf_val (__x1, __x2, __x3, __x4, __x5, __x6) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let __y3 = __x3 in
+            let __y4 = __x4 in
+            let (__st, __y5) = self#class_field_kind __st __x5 in
+            let __y6 = __x6
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) &&
+                       ((__x4 == __y4) &&
+                          ((__x5 == __y5) &&
+                             ((__x6 == __y6) && (__x1 == __y1)))))
+                then __value
+                else Tcf_val (__y1, __y2, __y3, __y4, __y5, __y6)))
+        | Tcf_meth (__x1, __x2, __x3, __x4, __x5) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let __y3 = __x3 in
+            let (__st, __y4) = self#class_field_kind __st __x4 in
+            let __y5 = __x5
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) &&
+                       ((__x4 == __y4) && ((__x5 == __y5) && (__x1 == __y1))))
+                then __value
+                else Tcf_meth (__y1, __y2, __y3, __y4, __y5)))
+        | Tcf_constr (__x1, __x2) ->
+            let (__st, __y1) = self#core_type __st __x1 in
+            let (__st, __y2) = self#core_type __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tcf_constr (__y1, __y2)))
+        | Tcf_init __x1 ->
+            let (__st, __y1) = self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tcf_init __y1))
+    method module_expr : 'st -> module_expr -> ('st * module_expr) =
+      fun __st __value ->
+        let (__st, mod_desc) = self#module_expr_desc __st __value.mod_desc in
+        let mod_loc = __value.mod_loc in
+        let mod_type = __value.mod_type in
+        let mod_env = __value.mod_env
+        in
+          (__st,
+           (if
+              (__value.mod_loc == mod_loc) &&
+                ((__value.mod_type == mod_type) &&
+                   ((__value.mod_env == mod_env) &&
+                      (__value.mod_desc == mod_desc)))
+            then __value
+            else
+              {
+                mod_desc = mod_desc;
+                mod_loc = mod_loc;
+                mod_type = mod_type;
+                mod_env = mod_env;
+              }))
+    method module_type_constraint :
+      'st -> module_type_constraint -> ('st * module_type_constraint) =
+      fun __st __value ->
+        match __value with
+        | Tmodtype_implicit -> (__st, __value)
+        | Tmodtype_explicit __x1 ->
+            let (__st, __y1) = self#module_type __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Tmodtype_explicit __y1))
+    method module_expr_desc :
+      'st -> module_expr_desc -> ('st * module_expr_desc) =
+      fun __st __value ->
+        match __value with
+        | Tmod_ident (__x1, __x2) -> (__st, __value)
+        | Tmod_structure __x1 ->
+            let (__st, __y1) = self#structure __st __x1
+            in
+              (__st, (if __x1 == __y1 then __value else Tmod_structure __y1))
+        | Tmod_functor (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_type __st __x3 in
+            let (__st, __y4) = self#module_expr __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Tmod_functor (__y1, __y2, __y3, __y4)))
+        | Tmod_apply (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#module_expr __st __x1 in
+            let (__st, __y2) = self#module_expr __st __x2 in
+            let (__st, __y3) = self#module_coercion __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tmod_apply (__y1, __y2, __y3)))
+        | Tmod_constraint (__x1, __x2, __x3, __x4) ->
+            let (__st, __y1) = self#module_expr __st __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_type_constraint __st __x3 in
+            let (__st, __y4) = self#module_coercion __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Tmod_constraint (__y1, __y2, __y3, __y4)))
+        | Tmod_unpack (__x1, __x2) ->
+            let (__st, __y1) = self#expression __st __x1 in
+            let __y2 = __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tmod_unpack (__y1, __y2)))
+    method structure : 'st -> structure -> ('st * structure) =
+      fun __st __value ->
+        let (__st, str_items) =
+          self#list self#structure_item __st __value.str_items in
+        let str_type = __value.str_type in
+        let str_final_env = __value.str_final_env
+        in
+          (__st,
+           (if
+              (__value.str_type == str_type) &&
+                ((__value.str_final_env == str_final_env) &&
+                   (__value.str_items == str_items))
+            then __value
+            else
+              {
+                str_items = str_items;
+                str_type = str_type;
+                str_final_env = str_final_env;
+              }))
+    method structure_item : 'st -> structure_item -> ('st * structure_item) =
+      fun __st __value ->
+        let (__st, str_desc) =
+          self#structure_item_desc __st __value.str_desc in
+        let str_loc = __value.str_loc in
+        let str_env = __value.str_env
+        in
+          (__st,
+           (if
+              (__value.str_loc == str_loc) &&
+                ((__value.str_env == str_env) &&
+                   (__value.str_desc == str_desc))
+            then __value
+            else
+              { str_desc = str_desc; str_loc = str_loc; str_env = str_env; }))
+    method structure_item_desc :
+      'st -> structure_item_desc -> ('st * structure_item_desc) =
+      fun __st __value ->
+        match __value with
+        | Tstr_eval __x1 ->
+            let (__st, __y1) = self#expression __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tstr_eval __y1))
+        | Tstr_value (__x1, __x2) ->
+            let __y1 = __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let (__st, __y1) = self#pattern __st __x1 in
+                   let (__st, __y2) = self#expression __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tstr_value (__y1, __y2)))
+        | Tstr_primitive (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#value_description __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tstr_primitive (__y1, __y2, __y3)))
+        | Tstr_type __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#type_declaration __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tstr_type __y1))
+        | Tstr_exception (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#exception_declaration __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tstr_exception (__y1, __y2, __y3)))
+        | Tstr_exn_rebind (__x1, __x2, __x3, __x4) -> (__st, __value)
+        | Tstr_module (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_expr __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tstr_module (__y1, __y2, __y3)))
+        | Tstr_recmodule __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3, __x4) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#module_type __st __x3 in
+                   let (__st, __y4) = self#module_expr __st __x4
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) &&
+                           ((__x3 == __y3) &&
+                              ((__x4 == __y4) && (__x1 == __y1)))
+                       then __value
+                       else (__y1, __y2, __y3, __y4))))
+                __st __x1
+            in
+              (__st, (if __x1 == __y1 then __value else Tstr_recmodule __y1))
+        | Tstr_modtype (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tstr_modtype (__y1, __y2, __y3)))
+        | Tstr_open (__x1, __x2, __x3) -> (__st, __value)
+        | Tstr_class __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let (__st, __y1) = self#class_declaration __st __x1 in
+                   let (__st, __y2) =
+                     self#list (fun __st v -> (__st, v)) __st __x2 in
+                   let __y3 = __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tstr_class __y1))
+        | Tstr_class_type __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#class_type_declaration __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Tstr_class_type __y1))
+        | Tstr_include (__x1, __x2) ->
+            let (__st, __y1) = self#module_expr __st __x1 in
+            let __y2 = __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tstr_include (__y1, __y2)))
+    method module_coercion :
+      'st -> module_coercion -> ('st * module_coercion) =
+      fun __st __value ->
+        match __value with
+        | Tcoerce_none -> (__st, __value)
+        | Tcoerce_structure __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2) as __value)) ->
+                   let __y1 = __x1 in
+                   let (__st, __y2) = self#module_coercion __st __x2
+                   in
+                     (__st,
+                      (if (__x2 == __y2) && (__x1 == __y1)
+                       then __value
+                       else (__y1, __y2))))
+                __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Tcoerce_structure __y1))
+        | Tcoerce_functor (__x1, __x2) ->
+            let (__st, __y1) = self#module_coercion __st __x1 in
+            let (__st, __y2) = self#module_coercion __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tcoerce_functor (__y1, __y2)))
+        | Tcoerce_primitive __x1 -> (__st, __value)
+    method module_type : 'st -> module_type -> ('st * module_type) =
+      fun __st __value ->
+        let (__st, mty_desc) = self#module_type_desc __st __value.mty_desc in
+        let mty_type = __value.mty_type in
+        let mty_env = __value.mty_env in
+        let mty_loc = __value.mty_loc
+        in
+          (__st,
+           (if
+              (__value.mty_type == mty_type) &&
+                ((__value.mty_env == mty_env) &&
+                   ((__value.mty_loc == mty_loc) &&
+                      (__value.mty_desc == mty_desc)))
+            then __value
+            else
+              {
+                mty_desc = mty_desc;
+                mty_type = mty_type;
+                mty_env = mty_env;
+                mty_loc = mty_loc;
+              }))
+    method module_type_desc :
+      'st -> module_type_desc -> ('st * module_type_desc) =
+      fun __st __value ->
+        match __value with
+        | Tmty_ident (__x1, __x2) -> (__st, __value)
+        | Tmty_signature __x1 ->
+            let (__st, __y1) = self#signature __st __x1
+            in
+              (__st, (if __x1 == __y1 then __value else Tmty_signature __y1))
+        | Tmty_functor (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_type __st __x3 in
+            let (__st, __y4) = self#module_type __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Tmty_functor (__y1, __y2, __y3, __y4)))
+        | Tmty_with (__x1, __x2) ->
+            let (__st, __y1) = self#module_type __st __x1 in
+            let (__st, __y2) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#with_constraint __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tmty_with (__y1, __y2)))
+        | Tmty_typeof __x1 ->
+            let (__st, __y1) = self#module_expr __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tmty_typeof __y1))
+    method signature : 'st -> signature -> ('st * signature) =
+      fun __st __value ->
+        let (__st, sig_items) =
+          self#list self#signature_item __st __value.sig_items in
+        let sig_type = __value.sig_type in
+        let sig_final_env = __value.sig_final_env
+        in
+          (__st,
+           (if
+              (__value.sig_type == sig_type) &&
+                ((__value.sig_final_env == sig_final_env) &&
+                   (__value.sig_items == sig_items))
+            then __value
+            else
+              {
+                sig_items = sig_items;
+                sig_type = sig_type;
+                sig_final_env = sig_final_env;
+              }))
+    method signature_item : 'st -> signature_item -> ('st * signature_item) =
+      fun __st __value ->
+        let (__st, sig_desc) =
+          self#signature_item_desc __st __value.sig_desc in
+        let sig_env = __value.sig_env in
+        let sig_loc = __value.sig_loc
+        in
+          (__st,
+           (if
+              (__value.sig_env == sig_env) &&
+                ((__value.sig_loc == sig_loc) &&
+                   (__value.sig_desc == sig_desc))
+            then __value
+            else
+              { sig_desc = sig_desc; sig_env = sig_env; sig_loc = sig_loc; }))
+    method signature_item_desc :
+      'st -> signature_item_desc -> ('st * signature_item_desc) =
+      fun __st __value ->
+        match __value with
+        | Tsig_value (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#value_description __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tsig_value (__y1, __y2, __y3)))
+        | Tsig_type __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#type_declaration __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tsig_type __y1))
+        | Tsig_exception (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#exception_declaration __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tsig_exception (__y1, __y2, __y3)))
+        | Tsig_module (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#module_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tsig_module (__y1, __y2, __y3)))
+        | Tsig_recmodule __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#module_type __st __x3
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                       then __value
+                       else (__y1, __y2, __y3))))
+                __st __x1
+            in
+              (__st, (if __x1 == __y1 then __value else Tsig_recmodule __y1))
+        | Tsig_modtype (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#modtype_declaration __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tsig_modtype (__y1, __y2, __y3)))
+        | Tsig_open (__x1, __x2, __x3) -> (__st, __value)
+        | Tsig_include (__x1, __x2) ->
+            let (__st, __y1) = self#module_type __st __x1 in
+            let __y2 = __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tsig_include (__y1, __y2)))
+        | Tsig_class __x1 ->
+            let (__st, __y1) = self#list self#class_description __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tsig_class __y1))
+        | Tsig_class_type __x1 ->
+            let (__st, __y1) =
+              self#list self#class_type_declaration __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Tsig_class_type __y1))
+    method modtype_declaration :
+      'st -> modtype_declaration -> ('st * modtype_declaration) =
+      fun __st __value ->
+        match __value with
+        | Tmodtype_abstract -> (__st, __value)
+        | Tmodtype_manifest __x1 ->
+            let (__st, __y1) = self#module_type __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Tmodtype_manifest __y1))
+    method with_constraint :
+      'st -> with_constraint -> ('st * with_constraint) =
+      fun __st __value ->
+        match __value with
+        | Twith_type __x1 ->
+            let (__st, __y1) = self#type_declaration __st __x1
+            in (__st, (if __x1 == __y1 then __value else Twith_type __y1))
+        | Twith_module (__x1, __x2) -> (__st, __value)
+        | Twith_typesubst __x1 ->
+            let (__st, __y1) = self#type_declaration __st __x1
+            in
+              (__st,
+               (if __x1 == __y1 then __value else Twith_typesubst __y1))
+        | Twith_modsubst (__x1, __x2) -> (__st, __value)
+    method core_type : 'st -> core_type -> ('st * core_type) =
+      fun __st __value ->
+        let (__st, ctyp_desc) = self#core_type_desc __st __value.ctyp_desc in
+        let ctyp_type = __value.ctyp_type in
+        let ctyp_env = __value.ctyp_env in
+        let ctyp_loc = __value.ctyp_loc
+        in
+          (__st,
+           (if
+              (__value.ctyp_type == ctyp_type) &&
+                ((__value.ctyp_env == ctyp_env) &&
+                   ((__value.ctyp_loc == ctyp_loc) &&
+                      (__value.ctyp_desc == ctyp_desc)))
+            then __value
+            else
+              {
+                ctyp_desc = ctyp_desc;
+                ctyp_type = ctyp_type;
+                ctyp_env = ctyp_env;
+                ctyp_loc = ctyp_loc;
+              }))
+    method core_type_desc : 'st -> core_type_desc -> ('st * core_type_desc) =
+      fun __st __value ->
+        match __value with
+        | Ttyp_any -> (__st, __value)
+        | Ttyp_var __x1 -> (__st, __value)
+        | Ttyp_arrow (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#core_type __st __x2 in
+            let (__st, __y3) = self#core_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Ttyp_arrow (__y1, __y2, __y3)))
+        | Ttyp_tuple __x1 ->
+            let (__st, __y1) = self#list self#core_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Ttyp_tuple __y1))
+        | Ttyp_constr (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#core_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Ttyp_constr (__y1, __y2, __y3)))
+        | Ttyp_object __x1 ->
+            let (__st, __y1) = self#list self#core_field_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Ttyp_object __y1))
+        | Ttyp_class (__x1, __x2, __x3, __x4) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#core_type __st __x3 in
+            let (__st, __y4) = self#list (fun __st v -> (__st, v)) __st __x4
+            in
+              (__st,
+               (if
+                  (__x2 == __y2) &&
+                    ((__x3 == __y3) && ((__x4 == __y4) && (__x1 == __y1)))
+                then __value
+                else Ttyp_class (__y1, __y2, __y3, __y4)))
+        | Ttyp_alias (__x1, __x2) ->
+            let (__st, __y1) = self#core_type __st __x1 in
+            let __y2 = __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Ttyp_alias (__y1, __y2)))
+        | Ttyp_variant (__x1, __x2, __x3) ->
+            let (__st, __y1) = self#list self#row_field __st __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) =
+              self#option (self#list (fun __st v -> (__st, v))) __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Ttyp_variant (__y1, __y2, __y3)))
+        | Ttyp_poly (__x1, __x2) ->
+            let (__st, __y1) =
+              self#list (fun __st v -> (__st, v)) __st __x1 in
+            let (__st, __y2) = self#core_type __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Ttyp_poly (__y1, __y2)))
+        | Ttyp_package __x1 ->
+            let (__st, __y1) = self#package_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Ttyp_package __y1))
+    method package_type : 'st -> package_type -> ('st * package_type) =
+      fun __st __value ->
+        let pack_name = __value.pack_name in
+        let (__st, pack_fields) =
+          self#list
+            (fun __st (((__x1, __x2) as __value)) ->
+               let __y1 = __x1 in
+               let (__st, __y2) = self#core_type __st __x2
+               in
+                 (__st,
+                  (if (__x2 == __y2) && (__x1 == __y1)
+                   then __value
+                   else (__y1, __y2))))
+            __st __value.pack_fields in
+        let pack_type = __value.pack_type in
+        let pack_txt = __value.pack_txt
+        in
+          (__st,
+           (if
+              (__value.pack_fields == pack_fields) &&
+                ((__value.pack_type == pack_type) &&
+                   ((__value.pack_txt == pack_txt) &&
+                      (__value.pack_name == pack_name)))
+            then __value
+            else
+              {
+                pack_name = pack_name;
+                pack_fields = pack_fields;
+                pack_type = pack_type;
+                pack_txt = pack_txt;
+              }))
+    method core_field_type :
+      'st -> core_field_type -> ('st * core_field_type) =
+      fun __st __value ->
+        let (__st, field_desc) =
+          self#core_field_desc __st __value.field_desc in
+        let field_loc = __value.field_loc
+        in
+          (__st,
+           (if
+              (__value.field_loc == field_loc) &&
+                (__value.field_desc == field_desc)
+            then __value
+            else { field_desc = field_desc; field_loc = field_loc; }))
+    method core_field_desc :
+      'st -> core_field_desc -> ('st * core_field_desc) =
+      fun __st __value ->
+        match __value with
+        | Tcfield (__x1, __x2) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#core_type __st __x2
+            in
+              (__st,
+               (if (__x2 == __y2) && (__x1 == __y1)
+                then __value
+                else Tcfield (__y1, __y2)))
+        | Tcfield_var -> (__st, __value)
+    method row_field : 'st -> row_field -> ('st * row_field) =
+      fun __st __value ->
+        match __value with
+        | Ttag (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#core_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Ttag (__y1, __y2, __y3)))
+        | Tinherit __x1 ->
+            let (__st, __y1) = self#core_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tinherit __y1))
+    method value_description :
+      'st -> value_description -> ('st * value_description) =
+      fun __st __value ->
+        let (__st, val_desc) = self#core_type __st __value.val_desc in
+        let val_val = __value.val_val in
+        let (__st, val_prim) =
+          self#list (fun __st v -> (__st, v)) __st __value.val_prim in
+        let val_loc = __value.val_loc
+        in
+          (__st,
+           (if
+              (__value.val_val == val_val) &&
+                ((__value.val_prim == val_prim) &&
+                   ((__value.val_loc == val_loc) &&
+                      (__value.val_desc == val_desc)))
+            then __value
+            else
+              {
+                val_desc = val_desc;
+                val_val = val_val;
+                val_prim = val_prim;
+                val_loc = val_loc;
+              }))
+    method type_declaration :
+      'st -> type_declaration -> ('st * type_declaration) =
+      fun __st __value ->
+        let (__st, typ_params) =
+          self#list (self#option (fun __st v -> (__st, v))) __st
+            __value.typ_params in
+        let typ_type = __value.typ_type in
+        let (__st, typ_cstrs) =
+          self#list
+            (fun __st (((__x1, __x2, __x3) as __value)) ->
+               let (__st, __y1) = self#core_type __st __x1 in
+               let (__st, __y2) = self#core_type __st __x2 in
+               let __y3 = __x3
+               in
+                 (__st,
+                  (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                   then __value
+                   else (__y1, __y2, __y3))))
+            __st __value.typ_cstrs in
+        let (__st, typ_kind) = self#type_kind __st __value.typ_kind in
+        let typ_private = __value.typ_private in
+        let (__st, typ_manifest) =
+          self#option self#core_type __st __value.typ_manifest in
+        let (__st, typ_variance) =
+          self#list (fun __st (((__x1, __x2) as __value)) -> (__st, __value))
+            __st __value.typ_variance in
+        let typ_loc = __value.typ_loc
+        in
+          (__st,
+           (if
+              (__value.typ_type == typ_type) &&
+                ((__value.typ_cstrs == typ_cstrs) &&
+                   ((__value.typ_kind == typ_kind) &&
+                      ((__value.typ_private == typ_private) &&
+                         ((__value.typ_manifest == typ_manifest) &&
+                            ((__value.typ_variance == typ_variance) &&
+                               ((__value.typ_loc == typ_loc) &&
+                                  (__value.typ_params == typ_params)))))))
+            then __value
+            else
+              {
+                typ_params = typ_params;
+                typ_type = typ_type;
+                typ_cstrs = typ_cstrs;
+                typ_kind = typ_kind;
+                typ_private = typ_private;
+                typ_manifest = typ_manifest;
+                typ_variance = typ_variance;
+                typ_loc = typ_loc;
+              }))
+    method type_kind : 'st -> type_kind -> ('st * type_kind) =
+      fun __st __value ->
+        match __value with
+        | Ttype_abstract -> (__st, __value)
+        | Ttype_variant __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3, __x4) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let (__st, __y3) = self#list self#core_type __st __x3 in
+                   let __y4 = __x4
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) &&
+                           ((__x3 == __y3) &&
+                              ((__x4 == __y4) && (__x1 == __y1)))
+                       then __value
+                       else (__y1, __y2, __y3, __y4))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Ttype_variant __y1))
+        | Ttype_record __x1 ->
+            let (__st, __y1) =
+              self#list
+                (fun __st (((__x1, __x2, __x3, __x4, __x5) as __value)) ->
+                   let __y1 = __x1 in
+                   let __y2 = __x2 in
+                   let __y3 = __x3 in
+                   let (__st, __y4) = self#core_type __st __x4 in
+                   let __y5 = __x5
+                   in
+                     (__st,
+                      (if
+                         (__x2 == __y2) &&
+                           ((__x3 == __y3) &&
+                              ((__x4 == __y4) &&
+                                 ((__x5 == __y5) && (__x1 == __y1))))
+                       then __value
+                       else (__y1, __y2, __y3, __y4, __y5))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Ttype_record __y1))
+    method exception_declaration :
+      'st -> exception_declaration -> ('st * exception_declaration) =
+      fun __st __value ->
+        let (__st, exn_params) =
+          self#list self#core_type __st __value.exn_params in
+        let exn_exn = __value.exn_exn in
+        let exn_loc = __value.exn_loc
+        in
+          (__st,
+           (if
+              (__value.exn_exn == exn_exn) &&
+                ((__value.exn_loc == exn_loc) &&
+                   (__value.exn_params == exn_params))
+            then __value
+            else
+              {
+                exn_params = exn_params;
+                exn_exn = exn_exn;
+                exn_loc = exn_loc;
+              }))
+    method class_type : 'st -> class_type -> ('st * class_type) =
+      fun __st __value ->
+        let (__st, cltyp_desc) =
+          self#class_type_desc __st __value.cltyp_desc in
+        let cltyp_type = __value.cltyp_type in
+        let cltyp_env = __value.cltyp_env in
+        let cltyp_loc = __value.cltyp_loc
+        in
+          (__st,
+           (if
+              (__value.cltyp_type == cltyp_type) &&
+                ((__value.cltyp_env == cltyp_env) &&
+                   ((__value.cltyp_loc == cltyp_loc) &&
+                      (__value.cltyp_desc == cltyp_desc)))
+            then __value
+            else
+              {
+                cltyp_desc = cltyp_desc;
+                cltyp_type = cltyp_type;
+                cltyp_env = cltyp_env;
+                cltyp_loc = cltyp_loc;
+              }))
+    method class_type_desc :
+      'st -> class_type_desc -> ('st * class_type_desc) =
+      fun __st __value ->
+        match __value with
+        | Tcty_constr (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let __y2 = __x2 in
+            let (__st, __y3) = self#list self#core_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tcty_constr (__y1, __y2, __y3)))
+        | Tcty_signature __x1 ->
+            let (__st, __y1) = self#class_signature __st __x1
+            in
+              (__st, (if __x1 == __y1 then __value else Tcty_signature __y1))
+        | Tcty_fun (__x1, __x2, __x3) ->
+            let __y1 = __x1 in
+            let (__st, __y2) = self#core_type __st __x2 in
+            let (__st, __y3) = self#class_type __st __x3
+            in
+              (__st,
+               (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                then __value
+                else Tcty_fun (__y1, __y2, __y3)))
+    method class_signature :
+      'st -> class_signature -> ('st * class_signature) =
+      fun __st __value ->
+        let (__st, csig_self) = self#core_type __st __value.csig_self in
+        let (__st, csig_fields) =
+          self#list self#class_type_field __st __value.csig_fields in
+        let csig_type = __value.csig_type in
+        let csig_loc = __value.csig_loc
+        in
+          (__st,
+           (if
+              (__value.csig_fields == csig_fields) &&
+                ((__value.csig_type == csig_type) &&
+                   ((__value.csig_loc == csig_loc) &&
+                      (__value.csig_self == csig_self)))
+            then __value
+            else
+              {
+                csig_self = csig_self;
+                csig_fields = csig_fields;
+                csig_type = csig_type;
+                csig_loc = csig_loc;
+              }))
+    method class_type_field :
+      'st -> class_type_field -> ('st * class_type_field) =
+      fun __st __value ->
+        let (__st, ctf_desc) =
+          self#class_type_field_desc __st __value.ctf_desc in
+        let ctf_loc = __value.ctf_loc
+        in
+          (__st,
+           (if (__value.ctf_loc == ctf_loc) && (__value.ctf_desc == ctf_desc)
+            then __value
+            else { ctf_desc = ctf_desc; ctf_loc = ctf_loc; }))
+    method class_type_field_desc :
+      'st -> class_type_field_desc -> ('st * class_type_field_desc) =
+      fun __st __value ->
+        match __value with
+        | Tctf_inher __x1 ->
+            let (__st, __y1) = self#class_type __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tctf_inher __y1))
+        | Tctf_val __x1 ->
+            let (__st, __y1) =
+              (fun __st (((__x1, __x2, __x3, __x4) as __value)) ->
+                 let __y1 = __x1 in
+                 let __y2 = __x2 in
+                 let __y3 = __x3 in
+                 let (__st, __y4) = self#core_type __st __x4
+                 in
+                   (__st,
+                    (if
+                       (__x2 == __y2) &&
+                         ((__x3 == __y3) &&
+                            ((__x4 == __y4) && (__x1 == __y1)))
+                     then __value
+                     else (__y1, __y2, __y3, __y4))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tctf_val __y1))
+        | Tctf_virt __x1 ->
+            let (__st, __y1) =
+              (fun __st (((__x1, __x2, __x3) as __value)) ->
+                 let __y1 = __x1 in
+                 let __y2 = __x2 in
+                 let (__st, __y3) = self#core_type __st __x3
+                 in
+                   (__st,
+                    (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                     then __value
+                     else (__y1, __y2, __y3))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tctf_virt __y1))
+        | Tctf_meth __x1 ->
+            let (__st, __y1) =
+              (fun __st (((__x1, __x2, __x3) as __value)) ->
+                 let __y1 = __x1 in
+                 let __y2 = __x2 in
+                 let (__st, __y3) = self#core_type __st __x3
+                 in
+                   (__st,
+                    (if (__x2 == __y2) && ((__x3 == __y3) && (__x1 == __y1))
+                     then __value
+                     else (__y1, __y2, __y3))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tctf_meth __y1))
+        | Tctf_cstr __x1 ->
+            let (__st, __y1) =
+              (fun __st (((__x1, __x2) as __value)) ->
+                 let (__st, __y1) = self#core_type __st __x1 in
+                 let (__st, __y2) = self#core_type __st __x2
+                 in
+                   (__st,
+                    (if (__x2 == __y2) && (__x1 == __y1)
+                     then __value
+                     else (__y1, __y2))))
+                __st __x1
+            in (__st, (if __x1 == __y1 then __value else Tctf_cstr __y1))
+    method class_declaration :
+      'st -> class_declaration -> ('st * class_declaration) =
+      self#class_infos self#class_expr
+    method class_description :
+      'st -> class_description -> ('st * class_description) =
+      self#class_infos self#class_type
+    method class_type_declaration :
+      'st -> class_type_declaration -> ('st * class_type_declaration) =
+      self#class_infos self#class_type
+    method class_infos :
+      'a.
+        ('st -> 'a -> ('st * 'a)) ->
+          'st -> 'a class_infos -> ('st * ('a class_infos)) =
+      fun __tv_a __st __value ->
+        let ci_virt = __value.ci_virt in
+        let (__st, ci_params) =
+          (fun __st (((__x1, __x2) as __value)) ->
+             let (__st, __y1) =
+               self#list (fun __st v -> (__st, v)) __st __x1 in
+             let __y2 = __x2
+             in
+               (__st,
+                (if (__x2 == __y2) && (__x1 == __y1)
+                 then __value
+                 else (__y1, __y2))))
+            __st __value.ci_params in
+        let ci_id_name = __value.ci_id_name in
+        let ci_id_class = __value.ci_id_class in
+        let ci_id_class_type = __value.ci_id_class_type in
+        let ci_id_object = __value.ci_id_object in
+        let ci_id_typesharp = __value.ci_id_typesharp in
+        let (__st, ci_expr) = __tv_a __st __value.ci_expr in
+        let ci_decl = __value.ci_decl in
+        let ci_type_decl = __value.ci_type_decl in
+        let (__st, ci_variance) =
+          self#list (fun __st (((__x1, __x2) as __value)) -> (__st, __value))
+            __st __value.ci_variance in
+        let ci_loc = __value.ci_loc
+        in
+          (__st,
+           (if
+              (__value.ci_params == ci_params) &&
+                ((__value.ci_id_name == ci_id_name) &&
+                   ((__value.ci_id_class == ci_id_class) &&
+                      ((__value.ci_id_class_type == ci_id_class_type) &&
+                         ((__value.ci_id_object == ci_id_object) &&
+                            ((__value.ci_id_typesharp == ci_id_typesharp) &&
+                               ((__value.ci_expr == ci_expr) &&
+                                  ((__value.ci_decl == ci_decl) &&
+                                     ((__value.ci_type_decl == ci_type_decl)
+                                        &&
+                                        ((__value.ci_variance == ci_variance)
+                                           &&
+                                           ((__value.ci_loc == ci_loc) &&
+                                              (__value.ci_virt == ci_virt)))))))))))
+            then __value
+            else
+              {
+                ci_virt = ci_virt;
+                ci_params = ci_params;
+                ci_id_name = ci_id_name;
+                ci_id_class = ci_id_class;
+                ci_id_class_type = ci_id_class_type;
+                ci_id_object = ci_id_object;
+                ci_id_typesharp = ci_id_typesharp;
+                ci_expr = ci_expr;
+                ci_decl = ci_decl;
+                ci_type_decl = ci_type_decl;
+                ci_variance = ci_variance;
+                ci_loc = ci_loc;
+              }))
+  end
+and virtual ['st] omap_pat_extra = ['st] omap_pattern
+and virtual ['st] omap_pattern_desc = ['st] omap_pattern
+and virtual ['st] omap_expression = ['st] omap_pattern
+and virtual ['st] omap_exp_extra = ['st] omap_pattern
+and virtual ['st] omap_expression_desc = ['st] omap_pattern
+and virtual ['st] omap_meth = ['st] omap_pattern
+and virtual ['st] omap_class_expr = ['st] omap_pattern
+and virtual ['st] omap_class_expr_desc = ['st] omap_pattern
+and virtual ['st] omap_class_structure = ['st] omap_pattern
+and virtual ['st] omap_class_field = ['st] omap_pattern
+and virtual ['st] omap_class_field_kind = ['st] omap_pattern
+and virtual ['st] omap_class_field_desc = ['st] omap_pattern
+and virtual ['st] omap_module_expr = ['st] omap_pattern
+and virtual ['st] omap_module_type_constraint = ['st] omap_pattern
+and virtual ['st] omap_module_expr_desc = ['st] omap_pattern
+and virtual ['st] omap_structure = ['st] omap_pattern
+and virtual ['st] omap_structure_item = ['st] omap_pattern
+and virtual ['st] omap_structure_item_desc = ['st] omap_pattern
+and virtual ['st] omap_module_coercion = ['st] omap_pattern
+and virtual ['st] omap_module_type = ['st] omap_pattern
+and virtual ['st] omap_module_type_desc = ['st] omap_pattern
+and virtual ['st] omap_signature = ['st] omap_pattern
+and virtual ['st] omap_signature_item = ['st] omap_pattern
+and virtual ['st] omap_signature_item_desc = ['st] omap_pattern
+and virtual ['st] omap_modtype_declaration = ['st] omap_pattern
+and virtual ['st] omap_with_constraint = ['st] omap_pattern
+and virtual ['st] omap_core_type = ['st] omap_pattern
+and virtual ['st] omap_core_type_desc = ['st] omap_pattern
+and virtual ['st] omap_package_type = ['st] omap_pattern
+and virtual ['st] omap_core_field_type = ['st] omap_pattern
+and virtual ['st] omap_core_field_desc = ['st] omap_pattern
+and virtual ['st] omap_row_field = ['st] omap_pattern
+and virtual ['st] omap_value_description = ['st] omap_pattern
+and virtual ['st] omap_type_declaration = ['st] omap_pattern
+and virtual ['st] omap_type_kind = ['st] omap_pattern
+and virtual ['st] omap_exception_declaration = ['st] omap_pattern
+and virtual ['st] omap_class_type = ['st] omap_pattern
+and virtual ['st] omap_class_type_desc = ['st] omap_pattern
+and virtual ['st] omap_class_signature = ['st] omap_pattern
+and virtual ['st] omap_class_type_field = ['st] omap_pattern
+and virtual ['st] omap_class_type_field_desc = ['st] omap_pattern
+and virtual ['st] omap_class_declaration = ['st] omap_pattern
+and virtual ['st] omap_class_description = ['st] omap_pattern
+and virtual ['st] omap_class_type_declaration = ['st] omap_pattern
+and virtual ['st] omap_class_infos = ['st] omap_pattern
+
+(*
 class virtual omap =
   object ((self : 'self))
 
     | (Some v as o) -> let self, v' = f self v in if v == v' then self, o else self, Some v'
     | None -> self, None
 end
+*)

File retype/Makefile

 # Requires unix!
 COMPFLAGS= $(INCLUDES_DEP) -I +unix
 
-MODULES= untypeast pprintast compile main
+MODULES= untypeast compile main
 
 OBJS=		$(addsuffix .cmo, $(MODULES))
 
 untypeast.mli: ../ocaml/tools/untypeast.mli
 	cp $< $@
 
-pprintast.ml: ../ocaml/tools/pprintast.ml
-	cp $< $@
-
 beforedepend:: main.ml untypeast.ml untypeast.mli pprintast.ml
 
 clean::

File retype/compile.ml

 (*                                                                     *)
 (***********************************************************************)
 
-(* $Id: compile.ml 12511 2012-05-30 13:29:48Z lefessan $ *)
-
 (* The batch compiler *)
 
 open Misc
 open Config
 open Format
 open Typedtree
-
-(* Initialize the search path.
-   The current directory is always searched first,
-   then the directories specified with the -I option (in command-line order),
-   then the standard library directory (unless the -nostdlib option is given).
- *)
-
-let init_path () =
-  let dirs =
-    if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
-    else if !Clflags.use_vmthreads then "+vmthreads" :: !Clflags.include_dirs
-    else !Clflags.include_dirs in
-  let exp_dirs =
-    List.map (expand_directory Config.standard_library) dirs in
-  load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
-  Env.reset_cache ()
-
-(* Return the initial environment in which compilation proceeds. *)
-
-(* Note: do not do init_path() in initial_env, this breaks
-   toplevel initialization (PR#1775) *)