make UTop_main.interact work and add an example
This commit is contained in:
parent
fa05edcc93
commit
05a0816d95
|
@ -0,0 +1,7 @@
|
|||
OC := ocamlbuild -classic-display -no-links -use-ocamlfind
|
||||
|
||||
build:
|
||||
$(OC) -pkg threads,compiler-libs.toplevel,utop test_program.byte
|
||||
|
||||
clean:
|
||||
$(OC) -clean
|
|
@ -0,0 +1 @@
|
|||
true: thread, linkall, predicate(create_toploop), warn(-40), bin_annot
|
|
@ -0,0 +1,12 @@
|
|||
type t = A of int | B of string
|
||||
|
||||
let some_value = [A 42; B "Hello, world"]
|
||||
|
||||
let () =
|
||||
print_endline "Starting utop now!";
|
||||
UTop_main.interact
|
||||
~search_path:["_build"]
|
||||
~unit:__MODULE__
|
||||
~loc:__POS__
|
||||
~values:[V ("some_value", some_value)]
|
||||
;;
|
|
@ -0,0 +1 @@
|
|||
(* empty *)
|
|
@ -1368,8 +1368,13 @@ type value = V : string * _ -> value
|
|||
exception Found of Env.t
|
||||
|
||||
let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
|
||||
let fname = Misc.find_in_path_uncap search_path (unit ^ ".cmt") in
|
||||
let cmt_infos = Cmt_format.read_cmt fname in
|
||||
let cmt_fname =
|
||||
try
|
||||
Misc.find_in_path_uncap search_path (unit ^ ".cmt")
|
||||
with Not_found ->
|
||||
Printf.ksprintf failwith "%s.cmt not found in search path!" fname
|
||||
in
|
||||
let cmt_infos = Cmt_format.read_cmt cmt_fname in
|
||||
let search = object(self)
|
||||
inherit [unit] UTop_cmt_lifter.lifter as super
|
||||
|
||||
|
@ -1383,6 +1388,11 @@ let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
|
|||
with
|
||||
| (_, Some l, Required), (_, Some v, Required) ->
|
||||
let pos = l.exp_loc.loc_start in
|
||||
Printf.eprintf "%s:%d:%d %s:%d:%d\n%!"
|
||||
fname lnum cnum
|
||||
pos.pos_fname
|
||||
pos.pos_lnum
|
||||
(pos.pos_cnum - pos.pos_bol);
|
||||
if pos.pos_fname = fname &&
|
||||
pos.pos_lnum = lnum &&
|
||||
pos.pos_cnum - pos.pos_bol = cnum then
|
||||
|
@ -1412,6 +1422,8 @@ let interact ~search_path ~unit ~loc:(fname, lnum, cnum, _) ~values =
|
|||
match search#lift_Cmt_format_cmt_infos cmt_infos with
|
||||
| () -> failwith "Couldn't find location in cmt file"
|
||||
| exception (Found env) ->
|
||||
Clflags.include_dirs := cmt_infos.cmt_loadpath @ !Clflags.include_dirs;
|
||||
let env = Env.env_of_only_summary Envaux.env_from_summary env in
|
||||
List.iter (fun (V (name, v)) -> Toploop.setvalue name (Obj.repr v)) values;
|
||||
main_internal ~initial_env:(Some env)
|
||||
;;
|
||||
|
|
Loading…
Reference in New Issue