blob: 7f9974da7a85fc92d51f4539c8d55e223ddf69b0 (
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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Daniel de Rauglaudre, 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. *)
(* *)
(***********************************************************************)
open Format
type error =
| CannotRun of string
| WrongMagic of string
exception Error of error
(* Optionally preprocess a source file *)
let preprocess sourcefile =
match !Clflags.preprocessor with
None -> sourcefile
| Some pp ->
let tmpfile = Filename.temp_file "ocamlpp" "" in
let comm = Printf.sprintf "%s %s > %s"
pp (Filename.quote sourcefile) tmpfile
in
if Ccomp.command comm <> 0 then begin
Misc.remove_file tmpfile;
raise (Error (CannotRun comm));
end;
tmpfile
let remove_preprocessed inputfile =
match !Clflags.preprocessor with
None -> ()
| Some _ -> Misc.remove_file inputfile
let write_ast magic ast =
let fn = Filename.temp_file "camlppx" "" in
let oc = open_out_bin fn in
output_string oc magic;
output_value oc !Location.input_name;
output_value oc ast;
close_out oc;
fn
let apply_rewriter magic fn_in ppx =
let fn_out = Filename.temp_file "camlppx" "" in
let comm =
Printf.sprintf "%s %s %s" ppx (Filename.quote fn_in) (Filename.quote fn_out)
in
let ok = Ccomp.command comm = 0 in
Misc.remove_file fn_in;
if not ok then begin
Misc.remove_file fn_out;
raise (Error (CannotRun comm));
end;
if not (Sys.file_exists fn_out) then
raise (Error (WrongMagic comm));
(* check magic before passing to the next ppx *)
let ic = open_in_bin fn_out in
let buffer =
try Misc.input_bytes ic (String.length magic) with End_of_file -> "" in
close_in ic;
if buffer <> magic then begin
Misc.remove_file fn_out;
raise (Error (WrongMagic comm));
end;
fn_out
let read_ast magic fn =
let ic = open_in_bin fn in
try
let buffer = Misc.input_bytes ic (String.length magic) in
assert(buffer = magic); (* already checked by apply_rewriter *)
Location.input_name := input_value ic;
let ast = input_value ic in
close_in ic;
Misc.remove_file fn;
ast
with exn ->
close_in ic;
Misc.remove_file fn;
raise exn
let apply_rewriters magic ast =
match !Clflags.all_ppx with
| [] -> ast
| ppxs ->
let fn =
List.fold_left (apply_rewriter magic) (write_ast magic ast)
(List.rev ppxs)
in
read_ast magic fn
(* Parse a file or get a dumped syntax tree from it *)
exception Outdated_version
let file ppf inputfile parse_fun ast_magic =
let ic = open_in_bin inputfile in
let is_ast_file =
try
let buffer = Misc.input_bytes ic (String.length ast_magic) in
if buffer = ast_magic then true
else if String.sub buffer 0 9 = String.sub ast_magic 0 9 then
raise Outdated_version
else false
with
Outdated_version ->
Misc.fatal_error "OCaml and preprocessor have incompatible versions"
| _ -> false
in
let ast =
try
if is_ast_file then begin
if !Clflags.fast then
(* FIXME make this a proper warning *)
fprintf ppf "@[Warning: %s@]@."
"option -unsafe used with a preprocessor returning a syntax tree";
Location.input_name := input_value ic;
input_value ic
end else begin
seek_in ic 0;
Location.input_name := inputfile;
let lexbuf = Lexing.from_channel ic in
Location.init lexbuf inputfile;
parse_fun lexbuf
end
with x -> close_in ic; raise x
in
close_in ic;
apply_rewriters ast_magic ast
let report_error ppf = function
| CannotRun cmd ->
fprintf ppf "Error while running external preprocessor@.\
Command line: %s@." cmd
| WrongMagic cmd ->
fprintf ppf "External preprocessor does not produce a valid file@.\
Command line: %s@." cmd
let () =
Location.register_error_of_exn
(function
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
let parse_all parse_fun magic ppf sourcefile =
Location.input_name := sourcefile;
let inputfile = preprocess sourcefile in
let ast =
try file ppf inputfile parse_fun magic
with exn ->
remove_preprocessed inputfile;
raise exn
in
remove_preprocessed inputfile;
ast
let parse_implementation ppf sourcefile =
parse_all Parse.implementation Config.ast_impl_magic_number ppf sourcefile
let parse_interface ppf sourcefile =
parse_all Parse.interface Config.ast_intf_magic_number ppf sourcefile
|
