瀏覽代碼

[java/cs] fixed object declaration order assurance

Caue Waneck 13 年之前
父節點
當前提交
fb8dec1701
共有 1 個文件被更改,包括 57 次插入2 次删除
  1. 57 2
      gencommon.ml

+ 57 - 2
gencommon.ml

@@ -5041,6 +5041,9 @@ struct
             aggregate true [e]
           | _ -> trace (debug_expr expr); assert false (* should have been read as Statement by shallow_expr_type *)
   
+  let is_side_effects_free e =
+    match expr_kind e with | KNoSideEffects -> true | _ -> false
+  
   let get_kinds (statement:texpr) =
     let kinds = ref [] in
     ignore (expr_stat_map (fun e ->
@@ -6012,6 +6015,36 @@ struct
   
   (* WARNING: this will only work if overloading contructors is possible on target language *)
   let implement_dynamic_object_ctor ctx cl =
+    let rec is_side_effects_free e =
+      match e.eexpr with
+        | TConst _
+        | TLocal _
+        | TFunction _
+        | TEnumField _
+        | TTypeExpr _ -> 
+          true
+        | TNew(clnew,[],params) when clnew == cl ->
+          List.for_all is_side_effects_free params
+        | TUnop(Increment,_,_)
+        | TUnop(Decrement,_,_)
+        | TBinop(OpAssign,_,_)
+        | TBinop(OpAssignOp _,_,_) ->
+          false
+        | TUnop(_,_,e) ->
+          is_side_effects_free e
+        | TArray(e1,e2)
+        | TBinop(_,e1,e2) ->
+          is_side_effects_free e1 && is_side_effects_free e2
+        | TIf(cond,e1,Some e2) ->
+          is_side_effects_free cond && is_side_effects_free e1 && is_side_effects_free e2
+        | TField(e,_)
+        | TClosure(e,_)
+        | TParenthesis e -> is_side_effects_free e
+        | TArrayDecl el -> List.for_all is_side_effects_free el
+        | TCast(e,_) -> is_side_effects_free e
+        | _ -> false
+    in
+    
     let pos = cl.cl_pos in
     let gen = ctx.rcf_gen in
     let basic = gen.gcon.basic in
@@ -6077,6 +6110,20 @@ struct
     in
     
     let do_objdecl e objdecl =
+      let exprs_before = ref [] in
+      let rec change_exprs decl acc = match decl with
+        | (name,expr) :: tl ->
+          if is_side_effects_free expr then 
+            change_exprs tl ((name,expr) :: acc)
+          else begin
+            let var = mk_temp gen "odecl" expr.etype in
+            exprs_before := { eexpr = TVars([var,Some expr]); etype = basic.tvoid; epos = expr.epos } :: !exprs_before;
+            change_exprs tl ((name,mk_local var expr.epos) :: acc)
+          end
+        | [] -> acc
+      in
+      let objdecl = change_exprs objdecl [] in
+      
       let odecl, odecl_f = loop objdecl [] [] in
       let changed_expr = List.map (fun (s,e) -> (may_hash_field s,e)) in
       let odecl, odecl_f = changed_expr odecl, changed_expr odecl_f in
@@ -6090,7 +6137,7 @@ struct
       let odecl, odecl_f = List.sort sort_fn odecl, List.sort sort_fn odecl_f in
       
       let mk_arrdecl el t = { eexpr = TArrayDecl(el); etype = t; epos = pos } in
-      { 
+      let ret = { 
         e with eexpr = TNew(cl,[],
           [ 
             mk_arrdecl (List.map fst odecl) (basic.tarray hasht); 
@@ -6098,7 +6145,15 @@ struct
             mk_arrdecl (List.map fst odecl_f) (basic.tarray hasht);
             mk_arrdecl (List.map snd odecl_f) (basic.tarray basic.tfloat)
           ]);
-      }
+      } in
+      match !exprs_before with
+        | [] -> ret
+        | block ->
+          {
+            eexpr = TBlock(List.rev block @ [ret]);
+            etype = ret.etype;
+            epos = ret.epos;
+          }
     in
     do_objdecl