Skip to content

Commit c1d5581

Browse files
committed
snapshot
1 parent 6d36a98 commit c1d5581

File tree

4 files changed

+246
-391
lines changed

4 files changed

+246
-391
lines changed

lib/4.06.1/unstable/js_compiler.ml

Lines changed: 70 additions & 107 deletions
Large diffs are not rendered by default.

lib/4.06.1/unstable/js_refmt_compiler.ml

Lines changed: 70 additions & 107 deletions
Large diffs are not rendered by default.

lib/4.06.1/unstable/native_ppx.ml

Lines changed: 36 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -15559,9 +15559,7 @@ val iter_process_bs_string_int_unwrap_uncurry :
1555915559
val iter_process_bs_string_as :
1556015560
t -> string option
1556115561

15562-
val iter_process_bs_string_as_ast :
15563-
t ->
15564-
Parsetree.expression option
15562+
1556515563

1556615564
val has_bs_optional :
1556715565
t -> bool
@@ -15780,31 +15778,6 @@ let process_derive_type (attrs : t) : derive_attr * t =
1578015778
st, attr::acc
1578115779
)
1578215780

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 *)
1580815781

1580915782

1581015783
(* duplicated [bs.uncurry] [bs.string] not allowed,
@@ -15859,26 +15832,6 @@ let iter_process_bs_string_as (attrs : t) : string option =
1585915832
) ;
1586015833
!st
1586115834

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
1588215835

1588315836
let has_bs_optional (attrs : t) : bool =
1588415837
Ext_list.exists attrs (fun
@@ -17255,12 +17208,14 @@ type label = private
1725517208

1725617209

1725717210
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+
}
1726417219
| Int of (Ast_compatible.hash_label * int ) list (* ([`a | `b ] [@bs.int])*)
1726517220
| Arg_cst of cst
1726617221
| Fn_uncurry_arity of int (* annotated with [@bs.uncurry ] or [@bs.uncurry 2]*)
@@ -17350,14 +17305,22 @@ type label =
1735017305
(* it will be ignored , side effect will be recorded *)
1735117306

1735217307

17353-
17308+
(* This type is used to give some meta info on each argument *)
1735417309
type attr =
17355-
| Poly_var of {
17356-
has_payload : bool ;
17310+
| Poly_var_string of {
1735717311
descr :
1735817312
(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+
}
1736117324
(* `a does not have any value*)
1736217325
| Int of (Ast_compatible.hash_label * int ) list (* ([`a | `b ] [@bs.int])*)
1736317326
| Arg_cst of cst
@@ -17596,12 +17559,15 @@ let map_row_fields_into_strings ptyp_loc
1759617559
| `NonNull ->
1759717560
let has_payload = case = `NonNull in
1759817561
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 }
1760517571

1760617572
let is_enum row_fields =
1760717573
List.for_all (fun (x : Parsetree.row_field) ->
@@ -19695,7 +19661,7 @@ let process_obj
1969519661
{obj_arg_label = External_arg_spec.obj_label s; obj_arg_type},
1969619662
{param_type with ty = new_ty}::arg_types,
1969719663
(({Asttypes.txt = name; loc}, [], Ast_literal.type_int ~loc ()) :: result_types)
19698-
| Poly_var { has_payload = false ; _} ->
19664+
| Poly_var_string _ ->
1969919665
let s = Lam_methname.translate name in
1970019666
{obj_arg_label = External_arg_spec.obj_label s; obj_arg_type},
1970119667
{param_type with ty = new_ty }::arg_types,
@@ -19704,7 +19670,7 @@ let process_obj
1970419670
Location.raise_errorf ~loc
1970519671
"The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
1970619672
| Extern_unit -> assert false
19707-
| Poly_var { has_payload = true ; _}
19673+
| Poly_var _
1970819674
->
1970919675
Location.raise_errorf ~loc
1971019676
"bs.obj label %s does not support such arg type" name
@@ -19728,7 +19694,7 @@ let process_obj
1972819694
{obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
1972919695
param_type :: arg_types,
1973019696
(({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 _ ->
1973219698
let s = Lam_methname.translate name in
1973319699
{obj_arg_label = External_arg_spec.optional s ; obj_arg_type },
1973419700
param_type::arg_types,
@@ -19740,7 +19706,7 @@ let process_obj
1974019706
Location.raise_errorf ~loc
1974119707
"The combination of [@@bs.obj], [@@bs.uncurry] is not supported yet"
1974219708
| Extern_unit -> assert false
19743-
| Poly_var {has_payload = true; _}
19709+
| Poly_var _
1974419710
->
1974519711
Location.raise_errorf ~loc
1974619712
"bs.obj label %s does not support such arg type" name
@@ -20154,7 +20120,7 @@ let handle_attributes
2015420120
| Optional s ->
2015520121
let arg_type = get_opt_arg_type ~nolabel:false ty in
2015620122
begin match arg_type with
20157-
| Poly_var {has_payload = true; _} ->
20123+
| Poly_var _ ->
2015820124
(* ?x:([`x of int ] [@bs.string]) does not make sense *)
2015920125
Location.raise_errorf
2016020126
~loc

lib/4.06.1/whole_compiler.ml

Lines changed: 70 additions & 107 deletions
Large diffs are not rendered by default.

0 commit comments

Comments
 (0)