blob: a0fc957025913c6f18acd87e3d77d748064b6d3f (
plain) (
blame)
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
|
(*
* Computes iterator-loop nesting depths and max depth of each function.
*)
open Semant;;
open Common;;
let log cx = Session.log "loop"
(should_log cx cx.ctxt_sess.Session.sess_log_loop)
cx.ctxt_sess.Session.sess_log_out
;;
type fn_ctxt = { current_depth: int; }
;;
let incr_depth (fcx:fn_ctxt) =
{ current_depth = fcx.current_depth + 1; }
;;
let decr_depth (fcx:fn_ctxt) =
{ current_depth = fcx.current_depth - 1; }
;;
let top_fcx = { current_depth = 0; }
;;
let loop_depth_visitor
(cx:ctxt)
(inner:Walk.visitor)
: Walk.visitor =
let (fcxs : fn_ctxt Stack.t) = Stack.create () in
let push_loop () =
let fcx = Stack.pop fcxs in
Stack.push (incr_depth fcx) fcxs
in
let pop_loop () =
let fcx = Stack.pop fcxs in
Stack.push (decr_depth fcx) fcxs
in
let visit_mod_item_pre
(ident:Ast.ident)
(ty_params:(Ast.ty_param identified) array)
(item:Ast.mod_item)
: unit =
Stack.push top_fcx fcxs;
inner.Walk.visit_mod_item_pre ident ty_params item
in
let visit_mod_item_post
(ident:Ast.ident)
(ty_params:(Ast.ty_param identified) array)
(item:Ast.mod_item)
: unit =
inner.Walk.visit_mod_item_post ident ty_params item;
ignore (Stack.pop fcxs);
in
let visit_obj_fn_pre
(obj:Ast.obj identified)
(ident:Ast.ident)
(fn:Ast.fn identified)
: unit =
Stack.push top_fcx fcxs;
inner.Walk.visit_obj_fn_pre obj ident fn
in
let visit_obj_fn_post
(obj:Ast.obj identified)
(ident:Ast.ident)
(fn:Ast.fn identified)
: unit =
inner.Walk.visit_obj_fn_pre obj ident fn;
ignore (Stack.pop fcxs)
in
let visit_obj_drop_pre
(obj:Ast.obj identified)
(b:Ast.block)
: unit =
Stack.push top_fcx fcxs;
inner.Walk.visit_obj_drop_pre obj b
in
let visit_obj_drop_post
(obj:Ast.obj identified)
(b:Ast.block)
: unit =
inner.Walk.visit_obj_drop_post obj b;
ignore (Stack.pop fcxs)
in
let visit_slot_identified_pre sloti =
let fcx = Stack.top fcxs in
htab_put cx.ctxt_slot_loop_depths sloti.id fcx.current_depth;
inner.Walk.visit_slot_identified_pre sloti
in
let visit_stmt_pre s =
let fcx = Stack.top fcxs in
htab_put cx.ctxt_stmt_loop_depths s.id fcx.current_depth;
begin
match s.node with
| Ast.STMT_for_each fe ->
htab_put cx.ctxt_block_is_loop_body fe.Ast.for_each_body.id ();
| _ -> ()
end;
inner.Walk.visit_stmt_pre s
in
let visit_block_pre b =
if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
then push_loop ();
let fcx = Stack.top fcxs in
htab_put cx.ctxt_block_loop_depths b.id fcx.current_depth;
inner.Walk.visit_block_pre b
in
let visit_block_post b =
inner.Walk.visit_block_post b;
if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
then pop_loop ()
in
{ inner with
Walk.visit_mod_item_pre = visit_mod_item_pre;
Walk.visit_mod_item_post = visit_mod_item_post;
Walk.visit_obj_fn_pre = visit_obj_fn_pre;
Walk.visit_obj_fn_post = visit_obj_fn_post;
Walk.visit_obj_drop_pre = visit_obj_drop_pre;
Walk.visit_obj_drop_post = visit_obj_drop_post;
Walk.visit_slot_identified_pre = visit_slot_identified_pre;
Walk.visit_stmt_pre = visit_stmt_pre;
Walk.visit_block_pre = visit_block_pre;
Walk.visit_block_post = visit_block_post }
;;
let process_crate
(cx:ctxt)
(crate:Ast.crate)
: unit =
let passes =
[|
(loop_depth_visitor cx
Walk.empty_visitor)
|]
in
run_passes cx "loop" passes
cx.ctxt_sess.Session.sess_log_loop log crate
;;
(*
* 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:
*)
|