blob: bf896c3fb0f4891efc348b1b29fb197fdfb5c8df (
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
153
154
|
(***********************************************************************)
(* *)
(* Caml Special Light *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1995 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $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 () =
load_path :=
"" :: List.rev (Config.standard_library :: !Clflags.include_dirs);
Env.reset_cache()
(* Return the initial environment in which compilation proceeds. *)
let initial_env () =
try
if !Clflags.nopervasives
then Env.initial
else Env.open_pers_signature "Pervasives" Env.initial
with Not_found ->
fatal_error "cannot open Pervasives.cmi"
(* Optionally preprocess a source file *)
let preprocess sourcefile tmpfile =
match !Clflags.preprocessor with
None -> sourcefile
| Some pp ->
let comm = pp ^ " " ^ sourcefile ^ " > " ^ tmpfile in
if Sys.command comm <> 0 then begin
Printf.eprintf "Preprocessing error\n";
flush stderr;
exit 2
end;
tmpfile
let remove_preprocessed inputfile =
match !Clflags.preprocessor with
None -> ()
| Some _ -> remove_file inputfile
(* Parse a file or get a dumped syntax tree in it *)
let parse_file inputfile parse_fun ast_magic =
let ic = open_in_bin inputfile in
let is_ast_file =
try
let buffer = String.create (String.length ast_magic) in
really_input ic buffer 0 (String.length ast_magic);
buffer = ast_magic
with _ -> false
in
let ast =
try
if is_ast_file then begin
Location.input_name := input_value ic;
input_value ic
end else begin
seek_in ic 0;
Location.input_name := inputfile;
parse_fun (Lexing.from_channel ic)
end
with x -> close_in ic; raise x
in
close_in ic;
ast
(* Compile a .mli file *)
let interface sourcefile =
init_path();
let prefixname = Filename.chop_extension sourcefile in
let modulename = capitalize(Filename.basename prefixname) in
let inputfile = preprocess sourcefile (prefixname ^ ".ppi") in
let ast = parse_file inputfile Parse.interface ast_intf_magic_number in
let sg = Typemod.transl_signature (initial_env()) ast in
if !Clflags.print_types then (Printtyp.signature sg; print_flush());
Env.save_signature sg modulename (prefixname ^ ".cmi");
remove_preprocessed inputfile
(* Compile a .ml file *)
let print_if flag printer arg =
if !flag then begin printer arg; print_newline() end;
arg
let implementation sourcefile =
init_path();
let prefixname = Filename.chop_extension sourcefile in
let modulename = capitalize(Filename.basename prefixname) in
let inputfile = preprocess sourcefile (prefixname ^ ".ppo") in
let ast = parse_file inputfile Parse.implementation ast_impl_magic_number in
let objfile = prefixname ^ ".cmo" in
let oc = open_out_bin objfile in
try
let (str, sg, finalenv) =
Typemod.type_structure (initial_env()) ast in
if !Clflags.print_types then (Printtyp.signature sg; print_flush());
let (coercion, crc) =
if Sys.file_exists (prefixname ^ ".mli") then begin
let intf_file =
try find_in_path !load_path (prefixname ^ ".cmi")
with Not_found -> prefixname ^ ".cmi" in
let (dclsig, crc) = Env.read_signature modulename intf_file in
(Includemod.compunit sourcefile sg intf_file dclsig, crc)
end else begin
let crc = Env.save_signature sg modulename (prefixname ^ ".cmi") in
Typemod.check_nongen_schemes finalenv str;
(Tcoerce_none, crc)
end in
Emitcode.to_file oc modulename crc
(print_if Clflags.dump_instr Printinstr.instrlist
(Bytegen.compile_implementation
(print_if Clflags.dump_lambda Printlambda.lambda
(Simplif.simplify_lambda
(print_if Clflags.dump_rawlambda Printlambda.lambda
(Translmod.transl_implementation modulename str coercion))))));
remove_preprocessed inputfile;
close_out oc
with x ->
close_out oc;
remove_file objfile;
raise x
let c_file name =
if Sys.command
(Printf.sprintf
"%s -c %s -I%s %s"
Config.bytecomp_c_compiler
(String.concat " "
(List.map (fun dir -> "-I" ^ dir)
(List.rev !Clflags.include_dirs)))
Config.standard_library
name)
<> 0
then exit 2
|
