diff --git a/bin/dune b/bin/dune deleted file mode 100644 index 559b865..0000000 --- a/bin/dune +++ /dev/null @@ -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)) - diff --git a/bin/init.ml b/bin/init.ml deleted file mode 100644 index d13c504..0000000 --- a/bin/init.ml +++ /dev/null @@ -1,6 +0,0 @@ -#directory "";; - -let x = 1.0;; - -assert (x = 1.0) - diff --git a/bin/topinf.mli b/bin/topinf.mli deleted file mode 100644 index e1584f7..0000000 --- a/bin/topinf.mli +++ /dev/null @@ -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 diff --git a/dune b/dune new file mode 100644 index 0000000..34b04ab --- /dev/null +++ b/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)) diff --git a/dune-project b/dune-project index d3a8bf1..e5d4aa9 100644 --- a/dune-project +++ b/dune-project @@ -1,2 +1,3 @@ (lang dune 2.8) (name komm) +(wrapped_executables false) diff --git a/bin/fonts/NotoEmoji-Regular.ttf b/fonts/NotoEmoji-Regular.ttf similarity index 100% rename from bin/fonts/NotoEmoji-Regular.ttf rename to fonts/NotoEmoji-Regular.ttf diff --git a/bin/fonts/Roboto-Bold.ttf b/fonts/Roboto-Bold.ttf similarity index 100% rename from bin/fonts/Roboto-Bold.ttf rename to fonts/Roboto-Bold.ttf diff --git a/bin/fonts/Roboto-Light.ttf b/fonts/Roboto-Light.ttf similarity index 100% rename from bin/fonts/Roboto-Light.ttf rename to fonts/Roboto-Light.ttf diff --git a/bin/fonts/Roboto-Regular.ttf b/fonts/Roboto-Regular.ttf similarity index 100% rename from bin/fonts/Roboto-Regular.ttf rename to fonts/Roboto-Regular.ttf diff --git a/bin/fonts/entypo.ttf b/fonts/entypo.ttf similarity index 100% rename from bin/fonts/entypo.ttf rename to fonts/entypo.ttf diff --git a/init.ml b/init.ml new file mode 100644 index 0000000..bd6c11e --- /dev/null +++ b/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 ();; diff --git a/lib/dune b/lib/dune deleted file mode 100644 index 9587f17..0000000 --- a/lib/dune +++ /dev/null @@ -1,2 +0,0 @@ -(library - (name komm)) diff --git a/bin/main.ml b/main.ml similarity index 93% rename from bin/main.ml rename to main.ml index 71cdfb0..e7719aa 100644 --- a/bin/main.ml +++ b/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 diff --git a/test.ml b/test.ml new file mode 100644 index 0000000..936a915 --- /dev/null +++ b/test.ml @@ -0,0 +1,6 @@ + + + + +let eval = (Topinf.init Format.std_formatter) Format.std_formatter in +eval "#use \"init.ml\";;"; diff --git a/bin/topinf.ml b/topinf.ml similarity index 97% rename from bin/topinf.ml rename to topinf.ml index 2ea467a..73da4e2 100644 --- a/bin/topinf.ml +++ b/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_expr = exp; + vb_pat = { pat_desc = Tpat_any; _}; + 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); - F.epr "Topmain.eval: 6 handle exceptions@." + ignore (execute_phrase true ppf phr) 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 diff --git a/topinf.mli b/topinf.mli new file mode 100644 index 0000000..dccb749 --- /dev/null +++ b/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