blob: 0cf5b3ef402c22f3d5b32150f291a5c93418c23b (
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
|
(***********************************************************************)
(* *)
(* 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 () =
init_path();
try
if !Clflags.nopervasives
then Env.initial
else Env.open_pers_signature "Pervasives" Env.initial
with Not_found ->
fatal_error "cannot open Pervasives.cmi"
(* Compile a .mli file *)
let interface sourcefile =
let prefixname = Filename.chop_suffix sourcefile ".mli" in
let modulename = capitalize(Filename.basename prefixname) in
let ic = open_in_bin sourcefile in
let lb = Lexing.from_channel ic in
Location.input_name := sourcefile;
try
let sg = Typemod.transl_signature (initial_env()) (Parse.interface lb) in
close_in ic;
if !Clflags.print_types then (Printtyp.signature sg; print_flush());
Env.save_signature sg modulename (prefixname ^ ".cmi");
()
with x ->
close_in ic;
raise x
(* Compile a .ml file *)
let print_if flag printer arg =
if !flag then begin printer arg; print_newline() end;
arg
let implementation sourcefile =
let prefixname = Filename.chop_suffix sourcefile ".ml" in
let modulename = capitalize(Filename.basename prefixname) in
let objfile = prefixname ^ ".cmo" in
let ic = open_in_bin sourcefile in
let oc = open_out_bin objfile in
let lb = Lexing.from_channel ic in
Location.input_name := sourcefile;
try
let (str, sg, finalenv) =
Typemod.type_structure (initial_env()) (Parse.implementation lb) 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.signatures Env.initial sg dclsig, crc)
end else begin
let crc = Env.save_signature sg modulename (prefixname ^ ".cmi") in
(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
(Translmod.transl_implementation modulename str coercion))));
close_in ic;
close_out oc
with x ->
close_in ic;
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
|
