Skip to content

Commit cceb5c5

Browse files
bobzhangbobzhang
committed
works with multiple record
1 parent a75e11f commit cceb5c5

20 files changed

+489
-263
lines changed

‎jscomp/bin/bsbuild.ml

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1838,6 +1838,8 @@ val rev_except_last : 'a list -> 'a list * 'a
18381838
val sort_via_array :
18391839
('a -> 'a -> int) -> 'a list -> 'a list
18401840

1841+
val last : 'a list -> 'a
1842+
18411843
end = struct
18421844
#1 "ext_list.ml"
18431845
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -2194,6 +2196,12 @@ let sort_via_array cmp lst =
21942196
Array.sort cmp arr;
21952197
Array.to_list arr
21962198

2199+
let rec last xs =
2200+
match xs with
2201+
| [x] -> x
2202+
| _ :: tl -> last tl
2203+
| [] -> invalid_arg "Ext_list.last"
2204+
21972205
end
21982206
module Json_lexer : sig
21992207
#1 "json_lexer.mli"

‎jscomp/bin/bsdep.ml

Lines changed: 48 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -5229,6 +5229,8 @@ val rev_except_last : 'a list -> 'a list * 'a
52295229
val sort_via_array :
52305230
('a -> 'a -> int) -> 'a list -> 'a list
52315231

5232+
val last : 'a list -> 'a
5233+
52325234
end = struct
52335235
#1 "ext_list.ml"
52345236
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -5585,6 +5587,12 @@ let sort_via_array cmp lst =
55855587
Array.sort cmp arr;
55865588
Array.to_list arr
55875589

5590+
let rec last xs =
5591+
match xs with
5592+
| [x] -> x
5593+
| _ :: tl -> last tl
5594+
| [] -> invalid_arg "Ext_list.last"
5595+
55885596
end
55895597
module Js_config : sig
55905598
#1 "js_config.mli"
@@ -26407,18 +26415,18 @@ module Ast_derive : sig
2640726415

2640826416

2640926417
type gen = {
26410-
structure_gen : Parsetree.type_declaration -> bool -> Ast_structure.t ;
26411-
signature_gen : Parsetree.type_declaration -> bool -> Ast_signature.t ;
26418+
structure_gen : Parsetree.type_declaration list -> bool -> Ast_structure.t ;
26419+
signature_gen : Parsetree.type_declaration list -> bool -> Ast_signature.t ;
2641226420
expression_gen : (Parsetree.core_type -> Parsetree.expression) option ;
2641326421
}
2641426422

2641526423
val type_deriving_structure:
26416-
Parsetree.type_declaration ->
26424+
Parsetree.type_declaration list ->
2641726425
Ast_payload.action list ->
2641826426
bool ->
2641926427
Ast_structure.t
2642026428
val type_deriving_signature:
26421-
Parsetree.type_declaration ->
26429+
Parsetree.type_declaration list ->
2642226430
Ast_payload.action list ->
2642326431
bool ->
2642426432
Ast_signature.t
@@ -26457,8 +26465,8 @@ end = struct
2645726465

2645826466

2645926467
type gen = {
26460-
structure_gen : Parsetree.type_declaration -> bool -> Ast_structure.t ;
26461-
signature_gen : Parsetree.type_declaration -> bool -> Ast_signature.t ;
26468+
structure_gen : Parsetree.type_declaration list -> bool -> Ast_structure.t ;
26469+
signature_gen : Parsetree.type_declaration list -> bool -> Ast_signature.t ;
2646226470
expression_gen : (Parsetree.core_type -> Parsetree.expression) option ;
2646326471
}
2646426472

@@ -26478,24 +26486,24 @@ let update key value =
2647826486

2647926487

2648026488
let type_deriving_structure
26481-
(tdcl : Parsetree.type_declaration)
26489+
tdcls
2648226490
(actions : Ast_payload.action list )
2648326491
(explict_nonrec : bool )
2648426492
: Ast_structure.t =
2648526493
Ext_list.flat_map
2648626494
(fun action ->
2648726495
(Ast_payload.table_dispatch !derive_table action).structure_gen
26488-
tdcl explict_nonrec) actions
26496+
tdcls explict_nonrec) actions
2648926497

2649026498
let type_deriving_signature
26491-
(tdcl : Parsetree.type_declaration)
26499+
tdcls
2649226500
(actions : Ast_payload.action list )
2649326501
(explict_nonrec : bool )
2649426502
: Ast_signature.t =
2649526503
Ext_list.flat_map
2649626504
(fun action ->
2649726505
(Ast_payload.table_dispatch !derive_table action).signature_gen
26498-
tdcl explict_nonrec) actions
26506+
tdcls explict_nonrec) actions
2649926507

2650026508
let dispatch_extension ({Asttypes.txt ; loc}) typ =
2650126509
let txt = Ext_string.tail_from txt (String.length Literals.bs_deriving_dot) in
@@ -29526,18 +29534,28 @@ let rec unsafe_mapper : Ast_mapper.mapper =
2952629534
);
2952729535
signature_item = begin fun (self : Ast_mapper.mapper) (sigi : Parsetree.signature_item) ->
2952829536
match sigi.psig_desc with
29529-
| Psig_type [{ptype_attributes} as tdcl] ->
29530-
begin match Ast_attributes.process_derive_type ptype_attributes with
29537+
| Psig_type (_ :: _ as tdcls) ->
29538+
begin match Ast_attributes.process_derive_type
29539+
(Ext_list.last tdcls).ptype_attributes with
2953129540
| {bs_deriving = `Has_deriving actions; explict_nonrec}, ptype_attributes
2953229541
-> Ast_signature.fuse
2953329542
{sigi with
29534-
psig_desc = Psig_type [self.type_declaration self {tdcl with ptype_attributes}]
29543+
psig_desc = Psig_type
29544+
(
29545+
Ext_list.map_last (fun last tdcl ->
29546+
if last then
29547+
self.type_declaration self {tdcl with ptype_attributes}
29548+
else
29549+
self.type_declaration self tdcl
29550+
) tdcls
29551+
)
2953529552
}
2953629553
(self.signature
2953729554
self @@
29538-
Ast_derive.type_deriving_signature tdcl actions explict_nonrec)
29555+
Ast_derive.type_deriving_signature tdcls actions explict_nonrec)
2953929556
| {bs_deriving = `Nothing }, _ ->
29540-
{sigi with psig_desc = Psig_type [ self.type_declaration self tdcl] }
29557+
Ast_mapper.default_mapper.signature_item self sigi
29558+
(* {sigi with psig_desc = Psig_type [ self.type_declaration self tdcl] } *)
2954129559
end
2954229560
| Psig_value
2954329561
({pval_attributes;
@@ -29575,23 +29593,30 @@ let rec unsafe_mapper : Ast_mapper.mapper =
2957529593
| Pstr_extension ( ({txt = ("bs.raw"| "raw") ; loc}, payload), _attrs)
2957629594
->
2957729595
Ast_util.handle_raw_structure loc payload
29578-
| Pstr_type [ {ptype_attributes} as tdcl ]->
29579-
begin match Ast_attributes.process_derive_type ptype_attributes with
29596+
| Pstr_type (_ :: _ as tdcls ) (* [ {ptype_attributes} as tdcl ] *)->
29597+
begin match Ast_attributes.process_derive_type
29598+
((Ext_list.last tdcls).ptype_attributes) with
2958029599
| {bs_deriving = `Has_deriving actions;
2958129600
explict_nonrec
2958229601
}, ptype_attributes ->
2958329602
Ast_structure.fuse
2958429603
{str with
2958529604
pstr_desc =
2958629605
Pstr_type
29587-
[ self.type_declaration self {tdcl with ptype_attributes}]}
29606+
(Ext_list.map_last (fun last tdcl ->
29607+
if last then
29608+
self.type_declaration self {tdcl with ptype_attributes}
29609+
else
29610+
self.type_declaration self tdcl) tdcls)
29611+
}
2958829612
(self.structure self @@ Ast_derive.type_deriving_structure
29589-
tdcl actions explict_nonrec )
29613+
tdcls actions explict_nonrec )
2959029614
| {bs_deriving = `Nothing}, _ ->
29591-
{str with
29592-
pstr_desc =
29593-
Pstr_type
29594-
[ self.type_declaration self tdcl]}
29615+
Ast_mapper.default_mapper.structure_item self str
29616+
(* {str with *)
29617+
(* pstr_desc = *)
29618+
(* Pstr_type *)
29619+
(* [ self.type_declaration self tdcl]} *)
2959529620
end
2959629621
| Pstr_primitive
2959729622
({pval_attributes;

‎jscomp/bin/bsppx.ml

Lines changed: 48 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -5449,6 +5449,8 @@ val rev_except_last : 'a list -> 'a list * 'a
54495449
val sort_via_array :
54505450
('a -> 'a -> int) -> 'a list -> 'a list
54515451

5452+
val last : 'a list -> 'a
5453+
54525454
end = struct
54535455
#1 "ext_list.ml"
54545456
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -5805,6 +5807,12 @@ let sort_via_array cmp lst =
58055807
Array.sort cmp arr;
58065808
Array.to_list arr
58075809

5810+
let rec last xs =
5811+
match xs with
5812+
| [x] -> x
5813+
| _ :: tl -> last tl
5814+
| [] -> invalid_arg "Ext_list.last"
5815+
58085816
end
58095817
module Ast_comb : sig
58105818
#1 "ast_comb.mli"
@@ -6313,18 +6321,18 @@ module Ast_derive : sig
63136321

63146322

63156323
type gen = {
6316-
structure_gen : Parsetree.type_declaration -> bool -> Ast_structure.t ;
6317-
signature_gen : Parsetree.type_declaration -> bool -> Ast_signature.t ;
6324+
structure_gen : Parsetree.type_declaration list -> bool -> Ast_structure.t ;
6325+
signature_gen : Parsetree.type_declaration list -> bool -> Ast_signature.t ;
63186326
expression_gen : (Parsetree.core_type -> Parsetree.expression) option ;
63196327
}
63206328

63216329
val type_deriving_structure:
6322-
Parsetree.type_declaration ->
6330+
Parsetree.type_declaration list ->
63236331
Ast_payload.action list ->
63246332
bool ->
63256333
Ast_structure.t
63266334
val type_deriving_signature:
6327-
Parsetree.type_declaration ->
6335+
Parsetree.type_declaration list ->
63286336
Ast_payload.action list ->
63296337
bool ->
63306338
Ast_signature.t
@@ -6363,8 +6371,8 @@ end = struct
63636371

63646372

63656373
type gen = {
6366-
structure_gen : Parsetree.type_declaration -> bool -> Ast_structure.t ;
6367-
signature_gen : Parsetree.type_declaration -> bool -> Ast_signature.t ;
6374+
structure_gen : Parsetree.type_declaration list -> bool -> Ast_structure.t ;
6375+
signature_gen : Parsetree.type_declaration list -> bool -> Ast_signature.t ;
63686376
expression_gen : (Parsetree.core_type -> Parsetree.expression) option ;
63696377
}
63706378

@@ -6384,24 +6392,24 @@ let update key value =
63846392

63856393

63866394
let type_deriving_structure
6387-
(tdcl : Parsetree.type_declaration)
6395+
tdcls
63886396
(actions : Ast_payload.action list )
63896397
(explict_nonrec : bool )
63906398
: Ast_structure.t =
63916399
Ext_list.flat_map
63926400
(fun action ->
63936401
(Ast_payload.table_dispatch !derive_table action).structure_gen
6394-
tdcl explict_nonrec) actions
6402+
tdcls explict_nonrec) actions
63956403

63966404
let type_deriving_signature
6397-
(tdcl : Parsetree.type_declaration)
6405+
tdcls
63986406
(actions : Ast_payload.action list )
63996407
(explict_nonrec : bool )
64006408
: Ast_signature.t =
64016409
Ext_list.flat_map
64026410
(fun action ->
64036411
(Ast_payload.table_dispatch !derive_table action).signature_gen
6404-
tdcl explict_nonrec) actions
6412+
tdcls explict_nonrec) actions
64056413

64066414
let dispatch_extension ({Asttypes.txt ; loc}) typ =
64076415
let txt = Ext_string.tail_from txt (String.length Literals.bs_deriving_dot) in
@@ -11703,18 +11711,28 @@ let rec unsafe_mapper : Ast_mapper.mapper =
1170311711
);
1170411712
signature_item = begin fun (self : Ast_mapper.mapper) (sigi : Parsetree.signature_item) ->
1170511713
match sigi.psig_desc with
11706-
| Psig_type [{ptype_attributes} as tdcl] ->
11707-
begin match Ast_attributes.process_derive_type ptype_attributes with
11714+
| Psig_type (_ :: _ as tdcls) ->
11715+
begin match Ast_attributes.process_derive_type
11716+
(Ext_list.last tdcls).ptype_attributes with
1170811717
| {bs_deriving = `Has_deriving actions; explict_nonrec}, ptype_attributes
1170911718
-> Ast_signature.fuse
1171011719
{sigi with
11711-
psig_desc = Psig_type [self.type_declaration self {tdcl with ptype_attributes}]
11720+
psig_desc = Psig_type
11721+
(
11722+
Ext_list.map_last (fun last tdcl ->
11723+
if last then
11724+
self.type_declaration self {tdcl with ptype_attributes}
11725+
else
11726+
self.type_declaration self tdcl
11727+
) tdcls
11728+
)
1171211729
}
1171311730
(self.signature
1171411731
self @@
11715-
Ast_derive.type_deriving_signature tdcl actions explict_nonrec)
11732+
Ast_derive.type_deriving_signature tdcls actions explict_nonrec)
1171611733
| {bs_deriving = `Nothing }, _ ->
11717-
{sigi with psig_desc = Psig_type [ self.type_declaration self tdcl] }
11734+
Ast_mapper.default_mapper.signature_item self sigi
11735+
(* {sigi with psig_desc = Psig_type [ self.type_declaration self tdcl] } *)
1171811736
end
1171911737
| Psig_value
1172011738
({pval_attributes;
@@ -11752,23 +11770,30 @@ let rec unsafe_mapper : Ast_mapper.mapper =
1175211770
| Pstr_extension ( ({txt = ("bs.raw"| "raw") ; loc}, payload), _attrs)
1175311771
->
1175411772
Ast_util.handle_raw_structure loc payload
11755-
| Pstr_type [ {ptype_attributes} as tdcl ]->
11756-
begin match Ast_attributes.process_derive_type ptype_attributes with
11773+
| Pstr_type (_ :: _ as tdcls ) (* [ {ptype_attributes} as tdcl ] *)->
11774+
begin match Ast_attributes.process_derive_type
11775+
((Ext_list.last tdcls).ptype_attributes) with
1175711776
| {bs_deriving = `Has_deriving actions;
1175811777
explict_nonrec
1175911778
}, ptype_attributes ->
1176011779
Ast_structure.fuse
1176111780
{str with
1176211781
pstr_desc =
1176311782
Pstr_type
11764-
[ self.type_declaration self {tdcl with ptype_attributes}]}
11783+
(Ext_list.map_last (fun last tdcl ->
11784+
if last then
11785+
self.type_declaration self {tdcl with ptype_attributes}
11786+
else
11787+
self.type_declaration self tdcl) tdcls)
11788+
}
1176511789
(self.structure self @@ Ast_derive.type_deriving_structure
11766-
tdcl actions explict_nonrec )
11790+
tdcls actions explict_nonrec )
1176711791
| {bs_deriving = `Nothing}, _ ->
11768-
{str with
11769-
pstr_desc =
11770-
Pstr_type
11771-
[ self.type_declaration self tdcl]}
11792+
Ast_mapper.default_mapper.structure_item self str
11793+
(* {str with *)
11794+
(* pstr_desc = *)
11795+
(* Pstr_type *)
11796+
(* [ self.type_declaration self tdcl]} *)
1177211797
end
1177311798
| Pstr_primitive
1177411799
({pval_attributes;

0 commit comments

Comments
 (0)