[Caml-list] Opening a module from toploop startup

[Caml-list] Opening a module from toploop startup

[Michael Le Barbier Grünewald]

Dear Camlers,

I am learning to produce customised toplevel loops and, while I was able
to automatically add custom printers, could not open modules.

Obviously, there is something I should know, and don't… could someone
help me?

My code (working example, see below) is a bit long, so let me outline it:

The _startup_ procedure issues a few toploop directives, adding search
directories, installing printers for the given modules (currently one)
and opening them.

_open_module_ and _install_printer_ produce and interpret toplevel
phrases corresponding to the directives with the same name.

Tank you for your help,
Michael


----8<----
Compile:

    |ocamlfind ocamlc -c -package "compiler-libs" -o demonstrate.cmo
    demonstrate.ml|||
    |||ocamlfind ocamlmktop -package "compiler-libs" -custom -linkall
    -dllpath-all -linkpkg -package "compiler-libs" demonstrate.cmo -o
    mytoplevel|||
    ||

Demonstrate that the Demonstrate.Tag module is not opened:

    |> ./mytoplevel|||
    |||        OCaml version 4.00.1|||
    ||||
    |||# test_open_module;;|||
    |||Error: Unbound value test_open_module|||
    |||# ^D|||
    ||

Demonstrate that the custom printer is installed:

    |> ./mytoplevel|||
    |||        OCaml version 4.00.1|||
    ||||
    |||# open Demonstrate;;|||
    |||# (5 : Tag.t);;|||
    |||- : Demonstrate.Tag.t = Tag#5|||
    |||# ^D|

The whole code:
~~~~
|open Format||
||
||module Tag =||
||struct||
||  type t = int||
||  let format fft tag =||
||    fprintf fft "Tag#%d" tag||
||  let test_open_module () =||
||    true||
||end||
||
||let libdir = [||
||  "/usr/local/lib/ocaml/compiler-libs";||
||]||
||
||let execute_phrase ident phrase =||
||  if Toploop.execute_phrase false Format.std_formatter phrase||
||  then||
||    ()||
||  else||
||    failwith ident||
||
||let rec make_path_rev p =||
||  match p with||
||  | [] -> invalid_arg "make_path_rev"||
||  | h :: [] -> Longident.Lident h||
||  | h :: t -> Longident.Ldot (make_path_rev t, h)||
||
||let make_path p =||
||  make_path_rev (List.rev p)||
||    ||
||let install_printer path =||
||  let longident = make_path_rev ("format" :: List.rev path) in||
||  let phrase = Parsetree.Ptop_dir(||
||    "install_printer", Parsetree.Pdir_ident longident||
||  )||
||  in||
||  execute_phrase "install_printer" phrase||
||
||
||let open_module p =||
||  let open Parsetree in||
||  let open Location in||
||  let open Asttypes in||
||  let loc = {||
||    loc_start = Lexing.dummy_pos;||
||    loc_end = Lexing.dummy_pos;||
||    loc_ghost = false||
||  }||
||  in||
||  let phrase = Ptop_def [||
||    {||
||      pstr_desc =||
||    Pstr_open {||
||      txt = make_path p;||
||      loc;||
||    };||
||      pstr_loc = loc||
||    };||
||  ]||
||  in||
||  execute_phrase "open_module" phrase||
||
||let startup () =||
||  begin||
||    List.iter Topdirs.dir_directory libdir;||
||    List.iter install_printer [["Demonstrate"; "Tag"]];||
||    List.iter open_module [["Demonstrate"]; ["Demonstrate"; "Tag" ]];||
||  end||
||
||let _ =||
||  Toploop.toplevel_startup_hook := startup|
---->8----

[Caml-list] Re: Opening a module from toploop startup

[Michael]

Just a gentle ping on this one…

Maybe could someone suggest an open-source project where customisation 
of the toplevel takes place?

Also I am sorry about the poor formatting of my original message, I got 
tripped by HTML editing. The clean code is:
~~~~~~~~~
open Format

module Tag =
struct
   type t = int
   let format fft tag =
     fprintf fft "Tag#%d" tag
   let test_open_module () =
     true
end

let libdir = [
   "/usr/local/lib/ocaml/compiler-libs";
]

let execute_phrase ident phrase =
   if Toploop.execute_phrase false Format.std_formatter phrase
   then
     ()
   else
     failwith ident

let rec make_path_rev p =
   match p with
   | [] -> invalid_arg "make_path_rev"
   | h :: [] -> Longident.Lident h
   | h :: t -> Longident.Ldot (make_path_rev t, h)

let make_path p =
   make_path_rev (List.rev p)

let install_printer path =
   let longident = make_path_rev ("format" :: List.rev path) in
   let phrase = Parsetree.Ptop_dir(
     "install_printer", Parsetree.Pdir_ident longident
   )
   in
   execute_phrase "install_printer" phrase


let open_module p =
   let open Parsetree in
   let open Location in
   let open Asttypes in
   let loc = {
     loc_start = Lexing.dummy_pos;
     loc_end = Lexing.dummy_pos;
     loc_ghost = false
   }
   in
   let phrase = Ptop_def [
     {
       pstr_desc =
     Pstr_open {
       txt = make_path p;
       loc;
     };
       pstr_loc = loc
     };
   ]
   in
   execute_phrase "open_module" phrase

let startup () =
   begin
     List.iter Topdirs.dir_directory libdir;
     List.iter install_printer [["Demonstrate"; "Tag"]];
     List.iter open_module [["Demonstrate"]; ["Demonstrate"; "Tag" ]];
   end

let _ =
   Toploop.toplevel_startup_hook := startup
~~~~~~~~~

Michael Le Barbier Grünewald schrieb:
> Dear Camlers,
>
> I am learning to produce customised toplevel loops and, while I was able
> to automatically add custom printers, could not open modules.
>
> Obviously, there is something I should know, and don't… could someone
> help me?
>
> My code (working example, see below) is a bit long, so let me outline it:
>
> The _startup_ procedure issues a few toploop directives, adding search
> directories, installing printers for the given modules (currently one)
> and opening them.
>
> _open_module_ and _install_printer_ produce and interpret toplevel
> phrases corresponding to the directives with the same name.
>
> Tank you for your help,
> Michael
>
>
> ----8<----
> Compile:
>
>      |ocamlfind ocamlc -c -package "compiler-libs" -o demonstrate.cmo
>      demonstrate.ml|||
>      |||ocamlfind ocamlmktop -package "compiler-libs" -custom -linkall
>      -dllpath-all -linkpkg -package "compiler-libs" demonstrate.cmo -o
>      mytoplevel|||
>      ||
>
> Demonstrate that the Demonstrate.Tag module is not opened:
>
>      |> ./mytoplevel|||
>      |||        OCaml version 4.00.1|||
>      ||||
>      |||# test_open_module;;|||
>      |||Error: Unbound value test_open_module|||
>      |||# ^D|||
>      ||
>
> Demonstrate that the custom printer is installed:
>
>      |> ./mytoplevel|||
>      |||        OCaml version 4.00.1|||
>      ||||
>      |||# open Demonstrate;;|||
>      |||# (5 : Tag.t);;|||
>      |||- : Demonstrate.Tag.t = Tag#5|||
>      |||# ^D|
>
> The whole code:
> ~~~~
> |open Format||
> ||
> ||module Tag =||
> ||struct||
> ||  type t = int||
> ||  let format fft tag =||
> ||    fprintf fft "Tag#%d" tag||
> ||  let test_open_module () =||
> ||    true||
> ||end||
> ||
> ||let libdir = [||
> ||  "/usr/local/lib/ocaml/compiler-libs";||
> ||]||
> ||
> ||let execute_phrase ident phrase =||
> ||  if Toploop.execute_phrase false Format.std_formatter phrase||
> ||  then||
> ||    ()||
> ||  else||
> ||    failwith ident||
> ||
> ||let rec make_path_rev p =||
> ||  match p with||
> ||  | [] -> invalid_arg "make_path_rev"||
> ||  | h :: [] -> Longident.Lident h||
> ||  | h :: t -> Longident.Ldot (make_path_rev t, h)||
> ||
> ||let make_path p =||
> ||  make_path_rev (List.rev p)||
> ||    ||
> ||let install_printer path =||
> ||  let longident = make_path_rev ("format" :: List.rev path) in||
> ||  let phrase = Parsetree.Ptop_dir(||
> ||    "install_printer", Parsetree.Pdir_ident longident||
> ||  )||
> ||  in||
> ||  execute_phrase "install_printer" phrase||
> ||
> ||
> ||let open_module p =||
> ||  let open Parsetree in||
> ||  let open Location in||
> ||  let open Asttypes in||
> ||  let loc = {||
> ||    loc_start = Lexing.dummy_pos;||
> ||    loc_end = Lexing.dummy_pos;||
> ||    loc_ghost = false||
> ||  }||
> ||  in||
> ||  let phrase = Ptop_def [||
> ||    {||
> ||      pstr_desc =||
> ||    Pstr_open {||
> ||      txt = make_path p;||
> ||      loc;||
> ||    };||
> ||      pstr_loc = loc||
> ||    };||
> ||  ]||
> ||  in||
> ||  execute_phrase "open_module" phrase||
> ||
> ||let startup () =||
> ||  begin||
> ||    List.iter Topdirs.dir_directory libdir;||
> ||    List.iter install_printer [["Demonstrate"; "Tag"]];||
> ||    List.iter open_module [["Demonstrate"]; ["Demonstrate"; "Tag" ]];||
> ||  end||
> ||
> ||let _ =||
> ||  Toploop.toplevel_startup_hook := startup|
> ---->8----

Re: [Caml-list] Re: Opening a module from toploop startup

[Daniel Bünzli]

Le mardi, 9 juillet 2013 à 10:26, Michael a écrit :
> Maybe could someone suggest an open-source project where customisation
> of the toplevel takes place?

You can checkout this thread [1].

Best,

Daniel

[1] http://lists.ocaml.org/pipermail/platform/2013-March/000380.html

Re: [Caml-list] Re: Opening a module from toploop startup

[Anil Madhavapeddy]

This (rather rough) snippet of code is what we're using in Real World OCaml to automate the output generation. It's in turn based on Christophe's code from http://github.com/ocaml/ocaml.org.  It does run a set of initial phrases to activate and open Core, which is what you're looking for.

https://gist.github.com/avsm/5949199

It won't quite compile out of the box, and it requires 4.01.0dev+trunk due to its use of short_paths, so it's best to crib from it than try to use it directly.

One downside to the current toplevel is that it's rather hard to distinguish compiler output from the program output.  We'll either switch to utop (which has support for this), or modify this toplevel to pass the compiler output formatter a separate fd from the stdin/stdout so that they can be distinguished more clearly.

Hope that helps,
Anil

On 9 Jul 2013, at 10:26, Michael <michipili@gmail.com> wrote:

> Just a gentle ping on this one…
> 
> Maybe could someone suggest an open-source project where customisation of the toplevel takes place?
> 
> Also I am sorry about the poor formatting of my original message, I got tripped by HTML editing. The clean code is:
> ~~~~~~~~~
> open Format
> 
> module Tag =
> struct
>  type t = int
>  let format fft tag =
>    fprintf fft "Tag#%d" tag
>  let test_open_module () =
>    true
> end
> 
> let libdir = [
>  "/usr/local/lib/ocaml/compiler-libs";
> ]
> 
> let execute_phrase ident phrase =
>  if Toploop.execute_phrase false Format.std_formatter phrase
>  then
>    ()
>  else
>    failwith ident
> 
> let rec make_path_rev p =
>  match p with
>  | [] -> invalid_arg "make_path_rev"
>  | h :: [] -> Longident.Lident h
>  | h :: t -> Longident.Ldot (make_path_rev t, h)
> 
> let make_path p =
>  make_path_rev (List.rev p)
> 
> let install_printer path =
>  let longident = make_path_rev ("format" :: List.rev path) in
>  let phrase = Parsetree.Ptop_dir(
>    "install_printer", Parsetree.Pdir_ident longident
>  )
>  in
>  execute_phrase "install_printer" phrase
> 
> 
> let open_module p =
>  let open Parsetree in
>  let open Location in
>  let open Asttypes in
>  let loc = {
>    loc_start = Lexing.dummy_pos;
>    loc_end = Lexing.dummy_pos;
>    loc_ghost = false
>  }
>  in
>  let phrase = Ptop_def [
>    {
>      pstr_desc =
>    Pstr_open {
>      txt = make_path p;
>      loc;
>    };
>      pstr_loc = loc
>    };
>  ]
>  in
>  execute_phrase "open_module" phrase
> 
> let startup () =
>  begin
>    List.iter Topdirs.dir_directory libdir;
>    List.iter install_printer [["Demonstrate"; "Tag"]];
>    List.iter open_module [["Demonstrate"]; ["Demonstrate"; "Tag" ]];
>  end
> 
> let _ =
>  Toploop.toplevel_startup_hook := startup
> ~~~~~~~~~
> 
> Michael Le Barbier Grünewald schrieb:
>> Dear Camlers,
>> 
>> I am learning to produce customised toplevel loops and, while I was able
>> to automatically add custom printers, could not open modules.
>> 
>> Obviously, there is something I should know, and don't… could someone
>> help me?
>> 
>> My code (working example, see below) is a bit long, so let me outline it:
>> 
>> The _startup_ procedure issues a few toploop directives, adding search
>> directories, installing printers for the given modules (currently one)
>> and opening them.
>> 
>> _open_module_ and _install_printer_ produce and interpret toplevel
>> phrases corresponding to the directives with the same name.
>> 
>> Tank you for your help,
>> Michael
>> 
>> 
>> ----8<----
>> Compile:
>> 
>>     |ocamlfind ocamlc -c -package "compiler-libs" -o demonstrate.cmo
>>     demonstrate.ml|||
>>     |||ocamlfind ocamlmktop -package "compiler-libs" -custom -linkall
>>     -dllpath-all -linkpkg -package "compiler-libs" demonstrate.cmo -o
>>     mytoplevel|||
>>     ||
>> 
>> Demonstrate that the Demonstrate.Tag module is not opened:
>> 
>>     |> ./mytoplevel|||
>>     |||        OCaml version 4.00.1|||
>>     ||||
>>     |||# test_open_module;;|||
>>     |||Error: Unbound value test_open_module|||
>>     |||# ^D|||
>>     ||
>> 
>> Demonstrate that the custom printer is installed:
>> 
>>     |> ./mytoplevel|||
>>     |||        OCaml version 4.00.1|||
>>     ||||
>>     |||# open Demonstrate;;|||
>>     |||# (5 : Tag.t);;|||
>>     |||- : Demonstrate.Tag.t = Tag#5|||
>>     |||# ^D|
>> 
>> The whole code:
>> ~~~~
>> |open Format||
>> ||
>> ||module Tag =||
>> ||struct||
>> ||  type t = int||
>> ||  let format fft tag =||
>> ||    fprintf fft "Tag#%d" tag||
>> ||  let test_open_module () =||
>> ||    true||
>> ||end||
>> ||
>> ||let libdir = [||
>> ||  "/usr/local/lib/ocaml/compiler-libs";||
>> ||]||
>> ||
>> ||let execute_phrase ident phrase =||
>> ||  if Toploop.execute_phrase false Format.std_formatter phrase||
>> ||  then||
>> ||    ()||
>> ||  else||
>> ||    failwith ident||
>> ||
>> ||let rec make_path_rev p =||
>> ||  match p with||
>> ||  | [] -> invalid_arg "make_path_rev"||
>> ||  | h :: [] -> Longident.Lident h||
>> ||  | h :: t -> Longident.Ldot (make_path_rev t, h)||
>> ||
>> ||let make_path p =||
>> ||  make_path_rev (List.rev p)||
>> ||    ||
>> ||let install_printer path =||
>> ||  let longident = make_path_rev ("format" :: List.rev path) in||
>> ||  let phrase = Parsetree.Ptop_dir(||
>> ||    "install_printer", Parsetree.Pdir_ident longident||
>> ||  )||
>> ||  in||
>> ||  execute_phrase "install_printer" phrase||
>> ||
>> ||
>> ||let open_module p =||
>> ||  let open Parsetree in||
>> ||  let open Location in||
>> ||  let open Asttypes in||
>> ||  let loc = {||
>> ||    loc_start = Lexing.dummy_pos;||
>> ||    loc_end = Lexing.dummy_pos;||
>> ||    loc_ghost = false||
>> ||  }||
>> ||  in||
>> ||  let phrase = Ptop_def [||
>> ||    {||
>> ||      pstr_desc =||
>> ||    Pstr_open {||
>> ||      txt = make_path p;||
>> ||      loc;||
>> ||    };||
>> ||      pstr_loc = loc||
>> ||    };||
>> ||  ]||
>> ||  in||
>> ||  execute_phrase "open_module" phrase||
>> ||
>> ||let startup () =||
>> ||  begin||
>> ||    List.iter Topdirs.dir_directory libdir;||
>> ||    List.iter install_printer [["Demonstrate"; "Tag"]];||
>> ||    List.iter open_module [["Demonstrate"]; ["Demonstrate"; "Tag" ]];||
>> ||  end||
>> ||
>> ||let _ =||
>> ||  Toploop.toplevel_startup_hook := startup|
>> ---->8----
> 
> 
> -- 
> Caml-list mailing list.  Subscription management and archives:
> https://sympa.inria.fr/sympa/arc/caml-list
> Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
> Bug reports: http://caml.inria.fr/bin/caml-bugs
> 

Re: [Caml-list] Re: Opening a module from toploop startup

[Michael]

Hi Daniel, Hi Anil,

thank you very much for your very useful answers, they helped a lot!

I could have a look at them today, and I studied in more details the
toplevel code, and since the startup hook is processed before that the
toplevel has been initialised, it is probably not a good place to open
modules:

let main () =
  Arg.parse Options.list file_argument usage;
  if not (prepare Format.err_formatter) then exit 2;
  Toploop.loop Format.std_formatter

let loop ppf =
  fprintf ppf "        OCaml version %s@.@." Config.version;
  initialize_toplevel_env ();
  …

let prepare ppf =
  Toploop.set_paths ();
  try
    let res =
      List.for_all (Topdirs.load_file ppf) (List.rev !preload_objects) in
    !Toploop.toplevel_startup_hook ();
    res
  with x ->
    …

A better place to open these modules is probably the initialisation file.


The example of the “core-runner-toplevel” shows well how to write an
alternate toplevel, I will probably found it very useful when I will
need more substantial amenagements.

Regards,
Michael