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
115
116
117
118
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *)
(* *)
(* Copyright 2013 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
let auto_include find_in_dir fn =
if !Clflags.no_std_include then
raise Not_found
else
let alert = Location.auto_include_alert in
Load_path.auto_include_otherlibs alert find_in_dir fn
(* Initialize the search path.
[dir] (default: the current directory)
is always searched first unless -nocwd is specified,
then the directories specified with the -I option (in command-line order),
then the standard library directory (unless the -nostdlib option is given).
*)
let init_path ?(auto_include=auto_include) ?(dir="") () =
let dirs =
if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
else
!Clflags.include_dirs
in
let dirs =
!Compenv.last_include_dirs @ dirs @ Config.flexdll_dirs @
!Compenv.first_include_dirs
in
let exp_dirs =
List.map (Misc.expand_directory Config.standard_library) dirs
in
let dirs =
(if !Clflags.no_cwd then [] else [dir])
@ List.rev_append exp_dirs (Clflags.std_include_dir ())
in
Load_path.init ~auto_include dirs;
Env.reset_cache ()
(* Return the initial environment in which compilation proceeds. *)
(* Note: do not do init_path() in initial_env, this breaks
toplevel initialization (PR#8227) *)
let initial_env () =
Ident.reinit();
Types.Uid.reinit();
let initially_opened_module =
if !Clflags.nopervasives then
None
else
Some "Stdlib"
in
Typemod.initial_env
~loc:(Location.in_file "command line")
~initially_opened_module
~open_implicit_modules:(List.rev !Clflags.open_modules)
let set_from_env flag Clflags.{ parse; usage; env_var } =
try
match parse (Sys.getenv env_var) with
| None ->
Location.prerr_warning Location.none
(Warnings.Bad_env_variable (env_var, usage))
| Some x -> match !flag with
| None -> flag := Some x
| Some _ -> ()
with
Not_found -> ()
let read_clflags_from_env () =
set_from_env Clflags.color Clflags.color_reader;
if
Option.is_none !Clflags.color &&
Option.is_some (Sys.getenv_opt "NO_COLOR")
then
Clflags.color := Some Misc.Color.Never;
set_from_env Clflags.error_style Clflags.error_style_reader;
()
let rec make_directory dir =
if Sys.file_exists dir then () else
begin
make_directory (Filename.dirname dir);
Sys.mkdir dir 0o777
end
let with_ppf_dump ~file_prefix f =
let with_ch ch =
let ppf = Format.formatter_of_out_channel ch in
ppf,
(fun () ->
Format.pp_print_flush ppf ();
close_out ch)
in
let ppf_dump, finally =
match !Clflags.dump_dir, !Clflags.dump_into_file with
| None, false -> Format.err_formatter, ignore
| None, true -> with_ch (open_out (file_prefix ^ ".dump"))
| Some d, _ ->
let () = make_directory Filename.(dirname @@ concat d @@ file_prefix) in
let _, ch =
Filename.open_temp_file ~temp_dir:d (file_prefix ^ ".") ".dump"
in
with_ch ch
in
Misc.try_finally (fun () -> f ppf_dump) ~always:finally
|
