1- (* * Bundled by bspack 08/23 -11:54 *)
1+ (* * Bundled by bspack 08/24 -11:29 *)
22module String_map : sig
33#1 " string_map.mli"
44(* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -4440,36 +4440,51 @@ let check_ffi ?loc ffi =
44404440 TODO: we should emit an warning if we bind
44414441 two external files to the same module name
44424442*)
4443+ type bundle_source =
4444+ [`Nm_payload of string
4445+ |`Nm_external of string
4446+ | `Nm_val of string
4447+ ]
44434448
4449+ let string_of_bundle_source (x : bundle_source ) =
4450+ match x with
4451+ | `Nm_payload x
4452+ | `Nm_external x
4453+ | `Nm_val x -> x
4454+ type name_source =
4455+ [ bundle_source
4456+ | `Nm_na
4457+
4458+ ]
44444459type st =
4445- { val_name : string option ;
4460+ { val_name : name_source ;
44464461 external_module_name : external_module_name option ;
44474462 module_as_val : external_module_name option ;
4448- val_send : string option ;
4463+ val_send : name_source ;
44494464 splice : bool ; (* mutable *)
44504465 set_index : bool ; (* mutable *)
44514466 get_index : bool ;
4452- new_name : string option ;
4453- call_name : string option ;
4454- set_name : string option ;
4455- get_name : string option ;
4467+ new_name : name_source ;
4468+ call_name : name_source ;
4469+ set_name : name_source ;
4470+ get_name : name_source ;
44564471 mk_obj : bool ;
44574472
44584473 }
44594474
44604475let init_st =
44614476 {
4462- val_name = None ;
4477+ val_name = `Nm_na ;
44634478 external_module_name = None ;
44644479 module_as_val = None ;
4465- val_send = None ;
4480+ val_send = `Nm_na ;
44664481 splice = false ;
44674482 set_index = false ;
44684483 get_index = false ;
4469- new_name = None ;
4470- call_name = None ;
4471- set_name = None ;
4472- get_name = None ;
4484+ new_name = `Nm_na ;
4485+ call_name = `Nm_na ;
4486+ set_name = `Nm_na ;
4487+ get_name = `Nm_na ;
44734488 mk_obj = false ;
44744489
44754490 }
@@ -4503,13 +4518,13 @@ let handle_attributes
45034518 (type_annotation : Parsetree.core_type )
45044519 (prim_attributes : Ast_attributes.t ) (prim_name : string ) =
45054520 let prim_name_or_pval_prim =
4506- if String. length prim_name = 0 then pval_prim
4507- else prim_name (* need check name *)
4521+ if String. length prim_name = 0 then `Nm_val pval_prim
4522+ else `Nm_external prim_name (* need check name *)
45084523 in
45094524 let name_from_payload_or_prim payload =
45104525 match Ast_payload. is_single_string payload with
4511- | Some _ as val_name -> val_name
4512- | None -> Some prim_name_or_pval_prim
4526+ | Some val_name -> `Nm_payload val_name
4527+ | None -> prim_name_or_pval_prim
45134528 in
45144529 let result_type_ty, arg_types_ty =
45154530 Ast_core_type. list_of_arrow type_annotation in
@@ -4548,7 +4563,9 @@ let handle_attributes
45484563 { st with
45494564 module_as_val =
45504565 Some
4551- { bundle = prim_name_or_pval_prim ;
4566+ { bundle =
4567+ string_of_bundle_source
4568+ (prim_name_or_pval_prim :> bundle_source ) ;
45524569 bind_name = Some pval_prim}
45534570 }
45544571 | _ -> Location. raise_errorf ~loc " Illegal attributes"
@@ -4584,15 +4601,15 @@ let handle_attributes
45844601 match st with
45854602 | {mk_obj = true ;
45864603
4587- val_name = None ;
4604+ val_name = `Nm_na ;
45884605 external_module_name = None ;
45894606 module_as_val = None ;
4590- val_send = None ;
4607+ val_send = `Nm_na ;
45914608 splice = false ;
4592- new_name = None ;
4593- call_name = None ;
4594- set_name = None ;
4595- get_name = None ;
4609+ new_name = `Nm_na ;
4610+ call_name = `Nm_na ;
4611+ set_name = `Nm_na ;
4612+ get_name = `Nm_na ;
45964613 get_index = false ;
45974614 } ->
45984615 let labels = List. map (function
@@ -4612,16 +4629,16 @@ let handle_attributes
46124629 Location. raise_errorf ~loc " conflict attributes found"
46134630 | {set_index = true ;
46144631
4615- val_name = None ;
4632+ val_name = `Nm_na ;
46164633 external_module_name = None ;
46174634 module_as_val = None ;
4618- val_send = None ;
4635+ val_send = `Nm_na ;
46194636 splice = false ;
46204637 get_index = false ;
4621- new_name = None ;
4622- call_name = None ;
4623- set_name = None ;
4624- get_name = None ;
4638+ new_name = `Nm_na ;
4639+ call_name = `Nm_na ;
4640+ set_name = `Nm_na ;
4641+ get_name = `Nm_na ;
46254642 mk_obj = false ;
46264643
46274644 }
@@ -4640,15 +4657,15 @@ let handle_attributes
46404657
46414658 | {get_index = true ;
46424659
4643- val_name = None ;
4660+ val_name = `Nm_na ;
46444661 external_module_name = None ;
46454662 module_as_val = None ;
4646- val_send = None ;
4663+ val_send = `Nm_na ;
46474664 splice = false ;
4648- new_name = None ;
4649- call_name = None ;
4650- set_name = None ;
4651- get_name = None ;
4665+ new_name = `Nm_na ;
4666+ call_name = `Nm_na ;
4667+ set_name = `Nm_na ;
4668+ get_name = `Nm_na ;
46524669 mk_obj = false ;
46534670 } ->
46544671 if String. length prim_name <> 0 then
@@ -4674,89 +4691,94 @@ let handle_attributes
46744691 ]}
46754692 *)
46764693 external_module_name = None ;
4677- val_send = None ;
4694+ val_send = `Nm_na ;
46784695 splice = false ;
4679- call_name = None ;
4680- set_name = None ;
4681- get_name = None ;
4696+ call_name = `Nm_na ;
4697+ set_name = `Nm_na ;
4698+ get_name = `Nm_na ;
46824699 mk_obj = false ;
46834700 } ->
46844701 begin match arg_types_ty, new_name, val_name with
4685- | [] , None , _ -> Js_module_as_var v
4686- | _ , None , _ -> Js_module_as_fn v
4687- | _ , Some _ , Some _ ->
4702+ | [] , `Nm_na , _ -> Js_module_as_var v
4703+ | _ , `Nm_na , _ -> Js_module_as_fn v
4704+ | _ , #bundle_source , #bundle_source ->
46884705 Location. raise_errorf ~loc " conflict attributes found"
4689- | _, Some n, None
4690- -> Js_module_as_class v
4706+ | _, (`Nm_val _ | `Nm_external _) , `Nm_na
4707+ -> Js_module_as_class v
4708+ | _, `Nm_payload _ , `Nm_na
4709+ ->
4710+ Location. raise_errorf ~loc
4711+ " conflict attributes found: (bs.new should not carry payload here)"
4712+
46914713 end
46924714 | {module_as_val = Some _}
46934715 -> Location. raise_errorf ~loc " conflict attributes found"
4694- | {call_name = Some name ;
4716+ | {call_name = ( `Nm_val name | `Nm_external name | `Nm_payload name) ;
46954717 splice;
46964718 external_module_name;
46974719
4698- val_name = None ;
4720+ val_name = `Nm_na ;
46994721 module_as_val = None ;
4700- val_send = None ;
4722+ val_send = `Nm_na ;
47014723 set_index = false ;
47024724 get_index = false ;
4703- new_name = None ;
4704- set_name = None ;
4705- get_name = None
4725+ new_name = `Nm_na ;
4726+ set_name = `Nm_na ;
4727+ get_name = `Nm_na
47064728 } ->
47074729 Js_call {txt = {splice; name}; external_module_name}
4708- | {call_name = Some _ }
4730+ | {call_name = #bundle_source }
47094731 -> Location. raise_errorf ~loc " conflict attributes found"
47104732
4711- | {val_name = Some name;
4733+ | {val_name = ( `Nm_val name | `Nm_external name | `Nm_payload name) ;
47124734 external_module_name;
47134735
4714- call_name = None ;
4736+ call_name = `Nm_na ;
47154737 module_as_val = None ;
4716- val_send = None ;
4738+ val_send = `Nm_na ;
47174739 set_index = false ;
47184740 get_index = false ;
4719- new_name = None ;
4720- set_name = None ;
4721- get_name = None
4741+ new_name = `Nm_na ;
4742+ set_name = `Nm_na ;
4743+ get_name = `Nm_na
47224744
47234745 }
47244746 ->
47254747 Js_global {txt = name; external_module_name}
4726- | {val_name = Some _ }
4748+ | {val_name = #bundle_source }
47274749 -> Location. raise_errorf ~loc " conflict attributes found"
47284750 | {splice ;
47294751 external_module_name = (Some _ as external_module_name);
47304752
4731- val_name = None ;
4732- call_name = None ;
4753+ val_name = `Nm_na ;
4754+ call_name = `Nm_na ;
47334755 module_as_val = None ;
4734- val_send = None ;
4756+ val_send = `Nm_na ;
47354757 set_index = false ;
47364758 get_index = false ;
4737- new_name = None ;
4738- set_name = None ;
4739- get_name = None ;
4759+ new_name = `Nm_na ;
4760+ set_name = `Nm_na ;
4761+ get_name = `Nm_na ;
47404762
47414763 }
47424764 ->
4743- let name = prim_name_or_pval_prim in
4765+ let name = string_of_bundle_source prim_name_or_pval_prim in
47444766 begin match arg_types with
47454767 | [] -> Js_global {txt = name; external_module_name}
47464768 | _ -> Js_call {txt = {splice; name}; external_module_name}
47474769 end
47484770
4749- | {val_send = Some name;
4771+ | {val_send = ( `Nm_val name | `Nm_external name | `Nm_payload name) ;
47504772 splice;
47514773
4752- val_name = None ;
4753- call_name = None ;
4774+ val_name = `Nm_na ;
4775+ call_name = `Nm_na ;
47544776 module_as_val = None ;
47554777 set_index = false ;
47564778 get_index = false ;
4757- new_name = None ;
4758- set_name = None ;
4759- get_name = None ;
4779+ new_name = `Nm_na ;
4780+ set_name = `Nm_na ;
4781+ get_name = `Nm_na ;
47604782 external_module_name = None ;
47614783 } ->
47624784 begin match arg_types with
@@ -4765,35 +4787,35 @@ let handle_attributes
47654787 | _ ->
47664788 Location. raise_errorf ~loc " Ill defined attribute [@@bs.send] (at least one argument)"
47674789 end
4768- | {val_send = Some _ }
4790+ | {val_send = #bundle_source }
47694791 -> Location. raise_errorf ~loc " conflict attributes found"
47704792
4771- | {new_name = Some name;
4793+ | {new_name = ( `Nm_val name | `Nm_external name | `Nm_payload name) ;
47724794 external_module_name;
47734795
4774- val_name = None ;
4775- call_name = None ;
4796+ val_name = `Nm_na ;
4797+ call_name = `Nm_na ;
47764798 module_as_val = None ;
47774799 set_index = false ;
47784800 get_index = false ;
4779- val_send = None ;
4780- set_name = None ;
4781- get_name = None
4801+ val_send = `Nm_na ;
4802+ set_name = `Nm_na ;
4803+ get_name = `Nm_na
47824804 }
47834805 -> Js_new {txt = name; external_module_name}
4784- | {new_name = Some _ }
4806+ | {new_name = #bundle_source }
47854807 -> Location. raise_errorf ~loc " conflict attributes found"
47864808
4787- | {set_name = Some name;
4809+ | {set_name = ( `Nm_val name | `Nm_external name | `Nm_payload name) ;
47884810
4789- val_name = None ;
4790- call_name = None ;
4811+ val_name = `Nm_na ;
4812+ call_name = `Nm_na ;
47914813 module_as_val = None ;
47924814 set_index = false ;
47934815 get_index = false ;
4794- val_send = None ;
4795- new_name = None ;
4796- get_name = None ;
4816+ val_send = `Nm_na ;
4817+ new_name = `Nm_na ;
4818+ get_name = `Nm_na ;
47974819 external_module_name = None
47984820 }
47994821 ->
@@ -4802,19 +4824,19 @@ let handle_attributes
48024824 Js_set name
48034825 | _ -> Location. raise_errorf ~loc " Ill defined attribute [@@bs.set] (two args required)"
48044826 end
4805- | {set_name = Some _ }
4827+ | {set_name = #bundle_source }
48064828 -> Location. raise_errorf ~loc " conflict attributes found"
48074829
4808- | {get_name = Some name;
4830+ | {get_name = ( `Nm_val name | `Nm_external name | `Nm_payload name) ;
48094831
4810- val_name = None ;
4811- call_name = None ;
4832+ val_name = `Nm_na ;
4833+ call_name = `Nm_na ;
48124834 module_as_val = None ;
48134835 set_index = false ;
48144836 get_index = false ;
4815- val_send = None ;
4816- new_name = None ;
4817- set_name = None ;
4837+ val_send = `Nm_na ;
4838+ new_name = `Nm_na ;
4839+ set_name = `Nm_na ;
48184840 external_module_name = None
48194841 }
48204842 ->
@@ -4823,7 +4845,7 @@ let handle_attributes
48234845 | _ ->
48244846 Location. raise_errorf ~loc " Ill defined attribute [@@bs.get] (only one argument)"
48254847 end
4826- | {get_name = Some _ }
4848+ | {get_name = #bundle_source }
48274849 -> Location. raise_errorf ~loc " conflict attributes found"
48284850 | _ -> Location. raise_errorf ~loc " Illegal attribute found" in
48294851 check_ffi ~loc ffi;
0 commit comments