24
24
25
25
26
26
27
-
28
-
29
-
30
-
31
-
32
27
module E = Js_exp_make
33
28
module S = Js_stmt_make
34
29
@@ -49,11 +44,6 @@ type continuation = Lam_compile_context.continuation
49
44
let make ?value ?(finished =False ) block =
50
45
{ block ; value ; finished }
51
46
52
- let of_stmt ?value ?(finished = False ) stmt =
53
- { block = [stmt] ; value ; finished }
54
-
55
- let of_block ?value ?(finished = False ) block =
56
- { block ; value ; finished }
57
47
58
48
let dummy =
59
49
{value = None ; block = [] ; finished = Dummy }
@@ -94,47 +84,65 @@ let output_of_block_and_expression
94
84
| NeedValue , (ReturnTrue _ | ReturnFalse ) ->
95
85
make block ~value: exp
96
86
97
- let statement_of_opt_expr (x : J.expression option ) : J.statement =
98
- match x with
99
- | None -> S. empty_stmt
100
- | Some x when Js_analyzer. no_side_effect_expression x ->
101
- S. empty_stmt
102
- (* TODO, pure analysis in lambda instead *)
103
- | Some x -> S. exp x
104
87
105
- let rec unroll_block (block : J.block ) =
88
+
89
+ let block_with_opt_expr block (x : J.expression option ) : J.block =
90
+ match x with
91
+ | None -> block
92
+ | Some x when Js_analyzer. no_side_effect_expression x -> block
93
+ | Some x -> block @ [S. exp x ]
94
+
95
+ let opt_expr_with_block (x : J.expression option ) block : J.block =
96
+ match x with
97
+ | None -> block
98
+ | Some x when Js_analyzer. no_side_effect_expression x -> block
99
+ | Some x -> (S. exp x) :: block
100
+
101
+
102
+ let rec unnest_block (block : J.block ) : J.block =
106
103
match block with
107
- | [{statement_desc = Block block}] -> unroll_block block
104
+ | [{statement_desc = Block block}] -> unnest_block block
108
105
| _ -> block
109
106
110
- let to_block ( x : t ) : J.block =
107
+ let output_as_block ( x : t ) : J.block =
111
108
match x with
112
109
| {block; value = opt ; finished} ->
113
- let block = unroll_block block in
110
+ let block = unnest_block block in
114
111
if finished = True then block
115
112
else
116
- begin match opt with
117
- | None -> block (* TODO, pure analysis in lambda instead *)
118
- | Some x when Js_analyzer. no_side_effect_expression x -> block
119
- | Some x -> block @ [S. exp x ]
120
- end
113
+ block_with_opt_expr block opt
114
+
121
115
122
116
let to_break_block (x : t ) : J.block * bool =
117
+ let block = unnest_block x.block in
123
118
match x with
124
- | {finished = True ; block ; _ } ->
125
- unroll_block block, false
119
+ | {finished = True ; _ } ->
120
+ block, false
126
121
(* value does not matter when [finished] is true
127
122
TODO: check if it has side efects
128
123
*)
129
- | {block; value = None ; finished } ->
130
- let block = unroll_block block in
124
+ | { value = None ; finished } ->
131
125
block, (match finished with | True -> false | (False | Dummy ) -> true )
132
126
133
- | {block; value = opt ; _} ->
134
- let block = unroll_block block in
135
- block @ [statement_of_opt_expr opt], true
127
+ | {value = Some _ as opt ; _} ->
128
+ block_with_opt_expr block opt, true
129
+
136
130
137
- let rec append (x : t ) (y : t ) : t =
131
+ (* * TODO: make everything expression make inlining hard, and code not readable?
132
+ 1. readability dpends on how we print the expression
133
+ 2. inlining needs generate symbols, which are statements, type mismatch
134
+ we need capture [Exp e]
135
+
136
+ can we call them all [statement]? statement has no value
137
+ *)
138
+ (* | {block = [{statement_desc = Exp e }]; value = None ; _}, _ *)
139
+ (* -> *)
140
+ (* append { x with block = []; value = Some e} y *)
141
+ (* | _ , {block = [{statement_desc = Exp e }]; value = None ; _} *)
142
+ (* -> *)
143
+ (* append x { y with block = []; value = Some e} *)
144
+
145
+ let rec append_output (x : t ) (y : t ) : t =
138
146
match x , y with (* ATTTENTION: should not optimize [opt_e2], it has to conform to [NeedValue]*)
139
147
| {finished = True ; _ } , _ -> x
140
148
| _ , {block = [] ; value = None ; finished = Dummy } -> x
@@ -151,34 +159,17 @@ let rec append (x : t ) (y : t ) : t =
151
159
{block = [] ; value = Some (E. seq e1 e2); finished}
152
160
(* {block = [S.exp e1]; value = Some e2(\* (E.seq e1 e2) *\); finished} *)
153
161
154
- (* * TODO: make everything expression make inlining hard, and code not readable?
155
-
156
- 1. readability pends on how we print the expression
157
- 2. inlining needs generate symbols, which are statements, type mismatch
158
- we need capture [Exp e]
159
-
160
- can we call them all [statement]? statement has no value
161
- *)
162
- (* | {block = [{statement_desc = Exp e }]; value = None ; _}, _ *)
163
- (* -> *)
164
- (* append { x with block = []; value = Some e} y *)
165
- (* | _ , {block = [{statement_desc = Exp e }]; value = None ; _} *)
166
- (* -> *)
167
- (* append x { y with block = []; value = Some e} *)
168
-
169
162
| {block = block1 ; value = opt_e1 ; _} , {block = block2 ; value = opt_e2 ; finished} ->
170
- let block1 = unroll_block block1 in
171
- make (block1 @ (statement_of_opt_expr opt_e1 :: unroll_block block2))
163
+ let block1 = unnest_block block1 in
164
+ make (block1 @ (opt_expr_with_block opt_e1 @@ unnest_block block2))
172
165
?value:opt_e2 ~finished
173
166
174
167
175
- module Ops = struct
176
- let (++) (x : t ) (y : t ) : t = append x y
177
- end
168
+
178
169
179
170
(* Fold right is more efficient *)
180
171
let concat (xs : t list ) : t =
181
- Ext_list. fold_right (fun x acc -> append x acc) xs dummy
172
+ Ext_list. fold_right (fun x acc -> append_output x acc) xs dummy
182
173
183
174
let to_string x =
184
- Js_dump. string_of_block (to_block x)
175
+ Js_dump. string_of_block (output_as_block x)
0 commit comments