fix #2503

jscomp/core/bs_conditional_initial.ml

@@ -25,7 +25,7 @@
 
 let setup_env () = 
 #if BS_DEBUG then    
-    Js_config.set_debug_file "gpr_2487.ml";
+    Js_config.set_debug_file "gpr_2503_test.ml";
 #end       
   Lexer.replace_directive_bool "BS" true;
   Lexer.replace_directive_string "BS_VERSION"  Bs_version.version

jscomp/core/lam_compile_external_call.ml

@@ -72,7 +72,7 @@ let handle_external_opt
      This would not work with [NonNullString]
 *)
 let ocaml_to_js_eff 
-    ({ External_arg_spec.arg_label;  arg_type })
+    ({arg_label;  arg_type }:  External_arg_spec.t)
     (raw_arg : J.expression)
   : E.t list * E.t list  =
   let arg =
@@ -101,7 +101,12 @@ let ocaml_to_js_eff
   | NullString dispatches -> 
     [Js_of_lam_variant.eval arg dispatches],[]
   | NonNullString dispatches -> 
-    Js_of_lam_variant.eval_as_event arg dispatches,[]
+    Js_of_lam_variant.eval_as_event arg dispatches,[]    
+    (* FIXME: encode invariant below in the signature*)
+    (* length of 2
+      - the poly var tag 
+      - the value
+     *)
   | Int dispatches -> 
     [Js_of_lam_variant.eval_as_int arg dispatches],[]
   | Unwrap ->
@@ -275,7 +280,7 @@ let translate_ffi
              name = fn;
              splice ;
              scopes
-           } -> 
+           } -> (* handle [@@bs.new]*)
     (* This has some side effect, it will 
        mark its identifier (If it has) as an object,
        ATTENTION: 

jscomp/core/lam_compile_external_obj.ml

@@ -74,7 +74,7 @@ let assemble_args_obj (labels : External_arg_spec.t list)  (args : J.expression
         | Array ([x],_)
         | Caml_block ([x],_,_,_) ->
           let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff 
-            ({External_arg_spec.arg_label = External_arg_spec.label label None; arg_type}) x in 
+            ({arg_label = External_arg_spec.label label None; arg_type}) x in 
           begin match acc with 
           | [] -> assert false 
           | x::xs -> 
@@ -104,21 +104,48 @@ let assemble_args_obj (labels : External_arg_spec.t list)  (args : J.expression
       | x::xs -> E.seq (E.fuse_to_seq x xs) (E.obj map)     
     end) :: 
       (Ext_list.flat_map (fun 
-        ((label : External_arg_spec.t), (arg  : J.expression )) -> 
-      match label with 
+        ((xlabel : External_arg_spec.t), (arg  : J.expression )) -> 
+      match xlabel with 
       | {arg_label = Optional label } -> 
         (* Need make sure whether assignment is effectful or not
           to avoid code duplication
         *)
         begin match Js_ast_util.named_expression arg with 
         | None ->
-          [S.if_ arg [S.exp (E.assign (E.dot var_v label) 
-            (E.index arg 0l) ) ] ] 
-        | Some (st,id) ->
-          let var_id = E.var id in         
-          st ::  
-            [S.if_ var_id [S.exp (E.assign (E.dot var_v label) 
-              (E.index var_id 0l)) ]]
+          let acc,new_eff = 
+            Lam_compile_external_call.ocaml_to_js_eff 
+            {xlabel with arg_label =
+             External_arg_spec.empty_label}
+              (E.index arg 0l ) in 
+          begin match acc with 
+          | [ v ] ->                         
+            [S.if_ arg [S.exp (E.assign (E.dot var_v label) 
+            (
+              match new_eff with 
+              | [] -> v 
+              | x :: xs ->
+                E.seq (E.fuse_to_seq  x xs ) v
+             ) ) ] ] 
+          |_ -> assert false
+          end
+        | Some (st,id) -> (* FIXME: see #2503 *)
+          let arg = E.var id in         
+          let acc,new_eff = 
+            Lam_compile_external_call.ocaml_to_js_eff 
+            {xlabel with arg_label =
+             External_arg_spec.empty_label}
+              (E.index arg 0l ) in 
+          begin match acc with 
+          | [ v ] ->        
+            st ::  
+            [S.if_ arg [S.exp (E.assign (E.dot var_v label) 
+              (match new_eff with 
+              | [] -> v 
+              | x :: xs ->
+                E.seq (E.fuse_to_seq x xs) v 
+              )) ]]
+          | _ -> assert false
+          end 
         end 
       |  _ -> assert false    
       )

jscomp/others/belt_Map.mli

@@ -511,6 +511,6 @@ val packIdData: id:('a, 'b) id -> data:('a, 'c, 'b) Belt_MapDict.t -> ('a, 'c, '
 (**/**)
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 (**/**)

jscomp/others/belt_MapDict.mli

@@ -124,7 +124,7 @@ val getExn:
 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 val remove:

jscomp/others/belt_MapInt.mli

@@ -64,7 +64,7 @@ val getExn: 'a t -> key -> 'a
 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 (****************************************************************************)
@@ -151,7 +151,7 @@ val mapWithKey: 'a t -> (key -> 'a -> 'b) -> 'b t
 (**/**)
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 (**/**)
 

jscomp/others/belt_MapString.mli

@@ -64,7 +64,7 @@ val getExn: 'a t -> key -> 'a
 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 (****************************************************************************)
@@ -151,7 +151,7 @@ val mapWithKey: 'a t -> (key -> 'a -> 'b) -> 'b t
 (**/**)
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 (**/**)
 

jscomp/others/belt_MutableMap.mli

@@ -158,7 +158,7 @@ val getWithDefault:
 val getExn:  ('k, 'a, 'id) t -> 'k ->  'a 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 (****************************************************************************)

jscomp/others/belt_MutableMapInt.mli

@@ -97,7 +97,7 @@ val getWithDefault:  'a t -> key -> 'a  -> 'a
 val getExn: 'a t -> key -> 'a
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_MutableMapString.mli

@@ -97,7 +97,7 @@ val getWithDefault:  'a t -> key -> 'a  -> 'a
 val getExn: 'a t -> key -> 'a
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_MutableSet.mli

@@ -181,7 +181,7 @@ val split: ('elt, 'id) t -> 'elt ->  (('elt, 'id) t * ('elt, 'id) t) * bool
 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 (*

jscomp/others/belt_MutableSetInt.mli

@@ -116,7 +116,7 @@ val split:  t -> elt  -> (t * t) * bool
 
 val checkInvariantInternal: t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_MutableSetString.mli

@@ -116,7 +116,7 @@ val split:  t -> elt  -> (t * t) * bool
 
 val checkInvariantInternal: t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_Set.mli

@@ -272,8 +272,8 @@ val subset: ('elt, 'id) t -> ('elt, 'id) t -> bool
       let s1 = ofArray ~id:(module IntCmp) [|5;2;3;1;5;4;|];;
       let s2 = intersect s0 s1;;
       subset s2 s0 = true;;
-      subset s1 s0 = true;;
-      subset s1 s2 = false;;
+      subset s2 s1 = true;;
+      subset s1 s0 = false;;
     ]}
 *)
 
@@ -425,7 +425,7 @@ val split: ('elt, 'id) t -> 'elt -> (('elt, 'id) t  * ('elt, 'id) t) * bool
 (**/**)
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 (**/**)
 

jscomp/others/belt_SetDict.mli

@@ -150,7 +150,7 @@ val split: ('elt, 'id) t -> 'elt ->
 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_SetInt.mli

@@ -129,7 +129,7 @@ val split:  t -> elt -> (t * t) * bool
 
 val checkInvariantInternal: t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_SetString.mli

@@ -129,7 +129,7 @@ val split:  t -> elt -> (t * t) * bool
 
 val checkInvariantInternal: t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/belt_internalAVLset.mli

@@ -97,7 +97,7 @@ val size: 'a t -> int
 val toList: 'a t -> 'a list
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 val fillArray: 'a node -> int -> 'a array -> int 
 val toArray: 'a t -> 'a array

jscomp/others/belt_internalAVLtree.mli

@@ -131,7 +131,7 @@ val size : ('a,'b) t -> int
 val toList : ('a,'b) t -> ('a * 'b) list
 val checkInvariantInternal : ('a,'b) t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/map.cppo.mli

@@ -68,7 +68,7 @@ val getExn: 'a t -> key -> 'a
 
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 (****************************************************************************)
@@ -155,7 +155,7 @@ val mapWithKey: 'a t -> (key -> 'a -> 'b) -> 'b t
 (**/**)
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 (**/**)
 

jscomp/others/mapm.cppo.mli

@@ -100,7 +100,7 @@ val getWithDefault:  'a t -> key -> 'a  -> 'a
 val getExn: 'a t -> key -> 'a
 val checkInvariantInternal: _ t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/set.cppo.mli

@@ -132,7 +132,7 @@ val split:  t -> elt -> (t * t) * bool
 
 val checkInvariantInternal: t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/others/setm.cppo.mli

@@ -119,7 +119,7 @@ val split:  t -> elt  -> (t * t) * bool
 
 val checkInvariantInternal: t -> unit
 (**
-   {b raise} when invariant is not helld
+   {b raise} when invariant is not held
 *)  
 
 

jscomp/test/.depend

@@ -302,7 +302,7 @@ gpr_2250_test.cmj : mt.cmj
 gpr_2316_test.cmj : mt.cmj ../runtime/js.cmj
 gpr_2474.cmj :
 gpr_2487.cmj : ../others/belt.cmj
-gpr_2503_test.cmj : ../runtime/js.cmj
+gpr_2503_test.cmj : mt.cmj ../runtime/js.cmj
 gpr_405_test.cmj : ../stdlib/hashtbl.cmj gpr_405_test.cmi
 gpr_441.cmj :
 gpr_459_test.cmj : mt.cmj