Browse Source

added TClosure

Nicolas Cannasse 16 years ago
parent
commit
8eabe40525
15 changed files with 194 additions and 99 deletions
  1. 2 0
      doc/CHANGES.txt
  2. 2 1
      genas3.ml
  3. 3 0
      gencpp.ml
  4. 9 10
      genjs.ml
  5. 13 15
      genneko.ml
  6. 3 1
      genphp.ml
  7. 10 7
      genswf8.ml
  8. 5 4
      genswf9.ml
  9. 1 1
      genxml.ml
  10. 2 2
      std/flash/Boot.hx
  11. 65 0
      tests/unit/TestMisc.hx
  12. 13 5
      tests/unit/TestType.hx
  13. 9 1
      type.ml
  14. 2 2
      typeload.ml
  15. 55 50
      typer.ml

+ 2 - 0
doc/CHANGES.txt

@@ -28,6 +28,8 @@ TODO :
 	all : renamed haxe.Http.request to "requestUrl"
 	all : renamed haxe.Http.request to "requestUrl"
 	all : renamed neko.zip.Compress/Uncompress.run to "execute"
 	all : renamed neko.zip.Compress/Uncompress.run to "execute"
 	spod : fix very rare issue with relations and transactions
 	spod : fix very rare issue with relations and transactions
+	compiler : added TClosure - optimize closure creation and ease code generation
+	cpp : added CPP platform
 
 
 2009-03-22: 2.03
 2009-03-22: 2.03
 	optimized Type.enumEq : use index instead of tag comparison for neko/flash9/php
 	optimized Type.enumEq : use index instead of tag comparison for neko/flash9/php

+ 2 - 1
genas3.ml

@@ -471,7 +471,7 @@ and gen_expr ctx e =
 		gen_value_op ctx e2;
 		gen_value_op ctx e2;
 	| TField ({ eexpr = TTypeExpr t },s) when t_path t = ctx.curclass.cl_path && not (PMap.mem s ctx.locals) ->
 	| TField ({ eexpr = TTypeExpr t },s) when t_path t = ctx.curclass.cl_path && not (PMap.mem s ctx.locals) ->
 		print ctx "%s" (s_ident s)
 		print ctx "%s" (s_ident s)
-	| TField (e,s) ->
+	| TField (e,s) | TClosure (e,s) ->
    		gen_value ctx e;
    		gen_value ctx e;
 		gen_field_access ctx e.etype s
 		gen_field_access ctx e.etype s
 	| TTypeExpr t ->
 	| TTypeExpr t ->
@@ -736,6 +736,7 @@ and gen_value ctx e =
 	| TArray _
 	| TArray _
 	| TBinop _
 	| TBinop _
 	| TField _
 	| TField _
+	| TClosure _
 	| TTypeExpr _
 	| TTypeExpr _
 	| TParenthesis _
 	| TParenthesis _
 	| TObjectDecl _
 	| TObjectDecl _

+ 3 - 0
gencpp.ml

@@ -511,6 +511,7 @@ let debug_expression expression type_too =
 	| TArray (_,_) -> "TArray"
 	| TArray (_,_) -> "TArray"
 	| TBinop (_,_,_) -> "TBinop"
 	| TBinop (_,_,_) -> "TBinop"
 	| TField (_,_) -> "TField"
 	| TField (_,_) -> "TField"
+	| TClosure _ -> "TClosure"
 	| TTypeExpr _ -> "TTypeExpr"
 	| TTypeExpr _ -> "TTypeExpr"
 	| TParenthesis _ -> "TParenthesis"
 	| TParenthesis _ -> "TParenthesis"
 	| TObjectDecl _ -> "TObjectDecl"
 	| TObjectDecl _ -> "TObjectDecl"
@@ -558,6 +559,7 @@ let rec iter_retval f retval e =
 		f false e2;
 		f false e2;
 	| TThrow e
 	| TThrow e
 	| TField (e,_)
 	| TField (e,_)
+	| TClosure (e,_)
 	| TUnop (_,_,e) ->
 	| TUnop (_,_,e) ->
 		f true e
 		f true e
 	| TParenthesis e ->
 	| TParenthesis e ->
@@ -1145,6 +1147,7 @@ let rec gen_expression ctx retval expression =
 		end
 		end
 	(* Get precidence matching haxe ? *)
 	(* Get precidence matching haxe ? *)
 	| TBinop (op,expr1,expr2) -> gen_bin_op op expr1 expr2
 	| TBinop (op,expr1,expr2) -> gen_bin_op op expr1 expr2
+	| TClosure (expr,name)
 	| TField (expr,name) ->
 	| TField (expr,name) ->
 		gen_member_access expr name (is_function_member expression) expression.etype
 		gen_member_access expr name (is_function_member expression) expression.etype
 	| TParenthesis expr -> output "("; gen_expression ctx true expr; output ")"
 	| TParenthesis expr -> output "("; gen_expression ctx true expr; output ")"

+ 9 - 10
genjs.ml

@@ -229,16 +229,14 @@ and gen_expr ctx e =
 		print ctx " %s " (Ast.s_binop op);
 		print ctx " %s " (Ast.s_binop op);
 		gen_value_op ctx e2;
 		gen_value_op ctx e2;
 	| TField (x,s) ->
 	| TField (x,s) ->
-		(match follow e.etype with
-		| TFun _ ->
-			spr ctx "$closure(";
-			gen_value ctx x;
-			spr ctx ",";
-			gen_constant ctx e.epos (TString s);
-			spr ctx ")";
-		| _ ->
-			gen_value ctx x;
-			spr ctx (field s))
+		gen_value ctx x;
+		spr ctx (field s)
+	| TClosure (x,s) ->
+		spr ctx "$closure(";
+		gen_value ctx x;
+		spr ctx ",";
+		gen_constant ctx e.epos (TString s);
+		spr ctx ")";
 	| TTypeExpr t ->
 	| TTypeExpr t ->
 		spr ctx (s_path (t_path t))
 		spr ctx (s_path (t_path t))
 	| TParenthesis e ->
 	| TParenthesis e ->
@@ -512,6 +510,7 @@ and gen_value ctx e =
 	| TArray _
 	| TArray _
 	| TBinop _
 	| TBinop _
 	| TField _
 	| TField _
+	| TClosure _
 	| TTypeExpr _
 	| TTypeExpr _
 	| TParenthesis _
 	| TParenthesis _
 	| TObjectDecl _
 	| TObjectDecl _

+ 13 - 15
genneko.ml

@@ -233,19 +233,6 @@ and gen_call ctx p e el =
 		let e = (match gen_expr ctx e with EFunction _, _ as e -> (EBlock [e],p) | e -> e) in
 		let e = (match gen_expr ctx e with EFunction _, _ as e -> (EBlock [e],p) | e -> e) in
 		call p e (List.map (gen_expr ctx) el)
 		call p e (List.map (gen_expr ctx) el)
 
 
-and gen_closure p ep t e f =
-	match follow t with
-	| TFun (args,_) ->
-		let n = List.length args in
-		if n > 5 then error "Cannot create closure with more than 5 arguments" ep;
-		let tmp = ident p "@tmp" in
-		EBlock [
-			(EVars ["@tmp", Some e; "@fun", Some (field p tmp f)] , p);
-			call p (ident p ("@closure" ^ string_of_int n)) [tmp;ident p "@fun"]
-		] , p
-	| _ ->
-		field p e f
-
 and gen_expr ctx e =
 and gen_expr ctx e =
 	let p = pos ctx e.epos in
 	let p = pos ctx e.epos in
 	match e.eexpr with
 	match e.eexpr with
@@ -265,8 +252,19 @@ and gen_expr ctx e =
 		(EBinop ("=",field p (gen_expr ctx e1) f,gen_expr ctx e2),p)
 		(EBinop ("=",field p (gen_expr ctx e1) f,gen_expr ctx e2),p)
 	| TBinop (op,e1,e2) ->
 	| TBinop (op,e1,e2) ->
 		gen_binop ctx p op e1 e2
 		gen_binop ctx p op e1 e2
-	| TField (e2,f) ->
-		gen_closure p e.epos e.etype (gen_expr ctx e2) f
+	| TField (e,f) ->
+		field p (gen_expr ctx e) f
+	| TClosure (e2,f) ->
+		(match follow e.etype with
+		| TFun (args,_) ->
+			let n = List.length args in
+			if n > 5 then error "Cannot create closure with more than 5 arguments" e.epos;
+			let tmp = ident p "@tmp" in
+			EBlock [
+				(EVars ["@tmp", Some (gen_expr ctx e2); "@fun", Some (field p tmp f)] , p);
+				call p (ident p ("@closure" ^ string_of_int n)) [tmp;ident p "@fun"]
+			] , p
+		| _ -> assert false)
 	| TTypeExpr t ->
 	| TTypeExpr t ->
 		gen_type_path p (t_path t)
 		gen_type_path p (t_path t)
 	| TParenthesis e ->
 	| TParenthesis e ->

+ 3 - 1
genphp.ml

@@ -76,6 +76,7 @@ let s_expr_expr e =
 	| TArray (_,_) -> "TArray"
 	| TArray (_,_) -> "TArray"
 	| TBinop (_,_,_) -> "TBinop"
 	| TBinop (_,_,_) -> "TBinop"
 	| TField (_,_) -> "TField"
 	| TField (_,_) -> "TField"
+	| TClosure (_,_) -> "TClosure"
 	| TTypeExpr _ -> "TTypeExpr"
 	| TTypeExpr _ -> "TTypeExpr"
 	| TParenthesis _ -> "TParenthesis"
 	| TParenthesis _ -> "TParenthesis"
 	| TObjectDecl _ -> "TObjectDecl"
 	| TObjectDecl _ -> "TObjectDecl"
@@ -1034,7 +1035,7 @@ and gen_expr ctx e =
 			print ctx " %s " (Ast.s_binop op);
 			print ctx " %s " (Ast.s_binop op);
 			gen_value_op ctx e2;
 			gen_value_op ctx e2;
 		);
 		);
-	| TField (e1,s) ->
+	| TField (e1,s) | TClosure (e1,s) ->
 		(match follow e.etype with
 		(match follow e.etype with
 		| TFun (args, _) ->
 		| TFun (args, _) ->
 			let p = escphp ctx.quotes in
 			let p = escphp ctx.quotes in
@@ -1453,6 +1454,7 @@ and gen_value ctx e =
 	| TArray _
 	| TArray _
 	| TBinop _
 	| TBinop _
 	| TField _
 	| TField _
+	| TClosure _
 	| TParenthesis _
 	| TParenthesis _
 	| TObjectDecl _
 	| TObjectDecl _
 	| TArrayDecl _
 	| TArrayDecl _

+ 10 - 7
genswf8.ml

@@ -589,13 +589,15 @@ let rec gen_access ?(read_write=false) ctx forcall e =
 			write ctx ASwap;
 			write ctx ASwap;
 			push ctx [p];
 			push ctx [p];
 		end;
 		end;
-		(match follow e.etype with
-		| TFun _ -> VarClosure
-		| _ ->
-			if not !protect_all && Codegen.is_volatile e.etype then
-				VarVolatile
-			else
-				VarObj)
+		if not !protect_all && Codegen.is_volatile e.etype then
+			VarVolatile
+		else
+			VarObj
+	| TClosure (e,f) ->
+		gen_expr ctx true e;
+		if read_write then assert false;
+		push ctx [VStr (f,is_protected ctx e.etype f)];
+		VarClosure
 	| TArray (ea,eb) ->
 	| TArray (ea,eb) ->
 		if read_write then 
 		if read_write then 
 			try 
 			try 
@@ -958,6 +960,7 @@ and gen_expr_2 ctx retval e =
 	| TConst TSuper
 	| TConst TSuper
 	| TConst TThis
 	| TConst TThis
 	| TField _
 	| TField _
+	| TClosure _
 	| TArray _
 	| TArray _
 	| TLocal _
 	| TLocal _
 	| TTypeExpr _
 	| TTypeExpr _

+ 5 - 4
genswf9.ml

@@ -733,7 +733,7 @@ let gen_access ctx e (forset : 'a) : 'a access =
 	match e.eexpr with
 	match e.eexpr with
 	| TLocal i ->
 	| TLocal i ->
 		gen_local_access ctx i e.epos forset
 		gen_local_access ctx i e.epos forset
-	| TField (e1,f) ->
+	| TField (e1,f) | TClosure (e1,f) ->
 		let id, k, closure = property ctx f e1.etype in
 		let id, k, closure = property ctx f e1.etype in
 		if closure && not ctx.for_call then error "In Flash9, this method cannot be accessed this way : please define a local function" e1.epos;
 		if closure && not ctx.for_call then error "In Flash9, this method cannot be accessed this way : please define a local function" e1.epos;
 		(match e1.eexpr with
 		(match e1.eexpr with
@@ -897,6 +897,7 @@ let rec gen_expr_content ctx retval e =
 		ctx.infos.icond <- true;
 		ctx.infos.icond <- true;
 		no_value ctx retval
 		no_value ctx retval
 	| TField _
 	| TField _
+	| TClosure _
 	| TLocal _
 	| TLocal _
 	| TTypeExpr _ ->
 	| TTypeExpr _ ->
 		getvar ctx (gen_access ctx e Read)
 		getvar ctx (gen_access ctx e Read)
@@ -1586,7 +1587,7 @@ let generate_construct ctx fdata c =
 	(* --- *)
 	(* --- *)
 	PMap.iter (fun _ f ->
 	PMap.iter (fun _ f ->
 		match f.cf_expr with
 		match f.cf_expr with
-		| Some { eexpr = TFunction fdata } when f.cf_set = NormalAccess ->
+		| Some { eexpr = TFunction fdata } when f.cf_set = MethodDynamicAccess  ->
 			let id = ident f.cf_name in
 			let id = ident f.cf_name in
 			write ctx (HFindProp id);
 			write ctx (HFindProp id);
 			write ctx (HFunction (generate_method ctx fdata false));
 			write ctx (HFunction (generate_method ctx fdata false));
@@ -1622,7 +1623,7 @@ let generate_class_init ctx c hc =
 	write ctx (HClassDef hc);
 	write ctx (HClassDef hc);
 	List.iter (fun f ->
 	List.iter (fun f ->
 		match f.cf_expr with
 		match f.cf_expr with
-		| Some { eexpr = TFunction fdata } when f.cf_set = NormalAccess ->
+		| Some { eexpr = TFunction fdata } when f.cf_set = MethodDynamicAccess ->
 			write ctx HDup;
 			write ctx HDup;
 			write ctx (HFunction (generate_method ctx fdata true));
 			write ctx (HFunction (generate_method ctx fdata true));
 			write ctx (HInitProp (ident f.cf_name));
 			write ctx (HInitProp (ident f.cf_name));
@@ -1674,7 +1675,7 @@ let generate_field_kind ctx f c stat =
 			| Some (c,_) ->
 			| Some (c,_) ->
 				PMap.exists f.cf_name c.cl_fields || loop c
 				PMap.exists f.cf_name c.cl_fields || loop c
 		in
 		in
-		if f.cf_set = NormalAccess then
+		if f.cf_set = NormalAccess || f.cf_set = MethodDynamicAccess then
 			Some (HFVar {
 			Some (HFVar {
 				hlv_type = Some (type_path ctx ([],"Function"));
 				hlv_type = Some (type_path ctx ([],"Function"));
 				hlv_value = HVNone;
 				hlv_value = HVNone;

+ 1 - 1
genxml.ml

@@ -85,7 +85,7 @@ let gen_constr e =
 let gen_field att f =
 let gen_field att f =
 	let add_get_set acc name att =
 	let add_get_set acc name att =
 		match acc with
 		match acc with
-		| NormalAccess | ResolveAccess -> att
+		| NormalAccess | ResolveAccess | MethodDynamicAccess -> att
 		| NoAccess | NeverAccess -> (name, "null") :: att
 		| NoAccess | NeverAccess -> (name, "null") :: att
 		| MethodAccess m -> (name, if m = name ^ "_" ^ f.cf_name then "dynamic" else m) :: att
 		| MethodAccess m -> (name, if m = name ^ "_" ^ f.cf_name then "dynamic" else m) :: att
 		| MethodCantAccess -> att
 		| MethodCantAccess -> att

+ 2 - 2
std/flash/Boot.hx

@@ -265,8 +265,8 @@ class Boot {
 		current.flash.Lib._root = _root;
 		current.flash.Lib._root = _root;
 		current.flash.Lib.current = current;
 		current.flash.Lib.current = current;
 		// prevent closure creation by setting untyped
 		// prevent closure creation by setting untyped
-		current[__unprotect__("@instanceof")] = untyped __instanceof;
-		current[__unprotect__("@closure")] = untyped __closure;
+		current[__unprotect__("@instanceof")] = flash.Boot[__unprotect__("__instanceof")];
+		current[__unprotect__("@closure")] = flash.Boot[__unprotect__("__closure")];
 		// fix firefox default alignement
 		// fix firefox default alignement
 		if( _global["Stage"]["align"] == "" )
 		if( _global["Stage"]["align"] == "" )
 			_global["Stage"]["align"] = "LT";
 			_global["Stage"]["align"] = "LT";

+ 65 - 0
tests/unit/TestMisc.hx

@@ -1,5 +1,35 @@
 package unit;
 package unit;
 
 
+class MyDynamicClass {
+
+	var v : Int;
+
+	public function new(v) {
+		this.v = v;
+	}
+
+	public function get() {
+		return v;
+	}
+
+	public dynamic function add(x,y) {
+		return v + x + y;
+	}
+
+	public inline function iadd(x,y) {
+		return v + x + y;
+	}
+
+}
+
+class MyDynamicSubClass extends MyDynamicClass {
+
+	override function add(x,y) {
+		return (v + x + y) * 2;
+	}
+
+}
+
 class TestMisc extends Test {
 class TestMisc extends Test {
 
 
 	function testClosure() {
 	function testClosure() {
@@ -17,12 +47,47 @@ class TestMisc extends Test {
 
 
 		var o = { f : f };
 		var o = { f : f };
 		eq( o.f(), 5 );
 		eq( o.f(), 5 );
+		eq( o.f, o.f ); // we shouldn't create a new closure here
 
 
 		var o = { add : c.add };
 		var o = { add : c.add };
 		eq( o.add(1,2), 103 );
 		eq( o.add(1,2), 103 );
+		eq( o.add, o.add ); // we shouldn't create a new closure here
 
 
 		var o = { cos : Math.cos };
 		var o = { cos : Math.cos };
 		eq( o.cos(0), 1. );
 		eq( o.cos(0), 1. );
+
+		// check enum
+		var c = MyEnum.C;
+		t( Type.enumEq(MyEnum.C(1,"hello"), c(1,"hello")) );
+	}
+
+	function testInlineClosure() {
+		var inst = new MyDynamicClass(100);
+		var add = inst.iadd;
+		eq( inst.iadd(1,2), 103 );
+		eq( add(1,2), 103 );
+	}
+
+	function testDynamicClosure() {
+		var inst = new MyDynamicClass(100);
+		var add = inst.add;
+		eq( inst.add(1,2), 103 );
+		eq( callback(inst.add,1)(2), 103 );
+		eq( add(1,2), 103 );
+
+		// check overriden dynamic method
+		var inst = new MyDynamicSubClass(100);
+		var add = inst.add;
+		eq( inst.add(1,2), 206 );
+		eq( callback(inst.add,1)(2), 206 );
+		eq( add(1,2), 206 );
+
+		// check redefined dynamic method
+		inst.add = function(x,y) return inst.get() * 2 + x + y;
+		var add = inst.add;
+		eq( inst.add(1,2), 203 );
+		eq( callback(inst.add,1)(2), 203 );
+		eq( add(1,2), 203 );
 	}
 	}
 
 
 	function testMD5() {
 	function testMD5() {

+ 13 - 5
tests/unit/TestType.hx

@@ -3,19 +3,27 @@ import unit.MyEnum;
 
 
 class TestType extends Test {
 class TestType extends Test {
 
 
+	static inline function u( s : String ) : String {
+		#if flash
+		return untyped __unprotect__(s);
+		#else
+		return s;
+		#end
+	}
+
 	public function testType() {
 	public function testType() {
-		eq( Type.resolveClass("unit.MyClass"), unit.MyClass );
-		eq( Type.getClassName(unit.MyClass), "unit.MyClass" );
+		var name = u("unit")+"."+u("MyClass");
+		eq( Type.resolveClass(name), unit.MyClass );
+		eq( Type.getClassName(unit.MyClass), name );
 		eq( Type.getClassFields(unit.MyClass).length , 0 );
 		eq( Type.getClassFields(unit.MyClass).length , 0 );
 	}
 	}
 
 
-
 	public function testFields() {
 	public function testFields() {
 		var sfields = Type.getClassFields(unit.MySubClass);
 		var sfields = Type.getClassFields(unit.MySubClass);
 		eq( sfields.length , 1 );
 		eq( sfields.length , 1 );
-		eq( sfields[0], "XXX" );
+		eq( sfields[0], u("XXX") );
 
 
-		var fields = ["add","get","intValue","ref","set","stringValue","val"];
+		var fields = [u("add"),u("get"),u("intValue"),u("ref"),u("set"),u("stringValue"),u("val")];
 		var fl = Type.getInstanceFields(unit.MyClass);
 		var fl = Type.getInstanceFields(unit.MyClass);
 		fl.sort(Reflect.compare);
 		fl.sort(Reflect.compare);
 		eq( fl.join("|"), fields.join("|") );
 		eq( fl.join("|"), fields.join("|") );

+ 9 - 1
type.ml

@@ -26,6 +26,7 @@ type field_access =
 	| ResolveAccess
 	| ResolveAccess
 	| MethodAccess of string
 	| MethodAccess of string
 	| MethodCantAccess
 	| MethodCantAccess
+	| MethodDynamicAccess
 	| NeverAccess
 	| NeverAccess
 	| InlineAccess
 	| InlineAccess
 
 
@@ -75,6 +76,7 @@ and texpr_expr =
 	| TArray of texpr * texpr
 	| TArray of texpr * texpr
 	| TBinop of Ast.binop * texpr * texpr
 	| TBinop of Ast.binop * texpr * texpr
 	| TField of texpr * string
 	| TField of texpr * string
+	| TClosure of texpr * string
 	| TTypeExpr of module_type
 	| TTypeExpr of module_type
 	| TParenthesis of texpr
 	| TParenthesis of texpr
 	| TObjectDecl of (string * texpr) list
 	| TObjectDecl of (string * texpr) list
@@ -290,9 +292,10 @@ let s_access = function
 	| NoAccess -> "null"
 	| NoAccess -> "null"
 	| NeverAccess -> "never"
 	| NeverAccess -> "never"
 	| MethodAccess m -> m
 	| MethodAccess m -> m
-	| MethodCantAccess -> "dynamic"
+	| MethodCantAccess -> "default"
 	| ResolveAccess -> "resolve"
 	| ResolveAccess -> "resolve"
 	| InlineAccess -> "inline"
 	| InlineAccess -> "inline"
+	| MethodDynamicAccess -> "dynamic"
 
 
 let rec is_parent csup c =
 let rec is_parent csup c =
 	if c == csup then
 	if c == csup then
@@ -791,6 +794,7 @@ let iter f e =
 		f e2;
 		f e2;
 	| TThrow e
 	| TThrow e
 	| TField (e,_)
 	| TField (e,_)
+	| TClosure (e,_)
 	| TParenthesis e
 	| TParenthesis e
 	| TUnop (_,_,e) ->
 	| TUnop (_,_,e) ->
 		f e
 		f e
@@ -846,6 +850,8 @@ let map_expr f e =
 		{ e with eexpr = TThrow (f e1) }
 		{ e with eexpr = TThrow (f e1) }
 	| TField (e1,v) ->
 	| TField (e1,v) ->
 		{ e with eexpr = TField (f e1,v) }
 		{ e with eexpr = TField (f e1,v) }
+	| TClosure (e1,v) ->
+		{ e with eexpr = TClosure (f e1,v) }
 	| TParenthesis e1 ->
 	| TParenthesis e1 ->
 		{ e with eexpr = TParenthesis (f e1) }
 		{ e with eexpr = TParenthesis (f e1) }
 	| TUnop (op,pre,e1) ->
 	| TUnop (op,pre,e1) ->
@@ -896,6 +902,8 @@ let map_expr_type f ft e =
 		{ e with eexpr = TThrow (f e1); etype = ft e.etype }
 		{ e with eexpr = TThrow (f e1); etype = ft e.etype }
 	| TField (e1,v) ->
 	| TField (e1,v) ->
 		{ e with eexpr = TField (f e1,v); etype = ft e.etype }
 		{ e with eexpr = TField (f e1,v); etype = ft e.etype }
+	| TClosure (e1,v) ->
+		{ e with eexpr = TClosure (f e1,v); etype = ft e.etype }
 	| TParenthesis e1 ->
 	| TParenthesis e1 ->
 		{ e with eexpr = TParenthesis (f e1); etype = ft e.etype }
 		{ e with eexpr = TParenthesis (f e1); etype = ft e.etype }
 	| TUnop (op,pre,e1) ->
 	| TUnop (op,pre,e1) ->

+ 2 - 2
typeload.ml

@@ -616,7 +616,7 @@ let init_class ctx c p herits fields =
 			let stat = List.mem AStatic access in
 			let stat = List.mem AStatic access in
 			let inline = List.mem AInline access in
 			let inline = List.mem AInline access in
 			let parent = (if not stat then get_parent c name else None) in
 			let parent = (if not stat then get_parent c name else None) in
-			let dynamic = List.mem ADynamic access || (match parent with Some { cf_set = NormalAccess } -> true | _ -> false) in
+			let dynamic = List.mem ADynamic access || (match parent with Some { cf_set = MethodDynamicAccess } -> true | _ -> false) in
 			let ctx = { ctx with
 			let ctx = { ctx with
 				curclass = c;
 				curclass = c;
 				curmethod = name;
 				curmethod = name;
@@ -641,7 +641,7 @@ let init_class ctx c p herits fields =
 				cf_doc = doc;
 				cf_doc = doc;
 				cf_type = t;
 				cf_type = t;
 				cf_get = if inline then InlineAccess else NormalAccess;
 				cf_get = if inline then InlineAccess else NormalAccess;
-				cf_set = (if inline then NeverAccess else if dynamic then NormalAccess else MethodCantAccess);
+				cf_set = (if inline then NeverAccess else if dynamic then MethodDynamicAccess else MethodCantAccess);
 				cf_expr = None;
 				cf_expr = None;
 				cf_public = is_public access parent;
 				cf_public = is_public access parent;
 				cf_params = params;
 				cf_params = params;

+ 55 - 50
typer.ml

@@ -28,6 +28,11 @@ type switch_mode =
 	| CMatch of (tenum_field * (string option * t) list option)
 	| CMatch of (tenum_field * (string option * t) list option)
 	| CExpr of texpr
 	| CExpr of texpr
 
 
+type access_mode =
+	| MGet
+	| MSet
+	| MCall
+
 exception Display of t
 exception Display of t
 
 
 type access_kind =
 type access_kind =
@@ -206,7 +211,7 @@ let type_type ctx tpath p =
 				cf_public = true;
 				cf_public = true;
 				cf_type = f.ef_type;
 				cf_type = f.ef_type;
 				cf_get = NormalAccess;
 				cf_get = NormalAccess;
-				cf_set = NoAccess;
+				cf_set = (match follow f.ef_type with TFun _ -> MethodCantAccess | _ -> NoAccess);
 				cf_doc = None;
 				cf_doc = None;
 				cf_expr = None;
 				cf_expr = None;
 				cf_params = [];
 				cf_params = [];
@@ -263,13 +268,13 @@ let acc_get 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 (TField (e,f.cf_name)) t p
+		| Some { eexpr = TFunction _ } ->  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
 
 
-let field_access ctx get f t e p =
-	match if get then f.cf_get else f.cf_set with
+let field_access ctx mode f t e p =
+	match (match mode with MGet | MCall -> f.cf_get | MSet -> f.cf_set) with
 	| NoAccess ->
 	| NoAccess ->
 		let normal = AccExpr (mk (TField (e,f.cf_name)) t p) in
 		let normal = AccExpr (mk (TField (e,f.cf_name)) t p) in
 		(match follow e.etype with
 		(match follow e.etype with
@@ -282,16 +287,18 @@ let field_access ctx get f t e p =
 			if ctx.untyped then normal else AccNo f.cf_name)
 			if ctx.untyped then normal else AccNo f.cf_name)
 	| MethodCantAccess when not ctx.untyped ->
 	| MethodCantAccess when not ctx.untyped ->
 		error "Cannot rebind this method : please use 'dynamic' before method declaration" p
 		error "Cannot rebind this method : please use 'dynamic' before method declaration" p
-	| NormalAccess | MethodCantAccess ->
-		AccExpr (mk (TField (e,f.cf_name)) t p)
+	| NormalAccess | MethodCantAccess | MethodDynamicAccess ->
+		(match mode, f.cf_set with
+		| MGet, MethodCantAccess | MGet, MethodDynamicAccess -> AccExpr (mk (TClosure (e,f.cf_name)) t p)
+		| _ -> AccExpr (mk (TField (e,f.cf_name)) t p))	 
 	| MethodAccess m ->
 	| MethodAccess m ->
 		if m = ctx.curmethod && (match e.eexpr with TConst TThis -> true | TTypeExpr (TClassDecl c) when c == ctx.curclass -> true | _ -> false) then
 		if m = ctx.curmethod && (match e.eexpr with TConst TThis -> true | TTypeExpr (TClassDecl c) when c == ctx.curclass -> true | _ -> false) then
 			let prefix = if Common.defined ctx.com "as3" then "$" else "" in
 			let prefix = if Common.defined ctx.com "as3" then "$" else "" in
 			AccExpr (mk (TField (e,prefix ^ f.cf_name)) t p)
 			AccExpr (mk (TField (e,prefix ^ f.cf_name)) t p)
-		else if get then
-			AccExpr (mk (TCall (mk (TField (e,m)) (tfun [] t) p,[])) t p)
-		else
+		else if mode = MSet then
 			AccSet (e,m,t,f.cf_name)
 			AccSet (e,m,t,f.cf_name)
+		else
+			AccExpr (mk (TCall (mk (TField (e,m)) (tfun [] t) p,[])) t p)			
 	| ResolveAccess ->
 	| ResolveAccess ->
 		let fstring = mk (TConst (TString f.cf_name)) ctx.api.tstring p in
 		let fstring = mk (TConst (TString f.cf_name)) ctx.api.tstring p in
 		let tresolve = tfun [ctx.api.tstring] t in
 		let tresolve = tfun [ctx.api.tstring] t in
@@ -301,47 +308,45 @@ let field_access ctx get f t e p =
 	| InlineAccess ->
 	| InlineAccess ->
 		AccInline (e,f,t)
 		AccInline (e,f,t)
 
 
-let type_ident ctx i is_type p get =
+let type_ident ctx i is_type p mode =
 	match i with
 	match i with
 	| "true" ->
 	| "true" ->
-		if get then
+		if mode = MGet then
 			AccExpr (mk (TConst (TBool true)) ctx.api.tbool p)
 			AccExpr (mk (TConst (TBool true)) ctx.api.tbool p)
 		else
 		else
 			AccNo i
 			AccNo i
 	| "false" ->
 	| "false" ->
-		if get then
+		if mode = MGet then
 			AccExpr (mk (TConst (TBool false)) ctx.api.tbool p)
 			AccExpr (mk (TConst (TBool false)) ctx.api.tbool p)
 		else
 		else
 			AccNo i
 			AccNo i
 	| "this" ->
 	| "this" ->
 		if not ctx.untyped && ctx.in_static then error "Cannot access this from a static function" p;
 		if not ctx.untyped && ctx.in_static then error "Cannot access this from a static function" p;
-		if get then
+		if mode = MGet then
 			AccExpr (mk (TConst TThis) ctx.tthis p)
 			AccExpr (mk (TConst TThis) ctx.tthis p)
 		else
 		else
 			AccNo i
 			AccNo i
 	| "super" ->
 	| "super" ->
-		if not ctx.super_call then
-			AccNo i
-		else
 		let t = (match ctx.curclass.cl_super with
 		let t = (match ctx.curclass.cl_super with
-		| None -> error "Current class does not have a superclass" p
-		| Some (c,params) -> TInst(c,params)
+			| None -> error "Current class does not have a superclass" p
+			| Some (c,params) -> TInst(c,params)
 		) in
 		) in
 		if ctx.in_static then error "Cannot access super from a static function" p;
 		if ctx.in_static then error "Cannot access super from a static function" p;
-		ctx.super_call <- false;
-		if get then
-			AccExpr (mk (TConst TSuper) t p)
-		else
+		if mode = MSet || not ctx.super_call then
 			AccNo i
 			AccNo i
+		else begin
+			ctx.super_call <- false;
+			AccExpr (mk (TConst TSuper) t p)
+		end
 	| "null" ->
 	| "null" ->
-		if get then
+		if mode = MGet then
 			AccExpr (null (mk_mono()) p)
 			AccExpr (null (mk_mono()) p)
 		else
 		else
 			AccNo i
 			AccNo i
 	| "here" ->
 	| "here" ->
 		let infos = mk_infos ctx p [] in
 		let infos = mk_infos ctx p [] in
 		let e = type_expr ctx infos true in
 		let e = type_expr ctx infos true in
-		if get then
+		if mode = MGet then
 			AccExpr { e with etype = Typeload.load_normal_type ctx { tpackage = ["haxe"]; tname = "PosInfos"; tparams = [] } p false }
 			AccExpr { e with etype = Typeload.load_normal_type ctx { tpackage = ["haxe"]; tname = "PosInfos"; tparams = [] } p false }
 		else
 		else
 			AccNo i
 			AccNo i
@@ -353,12 +358,12 @@ let type_ident ctx i is_type p get =
 		(* member variable lookup *)
 		(* member variable lookup *)
 		if ctx.in_static then raise Not_found;
 		if ctx.in_static then raise Not_found;
 		let t , f = class_field ctx.curclass i in
 		let t , f = class_field ctx.curclass i in
-		field_access ctx get f t (mk (TConst TThis) ctx.tthis p) p
+		field_access ctx mode f t (mk (TConst TThis) ctx.tthis p) p
 	with Not_found -> try
 	with Not_found -> try
 		(* static variable lookup *)
 		(* static variable lookup *)
 		let f = PMap.find i ctx.curclass.cl_statics in
 		let f = PMap.find i ctx.curclass.cl_statics in
 		let e = type_type ctx ctx.curclass.cl_path p in
 		let e = type_type ctx ctx.curclass.cl_path p in
-		field_access ctx get f (field_type f) e p
+		field_access ctx mode f (field_type f) e p
 	with Not_found -> try
 	with Not_found -> try
 		(* lookup imported *)
 		(* lookup imported *)
 		let rec loop l =
 		let rec loop l =
@@ -377,10 +382,10 @@ let type_ident ctx i is_type p get =
 		in
 		in
 		let e = loop ctx.local_types in
 		let e = loop ctx.local_types in
 		check_locals_masking ctx e;
 		check_locals_masking ctx e;
-		if get then
-			AccExpr e
-		else
+		if mode = MSet then
 			AccNo i
 			AccNo i
+		else
+			AccExpr e
 	with Not_found -> try
 	with Not_found -> try
 		(* lookup type *)
 		(* lookup type *)
 		if not is_type then raise Not_found;
 		if not is_type then raise Not_found;
@@ -437,7 +442,7 @@ let type_matching ctx (enum,params) (e,p) ecases first_case =
 	| _ ->
 	| _ ->
 		invalid()
 		invalid()
 
 
-let type_field ctx e i p get =
+let type_field ctx e i p mode =
 	let no_field() =
 	let no_field() =
 		if not ctx.untyped then display_error ctx (s_type (print_context()) e.etype ^ " has no field " ^ i) p;
 		if not ctx.untyped then display_error ctx (s_type (print_context()) e.etype ^ " has no field " ^ i) p;
 		AccExpr (mk (TField (e,i)) (mk_mono()) p)
 		AccExpr (mk (TField (e,i)) (mk_mono()) p)
@@ -448,7 +453,7 @@ let type_field ctx e i p get =
 			match c.cl_dynamic with
 			match c.cl_dynamic with
 			| Some t ->
 			| Some t ->
 				let t = apply_params c.cl_types params t in
 				let t = apply_params c.cl_types params t in
-				if get && PMap.mem "resolve" c.cl_fields then
+				if mode = MGet && PMap.mem "resolve" c.cl_fields then
 					AccExpr (mk (TCall (mk (TField (e,"resolve")) (tfun [ctx.api.tstring] t) p,[Typeload.type_constant ctx (String i) p])) t p)
 					AccExpr (mk (TCall (mk (TField (e,"resolve")) (tfun [ctx.api.tstring] t) p,[Typeload.type_constant ctx (String i) p])) t p)
 				else
 				else
 					AccExpr (mk (TField (e,i)) t p)
 					AccExpr (mk (TField (e,i)) t p)
@@ -461,7 +466,7 @@ let type_field ctx e i p get =
 			let t , f = class_field c i in
 			let t , f = class_field c i in
 			if e.eexpr = TConst TSuper && f.cf_set = NormalAccess && Common.platform ctx.com Flash9 then error "Cannot access superclass variable for calling : needs to be a proper method" p;
 			if e.eexpr = TConst TSuper && f.cf_set = NormalAccess && Common.platform ctx.com Flash9 then error "Cannot access superclass variable for calling : needs to be a proper method" p;
 			if not f.cf_public && not (is_parent c ctx.curclass) && not ctx.untyped then display_error ctx ("Cannot access to private field " ^ i) p;
 			if not f.cf_public && not (is_parent c ctx.curclass) && not ctx.untyped then display_error ctx ("Cannot access to private field " ^ i) p;
-			field_access ctx get f (apply_params c.cl_types params t) e p
+			field_access ctx mode f (apply_params c.cl_types params t) e p
 		with Not_found -> try
 		with Not_found -> try
 			loop_dyn c params
 			loop_dyn c params
 		with Not_found ->
 		with Not_found ->
@@ -478,7 +483,7 @@ let type_field ctx e i p get =
 				| Statics c when is_parent c ctx.curclass -> ()
 				| Statics c when is_parent c ctx.curclass -> ()
 				| _ -> display_error ctx ("Cannot access to private field " ^ i) p
 				| _ -> display_error ctx ("Cannot access to private field " ^ i) p
 			end;
 			end;
-			field_access ctx get f (field_type f) e p
+			field_access ctx mode f (field_type f) e p
 		with Not_found ->
 		with Not_found ->
 			if is_closed a then
 			if is_closed a then
 				no_field()
 				no_field()
@@ -489,12 +494,12 @@ let type_field ctx e i p get =
 				cf_doc = None;
 				cf_doc = None;
 				cf_public = true;
 				cf_public = true;
 				cf_get = NormalAccess;
 				cf_get = NormalAccess;
-				cf_set = if get then NoAccess else NormalAccess;
+				cf_set = (match mode with MSet -> NormalAccess | MGet | MCall -> NoAccess);
 				cf_expr = None;
 				cf_expr = None;
 				cf_params = [];
 				cf_params = [];
 			} in
 			} in
 			a.a_fields <- PMap.add i f a.a_fields;
 			a.a_fields <- PMap.add i f a.a_fields;
-			field_access ctx get f (field_type f) e p
+			field_access ctx mode f (field_type f) e p
 		)
 		)
 	| TMono r ->
 	| TMono r ->
 		if ctx.untyped && Common.defined ctx.com "swf-mark" && Common.defined ctx.com "flash" then ctx.com.warning "Mark" p;
 		if ctx.untyped && Common.defined ctx.com "swf-mark" && Common.defined ctx.com "flash" then ctx.com.warning "Mark" p;
@@ -504,7 +509,7 @@ let type_field ctx e i p get =
 			cf_doc = None;
 			cf_doc = None;
 			cf_public = true;
 			cf_public = true;
 			cf_get = NormalAccess;
 			cf_get = NormalAccess;
-			cf_set = if get then NoAccess else NormalAccess;
+			cf_set = (match mode with MSet -> NormalAccess | MGet | MCall -> NoAccess);
 			cf_expr = None;
 			cf_expr = None;
 			cf_params = [];
 			cf_params = [];
 		} in
 		} in
@@ -512,7 +517,7 @@ let type_field ctx e i p get =
 		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
 		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
 		ctx.opened <- x :: ctx.opened;
 		ctx.opened <- x :: ctx.opened;
 		r := Some t;
 		r := Some t;
-		field_access ctx get f (field_type f) e p
+		field_access ctx mode f (field_type f) e p
 	| t ->
 	| t ->
 		no_field()
 		no_field()
 
 
@@ -563,7 +568,7 @@ let unify_int ctx e k =
 let rec type_binop ctx op e1 e2 p =
 let rec type_binop ctx op e1 e2 p =
 	match op with
 	match op with
 	| OpAssign ->
 	| OpAssign ->
-		let e1 = type_access ctx (fst e1) (snd e1) false in
+		let e1 = type_access ctx (fst e1) (snd e1) MSet in
 		let e2 = type_expr_with_type ctx e2 (match e1 with AccNo _ | AccInline _ -> None | AccExpr e | AccSet(e,_,_,_) -> Some e.etype) in
 		let e2 = type_expr_with_type ctx e2 (match e1 with AccNo _ | AccInline _ -> None | AccExpr e | AccSet(e,_,_,_) -> Some e.etype) in
 		(match e1 with
 		(match e1 with
 		| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
 		| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
@@ -582,7 +587,7 @@ let rec type_binop ctx op e1 e2 p =
 		| AccInline _ ->
 		| AccInline _ ->
 			assert false)
 			assert false)
 	| OpAssignOp op ->
 	| OpAssignOp op ->
-		(match type_access ctx (fst e1) (snd e1) false with
+		(match type_access ctx (fst e1) (snd e1) MSet with
 		| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
 		| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
 		| AccExpr e ->
 		| AccExpr e ->
 			let eop = type_binop ctx op e1 e2 p in
 			let eop = type_binop ctx op e1 e2 p in
@@ -748,7 +753,7 @@ let rec type_binop ctx op e1 e2 p =
 
 
 and type_unop ctx op flag e p =
 and type_unop ctx op flag e p =
 	let set = (op = Increment || op = Decrement) in
 	let set = (op = Increment || op = Decrement) in
-	let acc = type_access ctx (fst e) (snd e) (not set) in
+	let acc = type_access ctx (fst e) (snd e) (if set then MSet else MGet) in
 	let access e =
 	let access e =
 		let t = (match op with
 		let t = (match op with
 		| Not ->
 		| Not ->
@@ -818,7 +823,7 @@ and type_switch ctx e cases def need_val p =
 		| (EConst (Ident name),p) :: l
 		| (EConst (Ident name),p) :: l
 		| (EConst (Type name),p) :: l ->
 		| (EConst (Type name),p) :: l ->
 			(try
 			(try
-				let e = acc_get (type_ident ctx name false p true) p in
+				let e = acc_get (type_ident ctx name false p MGet) p in
 				(match e.eexpr with
 				(match e.eexpr with
 				| TEnumField (e,_) -> Some (e, List.map (fun _ -> mk_mono()) e.e_types)
 				| TEnumField (e,_) -> Some (e, List.map (fun _ -> mk_mono()) e.e_types)
 				| _ -> None)
 				| _ -> None)
@@ -957,17 +962,17 @@ and type_switch ctx e cases def need_val p =
 		let cases = List.map matchs cases in
 		let cases = List.map matchs cases in
 		mk (TMatch (e,(en,enparams),List.map indexes cases,def)) t p
 		mk (TMatch (e,(en,enparams),List.map indexes cases,def)) t p
 
 
-and type_access ctx e p get =
+and type_access ctx e p mode =
 	match e with
 	match e with
 	| EConst (Ident s) ->
 	| EConst (Ident s) ->
-		type_ident ctx s false p get
+		type_ident ctx s false p mode
 	| EConst (Type s) ->
 	| EConst (Type s) ->
-		type_ident ctx s true p get
+		type_ident ctx s true p mode
 	| EField _
 	| EField _
 	| EType _ ->
 	| EType _ ->
 		let fields path e =
 		let fields path e =
 			List.fold_left (fun e (f,_,p) ->
 			List.fold_left (fun e (f,_,p) ->
-				let e = acc_get (e true) p in
+				let e = acc_get (e MGet) p in
 				type_field ctx e f p
 				type_field ctx e f p
 			) e path
 			) e path
 		in
 		in
@@ -1027,7 +1032,7 @@ and type_access ctx e p get =
 			| _ ->
 			| _ ->
 				fields acc (type_access ctx (fst e) (snd e))
 				fields acc (type_access ctx (fst e) (snd e))
 		in
 		in
-		loop [] (e,p) get
+		loop [] (e,p) mode
 	| EArray (e1,e2) ->
 	| EArray (e1,e2) ->
 		let e1 = type_expr ctx e1 in
 		let e1 = type_expr ctx e1 in
 		let e2 = type_expr ctx e2 in
 		let e2 = type_expr ctx e2 in
@@ -1061,7 +1066,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 	| EArray _
 	| EArray _
 	| EConst (Ident _)
 	| EConst (Ident _)
 	| EConst (Type _) ->
 	| EConst (Type _) ->
-		acc_get (type_access ctx e p true) p
+		acc_get (type_access ctx e p MGet) p
 	| EConst (Regexp (r,opt)) ->
 	| EConst (Regexp (r,opt)) ->
 		let str = mk (TConst (TString r)) ctx.api.tstring p in
 		let str = mk (TConst (TString r)) ctx.api.tstring p in
 		let opt = mk (TConst (TString opt)) ctx.api.tstring p in
 		let opt = mk (TConst (TString opt)) ctx.api.tstring p in
@@ -1169,7 +1174,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 						unify_raise ctx e1.etype t e1.epos;
 						unify_raise ctx e1.etype t e1.epos;
 						e1
 						e1
 					with Error (Unify _,_) ->
 					with Error (Unify _,_) ->
-						let acc = acc_get (type_field ctx e1 "iterator" e1.epos true) e1.epos in
+						let acc = acc_get (type_field ctx e1 "iterator" e1.epos MCall) e1.epos in
 						match follow acc.etype with
 						match follow acc.etype with
 						| TFun ([],it) ->
 						| TFun ([],it) ->
 							unify ctx it t e1.epos;
 							unify ctx it t e1.epos;
@@ -1483,8 +1488,8 @@ and type_call ctx e el p =
 	| _ ->
 	| _ ->
 		(match e with
 		(match e with
 		| EField ((EConst (Ident "super"),_),_) , _ | EType ((EConst (Ident "super"),_),_) , _ -> ctx.super_call <- true
 		| EField ((EConst (Ident "super"),_),_) , _ | EType ((EConst (Ident "super"),_),_) , _ -> ctx.super_call <- true
-		| _ -> ());
-		match type_access ctx (fst e) (snd e) true with
+		| _ -> ());		
+		match type_access ctx (fst e) (snd e) MCall with
 		| AccInline (ethis,f,t) ->
 		| AccInline (ethis,f,t) ->
 			let params, tret = (match follow t with
 			let params, tret = (match follow t with
 				| TFun (args,r) -> unify_call_params ctx (Some f.cf_name) el args p true, r
 				| TFun (args,r) -> unify_call_params ctx (Some f.cf_name) el args p true, r