Skip to content

Commit e556137

Browse files
DZakhDZakh
committed
Support field aliases for obj ppx
1 parent a8c7f15 commit e556137

File tree

3 files changed

+55
-19
lines changed

3 files changed

+55
-19
lines changed

‎jscomp/frontend/ast_external_process.ml

Lines changed: 34 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -349,6 +349,13 @@ type response = {
349349
no_inline_cross_module: bool;
350350
}
351351

352+
let get_maybe_obj_field_alias (attributes) =
353+
attributes |> List.find_map (fun (attr: Parsetree.attribute) -> match attr with
354+
| ({txt = "as"; _}, PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (alias, _)); _}, _); _ } ]) -> Some(alias)
355+
| _ -> None
356+
)
357+
358+
352359
let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
353360
(arg_types_ty : Ast_core_type.param_type list)
354361
(result_type : Ast_core_type.t) : Parsetree.core_type * External_ffi_types.t
@@ -398,7 +405,11 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
398405
| _ ->
399406
Location.raise_errorf ~loc
400407
"expect label, optional, or unit here")
401-
| Labelled name -> (
408+
| Labelled label -> (
409+
let fieldName = match get_maybe_obj_field_alias param_type.attr with
410+
| Some(alias) -> alias
411+
| None -> label
412+
in
402413
let obj_arg_type = refine_obj_arg_type ~nolabel:false ty in
403414
match obj_arg_type with
404415
| Ignore ->
@@ -407,39 +418,39 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
407418
result_types )
408419
| Arg_cst _ ->
409420
( {
410-
obj_arg_label = External_arg_spec.obj_label name;
421+
obj_arg_label = External_arg_spec.obj_label fieldName;
411422
obj_arg_type;
412423
},
413424
arg_types,
414425
(* ignored in [arg_types], reserved in [result_types] *)
415426
result_types )
416427
| Nothing ->
417428
( {
418-
obj_arg_label = External_arg_spec.obj_label name;
429+
obj_arg_label = External_arg_spec.obj_label fieldName;
419430
obj_arg_type;
420431
},
421432
param_type :: arg_types,
422-
Parsetree.Otag ({Asttypes.txt = name; loc}, [], ty)
433+
Parsetree.Otag ({Asttypes.txt = fieldName; loc}, [], ty)
423434
:: result_types )
424435
| Int _ ->
425436
( {
426-
obj_arg_label = External_arg_spec.obj_label name;
437+
obj_arg_label = External_arg_spec.obj_label fieldName;
427438
obj_arg_type;
428439
},
429440
param_type :: arg_types,
430441
Otag
431-
( {Asttypes.txt = name; loc},
442+
( {Asttypes.txt = fieldName; loc},
432443
[],
433444
Ast_literal.type_int ~loc () )
434445
:: result_types )
435446
| Poly_var_string _ ->
436447
( {
437-
obj_arg_label = External_arg_spec.obj_label name;
448+
obj_arg_label = External_arg_spec.obj_label fieldName;
438449
obj_arg_type;
439450
},
440451
param_type :: arg_types,
441452
Otag
442-
( {Asttypes.txt = name; loc},
453+
( {Asttypes.txt = fieldName; loc},
443454
[],
444455
Ast_literal.type_string ~loc () )
445456
:: result_types )
@@ -449,11 +460,15 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
449460
| Extern_unit -> assert false
450461
| Poly_var _ ->
451462
Location.raise_errorf ~loc
452-
"%@obj label %s does not support such arg type" name
463+
"%@obj label %s does not support such arg type" label
453464
| Unwrap ->
454465
Location.raise_errorf ~loc
455-
"%@obj label %s does not support %@unwrap arguments" name)
456-
| Optional name -> (
466+
"%@obj label %s does not support %@unwrap arguments" label)
467+
| Optional label -> (
468+
let fieldName = match get_maybe_obj_field_alias param_type.attr with
469+
| Some(alias) -> alias
470+
| None -> label
471+
in
457472
let obj_arg_type = get_opt_arg_type ~nolabel:false ty in
458473
match obj_arg_type with
459474
| Ignore ->
@@ -469,35 +484,35 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
469484
in
470485
( {
471486
obj_arg_label =
472-
External_arg_spec.optional for_sure_not_nested name;
487+
External_arg_spec.optional for_sure_not_nested fieldName;
473488
obj_arg_type;
474489
},
475490
param_type :: arg_types,
476491
Parsetree.Otag
477-
( {Asttypes.txt = name; loc},
492+
( {Asttypes.txt = fieldName; loc},
478493
[],
479494
Ast_comb.to_undefined_type loc ty )
480495
:: result_types )
481496
| Int _ ->
482497
( {
483-
obj_arg_label = External_arg_spec.optional true name;
498+
obj_arg_label = External_arg_spec.optional true fieldName;
484499
obj_arg_type;
485500
},
486501
param_type :: arg_types,
487502
Otag
488-
( {Asttypes.txt = name; loc},
503+
( {Asttypes.txt = fieldName; loc},
489504
[],
490505
Ast_comb.to_undefined_type loc
491506
@@ Ast_literal.type_int ~loc () )
492507
:: result_types )
493508
| Poly_var_string _ ->
494509
( {
495-
obj_arg_label = External_arg_spec.optional true name;
510+
obj_arg_label = External_arg_spec.optional true fieldName;
496511
obj_arg_type;
497512
},
498513
param_type :: arg_types,
499514
Otag
500-
( {Asttypes.txt = name; loc},
515+
( {Asttypes.txt = fieldName; loc},
501516
[],
502517
Ast_comb.to_undefined_type loc
503518
@@ Ast_literal.type_string ~loc () )
@@ -511,10 +526,10 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string)
511526
| Extern_unit -> assert false
512527
| Poly_var _ ->
513528
Location.raise_errorf ~loc
514-
"%@obj label %s does not support such arg type" name
529+
"%@obj label %s does not support such arg type" label
515530
| Unwrap ->
516531
Location.raise_errorf ~loc
517-
"%@obj label %s does not support %@unwrap arguments" name)
532+
"%@obj label %s does not support %@unwrap arguments" label)
518533
in
519534
(new_arg_label :: arg_labels, new_arg_types, output_tys))
520535
in

‎jscomp/test/external_ppx.js

Lines changed: 12 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎jscomp/test/external_ppx.res

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,15 @@ external make_config: (~length: 'a, ~width: int) => unit = ""
99

1010
@obj external opt_make: (~length: int, ~width: int=?) => (_ as 'event) = ""
1111

12+
@obj
13+
external renamed_make: (
14+
@as("type") ~_type: string,
15+
@as("WIDTH") ~width: int=?,
16+
~normal: float,
17+
) => (_ as 'event) = ""
18+
19+
let renamed = renamed_make(~_type="123", ~normal=12.)
20+
1221
@obj
1322
external ff: (
1423
~hi: int,

0 commit comments

Comments
 (0)