Skip to content

Commit 5db44d2

Browse files
hhugoOlivierNicole
hhugo
authored and
OlivierNicole
committed
Compiler: track block mutability (#1603)
1 parent c860567 commit 5db44d2

18 files changed

+94
-53
lines changed

‎compiler/lib/code.ml

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -338,13 +338,17 @@ type special =
338338
| Undefined
339339
| Alias_prim of string
340340

341+
type mutability =
342+
| Immutable
343+
| Maybe_mutable
344+
341345
type expr =
342346
| Apply of
343347
{ f : Var.t
344348
; args : Var.t list
345349
; exact : bool
346350
}
347-
| Block of int * Var.t array * array_or_not
351+
| Block of int * Var.t array * array_or_not * mutability
348352
| Field of Var.t * int
349353
| Closure of Var.t list * cont
350354
| Constant of constant
@@ -492,8 +496,14 @@ module Print = struct
492496
if exact
493497
then Format.fprintf f "%a!(%a)" Var.print g var_list args
494498
else Format.fprintf f "%a(%a)" Var.print g var_list args
495-
| Block (t, a, _) ->
496-
Format.fprintf f "{tag=%d" t;
499+
| Block (t, a, _, mut) ->
500+
Format.fprintf
501+
f
502+
"%s{tag=%d"
503+
(match mut with
504+
| Immutable -> "imm"
505+
| Maybe_mutable -> "")
506+
t;
497507
for i = 0 to Array.length a - 1 do
498508
Format.fprintf f "; %d = %a" i Var.print a.(i)
499509
done;
@@ -790,7 +800,7 @@ let invariant { blocks; start; _ } =
790800
in
791801
let check_expr = function
792802
| Apply _ -> ()
793-
| Block (_, _, _) -> ()
803+
| Block (_, _, _, _) -> ()
794804
| Field (_, _) -> ()
795805
| Closure (l, cont) ->
796806
List.iter l ~f:define;

‎compiler/lib/code.mli

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -185,13 +185,17 @@ type special =
185185
| Undefined
186186
| Alias_prim of string
187187

188+
type mutability =
189+
| Immutable
190+
| Maybe_mutable
191+
188192
type expr =
189193
| Apply of
190194
{ f : Var.t
191195
; args : Var.t list
192196
; exact : bool (* if true, then # of arguments = # of parameters *)
193197
}
194-
| Block of int * Var.t array * array_or_not
198+
| Block of int * Var.t array * array_or_not * mutability
195199
| Field of Var.t * int
196200
| Closure of Var.t list * cont
197201
| Constant of constant

‎compiler/lib/deadcode.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ and mark_expr st e =
6161
| Apply { f; args; _ } ->
6262
mark_var st f;
6363
List.iter args ~f:(fun x -> mark_var st x)
64-
| Block (_, a, _) -> Array.iter a ~f:(fun x -> mark_var st x)
64+
| Block (_, a, _, _) -> Array.iter a ~f:(fun x -> mark_var st x)
6565
| Field (x, _) -> mark_var st x
6666
| Closure (_, (pc, _)) -> mark_reachable st pc
6767
| Special _ -> ()

‎compiler/lib/eval.ml

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -200,7 +200,7 @@ let is_int ~target info x =
200200
match target with
201201
| `JavaScript -> Y
202202
| `Wasm -> N)
203-
| Expr (Block (_, _, _)) | Expr (Constant _) -> N
203+
| Expr (Block (_, _, _, _)) | Expr (Constant _) -> N
204204
| _ -> Unknown)
205205
Unknown
206206
(fun u v ->
@@ -275,7 +275,7 @@ let eval_instr ~target info ((x, loc) as i) =
275275
| `JavaScript -> "js_of_ocaml"
276276
| `Wasm -> "wasm_of_ocaml")) )
277277
, noloc )
278-
; Let (x, Block (0, [| jsoo |], NotArray)), loc
278+
; Let (x, Block (0, [| jsoo |], NotArray, Immutable)), loc
279279
]
280280
| Let (_, Prim (Extern ("%resume" | "%perform" | "%reperform"), _)) ->
281281
[ i ] (* We need that the arguments to this primitives remain variables *)
@@ -331,7 +331,7 @@ let the_case_of info x =
331331
(fun x ->
332332
match info.info_defs.(Var.idx x) with
333333
| Expr (Constant (Int (_, i))) -> CConst (Int32.to_int i)
334-
| Expr (Block (j, _, _)) ->
334+
| Expr (Block (j, _, _, _)) ->
335335
if Var.ISet.mem info.info_possibly_mutable x then Unknown else CTag j
336336
| Expr (Constant (Tuple (j, _, _))) -> CTag j
337337
| _ -> Unknown)
@@ -366,7 +366,7 @@ let the_cond_of info x =
366366
| NativeString _
367367
| Float_array _
368368
| Int64 _ )) -> Non_zero
369-
| Expr (Block (_, _, _)) -> Non_zero
369+
| Expr (Block (_, _, _, _)) -> Non_zero
370370
| Expr (Field _ | Closure _ | Prim _ | Apply _ | Special _) -> Unknown
371371
| Param | Phi _ -> Unknown)
372372
Unknown
@@ -414,7 +414,7 @@ let rec do_not_raise pc visited blocks =
414414
| Array_set (_, _, _) | Offset_ref (_, _) | Set_field (_, _, _) | Assign _ -> ()
415415
| Let (_, e) -> (
416416
match e with
417-
| Block (_, _, _) | Field (_, _) | Constant _ | Closure _ -> ()
417+
| Block (_, _, _, _) | Field (_, _) | Constant _ | Closure _ -> ()
418418
| Apply _ -> raise May_raise
419419
| Special _ -> ()
420420
| Prim (Extern name, _) when Primitive.is_pure name -> ()

‎compiler/lib/flow.ml

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -93,7 +93,7 @@ let expr_deps blocks vars deps defs x e =
9393
| Closure (l, cont) ->
9494
List.iter l ~f:(fun x -> add_param_def vars defs x);
9595
cont_deps blocks vars deps defs cont
96-
| Block (_, a, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
96+
| Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
9797
| Field (y, _) -> add_dep deps x y
9898

9999
let program_deps { blocks; _ } =
@@ -143,7 +143,7 @@ let propagate1 deps defs st x =
143143
var_set_lift
144144
(fun z ->
145145
match defs.(Var.idx z) with
146-
| Expr (Block (_, a, _)) when n < Array.length a ->
146+
| Expr (Block (_, a, _, _)) when n < Array.length a ->
147147
let t = a.(n) in
148148
add_dep deps x t;
149149
Var.Tbl.get st t
@@ -185,7 +185,7 @@ let rec block_escape st x =
185185
Code.Var.ISet.add st.may_escape y;
186186
Code.Var.ISet.add st.possibly_mutable y;
187187
match st.defs.(Var.idx y) with
188-
| Expr (Block (_, l, _)) -> Array.iter l ~f:(fun z -> block_escape st z)
188+
| Expr (Block (_, l, _, _)) -> Array.iter l ~f:(fun z -> block_escape st z)
189189
| _ -> ()))
190190
(Var.Tbl.get st.known_origins x)
191191

@@ -217,15 +217,16 @@ let expr_escape st _x e =
217217
| Pv v, `Shallow_const -> (
218218
match st.defs.(Var.idx v) with
219219
| Expr (Constant (Tuple _)) -> ()
220-
| Expr (Block (_, a, _)) -> Array.iter a ~f:(fun x -> block_escape st x)
220+
| Expr (Block (_, a, _, _)) ->
221+
Array.iter a ~f:(fun x -> block_escape st x)
221222
| _ -> block_escape st v)
222223
| Pv v, `Object_literal -> (
223224
match st.defs.(Var.idx v) with
224225
| Expr (Constant (Tuple _)) -> ()
225-
| Expr (Block (_, a, _)) ->
226+
| Expr (Block (_, a, _, _)) ->
226227
Array.iter a ~f:(fun x ->
227228
match st.defs.(Var.idx x) with
228-
| Expr (Block (_, [| _k; v |], _)) -> block_escape st v
229+
| Expr (Block (_, [| _k; v |], _, _)) -> block_escape st v
229230
| Expr (Constant _) -> ()
230231
| _ -> block_escape st x)
231232
| _ -> block_escape st v)
@@ -273,7 +274,7 @@ let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x =
273274
|| Var.Set.exists
274275
(fun z ->
275276
match defs.(Var.idx z) with
276-
| Expr (Block (_, a, _)) ->
277+
| Expr (Block (_, a, _, _)) ->
277278
n >= Array.length a
278279
|| Var.ISet.mem possibly_mutable z
279280
|| Var.Tbl.get st a.(n)
@@ -368,7 +369,7 @@ let direct_approx info x =
368369
then None
369370
else
370371
match info.info_defs.(Var.idx z) with
371-
| Expr (Block (_, a, _)) when n < Array.length a -> Some a.(n)
372+
| Expr (Block (_, a, _, _)) when n < Array.length a -> Some a.(n)
372373
| _ -> None)
373374
None
374375
(fun u v ->

‎compiler/lib/freevars.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ let iter_expr_free_vars f e =
3333
| Apply { f = x; args; _ } ->
3434
f x;
3535
List.iter ~f args
36-
| Block (_, a, _) -> Array.iter ~f a
36+
| Block (_, a, _, _) -> Array.iter ~f a
3737
| Field (x, _) -> f x
3838
| Closure _ -> ()
3939
| Special _ -> ()

‎compiler/lib/generate.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1222,7 +1222,7 @@ let rec translate_expr ctx queue loc x e level : _ * J.statement_list =
12221222
let prop = or_p prop prop' in
12231223
let e = apply_fun ctx f args exact cps loc in
12241224
(e, prop, queue), []
1225-
| Block (tag, a, array_or_not) ->
1225+
| Block (tag, a, array_or_not, _mut) ->
12261226
let contents, prop, queue =
12271227
List.fold_right
12281228
~f:(fun x (args, prop, queue) ->

‎compiler/lib/generate_closure.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -377,7 +377,7 @@ let rewrite_mutable
377377
; body =
378378
closures_intern
379379
@ proj
380-
@ [ Let (b, Block (0, Array.of_list new_xs, NotArray)), noloc ]
380+
@ [ Let (b, Block (0, Array.of_list new_xs, NotArray, Immutable)), noloc ]
381381
; branch = Return b, noloc
382382
}
383383
in

‎compiler/lib/global_flow.ml

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -201,15 +201,15 @@ let expr_deps blocks st x e =
201201
| Pv v, `Const -> do_escape st Escape_constant v
202202
| Pv v, `Shallow_const -> (
203203
match st.defs.(Var.idx v) with
204-
| Expr (Block (_, a, _)) ->
204+
| Expr (Block (_, a, _, _)) ->
205205
Array.iter a ~f:(fun x -> do_escape st Escape x)
206206
| _ -> do_escape st Escape v)
207207
| Pv v, `Object_literal -> (
208208
match st.defs.(Var.idx v) with
209-
| Expr (Block (_, a, _)) ->
209+
| Expr (Block (_, a, _, _)) ->
210210
Array.iter a ~f:(fun x ->
211211
match st.defs.(Var.idx x) with
212-
| Expr (Block (_, [| _k; v |], _)) -> do_escape st Escape v
212+
| Expr (Block (_, [| _k; v |], _, _)) -> do_escape st Escape v
213213
| _ -> do_escape st Escape x)
214214
| _ -> do_escape st Escape v)
215215
| Pv v, `Mutable -> do_escape st Escape v);
@@ -323,7 +323,7 @@ module Domain = struct
323323
then (
324324
st.may_escape.(idx) <- s;
325325
match st.defs.(idx) with
326-
| Expr (Block (_, a, _)) ->
326+
| Expr (Block (_, a, _, _)) ->
327327
Array.iter ~f:(fun y -> variable_escape ~update ~st ~approx s y) a;
328328
if Poly.equal s Escape
329329
then (
@@ -407,7 +407,7 @@ let propagate st ~update approx x =
407407
~approx
408408
(fun z ->
409409
match st.defs.(Var.idx z) with
410-
| Expr (Block (t, a, _))
410+
| Expr (Block (t, a, _, _))
411411
when n < Array.length a
412412
&&
413413
match tags with
@@ -441,7 +441,7 @@ let propagate st ~update approx x =
441441
~others
442442
(fun z ->
443443
match st.defs.(Var.idx z) with
444-
| Expr (Block (_, lst, _)) ->
444+
| Expr (Block (_, lst, _, _)) ->
445445
Array.iter ~f:(fun t -> add_dep st x t) lst;
446446
let a =
447447
Array.fold_left

‎compiler/lib/inline.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -169,8 +169,8 @@ let simple blocks cont mapping =
169169
| Prim (prim, args) ->
170170
`Exp (Prim (prim, List.map args ~f:(map_prim_arg mapping)))
171171
| Special _ -> `Exp exp
172-
| Block (tag, args, aon) ->
173-
`Exp (Block (tag, Array.map args ~f:(map_var mapping), aon))
172+
| Block (tag, args, aon, mut) ->
173+
`Exp (Block (tag, Array.map args ~f:(map_var mapping), aon, mut))
174174
| Field (x, i) -> `Exp (Field (map_var mapping x, i))
175175
| Closure _ -> `Fail
176176
| Constant _ -> `Fail

‎compiler/lib/parse_bytecode.ml

Lines changed: 37 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1346,26 +1346,42 @@ and compile infos pc state instrs =
13461346
let x, state = State.fresh_var state loc in
13471347

13481348
if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
1349-
compile infos (pc + 1) state ((Let (x, Block (0, [||], Unknown)), loc) :: instrs)
1349+
compile
1350+
infos
1351+
(pc + 1)
1352+
state
1353+
((Let (x, Block (0, [||], Unknown, Maybe_mutable)), loc) :: instrs)
13501354
| ATOM ->
13511355
let i = getu code (pc + 1) in
13521356
let x, state = State.fresh_var state loc in
13531357

13541358
if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
1355-
compile infos (pc + 2) state ((Let (x, Block (i, [||], NotArray)), loc) :: instrs)
1359+
compile
1360+
infos
1361+
(pc + 2)
1362+
state
1363+
((Let (x, Block (i, [||], Unknown, Maybe_mutable)), loc) :: instrs)
13561364
| PUSHATOM0 ->
13571365
let state = State.push state loc in
13581366
let x, state = State.fresh_var state loc in
13591367

13601368
if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
1361-
compile infos (pc + 1) state ((Let (x, Block (0, [||], Unknown)), loc) :: instrs)
1369+
compile
1370+
infos
1371+
(pc + 1)
1372+
state
1373+
((Let (x, Block (0, [||], Unknown, Maybe_mutable)), loc) :: instrs)
13621374
| PUSHATOM ->
13631375
let state = State.push state loc in
13641376

13651377
let i = getu code (pc + 1) in
13661378
let x, state = State.fresh_var state loc in
13671379
if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
1368-
compile infos (pc + 2) state ((Let (x, Block (i, [||], NotArray)), loc) :: instrs)
1380+
compile
1381+
infos
1382+
(pc + 2)
1383+
state
1384+
((Let (x, Block (i, [||], Unknown, Maybe_mutable)), loc) :: instrs)
13691385
| MAKEBLOCK ->
13701386
let size = getu code (pc + 1) in
13711387
let tag = getu code (pc + 2) in
@@ -1384,7 +1400,12 @@ and compile infos pc state instrs =
13841400
infos
13851401
(pc + 3)
13861402
state
1387-
((Let (x, Block (tag, Array.of_list (List.map ~f:fst contents), Unknown)), loc)
1403+
(( Let
1404+
( x
1405+
, Block
1406+
(tag, Array.of_list (List.map ~f:fst contents), Unknown, Maybe_mutable)
1407+
)
1408+
, loc )
13881409
:: instrs)
13891410
| MAKEBLOCK1 ->
13901411
let tag = getu code (pc + 1) in
@@ -1396,7 +1417,7 @@ and compile infos pc state instrs =
13961417
infos
13971418
(pc + 2)
13981419
state
1399-
((Let (x, Block (tag, [| y |], NotArray)), loc) :: instrs)
1420+
((Let (x, Block (tag, [| y |], Unknown, Maybe_mutable)), loc) :: instrs)
14001421
| MAKEBLOCK2 ->
14011422
let tag = getu code (pc + 1) in
14021423
let y, _ = State.accu state in
@@ -1410,7 +1431,7 @@ and compile infos pc state instrs =
14101431
infos
14111432
(pc + 2)
14121433
(State.pop 1 state)
1413-
((Let (x, Block (tag, [| y; z |], NotArray)), loc) :: instrs)
1434+
((Let (x, Block (tag, [| y; z |], Unknown, Maybe_mutable)), loc) :: instrs)
14141435
| MAKEBLOCK3 ->
14151436
let tag = getu code (pc + 1) in
14161437
let y, _ = State.accu state in
@@ -1434,7 +1455,7 @@ and compile infos pc state instrs =
14341455
infos
14351456
(pc + 2)
14361457
(State.pop 2 state)
1437-
((Let (x, Block (tag, [| y; z; t |], NotArray)), loc) :: instrs)
1458+
((Let (x, Block (tag, [| y; z; t |], Unknown, Maybe_mutable)), loc) :: instrs)
14381459
| MAKEFLOATBLOCK ->
14391460
let size = getu code (pc + 1) in
14401461
let state = State.push state loc in
@@ -1452,7 +1473,12 @@ and compile infos pc state instrs =
14521473
infos
14531474
(pc + 2)
14541475
state
1455-
((Let (x, Block (254, Array.of_list (List.map ~f:fst contents), Unknown)), loc)
1476+
(( Let
1477+
( x
1478+
, Block
1479+
(254, Array.of_list (List.map ~f:fst contents), Unknown, Maybe_mutable)
1480+
)
1481+
, loc )
14561482
:: instrs)
14571483
| GETFIELD0 ->
14581484
let y, _ = State.accu state in
@@ -2470,7 +2496,7 @@ let override_global =
24702496
let init_mod = Var.fresh_n "init_mod" in
24712497
let update_mod = Var.fresh_n "update_mod" in
24722498
( x
2473-
, (Let (x, Block (0, [| init_mod; update_mod |], NotArray)), noloc)
2499+
, (Let (x, Block (0, [| init_mod; update_mod |], NotArray, Immutable)), noloc)
24742500
:: ( Let (init_mod, Special (Alias_prim "caml_CamlinternalMod_init_mod"))
24752501
, noloc )
24762502
:: ( Let (update_mod, Special (Alias_prim "caml_CamlinternalMod_update_mod"))
@@ -3050,7 +3076,7 @@ let predefined_exceptions ~target =
30503076
Regular
30513077
, Int32.of_int (-index - 1) )) )
30523078
, noloc )
3053-
; Let (exn, Block (248, [| v_name; v_index |], NotArray)), noloc
3079+
; Let (exn, Block (248, [| v_name; v_index |], NotArray, Immutable)), noloc
30543080
; ( Let
30553081
( Var.fresh ()
30563082
, Prim

‎compiler/lib/phisimpl.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,7 @@ let expr_deps blocks vars deps defs x e =
5252
match e with
5353
| Constant _ | Apply _ | Prim _ | Special _ -> ()
5454
| Closure (_, cont) -> cont_deps blocks vars deps defs cont
55-
| Block (_, a, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
55+
| Block (_, a, _, _) -> Array.iter a ~f:(fun y -> add_dep deps x y)
5656
| Field (y, _) -> add_dep deps x y
5757

5858
let program_deps { blocks; _ } =

0 commit comments

Comments
 (0)