Fix 4.04 compatibility

Closes #173

_tags

@@ -3,7 +3,7 @@
 <src/**/*.ml{,i}>: cppo_V_OCAML, cppo_interact, package(compiler-libs)
 <src/camlp5/**/*.ml{,i}>: use_camlp5
 
-<**/*.ml>: warn(-3-40)
+<**/*.ml>: warn(-3-40@8)
 
 # OASIS_START
 # OASIS_STOP

src/lib/uTop.cppo.ml

@@ -267,6 +267,11 @@ let parse_default parse str eos_is_error =
       | Syntaxerr.Ill_formed_ast (loc, s) ->
           Error ([mkloc loc],
                  Printf.sprintf "Error: broken invariant in parsetree: %s" s)
+#endif
+#if OCAML_VERSION >= (4, 04, 0)
+      | Syntaxerr.Invalid_package_type (loc, s) ->
+          Error ([mkloc loc],
+                 Printf.sprintf "Invalid package type: %s" s)
 #endif
     end
     | Syntaxerr.Escape_error | Parsing.Parse_error ->

src/lib/uTop_complete.cppo.ml

@@ -428,6 +428,16 @@ let add_names_of_type decl acc =
         acc
 #endif
 
+#if OCAML_VERSION >= (4, 04, 0)
+let path_of_mty_alias = function
+  | Mty_alias (_, path) -> path
+  | _ -> assert false
+#else
+let path_of_mty_alias = function
+  | Mty_alias path -> path
+  | _ -> assert false
+#endif
+
 let rec names_of_module_type = function
   | Mty_signature decls ->
       List.fold_left
@@ -458,7 +468,8 @@ let rec names_of_module_type = function
         | None -> String_set.empty
     end
 #if OCAML_VERSION >= (4, 02, 0)
-  | Mty_alias path -> begin
+  | Mty_alias _ as mty_alias -> begin
+      let path = path_of_mty_alias mty_alias in
       match lookup_env Env.find_module path !Toploop.toplevel_env with
         | None -> String_set.empty
         | Some { md_type = module_type } -> names_of_module_type module_type
@@ -497,7 +508,8 @@ let rec fields_of_module_type = function
         | None -> String_set.empty
     end
 #if OCAML_VERSION >= (4, 02, 0)
-  | Mty_alias path -> begin
+  | Mty_alias _ as mty_alias -> begin
+      let path = path_of_mty_alias mty_alias in
       match lookup_env Env.find_module path !Toploop.toplevel_env with
         | None -> String_set.empty
         | Some { md_type = module_type } -> fields_of_module_type module_type
@@ -568,6 +580,10 @@ let list_global_names () =
 #if OCAML_VERSION >= (4, 02, 0)
     | Env.Env_functor_arg(summary, id) ->
         loop (add (Ident.name id) acc) summary
+#endif
+#if OCAML_VERSION >= (4, 04, 0)
+    | Env.Env_constraints (summary, _) ->
+        loop acc summary
 #endif
     | Env.Env_open(summary, path) ->
         match try Some (Path_map.find path !local_names_by_path) with Not_found -> None with
@@ -634,6 +650,10 @@ let list_global_fields () =
         loop (add (Ident.name id) acc) summary
     | Env.Env_cltype(summary, id, _) ->
         loop (add (Ident.name id) acc) summary
+#if OCAML_VERSION >= (4, 04, 0)
+    | Env.Env_constraints (summary, _) ->
+        loop acc summary
+#endif
     | Env.Env_open(summary, path) ->
         match try Some (Path_map.find path !local_fields_by_path) with Not_found -> None with
           | Some fields ->

src/lib/uTop_main.cppo.ml

@@ -93,6 +93,12 @@ let parse_input_multi input =
   in
   (result, Buffer.contents buf)
 
+#if OCAML_VERSION >= (4, 04, 0)
+let ast_impl_kind = Pparse.Structure
+#elif OCAML_VERSION >= (4, 02, 0)
+let ast_impl_kind = Config.ast_impl_magic_number
+#endif
+
 let parse_and_check input eos_is_error =
   let buf = Buffer.create 32 in
   let preprocess input =
@@ -101,7 +107,7 @@ let parse_and_check input eos_is_error =
     | UTop.Value (Parsetree.Ptop_def pstr) ->
         begin try
           let pstr = Pparse.apply_rewriters ~tool_name:"ocaml"
-                                Config.ast_impl_magic_number pstr in
+                                ast_impl_kind pstr in
           UTop.Value (Parsetree.Ptop_def pstr)
         with Pparse.Error error ->
           Pparse.report_error Format.str_formatter error;
@@ -490,6 +496,14 @@ let rewrite_rules = [
   }
 ]
 
+#if OCAML_VERSION >= (4, 04, 0)
+let lookup_type longident env =
+  let path = Env.lookup_type longident env in
+  (path, Env.find_type path env)
+#else
+let lookup_type = Env.lookup_type
+#endif
+
 let rule_path rule =
   match rule.path_to_rewrite with
   | Some _ as x -> x
@@ -497,7 +511,7 @@ let rule_path rule =
     try
       let env = !Toploop.toplevel_env in
       let path =
-        match Env.lookup_type rule.type_to_rewrite env with
+        match lookup_type rule.type_to_rewrite env with
         | path, { Types.type_kind     = Types.Type_abstract
                 ; Types.type_private  = Asttypes.Public
                 ; Types.type_manifest = Some ty
@@ -1063,7 +1077,7 @@ let typeof sid =
   in
   let out_sig_item =
     try
-      let (path, ty_decl) = Env.lookup_type id env in
+      let (path, ty_decl) = lookup_type id env in
       let id = Ident.create (Path.name path) in
       Some (Printtyp.tree_of_type_declaration id ty_decl Types.Trec_not)
     with Not_found ->