bug fix 631

Author: Hongbo Zhang

jscomp/js_exp_make.ml

@@ -314,6 +314,16 @@ let index ?comment (e0 : t)  e1 : t =
     List.nth l  (Int32.to_int e1)  (* Float i -- should not appear here *)
   | _ -> { expression_desc = Access (e0, int ?comment e1); comment = None} 
 
+
+let index_addr ?comment ~yes ~no (e0 : t)  e1 : t = 
+  match e0.expression_desc with
+  | Array (l,_mutable_flag)  when no_side_effect e0 -> 
+    no
+  | Caml_block (l,_mutable_flag, _, _)  when no_side_effect e0 -> 
+    no
+  | _ ->
+    yes ({ expression_desc = Access (e0, int ?comment e1); comment = None} : t) 
+
 let call ?comment ~info e0 args : t = 
   {expression_desc = Call(e0,args,info); comment }
 

jscomp/js_exp_make.mli

@@ -145,6 +145,9 @@ val js_global_dot : ?comment:string -> string -> string -> t
 
 val index : ?comment:string -> t -> Int32.t -> t
 
+(** if the expression is a temporay block which has no side effect,
+    write to it does not really make sense, optimize it away *)
+val index_addr : ?comment:string -> yes:(t -> t) -> no:t -> t -> Js_op.jsint -> t
 
 val assign :  binary_op
 

jscomp/js_of_lam_block.ml

@@ -57,15 +57,16 @@ let field field_info e i =
     -> E.index ~comment:s e i
 
 
-let set_field field_info e i e0 = 
-  let v = 
+
+let set_field field_info e i e0 =
+  let comment = 
     match field_info with 
     | Lambda.Fld_set_na 
-      -> 
-      E.index e i 
-    | Fld_record_set s -> 
-      E.index ~comment:s e i in 
-  E.assign v  e0
+      -> None
+    | Fld_record_set s -> Some (s)
+  in (* see GPR#631*)
+  E.index_addr ?comment e i  ~no:e0 ~yes:(fun v -> E.assign v e0)
+
 
 
 

jscomp/lam_compile_group.ml

@@ -422,7 +422,7 @@ let lambda_as_module
     (lam : Lambda.lambda) = 
   begin 
     Js_config.set_current_file filename ;  
-    Js_config.iset_debug_file "optional_ffi_test.ml";
+    Js_config.iset_debug_file "jsoo_485_test.ml";
     let lambda_output = compile ~filename output_prefix false env sigs lam in
     let (//) = Filename.concat in 
     let basename =  

jscomp/test/.depend

@@ -334,6 +334,10 @@ js_obj_test.cmj : mt.cmi
 js_obj_test.cmx : mt.cmx
 js_val.cmj :
 js_val.cmx :
+jsoo_485.cmj :
+jsoo_485.cmx :
+jsoo_485_test.cmj :
+jsoo_485_test.cmx :
 largest_int_flow.cmj :
 largest_int_flow.cmx :
 lazy_test.cmj : mt.cmi ../stdlib/lazy.cmi
@@ -1086,6 +1090,10 @@ js_obj_test.cmo : mt.cmi
 js_obj_test.cmj : mt.cmj
 js_val.cmo :
 js_val.cmj :
+jsoo_485.cmo :
+jsoo_485.cmj :
+jsoo_485_test.cmo :
+jsoo_485_test.cmj :
 largest_int_flow.cmo :
 largest_int_flow.cmj :
 lazy_test.cmo : mt.cmi ../stdlib/lazy.cmi

jscomp/test/Makefile

@@ -59,7 +59,7 @@ OTHERS := a test_ari test_export2 test_internalOO test_obj_simple_ffi test_scope
 	optional_ffi_test poly_variant_test \
 	bs_rest_test infer_type_test fs_test module_as_function\
 	test_case_set test_mutliple string_bound_get_test inline_string_test\
-	ppx_this_obj_test unsafe_obj_external gpr_627_test	
+	ppx_this_obj_test unsafe_obj_external gpr_627_test jsoo_485_test	
 
 
 SOURCE_LIST := js_dyn $(OTHERS) 

jscomp/test/jsoo_485.ml

@@ -0,0 +1,10 @@
+'use strict';
+
+
+function f() {
+  /* Some */[3];
+  return /* () */0;
+}
+
+exports.f = f;
+/*  Not a pure module */

jscomp/test/jsoo_485_test.js

@@ -0,0 +1,12 @@
+let f () = 
+  (ref None) := Some 3
+
+
+(* Uncaught ReferenceError: Invalid left-hand side in assignment *)
+(*
+function f() {
+  /* None */0 = /* Some */[3];
+  return /* () */0;
+}*)
+
+let () = f ()