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
|
(*
* This module goes near the bottom of the dependency DAG, and holds option,
* and global-state machinery for a single run of the compiler.
*)
open Common;;
type meta = (string * string) array;;
type sess =
{
mutable sess_in: filename option;
mutable sess_out: filename option;
mutable sess_library_mode: bool;
mutable sess_alt_backend: bool;
mutable sess_minimal: bool;
mutable sess_use_pexps: bool;
mutable sess_targ: target;
mutable sess_log_lex: bool;
mutable sess_log_parse: bool;
mutable sess_log_ast: bool;
mutable sess_log_sig: bool;
mutable sess_log_passes: bool;
mutable sess_log_resolve: bool;
mutable sess_log_type: bool;
mutable sess_log_simplify: bool;
mutable sess_log_layer: bool;
mutable sess_log_typestate: bool;
mutable sess_log_dead: bool;
mutable sess_log_loop: bool;
mutable sess_log_alias: bool;
mutable sess_log_layout: bool;
mutable sess_log_trans: bool;
mutable sess_log_itype: bool;
mutable sess_log_dwarf: bool;
mutable sess_log_ra: bool;
mutable sess_log_insn: bool;
mutable sess_log_asm: bool;
mutable sess_log_obj: bool;
mutable sess_log_lib: bool;
mutable sess_log_path: (string list) option;
mutable sess_log_out: out_channel;
mutable sess_log_err: out_channel;
mutable sess_trace_block: bool;
mutable sess_trace_drop: bool;
mutable sess_trace_tag: bool;
mutable sess_trace_gc: bool;
mutable sess_failed: bool;
mutable sess_report_timing: bool;
mutable sess_report_quads: bool;
mutable sess_report_gc: bool;
mutable sess_report_deps: bool;
mutable sess_next_crate_id: int;
mutable sess_fuzz_item_count: int;
sess_timings: (string, float) Hashtbl.t;
sess_quad_counts: (string, int ref) Hashtbl.t;
sess_spans: (node_id,span) Hashtbl.t;
sess_lib_dirs: filename Queue.t;
sess_crate_meta: (meta, crate_id) Hashtbl.t;
sess_node_id_counter: node_id ref;
sess_opaque_id_counter: opaque_id ref;
sess_temp_id_counter: temp_id ref;
}
;;
let add_time sess name amt =
let existing =
if Hashtbl.mem sess.sess_timings name
then Hashtbl.find sess.sess_timings name
else 0.0
in
(Hashtbl.replace sess.sess_timings name (existing +. amt))
;;
let time_inner name sess thunk =
let t0 = Unix.gettimeofday() in
let x = thunk() in
let t1 = Unix.gettimeofday() in
add_time sess name (t1 -. t0);
x
;;
let get_span sess id =
if Hashtbl.mem sess.sess_spans id
then (Some (Hashtbl.find sess.sess_spans id))
else None
;;
let log name flag chan =
let k1 s =
Printf.fprintf chan "%s: %s\n%!" name s
in
let k2 _ = () in
Printf.ksprintf (if flag then k1 else k2)
;;
let fail sess =
sess.sess_failed <- true;
Printf.fprintf sess.sess_log_err
;;
let string_of_pos (p:pos) =
let (filename, line, col) = p in
Printf.sprintf "%s:%d:%d" filename line col
;;
let string_of_span (s:span) =
let (filename, line0, col0) = s.lo in
let (_, line1, col1) = s.hi in
Printf.sprintf "%s:%d:%d:%d:%d" filename line0 col0 line1 col1
;;
let filename_of (fo:filename option) : filename =
match fo with
None -> "<none>"
| Some f -> f
;;
let report_err sess ido str =
let spano = match ido with
None -> None
| Some id -> get_span sess id
in
match spano with
None ->
fail sess "error: %s\n%!" str
| Some span ->
fail sess "%s: error: %s\n%!"
(string_of_span span) str
;;
let make_crate_id (sess:sess) : crate_id =
let crate_id = Crate sess.sess_next_crate_id in
sess.sess_next_crate_id <- sess.sess_next_crate_id + 1;
crate_id
;;
(*
* Local Variables:
* fill-column: 78;
* indent-tabs-mode: nil
* buffer-file-coding-system: utf-8-unix
* compile-command: "make -k -C $RBUILD 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
* End:
*)
|