Browse Source

prevent closure creation for inline methods of extern classes
always force inlining for inline methods of extern classes

Nicolas Cannasse 14 years ago
parent
commit
3afaefaa50
2 changed files with 18 additions and 12 deletions
  1. 7 7
      std/flash9/Memory.hx
  2. 11 5
      typer.ml

+ 7 - 7
std/flash9/Memory.hx

@@ -1,28 +1,28 @@
 package flash;
 package flash;
 
 
-class Memory {
+extern class Memory {
 
 
-	public static inline function select( b : flash.utils.ByteArray ) {
+	public static inline function select( b : flash.utils.ByteArray ) : Void {
 		flash.system.ApplicationDomain.currentDomain.domainMemory = b;
 		flash.system.ApplicationDomain.currentDomain.domainMemory = b;
 	}
 	}
 
 
-	public static inline function setByte( addr : Int, v : Int ) {
+	public static inline function setByte( addr : Int, v : Int ) : Void {
 		untyped __vmem_set__(0,addr,v);
 		untyped __vmem_set__(0,addr,v);
 	}
 	}
 
 
-	public static inline function setI16( addr : Int, v : Int ) {
+	public static inline function setI16( addr : Int, v : Int ) : Void {
 		untyped __vmem_set__(1,addr,v);
 		untyped __vmem_set__(1,addr,v);
 	}
 	}
 
 
-	public static inline function setI32( addr : Int, v : Int ) {
+	public static inline function setI32( addr : Int, v : Int ) : Void {
 		untyped __vmem_set__(2,addr,v);
 		untyped __vmem_set__(2,addr,v);
 	}
 	}
 
 
-	public static inline function setFloat( addr : Int, v : Float ) {
+	public static inline function setFloat( addr : Int, v : Float ) : Void {
 		untyped __vmem_set__(3,addr,v);
 		untyped __vmem_set__(3,addr,v);
 	}
 	}
 
 
-	public static inline function setDouble( addr : Int, v : Float ) {
+	public static inline function setDouble( addr : Int, v : Float ) : Void {
 		untyped __vmem_set__(4,addr,v);
 		untyped __vmem_set__(4,addr,v);
 	}
 	}
 
 

+ 11 - 5
typer.ml

@@ -279,14 +279,14 @@ let get_constructor c p =
 
 
 let make_call ctx e params t p =
 let make_call ctx e params t p =
 	try
 	try
-		if not ctx.g.doinline then raise Exit;
 		let ethis, fname = (match e.eexpr with TField (ethis,fname) -> ethis, fname | _ -> raise Exit) in
 		let ethis, fname = (match e.eexpr with TField (ethis,fname) -> ethis, fname | _ -> raise Exit) in
-		let f = (match follow ethis.etype with
-			| TInst (c,params) -> snd (try class_field c fname with Not_found -> raise Exit)
-			| TAnon a -> (try PMap.find fname a.a_fields with Not_found -> raise Exit)
+		let f, cl = (match follow ethis.etype with
+			| TInst (c,params) -> snd (try class_field c fname with Not_found -> raise Exit), Some c
+			| TAnon a -> (try PMap.find fname a.a_fields with Not_found -> raise Exit), (match !(a.a_status) with Statics c -> Some c | _ -> None)
 			| _ -> raise Exit
 			| _ -> raise Exit
 		) in
 		) in
 		if f.cf_kind <> Method MethInline then raise Exit;
 		if f.cf_kind <> Method MethInline then raise Exit;
+		if not ctx.g.doinline then (match cl with Some { cl_extern = true } -> () | _ -> raise Exit);
 		ignore(follow f.cf_type); (* force evaluation *)
 		ignore(follow f.cf_type); (* force evaluation *)
 		let params = List.map (Optimizer.reduce_expression ctx) params in
 		let params = List.map (Optimizer.reduce_expression ctx) params in
 		(match f.cf_expr with
 		(match f.cf_expr with
@@ -327,7 +327,13 @@ let rec acc_get ctx g p =
 		ignore(follow f.cf_type); (* force computing *)
 		ignore(follow f.cf_type); (* force computing *)
 		(match f.cf_expr with
 		(match f.cf_expr with
 		| None -> error "Recursive inline is not supported" p
 		| None -> error "Recursive inline is not supported" p
-		| Some { eexpr = TFunction _ } ->  mk (TClosure (e,f.cf_name)) t p
+		| Some { eexpr = TFunction _ } -> 
+			let chk_class c = if c.cl_extern then error "Can't create closure on an inline extern method" p in
+			(match follow e.etype with
+			| TInst (c,_) -> chk_class c
+			| TAnon a -> (match !(a.a_status) with Statics c -> chk_class c | _ -> ())
+			| _ -> ());
+			mk (TClosure (e,f.cf_name)) t p
 		| Some e ->
 		| Some e ->
 			let rec loop e = Type.map_expr loop { e with epos = p } in
 			let rec loop e = Type.map_expr loop { e with epos = p } in
 			loop e)
 			loop e)