make utop work with trunk

src/camlp4/uTop_camlp4.ml

@@ -13,7 +13,11 @@ open Camlp4.PreCast
 
 module Ast2pt = Camlp4.Struct.Camlp4Ast2OCamlAst.Make(Ast)
 
+#if ocaml_version < (4, 2, 0)
 external cast_toplevel_phrase : Camlp4_import.Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase = "%identity"
+#else
+let cast_toplevel_phrase x = x
+#endif
 
 let print_camlp4_error pp exn =
   Format.fprintf pp "@[<0>%a@]" Camlp4.ErrorHandler.print exn;

src/lib/uTop.ml

@@ -249,6 +249,11 @@ let parse_default parse str eos_is_error =
       | Syntaxerr.Variable_in_scope (loc, var) ->
         Error ([mkloc loc],
                Printf.sprintf "In this scoped type, variable '%s is reserved for the local type %s." var var)
+#endif
+#if ocaml_version >= (4, 2, 0)
+      | Syntaxerr.Not_expecting (loc, nonterm) ->
+          Error ([mkloc loc],
+                 Printf.sprintf "Syntax error: %s not expected" nonterm)
 #endif
     end
     | Syntaxerr.Escape_error | Parsing.Parse_error ->
@@ -305,6 +310,7 @@ let check_phrase phrase =
         let env = !Toploop.toplevel_env in
         (* Construct "let _ () = let module _ = struct <items> end in ()" in order to test
            the typing and compilation of [items] without evaluating them. *)
+#if ocaml_version < (4, 2, 0)
         let structure = {
           pmod_loc = loc;
           pmod_desc = Pmod_structure (item :: items);
@@ -332,6 +338,18 @@ let check_phrase phrase =
                                       ppat_loc = loc }, func)]);
           pstr_loc = loc;
         } in
+#else
+        let top_def =
+          let open Ast_helper in
+          let open Convenience in
+          with_default_loc loc
+            (fun () ->
+               Str.eval
+                 (Exp.letmodule (with_loc loc "_")
+                    (Mod.structure (item :: items))
+                    (unit ())))
+        in
+#endif
         let check_phrase = Ptop_def [top_def] in
         try
           let _ =

src/lib/uTop_complete.ml

@@ -369,7 +369,10 @@ let visible_modules () =
             acc)
         String_set.empty !Config.load_path)
 
-#if ocaml_version >= (4, 0, 0)
+#if ocaml_version >= (4, 2, 0)
+let field_name { ld_id = id } = Ident.name id
+let constructor_name { cd_id = id } = Ident.name id
+#elif ocaml_version >= (4, 0, 0)
 let field_name (id, _, _) = Ident.name id
 let constructor_name (id, _, _) = Ident.name id
 #else
@@ -413,8 +416,13 @@ let rec names_of_module_type = function
         String_set.empty decls
   | Mty_ident path -> begin
       match lookup_env Env.find_modtype path !Toploop.toplevel_env with
+#if ocaml_version < (4, 2, 0)
         | Some Modtype_abstract -> String_set.empty
         | Some Modtype_manifest module_type -> names_of_module_type module_type
+#else
+        | Some { mtd_type = None } -> String_set.empty
+        | Some { mtd_type = Some module_type } -> names_of_module_type module_type
+#endif
         | None -> String_set.empty
     end
   | _ ->
@@ -436,8 +444,13 @@ let rec fields_of_module_type = function
         String_set.empty decls
   | Mty_ident path -> begin
       match lookup_env Env.find_modtype path !Toploop.toplevel_env with
+#if ocaml_version < (4, 2, 0)
         | Some Modtype_abstract -> String_set.empty
         | Some Modtype_manifest module_type -> fields_of_module_type module_type
+#else
+        | Some { mtd_type = None } -> String_set.empty
+        | Some { mtd_type = Some module_type } -> fields_of_module_type module_type
+#endif
         | None -> String_set.empty
     end
   | _ ->
@@ -493,11 +506,21 @@ let rec fields_of_module_type = function
 
 #endif
 
+#if ocaml_version < (4, 2, 0)
+let lookup_module = Env.lookup_module
+let find_module = Env.find_module
+#else
+let lookup_module id env =
+  let path = Env.lookup_module id env in
+  (path, Env.find_modtype_expansion path env)
+let find_module path env = (Env.find_module path env).md_type
+#endif
+
 let names_of_module longident =
   try
     Longident_map.find longident !local_names_by_longident
   with Not_found ->
-    match lookup_env Env.lookup_module longident !Toploop.toplevel_env with
+    match lookup_env lookup_module longident !Toploop.toplevel_env with
       | Some(path, module_type) ->
           let names = names_of_module_type module_type in
           local_names_by_path := Path_map.add path names !local_names_by_path;
@@ -511,7 +534,7 @@ let fields_of_module longident =
   try
     Longident_map.find longident !local_fields_by_longident
   with Not_found ->
-    match lookup_env Env.lookup_module longident !Toploop.toplevel_env with
+    match lookup_env lookup_module longident !Toploop.toplevel_env with
       | Some(path, module_type) ->
           let fields = fields_of_module_type module_type in
           local_fields_by_path := Path_map.add path fields !local_fields_by_path;
@@ -538,12 +561,16 @@ let list_global_names () =
         loop (add (Ident.name id) acc) summary
     | Env.Env_cltype(summary, id, _) ->
         loop (add (Ident.name id) acc) summary
+#if ocaml_version >= (4, 2, 0)
+    | Env.Env_functor_arg(summary, id) ->
+        loop (add (Ident.name id) acc) summary
+#endif
     | Env.Env_open(summary, path) ->
         match try Some (Path_map.find path !local_names_by_path) with Not_found -> None with
           | Some names ->
               loop (String_set.union acc names) summary
           | None ->
-              match lookup_env Env.find_module path !Toploop.toplevel_env with
+              match lookup_env find_module path !Toploop.toplevel_env with
                 | Some module_type ->
                     let names = names_of_module_type module_type in
                     local_names_by_path := Path_map.add path names !local_names_by_path;
@@ -589,6 +616,10 @@ let list_global_fields () =
         loop (add (Ident.name id) acc) summary
     | Env.Env_module(summary, id, _) ->
         loop (add (Ident.name id) acc) summary
+#if ocaml_version >= (4, 2, 0)
+    | Env.Env_functor_arg(summary, id) ->
+        loop (add (Ident.name id) acc) summary
+#endif
     | Env.Env_modtype(summary, id, _) ->
         loop (add (Ident.name id) acc) summary
     | Env.Env_class(summary, id, _) ->
@@ -600,7 +631,7 @@ let list_global_fields () =
           | Some fields ->
               loop (String_set.union acc fields) summary
           | None ->
-              match lookup_env Env.find_module path !Toploop.toplevel_env with
+              match lookup_env find_module path !Toploop.toplevel_env with
                 | Some module_type ->
                     let fields = fields_of_module_type module_type in
                     local_fields_by_path := Path_map.add path fields !local_fields_by_path;

src/lib/uTop_main.ml

@@ -344,6 +344,7 @@ let longident_async_thread_safe_block_on_async_exn =
   Longident.parse "Async.Std.Thread_safe.block_on_async_exn"
 let longident_unit = Longident.Lident "()"
 
+#if ocaml_version < (4, 2, 0)
 (* Wrap <expr> into: fun () -> <expr> *)
 let wrap_unit loc e =
   let i = with_loc loc longident_unit in
@@ -355,19 +356,28 @@ let wrap_unit loc e =
     Parsetree.pexp_desc = Parsetree.Pexp_function ("", None, [(p, e)]);
     Parsetree.pexp_loc = loc;
   }
+#endif
 
 let () =
   (* Rewrite Lwt.t expressions to Lwt_main.run <expr> *)
   Hashtbl.add rewrite_rules (Longident.Ldot (Longident.Lident "Lwt", "t")) {
     required_values = [longident_lwt_main_run];
-    rewrite = (fun loc e -> {
+    rewrite = (fun loc e ->
-      Parsetree.pexp_desc =
+#if ocaml_version < (4, 2, 0)
+      { Parsetree.pexp_desc =
           Parsetree.Pexp_apply
             ({ Parsetree.pexp_desc = Parsetree.Pexp_ident (with_loc loc longident_lwt_main_run);
                Parsetree.pexp_loc = loc },
-           [("", e)]);
+             [("", e)])
-      Parsetree.pexp_loc = loc;
+      ; Parsetree.pexp_loc = loc }
-    });
+#else
+      let open Ast_helper in
+      let open Convenience in
+      with_default_loc loc (fun () ->
+        Exp.apply (Exp.ident (with_loc loc longident_lwt_main_run)) [("", e)]
+      )
+#endif
+    );
     enabled = UTop.auto_run_lwt;
   };
 
@@ -375,15 +385,25 @@ let () =
      Async.Std.Thread_safe.block_on_async_exn (fun () -> <expr>). *)
   let rule = {
     required_values = [longident_async_thread_safe_block_on_async_exn];
-    rewrite = (fun loc e -> {
+    rewrite = (fun loc e ->
-      Parsetree.pexp_desc =
+#if ocaml_version < (4, 2, 0)
+      { Parsetree.pexp_desc =
           Parsetree.Pexp_apply
             ({ Parsetree.pexp_desc = Parsetree.Pexp_ident
                                        (with_loc loc longident_async_thread_safe_block_on_async_exn);
                Parsetree.pexp_loc = loc },
-           [("", wrap_unit loc e)]);
+             [("", wrap_unit loc e)])
-      Parsetree.pexp_loc = loc;
+      ; Parsetree.pexp_loc = loc }
-    });
+#else
+      let open Ast_helper in
+      let open Convenience in
+      with_default_loc loc (fun () ->
+        Exp.apply
+          (Exp.ident (with_loc loc longident_async_thread_safe_block_on_async_exn))
+          [("", Exp.fun_ "" None (punit ()) e)]
+      )
+#endif
+    );
     enabled = UTop.auto_run_async;
   } in
   Hashtbl.add rewrite_rules (Longident.parse "Async_core.Ivar.Deferred.t") rule;
@@ -448,6 +468,7 @@ let str_items_of_typed_structure tstr = tstr
 let str_desc_of_typed_str_item tstr = tstr
 #endif
 
+#if ocaml_version < (4, 2, 0)
 let rewrite_str_item pstr_item tstr_item =
   match pstr_item, str_desc_of_typed_str_item tstr_item with
     | ({ Parsetree.pstr_desc = Parsetree.Pstr_eval e;
@@ -465,6 +486,25 @@ let rewrite_str_item pstr_item tstr_item =
     end
     | _ ->
       pstr_item
+#else
+let rewrite_str_item pstr_item tstr_item =
+  match pstr_item, str_desc_of_typed_str_item tstr_item with
+    | ({ Parsetree.pstr_desc = Parsetree.Pstr_eval (e, _);
+         Parsetree.pstr_loc = loc },
+       Typedtree.Tstr_eval ({ Typedtree.exp_type = typ }, _)) -> begin
+      match rule_of_type typ with
+        | Some rule ->
+          if React.S.value rule.enabled && List.for_all is_persistent_in_env rule.required_values then
+            { Parsetree.pstr_desc = Parsetree.Pstr_eval (rule.rewrite loc e, []);
+              Parsetree.pstr_loc = loc }
+          else
+            pstr_item
+        | None ->
+          pstr_item
+    end
+    | _ ->
+      pstr_item
+#endif
 
 let rewrite phrase =
   match phrase with
@@ -963,7 +1003,12 @@ 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)
       let (path, mod_typ) = Env.lookup_module id env in
+#else
+      let path = Env.lookup_module id env in
+      let mod_typ = Env.find_modtype_expansion path env in
+#endif
       let id = Ident.create (Path.name path) in
       Some (Printtyp.tree_of_module id mod_typ Types.Trec_not)
     with Not_found ->

syntax/pa_optcomp.ml

@@ -288,7 +288,7 @@ let rec eval env = function
 
   (* Boolean operations *)
   | <:expr< not $x$ >> -> Bool(not (eval_bool env x))
-  | <:expr< $x$ or $y$ >> -> Bool(eval_bool env x or eval_bool env y)
+  | <:expr< $x$ or $y$ >> -> Bool(eval_bool env x || eval_bool env y)
   | <:expr< $x$ || $y$ >> -> Bool(eval_bool env x || eval_bool env y)
   | <:expr< $x$ && $y$ >> -> Bool(eval_bool env x && eval_bool env y)