From 5305027a3680f72e73ba141d40585b225cb6d610 Mon Sep 17 00:00:00 2001
From: Peter Zotov <whitequark@whitequark.org>
Date: Tue, 6 May 2014 20:18:39 +0400
Subject: [PATCH] Update for 4.02.

---
 src/lib/uTop_complete.ml | 24 ++++++++++++++++++++++++
 src/lib/uTop_main.ml     | 22 ++++++++++++++++------
 2 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/src/lib/uTop_complete.ml b/src/lib/uTop_complete.ml
index d3381ac..c0c8fc1 100644
--- a/src/lib/uTop_complete.ml
+++ b/src/lib/uTop_complete.ml
@@ -388,6 +388,10 @@ let add_fields_of_type decl acc =
         List.fold_left (fun acc field -> add (field_name field) acc) acc fields
     | Type_abstract ->
         acc
+#if ocaml_version >= (4, 02, 0)
+    | Type_open ->
+        acc
+#endif
 
 let add_names_of_type decl acc =
   match decl.type_kind with
@@ -397,6 +401,10 @@ let add_names_of_type decl acc =
         List.fold_left (fun acc field -> add (field_name field) acc) acc fields
     | Type_abstract ->
         acc
+#if ocaml_version >= (4, 02, 0)
+    | Type_open ->
+        acc
+#endif
 
 #if ocaml_version >= (4, 0, 0)
 
@@ -405,7 +413,11 @@ let rec names_of_module_type = function
       List.fold_left
         (fun acc decl -> match decl with
            | Sig_value (id, _)
+#if ocaml_version >= (4, 02, 0)
+           | Sig_typext (id, _, _)
+#else
            | Sig_exception (id, _)
+#endif
            | Sig_module (id, _, _)
            | Sig_modtype (id, _)
            | Sig_class (id, _, _)
@@ -433,7 +445,11 @@ let rec fields_of_module_type = function
       List.fold_left
         (fun acc decl -> match decl with
            | Sig_value (id, _)
+#if ocaml_version >= (4, 02, 0)
+           | Sig_typext (id, _, _)
+#else
            | Sig_exception (id, _)
+#endif
            | Sig_module (id, _, _)
            | Sig_modtype (id, _)
            | Sig_class (id, _, _)
@@ -551,7 +567,11 @@ let list_global_names () =
         loop (add (Ident.name id) acc) summary
     | Env.Env_type(summary, id, decl) ->
         loop (add_names_of_type decl (add (Ident.name id) acc)) summary
+#if ocaml_version >= (4, 02, 0)
+    | Env.Env_extension(summary, id, _) ->
+#else
     | Env.Env_exception(summary, id, _) ->
+#endif
         loop (add (Ident.name id) acc) summary
     | Env.Env_module(summary, id, _) ->
         loop (add (Ident.name id) acc) summary
@@ -612,7 +632,11 @@ let list_global_fields () =
         loop (add (Ident.name id) acc) summary
     | Env.Env_type(summary, id, decl) ->
         loop (add_fields_of_type decl (add (Ident.name id) acc)) summary
+#if ocaml_version >= (4, 02, 0)
+    | Env.Env_extension(summary, id, _) ->
+#else
     | Env.Env_exception(summary, id, _) ->
+#endif
         loop (add (Ident.name id) acc) summary
     | Env.Env_module(summary, id, _) ->
         loop (add (Ident.name id) acc) summary
diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml
index 2444492..cdd462c 100644
--- a/src/lib/uTop_main.ml
+++ b/src/lib/uTop_main.ml
@@ -242,9 +242,17 @@ let rec map_items unwrap wrap items =
       | Outcometree.Osig_class (_, name, _, _, rs)
       | Outcometree.Osig_class_type (_, name, _, _, rs)
       | Outcometree.Osig_module (name, _, rs)
+#if ocaml_version >= (4, 02, 0)
+      | Outcometree.Osig_type ({ Outcometree.otype_name = name }, rs) ->
+#else
       | Outcometree.Osig_type ((name, _, _, _, _), rs) ->
+#endif
         (name, rs)
+#if ocaml_version >= (4, 02, 0)
+      | Outcometree.Osig_typext ({ Outcometree.oext_name = name}, _)
+#else
       | Outcometree.Osig_exception (name, _)
+#endif
       | Outcometree.Osig_modtype (name, _)
       | Outcometree.Osig_value (name, _, _) ->
         (name, Outcometree.Orec_not)
@@ -276,12 +284,16 @@ let rec map_items unwrap wrap items =
               wrap (Outcometree.Osig_module (name, a, Outcometree.Orec_first)) extra :: items'
             else
               items
-          | Outcometree.Osig_type ((name, a, b, c, d), rs) ->
+          | Outcometree.Osig_type (oty, rs) ->
             if rs = Outcometree.Orec_next then
-              wrap (Outcometree.Osig_type ((name, a, b, c, d), Outcometree.Orec_first)) extra :: items'
+              wrap (Outcometree.Osig_type (oty, Outcometree.Orec_first)) extra :: items'
             else
               items
+#if ocaml_version >= (4, 02, 0)
+          | Outcometree.Osig_typext _
+#else
           | Outcometree.Osig_exception _
+#endif
           | Outcometree.Osig_modtype _
           | Outcometree.Osig_value _ ->
             items
@@ -1011,7 +1023,7 @@ let typeof sid =
       Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
     with Not_found ->
     try
-#if ocaml_version < (4, 2, 0)
+#if ocaml_version < (4, 02, 0)
       let (path, mod_typ) = Env.lookup_module id env in
 #else
       let path = Env.lookup_module id env in
@@ -1028,13 +1040,11 @@ let typeof sid =
     try
       let cstr_desc = Env.lookup_constructor id env in
       match cstr_desc.Types.cstr_tag with
+#if ocaml_version < (4, 02, 0)
       | Types.Cstr_exception (_path, loc) ->
-#if ocaml_version < (4, 2, 0)
         let path, exn_decl = Typedecl.transl_exn_rebind env loc id in
         let id = Ident.create (Path.name path) in
         Some (Printtyp.tree_of_exception_declaration id exn_decl)
-#else
-        None
 #endif
       | _ ->
         let (path, ty_decl) = from_type_desc cstr_desc.Types.cstr_res.Types.desc in