blob: 33a198ed832813c20f44e03ac9d1a27aeb7d8a13 (
plain)
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2002 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* The batch compiler *)
open Misc
open Config
open Format
open Typedtree
(* Initialize the search path.
The current directory is always searched first,
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 () =
let dirs =
if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
else if !Clflags.use_vmthreads then "+vmthreads" :: !Clflags.include_dirs
else !Clflags.include_dirs in
let exp_dirs =
List.map (expand_directory Config.standard_library) dirs in
load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
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#1775) *)
let initial_env () =
Ident.reinit();
try
if !Clflags.nopervasives
then Env.initial
else Env.open_pers_signature "Pervasives" Env.initial
with Not_found ->
fatal_error "cannot open pervasives.cmi"
(* Note: this function is duplicated in optcompile.ml *)
let check_unit_name ppf filename name =
try
begin match name.[0] with
| 'A'..'Z' -> ()
| _ ->
Location.print_warning (Location.in_file filename) ppf
(Warnings.Bad_module_name name);
raise Exit;
end;
for i = 1 to String.length name - 1 do
match name.[i] with
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> ()
| _ ->
Location.print_warning (Location.in_file filename) ppf
(Warnings.Bad_module_name name);
raise Exit;
done;
with Exit -> ()
;;
(* Compile a .mli file *)
let interface ppf sourcefile outputprefix =
Location.input_name := sourcefile;
init_path ();
let modulename =
String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
check_unit_name ppf sourcefile modulename;
Env.set_unit_name modulename;
let inputfile = Pparse.preprocess sourcefile in
try
let ast =
Pparse.file ppf inputfile Parse.interface ast_intf_magic_number in
if !Clflags.dump_parsetree then fprintf ppf "%a@." Printast.interface ast;
let sg = Typemod.transl_signature (initial_env()) ast in
if !Clflags.print_types then
fprintf std_formatter "%a@." Printtyp.signature
(Typemod.simplify_signature sg);
Warnings.check_fatal ();
if not !Clflags.print_types then
Env.save_signature sg modulename (outputprefix ^ ".cmi");
Pparse.remove_preprocessed inputfile
with e ->
Pparse.remove_preprocessed_if_ast inputfile;
raise e
(* Compile a .ml file *)
let print_if ppf flag printer arg =
if !flag then fprintf ppf "%a@." printer arg;
arg
let (++) x f = f x
let implementation ppf sourcefile outputprefix =
Location.input_name := sourcefile;
init_path ();
let modulename =
String.capitalize(Filename.basename(chop_extension_if_any sourcefile)) in
check_unit_name ppf sourcefile modulename;
Env.set_unit_name modulename;
let inputfile = Pparse.preprocess sourcefile in
let env = initial_env() in
if !Clflags.print_types then begin
try ignore(
Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ Typemod.type_implementation sourcefile outputprefix modulename env)
with x ->
Pparse.remove_preprocessed_if_ast inputfile;
raise x
end else begin
let objfile = outputprefix ^ ".cmo" in
let oc = open_out_bin objfile in
try
Pparse.file ppf inputfile Parse.implementation ast_impl_magic_number
++ print_if ppf Clflags.dump_parsetree Printast.implementation
++ Unused_var.warn ppf
++ Typemod.type_implementation sourcefile outputprefix modulename env
++ Translmod.transl_implementation modulename
++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
++ Simplif.simplify_lambda
++ print_if ppf Clflags.dump_lambda Printlambda.lambda
++ Bytegen.compile_implementation modulename
++ print_if ppf Clflags.dump_instr Printinstr.instrlist
++ Emitcode.to_file oc modulename;
Warnings.check_fatal ();
close_out oc;
Pparse.remove_preprocessed inputfile;
Stypes.dump (outputprefix ^ ".annot");
with x ->
close_out oc;
remove_file objfile;
Pparse.remove_preprocessed_if_ast inputfile;
Stypes.dump (outputprefix ^ ".annot");
raise x
end
let c_file name =
Location.input_name := name;
if Ccomp.compile_file name <> 0 then exit 2
|
