-
Notifications
You must be signed in to change notification settings - Fork 51
/
type_alias_liveness.ml
195 lines (190 loc) · 9.41 KB
/
type_alias_liveness.ml
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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
open Core
open Ast.Ast_types
open Desugaring.Desugared_ast
open Data_race_checker_env
let update_capabilities_if_live_aliases filter_linear_caps_fn live_aliases capabilities =
(* if we have live aliases, then the object is not linear at this point, so filter out
linear capabilties. *)
if not (List.is_empty live_aliases) then
List.filter ~f:(filter_linear_caps_fn capabilities) capabilities
else capabilities
let type_alias_liveness_identifier aliased_obj_name possible_aliases filter_linear_caps_fn
live_aliases id =
let id_name = get_identifier_name id in
if id_name = aliased_obj_name then
let maybe_updated_capabilities =
update_capabilities_if_live_aliases filter_linear_caps_fn live_aliases
(get_identifier_capabilities id) in
(set_identifier_capabilities id maybe_updated_capabilities, live_aliases)
else
( match
List.find
~f:(fun poss_alias -> identifier_matches_var_name poss_alias id)
possible_aliases
with
| Some alias -> alias :: live_aliases
| None -> live_aliases )
|> fun updated_live_aliases -> (id, updated_live_aliases)
let rec type_alias_liveness_expr aliased_obj_name possible_aliases filter_linear_caps_fn
live_aliases expr =
let type_alias_liveness_expr_rec =
type_alias_liveness_expr aliased_obj_name possible_aliases filter_linear_caps_fn in
let type_alias_liveness_identifier_rec =
type_alias_liveness_identifier aliased_obj_name possible_aliases filter_linear_caps_fn
in
let type_alias_liveness_block_expr_rec =
type_alias_liveness_block_expr aliased_obj_name possible_aliases filter_linear_caps_fn
in
match expr with
| Identifier (loc, id) ->
type_alias_liveness_identifier_rec live_aliases id
|> fun (updated_id, updated_live_aliases) ->
(Identifier (loc, updated_id), updated_live_aliases)
| Integer _ | Boolean _ -> (expr, live_aliases)
| BlockExpr (loc, block_expr) ->
type_alias_liveness_block_expr_rec live_aliases block_expr
|> fun (updated_block_expr, updated_live_aliases) ->
(BlockExpr (loc, updated_block_expr), updated_live_aliases)
| Constructor (loc, type_expr, class_name, constructor_args) ->
(* Note we fold right since we run in reverse program execution order. *)
List.fold_right ~init:([], live_aliases)
~f:
(fun (ConstructorArg (type_expr, field_name, expr)) (acc_args, acc_live_aliases) ->
type_alias_liveness_expr_rec acc_live_aliases expr
|> fun (updated_expr, updated_acc_live_aliases) ->
ConstructorArg (type_expr, field_name, updated_expr)
|> fun updated_arg -> (updated_arg :: acc_args, updated_acc_live_aliases))
constructor_args
|> fun (updated_args, updated_live_aliases) ->
(Constructor (loc, type_expr, class_name, updated_args), updated_live_aliases)
| Let (loc, type_expr, var_name, bound_expr) ->
(* remove this var from the set of live aliases *)
type_alias_liveness_expr_rec
(List.filter ~f:(fun name -> not (var_name = name)) live_aliases)
bound_expr
|> fun (updated_bound_expr, updated_live_aliases) ->
(Let (loc, type_expr, var_name, updated_bound_expr), updated_live_aliases)
| Assign (loc, type_expr, id, assigned_expr) ->
type_alias_liveness_identifier_rec live_aliases id
|> fun (updated_id, id_updated_live_aliases) ->
type_alias_liveness_expr_rec id_updated_live_aliases assigned_expr
|> fun (updated_assigned_expr, post_assigned_expr_live_aliases) ->
( Assign (loc, type_expr, updated_id, updated_assigned_expr)
, post_assigned_expr_live_aliases )
| Consume (loc, id) ->
type_alias_liveness_identifier_rec live_aliases id
|> fun (updated_id, updated_live_aliases) ->
(Consume (loc, updated_id), updated_live_aliases)
| MethodApp (loc, type_expr, obj_name, obj_capabilities, obj_class, method_name, args)
->
let obj_id =
Variable (TEClass (obj_class, None), obj_name, obj_capabilities, None) in
type_alias_liveness_identifier_rec live_aliases obj_id
|> fun (updated_id, live_aliases_before_method_call) ->
List.fold_right
~init:([], live_aliases_before_method_call)
~f:(fun arg (acc_args, acc_live_aliases) ->
type_alias_liveness_expr_rec acc_live_aliases arg
|> fun (updated_arg, updated_acc_live_aliases) ->
(updated_arg :: acc_args, updated_acc_live_aliases))
args
|> fun (updated_args, updated_live_aliases) ->
( MethodApp
( loc
, type_expr
, obj_name
, get_identifier_capabilities updated_id
, obj_class
, method_name
, updated_args )
, updated_live_aliases )
| FunctionApp (loc, return_type, func_name, args) ->
List.fold_right ~init:([], live_aliases)
~f:(fun arg (acc_args, acc_live_aliases) ->
type_alias_liveness_expr_rec acc_live_aliases arg
|> fun (updated_arg, updated_acc_live_aliases) ->
(updated_arg :: acc_args, updated_acc_live_aliases))
args
|> fun (updated_args, updated_live_aliases) ->
(FunctionApp (loc, return_type, func_name, updated_args), updated_live_aliases)
| Printf (loc, format_str, args) ->
List.fold_right ~init:([], live_aliases)
~f:(fun arg (acc_args, acc_live_aliases) ->
type_alias_liveness_expr_rec acc_live_aliases arg
|> fun (updated_arg, updated_acc_live_aliases) ->
(updated_arg :: acc_args, updated_acc_live_aliases))
args
|> fun (updated_args, updated_live_aliases) ->
(Printf (loc, format_str, updated_args), updated_live_aliases)
| FinishAsync (loc, type_expr, async_exprs, curr_thread_free_vars, curr_thread_expr) ->
(* note the async expressions are forked, so we treat as independent (hence map not
fold) *)
List.unzip
(List.map
~f:(fun (AsyncExpr (free_vars, async_expr)) ->
type_alias_liveness_block_expr_rec live_aliases async_expr
|> fun (updated_async_expr, updated_async_live_aliases) ->
(AsyncExpr (free_vars, updated_async_expr), updated_async_live_aliases))
async_exprs)
|> fun (updated_async_exprs, async_live_aliases) ->
type_alias_liveness_block_expr_rec live_aliases curr_thread_expr
|> fun (updated_curr_thread_expr, curr_thread_live_aliases) ->
List.concat (curr_thread_live_aliases :: async_live_aliases)
|> fun updated_live_aliases ->
( FinishAsync
( loc
, type_expr
, updated_async_exprs
, curr_thread_free_vars
, updated_curr_thread_expr )
, updated_live_aliases )
| If (loc, type_expr, cond_expr, then_expr, else_expr) ->
type_alias_liveness_block_expr_rec live_aliases then_expr
|> fun (updated_then_expr, then_live_aliases) ->
type_alias_liveness_block_expr_rec live_aliases else_expr
|> fun (updated_else_expr, else_live_aliases) ->
type_alias_liveness_expr_rec (then_live_aliases @ else_live_aliases) cond_expr
|> fun (updated_cond_expr, cond_live_aliases) ->
( If (loc, type_expr, updated_cond_expr, updated_then_expr, updated_else_expr)
, cond_live_aliases )
| While (loc, cond_expr, loop_expr) ->
type_alias_liveness_loop_expr aliased_obj_name possible_aliases
filter_linear_caps_fn live_aliases loop_expr
|> fun (updated_loop_expr, loop_live_aliases) ->
type_alias_liveness_expr_rec loop_live_aliases cond_expr
|> fun (updated_cond_expr, cond_live_aliases) ->
(While (loc, updated_cond_expr, updated_loop_expr), cond_live_aliases)
| BinOp (loc, type_expr, binop, expr1, expr2) ->
(* right-to-left as opposite of program execution order *)
type_alias_liveness_expr_rec live_aliases expr2
|> fun (updated_expr2, expr2_live_aliases) ->
type_alias_liveness_expr_rec expr2_live_aliases expr1
|> fun (updated_expr_1, expr1_live_aliases) ->
(BinOp (loc, type_expr, binop, updated_expr_1, updated_expr2), expr1_live_aliases)
| UnOp (loc, type_expr, unop, expr) ->
type_alias_liveness_expr_rec live_aliases expr
|> fun (updated_expr, updated_live_aliases) ->
(UnOp (loc, type_expr, unop, updated_expr), updated_live_aliases)
and type_alias_liveness_block_expr aliased_obj_name possible_aliases filter_linear_caps_fn
live_aliases (Block (loc, type_expr, exprs)) =
let type_alias_liveness_expr_rec =
type_alias_liveness_expr aliased_obj_name possible_aliases filter_linear_caps_fn in
List.fold_right ~init:([], live_aliases)
~f:(fun expr (acc_exprs, acc_live_aliases) ->
type_alias_liveness_expr_rec acc_live_aliases expr
|> fun (updated_expr, updated_acc_live_aliases) ->
(updated_expr :: acc_exprs, updated_acc_live_aliases))
exprs
|> fun (updated_exprs, updated_live_aliases) ->
(Block (loc, type_expr, updated_exprs), updated_live_aliases)
(* compute least fixed point of loop liveness aliases *)
and type_alias_liveness_loop_expr aliased_obj_name possible_aliases filter_linear_caps_fn
live_aliases loop_expr =
type_alias_liveness_block_expr aliased_obj_name possible_aliases filter_linear_caps_fn
live_aliases loop_expr
|> fun (updated_loop_expr, updated_live_aliases) ->
if var_lists_are_equal live_aliases updated_live_aliases then
(updated_loop_expr, updated_live_aliases)
else
type_alias_liveness_loop_expr aliased_obj_name possible_aliases filter_linear_caps_fn
updated_live_aliases updated_loop_expr