Skip to content

Commit 94f13c9

Browse files
bobzhangbobzhang
committed
provide bs.open for open data
1 parent ddd187a commit 94f13c9

14 files changed

+430
-11
lines changed

‎jscomp/bin/bsdep.ml

+87-2
Original file line numberDiff line numberDiff line change
@@ -26356,6 +26356,8 @@ val process_method_attributes_rev :
2635626356
val process_attributes_rev :
2635726357
t -> [ `Meth_callback | `Nothing | `Uncurry | `Method ] * t
2635826358

26359+
val process_pexp_fun_attributes_rev :
26360+
t -> [ `Nothing | `Exn ] * t
2635926361
val process_bs :
2636026362
t -> [ `Nothing | `Has] * t
2636126363

@@ -26496,6 +26498,17 @@ let process_attributes_rev (attrs : t) =
2649626498
st, attr::acc
2649726499
) ( `Nothing, []) attrs
2649826500

26501+
let process_pexp_fun_attributes_rev (attrs : t) =
26502+
List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) ->
26503+
match txt, st with
26504+
| "bs.open", (`Nothing | `Exn)
26505+
->
26506+
`Exn, acc
26507+
26508+
| _ , _ ->
26509+
st, attr::acc
26510+
) ( `Nothing, []) attrs
26511+
2649926512
let process_bs attrs =
2650026513
List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) ->
2650126514
match txt, st with
@@ -26697,7 +26710,7 @@ type pattern_lit = Parsetree.pattern lit
2669726710
val val_unit : expression_lit
2669826711

2669926712
val type_unit : core_type_lit
26700-
26713+
val type_exn : core_type_lit
2670126714
val type_string : core_type_lit
2670226715
val type_int : core_type_lit
2670326716
val type_any : core_type_lit
@@ -26739,6 +26752,7 @@ module Lid = struct
2673926752
let type_unit : t = Lident "unit"
2674026753
let type_string : t = Lident "string"
2674126754
let type_int : t = Lident "int" (* use *predef* *)
26755+
let type_exn : t = Lident "exn" (* use *predef* *)
2674226756
(* TODO should be renamed in to {!Js.fn} *)
2674326757
(* TODO should be moved into {!Js.t} Later *)
2674426758
let js_fn = Longident.Ldot (Lident "Js", "fn")
@@ -26757,8 +26771,12 @@ module No_loc = struct
2675726771
let loc = Location.none
2675826772
let val_unit =
2675926773
Ast_helper.Exp.construct {txt = Lid.val_unit; loc } None
26774+
2676026775
let type_unit =
2676126776
Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
26777+
let type_exn =
26778+
Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
26779+
2676226780
let type_int =
2676326781
Ast_helper.Typ.mk (Ptyp_constr ({txt = Lid.type_int; loc}, []))
2676426782
let type_string =
@@ -26786,6 +26804,13 @@ let type_unit ?loc () =
2678626804
| Some loc ->
2678726805
Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
2678826806

26807+
let type_exn ?loc () =
26808+
match loc with
26809+
| None ->
26810+
No_loc.type_exn
26811+
| Some loc ->
26812+
Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_exn; loc}, []))
26813+
2678926814

2679026815
let type_string ?loc () =
2679126816
match loc with
@@ -32614,7 +32639,10 @@ val ocaml_obj_as_js_object :
3261432639
Parsetree.expression_desc) cxt
3261532640

3261632641

32617-
32642+
val convertBsErrorFunction :
32643+
32644+
(Ast_helper.attrs -> Parsetree.case list -> Parsetree.expression) cxt
32645+
3261832646
end = struct
3261932647
#1 "ast_util.ml"
3262032648
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -33250,6 +33278,56 @@ let record_as_js_object
3325033278

3325133279

3325233280

33281+
let isCamlExceptionOrOpenVariant = Longident.parse "Caml_exceptions.isCamlExceptionOrOpenVariant"
33282+
let obj_magic = Longident.parse "Obj.magic"
33283+
33284+
let rec checkCases (cases : Parsetree.case list) =
33285+
List.iter check_case cases
33286+
and check_case case =
33287+
check_pat case.pc_lhs
33288+
and check_pat (pat : Parsetree.pattern) =
33289+
match pat.ppat_desc with
33290+
| Ppat_construct _ -> ()
33291+
| Ppat_or (l,r) ->
33292+
check_pat l; check_pat r
33293+
| _ -> Location.raise_errorf ~loc:pat.ppat_loc "Unsupported pattern in `bs.open`"
33294+
33295+
let convertBsErrorFunction loc (self : Ast_mapper.mapper) attrs (cases : Parsetree.case list ) =
33296+
let txt = "match" in
33297+
let txt_expr = Exp.ident ~loc {txt = Lident txt; loc} in
33298+
let none = Exp.constraint_ ~loc
33299+
(Exp.construct ~loc {txt = Lident "None" ; loc} None)
33300+
(Ast_core_type.lift_option_type (Typ.any ~loc ())) in
33301+
let () = checkCases cases in
33302+
let cases = self.cases self cases in
33303+
Exp.fun_ ~attrs ~loc "" None ( Pat.var ~loc {txt; loc })
33304+
(Exp.ifthenelse
33305+
~loc
33306+
(Exp.apply ~loc (Exp.ident ~loc {txt = isCamlExceptionOrOpenVariant ; loc}) ["", txt_expr ])
33307+
(Exp.match_ ~loc
33308+
(Exp.constraint_ ~loc
33309+
(Exp.apply ~loc (Exp.ident ~loc {txt = obj_magic; loc}) ["", txt_expr])
33310+
(Ast_literal.type_exn ~loc ())
33311+
)
33312+
(List.map (fun (x :Parsetree.case ) ->
33313+
let pc_rhs = x.pc_rhs in
33314+
let loc = pc_rhs.pexp_loc in
33315+
{
33316+
x with pc_rhs =
33317+
Exp.constraint_ ~loc
33318+
(Exp.construct ~loc {txt = Lident "Some";loc} (Some pc_rhs))
33319+
(Ast_core_type.lift_option_type (Typ.any ~loc ()) )
33320+
}
33321+
33322+
) cases
33323+
@ [
33324+
Exp.case (Pat.any ~loc ()) none
33325+
])
33326+
)
33327+
(Some none))
33328+
33329+
33330+
3325333331
end
3325433332
module Ext_ref : sig
3325533333
#1 "ext_ref.mli"
@@ -33803,6 +33881,13 @@ let rec unsafe_mapper : Ast_mapper.mapper =
3380333881
Ast_derive.dispatch_extension lid typ
3380433882

3380533883
(** End rewriting *)
33884+
| Pexp_function cases ->
33885+
begin match Ast_attributes.process_pexp_fun_attributes_rev e.pexp_attributes with
33886+
| `Nothing, _ ->
33887+
Ast_mapper.default_mapper.expr self e
33888+
| `Exn, pexp_attributes ->
33889+
Ast_util.convertBsErrorFunction loc self pexp_attributes cases
33890+
end
3380633891
| Pexp_fun ("", None, pat , body)
3380733892
->
3380833893
begin match Ast_attributes.process_attributes_rev e.pexp_attributes with

‎jscomp/bin/bsppx.ml

+87-2
Original file line numberDiff line numberDiff line change
@@ -8371,6 +8371,8 @@ val process_method_attributes_rev :
83718371
val process_attributes_rev :
83728372
t -> [ `Meth_callback | `Nothing | `Uncurry | `Method ] * t
83738373

8374+
val process_pexp_fun_attributes_rev :
8375+
t -> [ `Nothing | `Exn ] * t
83748376
val process_bs :
83758377
t -> [ `Nothing | `Has] * t
83768378

@@ -8511,6 +8513,17 @@ let process_attributes_rev (attrs : t) =
85118513
st, attr::acc
85128514
) ( `Nothing, []) attrs
85138515

8516+
let process_pexp_fun_attributes_rev (attrs : t) =
8517+
List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) ->
8518+
match txt, st with
8519+
| "bs.open", (`Nothing | `Exn)
8520+
->
8521+
`Exn, acc
8522+
8523+
| _ , _ ->
8524+
st, attr::acc
8525+
) ( `Nothing, []) attrs
8526+
85148527
let process_bs attrs =
85158528
List.fold_left (fun (st, acc) (({txt; loc}, _) as attr : attr) ->
85168529
match txt, st with
@@ -8712,7 +8725,7 @@ type pattern_lit = Parsetree.pattern lit
87128725
val val_unit : expression_lit
87138726

87148727
val type_unit : core_type_lit
8715-
8728+
val type_exn : core_type_lit
87168729
val type_string : core_type_lit
87178730
val type_int : core_type_lit
87188731
val type_any : core_type_lit
@@ -8754,6 +8767,7 @@ module Lid = struct
87548767
let type_unit : t = Lident "unit"
87558768
let type_string : t = Lident "string"
87568769
let type_int : t = Lident "int" (* use *predef* *)
8770+
let type_exn : t = Lident "exn" (* use *predef* *)
87578771
(* TODO should be renamed in to {!Js.fn} *)
87588772
(* TODO should be moved into {!Js.t} Later *)
87598773
let js_fn = Longident.Ldot (Lident "Js", "fn")
@@ -8772,8 +8786,12 @@ module No_loc = struct
87728786
let loc = Location.none
87738787
let val_unit =
87748788
Ast_helper.Exp.construct {txt = Lid.val_unit; loc } None
8789+
87758790
let type_unit =
87768791
Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
8792+
let type_exn =
8793+
Ast_helper.Typ.mk (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
8794+
87778795
let type_int =
87788796
Ast_helper.Typ.mk (Ptyp_constr ({txt = Lid.type_int; loc}, []))
87798797
let type_string =
@@ -8801,6 +8819,13 @@ let type_unit ?loc () =
88018819
| Some loc ->
88028820
Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_unit; loc}, []))
88038821

8822+
let type_exn ?loc () =
8823+
match loc with
8824+
| None ->
8825+
No_loc.type_exn
8826+
| Some loc ->
8827+
Ast_helper.Typ.mk ~loc (Ptyp_constr ({ txt = Lid.type_exn; loc}, []))
8828+
88048829

88058830
let type_string ?loc () =
88068831
match loc with
@@ -15798,7 +15823,10 @@ val ocaml_obj_as_js_object :
1579815823
Parsetree.expression_desc) cxt
1579915824

1580015825

15801-
15826+
val convertBsErrorFunction :
15827+
15828+
(Ast_helper.attrs -> Parsetree.case list -> Parsetree.expression) cxt
15829+
1580215830
end = struct
1580315831
#1 "ast_util.ml"
1580415832
(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -16434,6 +16462,56 @@ let record_as_js_object
1643416462

1643516463

1643616464

16465+
let isCamlExceptionOrOpenVariant = Longident.parse "Caml_exceptions.isCamlExceptionOrOpenVariant"
16466+
let obj_magic = Longident.parse "Obj.magic"
16467+
16468+
let rec checkCases (cases : Parsetree.case list) =
16469+
List.iter check_case cases
16470+
and check_case case =
16471+
check_pat case.pc_lhs
16472+
and check_pat (pat : Parsetree.pattern) =
16473+
match pat.ppat_desc with
16474+
| Ppat_construct _ -> ()
16475+
| Ppat_or (l,r) ->
16476+
check_pat l; check_pat r
16477+
| _ -> Location.raise_errorf ~loc:pat.ppat_loc "Unsupported pattern in `bs.open`"
16478+
16479+
let convertBsErrorFunction loc (self : Ast_mapper.mapper) attrs (cases : Parsetree.case list ) =
16480+
let txt = "match" in
16481+
let txt_expr = Exp.ident ~loc {txt = Lident txt; loc} in
16482+
let none = Exp.constraint_ ~loc
16483+
(Exp.construct ~loc {txt = Lident "None" ; loc} None)
16484+
(Ast_core_type.lift_option_type (Typ.any ~loc ())) in
16485+
let () = checkCases cases in
16486+
let cases = self.cases self cases in
16487+
Exp.fun_ ~attrs ~loc "" None ( Pat.var ~loc {txt; loc })
16488+
(Exp.ifthenelse
16489+
~loc
16490+
(Exp.apply ~loc (Exp.ident ~loc {txt = isCamlExceptionOrOpenVariant ; loc}) ["", txt_expr ])
16491+
(Exp.match_ ~loc
16492+
(Exp.constraint_ ~loc
16493+
(Exp.apply ~loc (Exp.ident ~loc {txt = obj_magic; loc}) ["", txt_expr])
16494+
(Ast_literal.type_exn ~loc ())
16495+
)
16496+
(List.map (fun (x :Parsetree.case ) ->
16497+
let pc_rhs = x.pc_rhs in
16498+
let loc = pc_rhs.pexp_loc in
16499+
{
16500+
x with pc_rhs =
16501+
Exp.constraint_ ~loc
16502+
(Exp.construct ~loc {txt = Lident "Some";loc} (Some pc_rhs))
16503+
(Ast_core_type.lift_option_type (Typ.any ~loc ()) )
16504+
}
16505+
16506+
) cases
16507+
@ [
16508+
Exp.case (Pat.any ~loc ()) none
16509+
])
16510+
)
16511+
(Some none))
16512+
16513+
16514+
1643716515
end
1643816516
module Ext_ref : sig
1643916517
#1 "ext_ref.mli"
@@ -16987,6 +17065,13 @@ let rec unsafe_mapper : Ast_mapper.mapper =
1698717065
Ast_derive.dispatch_extension lid typ
1698817066

1698917067
(** End rewriting *)
17068+
| Pexp_function cases ->
17069+
begin match Ast_attributes.process_pexp_fun_attributes_rev e.pexp_attributes with
17070+
| `Nothing, _ ->
17071+
Ast_mapper.default_mapper.expr self e
17072+
| `Exn, pexp_attributes ->
17073+
Ast_util.convertBsErrorFunction loc self pexp_attributes cases
17074+
end
1699017075
| Pexp_fun ("", None, pat , body)
1699117076
->
1699217077
begin match Ast_attributes.process_attributes_rev e.pexp_attributes with

0 commit comments

Comments
 (0)