Skip to content

Commit ec2347d

Browse files
author
Hongbo Zhang
committed
refactoring
1 parent d3ce07a commit ec2347d

13 files changed

+112
-90
lines changed

‎jscomp/js_of_lam_module.ml

-9
Original file line numberDiff line numberDiff line change
@@ -34,12 +34,3 @@ let make ?comment (args : J.expression list) =
3434
?comment E.zero_int_literal
3535
(Blk_module None) args Immutable
3636

37-
let is_empty_shape (shape : J.expression) =
38-
match shape with
39-
| {expression_desc =
40-
Caml_block([
41-
{expression_desc =
42-
Caml_block ([],_,_,_) ; _ }
43-
],_,_,_) ; _}
44-
-> true
45-
| _ -> false

‎jscomp/js_of_lam_module.mli

-2
Original file line numberDiff line numberDiff line change
@@ -31,5 +31,3 @@ val make :
3131
?comment:string ->
3232
J.expression list -> J.expression
3333

34-
val is_empty_shape :
35-
J.expression -> bool

‎jscomp/lam.ml

+20-30
Original file line numberDiff line numberDiff line change
@@ -34,15 +34,15 @@ type mutable_flag = Asttypes.mutable_flag
3434
type field_dbg_info = Lambda.field_dbg_info
3535
type set_field_dbg_info = Lambda.set_field_dbg_info
3636

37-
37+
type ident = Ident.t
3838
type primitive =
3939
| Pbytes_to_string
4040
| Pbytes_of_string
4141
| Pchar_to_int
4242
| Pchar_of_int
4343
(* Globals *)
44-
| Pgetglobal of Ident.t
45-
| Psetglobal of Ident.t
44+
| Pgetglobal of ident
45+
| Psetglobal of ident
4646
(* Operations on heap blocks *)
4747
| Pmakeblock of int * tag_info * mutable_flag
4848
| Pfield of int * field_dbg_info
@@ -74,10 +74,7 @@ type primitive =
7474
(* String operations *)
7575
| Pstringlength
7676
| Pstringrefu
77-
| Pstringsetu
7877
| Pstringrefs
79-
| Pstringsets
80-
8178
| Pbyteslength
8279
| Pbytesrefu
8380
| Pbytessetu
@@ -139,7 +136,7 @@ type primitive =
139136
| Pbswap16
140137
| Pbbswap of boxed_integer
141138
(* Integer to external pointer *)
142-
| Pint_as_pointer
139+
143140
| Pdebugger
144141
| Pjs_unsafe_downgrade
145142
| Pinit_mod
@@ -163,30 +160,30 @@ and apply_info =
163160
and function_info =
164161
{ arity : int ;
165162
kind : Lambda.function_kind ;
166-
params : Ident.t list ;
163+
params : ident list ;
167164
body : t
168165
}
169166
and t =
170-
| Lvar of Ident.t
167+
| Lvar of ident
171168
| Lconst of Lambda.structured_constant
172169
| Lapply of apply_info
173170
| Lfunction of function_info
174-
| Llet of Lambda.let_kind * Ident.t * t * t
175-
| Lletrec of (Ident.t * t) list * t
171+
| Llet of Lambda.let_kind * ident * t * t
172+
| Lletrec of (ident * t) list * t
176173
| Lprim of prim_info
177174
| Lswitch of t * switch
178175
| Lstringswitch of t * (string * t) list * t option
179176
| Lstaticraise of int * t list
180-
| Lstaticcatch of t * (int * Ident.t list) * t
181-
| Ltrywith of t * Ident.t * t
177+
| Lstaticcatch of t * (int * ident list) * t
178+
| Ltrywith of t * ident * t
182179
| Lifthenelse of t * t * t
183180
| Lsequence of t * t
184181
| Lwhile of t * t
185-
| Lfor of Ident.t * t * t * Asttypes.direction_flag * t
186-
| Lassign of Ident.t * t
182+
| Lfor of ident * t * t * Asttypes.direction_flag * t
183+
| Lassign of ident * t
187184
| Lsend of Lambda.meth_kind * t * t * t list * Location.t
188185
| Levent of t * Lambda.lambda_event
189-
| Lifused of Ident.t * t
186+
| Lifused of ident * t
190187

191188

192189
module Prim = struct
@@ -509,6 +506,7 @@ let not x : t =
509506

510507
let lam_prim ~primitive:(p : Lambda.primitive) ~args : t =
511508
match p with
509+
| Pint_as_pointer
512510
| Pidentity ->
513511
begin match args with [x] -> x | _ -> assert false end
514512
| Pbytes_to_string
@@ -544,16 +542,8 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args : t =
544542
| Pmakeblock (tag,info, mutable_flag)
545543
-> prim ~primitive:(Pmakeblock (tag,info,mutable_flag)) ~args
546544
| Pfield (id,info)
547-
->
548-
begin match args with
549-
| [Lprim{primitive = Pgetglobal {name = "CamlinternalMod"}; _}]
550-
->
551-
if id = 0 then prim ~primitive:Pinit_mod ~args:[]
552-
else prim ~primitive:Pupdate_mod ~args:[]
553-
| _
554-
->
555-
prim ~primitive:(Pfield (id,info)) ~args
556-
end
545+
-> prim ~primitive:(Pfield (id,info)) ~args
546+
557547
| Psetfield (id,b,info)
558548
-> prim ~primitive:(Psetfield (id,b,info)) ~args
559549

@@ -592,9 +582,10 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args : t =
592582
| Pasrint -> prim ~primitive:Pasrint ~args
593583
| Pstringlength -> prim ~primitive:Pstringlength ~args
594584
| Pstringrefu -> prim ~primitive:Pstringrefu ~args
595-
| Pstringsetu -> prim ~primitive:Pstringsetu ~args
585+
| Pstringsetu
586+
| Pstringsets -> assert false
596587
| Pstringrefs -> prim ~primitive:Pstringrefs ~args
597-
| Pstringsets -> prim ~primitive:Pstringsets ~args
588+
598589
| Pbyteslength -> prim ~primitive:Pbyteslength ~args
599590
| Pbytesrefu -> prim ~primitive:Pbytesrefu ~args
600591
| Pbytessetu -> prim ~primitive:Pbytessetu ~args
@@ -611,7 +602,7 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args : t =
611602
| Psubfloat -> prim ~primitive:Psubfloat ~args
612603
| Pmulfloat -> prim ~primitive:Pmulfloat ~args
613604
| Pdivfloat -> prim ~primitive:Pdivfloat ~args
614-
| Pint_as_pointer -> prim ~primitive:Pint_as_pointer ~args
605+
615606
| Pbswap16 -> prim ~primitive:Pbswap16 ~args
616607
| Pintcomp x -> prim ~primitive:(Pintcomp x) ~args
617608
| Poffsetint x -> prim ~primitive:(Poffsetint x) ~args
@@ -680,7 +671,6 @@ let rec convert (lam : Lambda.lambda) : t =
680671
match args with
681672
| [_loc ; shape] ->
682673
begin match shape with
683-
684674
| Lconst (Const_block (0, _, [Const_block (0, _, [])]))
685675
-> unit (* see {!Translmod.init_shape}*)
686676
| _ -> prim ~primitive:Pinit_mod ~args

‎jscomp/lam.mli

+23-27
Original file line numberDiff line numberDiff line change
@@ -34,14 +34,15 @@ type mutable_flag = Asttypes.mutable_flag
3434
type field_dbg_info = Lambda.field_dbg_info
3535
type set_field_dbg_info = Lambda.set_field_dbg_info
3636

37+
type ident = Ident.t
3738

38-
type primitive (* = Lambda.primitive *) =
39+
type primitive =
3940
| Pbytes_to_string
4041
| Pbytes_of_string
4142
| Pchar_to_int
4243
| Pchar_of_int
43-
| Pgetglobal of Ident.t
44-
| Psetglobal of Ident.t
44+
| Pgetglobal of ident
45+
| Psetglobal of ident
4546
| Pmakeblock of int * Lambda.tag_info * Asttypes.mutable_flag
4647
| Pfield of int * Lambda.field_dbg_info
4748
| Psetfield of int * bool * Lambda.set_field_dbg_info
@@ -58,18 +59,13 @@ type primitive (* = Lambda.primitive *) =
5859
| Pintcomp of Lambda.comparison
5960
| Poffsetint of int
6061
| Poffsetref of int
61-
6262
| Pintoffloat | Pfloatofint
6363
| Pnegfloat | Pabsfloat
6464
| Paddfloat | Psubfloat | Pmulfloat | Pdivfloat
6565
| Pfloatcomp of Lambda.comparison
66-
6766
| Pstringlength
6867
| Pstringrefu
69-
| Pstringsetu
7068
| Pstringrefs
71-
| Pstringsets
72-
7369
| Pbyteslength
7470
| Pbytesrefu
7571
| Pbytessetu
@@ -131,7 +127,7 @@ type primitive (* = Lambda.primitive *) =
131127
| Pbswap16
132128
| Pbbswap of boxed_integer
133129
(* Integer to external pointer *)
134-
| Pint_as_pointer
130+
135131
| Pdebugger
136132
| Pjs_unsafe_downgrade
137133
| Pinit_mod
@@ -157,30 +153,30 @@ and prim_info = private
157153
and function_info = private
158154
{ arity : int ;
159155
kind : Lambda.function_kind ;
160-
params : Ident.t list ;
156+
params : ident list ;
161157
body : t
162158
}
163159
and t = private
164-
| Lvar of Ident.t
160+
| Lvar of ident
165161
| Lconst of Lambda.structured_constant
166162
| Lapply of apply_info
167163
| Lfunction of function_info
168-
| Llet of Lambda.let_kind * Ident.t * t * t
169-
| Lletrec of (Ident.t * t) list * t
164+
| Llet of Lambda.let_kind * ident * t * t
165+
| Lletrec of (ident * t) list * t
170166
| Lprim of prim_info
171167
| Lswitch of t * switch
172168
| Lstringswitch of t * (string * t) list * t option
173169
| Lstaticraise of int * t list
174-
| Lstaticcatch of t * (int * Ident.t list) * t
175-
| Ltrywith of t * Ident.t * t
170+
| Lstaticcatch of t * (int * ident list) * t
171+
| Ltrywith of t * ident * t
176172
| Lifthenelse of t * t * t
177173
| Lsequence of t * t
178174
| Lwhile of t * t
179-
| Lfor of Ident.t * t * t * Asttypes.direction_flag * t
180-
| Lassign of Ident.t * t
175+
| Lfor of ident * t * t * Asttypes.direction_flag * t
176+
| Lassign of ident * t
181177
| Lsend of Lambda.meth_kind * t * t * t list * Location.t
182178
| Levent of t * Lambda.lambda_event
183-
| Lifused of Ident.t * t
179+
| Lifused of ident * t
184180

185181

186182
module Prim : sig
@@ -197,16 +193,16 @@ type triop = t -> t -> t -> t
197193

198194
type unop = t -> t
199195

200-
val var : Ident.t -> t
196+
val var : ident -> t
201197
val const : Lambda.structured_constant -> t
202198

203199
val apply : t -> t list -> Location.t -> Lambda.apply_status -> t
204200
val function_ :
205201
arity:int ->
206-
kind:Lambda.function_kind -> params:Ident.t list -> body:t -> t
202+
kind:Lambda.function_kind -> params:ident list -> body:t -> t
207203

208-
val let_ : Lambda.let_kind -> Ident.t -> t -> t -> t
209-
val letrec : (Ident.t * t) list -> t -> t
204+
val let_ : Lambda.let_kind -> ident -> t -> t -> t
205+
val letrec : (ident * t) list -> t -> t
210206
val if_ : triop
211207
val switch : t -> switch -> t
212208
val stringswitch : t -> (string * t) list -> t option -> t
@@ -221,9 +217,9 @@ val not : unop
221217
val seq : binop
222218
val while_ : binop
223219
val event : t -> Lambda.lambda_event -> t
224-
val try_ : t -> Ident.t -> t -> t
225-
val ifused : Ident.t -> t -> t
226-
val assign : Ident.t -> t -> t
220+
val try_ : t -> ident -> t -> t
221+
val ifused : ident -> t -> t
222+
val assign : ident -> t -> t
227223

228224
val send :
229225
Lambda.meth_kind ->
@@ -233,13 +229,13 @@ val send :
233229
val prim : primitive:primitive -> args:t list -> t
234230

235231
val staticcatch :
236-
t -> int * Ident.t list -> t -> t
232+
t -> int * ident list -> t -> t
237233

238234
val staticraise :
239235
int -> t list -> t
240236

241237
val for_ :
242-
Ident.t ->
238+
ident ->
243239
t ->
244240
t -> Asttypes.direction_flag -> t -> t
245241

‎jscomp/lam_analysis.ml

+1-3
Original file line numberDiff line numberDiff line change
@@ -126,7 +126,7 @@ let rec no_side_effects (lam : Lam.t) : bool =
126126
(* Compile time constants *)
127127
| Pctconst _
128128
(* Integer to external pointer *)
129-
| Pint_as_pointer
129+
130130
| Poffsetint _
131131

132132
-> true
@@ -135,8 +135,6 @@ let rec no_side_effects (lam : Lam.t) : bool =
135135
| Pjs_unsafe_downgrade
136136
| Pdebugger (* TODO *)
137137

138-
| Pstringsetu
139-
| Pstringsets
140138
| Pbytessetu
141139
| Pbytessets
142140
(* Bitvect operations *)

‎jscomp/lam_compile_primitive.ml

+1-9
Original file line numberDiff line numberDiff line change
@@ -435,14 +435,6 @@ let translate
435435

436436
| _ -> assert false
437437
end
438-
| Pstringsetu
439-
| Pstringsets ->
440-
begin
441-
Ext_log.err __LOC__ "string is immutable, %s is not available" "string.unsafe_set" ;
442-
assert false (* string is immutable *)
443-
end
444-
445-
446438
| Pbytesrefu
447439
| Pbytesrefs ->
448440
begin match args with
@@ -634,7 +626,7 @@ let translate
634626
(* Matching.inline_lazy_force (Lvar parm) Location.none) *)
635627
(* It is inlined, this should not appear here *)
636628
| Pbittest
637-
| Pint_as_pointer
629+
638630
| Pstring_set_16 _
639631
| Pstring_set_32 _
640632
| Pstring_set_64 _

‎jscomp/lam_print.ml

+1-3
Original file line numberDiff line numberDiff line change
@@ -161,9 +161,7 @@ let primitive ppf (prim : Lam.primitive) = match prim with
161161
| Pfloatcomp(Cge) -> fprintf ppf ">=."
162162
| Pstringlength -> fprintf ppf "string.length"
163163
| Pstringrefu -> fprintf ppf "string.unsafe_get"
164-
| Pstringsetu -> fprintf ppf "string.unsafe_set"
165164
| Pstringrefs -> fprintf ppf "string.get"
166-
| Pstringsets -> fprintf ppf "string.set"
167165
| Pbyteslength -> fprintf ppf "bytes.length"
168166
| Pbytesrefu -> fprintf ppf "bytes.unsafe_get"
169167
| Pbytessetu -> fprintf ppf "bytes.unsafe_set"
@@ -251,7 +249,7 @@ let primitive ppf (prim : Lam.primitive) = match prim with
251249
else fprintf ppf "bigarray.array1.set64"
252250
| Pbswap16 -> fprintf ppf "bswap16"
253251
| Pbbswap(bi) -> print_boxed_integer "bswap" ppf bi
254-
| Pint_as_pointer -> fprintf ppf "int_as_pointer"
252+
255253

256254
type print_kind =
257255
| Alias

‎jscomp/runtime/caml_module.ml

+5-4
Original file line numberDiff line numberDiff line change
@@ -22,13 +22,14 @@
2222
* along with this program; if not, write to the Free Software
2323
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
2424

25+
type shape = CamlinternalMod.shape
2526
(** Note that we have to provide a drop in replacement, since compiler internally will
2627
spit out ("CamlinternalMod".[init_mod|update_mod] unless we intercept it
2728
in the lambda layer
2829
*)
29-
let init_mod (loc : string * int * int) (shape : CamlinternalMod.shape) =
30+
let init_mod (loc : string * int * int) (shape : shape) =
3031
let undef_module _ = raise (Undefined_recursive_module loc) in
31-
let rec loop (shape : CamlinternalMod.shape) (struct_ : Obj.t array) idx =
32+
let rec loop (shape : shape) (struct_ : Obj.t array) idx =
3233
match shape with
3334
| Function -> struct_.(idx)<-(Obj.magic undef_module)
3435
| Lazy -> struct_.(idx)<- (Obj.magic (lazy undef_module))
@@ -56,8 +57,8 @@ external caml_update_dummy : Obj.t -> Obj.t -> unit = "caml_update_dummy"
5657
(* Note the [shape] passed between [init_mod] and [update_mod] is always the same
5758
and we assume [module] is encoded as an array
5859
*)
59-
let update_mod (shape : CamlinternalMod.shape) (o : Obj.t) (n : Obj.t) : unit =
60-
let rec aux (shape : CamlinternalMod.shape) o n parent i =
60+
let update_mod (shape : shape) (o : Obj.t) (n : Obj.t) : unit =
61+
let rec aux (shape : shape) o n parent i =
6162
match shape with
6263
| Function
6364
-> Obj.set_field parent i n

‎jscomp/test/.depend

+4
Original file line numberDiff line numberDiff line change
@@ -436,6 +436,8 @@ shift_test.cmj : ../stdlib/nativeint.cmi
436436
shift_test.cmx : ../stdlib/nativeint.cmx
437437
simple_lexer_test.cmj : ../stdlib/string.cmi mt.cmi ../stdlib/lexing.cmi
438438
simple_lexer_test.cmx : ../stdlib/string.cmx mt.cmx ../stdlib/lexing.cmx
439+
simplify_lambda_632o.cmj :
440+
simplify_lambda_632o.cmx :
439441
small_inline_test.cmj :
440442
small_inline_test.cmx :
441443
sprintf_reg_test.cmj : ../stdlib/printf.cmi mt_global.cmi mt.cmi
@@ -1114,6 +1116,8 @@ shift_test.cmo : ../stdlib/nativeint.cmi
11141116
shift_test.cmj : ../stdlib/nativeint.cmj
11151117
simple_lexer_test.cmo : ../stdlib/string.cmi mt.cmi ../stdlib/lexing.cmi
11161118
simple_lexer_test.cmj : ../stdlib/string.cmj mt.cmj ../stdlib/lexing.cmj
1119+
simplify_lambda_632o.cmo :
1120+
simplify_lambda_632o.cmj :
11171121
small_inline_test.cmo :
11181122
small_inline_test.cmj :
11191123
sprintf_reg_test.cmo : ../stdlib/printf.cmi mt_global.cmi mt.cmi

0 commit comments

Comments
 (0)