Skip to content

Commit 0146260

Browse files
hhugohhugo
committed
Compiler: extract mutability of blocks
1 parent 4da4dba commit 0146260

File tree

3 files changed

+111
-32
lines changed

3 files changed

+111
-32
lines changed

‎compiler/lib/ocaml_compiler.ml‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,46 @@ let rec constant_of_const c : Code.constant =
3737
let l = Array.of_list (List.map l ~f:constant_of_const) in
3838
Tuple (tag, l, Unknown)
3939

40+
type module_or_not =
41+
| Module
42+
| Not_module
43+
| Unknown
44+
45+
let rec is_module_in_summary deep ident' summary =
46+
match summary with
47+
(* Unknown *)
48+
| Env.Env_empty -> deep, Unknown
49+
(* Module *)
50+
| Env.Env_module (summary, ident, _, _)
51+
| Env.Env_functor_arg (summary, ident)
52+
| Env.Env_persistent (summary, ident) ->
53+
if Ident.same ident ident'
54+
then deep, Module
55+
else is_module_in_summary (deep + 1) ident' summary
56+
(* Not_module *)
57+
| Env.Env_modtype (summary, ident, _) | Env.Env_extension (summary, ident, _) ->
58+
if Ident.same ident ident'
59+
then deep, Not_module
60+
else is_module_in_summary (deep + 1) ident' summary
61+
(* Lowercase ident *)
62+
| Env.Env_value (summary, ident, _)
63+
| Env.Env_type (summary, ident, _)
64+
| Env.Env_class (summary, ident, _)
65+
| Env.Env_cltype (summary, ident, _) ->
66+
ignore (ident : Ident.t);
67+
is_module_in_summary (deep + 1) ident' summary
68+
(* Other, no ident *)
69+
| Env.Env_open (summary, _)
70+
| Env.Env_constraints (summary, _)
71+
| Env.Env_copy_types summary
72+
| Env.Env_value_unbound (summary, _, _)
73+
| Env.Env_module_unbound (summary, _, _) ->
74+
is_module_in_summary (deep + 1) ident' summary
75+
76+
let is_module_in_summary ident summary =
77+
let _deep, b = is_module_in_summary 0 ident summary in
78+
b
79+
4080
module Symtable = struct
4181
(* Copied from ocaml/bytecomp/symtable.ml *)
4282
module Num_tbl (M : Map.S) = struct

‎compiler/lib/ocaml_compiler.mli‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,13 @@
1818

1919
val constant_of_const : Lambda.structured_constant -> Code.constant
2020

21+
type module_or_not =
22+
| Module
23+
| Not_module
24+
| Unknown
25+
26+
val is_module_in_summary : Ident.t -> Env.summary -> module_or_not
27+
2128
module Symtable : sig
2229
module Global : sig
2330
type t =

‎compiler/lib/parse_bytecode.ml‎

Lines changed: 64 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -583,6 +583,8 @@ module State = struct
583583
; env_offset : int
584584
; handlers : handler list
585585
; globals : globals
586+
; immutable : unit Code.Var.Hashtbl.t
587+
; module_or_not : Ocaml_compiler.module_or_not Ident.Tbl.t
586588
}
587589

588590
let fresh_var state =
@@ -667,8 +669,16 @@ module State = struct
667669

668670
let pop_handler state = { state with handlers = List.tl state.handlers }
669671

670-
let initial g =
671-
{ accu = Unset; stack = []; env = [||]; env_offset = 0; handlers = []; globals = g }
672+
let initial g immutable =
673+
{ accu = Unset
674+
; stack = []
675+
; env = [||]
676+
; env_offset = 0
677+
; handlers = []
678+
; globals = g
679+
; immutable
680+
; module_or_not = Ident.Tbl.create 0
681+
}
672682

673683
let rec print_stack f l =
674684
match l with
@@ -691,20 +701,37 @@ module State = struct
691701
print_env
692702
st.env
693703

694-
let rec name_rec debug i l s summary =
704+
let maybe_module ident =
705+
match (Ident.name ident).[0] with
706+
| 'A' .. 'Z' -> true
707+
| _ -> false
708+
709+
let rec name_rec debug st i l s summary =
695710
match l, s with
696711
| [], _ -> ()
697712
| (j, ident) :: lrem, Var v :: srem when i = j ->
713+
(if maybe_module ident && not (Code.Var.Hashtbl.mem st.immutable v)
714+
then
715+
match Ident.Tbl.find st.module_or_not ident with
716+
| Module -> Code.Var.Hashtbl.add st.immutable v ()
717+
| Not_module -> ()
718+
| (exception Not_found) | Unknown -> (
719+
match Ocaml_compiler.is_module_in_summary ident summary with
720+
| Module ->
721+
Ident.Tbl.add st.module_or_not ident Module;
722+
Code.Var.Hashtbl.add st.immutable v ()
723+
| Not_module -> Ident.Tbl.add st.module_or_not ident Not_module
724+
| Unknown -> ()));
698725
Var.set_name v (Ident.name ident);
699-
name_rec debug (i + 1) lrem srem summary
700-
| (j, _) :: _, _ :: srem when i < j -> name_rec debug (i + 1) l srem summary
726+
name_rec debug st (i + 1) lrem srem summary
727+
| (j, _) :: _, _ :: srem when i < j -> name_rec debug st (i + 1) l srem summary
701728
| _ -> assert false
702729

703730
let name_vars st debug pc =
704731
if Debug.names debug
705732
then
706733
let l, summary = Debug.find debug pc in
707-
name_rec debug 0 l st.stack summary
734+
name_rec debug st 0 l st.stack summary
708735

709736
let rec make_stack i state =
710737
if i = 0
@@ -850,6 +877,8 @@ let string_of_addr debug_data addr =
850877
in
851878
Printf.sprintf "%s:%s-%s %s" file (pos loc.loc_start) (pos loc.loc_end) kind)
852879

880+
let is_immutable _instr _infos _pc = (* We don't know yet *) Maybe_mutable
881+
853882
let rec compile_block blocks joins debug_data code pc state : unit =
854883
match Addr.Map.find_opt pc !tagged_blocks with
855884
| Some old_state -> (
@@ -1377,47 +1406,36 @@ and compile infos pc state (instrs : instr list) =
13771406
let x, state = State.fresh_var state in
13781407
if debug_parser () then Format.printf "%a = 0@." Var.print x;
13791408
let instrs = register_global g i instrs in
1409+
Code.Var.Hashtbl.add state.immutable (access_global g i) ();
13801410
compile infos (pc + 2) state (Let (x, const 0) :: instrs)
13811411
| ATOM0 ->
13821412
let x, state = State.fresh_var state in
13831413

13841414
if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
1385-
compile
1386-
infos
1387-
(pc + 1)
1388-
state
1389-
(Let (x, Block (0, [||], Unknown, Maybe_mutable)) :: instrs)
1415+
let imm = is_immutable instr infos pc in
1416+
compile infos (pc + 1) state (Let (x, Block (0, [||], Unknown, imm)) :: instrs)
13901417
| ATOM ->
13911418
let i = getu code (pc + 1) in
13921419
let x, state = State.fresh_var state in
13931420

13941421
if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
1395-
compile
1396-
infos
1397-
(pc + 2)
1398-
state
1399-
(Let (x, Block (i, [||], Unknown, Maybe_mutable)) :: instrs)
1422+
let imm = is_immutable instr infos pc in
1423+
compile infos (pc + 2) state (Let (x, Block (i, [||], Unknown, imm)) :: instrs)
14001424
| PUSHATOM0 ->
14011425
let state = State.push state in
14021426
let x, state = State.fresh_var state in
14031427

14041428
if debug_parser () then Format.printf "%a = ATOM(0)@." Var.print x;
1405-
compile
1406-
infos
1407-
(pc + 1)
1408-
state
1409-
(Let (x, Block (0, [||], Unknown, Maybe_mutable)) :: instrs)
1429+
let imm = is_immutable instr infos pc in
1430+
compile infos (pc + 1) state (Let (x, Block (0, [||], Unknown, imm)) :: instrs)
14101431
| PUSHATOM ->
14111432
let state = State.push state in
14121433

14131434
let i = getu code (pc + 1) in
14141435
let x, state = State.fresh_var state in
14151436
if debug_parser () then Format.printf "%a = ATOM(%d)@." Var.print x i;
1416-
compile
1417-
infos
1418-
(pc + 2)
1419-
state
1420-
(Let (x, Block (i, [||], Unknown, Maybe_mutable)) :: instrs)
1437+
let imm = is_immutable instr infos pc in
1438+
compile infos (pc + 2) state (Let (x, Block (i, [||], Unknown, imm)) :: instrs)
14211439
| MAKEBLOCK ->
14221440
let size = getu code (pc + 1) in
14231441
let tag = getu code (pc + 2) in
@@ -1432,22 +1450,24 @@ and compile infos pc state (instrs : instr list) =
14321450
Format.printf "%d = %a; " i Var.print (List.nth contents i)
14331451
done;
14341452
Format.printf "}@.");
1453+
let imm = is_immutable instr infos pc in
14351454
compile
14361455
infos
14371456
(pc + 3)
14381457
state
1439-
(Let (x, Block (tag, Array.of_list contents, Unknown, Maybe_mutable)) :: instrs)
1458+
(Let (x, Block (tag, Array.of_list contents, Unknown, imm)) :: instrs)
14401459
| MAKEBLOCK1 ->
14411460
let tag = getu code (pc + 1) in
14421461
let y = State.accu state in
14431462
let x, state = State.fresh_var state in
14441463

14451464
if debug_parser () then Format.printf "%a = { 0 = %a; }@." Var.print x Var.print y;
1465+
let imm = is_immutable instr infos pc in
14461466
compile
14471467
infos
14481468
(pc + 2)
14491469
state
1450-
(Let (x, Block (tag, [| y |], Unknown, Maybe_mutable)) :: instrs)
1470+
(Let (x, Block (tag, [| y |], Unknown, imm)) :: instrs)
14511471
| MAKEBLOCK2 ->
14521472
let tag = getu code (pc + 1) in
14531473
let y = State.accu state in
@@ -1457,11 +1477,12 @@ and compile infos pc state (instrs : instr list) =
14571477
if debug_parser ()
14581478
then
14591479
Format.printf "%a = { 0 = %a; 1 = %a; }@." Var.print x Var.print y Var.print z;
1480+
let imm = is_immutable instr infos pc in
14601481
compile
14611482
infos
14621483
(pc + 2)
14631484
(State.pop 1 state)
1464-
(Let (x, Block (tag, [| y; z |], Unknown, Maybe_mutable)) :: instrs)
1485+
(Let (x, Block (tag, [| y; z |], Unknown, imm)) :: instrs)
14651486
| MAKEBLOCK3 ->
14661487
let tag = getu code (pc + 1) in
14671488
let y = State.accu state in
@@ -1481,11 +1502,12 @@ and compile infos pc state (instrs : instr list) =
14811502
z
14821503
Var.print
14831504
t;
1505+
let imm = is_immutable instr infos pc in
14841506
compile
14851507
infos
14861508
(pc + 2)
14871509
(State.pop 2 state)
1488-
(Let (x, Block (tag, [| y; z; t |], Unknown, Maybe_mutable)) :: instrs)
1510+
(Let (x, Block (tag, [| y; z; t |], Unknown, imm)) :: instrs)
14891511
| MAKEFLOATBLOCK ->
14901512
let size = getu code (pc + 1) in
14911513
let state = State.push state in
@@ -1499,11 +1521,12 @@ and compile infos pc state (instrs : instr list) =
14991521
Format.printf "%d = %a; " i Var.print (List.nth contents i)
15001522
done;
15011523
Format.printf "}@.");
1524+
let imm = is_immutable instr infos pc in
15021525
compile
15031526
infos
15041527
(pc + 2)
15051528
state
1506-
(Let (x, Block (254, Array.of_list contents, Unknown, Maybe_mutable)) :: instrs)
1529+
(Let (x, Block (254, Array.of_list contents, Unknown, imm)) :: instrs)
15071530
| GETFIELD0 ->
15081531
let y = State.accu state in
15091532
let x, state = State.fresh_var state in
@@ -2511,17 +2534,26 @@ type one =
25112534
}
25122535

25132536
let parse_bytecode code globals debug_data =
2514-
let state = State.initial globals in
2537+
let immutable = Code.Var.Hashtbl.create 0 in
2538+
let state = State.initial globals immutable in
25152539
Code.Var.reset ();
25162540
let blocks', joins = Blocks.analyse code in
25172541
let p =
25182542
if not (Blocks.is_empty blocks')
25192543
then (
25202544
let start = 0 in
2545+
25212546
compile_block blocks' joins debug_data code start state;
25222547
let blocks =
25232548
Addr.Map.mapi
25242549
(fun _ (state, instr, last) ->
2550+
let instr =
2551+
List.map instr ~f:(function
2552+
| Let (x, Block (tag, args, k, Maybe_mutable))
2553+
when Code.Var.Hashtbl.mem immutable x ->
2554+
Let (x, Block (tag, args, k, Immutable))
2555+
| x -> x)
2556+
in
25252557
{ params =
25262558
(match state with
25272559
| Some state -> State.stack_vars state

0 commit comments

Comments
 (0)