major refactor

bin/dune

@@ -1,30 +0,0 @@
-(executables
- (names main)
- (modes byte)
-  (modules main)
- (link_flags (-linkall))
- (libraries topinf
-            tsdl
-            tgls.tgles2
-            wall
-            zed
-            irmin-unix
-            ocaml-compiler-libs.common
-            ocaml-compiler-libs.bytecomp
-            ocaml-compiler-libs.toplevel
-            findlib))
-
-(library
- (name topinf)
- (modes byte)
- (modules topinf)
- (libraries tsdl
-            tgls.tgles2
-            wall
-            zed
-            irmin-unix
-            ocaml-compiler-libs.common
-            ocaml-compiler-libs.bytecomp
-            ocaml-compiler-libs.toplevel
-            findlib))
-  

bin/init.ml

@@ -1,6 +0,0 @@
-#directory "";;
-
-let x = 1.0;;
-
-assert (x = 1.0)
-  

bin/topinf.mli

@@ -1,12 +0,0 @@
-(* Accessors for the table of toplevel value bindings.  These functions
-     must appear as first and second exported functions in this module.
-     (See module Translmod.) *)
-val getvalue : string -> Obj.t
-
-val setvalue : string -> Obj.t -> unit
-
-val print_toplevel_value_bindings : unit -> unit
-
-type evalenv = Format.formatter -> string -> unit
-
-val init : Format.formatter -> evalenv

dune

@@ -0,0 +1,36 @@
+(env
+  (dev
+   (flags (:standard -warn-error -A))))
+
+(executable
+ (name main)
+ (modes byte)
+ (modules main)
+ (link_flags (-linkall))
+ (libraries
+  topinf
+  tsdl
+  tgls.tgles2
+  wall
+  zed
+  irmin-unix
+  ocaml-compiler-libs.common
+  ocaml-compiler-libs.bytecomp
+  ocaml-compiler-libs.toplevel))
+
+(executable
+ (name test)
+ (modes byte)
+ (modules test)
+ (link_flags (-linkall))
+ (libraries
+  topinf))
+
+
+(library
+ (name topinf)
+ (modes byte)
+ (modules topinf)
+ (libraries
+   fmt
+  ocaml-compiler-libs.toplevel))

dune-project

@@ -1,2 +1,3 @@
 (lang dune 2.8)
 (name komm)
+(wrapped_executables false)

init.ml

@@ -0,0 +1,14 @@
+(* $Id$ -*- tuareg -*- *)
+
+#directory "/home/cqc/p/pinephone/komm/komm/_build/default/.topinf.objs/byte";;
+open Topinf;;
+let print_directives () = 
+  Format.eprintf "directive_info_table:@.";
+  Hashtbl.iter (fun n _ -> Format.eprintf "\t%s@." n) Topinf.directive_info_table;;
+
+#directory "+compiler-libs";;
+
+let print_modules () =
+  Format.eprintf "Env.fold_modules:\n";
+  Env.fold_modules (fun modname _ _ () -> Format.eprintf "\t%s@." modname) None !Topinf.toplevel_env ();;
+print_modules ();;

lib/dune

@@ -1,2 +0,0 @@
-(library
- (name komm))

main.ml

@@ -1,4 +1,3 @@
-[@@@ocaml.warning "-6-9-26-27-32-34"]
 
 open Lwt.Infix
 module F = Fmt
@@ -50,16 +49,6 @@ module Display = struct
   let event_of_sdlevent ev =
     match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with
     | `Text_editing ->
-        F.epr
-          "event_of_sdlevent: `Text_editing\n\
-           \twindow_id=%d\n\
-           \ttext=%s\n\
-           \tstart=%d\n\
-           \tlength=%d@."
-          (Sdl.Event.get ev Sdl.Event.text_editing_window_id)
-          (Sdl.Event.get ev Sdl.Event.text_editing_text)
-          (Sdl.Event.get ev Sdl.Event.text_editing_start)
-          (Sdl.Event.get ev Sdl.Event.text_editing_length);
         `None
     | `Text_input -> `Text_input (Sdl.Event.get ev Sdl.Event.text_input_text)
     | (`Key_down | `Key_up) as w ->
@@ -84,9 +73,6 @@ module Display = struct
           }
         in
         let repeat = Sdl.Event.get ev Sdl.Event.keyboard_repeat in
-        (* (match w with `Key_down -> F.epr "key_down: " | `Key_up -> F.epr "key_up: ");
-           F.epr "%s@." (str_of_key k);
-           F.epr "\tkeyboard_repeat=%d\n" repeat ; *)
         if repeat < 1 then
           match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k
         else `None
@@ -94,7 +80,6 @@ module Display = struct
         let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in
         `Mouse mouse_xy
     | `Quit ->
-        F.epr "Quit Event\n";
         `Quit
     | _ -> (*F.epr "Unknown Event@." ; *) `None
 
@@ -157,7 +142,6 @@ module Display = struct
 
   let display_frame frame render =
     (* create and fill event list *)
-    let tstart = ticks () in
     let ev = Sdl.Event.create () in
     let el = ref [ `None ] in
     while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do
@@ -188,7 +172,6 @@ module Display = struct
           | a -> Some a (*| a -> Some a*))
         !el;
     if List.length !el > 0 then (
-      (*        F.epr "Passing in %d events\n" (List.length !el);    *)
       let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
       let _, (_, image) =
         render
@@ -211,7 +194,7 @@ module Display = struct
       let width = float width and height = float height in
       Wall.Renderer.render frame.wall ~width ~height image;
       Sdl.gl_swap_window frame.sdl_win;
-      (*F.epr "event loop took %0.6f seconds\n" (ticks () -. tstart); *) Ok ())
+      Ok ())
     else Ok ()
 
   let run frame render () =
@@ -361,7 +344,6 @@ let draw_pp height fpp (s : Display.state) =
   let font_height = fm.ascent -. fm.descent +. fm.line_gap in
   let max_x = ref 0. in
   let out_string text o l =
-    (*    F.epr "\tout_string: %s %s@." (String.sub text o l) (str_of_box !sc.box);*)
     let sp = !sc in
     push @@ simple_text font (String.sub text o l) !sc;
     max_x := max !max_x (Box2.maxx !box);
@@ -377,7 +359,6 @@ let draw_pp height fpp (s : Display.state) =
     ()
   in
   let out_newline () =
-    (*   F.epr "\tout_newline: %s@." (str_of_box !sc.box);)*)
     sc :=
       {
         !sc with
@@ -388,11 +369,9 @@ let draw_pp height fpp (s : Display.state) =
       }
   in
   let out_spaces n =
-    (*    F.epr "\tout_spaces: n=%d %s@." n (str_of_box !sc.box);*)
     let wpx = Text.Font.text_width font " " in
     if Box2.ox !sc.box +. (float n *. wpx) > Box2.maxx !sc.box then (
       (* WRAP *)
-      F.epr "out_spaces: ===== WRAP =======@.";
       out_newline ());
     let so = !sc in
     let bo = Box2.v (Box2.o !sc.box) (P2.v (float n *. wpx) height) in
@@ -405,7 +384,6 @@ let draw_pp height fpp (s : Display.state) =
     sc := { !sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box) }
   in
   let out_indent n =
-    (*    F.epr "\tout_indent: n=%d %s@." n (str_of_box !sc.box);*)
     let p = min (Box2.w !sc.box -. 1.) (height *. 2.0 *. float n) in
     sc :=
       {
@@ -446,7 +424,6 @@ let draw_pp height fpp (s : Display.state) =
   let margin = int_of_float (Box2.w s.box /. Text.Font.text_width font " ") in
   let max_indent = margin - 1 in
   Format.pp_safe_set_geometry pp ~max_indent ~margin;
-  (*  F.epr "draw_pp: margin = %d, max_indent = %d@." (Format.pp_get_margin pp ()) (Format.pp_get_max_indent pp ());*)
   fpp pp;
   Format.pp_force_newline pp ();
   (!sc, (Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box)), !node))
@@ -486,7 +463,6 @@ let draw_textedit (te : textedit) height (s : Display.state) =
           | _ -> ())
       | `Key_up _ -> ()
       | `Text_input s ->
-          F.epr "draw_textedit: `Text_input %s@." s;
           Zed_edit.insert ctx (Zed_rope.of_string (Zed_string.of_utf8 s));
           ()
       | _ -> ())
@@ -608,10 +584,8 @@ let draw_top (t : top) height (s : Display.state) =
   (* HACK use Lazy.? *)
   Display.handle_keyevents s.events (function
     | `Key_up { char = '\r'; mods = [ Ctrl ]; _ } ->
-        F.epr "draw_top: previous t.res=@.";
         format_symbolic_output_buffer F.stderr
           (Format.flush_symbolic_output_buffer t.res);
-        Topinf.print_toplevel_value_bindings ();
         (* HACK overwriting stdout formatter because fucking ocaml/toplevel/topdirs.ml hardcodes it *)
         Format.pp_set_formatter_out_functions Format.std_formatter
           (out_funs_of_sob t.res);
@@ -642,7 +616,7 @@ let draw_top (t : top) height (s : Display.state) =
     ]
     s
 
-let top_1 = make_top "../../rootstore" ()
+let top_1 = make_top "../rootstore" ()
 
 let draw_komm (s : Display.state) =
   let node, state, box = (ref I.empty, ref s, ref s.box) in

test.ml

@@ -0,0 +1,6 @@
+
+
+
+
+let eval = (Topinf.init Format.std_formatter) Format.std_formatter in
+eval "#use \"init.ml\";;";

topinf.ml

@@ -1,9 +1,6 @@
-[@@@ocaml.warning "-6-9-26-27-32-33-34"]
+[@@@ocaml.warning "-32"]
 
 module F = Fmt
-
-let _ = F.epr "topinf.ml comin at ya @."
-
 open Format
 open Misc
 open Parsetree
@@ -39,17 +36,15 @@ let phrase_buffer = Buffer.create 1024
 let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty
 
 let getvalue name =
-  F.epr "Topinf.getvalue %s@." name;
   try String.Map.find name !toplevel_value_bindings
   with Not_found -> fatal_error (name ^ " unbound at toplevel")
 
 let setvalue name v =
-  F.epr "Topinf.setvalue %s@." name;
   toplevel_value_bindings := String.Map.add name v !toplevel_value_bindings
 
-let print_toplevel_value_bindings () =
+let print_toplevel_value_bindings ppf =
   String.Map.iter
-    (fun k v -> F.epr "toplevel_value_bindings: %s\n" k)
+    (fun k _ -> F.pf ppf "toplevel_value_bindings: %s\n" k)
     !toplevel_value_bindings
 
 (* copied in lots of ocaml/lambda/translmod.ml *)
@@ -75,8 +70,6 @@ let cons_opt x_opt xs = match x_opt with None -> xs | Some x -> x :: xs
 (* Keep track of the root path (from the root of the namespace to the
    currently compiled module expression).  Useful for naming extensions. *)
 
-let global_path glob = Some (Pident glob)
-
 let functor_path path param =
   match path with None -> None | Some p -> Some (Papply (p, Pident param))
 
@@ -237,7 +230,7 @@ let compose_coercions c1 c2 =
 let primitive_declarations = ref ([] : Primitive.description list)
 
 let record_primitive = function
-  | { val_kind = Val_prim p; val_loc } ->
+  | { val_kind = Val_prim p; val_loc; _ } ->
       Translprim.check_primitive_arity val_loc p;
       primitive_declarations := p :: !primitive_declarations
   | _ -> ()
@@ -276,13 +269,13 @@ let init_shape id modl =
   and init_shape_struct env sg =
     match sg with
     | [] -> []
-    | Sig_value (subid, { val_kind = Val_reg; val_type = ty; val_loc = loc }, _)
+    | Sig_value (subid, { val_kind = Val_reg; val_type = ty; val_loc = loc; _ }, _)
       :: rem ->
         let init_v =
           match Ctype.expand_head env ty with
-          | { desc = Tarrow (_, _, _, _) } ->
+          | { desc = Tarrow (_, _, _, _); _} ->
               const_int 0 (* camlinternalMod.Function *)
-          | { desc = Tconstr (p, _, _) } when Path.same p Predef.path_lazy_t ->
+          | { desc = Tconstr (p, _, _); _} when Path.same p Predef.path_lazy_t ->
               const_int 1 (* camlinternalMod.Lazy *)
           | _ ->
               let not_a_function =
@@ -291,12 +284,12 @@ let init_shape id modl =
               raise (Initialization_failure not_a_function)
         in
         init_v :: init_shape_struct env rem
-    | Sig_value (_, { val_kind = Val_prim _ }, _) :: rem ->
+    | Sig_value (_, { val_kind = Val_prim _; _}, _) :: rem ->
         init_shape_struct env rem
     | Sig_value _ :: _rem -> assert false
     | Sig_type (id, tdecl, _, _) :: rem ->
         init_shape_struct (Env.add_type ~check:false id tdecl env) rem
-    | Sig_typext (subid, { ext_loc = loc }, _, _) :: _ ->
+    | Sig_typext (subid, { ext_loc = loc; _}, _, _) :: _ ->
         raise
           (Initialization_failure
              (Unsafe { reason = Unsafe_typext; loc; subid }))
@@ -458,7 +451,7 @@ let transl_class_bindings ~scopes cl_list =
   let ids = List.map (fun (ci, _) -> ci.ci_id_class) cl_list in
   ( ids,
     List.map
-      (fun ({ ci_id_class = id; ci_expr = cl; ci_virt = vf }, meths) ->
+      (fun ({ ci_id_class = id; ci_expr = cl; ci_virt = vf; _}, meths) ->
         (id, transl_class ~scopes ids id meths cl vf))
       cl_list )
 
@@ -684,7 +677,7 @@ and transl_structure ~scopes loc fields cc rootpath final_env = function
                   ext.tyexn_constructor,
                 body ),
             size )
-      | Tstr_module ({ mb_presence = Mp_present } as mb) -> (
+      | Tstr_module ({ mb_presence = Mp_present; _} as mb) -> (
           let id = mb.mb_id in
           (* Translate module first *)
           let subscopes =
@@ -728,7 +721,7 @@ and transl_structure ~scopes loc fields cc rootpath final_env = function
               in
               ( Llet (pure_module mb.mb_expr, Pgenval, id, module_body, body),
                 size ))
-      | Tstr_module ({ mb_presence = Mp_absent } as mb) ->
+      | Tstr_module ({ mb_presence = Mp_absent; _} as mb) ->
           List.iter
             (Translattribute.check_attribute_on_module mb.mb_expr)
             mb.mb_attributes;
@@ -861,11 +854,9 @@ let set_toplevel_unique_name id =
   aliased_idents := Ident.add id (Ident.unique_toplevel_name id) !aliased_idents
 
 let toplevel_name id =
-  F.epr "toplevel_name: %s @." (Ident.name id);
   try Ident.find_same id !aliased_idents with Not_found -> Ident.name id
 
 let toploop_getvalue id =
-  F.epr "toploop_getvalue: %s @." (Ident.name id);
   Lapply
     {
       ap_loc = Loc_unknown;
@@ -885,7 +876,6 @@ let toploop_getvalue id =
     }
 
 let toploop_setvalue id lam =
-  F.epr "toploop_setvalue: %s @." (Ident.name id);
   Lapply
     {
       ap_loc = Loc_unknown;
@@ -906,7 +896,6 @@ let toploop_setvalue id lam =
     }
 
 let toploop_setvalue_id id =
-  F.epr "toploop_setvalue_id: %s @." (Ident.name id);
   toploop_setvalue id (Lambda.Lvar id)
 
 let close_toplevel_term (lam, ()) =
@@ -919,7 +908,7 @@ let transl_toplevel_item ~scopes (item : structure_item) =
   match item.str_desc with
   | Tstr_eval (expr, _)
   | Tstr_value
-      (Nonrecursive, [ { vb_pat = { pat_desc = Tpat_any }; vb_expr = expr } ])
+      (Nonrecursive, [ { vb_pat = { pat_desc = Tpat_any; _}; vb_expr = expr; _} ])
     ->
       (* special compilation for toplevel "let _ = expr", so
          that Toploop can display the result of the expression.
@@ -942,9 +931,9 @@ let transl_toplevel_item ~scopes (item : structure_item) =
       toploop_setvalue ext.tyexn_constructor.ext_id
         (transl_extension_constructor ~scopes item.str_env None
            ext.tyexn_constructor)
-  | Tstr_module { mb_id = None; mb_presence = Mp_present; mb_expr = modl } ->
+  | Tstr_module { mb_id = None; mb_presence = Mp_present; mb_expr = modl; _} ->
       transl_module ~scopes Tcoerce_none None modl
-  | Tstr_module { mb_id = Some id; mb_presence = Mp_present; mb_expr = modl } ->
+  | Tstr_module { mb_id = Some id; mb_presence = Mp_present; mb_expr = modl; _} ->
       (* we need to use the unique name for the module because of issues
          with "open" (PR#8133) *)
       set_toplevel_unique_name id;
@@ -1018,7 +1007,7 @@ let transl_toplevel_item ~scopes (item : structure_item) =
               mid,
               transl_module ~scopes Tcoerce_none None od.open_expr,
               set_idents 0 ids ))
-  | Tstr_module ({ mb_presence = Mp_absent } as mb) ->
+  | Tstr_module ({ mb_presence = Mp_absent; _} as mb) ->
       List.iter
         (Translattribute.check_attribute_on_module mb.mb_expr)
         mb.mb_attributes;
@@ -1227,7 +1216,7 @@ let load_lambda ppf lam =
 (* Print the outcome of an evaluation *)
 let pr_item =
   Printtyp.print_items (fun env -> function
-    | Sig_value (id, { val_kind = Val_reg; val_type }, _) ->
+    | Sig_value (id, { val_kind = Val_reg; val_type; _}, _) ->
         Some (outval_of_value env (getvalue (toplevel_name id)) val_type)
     | _ -> None)
 
@@ -1327,10 +1316,10 @@ let execute_phrase print_outcome ppf phr =
                              ( Asttypes.Nonrecursive,
                                [
                                  {
-                                   vb_pat = { pat_desc = Tpat_any };
+                                   vb_pat = { pat_desc = Tpat_any; _};
-                                   vb_expr = exp;
+                                   vb_expr = exp; _
                                  };
-                               ] ) );
+                               ] ) ); _
                      };
                     ] ->
                         let outv = outval_of_value newenv v exp.exp_type in
@@ -1361,7 +1350,7 @@ let execute_phrase print_outcome ppf phr =
       with x ->
         toplevel_env := oldenv;
         raise x)
-  | Ptop_dir { pdir_name = { Location.txt = dir_name }; pdir_arg } -> (
+  | Ptop_dir { pdir_name = { Location.txt = dir_name; _}; pdir_arg; _} -> (
       let d =
         try Some (Hashtbl.find directive_table dir_name)
         with Not_found -> None
@@ -1380,10 +1369,10 @@ let execute_phrase print_outcome ppf phr =
           | Directive_none f, None ->
               f ();
               true
-          | Directive_string f, Some { pdira_desc = Pdir_string s } ->
+          | Directive_string f, Some { pdira_desc = Pdir_string s; _} ->
               f s;
               true
-          | Directive_int f, Some { pdira_desc = Pdir_int (n, None) } -> (
+          | Directive_int f, Some { pdira_desc = Pdir_int (n, None); _} -> (
               match Int_literal_converter.int n with
               | n ->
                   f n;
@@ -1394,13 +1383,13 @@ let execute_phrase print_outcome ppf phr =
                      integers for directive `%s'.@."
                     dir_name;
                   false)
-          | Directive_int _, Some { pdira_desc = Pdir_int (_, Some _) } ->
+          | Directive_int _, Some { pdira_desc = Pdir_int (_, Some _); _} ->
               fprintf ppf "Wrong integer literal for directive `%s'.@." dir_name;
               false
-          | Directive_ident f, Some { pdira_desc = Pdir_ident lid } ->
+          | Directive_ident f, Some { pdira_desc = Pdir_ident lid; _} ->
               f lid;
               true
-          | Directive_bool f, Some { pdira_desc = Pdir_bool b } ->
+          | Directive_bool f, Some { pdira_desc = Pdir_bool b; _} ->
               f b;
               true
           | _ ->
@@ -1769,10 +1758,6 @@ module Topdirs = struct
         Some (path, args)
     | _ -> None
 
-  type 'a printer_type_new = Format.formatter -> 'a -> unit
-
-  type 'a printer_type_old = 'a -> unit
-
   let printer_type ppf typename =
     let printer_type =
       match
@@ -1915,7 +1900,7 @@ module Topdirs = struct
               && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
               &&
               match Ctype.(repr (expand_head !toplevel_env desc.val_type)) with
-              | { desc = Tarrow _ } -> true
+              | { desc = Tarrow _; _ } -> true
               | _ -> false
             then (
               match is_traced clos with
@@ -2058,7 +2043,7 @@ module Topdirs = struct
         if is_exception_constructor env desc.cstr_res then raise Not_found;
         let path =
           match Ctype.repr desc.cstr_res with
-          | { desc = Tconstr (path, _, _) } -> path
+          | { desc = Tconstr (path, _, _); _} -> path
           | _ -> raise Not_found
         in
         let type_decl = Env.find_type path env in
@@ -2335,7 +2320,6 @@ end
 type evalenv = Format.formatter -> string -> unit
 
 let eval lb ppf (text : string) =
-  F.epr "Topmain.eval: \n";
   Topdirs.std_out := ppf;
   (read_interactive_input :=
      fun buffer _ ->
@@ -2345,21 +2329,16 @@ let eval lb ppf (text : string) =
        String.length text);
   let snap = Btype.snapshot () in
   try
-    F.epr "Topmain.eval: 1 reset@.";
     Buffer.reset phrase_buffer;
     (* Reset the phrase buffer, then flush the lexing buffer. *)
     Lexing.flush_input lb;
     (* calls read_interactive_input to fill buffer again *)
     Location.reset ();
     Warnings.reset_fatal ();
-    F.epr "Topmain.eval: 2 parse_toplevel_phrase@.";
     let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in
-    F.epr "Topmain.eval: 3 preprocess_phrase@.";
     let phr = preprocess_phrase ppf phr in
-    F.epr "Topmain.eval: 4 Env.reset_cache_toplevel@.";
     Env.reset_cache_toplevel ();
-    F.epr "Topmain.eval: 5 execute_phrase=%b@." (execute_phrase true ppf phr);
+    ignore (execute_phrase true ppf phr)
-    F.epr "Topmain.eval: 6 handle exceptions@."
   with
   | End_of_file ->
       F.epr "Topmain.eval End_of_file exception\n";
@@ -2379,7 +2358,6 @@ let eval lb ppf (text : string) =
 let preload_objects = ref [ (*"komm.cma"*) ]
 
 let init ppf =
-  F.epr "Topmain.init: \n";
   Topdirs.std_out := ppf;
   Clflags.include_dirs :=
     List.rev_append [ Sys.getcwd () ] !Clflags.include_dirs;
@@ -2395,12 +2373,9 @@ let init ppf =
   Compmisc.read_clflags_from_env ();
   set_paths ();
   (try
-     F.epr "Load_path.get_paths: @.";
-     List.iter (fun s -> F.epr "\t%s\n" s) (Load_path.get_paths ());
      let res =
        List.for_all
          (fun name ->
-           F.epr "Topdirs.load_file: name=%s@." name;
            Topdirs.load_file ppf name)
          (List.rev !preload_objects @ !Compenv.first_objfiles)
      in

topinf.mli

@@ -0,0 +1,25 @@
+(* Accessors for the table of toplevel value bindings.  These functions
+     must appear as first and second exported functions in this module.
+     (See module Translmod.) *)
+val getvalue : string -> Obj.t
+val setvalue : string -> Obj.t -> unit
+(* End accessors for table of toplevel value bindings that must be first in the module signature *)
+
+val print_toplevel_value_bindings : Format.formatter -> unit
+
+val toplevel_env : Env.t ref
+
+type evalenv = Format.formatter -> string -> unit
+
+val init : Format.formatter -> evalenv
+
+type directive_fun =
+  | Directive_none of (unit -> unit)
+  | Directive_string of (string -> unit)
+  | Directive_int of (int -> unit)
+  | Directive_ident of (Longident.t -> unit)
+  | Directive_bool of (bool -> unit)
+
+type directive_info = { section : string; doc : string }
+
+val directive_info_table : (string, directive_info) Hashtbl.t