@@ -70695,8 +70695,8 @@ val no_side_effect_statement :
70695
70695
val eq_expression :
70696
70696
J.expression -> J.expression -> bool
70697
70697
70698
- (* val eq_statement :
70699
- J.statement -> J.statement -> bool *)
70698
+ val eq_statement :
70699
+ J.statement -> J.statement -> bool
70700
70700
70701
70701
val rev_flatten_seq : J.expression -> J.block
70702
70702
@@ -70753,7 +70753,7 @@ end = struct
70753
70753
70754
70754
Note such shaking is done in the toplevel, so that it requires us to
70755
70755
flatten the statement first
70756
- *)
70756
+ *)
70757
70757
let free_variables used_idents defined_idents =
70758
70758
object (self)
70759
70759
inherit Js_fold.fold as super
@@ -70774,9 +70774,9 @@ let free_variables used_idents defined_idents =
70774
70774
70775
70775
match exp.expression_desc with
70776
70776
| Fun(_, _,_, env)
70777
- (** a optimization to avoid walking into funciton again
70778
- if it's already comuted
70779
- *)
70777
+ (** a optimization to avoid walking into funciton again
70778
+ if it's already comuted
70779
+ *)
70780
70780
->
70781
70781
{< used_idents =
70782
70782
Ident_set.union (Js_fun_env.get_unbounded env) used_idents >}
@@ -70810,12 +70810,12 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) =
70810
70810
| Array (xs,_mutable_flag)
70811
70811
| Caml_block (xs, _mutable_flag, _, _)
70812
70812
->
70813
- (** create [immutable] block,
70814
- does not really mean that this opreation itself is [pure].
70815
-
70816
- the block is mutable does not mean this operation is non-pure
70817
- *)
70818
- List.for_all no_side_effect xs
70813
+ (** create [immutable] block,
70814
+ does not really mean that this opreation itself is [pure].
70815
+
70816
+ the block is mutable does not mean this operation is non-pure
70817
+ *)
70818
+ List.for_all no_side_effect xs
70819
70819
| Bind(fn, obj) -> no_side_effect fn && no_side_effect obj
70820
70820
| Object kvs ->
70821
70821
List.for_all (fun (_property_name, y) -> no_side_effect y ) kvs
@@ -70867,54 +70867,140 @@ let no_side_effect init =
70867
70867
70868
70868
method! statement s =
70869
70869
if not no_side_effect then self else
70870
- match s.statement_desc with
70871
- | Throw _
70872
- | Debugger
70873
- | Break
70874
- | Variable _
70875
- | Continue _ ->
70876
- {< no_side_effect = false>}
70877
- | Exp e -> self#expression e
70878
- | Int_switch _ | String_switch _ | ForRange _
70879
- | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s
70870
+ match s.statement_desc with
70871
+ | Throw _
70872
+ | Debugger
70873
+ | Break
70874
+ | Variable _
70875
+ | Continue _ ->
70876
+ {< no_side_effect = false>}
70877
+ | Exp e -> self#expression e
70878
+ | Int_switch _ | String_switch _ | ForRange _
70879
+ | If _ | While _ | Block _ | Return _ | Try _ -> super#statement s
70880
70880
method! list f x =
70881
70881
if not self#get_no_side_effect then self else super#list f x
70882
70882
method! expression s =
70883
70883
if not no_side_effect then self
70884
70884
else {< no_side_effect = no_side_effect_expression s >}
70885
70885
70886
- (** only expression would cause side effec *)
70886
+ (** only expression would cause side effec *)
70887
70887
end
70888
70888
let no_side_effect_statement st = ((no_side_effect true)#statement st)#get_no_side_effect
70889
70889
70890
70890
(* TODO: generate [fold2]
70891
70891
This make sense, for example:
70892
70892
{[
70893
- let string_of_formatting_gen : type a b c d e f .
70894
- (a, b, c, d, e, f) formatting_gen -> string =
70895
- fun formatting_gen -> match formatting_gen with
70896
- | Open_tag (Format (_, str)) -> str
70897
- | Open_box (Format (_, str)) -> str
70893
+ let string_of_formatting_gen : type a b c d e f .
70894
+ (a, b, c, d, e, f) formatting_gen -> string =
70895
+ fun formatting_gen -> match formatting_gen with
70896
+ | Open_tag (Format (_, str)) -> str
70897
+ | Open_box (Format (_, str)) -> str
70898
70898
70899
70899
]}
70900
- *)
70901
- let rec eq_expression (x : J.expression) (y : J.expression) =
70902
- match x.expression_desc, y.expression_desc with
70903
- | Number (Int i) , Number (Int j) -> i = j
70904
- | Number (Float i), Number (Float j) -> false (* TODO *)
70905
- | Math (name00,args00), Math(name10,args10) ->
70906
- name00 = name10 && eq_expression_list args00 args10
70907
- | Access (a0,a1), Access(b0,b1) ->
70908
- eq_expression a0 b0 && eq_expression a1 b1
70909
- | Call (a0,args00,_), Call(b0,args10,_) ->
70910
- eq_expression a0 b0 && eq_expression_list args00 args10
70911
- | Var (Id i), Var (Id j) ->
70912
- Ident.same i j
70913
- | Bin (op0, a0,b0) , Bin(op1,a1,b1) ->
70914
- op0 = op1 && eq_expression a0 a1 && eq_expression b0 b1
70915
- | Str(a0,b0), Str(a1,b1) -> a0 = a1 && b0 = b1
70916
- | _, _ -> false
70917
-
70900
+ *)
70901
+ let rec eq_expression
70902
+ ({expression_desc = x0} : J.expression)
70903
+ ({expression_desc = y0} : J.expression) =
70904
+ begin match x0 with
70905
+ | Number (Int i) ->
70906
+ begin match y0 with
70907
+ | Number (Int j) -> i = j
70908
+ | _ -> false
70909
+ end
70910
+ | Number (Float i) ->
70911
+ begin match y0 with
70912
+ | Number (Float j) ->
70913
+ false (* conservative *)
70914
+ | _ -> false
70915
+ end
70916
+ | Math (name00,args00) ->
70917
+ begin match y0 with
70918
+ |Math(name10,args10) ->
70919
+ name00 = name10 && eq_expression_list args00 args10
70920
+ | _ -> false
70921
+ end
70922
+ | Access (a0,a1) ->
70923
+ begin match y0 with
70924
+ | Access(b0,b1) ->
70925
+ eq_expression a0 b0 && eq_expression a1 b1
70926
+ | _ -> false
70927
+ end
70928
+ | Call (a0,args00,_) ->
70929
+ begin match y0 with
70930
+ | Call(b0,args10,_) ->
70931
+ eq_expression a0 b0 && eq_expression_list args00 args10
70932
+ | _ -> false
70933
+ end
70934
+ | Var (Id i) ->
70935
+ begin match y0 with
70936
+ | Var (Id j) ->
70937
+ Ident.same i j
70938
+ | _ -> false
70939
+ end
70940
+ | Bin (op0, a0,b0) ->
70941
+ begin match y0 with
70942
+ | Bin(op1,a1,b1) ->
70943
+ op0 = op1 && eq_expression a0 a1 && eq_expression b0 b1
70944
+ | _ -> false
70945
+ end
70946
+ | Str(a0,b0) ->
70947
+ begin match y0 with
70948
+ | Str(a1,b1) -> a0 = a1 && b0 = b1
70949
+ | _ -> false
70950
+ end
70951
+ | Var (Qualified (id0,k0,opts0)) ->
70952
+ begin match y0 with
70953
+ | Var (Qualified (id1,k1,opts1)) ->
70954
+ Ident.same id0 id1 &&
70955
+ k0 = k1 &&
70956
+ opts0 = opts1
70957
+ | _ -> false
70958
+ end
70959
+ | Dot (e0,p0,b0) ->
70960
+ begin match y0 with
70961
+ | Dot(e1,p1,b1) ->
70962
+ p0 = p1 && b0 = b1 && eq_expression e0 e1
70963
+ | _ -> false
70964
+ end
70965
+ | Length _
70966
+ | Char_of_int _
70967
+ | Char_to_int _
70968
+ | Is_null_undefined_to_boolean _
70969
+ | Array_of_size _
70970
+ | Array_copy _
70971
+ | Array_append _
70972
+ | String_append _
70973
+ | Int_of_boolean _
70974
+ | Anything_to_number _
70975
+ | Bool _
70976
+ | Typeof _
70977
+ | Caml_not _
70978
+ | Js_not _
70979
+ | String_of_small_int_array _
70980
+ | Json_stringify _
70981
+ | Anything_to_string _
70982
+ | Dump _
70983
+ | Seq _
70984
+ | Cond _
70985
+ | FlatCall _
70986
+ | Bind _
70987
+ | String_access _
70988
+
70989
+ | New _
70990
+ | Fun _
70991
+ | Unicode _
70992
+ | Raw_js_code _
70993
+ | Array _
70994
+ | Caml_block _
70995
+ | Caml_uninitialized_obj _
70996
+ | Caml_block_tag _
70997
+ | Caml_block_set_tag _
70998
+ | Caml_block_set_length _
70999
+ | Object _
71000
+ | Number (Uint _ | Nint _)
71001
+
71002
+ -> false
71003
+ end
70918
71004
and eq_expression_list xs ys =
70919
71005
let rec aux xs ys =
70920
71006
match xs,ys with
@@ -70942,17 +71028,17 @@ let rev_flatten_seq (x : J.expression) =
70942
71028
70943
71029
(* TODO: optimization,
70944
71030
counter the number to know if needed do a loop gain instead of doing a diff
70945
- *)
71031
+ *)
70946
71032
70947
71033
let rev_toplevel_flatten block =
70948
71034
let rec aux acc (xs : J.block) : J.block =
70949
71035
match xs with
70950
71036
| [] -> acc
70951
71037
| {statement_desc =
70952
- Variable (
70953
- {ident_info = {used_stats = Dead_pure } ; _}
70954
- | {ident_info = {used_stats = Dead_non_pure}; value = None })
70955
- } :: xs -> aux acc xs
71038
+ Variable (
71039
+ {ident_info = {used_stats = Dead_pure } ; _}
71040
+ | {ident_info = {used_stats = Dead_non_pure}; value = None })
71041
+ } :: xs -> aux acc xs
70956
71042
| {statement_desc = Block b; _ } ::xs -> aux (aux acc b ) xs
70957
71043
70958
71044
| x :: xs -> aux (x :: acc) xs in
0 commit comments