/usr/lib/ocaml/tophide/tophide.ml is in libtophide-ocaml-dev 1.0.3-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | (* $Id$ *)
(*
Copyright 2008 Martin Jambon. All rights reserved.
This file is distributed under the terms stated in file LICENSE.
*)
open Toploop
open Outcometree
type env = {
print_out_class_type :
Format.formatter -> out_class_type -> unit;
print_out_module_type :
Format.formatter -> out_module_type -> unit;
print_out_phrase :
Format.formatter -> out_phrase -> unit;
print_out_sig_item :
Format.formatter -> out_sig_item -> unit;
print_out_signature :
Format.formatter -> out_sig_item list -> unit;
print_out_type :
Format.formatter -> out_type -> unit;
print_out_value :
Format.formatter -> out_value -> unit;
}
let save_env () = {
print_out_class_type = !print_out_class_type;
print_out_module_type = !print_out_module_type;
print_out_phrase = !print_out_phrase;
print_out_sig_item = !print_out_sig_item;
print_out_signature = !print_out_signature;
print_out_type = !print_out_type;
print_out_value = !print_out_value;
}
let load_env env =
print_out_class_type := env.print_out_class_type;
print_out_module_type := env.print_out_module_type;
print_out_phrase := env.print_out_phrase;
print_out_sig_item := env.print_out_sig_item;
print_out_signature := env.print_out_signature;
print_out_type := env.print_out_type;
print_out_value := env.print_out_value
let default_env = save_env ()
let filter_sig_item = function
Osig_class (_, _, _, _, _)
| Osig_class_type (_, _, _, _, _)
| Osig_typext _
| Osig_modtype _
| Osig_module _
| Osig_type _ as x -> Some x
| Osig_value (name, _, _) as x ->
if name <> "" && name.[0] = '_' then None
else Some x
let rec select f = function
[] -> []
| hd :: tl ->
match f hd with
None -> select f tl
| Some x -> x :: select f tl
let special_print_out_phrase fmt x0 =
let x =
match x0 with
Ophr_signature l0 ->
let l =
select (
fun (si0, ov) ->
match filter_sig_item si0 with
None -> None
| Some si -> Some (si, ov)
) l0
in
Ophr_signature l
| Ophr_eval _
| Ophr_exception _ -> x0
in
default_env.print_out_phrase fmt x
let special_env =
{ default_env with print_out_phrase = special_print_out_phrase }
let hide () = load_env special_env
let show () = load_env default_env
let _ =
(* Add "#hide" directive: *)
Hashtbl.add
directive_table
"hide"
(Directive_none hide);
(* Add "#show" directive: *)
Hashtbl.add
directive_table
"show"
(Directive_none show);
(* Enter "hide" mode upon loading *)
hide ()
|