@@ -398,7 +398,14 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
398
398
| _ ->
399
399
Location. raise_errorf ~loc
400
400
" expect label, optional, or unit here" )
401
- | Labelled name -> (
401
+ | Labelled label -> (
402
+ let fieldName =
403
+ match
404
+ Ast_attributes. iter_process_bs_string_as param_type.attr
405
+ with
406
+ | Some alias -> alias
407
+ | None -> label
408
+ in
402
409
let obj_arg_type = refine_obj_arg_type ~nolabel: false ty in
403
410
match obj_arg_type with
404
411
| Ignore ->
@@ -407,39 +414,39 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
407
414
result_types )
408
415
| Arg_cst _ ->
409
416
( {
410
- obj_arg_label = External_arg_spec. obj_label name ;
417
+ obj_arg_label = External_arg_spec. obj_label fieldName ;
411
418
obj_arg_type;
412
419
},
413
420
arg_types,
414
421
(* ignored in [arg_types], reserved in [result_types] *)
415
422
result_types )
416
423
| Nothing ->
417
424
( {
418
- obj_arg_label = External_arg_spec. obj_label name ;
425
+ obj_arg_label = External_arg_spec. obj_label fieldName ;
419
426
obj_arg_type;
420
427
},
421
428
param_type :: arg_types,
422
- Parsetree. Otag ({Asttypes. txt = name ; loc}, [] , ty)
429
+ Parsetree. Otag ({Asttypes. txt = fieldName ; loc}, [] , ty)
423
430
:: result_types )
424
431
| Int _ ->
425
432
( {
426
- obj_arg_label = External_arg_spec. obj_label name ;
433
+ obj_arg_label = External_arg_spec. obj_label fieldName ;
427
434
obj_arg_type;
428
435
},
429
436
param_type :: arg_types,
430
437
Otag
431
- ( {Asttypes. txt = name ; loc},
438
+ ( {Asttypes. txt = fieldName ; loc},
432
439
[] ,
433
440
Ast_literal. type_int ~loc () )
434
441
:: result_types )
435
442
| Poly_var_string _ ->
436
443
( {
437
- obj_arg_label = External_arg_spec. obj_label name ;
444
+ obj_arg_label = External_arg_spec. obj_label fieldName ;
438
445
obj_arg_type;
439
446
},
440
447
param_type :: arg_types,
441
448
Otag
442
- ( {Asttypes. txt = name ; loc},
449
+ ( {Asttypes. txt = fieldName ; loc},
443
450
[] ,
444
451
Ast_literal. type_string ~loc () )
445
452
:: result_types )
@@ -449,11 +456,18 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
449
456
| Extern_unit -> assert false
450
457
| Poly_var _ ->
451
458
Location. raise_errorf ~loc
452
- " %@obj label %s does not support such arg type" name
459
+ " %@obj label %s does not support such arg type" label
453
460
| Unwrap ->
454
461
Location. raise_errorf ~loc
455
- " %@obj label %s does not support %@unwrap arguments" name)
456
- | Optional name -> (
462
+ " %@obj label %s does not support %@unwrap arguments" label)
463
+ | Optional label -> (
464
+ let fieldName =
465
+ match
466
+ Ast_attributes. iter_process_bs_string_as param_type.attr
467
+ with
468
+ | Some alias -> alias
469
+ | None -> label
470
+ in
457
471
let obj_arg_type = get_opt_arg_type ~nolabel: false ty in
458
472
match obj_arg_type with
459
473
| Ignore ->
@@ -469,35 +483,35 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
469
483
in
470
484
( {
471
485
obj_arg_label =
472
- External_arg_spec. optional for_sure_not_nested name ;
486
+ External_arg_spec. optional for_sure_not_nested fieldName ;
473
487
obj_arg_type;
474
488
},
475
489
param_type :: arg_types,
476
490
Parsetree. Otag
477
- ( {Asttypes. txt = name ; loc},
491
+ ( {Asttypes. txt = fieldName ; loc},
478
492
[] ,
479
493
Ast_comb. to_undefined_type loc ty )
480
494
:: result_types )
481
495
| Int _ ->
482
496
( {
483
- obj_arg_label = External_arg_spec. optional true name ;
497
+ obj_arg_label = External_arg_spec. optional true fieldName ;
484
498
obj_arg_type;
485
499
},
486
500
param_type :: arg_types,
487
501
Otag
488
- ( {Asttypes. txt = name ; loc},
502
+ ( {Asttypes. txt = fieldName ; loc},
489
503
[] ,
490
504
Ast_comb. to_undefined_type loc
491
505
@@ Ast_literal. type_int ~loc () )
492
506
:: result_types )
493
507
| Poly_var_string _ ->
494
508
( {
495
- obj_arg_label = External_arg_spec. optional true name ;
509
+ obj_arg_label = External_arg_spec. optional true fieldName ;
496
510
obj_arg_type;
497
511
},
498
512
param_type :: arg_types,
499
513
Otag
500
- ( {Asttypes. txt = name ; loc},
514
+ ( {Asttypes. txt = fieldName ; loc},
501
515
[] ,
502
516
Ast_comb. to_undefined_type loc
503
517
@@ Ast_literal. type_string ~loc () )
@@ -511,10 +525,10 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
511
525
| Extern_unit -> assert false
512
526
| Poly_var _ ->
513
527
Location. raise_errorf ~loc
514
- " %@obj label %s does not support such arg type" name
528
+ " %@obj label %s does not support such arg type" label
515
529
| Unwrap ->
516
530
Location. raise_errorf ~loc
517
- " %@obj label %s does not support %@unwrap arguments" name )
531
+ " %@obj label %s does not support %@unwrap arguments" label )
518
532
in
519
533
(new_arg_label :: arg_labels, new_arg_types, output_tys))
520
534
in
0 commit comments