瀏覽代碼

added support for dynamic functions on As3 target by initializing them in the constructor (allows overrides and correct 'this' resolving)

Simon Krajewski 13 年之前
父節點
當前提交
fd59c596b1
共有 2 個文件被更改,包括 39 次插入12 次删除
  1. 38 9
      codegen.ml
  2. 1 3
      tests/unit/Test.hx

+ 38 - 9
codegen.ml

@@ -466,32 +466,61 @@ let on_inherit ctx c p h =
 	Adds member field initializations as assignments to the constructor
 *)
 let add_field_inits com c =
+	let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_types)) c.cl_pos in
+	(* TODO: we have to find a variable name which is not used in any of the functions *)
+	let v = alloc_var "_g" ethis.etype in
 	let rec can_init_inline cf e = match com.platform,e.eexpr with
 		| Flash8,_ -> true
-		| Flash,_ when Common.defined com "as3" -> true
+		| Flash,_ when Common.defined com "as3" && (match cf.cf_kind with Var _ -> true | Method _ -> false) -> true
 		| Php, TTypeExpr _ -> false
 		| Php,_ ->
 			(match cf.cf_kind with Var({v_write = AccCall _}) -> false | _ -> true)
 		| _ -> false
 	in
-	let inits = List.filter (fun cf ->
+	let need_this = ref false in
+	let inits,fields = List.fold_left (fun (inits,fields) cf ->
 		match cf.cf_kind,cf.cf_expr with
-		| Var _, Some e when can_init_inline cf e -> false
-		| Var _, Some _ -> true
-		| _ -> false
-	) c.cl_ordered_fields in
+		| Var _, Some e when can_init_inline cf e -> (inits, cf :: fields)
+		| Var _, Some _ -> (cf :: inits, cf :: fields)
+		| Method MethDynamic, Some e when Common.defined com "as3" ->
+			(* we move the initialization of dynamic functions to the constructor and also solve the
+			   'this' problem along the way *)
+			let rec use_this v e = match e.eexpr with
+				| TConst TThis ->
+					need_this := true;
+					mk (TLocal v) v.v_type e.epos
+				| _ -> Type.map_expr (use_this v) e
+			in
+			let e = Type.map_expr (use_this v) e in
+			let cf = {cf with cf_expr = Some e} in
+			(* if the method is an override, we have to remove the class field to not get invalid overrides *)
+			let fields = if List.mem cf.cf_name c.cl_overrides then begin
+				c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
+				fields
+			end else
+				cf :: fields
+			in
+			(cf :: inits, fields)
+		| _ -> (inits, cf :: fields)
+	) ([],[]) c.cl_ordered_fields in
+	c.cl_ordered_fields <- fields;
 	match inits with
 	| [] -> ()
 	| _ ->
-		let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_types)) c.cl_pos in
 		let el = List.map (fun cf ->
 			match cf.cf_expr with
 			| None -> assert false
 			| Some e ->
 				let lhs = mk (TField(ethis,cf.cf_name)) e.etype e.epos in
 				cf.cf_expr <- None;
-				mk (TBinop(OpAssign,lhs,e)) lhs.etype e.epos
+				let eassign = mk (TBinop(OpAssign,lhs,e)) lhs.etype e.epos in
+				if Common.defined com "as3" then begin
+					let echeck = mk (TBinop(OpEq,lhs,(mk (TConst TNull) lhs.etype e.epos))) com.basic.tbool e.epos in
+					mk (TIf(echeck,eassign,None)) eassign.etype e.epos
+				end else
+					eassign;
 		) inits in
+		let el = if !need_this then (mk (TVars([v, Some ethis])) ethis.etype ethis.epos) :: el else el in
 		match c.cl_constructor with
 		| None ->
 			let ct = TFun([],com.basic.tvoid) in
@@ -501,7 +530,7 @@ let add_field_inits com c =
 				tf_expr = mk (TBlock el) com.basic.tvoid c.cl_pos;
 			}) ct c.cl_pos in
 			let ctor = mk_field "new" ct c.cl_pos in
-      ctor.cf_kind <- Method MethNormal;
+			ctor.cf_kind <- Method MethNormal;
 			c.cl_constructor <- Some { ctor with cf_expr = Some ce };
 		| Some cf ->
 			match cf.cf_expr with

+ 1 - 3
tests/unit/Test.hx

@@ -193,12 +193,10 @@ class Test #if swf_mark implements mt.Protect #end #if as3 implements haxe.Publi
 			new TestLocals(),
 			new TestEReg(),
 			new TestXML(),
-			#if (!as3)
-			// these don't compile
 			new TestMisc(),
 			new TestResource(),
 			new TestInt64(),			
-			// these cause runtime exceptions
+			#if (!as3)
 			new TestReflect(),
 			new TestSerialize(),
 			new TestMeta(),