blob: 29afc628dca94557b83ba95bf037dfa81548fb8e (
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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* 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. *)
let init_path () =
let dirs =
if !Clflags.use_threads
then "+threads" :: !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. *)
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 compile.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;
Stypes.dump (outputprefix ^ ".annot");
with e ->
Pparse.remove_preprocessed_if_ast inputfile;
Stypes.dump (outputprefix ^ ".annot");
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 (+++) (x, y) f = (x, f y)
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
Compilenv.reset ?packname:!Clflags.for_package modulename;
let cmxfile = outputprefix ^ ".cmx" in
let objfile = outputprefix ^ ext_obj in
try
if !Clflags.print_types then ignore(
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)
else begin
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_store_implementation modulename
+++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
+++ Simplif.simplify_lambda
+++ print_if ppf Clflags.dump_lambda Printlambda.lambda
++ Asmgen.compile_implementation outputprefix ppf;
Compilenv.save_unit_info cmxfile;
end;
Warnings.check_fatal ();
Pparse.remove_preprocessed inputfile;
Stypes.dump (outputprefix ^ ".annot");
with x ->
remove_file objfile;
remove_file cmxfile;
Pparse.remove_preprocessed_if_ast inputfile;
Stypes.dump (outputprefix ^ ".annot");
raise x
let c_file name =
if Ccomp.compile_file name <> 0 then exit 2
|
