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
112
113
114
open Std
open Local_store
type typer_state = Local_store.store
let current_state = s_ref None
let new_state () =
let store = Local_store.fresh () in
Local_store.with_store store (fun () -> current_state := Some store);
store
let with_state state f =
if Local_store.is_bound () then
failwith "Mocaml.with_state: another instance is already in use";
match Local_store.with_store state f with
| r -> Cmt_format.clear (); r
| exception exn -> Cmt_format.clear (); reraise exn
let is_current_state state = match !current_state with
| Some state' -> state == state'
| None -> false
let setup_reader_config config = (
assert Local_store.(is_bound ());
let open Mconfig in
let open Clflags in
let ocaml = config.ocaml in
Env.set_unit_name (Mconfig.unitname config);
Location.input_name := config.query.filename;
fast := ocaml.unsafe ;
classic := ocaml.classic ;
principal := ocaml.principal ;
real_paths := ocaml.real_paths ;
recursive_types := ocaml.recursive_types ;
strict_sequence := ocaml.strict_sequence ;
applicative_functors := ocaml.applicative_functors ;
nopervasives := ocaml.nopervasives ;
strict_formats := ocaml.strict_formats ;
open_modules := ocaml.open_modules ;
)
let setup_typer_config config = (
setup_reader_config config;
Load_path.(init ~auto_include:no_auto_include (Mconfig.build_path config));
)
(** Switchable implementation of Oprint *)
let default_out_value = !Oprint.out_value
let default_out_type = !Oprint.out_type
let default_out_class_type = !Oprint.out_class_type
let default_out_module_type = !Oprint.out_module_type
let default_out_sig_item = !Oprint.out_sig_item
let default_out_signature = !Oprint.out_signature
let default_out_type_extension = !Oprint.out_type_extension
let default_out_phrase = !Oprint.out_phrase
let replacement_printer = ref None
let oprint default inj ppf x = match !replacement_printer with
| None -> default ppf x
| Some printer -> printer ppf (inj x)
let () =
let open Extend_protocol.Reader in
Oprint.out_value :=
oprint default_out_value (fun x -> Out_value x);
Oprint.out_type :=
oprint default_out_type (fun x -> Out_type x);
Oprint.out_class_type :=
oprint default_out_class_type (fun x -> Out_class_type x);
Oprint.out_module_type :=
oprint default_out_module_type (fun x -> Out_module_type x);
Oprint.out_sig_item :=
oprint default_out_sig_item (fun x -> Out_sig_item x);
Oprint.out_signature :=
oprint default_out_signature (fun x -> Out_signature x);
Oprint.out_type_extension :=
oprint default_out_type_extension (fun x -> Out_type_extension x);
Oprint.out_phrase :=
oprint default_out_phrase (fun x -> Out_phrase x)
let default_printer ppf =
let open Extend_protocol.Reader in function
| Out_value x -> default_out_value ppf x
| Out_type x -> default_out_type ppf x
| Out_class_type x -> default_out_class_type ppf x
| Out_module_type x -> default_out_module_type ppf x
| Out_sig_item x -> default_out_sig_item ppf x
| Out_signature x -> default_out_signature ppf x
| Out_type_extension x -> default_out_type_extension ppf x
| Out_phrase x -> default_out_phrase ppf x
let with_printer printer f =
let_ref replacement_printer (Some printer) f
let clear_caches () = (
Cmi_cache.clear ();
Cmt_cache.clear ();
Directory_content_cache.clear ();
)
let flush_caches ?older_than () = (
Cmi_cache.flush ?older_than ();
Cmt_cache.flush ?older_than ()
)