The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #14260 from lthls/single-lambda-string-const
Normalise string constants in Lambda
authored by
Vincent Laviron
and committed by
GitHub
aa53c7c4
25b6cc97
+105
-98
-4
.depend
-4
.depend
···
2511
2511
utils/clflags.cmi \
2512
2512
bytecomp/bytegen.cmi \
2513
2513
typing/btype.cmi \
2514
-
parsing/asttypes.cmi \
2515
2514
bytecomp/emitcode.cmi
2516
2515
bytecomp/emitcode.cmx : \
2517
2516
parsing/unit_info.cmx \
···
2532
2531
utils/clflags.cmx \
2533
2532
bytecomp/bytegen.cmx \
2534
2533
typing/btype.cmx \
2535
-
parsing/asttypes.cmx \
2536
2534
bytecomp/emitcode.cmi
2537
2535
bytecomp/emitcode.cmi : \
2538
2536
parsing/unit_info.cmi \
···
4436
4434
typing/path.cmi \
4437
4435
utils/misc.cmi \
4438
4436
parsing/longident.cmi \
4439
-
parsing/location.cmi \
4440
4437
typing/ident.cmi \
4441
4438
typing/env.cmi \
4442
4439
lambda/debuginfo.cmi \
···
4450
4447
typing/path.cmx \
4451
4448
utils/misc.cmx \
4452
4449
parsing/longident.cmx \
4453
-
parsing/location.cmx \
4454
4450
typing/ident.cmx \
4455
4451
typing/env.cmx \
4456
4452
lambda/debuginfo.cmx \
+4
Changes
+4
Changes
···
294
294
- #14198 Constraints on module unpacking are not ghost
295
295
(Thomas Refis, review by Nicolás Ojeda Bär)
296
296
297
+
- #14260: Refactor Lambda.structured_constant to avoid duplicate
298
+
representations for string constants
299
+
(Vincent Laviron, review by Nicolás Ojeda Bär and Gabriel Scherer)
300
+
297
301
### Build system:
298
302
299
303
- #13810: Support build of cross compilers to native freestanding targets
+5
-5
bytecomp/bytegen.ml
+5
-5
bytecomp/bytegen.ml
···
570
570
let getmethod, args' =
571
571
if kind = Self then (Kgetmethod, met::obj::args) else
572
572
match met with
573
-
Lconst(Const_base(Const_int n)) -> (Kgetpubmet n, obj::args)
573
+
Lconst(Const_int n) -> (Kgetpubmet n, obj::args)
574
574
| _ -> (Kgetdynmet, met::obj::args)
575
575
in
576
576
if is_tailcall cont then
···
667
667
end
668
668
| Lprim(Praise k, [arg], _) ->
669
669
comp_expr stack_info env arg sz (Kraise k :: discard_dead_code cont)
670
-
| Lprim(Paddint, [arg; Lconst(Const_base(Const_int n))], _)
670
+
| Lprim(Paddint, [arg; Lconst(Const_int n)], _)
671
671
when is_immed n ->
672
672
comp_expr stack_info env arg sz (Koffsetint n :: cont)
673
-
| Lprim(Psubint, [arg; Lconst(Const_base(Const_int n))], _)
673
+
| Lprim(Psubint, [arg; Lconst(Const_int n)], _)
674
674
when is_immed (-n) ->
675
675
comp_expr stack_info env arg sz (Koffsetint (-n) :: cont)
676
676
| Lprim (Poffsetint n, [arg], _)
677
677
when not (is_immed n) ->
678
678
comp_expr stack_info env arg sz
679
679
(Kpush::
680
-
Kconst (Const_base (Const_int n))::
680
+
Kconst (Const_int n)::
681
681
Kaddint::cont)
682
682
| Lprim(Pmakearray (kind, _), args, loc) ->
683
683
let cont = add_pseudo_event loc !compunit_name cont in
···
1043
1043
let code = comp_expr stack_info env exp sz cont in
1044
1044
let used_safe = !(stack_info.max_stack_used) + Config.stack_safety_margin in
1045
1045
if used_safe > Config.stack_threshold then
1046
-
Kconst(Const_base(Const_int used_safe)) ::
1046
+
Kconst(Const_int used_safe) ::
1047
1047
Kccall("caml_ensure_stack_capacity", 1) ::
1048
1048
code
1049
1049
else
+6
-7
bytecomp/emitcode.ml
+6
-7
bytecomp/emitcode.ml
···
17
17
18
18
open Config
19
19
open Misc
20
-
open Asttypes
21
20
open Lambda
22
21
open Instruct
23
22
open Opcodes
···
83
82
exception AsInt
84
83
85
84
let const_as_int = function
86
-
| Const_base(Const_int i) -> i
87
-
| Const_base(Const_char c) -> Char.code c
85
+
| Const_int i -> i
86
+
| Const_char c -> Char.code c
88
87
| _ -> raise AsInt
89
88
90
89
let is_immed i = immed_min <= i && i <= immed_max
···
260
259
| Ksetglobal q -> out opSETGLOBAL; slot_for_setglobal q
261
260
| Kconst sc ->
262
261
begin match sc with
263
-
Const_base(Const_int i) when is_immed i ->
262
+
Const_int i when is_immed i ->
264
263
if i >= 0 && i <= 3
265
264
then out (opCONST0 + i)
266
265
else (out opCONSTINT; out_int i)
267
-
| Const_base(Const_char c) ->
266
+
| Const_char c ->
268
267
out opCONSTINT; out_int (Char.code c)
269
268
| Const_block(t, []) ->
270
269
if t = 0 then out opATOM0 else (out opATOM; out_int t)
···
392
391
out opPUSHGETGLOBAL; slot_for_getglobal id; emit c
393
392
| Kpush :: Kconst sc :: c ->
394
393
begin match sc with
395
-
Const_base(Const_int i) when is_immed i ->
394
+
Const_int i when is_immed i ->
396
395
if i >= 0 && i <= 3
397
396
then out (opPUSHCONST0 + i)
398
397
else (out opPUSHCONSTINT; out_int i)
399
-
| Const_base(Const_char c) ->
398
+
| Const_char c ->
400
399
out opPUSHCONSTINT; out_int(Char.code c)
401
400
| Const_block(t, []) ->
402
401
if t = 0 then out opPUSHATOM0 else (out opPUSHATOM; out_int t)
+8
-9
bytecomp/symtable.ml
+8
-9
bytecomp/symtable.ml
···
205
205
(* Translate structured constants *)
206
206
207
207
let rec transl_const = function
208
-
Const_base(Const_int i) -> Obj.repr i
209
-
| Const_base(Const_char c) -> Obj.repr c
210
-
| Const_base(Const_string (s, _, _)) -> Obj.repr s
211
-
| Const_base(Const_float f) -> Obj.repr (float_of_string f)
212
-
| Const_base(Const_int32 i) -> Obj.repr i
213
-
| Const_base(Const_int64 i) -> Obj.repr i
214
-
| Const_base(Const_nativeint i) -> Obj.repr i
208
+
Const_int i -> Obj.repr i
209
+
| Const_char c -> Obj.repr c
210
+
| Const_float f -> Obj.repr (float_of_string f)
211
+
| Const_int32 i -> Obj.repr i
212
+
| Const_int64 i -> Obj.repr i
213
+
| Const_nativeint i -> Obj.repr i
215
214
| Const_immstring s -> Obj.repr s
216
215
| Const_block(tag, fields) ->
217
216
let block = Obj.new_block tag (List.length fields) in
···
238
237
let c = slot_for_setglobal global in
239
238
let cst = Const_block
240
239
(Obj.object_tag,
241
-
[Const_base(Const_string (name, Location.none,None));
242
-
Const_base(Const_int (-i-1))
240
+
[Const_immstring name;
241
+
Const_int (-i-1)
243
242
])
244
243
in
245
244
literal_table := (c, transl_const cst) :: !literal_table)
+17
-4
lambda/lambda.ml
+17
-4
lambda/lambda.ml
···
215
215
216
216
217
217
type structured_constant =
218
-
Const_base of constant
218
+
Const_int of int
219
+
| Const_char of char
220
+
| Const_float of string
221
+
| Const_int32 of int32
222
+
| Const_int64 of int64
223
+
| Const_nativeint of nativeint
219
224
| Const_block of int * structured_constant list
220
225
| Const_float_array of string list
221
226
| Const_immstring of string
···
369
374
required_globals : Ident.Set.t;
370
375
code : lambda }
371
376
372
-
let const_int n = Const_base (Const_int n)
377
+
let const_int n = Const_int n
373
378
374
379
let const_unit = const_int 0
375
380
376
381
let dummy_constant = Lconst (const_int (0xBBBB / 2))
382
+
383
+
let lambda_of_const (c : Asttypes.constant) =
384
+
match c with
385
+
| Const_int n -> Lconst (Const_int n)
386
+
| Const_char c -> Lconst (Const_char c)
387
+
| Const_float f -> Lconst (Const_float f)
388
+
| Const_int32 n -> Lconst (Const_int32 n)
389
+
| Const_int64 n -> Lconst (Const_int64 n)
390
+
| Const_nativeint n -> Lconst (Const_nativeint n)
391
+
| Const_string (s, _, _) -> Lconst (Const_immstring s)
377
392
378
393
let max_arity () =
379
394
if !Clflags.native_code then 126 else max_int
···
434
449
try Ident.find_same id env
435
450
with Not_found -> e
436
451
end
437
-
| Lconst (Const_base (Const_string (s, _, _))) ->
438
-
Lconst (Const_base (Const_string (s, Location.none, None)))
439
452
| Lconst _ -> e
440
453
| Lapply ap ->
441
454
Lapply {ap with ap_func = tr_rec env ap.ap_func;
+8
-1
lambda/lambda.mli
+8
-1
lambda/lambda.mli
···
214
214
val equal_boxed_integer : boxed_integer -> boxed_integer -> bool
215
215
216
216
type structured_constant =
217
-
Const_base of constant
217
+
Const_int of int
218
+
| Const_char of char
219
+
| Const_float of string
220
+
| Const_int32 of int32
221
+
| Const_int64 of int64
222
+
| Const_nativeint of nativeint
218
223
| Const_block of int * structured_constant list
219
224
| Const_float_array of string list
220
225
| Const_immstring of string
···
385
390
val const_unit: structured_constant
386
391
val const_int : int -> structured_constant
387
392
val lambda_unit: lambda
393
+
394
+
val lambda_of_const : Asttypes.constant -> lambda
388
395
389
396
(** [dummy_constant] produces a plecholder value with a recognizable
390
397
bit pattern (currently 0xBBBB in its tagged form) *)
+15
-15
lambda/matching.ml
+15
-15
lambda/matching.ml
···
2179
2179
let varg = Lvar idarg in
2180
2180
let tag = Ident.create_local "tag" in
2181
2181
let test_tag t =
2182
-
Lprim(Pintcomp Ceq, [Lvar tag; Lconst(Const_base(Const_int t))], loc)
2182
+
Lprim(Pintcomp Ceq, [Lvar tag; Lconst(Const_int t)], loc)
2183
2183
in
2184
2184
2185
2185
Llet
···
2244
2244
{ ap_tailcall = Default_tailcall;
2245
2245
ap_loc = loc;
2246
2246
ap_func = Lazy.force code_force_lazy;
2247
-
ap_args = [ Lconst (Const_base (Const_int 0)); arg ];
2247
+
ap_args = [ Lconst (Const_int 0); arg ];
2248
2248
ap_inlined = Never_inline;
2249
2249
ap_specialised = Default_specialise
2250
2250
}
···
2393
2393
let arg =
2394
2394
Lprim
2395
2395
(Parrayrefu kind,
2396
-
[ arg; Lconst (Const_base (Const_int pos)) ], loc)
2396
+
[ arg; Lconst (Const_int pos) ], loc)
2397
2397
in
2398
2398
{
2399
2399
arg;
···
2476
2476
let xs, y0, ys = split (k - 2) xs in
2477
2477
(x0 :: xs, y0, ys)
2478
2478
2479
-
let zero_lam = Lconst (Const_base (Const_int 0))
2479
+
let zero_lam = Lconst (Const_int 0)
2480
2480
2481
2481
let tree_way_test loc arg lt eq gt =
2482
2482
Lifthenelse
···
2575
2575
| [] -> fail
2576
2576
| (c, act) :: rem ->
2577
2577
Lifthenelse
2578
-
( Lprim (tst, [ arg; Lconst (Const_base c) ], loc),
2578
+
( Lprim (tst, [ arg; lambda_of_const c ], loc),
2579
2579
do_tests_fail loc fail tst arg rem,
2580
2580
act )
2581
2581
···
2584
2584
| [ (_, act) ] -> act
2585
2585
| (c, act) :: rem ->
2586
2586
Lifthenelse
2587
-
( Lprim (tst, [ arg; Lconst (Const_base c) ], loc),
2587
+
( Lprim (tst, [ arg; lambda_of_const c ], loc),
2588
2588
do_tests_nofail loc tst arg rem,
2589
2589
act )
2590
2590
···
2605
2605
rev_split_at (List.length const_lambda_list / 2) const_lambda_list
2606
2606
in
2607
2607
Lifthenelse
2608
-
( Lprim (lt_tst, [ arg; Lconst (Const_base (fst (List.hd list2))) ], loc),
2608
+
( Lprim (lt_tst, [ arg; lambda_of_const (fst (List.hd list2)) ], loc),
2609
2609
make_test_sequence list1,
2610
2610
make_test_sequence list2 )
2611
2611
in
···
2648
2648
in
2649
2649
bind Alias newvar arg (body newarg)
2650
2650
2651
-
let make_const i = Lconst (Const_base (Const_int i))
2651
+
let make_const i = Lconst (Const_int i)
2652
2652
2653
2653
let make_isout h arg = Lprim (Pisout, [ h; arg ], Loc_unknown)
2654
2654
···
2657
2657
let make_is_nonzero arg =
2658
2658
if !Clflags.native_code then
2659
2659
Lprim (Pintcomp Cne,
2660
-
[arg; Lconst (Const_base (Const_int 0))],
2660
+
[arg; Lconst (Const_int 0)],
2661
2661
Loc_unknown)
2662
2662
else
2663
2663
arg
···
3105
3105
(const_lambda_list, total, _pats) =
3106
3106
let fail, local_jumps = mk_failaction_neg partial ctx def in
3107
3107
let lambda1 =
3108
-
match cst with
3108
+
match (cst : Asttypes.constant) with
3109
3109
| Const_int _ ->
3110
3110
let int_lambda_list =
3111
3111
List.map
3112
3112
(function
3113
-
| Const_int n, l -> (n, l)
3113
+
| Asttypes.Const_int n, l -> (n, l)
3114
3114
| _ -> assert false)
3115
3115
const_lambda_list
3116
3116
in
···
3119
3119
let int_lambda_list =
3120
3120
List.map
3121
3121
(function
3122
-
| Const_char c, l -> (Char.code c, l)
3122
+
| Asttypes.Const_char c, l -> (Char.code c, l)
3123
3123
| _ -> assert false)
3124
3124
const_lambda_list
3125
3125
in
···
4010
4010
Lconst
4011
4011
(Const_block
4012
4012
( 0,
4013
-
[ Const_base (Const_string (fname, loc, None));
4014
-
Const_base (Const_int line);
4015
-
Const_base (Const_int char)
4013
+
[ Const_immstring fname;
4014
+
Const_int line;
4015
+
Const_int char
4016
4016
] ))
4017
4017
],
4018
4018
sloc )
+7
-8
lambda/printlambda.ml
+7
-8
lambda/printlambda.ml
···
21
21
22
22
23
23
let rec struct_const ppf = function
24
-
| Const_base(Const_int n) -> fprintf ppf "%i" n
25
-
| Const_base(Const_char c) -> fprintf ppf "%C" c
26
-
| Const_base(Const_string (s, _, _)) -> fprintf ppf "%S" s
27
-
| Const_immstring s -> fprintf ppf "#%S" s
28
-
| Const_base(Const_float f) -> fprintf ppf "%s" f
29
-
| Const_base(Const_int32 n) -> fprintf ppf "%lil" n
30
-
| Const_base(Const_int64 n) -> fprintf ppf "%LiL" n
31
-
| Const_base(Const_nativeint n) -> fprintf ppf "%nin" n
24
+
| Const_int n -> fprintf ppf "%i" n
25
+
| Const_char c -> fprintf ppf "%C" c
26
+
| Const_immstring s -> fprintf ppf "%S" s
27
+
| Const_float f -> fprintf ppf "%s" f
28
+
| Const_int32 n -> fprintf ppf "%lil" n
29
+
| Const_int64 n -> fprintf ppf "%LiL" n
30
+
| Const_nativeint n -> fprintf ppf "%nin" n
32
31
| Const_block(tag, []) ->
33
32
fprintf ppf "[%i]" tag
34
33
| Const_block(tag, sc1::scl) ->
+2
-2
lambda/simplif.ml
+2
-2
lambda/simplif.ml
···
248
248
match p, ll with
249
249
(* Simplify Obj.with_tag *)
250
250
| Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
251
-
[Lconst (Const_base (Const_int tag));
251
+
[Lconst (Const_int tag);
252
252
Lprim (Pmakeblock (_, mut, shape), fields, loc)] ->
253
253
Lprim (Pmakeblock(tag, mut, shape), fields, loc)
254
254
| Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
255
-
[Lconst (Const_base (Const_int tag));
255
+
[Lconst (Const_int tag);
256
256
Lconst (Const_block (_, fields))] ->
257
257
Lconst (Const_block (tag, fields))
258
258
+1
-1
lambda/tmc.ml
+1
-1
lambda/tmc.ml
···
131
131
let k_with_placeholder =
132
132
apply { constr with flag = Mutable } tmc_placeholder in
133
133
let placeholder_pos = List.length constr.before in
134
-
let placeholder_pos_lam = Lconst (Const_base (Const_int placeholder_pos)) in
134
+
let placeholder_pos_lam = Lconst (Const_int placeholder_pos) in
135
135
let block_var = Ident.create_local "block" in
136
136
Llet (Strict, Pgenval, block_var, k_with_placeholder,
137
137
body {
+8
-8
lambda/translcore.ml
+8
-8
lambda/translcore.ml
···
69
69
match ext.ext_kind with
70
70
Text_decl _ ->
71
71
Lprim (Pmakeblock (Obj.object_tag, Immutable, None),
72
-
[Lconst (Const_base (Const_string (name, ext.ext_loc, None)));
72
+
[Lconst (Const_immstring name);
73
73
Lprim (prim_fresh_oo_id, [Lconst (const_int 0)], loc)],
74
74
loc)
75
75
| Text_rebind(path, _lid) ->
···
84
84
| _ -> raise Not_constant
85
85
86
86
let extract_float = function
87
-
Const_base(Const_float f) -> f
87
+
Const_float f -> f
88
88
| _ -> fatal_error "Translcore.extract_float"
89
89
90
90
(* Insertion of debugging events *)
···
122
122
(Lprim(Pmakeblock(0, Immutable, None),
123
123
[slot;
124
124
Lconst(Const_block(0,
125
-
[Const_base(Const_string (fname, exp.exp_loc, None));
126
-
Const_base(Const_int line);
127
-
Const_base(Const_int char)]))], loc))], loc)
125
+
[Const_immstring fname;
126
+
Const_int line;
127
+
Const_int char]))], loc))], loc)
128
128
129
129
(* In cases where we're careful to preserve syntactic arity, we disable
130
130
the arity fusion attempted by simplif.ml *)
···
209
209
transl_ident (of_location ~scopes e.exp_loc)
210
210
e.exp_env e.exp_type path desc
211
211
| Texp_constant cst ->
212
-
Lconst(Const_base cst)
212
+
Lambda.lambda_of_const cst
213
213
| Texp_let(rec_flag, pat_expr_list, body) ->
214
214
transl_let ~scopes rec_flag pat_expr_list
215
215
(event_before ~scopes body (transl_exp ~scopes body))
···
1082
1082
"Translcore.transl_atomic_loc: atomic field in unboxed record"
1083
1083
| Record_extension _ -> 1
1084
1084
in
1085
-
let lbl = Lconst (Const_base (Const_int (lbl.lbl_pos + offset))) in
1085
+
let lbl = Lconst (Const_int (lbl.lbl_pos + offset)) in
1086
1086
(arg, lbl)
1087
1087
1088
1088
and transl_match ~scopes e arg pat_expr_list partial =
···
1245
1245
(lfunction ~kind:Curried ~params:[param, Pgenval] ~return:Pgenval
1246
1246
~attr:default_function_attribute ~loc:Loc_unknown
1247
1247
~body,
1248
-
Lconst(Const_base(Const_int 0)))
1248
+
Lconst(Const_int 0))
1249
1249
in
1250
1250
let alloc_stack =
1251
1251
Lprim(prim_alloc_stack, [val_fun; exn_fun; eff_fun], Loc_unknown)
+3
-5
lambda/translmod.ml
+3
-5
lambda/translmod.ml
···
228
228
let undefined_location loc =
229
229
let (fname, line, char) = Location.get_pos_info loc.Location.loc_start in
230
230
Lconst(Const_block(0,
231
-
[Const_base(Const_string (fname, loc, None));
231
+
[Const_immstring fname;
232
232
const_int line;
233
233
const_int char]))
234
234
···
1418
1418
ap_func=Lprim(Pfield (toploop_getvalue_pos, Pointer, Mutable),
1419
1419
[Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
1420
1420
Loc_unknown);
1421
-
ap_args=[Lconst(Const_base(
1422
-
Const_string (toplevel_name id, Location.none, None)))];
1421
+
ap_args=[Lconst(Const_immstring (toplevel_name id))];
1423
1422
ap_tailcall=Default_tailcall;
1424
1423
ap_inlined=Default_inline;
1425
1424
ap_specialised=Default_specialise;
···
1432
1431
[Lprim(Pgetglobal toploop_ident, [], Loc_unknown)],
1433
1432
Loc_unknown);
1434
1433
ap_args=
1435
-
[Lconst(Const_base(
1436
-
Const_string(toplevel_name id, Location.none, None)));
1434
+
[Lconst(Const_immstring (toplevel_name id));
1437
1435
lam];
1438
1436
ap_tailcall=Default_tailcall;
1439
1437
ap_inlined=Default_inline;
+3
-3
lambda/translobj.ml
+3
-3
lambda/translobj.ml
···
43
43
let method_count = ref 0
44
44
let method_table = ref []
45
45
46
-
let meth_tag s = Lconst(Const_base(Const_int(Btype.hash_variant s)))
46
+
let meth_tag s = Lconst(Const_int(Btype.hash_variant s))
47
47
48
48
let next_cache tag =
49
49
let n = !method_count in
50
50
incr method_count;
51
-
(tag, [!method_cache; Lconst(Const_base(Const_int n))])
51
+
(tag, [!method_cache; Lconst(Const_int n)])
52
52
53
53
let rec is_path = function
54
54
Lvar _ | Lprim (Pgetglobal _, [], _) | Lconst _ -> true
···
81
81
82
82
(* Insert labels *)
83
83
84
-
let int n = Lconst (Const_base (Const_int n))
84
+
let int n = Lconst (Const_int n)
85
85
86
86
let prim_makearray =
87
87
Primitive.simple ~name:"caml_array_make" ~arity:2 ~alloc:true
+4
-4
lambda/translprim.ml
+4
-4
lambda/translprim.ml
···
658
658
| Loc_POS ->
659
659
Lconst (Const_block (0, [
660
660
Const_immstring file;
661
-
Const_base (Const_int lnum);
662
-
Const_base (Const_int cnum);
663
-
Const_base (Const_int enum);
661
+
Const_int lnum;
662
+
Const_int cnum;
663
+
Const_int enum;
664
664
]))
665
665
| Loc_FILE -> Lconst (Const_immstring file)
666
666
| Loc_MODULE ->
···
672
672
let loc = Printf.sprintf "File %S, line %d, characters %d-%d"
673
673
file lnum cnum enum in
674
674
Lconst (Const_immstring loc)
675
-
| Loc_LINE -> Lconst (Const_base (Const_int lnum))
675
+
| Loc_LINE -> Lconst (Const_int lnum)
676
676
| Loc_FUNCTION ->
677
677
let scope_name = Debuginfo.Scoped_location.string_of_scoped_location sloc in
678
678
Lconst (Const_immstring scope_name)
+1
-1
lambda/value_rec_compiler.ml
+1
-1
lambda/value_rec_compiler.ml
+6
-8
middle_end/closure/closure.ml
+6
-8
middle_end/closure/closure.ml
···
905
905
Uconst_ref (name, Some cst)
906
906
in
907
907
let rec transl = function
908
-
| Const_base(Const_int n) -> Uconst_int n
909
-
| Const_base(Const_char c) -> Uconst_int (Char.code c)
908
+
| Const_int n -> Uconst_int n
909
+
| Const_char c -> Uconst_int (Char.code c)
910
910
| Const_block (tag, fields) ->
911
911
str (Uconst_block (tag, List.map transl fields))
912
912
| Const_float_array sl ->
···
914
914
str (Uconst_float_array (List.map float_of_string sl))
915
915
| Const_immstring s ->
916
916
str (Uconst_string s)
917
-
| Const_base (Const_string (s, _, _)) ->
918
-
str (Uconst_string s)
919
-
| Const_base(Const_float x) -> str (Uconst_float (float_of_string x))
920
-
| Const_base(Const_int32 x) -> str (Uconst_int32 x)
921
-
| Const_base(Const_int64 x) -> str (Uconst_int64 x)
922
-
| Const_base(Const_nativeint x) -> str (Uconst_nativeint x)
917
+
| Const_float x -> str (Uconst_float (float_of_string x))
918
+
| Const_int32 x -> str (Uconst_int32 x)
919
+
| Const_int64 x -> str (Uconst_int64 x)
920
+
| Const_nativeint x -> str (Uconst_nativeint x)
923
921
in
924
922
make_const (transl cst)
925
923
| Lfunction funct ->
+7
-13
middle_end/flambda/closure_conversion.ml
+7
-13
middle_end/flambda/closure_conversion.ml
···
109
109
let rec declare_const t (const : Lambda.structured_constant)
110
110
: Flambda.constant_defining_value_block_field * Internal_variable_names.t =
111
111
match const with
112
-
| Const_base (Const_int c) -> (Const (Int c), Names.const_int)
113
-
| Const_base (Const_char c) -> (Const (Char c), Names.const_char)
114
-
| Const_base (Const_string (s, _, _)) ->
115
-
let const, name =
116
-
(Flambda.Allocated_const (Immutable_string s),
117
-
Names.const_immstring)
118
-
in
119
-
register_const t const name
120
-
| Const_base (Const_float c) ->
112
+
| Const_int c -> (Const (Int c), Names.const_int)
113
+
| Const_char c -> (Const (Char c), Names.const_char)
114
+
| Const_float c ->
121
115
register_const t
122
116
(Allocated_const (Float (float_of_string c)))
123
117
Names.const_float
124
-
| Const_base (Const_int32 c) ->
118
+
| Const_int32 c ->
125
119
register_const t (Allocated_const (Int32 c))
126
120
Names.const_int32
127
-
| Const_base (Const_int64 c) ->
121
+
| Const_int64 c ->
128
122
register_const t (Allocated_const (Int64 c))
129
123
Names.const_int64
130
-
| Const_base (Const_nativeint c) ->
124
+
| Const_nativeint c ->
131
125
register_const t (Allocated_const (Nativeint c)) Names.const_nativeint
132
126
| Const_immstring c ->
133
127
register_const t (Allocated_const (Immutable_string c))
···
158
152
Lambda.const_int 0
159
153
160
154
let lambda_const_int i : Lambda.structured_constant =
161
-
Const_base (Const_int i)
155
+
Lambda.const_int i
162
156
163
157
let rec close t env (lam : Lambda.lambda) : Flambda.t =
164
158
match lam with