clean up

jscomp/all.depend

@@ -381,8 +381,9 @@ core/lam_dispatch_primitive.cmi : core/j.cmx
 core/lam_bounded_vars.cmi : core/lam.cmi ext/ident_hashtbl.cmi
 core/lam_beta_reduce.cmi : core/lam_stats.cmi core/lam_closure.cmi \
     core/lam.cmi ext/ident_map.cmi
-core/lam_compile_external_call.cmi : core/lam_compile_context.cmi core/j.cmx \
-    syntax/external_ffi_types.cmi syntax/external_arg_spec.cmi
+core/lam_compile_external_call.cmi : core/lam_compile_context.cmi \
+    core/js_of_lam_variant.cmi core/j.cmx syntax/external_ffi_types.cmi \
+    syntax/external_arg_spec.cmi
 core/lam_compile_external_obj.cmi : core/j.cmx syntax/external_arg_spec.cmi
 core/lam_compile_primitive.cmi : core/lam_compile_context.cmi core/lam.cmi \
     core/j.cmx

jscomp/core/js_of_lam_variant.ml

@@ -25,6 +25,11 @@
 module E = Js_exp_make
 module S = Js_stmt_make
 
+type arg_expression = 
+  | Splice0
+  | Splice1 of E.t 
+  | Splice2 of E.t * E.t
+
 (* we need destruct [undefined] when input is optional *)
 let eval (arg : J.expression) (dispatches : (int * string) list ) : E.t = 
   if arg == E.undefined then E.undefined else
@@ -41,23 +46,24 @@ let eval (arg : J.expression) (dispatches : (int * string) list ) : E.t =
               }) dispatches))]
 
 (** invariant: optional is not allowed in this case *)
-let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) : E.t list  = 
+let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) = 
   match arg.expression_desc with
   | Array ([{expression_desc = Number (Int {i} | Uint i)}; cb], _)
   | Caml_block([{expression_desc = Number (Int {i} | Uint i)}; cb], _, _, _)
     -> 
-    let v = Ext_list.assoc_by_int None (Int32.to_int i) dispatches in [E.str v ; cb ]   
+    let v = Ext_list.assoc_by_int None (Int32.to_int i) dispatches in 
+    Splice2(E.str v , cb )   
   | _ ->  
     let event = Ext_ident.create "action" in
-    [
-      E.ocaml_fun [event]
+    Splice2
+      (E.ocaml_fun [event]
       [(S.int_switch arg
       (Ext_list.map (fun (i,r) -> 
               {J.case = i ; 
                body = [S.return (E.index (E.var event) 0l)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
-      ; (* TODO: improve, one dispatch later, 
+      , (* TODO: improve, one dispatch later, 
            the problem is that we can not create bindings 
            due to the 
         *)
@@ -68,7 +74,7 @@ let eval_as_event (arg : J.expression) (dispatches : (int * string) list ) : E.t
                body = [S.return (E.index (E.var event) 1l)],
                       false (* FIXME: if true, still print break*)
               }) dispatches))]
-    ]
+      )
 
 (* we need destruct [undefined] when input is optional *)
 let eval_as_int (arg : J.expression) (dispatches : (int * int) list ) : E.t  = 

jscomp/core/js_of_lam_variant.mli

@@ -22,7 +22,17 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
-val eval : J.expression -> (int * string) list -> J.expression
-val eval_as_event : J.expression -> (int * string) list -> J.expression list 
-val eval_as_int : J.expression -> (int * int) list -> J.expression
+(* module E = Js_exp_make *)
+
+type arg_expression = 
+  | Splice0
+  | Splice1 of J.expression 
+  | Splice2 of J.expression * J.expression
+
+val eval :
+   J.expression -> (int * string) list -> J.expression
+val eval_as_event : 
+  J.expression -> (int * string) list -> arg_expression
+val eval_as_int : 
+  J.expression -> (int * int) list -> J.expression
 val eval_as_unwrap : J.expression -> J.expression

jscomp/core/lam_compile_external_call.ml

@@ -48,7 +48,16 @@ let handle_external_opt
   | None -> None 
 
 
-
+type arg_expression = Js_of_lam_variant.arg_expression = 
+  | Splice0
+  | Splice1 of E.t 
+  | Splice2 of E.t * E.t
+
+let append_list  x xs = 
+  match x with 
+  | Splice0 -> xs 
+  | Splice1 a -> a::xs 
+  | Splice2 (a,b) -> a::b::xs
 (** The first return value is value, the second argument is side effect expressions 
     Only the [unit] with no label will be ignored
     When  we are passing a boxed value to external(optional), we need
@@ -74,7 +83,7 @@ let handle_external_opt
 let ocaml_to_js_eff 
     ({arg_label;  arg_type }:  External_arg_spec.t)
     (raw_arg : J.expression)
-  : E.t list * E.t list  =
+  : arg_expression * E.t list  =
   let arg =
     match arg_label with
     | Optional label -> Js_of_lam_option.get_default_undefined raw_arg
@@ -87,19 +96,20 @@ let ocaml_to_js_eff
   | Fn_uncurry_arity _ -> assert false  
   (* has to be preprocessed by {!Lam} module first *)
   | Extern_unit ->  
-    (if arg_label = External_arg_spec.empty_label then [] else [E.unit]), 
+    (if arg_label = External_arg_spec.empty_label then 
+      Splice0 else Splice1 E.unit), 
     (if Js_analyzer.no_side_effect_expression arg then 
        []
      else 
        [arg]) (* leave up later to decide *)
   | Ignore -> 
-    [], 
+    Splice0, 
     (if Js_analyzer.no_side_effect_expression arg then 
        []
      else 
        [arg])
   | NullString dispatches -> 
-    [Js_of_lam_variant.eval arg dispatches],[]
+    Splice1 (Js_of_lam_variant.eval arg dispatches),[]
   | NonNullString dispatches -> 
     Js_of_lam_variant.eval_as_event arg dispatches,[]    
     (* FIXME: encode invariant below in the signature*)
@@ -108,7 +118,7 @@ let ocaml_to_js_eff
       - the value
      *)
   | Int dispatches -> 
-    [Js_of_lam_variant.eval_as_int arg dispatches],[]
+    Splice1 (Js_of_lam_variant.eval_as_int arg dispatches),[]
   | Unwrap ->
     let single_arg =
       match arg_label with
@@ -134,8 +144,8 @@ let ocaml_to_js_eff
       | _ ->
         Js_of_lam_variant.eval_as_unwrap raw_arg
     in
-    [single_arg],[]
-  | Nothing  | Array ->  [arg], []
+    Splice1 single_arg,[]
+  | Nothing  | Array ->  Splice1 arg, []
 
 
 
@@ -182,7 +192,7 @@ let assemble_args call_loc ffi  js_splice arg_types args : E.t list * E.t option
       else 
         let accs, eff = aux labels args in 
         let acc, new_eff = ocaml_to_js_eff arg_kind arg in 
-        Ext_list.append acc  accs, Ext_list.append new_eff  eff
+        append_list acc  accs, Ext_list.append new_eff  eff
     | { arg_label = Empty None | Label (_,None) | Optional _  ; _ } :: _ , [] 
       -> assert false 
     | [],  _ :: _  -> assert false      

jscomp/core/lam_compile_external_call.mli

@@ -33,7 +33,7 @@
 val ocaml_to_js_eff : 
   External_arg_spec.t -> 
   J.expression -> 
-  J.expression list * J.expression list  
+  Js_of_lam_variant.arg_expression * J.expression list  
 
 val translate_ffi :
   Location.t -> 

jscomp/core/lam_compile_external_obj.ml

@@ -60,9 +60,10 @@ let assemble_args_obj (labels : External_arg_spec.t list)  (args : J.expression
       let accs, eff, assign = aux labels args in 
       let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff arg_kind arg in 
       begin match acc with 
-        | [ ] -> assert false
-        | x::xs -> 
-          (label, E.fuse_to_seq x xs ) :: accs , Ext_list.append new_eff  eff , assign
+        | Splice2 _ 
+        | Splice0 -> assert false
+        | Splice1 x ->
+          (label, x) :: accs , Ext_list.append new_eff  eff , assign          
       end (* evaluation order is undefined *)
 
     | ({arg_label = Optional label; arg_type } as arg_kind)::labels, arg::args 
@@ -76,9 +77,10 @@ let assemble_args_obj (labels : External_arg_spec.t list)  (args : J.expression
           let acc, new_eff = Lam_compile_external_call.ocaml_to_js_eff 
             ({arg_label = External_arg_spec.label label None; arg_type}) x in 
           begin match acc with 
-          | [] -> assert false 
-          | x::xs -> 
-            (label, E.fuse_to_seq x xs ) :: accs , Ext_list.append new_eff  eff , assign
+          | Splice2 _
+          | Splice0 -> assert false 
+          | Splice1 x ->
+            (label, x) :: accs , Ext_list.append new_eff  eff , assign
           end   
         | _ ->                 
           accs, eff , (arg_kind,arg)::assign 
@@ -118,15 +120,15 @@ let assemble_args_obj (labels : External_arg_spec.t list)  (args : J.expression
              External_arg_spec.empty_label}
               (E.index arg 0l ) in 
           begin match acc with 
-          | [ v ] ->                         
+          | Splice1 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
+          | Splice0 | Splice2 _ -> assert false
           end
         | Some (st,id) -> (* FIXME: see #2503 *)
           let arg = E.var id in         
@@ -136,15 +138,15 @@ let assemble_args_obj (labels : External_arg_spec.t list)  (args : J.expression
              External_arg_spec.empty_label}
               (E.index arg 0l ) in 
           begin match acc with 
-          | [ v ] ->        
+          | Splice1 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
+          | Splice0 | Splice2 _ -> assert false
           end 
         end 
       |  _ -> assert false