fix for trunk
This commit is contained in:
parent
d49693ac4b
commit
b0795906e5
|
@ -44,7 +44,7 @@ let get_ui () = S.value UTop_private.ui
|
||||||
type profile = Dark | Light
|
type profile = Dark | Light
|
||||||
|
|
||||||
let profile, set_profile = S.create Dark
|
let profile, set_profile = S.create Dark
|
||||||
let set_profile p = set_profile p
|
let set_profile p = set_profile p
|
||||||
|
|
||||||
let size = UTop_private.size
|
let size = UTop_private.size
|
||||||
|
|
||||||
|
@ -312,12 +312,12 @@ let check_phrase phrase =
|
||||||
let env = !Toploop.toplevel_env in
|
let env = !Toploop.toplevel_env in
|
||||||
(* Construct "let _ () = let module _ = struct <items> end in ()" in order to test
|
(* Construct "let _ () = let module _ = struct <items> end in ()" in order to test
|
||||||
the typing and compilation of [items] without evaluating them. *)
|
the typing and compilation of [items] without evaluating them. *)
|
||||||
|
let unit = with_loc loc (Longident.Lident "()") in
|
||||||
#if ocaml_version < (4, 2, 0)
|
#if ocaml_version < (4, 2, 0)
|
||||||
let structure = {
|
let structure = {
|
||||||
pmod_loc = loc;
|
pmod_loc = loc;
|
||||||
pmod_desc = Pmod_structure (item :: items);
|
pmod_desc = Pmod_structure (item :: items);
|
||||||
} in
|
} in
|
||||||
let unit = with_loc loc (Longident.Lident "()") in
|
|
||||||
let unit_expr = {
|
let unit_expr = {
|
||||||
pexp_desc = Pexp_construct (unit, None, false);
|
pexp_desc = Pexp_construct (unit, None, false);
|
||||||
pexp_loc = loc;
|
pexp_loc = loc;
|
||||||
|
@ -343,13 +343,12 @@ let check_phrase phrase =
|
||||||
#else
|
#else
|
||||||
let top_def =
|
let top_def =
|
||||||
let open Ast_helper in
|
let open Ast_helper in
|
||||||
let open Convenience in
|
|
||||||
with_default_loc loc
|
with_default_loc loc
|
||||||
(fun () ->
|
(fun () ->
|
||||||
Str.eval
|
Str.eval
|
||||||
(Exp.letmodule (with_loc loc "_")
|
(Exp.letmodule (with_loc loc "_")
|
||||||
(Mod.structure (item :: items))
|
(Mod.structure (item :: items))
|
||||||
(unit ())))
|
(Exp.construct unit None)))
|
||||||
in
|
in
|
||||||
#endif
|
#endif
|
||||||
let check_phrase = Ptop_def [top_def] in
|
let check_phrase = Ptop_def [top_def] in
|
||||||
|
|
|
@ -372,7 +372,6 @@ let () =
|
||||||
; Parsetree.pexp_loc = loc }
|
; Parsetree.pexp_loc = loc }
|
||||||
#else
|
#else
|
||||||
let open Ast_helper in
|
let open Ast_helper in
|
||||||
let open Convenience in
|
|
||||||
with_default_loc loc (fun () ->
|
with_default_loc loc (fun () ->
|
||||||
Exp.apply (Exp.ident (with_loc loc longident_lwt_main_run)) [("", e)]
|
Exp.apply (Exp.ident (with_loc loc longident_lwt_main_run)) [("", e)]
|
||||||
)
|
)
|
||||||
|
@ -396,11 +395,11 @@ let () =
|
||||||
; Parsetree.pexp_loc = loc }
|
; Parsetree.pexp_loc = loc }
|
||||||
#else
|
#else
|
||||||
let open Ast_helper in
|
let open Ast_helper in
|
||||||
let open Convenience in
|
let punit = Pat.construct (with_loc loc (Longident.Lident "()")) None in
|
||||||
with_default_loc loc (fun () ->
|
with_default_loc loc (fun () ->
|
||||||
Exp.apply
|
Exp.apply
|
||||||
(Exp.ident (with_loc loc longident_async_thread_safe_block_on_async_exn))
|
(Exp.ident (with_loc loc longident_async_thread_safe_block_on_async_exn))
|
||||||
[("", Exp.fun_ "" None (punit ()) e)]
|
[("", Exp.fun_ "" None punit e)]
|
||||||
)
|
)
|
||||||
#endif
|
#endif
|
||||||
);
|
);
|
||||||
|
@ -661,7 +660,11 @@ let read_input_classic prompt buffer len =
|
||||||
else
|
else
|
||||||
Lwt_io.read_char_opt Lwt_io.stdin >>= function
|
Lwt_io.read_char_opt Lwt_io.stdin >>= function
|
||||||
| Some c ->
|
| Some c ->
|
||||||
|
#if ocaml_version >= (4, 02, 0)
|
||||||
|
Bytes.set buffer i c;
|
||||||
|
#else
|
||||||
buffer.[i] <- c;
|
buffer.[i] <- c;
|
||||||
|
#endif
|
||||||
if c = '\n' then
|
if c = '\n' then
|
||||||
return (i + 1, false)
|
return (i + 1, false)
|
||||||
else
|
else
|
||||||
|
@ -1021,9 +1024,13 @@ let typeof sid =
|
||||||
let cstr_desc = Env.lookup_constructor id env in
|
let cstr_desc = Env.lookup_constructor id env in
|
||||||
match cstr_desc.Types.cstr_tag with
|
match cstr_desc.Types.cstr_tag with
|
||||||
| Types.Cstr_exception (_path, loc) ->
|
| Types.Cstr_exception (_path, loc) ->
|
||||||
|
#if ocaml_version < (4, 2, 0)
|
||||||
let path, exn_decl = Typedecl.transl_exn_rebind env loc id in
|
let path, exn_decl = Typedecl.transl_exn_rebind env loc id in
|
||||||
let id = Ident.create (Path.name path) in
|
let id = Ident.create (Path.name path) in
|
||||||
Some (Printtyp.tree_of_exception_declaration id exn_decl)
|
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
|
let (path, ty_decl) = from_type_desc cstr_desc.Types.cstr_res.Types.desc in
|
||||||
let id = Ident.create (Path.name path) in
|
let id = Ident.create (Path.name path) in
|
||||||
|
|
|
@ -70,7 +70,7 @@ let env = ref Env.empty
|
||||||
let define id value = env := Env.add id value !env
|
let define id value = env := Env.add id value !env
|
||||||
|
|
||||||
let _ =
|
let _ =
|
||||||
define "ocaml_version" (Scanf.sscanf Sys.ocaml_version "%d.%d" (fun major minor -> Tuple [Int major; Int minor]))
|
define "ocaml_version" (Scanf.sscanf Sys.ocaml_version "%d.%d.%d" (fun major minor patchlevel -> Tuple [Int major; Int minor; Int patchlevel]))
|
||||||
|
|
||||||
let dirs = ref []
|
let dirs = ref []
|
||||||
let add_include_dir dir = dirs := dir :: !dirs
|
let add_include_dir dir = dirs := dir :: !dirs
|
||||||
|
|
Loading…
Reference in New Issue