@@ -15559,9 +15559,7 @@ val iter_process_bs_string_int_unwrap_uncurry :
15559
15559
val iter_process_bs_string_as :
15560
15560
t -> string option
15561
15561
15562
- val iter_process_bs_string_as_ast :
15563
- t ->
15564
- Parsetree.expression option
15562
+
15565
15563
15566
15564
val has_bs_optional :
15567
15565
t -> bool
@@ -15780,31 +15778,6 @@ let process_derive_type (attrs : t) : derive_attr * t =
15780
15778
st, attr::acc
15781
15779
)
15782
15780
15783
- (* let iter_process_derive_type (attrs : t) =
15784
- let st = ref {explict_nonrec = false; bs_deriving = None } in
15785
- Ext_list.iter attrs
15786
- (fun ({txt ; loc}, payload as attr) ->
15787
- match txt with
15788
- | "bs.deriving"
15789
- ->
15790
- let ost = !st in
15791
- (match ost with
15792
- | {bs_deriving = None } ->
15793
- Bs_ast_invariant.mark_used_bs_attribute attr ;
15794
- st :=
15795
- {ost with
15796
- bs_deriving = Some
15797
- (Ast_payload.ident_or_record_as_config loc payload)}
15798
- | {bs_deriving = Some _} ->
15799
- Bs_syntaxerr.err loc Duplicated_bs_deriving)
15800
-
15801
- | "nonrec" ->
15802
- st :=
15803
- { !st with explict_nonrec = true }
15804
- (* non bs attribute, no need to mark its use *)
15805
- | _ -> ()
15806
- ) ;
15807
- !st *)
15808
15781
15809
15782
15810
15783
(* duplicated [bs.uncurry] [bs.string] not allowed,
@@ -15859,26 +15832,6 @@ let iter_process_bs_string_as (attrs : t) : string option =
15859
15832
) ;
15860
15833
!st
15861
15834
15862
- let iter_process_bs_string_as_ast (attrs : t) : Parsetree.expression option =
15863
- let st = ref None in
15864
- Ext_list.iter attrs
15865
- (fun
15866
- (({txt ; loc}, payload ) as attr ) ->
15867
- match txt with
15868
- | "bs.as"
15869
- ->
15870
- if !st = None then
15871
- match Ast_payload.is_single_string_as_ast payload with
15872
- | None ->
15873
- Bs_syntaxerr.err loc Expect_string_literal
15874
- | Some _ as v ->
15875
- Bs_ast_invariant.mark_used_bs_attribute attr ;
15876
- st:= v
15877
- else
15878
- Bs_syntaxerr.err loc Duplicated_bs_as
15879
- | _ -> ()
15880
- ) ;
15881
- !st
15882
15835
15883
15836
let has_bs_optional (attrs : t) : bool =
15884
15837
Ext_list.exists attrs (fun
@@ -17255,12 +17208,14 @@ type label = private
17255
17208
17256
17209
17257
17210
type attr =
17258
- | Poly_var of {
17259
- has_payload : bool ;
17260
- descr :
17261
- (Ast_compatible.hash_label * string)
17262
- list option
17263
- }
17211
+ | Poly_var_string of {
17212
+ descr :
17213
+ (Ast_compatible.hash_label * string) list
17214
+ }
17215
+ | Poly_var of {
17216
+ descr :
17217
+ (Ast_compatible.hash_label * string) list option
17218
+ }
17264
17219
| Int of (Ast_compatible.hash_label * int ) list (* ([`a | `b ] [@bs.int])*)
17265
17220
| Arg_cst of cst
17266
17221
| Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)
@@ -17350,14 +17305,22 @@ type label =
17350
17305
(* it will be ignored , side effect will be recorded *)
17351
17306
17352
17307
17353
-
17308
+ (* This type is used to give some meta info on each argument *)
17354
17309
type attr =
17355
- | Poly_var of {
17356
- has_payload : bool ;
17310
+ | Poly_var_string of {
17357
17311
descr :
17358
17312
(Ast_compatible.hash_label * string) list
17359
- option
17360
- }
17313
+ (* introduced by attributes bs.string
17314
+ and bs.as
17315
+ *)
17316
+ }
17317
+ | Poly_var of {
17318
+ descr :
17319
+ (Ast_compatible.hash_label * string) list option
17320
+ (* introduced by attributes bs.string
17321
+ and bs.as
17322
+ *)
17323
+ }
17361
17324
(* `a does not have any value*)
17362
17325
| Int of (Ast_compatible.hash_label * int ) list (* ([`a | `b ] [@bs.int])*)
17363
17326
| Arg_cst of cst
@@ -17596,12 +17559,15 @@ let map_row_fields_into_strings ptyp_loc
17596
17559
| `NonNull ->
17597
17560
let has_payload = case = `NonNull in
17598
17561
let descr = if !has_bs_as then Some result else None in
17599
- if not has_payload && descr = None then begin
17600
- Location.prerr_warning ptyp_loc (Bs_ffi_warning "bs.string is redundant here, you can safely remove it")
17601
- end;
17602
- External_arg_spec.Poly_var
17603
- {has_payload ;
17604
- descr }
17562
+ match has_payload, descr with
17563
+ | false, None ->
17564
+ Location.prerr_warning ptyp_loc (Bs_ffi_warning "bs.string is redundant here, you can safely remove it");
17565
+ Nothing
17566
+ | false , Some descr ->
17567
+ External_arg_spec.Poly_var_string {descr }
17568
+ | true, _ ->
17569
+ External_arg_spec.Poly_var
17570
+ { descr }
17605
17571
17606
17572
let is_enum row_fields =
17607
17573
List.for_all (fun (x : Parsetree.row_field) ->
@@ -19695,7 +19661,7 @@ let process_obj
19695
19661
{obj_arg_label = External_arg_spec.obj_label s; obj_arg_type},
19696
19662
{param_type with ty = new_ty}::arg_types,
19697
19663
(({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
19698
- | Poly_var { has_payload = false ; _} ->
19664
+ | Poly_var_string _ ->
19699
19665
let s = Lam_methname.translate name in
19700
19666
{obj_arg_label = External_arg_spec.obj_label s; obj_arg_type},
19701
19667
{param_type with ty = new_ty }::arg_types,
@@ -19704,7 +19670,7 @@ let process_obj
19704
19670
Location.raise_errorf ~loc
19705
19671
"The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
19706
19672
| Extern_unit -> assert false
19707
- | Poly_var { has_payload = true ; _}
19673
+ | Poly_var _
19708
19674
->
19709
19675
Location.raise_errorf ~loc
19710
19676
"bs.obj label %s does not support such arg type" name
@@ -19728,7 +19694,7 @@ let process_obj
19728
19694
{obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
19729
19695
param_type :: arg_types,
19730
19696
(({Asttypes.txt = name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc ()) :: result_types)
19731
- | Poly_var {has_payload = false ; _} ->
19697
+ | Poly_var_string _ ->
19732
19698
let s = Lam_methname.translate name in
19733
19699
{obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
19734
19700
param_type::arg_types,
@@ -19740,7 +19706,7 @@ let process_obj
19740
19706
Location.raise_errorf ~loc
19741
19707
"The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
19742
19708
| Extern_unit -> assert false
19743
- | Poly_var {has_payload = true; _}
19709
+ | Poly_var _
19744
19710
->
19745
19711
Location.raise_errorf ~loc
19746
19712
"bs.obj label %s does not support such arg type" name
@@ -20154,7 +20120,7 @@ let handle_attributes
20154
20120
| Optional s ->
20155
20121
let arg_type = get_opt_arg_type ~nolabel:false ty in
20156
20122
begin match arg_type with
20157
- | Poly_var {has_payload = true; _} ->
20123
+ | Poly_var _ ->
20158
20124
(* ?x:([`x of int ] [@bs.string]) does not make sense *)
20159
20125
Location.raise_errorf
20160
20126
~loc
0 commit comments