浏览代码

removed TClosure, added TField FClosure.
Closures on static fields are no longer created, generators can instead look at the cf_kind if necessary

Nicolas Cannasse 12 年之前
父节点
当前提交
6d0c95a8ec
共有 14 个文件被更改,包括 43 次插入88 次删除
  1. 1 1
      codegen.ml
  2. 0 13
      dce.ml
  3. 0 10
      genas3.ml
  4. 0 3
      gencpp.ml
  5. 8 19
      genjs.ml
  6. 4 6
      genneko.ml
  7. 0 3
      genphp.ml
  8. 5 6
      genswf8.ml
  9. 1 3
      genswf9.ml
  10. 0 1
      interp.ml
  11. 1 1
      matcher.ml
  12. 5 4
      optimizer.ml
  13. 2 10
      type.ml
  14. 16 8
      typer.ml

+ 1 - 1
codegen.ml

@@ -1588,7 +1588,7 @@ let rec constructor_side_effects e =
 	match e.eexpr with
 	| TBinop (op,_,_) when op <> OpAssign ->
 		true
-	| TUnop _ | TArray _ | TField _ | TCall _ | TNew _ | TFor _ | TWhile _ | TSwitch _ | TMatch _ | TReturn _ | TThrow _ | TClosure _ ->
+	| TUnop _ | TArray _ | TField _ | TCall _ | TNew _ | TFor _ | TWhile _ | TSwitch _ | TMatch _ | TReturn _ | TThrow _ ->
 		true
 	| TBinop _ | TTry _ | TIf _ | TBlock _ | TVars _
 	| TFunction _ | TArrayDecl _ | TObjectDecl _

+ 0 - 13
dce.ml

@@ -270,19 +270,6 @@ and expr dce e =
 	| TCall ({eexpr = TConst TSuper} as e,el) ->
 		mark_t dce e.etype;
 		List.iter (expr dce) el;
-	| TClosure(e,n) ->
-		(match follow e.etype with
-		| TInst(c,_) ->
-			mark_class dce c;
-			field dce c n false;
-		| TAnon a ->
-			(match !(a.a_status) with
-			| Statics c ->
-				mark_class dce c;
-				field dce c n true;
-			| _ -> ())
-		| _ -> ());
-		expr dce e;
 	| TField(e,n) ->
 		let n = field_name n in
 		(match follow e.etype with

+ 0 - 10
genas3.ml

@@ -558,7 +558,6 @@ and gen_expr ctx e =
 		gen_value_op ctx e2;
 	(* variable fields on interfaces are generated as (class["field"] as class) *)
 	| TField ({etype = TInst({cl_interface = true} as c,_)} as e,FInstance (_,{ cf_name = s }))
-	| TClosure ({etype = TInst({cl_interface = true} as c,_)} as e,s)
 		when (try (match (PMap.find s c.cl_fields).cf_kind with Var _ -> true | _ -> false) with Not_found -> false) ->
 		spr ctx "(";
 		gen_value ctx e;
@@ -569,17 +568,9 @@ and gen_expr ctx e =
 		gen_expr ctx e1;
 		spr ctx ")";
 		gen_field_access ctx e1.etype (field_name s)
-	| TClosure({eexpr = TArrayDecl _} as e1,s) ->
-		spr ctx "(";
-		gen_expr ctx e1;
-		spr ctx ")";
-		gen_field_access ctx e1.etype s
 	| TField (e,s) ->
    		gen_value ctx e;
 		gen_field_access ctx e.etype (field_name s)
-	| TClosure (e,s) ->
-   		gen_value ctx e;
-		gen_field_access ctx e.etype s
 	| TTypeExpr t ->
 		spr ctx (s_path ctx true (t_path t) e.epos)
 	| TParenthesis e ->
@@ -855,7 +846,6 @@ and gen_value ctx e =
 	| TArray _
 	| TBinop _
 	| TField _
-	| TClosure _
 	| TTypeExpr _
 	| TParenthesis _
 	| TObjectDecl _

+ 0 - 3
gencpp.ml

@@ -686,7 +686,6 @@ let rec iter_retval f retval e =
 		f false e2;
 	| TThrow e
 	| TField (e,_)
-	| TClosure (e,_)
 	| TUnop (_,_,e) ->
 		f true e
 	| TParenthesis e ->
@@ -1488,8 +1487,6 @@ and gen_expression ctx retval expression =
 	| TBinop (op,expr1,expr2) -> gen_bin_op op expr1 expr2
 	| TField (expr,name) when (is_null expr) -> output "Dynamic()"
 
-	| TClosure (field_object,member) ->
-		gen_field field_object member
 	| TField (field_object,field) ->
 		gen_field field_object (field_name field)
 

+ 8 - 19
genjs.ml

@@ -307,7 +307,6 @@ let is_dynamic_iterator ctx e =
 		has_feature ctx "HxOverrides.iter" && (match follow x.etype with TInst ({ cl_path = [],"Array" },_) | TAnon _ | TDynamic _ | TMono _ -> true | _ -> false)
 	in
 	match e.eexpr with
-	| TClosure (x,"iterator") -> check x
 	| TField (x,f) when field_name f = "iterator" -> check x
 	| _ ->
 		false
@@ -424,37 +423,28 @@ and gen_expr ctx e =
 		gen_value ctx e1;
 		print ctx " %s " (Ast.s_binop op);
 		gen_value ctx e2;
-	| TClosure (x,"iterator") ->
-		add_feature ctx "use.$iterator";
-		print ctx "$iterator(";
-		gen_value ctx x;
-		print ctx ")";
 	| TField (x,f) when field_name f = "iterator" && is_dynamic_iterator ctx e ->
 		add_feature ctx "use.$iterator";
 		print ctx "$iterator(";
 		gen_value ctx x;
 		print ctx ")";
-	| TField (x,f) ->
-		gen_value ctx x;
-		let name = field_name f in
-		spr ctx (match f with FStatic _ -> static_field name | FInstance _ | FAnon _ | FDynamic _ -> field name)
-	| TClosure ({ eexpr = TTypeExpr _ } as x,s) ->
-		gen_value ctx x;
-		spr ctx (static_field s)
-	| TClosure (x,s) ->
+	| TField (x,FClosure (_,f)) ->
 		add_feature ctx "use.$bind";
-		let field = (match follow x.etype with TAnon { a_status = { contents = (Statics _ | EnumStatics _) } } -> static_field s | _ -> field s) in
 		(match x.eexpr with
 		| TConst _ | TLocal _ ->
 			print ctx "$bind(";
 			gen_value ctx x;
 			print ctx ",";
 			gen_value ctx x;
-			print ctx "%s)" field
+			print ctx "%s)" (field f.cf_name)
 		| _ ->
 			print ctx "($_=";
 			gen_value ctx x;
-			print ctx ",$bind($_,$_%s))" field)
+			print ctx ",$bind($_,$_%s))" (field f.cf_name))
+	| TField (x,f) ->
+		gen_value ctx x;
+		let name = field_name f in
+		spr ctx (match f with FStatic _ -> static_field name | FInstance _ | FAnon _ | FDynamic _ | FClosure _ -> field name)
 	| TTypeExpr t ->
 		spr ctx (ctx.type_accessor t)
 	| TParenthesis e ->
@@ -787,7 +777,6 @@ and gen_value ctx e =
 	| TArray _
 	| TBinop _
 	| TField _
-	| TClosure _
 	| TTypeExpr _
 	| TParenthesis _
 	| TObjectDecl _
@@ -1167,7 +1156,7 @@ let generate com =
 	let rec chk_features e =
 		if is_dynamic_iterator ctx e then add_feature ctx "use.$iterator";
 		match e.eexpr with
-		| TClosure _ ->
+		| TField (_,FClosure _) ->
 			add_feature ctx "use.$bind"
 		| _ ->
 			Type.iter chk_features e

+ 4 - 6
genneko.ml

@@ -226,24 +226,22 @@ and gen_expr ctx e =
 		(EBinop ("=",field p (gen_expr ctx e1) (field_name f),gen_expr ctx e2),p)
 	| TBinop (op,e1,e2) ->
 		gen_binop ctx p op e1 e2
-	| TField (e,f) ->
-		field p (gen_expr ctx e) (field_name f)
-	| TClosure (({ eexpr = TTypeExpr _ } as e),f) ->
-		field p (gen_expr ctx e) f
-	| TClosure (e2,f) ->
+	| TField (e2,FClosure (_,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);
+				(EVars ["@tmp", Some (gen_expr ctx e2); "@fun", Some (field p tmp f.cf_name)] , p);
 				if ctx.macros then
 					call p (builtin p "closure") [ident p "@fun";tmp]
 				else
 					call p (ident p ("@closure" ^ string_of_int n)) [tmp;ident p "@fun"]
 			] , p
 		| _ -> assert false)
+	| TField (e,f) ->
+		field p (gen_expr ctx e) (field_name f)
 	| TTypeExpr t ->
 		gen_type_path p (t_path t)
 	| TParenthesis e ->

+ 0 - 3
genphp.ml

@@ -1189,8 +1189,6 @@ and gen_expr ctx e =
 		));
 	| TField (e1,s) ->
 		gen_tfield ctx e e1 (field_name s)
-	| TClosure (e1,s) ->
-		gen_tfield ctx e e1 s
 	| TTypeExpr t ->
 		print ctx "_hx_qtype(\"%s\")" (s_path_haxe (t_path t))
 	| TParenthesis e ->
@@ -1739,7 +1737,6 @@ and gen_value ctx e =
 	| TArray _
 	| TBinop _
 	| TField _
-	| TClosure _
 	| TParenthesis _
 	| TObjectDecl _
 	| TArrayDecl _

+ 5 - 6
genswf8.ml

@@ -579,6 +579,11 @@ let rec gen_access ?(read_write=false) ctx forcall e =
 		VarStr
 	| TLocal v ->
 		access_local ctx v.v_name
+	| TField (e,FClosure (_,{ cf_name = f })) ->
+		gen_expr ctx true e;
+		if read_write then assert false;
+		push ctx [VStr (f,is_protected ctx e.etype f)];
+		VarClosure
 	| TField (e2,f) ->
 		gen_expr ctx true e2;
 		if read_write then write ctx ADup;
@@ -593,11 +598,6 @@ let rec gen_access ?(read_write=false) ctx forcall e =
 			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) ->
 		if read_write then
 			try
@@ -973,7 +973,6 @@ and gen_expr_2 ctx retval e =
 	| TConst TSuper
 	| TConst TThis
 	| TField _
-	| TClosure _
 	| TArray _
 	| TLocal _
 	| TTypeExpr _

+ 1 - 3
genswf9.ml

@@ -846,8 +846,7 @@ let rec gen_access ctx e (forset : 'a) : 'a access =
 	| TLocal v ->
 		gen_local_access ctx v e.epos forset
 	| TField (e1,f) ->
-		gen_access ctx { e with eexpr = TClosure (e1,field_name f) } forset
-	| TClosure (e1,f) ->
+		let f = field_name f 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;
 		(match e1.eexpr with
@@ -1021,7 +1020,6 @@ let rec gen_expr_content ctx retval e =
 		ctx.infos.icond <- true;
 		no_value ctx retval
 	| TField _
-	| TClosure _
 	| TLocal _
 	| TTypeExpr _ ->
 		getvar ctx (gen_access ctx e Read)

+ 0 - 1
interp.ml

@@ -4361,7 +4361,6 @@ let rec make_ast e =
 	| TArray (e1,e2) -> EArray (make_ast e1,make_ast e2)
 	| TBinop (op,e1,e2) -> EBinop (op, make_ast e1, make_ast e2)
 	| TField (e,f) -> EField (make_ast e, Type.field_name f)
-	| TClosure (e,f) -> EField (make_ast e, f)
 	| TTypeExpr t -> fst (mk_path (t_path t) e.epos)
 	| TParenthesis e -> EParenthesis (make_ast e)
 	| TObjectDecl fl -> EObjectDecl (List.map (fun (f,e) -> f, make_ast e) fl)

+ 1 - 1
matcher.ml

@@ -285,7 +285,7 @@ let to_pattern mctx e st =
 			| TFun(_,TEnum(en,pl)) ->
 				let ef = match ec.eexpr with
 					| TEnumField(_,s)
-					| TClosure ({ eexpr = TTypeExpr (TEnumDecl _) },s) -> PMap.find s en.e_constrs
+					| TField({ eexpr = TTypeExpr (TEnumDecl _) },FClosure (_,{ cf_name = s })) -> PMap.find s en.e_constrs
 					| _ -> error ("Expected constructor for enum " ^ (s_type_path en.e_path)) p
 				in
 				let mono_map,monos,tpl = List.fold_left (fun (mm,ml,tpl) (n,t) ->

+ 5 - 4
optimizer.ml

@@ -28,7 +28,7 @@ let has_side_effect e =
 	let rec loop e =
 		match e.eexpr with
 		| TConst _ | TLocal _ | TEnumField _ | TTypeExpr _ | TFunction _ -> ()
-		| TMatch _ | TNew _ | TCall _ | TClosure _ | TField _ | TArray _ | TBinop ((OpAssignOp _ | OpAssign),_,_) | TUnop ((Increment|Decrement),_,_) -> raise Exit
+		| TMatch _ | TNew _ | TCall _ | TField _ | TArray _ | TBinop ((OpAssignOp _ | OpAssign),_,_) | TUnop ((Increment|Decrement),_,_) -> raise Exit
 		| TReturn _ | TBreak | TContinue | TThrow _ | TCast (_,Some _) -> raise Exit
 		| TCast (_,None) | TBinop _ | TUnop _ | TParenthesis _ | TWhile _ | TFor _ | TIf _ | TTry _ | TSwitch _ | TArrayDecl _ | TVars _ | TBlock _ | TObjectDecl _ -> Type.iter loop e
 	in
@@ -543,7 +543,7 @@ let standard_precedence op =
 
 let rec need_parent e =
 	match e.eexpr with
-	| TConst _ | TLocal _ | TEnumField _ | TArray _ | TField _ | TParenthesis _ | TCall _ | TClosure _ | TNew _ | TTypeExpr _ | TObjectDecl _ | TArrayDecl _ -> false
+	| TConst _ | TLocal _ | TEnumField _ | TArray _ | TField _ | TParenthesis _ | TCall _ | TNew _ | TTypeExpr _ | TObjectDecl _ | TArrayDecl _ -> false
 	| TCast (e,None) -> need_parent e
 	| TCast _ | TThrow _ | TReturn _ | TTry _ | TMatch _ | TSwitch _ | TFor _ | TIf _ | TWhile _ | TBinop _ | TContinue | TBreak
 	| TBlock _ | TVars _ | TFunction _ | TUnop _ -> true
@@ -884,8 +884,9 @@ let rec reduce_loop ctx e =
 		(match inl with
 		| None -> reduce_expr ctx e
 		| Some e -> reduce_loop ctx e)
-	| TCall ({ eexpr = TClosure (o,name) } as f,el) ->
-		{ e with eexpr = TCall ({ f with eexpr = TField (o,try quick_field o.etype name with Not_found -> assert false) },el) }
+	| TCall ({ eexpr = TField (o,FClosure (c,cf)) } as f,el) ->
+		let fmode = (match c with None -> FAnon cf | Some c -> FInstance (c,cf)) in
+		{ e with eexpr = TCall ({ f with eexpr = TField (o,fmode) },el) }
 	| _ ->
 		reduce_expr ctx e)
 

+ 2 - 10
type.ml

@@ -102,7 +102,6 @@ and texpr_expr =
 	| TArray of texpr * texpr
 	| TBinop of Ast.binop * texpr * texpr
 	| TField of texpr * tfield_access
-	| TClosure of texpr * string
 	| TTypeExpr of module_type
 	| TParenthesis of texpr
 	| TObjectDecl of (string * texpr) list
@@ -130,6 +129,7 @@ and tfield_access =
 	| FStatic of tclass * tclass_field
 	| FAnon of tclass_field
 	| FDynamic of string
+	| FClosure of tclass option * tclass_field (* None class = TAnon *)
 
 and texpr = {
 	eexpr : texpr_expr;
@@ -307,7 +307,7 @@ let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
 
 let field_name f =
 	match f with
-	| FAnon f | FInstance (_,f) | FStatic (_,f) -> f.cf_name
+	| FAnon f | FInstance (_,f) | FStatic (_,f) | FClosure (_,f) -> f.cf_name
 	| FDynamic n -> n
 
 let mk_class m path pos =
@@ -1190,7 +1190,6 @@ let iter f e =
 		f e2;
 	| TThrow e
 	| TField (e,_)
-	| TClosure (e,_)
 	| TParenthesis e
 	| TCast (e,_)
 	| TUnop (_,_,e) ->
@@ -1247,8 +1246,6 @@ let map_expr f e =
 		{ e with eexpr = TThrow (f e1) }
 	| TField (e1,v) ->
 		{ e with eexpr = TField (f e1,v) }
-	| TClosure (e1,v) ->
-		{ e with eexpr = TClosure (f e1,v) }
 	| TParenthesis e1 ->
 		{ e with eexpr = TParenthesis (f e1) }
 	| TUnop (op,pre,e1) ->
@@ -1302,8 +1299,6 @@ let map_expr_type f ft fv e =
 		{ e with eexpr = TThrow (f e1); etype = ft e.etype }
 	| TField (e1,v) ->
 		{ 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 ->
 		{ e with eexpr = TParenthesis (f e1); etype = ft e.etype }
 	| TUnop (op,pre,e1) ->
@@ -1358,7 +1353,6 @@ let s_expr_kind e =
 	| TArray (_,_) -> "Array"
 	| TBinop (_,_,_) -> "Binop"
 	| TField (_,_) -> "Field"
-	| TClosure _ -> "Closure"
 	| TTypeExpr _ -> "TypeExpr"
 	| TParenthesis _ -> "Parenthesis"
 	| TObjectDecl _ -> "ObjectDecl"
@@ -1408,8 +1402,6 @@ let rec s_expr s_type e =
 		sprintf "(%s %s %s)" (loop e1) (s_binop op) (loop e2)
 	| TField (e,f) ->
 		sprintf "%s.%s" (loop e) (field_name f)
-	| TClosure (e,s) ->
-		sprintf "Closure (%s,%s)" (loop e) s
 	| TTypeExpr m ->
 		sprintf "TypeExpr %s" (s_type_path (t_path m))
 	| TParenthesis e ->

+ 16 - 8
typer.ml

@@ -592,12 +592,14 @@ let rec acc_get ctx g p =
 			}) twrap p in
 			make_call ctx ewrap [e] tcallb p
 		| _ -> assert false)
-	| AKInline (e,f,_,t) ->
+	| AKInline (e,f,fmode,t) ->
+		(* do not create a closure for static calls *)
+		let cmode = (match fmode with FStatic _ -> fmode | FInstance (c,f) -> FClosure (Some c,f) | _ -> assert false) in
 		ignore(follow f.cf_type); (* force computing *)
 		(match f.cf_expr with
 		| None ->
 			if ctx.com.display then
-				mk (TClosure (e,f.cf_name)) t p
+				mk (TField (e,cmode)) t p
 			else
 				error "Recursive inline is not supported" p
 		| Some { eexpr = TFunction _ } ->
@@ -606,7 +608,7 @@ let rec acc_get ctx g p =
 			| 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
+			mk (TField (e,cmode)) t p
 		| Some e ->
 			let rec loop e = Type.map_expr loop { e with epos = p } in
 			loop e)
@@ -644,7 +646,13 @@ let field_access ctx mode f fmode t e p =
 		| MethMacro, MGet -> display_error ctx "Macro functions must be called immediately" p; normal()
 		| MethMacro, MCall -> AKMacro (e,f)
 		| _ , MGet ->
-			AKExpr (mk (TClosure (e,f.cf_name)) t p)
+			let cmode = (match fmode with
+				| FInstance (c,cf) -> FClosure (Some c,cf)
+				| FStatic _ -> fmode
+				| FAnon f -> FClosure (None, f)
+				| FDynamic _ | FClosure _ -> assert false
+			) in
+			AKExpr (mk (TField (e,cmode)) t p)
 		| _ -> normal())
 	| Var v ->
 		match (match mode with MGet | MCall -> v.v_read | MSet -> v.v_write) with
@@ -673,7 +681,7 @@ let field_access ctx mode f fmode t e p =
 				| _ -> false
 			in
 			if mode = MGet && is_maybe_method() then
-				AKExpr (mk (TClosure (e,f.cf_name)) t p)
+				AKExpr (mk (TField (e,FClosure (None,f))) t p)
 			else
 				normal()
 		| AccCall m ->
@@ -1183,7 +1191,7 @@ let rec type_binop ctx op e1 e2 p =
 			let std = type_type ctx ([],"Std") e.epos in
 			let acc = acc_get ctx (type_field ctx std "string" e.epos MCall) e.epos in
 			ignore(follow acc.etype);
-			let acc = (match acc.eexpr with TClosure (e,f) -> { acc with eexpr = TField (e,FDynamic f) } | _ -> acc) in
+			let acc = (match acc.eexpr with TField (e,FClosure (Some c,f)) -> { acc with eexpr = TField (e,FInstance (c,f)) } | _ -> acc) in
 			make_call ctx acc [e] ctx.t.tstring e.epos
 		| KInt | KFloat | KString -> e
 	in
@@ -1481,7 +1489,7 @@ and type_switch_old ctx e cases def need_val with_type p =
 				| _ -> raise Exit
 			) pl in
 			(match e.eexpr with
-			| TEnumField (en,s) | TClosure ({ eexpr = TTypeExpr (TEnumDecl en) },s) -> type_match e en s pl
+			| TEnumField (en,s) -> type_match e en s pl
 			| _ -> if pl = [] then case_expr e else raise Exit)
 		with Exit ->
 			case_expr (type_expr ctx efull)
@@ -2143,7 +2151,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 						e1
 					with Error (Unify _,_) ->
 						let acc = acc_get ctx (type_field ctx e1 "iterator" e1.epos MCall) e1.epos in
-						let acc = (match acc.eexpr with TClosure (e,f) -> { acc with eexpr = TField (e,FDynamic f) } | _ -> acc) in
+						let acc = (match acc.eexpr with TField (e,FClosure (c,f)) -> { acc with eexpr = TField (e,match c with None -> FAnon f | Some c -> FInstance (c,f)) } | _ -> acc) in
 						match follow acc.etype with
 						| TFun ([],it) ->
 							unify ctx it t e1.epos;