Skip to content

Commit 706ac5a

Browse files
hhugohhugo
committed
WIP
1 parent 71a6ef8 commit 706ac5a

File tree

7 files changed

+91
-88
lines changed

7 files changed

+91
-88
lines changed

‎compiler/lib/eval.ml

Lines changed: 24 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -152,11 +152,11 @@ let the_length_of info x =
152152
get_approx
153153
info
154154
(fun x ->
155-
match info.info_defs.(Var.idx x) with
156-
| Expr (Constant (String s)) -> Some (Int32.of_int (String.length s))
157-
| Expr (Prim (Extern "caml_create_string", [ arg ]))
158-
| Expr (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int info arg
159-
| _ -> None)
155+
match Flow.Info.def info x with
156+
| Some (Constant (String s)) -> Some (Int32.of_int (String.length s))
157+
| Some (Prim (Extern "caml_create_string", [ arg ]))
158+
| Some (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int info arg
159+
| Some _ | None -> None)
160160
None
161161
(fun u v ->
162162
match u, v with
@@ -175,10 +175,10 @@ let is_int info x =
175175
get_approx
176176
info
177177
(fun x ->
178-
match info.info_defs.(Var.idx x) with
179-
| Expr (Constant (Int _)) -> Y
180-
| Expr (Block (_, _, _, _)) | Expr (Constant _) -> N
181-
| _ -> Unknown)
178+
match Flow.Info.def info x with
179+
| Some (Constant (Int _)) -> Y
180+
| Some (Block (_, _, _, _) | Constant _) -> N
181+
| Some _ | None -> Unknown)
182182
Unknown
183183
(fun u v ->
184184
match u, v with
@@ -195,11 +195,11 @@ let the_tag_of info x get =
195195
get_approx
196196
info
197197
(fun x ->
198-
match info.info_defs.(Var.idx x) with
199-
| Expr (Block (j, _, _, _)) ->
200-
if Var.ISet.mem info.info_possibly_mutable x then None else get j
201-
| Expr (Constant (Tuple (j, _, _))) -> get j
202-
| _ -> None)
198+
match Flow.Info.def info x with
199+
| Some (Block (j, _, _, _)) ->
200+
if Flow.Info.possibly_mutable info x then None else get j
201+
| Some (Constant (Tuple (j, _, _))) -> get j
202+
| Some _ | None -> None)
203203
None
204204
(fun u v ->
205205
match u, v with
@@ -218,10 +218,10 @@ let the_cont_of info x (a : cont array) =
218218
get_approx
219219
info
220220
(fun x ->
221-
match info.info_defs.(Var.idx x) with
222-
| Expr (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
223-
| Expr (Constant (Int j)) -> get (Int32.to_int j)
224-
| _ -> None)
221+
match Flow.Info.def info x with
222+
| Some (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
223+
| Some (Constant (Int j)) -> get (Int32.to_int j)
224+
| Some _ | None -> None)
225225
None
226226
(fun u v ->
227227
match u, v with
@@ -327,9 +327,9 @@ let the_cond_of info x =
327327
get_approx
328328
info
329329
(fun x ->
330-
match info.info_defs.(Var.idx x) with
331-
| Expr (Constant (Int 0l)) -> Zero
332-
| Expr
330+
match Flow.Info.def info x with
331+
| Some (Constant (Int 0l)) -> Zero
332+
| Some
333333
(Constant
334334
( Int _
335335
| Float _
@@ -338,9 +338,9 @@ let the_cond_of info x =
338338
| NativeString _
339339
| Float_array _
340340
| Int64 _ )) -> Non_zero
341-
| Expr (Block (_, _, _, _)) -> Non_zero
342-
| Expr (Field _ | Closure _ | Prim _ | Apply _ | Special _) -> Unknown
343-
| Param | Phi _ | Shape _ -> Unknown)
341+
| Some (Block (_, _, _, _)) -> Non_zero
342+
| Some (Field _ | Closure _ | Prim _ | Apply _ | Special _) -> Unknown
343+
| None -> Unknown)
344344
Unknown
345345
(fun u v ->
346346
match u, v with

‎compiler/lib/eval.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,4 +21,4 @@ val clear_static_env : unit -> unit
2121

2222
val set_static_env : string -> string -> unit
2323

24-
val f : Flow.info -> Code.program -> Code.program
24+
val f : Flow.Info.t -> Code.program -> Code.program

‎compiler/lib/flow.ml

Lines changed: 19 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -32,15 +32,25 @@ let add_var = Var.ISet.add
3232
type def =
3333
| Phi of Var.Set.t
3434
| Expr of Code.expr
35-
| Shape of Shape.t
3635
| Param
3736

38-
type info =
39-
{ info_defs : def array
40-
; info_known_origins : Code.Var.Set.t Code.Var.Tbl.t
41-
; info_maybe_unknown : bool Code.Var.Tbl.t
42-
; info_possibly_mutable : Var.ISet.t
43-
}
37+
module Info = struct
38+
type t =
39+
{ info_defs : def array
40+
; info_known_origins : Code.Var.Set.t Code.Var.Tbl.t
41+
; info_maybe_unknown : bool Code.Var.Tbl.t
42+
; info_possibly_mutable : Var.ISet.t
43+
}
44+
45+
let possibly_mutable t x = Code.Var.ISet.mem t.info_possibly_mutable x
46+
47+
let def t x =
48+
match t.info_defs.(Code.Var.idx x) with
49+
| Expr e -> Some e
50+
| Phi _ | Param -> None
51+
end
52+
53+
open Info
4454

4555
let update_def { info_defs; _ } x exp =
4656
let idx = Code.Var.idx x in
@@ -62,7 +72,7 @@ let add_assign_def vars defs x y =
6272
add_var vars x;
6373
let idx = Var.idx x in
6474
match defs.(idx) with
65-
| Expr _ | Param | Shape _ -> assert false
75+
| Expr _ | Param -> assert false
6676
| Phi s -> defs.(idx) <- Phi (Var.Set.add y s)
6777

6878
let add_param_def vars defs x =
@@ -135,7 +145,6 @@ let var_set_lift f s = Var.Set.fold (fun y s -> Var.Set.union (f y) s) s Var.Set
135145
let propagate1 deps defs st x =
136146
match defs.(Var.idx x) with
137147
| Param -> Var.Set.singleton x
138-
| Shape _ -> Var.Set.singleton x
139148
| Phi s -> var_set_lift (fun y -> Var.Tbl.get st y) s
140149
| Expr e -> (
141150
match e with
@@ -149,7 +158,6 @@ let propagate1 deps defs st x =
149158
let t = a.(n) in
150159
add_dep deps x t;
151160
Var.Tbl.get st t
152-
| Shape _ -> Var.Set.empty
153161
| Phi _ | Param | Expr _ -> Var.Set.empty)
154162
(Var.Tbl.get st y))
155163

@@ -273,7 +281,6 @@ let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x =
273281
match defs.(Var.idx x) with
274282
| Param -> skip_param
275283
| Phi s -> Var.Set.exists (fun y -> Var.Tbl.get st y) s
276-
| Shape _ -> false
277284
| Expr e -> (
278285
match e with
279286
| Constant _ | Closure _ | Apply _ | Prim _ | Block _ | Special _ -> false
@@ -286,7 +293,7 @@ let propagate2 ?(skip_param = false) defs known_origins possibly_mutable st x =
286293
n >= Array.length a
287294
|| Var.ISet.mem possibly_mutable z
288295
|| Var.Tbl.get st a.(n)
289-
| Phi _ | Param | Expr _ | Shape _ -> true)
296+
| Phi _ | Param | Expr _ -> true)
290297
(Var.Tbl.get known_origins y))
291298

292299
module Domain2 = struct

‎compiler/lib/flow.mli

Lines changed: 16 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -37,34 +37,29 @@ val get_label : t -> Code.Var.t option
3737
3838
*)
3939

40-
type def =
41-
| Phi of Code.Var.Set.t
42-
| Expr of Code.expr
43-
| Shape of Shape.t
44-
| Param
45-
46-
type info =
47-
{ info_defs : def array
48-
; info_known_origins : Code.Var.Set.t Code.Var.Tbl.t
49-
; info_maybe_unknown : bool Code.Var.Tbl.t
50-
; info_possibly_mutable : Code.Var.ISet.t
51-
}
40+
module Info : sig
41+
type t
42+
43+
val def : t -> Code.Var.t -> Code.expr option
44+
45+
val possibly_mutable : t -> Code.Var.t -> bool
46+
end
5247

5348
val get_approx :
54-
info -> (Code.Var.Set.elt -> 'b) -> 'b -> ('b -> 'b -> 'b) -> Code.Var.Tbl.key -> 'b
49+
Info.t -> (Code.Var.Set.elt -> 'b) -> 'b -> ('b -> 'b -> 'b) -> Code.Var.Tbl.key -> 'b
5550

56-
val the_def_of : info -> Code.prim_arg -> Code.expr option
51+
val the_def_of : Info.t -> Code.prim_arg -> Code.expr option
5752

58-
val the_const_of : info -> Code.prim_arg -> Code.constant option
53+
val the_const_of : Info.t -> Code.prim_arg -> Code.constant option
5954

60-
val the_string_of : info -> Code.prim_arg -> string option
55+
val the_string_of : Info.t -> Code.prim_arg -> string option
6156

62-
val the_native_string_of : info -> Code.prim_arg -> Code.Native_string.t option
57+
val the_native_string_of : Info.t -> Code.prim_arg -> Code.Native_string.t option
6358

64-
val the_int : info -> Code.prim_arg -> int32 option
59+
val the_int : Info.t -> Code.prim_arg -> int32 option
6560

66-
val update_def : info -> Code.Var.t -> Code.expr -> unit
61+
val update_def : Info.t -> Code.Var.t -> Code.expr -> unit
6762

68-
val the_shape_of : info -> Code.Var.t -> Shape.t
63+
val the_shape_of : Info.t -> Code.Var.t -> Shape.t
6964

70-
val f : ?skip_param:bool -> Code.program -> Code.program * info
65+
val f : ?skip_param:bool -> Code.program -> Code.program * Info.t

‎compiler/lib/specialize.ml

Lines changed: 29 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -24,34 +24,35 @@ open Flow
2424
let function_arity info x =
2525
let rec arity info x acc =
2626
match Shape.get x with
27-
| Some shape ->
28-
(match shape with
29-
| Function { arity; _} -> Some arity
30-
| Block _ | Bot _ -> None)
31-
| None -> get_approx
32-
info
33-
(fun x ->
34-
match info.info_defs.(Var.idx x) with
35-
| Expr (Closure (l, _)) -> Some (List.length l)
36-
| Expr (Special (Alias_prim prim)) -> (
37-
try Some (Primitive.arity prim) with Not_found -> None)
38-
| Expr (Apply { f; args; _ }) -> (
39-
if List.mem f ~set:acc
40-
then None
41-
else
42-
match arity info f (f :: acc) with
43-
| Some n ->
44-
let diff = n - List.length args in
45-
if diff > 0 then Some diff else None
46-
| None -> None)
47-
| Expr _ -> None
48-
| Phi _ | Param | Shape _ -> None)
49-
None
50-
(fun u v ->
51-
match u, v with
52-
| Some n, Some m when n = m -> u
53-
| _ -> None)
54-
x
27+
| Some shape -> (
28+
match shape with
29+
| Function { arity; _ } -> Some arity
30+
| Block _ | Bot _ -> None)
31+
| None ->
32+
get_approx
33+
info
34+
(fun x ->
35+
match Info.def info x with
36+
| Some (Closure (l, _)) -> Some (List.length l)
37+
| Some (Special (Alias_prim prim)) -> (
38+
try Some (Primitive.arity prim) with Not_found -> None)
39+
| Some (Apply { f; args; _ }) -> (
40+
if List.mem f ~set:acc
41+
then None
42+
else
43+
match arity info f (f :: acc) with
44+
| Some n ->
45+
let diff = n - List.length args in
46+
if diff > 0 then Some diff else None
47+
| None -> None)
48+
| Some _ -> None
49+
| None -> None)
50+
None
51+
(fun u v ->
52+
match u, v with
53+
| Some n, Some m when n = m -> u
54+
| _ -> None)
55+
x
5556
in
5657
arity info x []
5758

‎compiler/lib/specialize.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,6 @@
1818
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1919
*)
2020

21-
val function_arity : Flow.info -> Code.Var.t -> int option
21+
val function_arity : Flow.Info.t -> Code.Var.t -> int option
2222

2323
val f : function_arity:(Code.Var.t -> int option) -> Code.program -> Code.program

‎compiler/lib/specialize_js.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,6 @@
1818
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
1919
*)
2020

21-
val f : Flow.info -> Code.program -> Code.program
21+
val f : Flow.Info.t -> Code.program -> Code.program
2222

2323
val f_once : Code.program -> Code.program

0 commit comments

Comments
 (0)