瀏覽代碼

move filter code from codegen to filters module

Simon Krajewski 12 年之前
父節點
當前提交
cfcb3d710e
共有 3 個文件被更改,包括 1010 次插入998 次删除
  1. 1 1
      Makefile
  2. 0 984
      codegen.ml
  3. 1009 13
      filters.ml

+ 1 - 1
Makefile

@@ -108,7 +108,7 @@ common.cmx: type.cmx ast.cmx
 
 dce.cmx: ast.cmx common.cmx codegen.cmx type.cmx
 
-filters.cmx: ast.cmx common.cmx type.cmx dce.cmx
+filters.cmx: ast.cmx common.cmx type.cmx dce.cmx codegen.cmx typecore.cmx
 
 genas3.cmx: type.cmx common.cmx codegen.cmx ast.cmx
 

+ 0 - 984
codegen.ml

@@ -586,231 +586,6 @@ let on_inherit ctx c p h =
 	| _ ->
 		true
 
-(* -------------------------------------------------------------------------- *)
-(* FINAL GENERATION *)
-
-(* Saves a class state so it can be restored later, e.g. after DCE or native path rewrite *)
-let save_class_state ctx t = match t with
-	| TClassDecl c ->
-		let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern in
-		let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
-		let cst = c.cl_constructor and over = c.cl_overrides in
-		let oflk = List.map (fun f -> f.cf_kind,f.cf_expr,f.cf_type) ofl in
-		let ostk = List.map (fun f -> f.cf_kind,f.cf_expr,f.cf_type) ost in
-		c.cl_restore <- (fun() ->
-			c.cl_meta <- meta;
-			c.cl_extern <- ext;
-			c.cl_path <- path;
-			c.cl_fields <- fl;
-			c.cl_ordered_fields <- ofl;
-			c.cl_statics <- st;
-			c.cl_ordered_statics <- ost;
-			c.cl_constructor <- cst;
-			c.cl_overrides <- over;
-			(* DCE might modify the cf_kind, so let's restore it as well *)
-			List.iter2 (fun f (k,e,t) -> f.cf_kind <- k; f.cf_expr <- e; f.cf_type <- t;) ofl oflk;
-			List.iter2 (fun f (k,e,t) -> f.cf_kind <- k; f.cf_expr <- e; f.cf_type <- t;) ost ostk;
-		)
-	| _ ->
-		()
-
-
-(* Checks if a private class' path clashes with another path *)
-let check_private_path ctx t = match t with
-	| TClassDecl c when c.cl_private ->
-		let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
-		if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
-	| _ ->
-		()
-
-(* Removes generic base classes *)
-
-let is_removable_class c = c.cl_kind = KGeneric && (has_ctor_constraint c || Meta.has Meta.Remove c.cl_meta)
-
-let remove_generic_base ctx t = match t with
-	| TClassDecl c when is_removable_class c ->
-		c.cl_extern <- true
-	| _ ->
-		()
-
-(* Rewrites class or enum paths if @:native metadata is set *)
-let apply_native_paths ctx t =
-	let get_real_path meta path =
-		let (_,e,mp) = Meta.get Meta.Native meta in
-		match e with
-		| [Ast.EConst (Ast.String name),p] ->
-			(Meta.RealPath,[Ast.EConst (Ast.String (s_type_path path)),p],mp),parse_path name
-		| _ ->
-			error "String expected" mp
-	in
-	try
-		(match t with
-		| TClassDecl c ->
-			let meta,path = get_real_path c.cl_meta c.cl_path in
-			c.cl_meta <- meta :: c.cl_meta;
-			c.cl_path <- path;
-		| TEnumDecl e ->
-			let meta,path = get_real_path e.e_meta e.e_path in
-			e.e_meta <- meta :: e.e_meta;
-			e.e_path <- path;
-		| TAbstractDecl a ->
-			let meta,path = get_real_path a.a_meta a.a_path in
-			a.a_meta <- meta :: a.a_meta;
-			a.a_path <- path;
-		| _ ->
-			())
-	with Not_found ->
-		()
-
-(* Adds the __rtti field if required *)
-let add_rtti ctx t =
-	let rec has_rtti c =
-		Meta.has Meta.Rtti c.cl_meta || match c.cl_super with None -> false | Some (csup,_) -> has_rtti csup
-	in
-	match t with
-	| TClassDecl c when has_rtti c && not (PMap.mem "__rtti" c.cl_statics) ->
-		let f = mk_field "__rtti" ctx.t.tstring c.cl_pos in
-		let str = Genxml.gen_type_string ctx.com t in
-		f.cf_expr <- Some (mk (TConst (TString str)) f.cf_type c.cl_pos);
-		c.cl_ordered_statics <- f :: c.cl_ordered_statics;
-		c.cl_statics <- PMap.add f.cf_name f c.cl_statics;
-	| _ ->
-		()
-
-(* Removes extern and macro fields, also checks for Void fields *)
-
-let is_removable_field ctx f =
-	Meta.has Meta.Extern f.cf_meta || Meta.has Meta.Generic f.cf_meta
-	|| (match f.cf_kind with
-		| Var {v_read = AccRequire (s,_)} -> true
-		| Method MethMacro -> not ctx.in_macro
-		| _ -> false)
-
-let remove_extern_fields ctx t = match t with
-	| TClassDecl c ->
-		if not (Common.defined ctx.com Define.DocGen) then begin
-			c.cl_ordered_fields <- List.filter (fun f ->
-				let b = is_removable_field ctx f in
-				if b then c.cl_fields <- PMap.remove f.cf_name c.cl_fields;
-				not b
-			) c.cl_ordered_fields;
-			c.cl_ordered_statics <- List.filter (fun f ->
-				let b = is_removable_field ctx f in
-				if b then c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
-				not b
-			) c.cl_ordered_statics;
-		end
-	| _ ->
-		()
-
-(* Adds member field initializations as assignments to the constructor *)
-let add_field_inits ctx t =
-	let apply 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 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 _ ->
-				if ctx.com.config.pf_can_init_member cf then (inits, cf :: fields) else (cf :: inits, cf :: fields)
-			| Method MethDynamic, Some e when Common.defined ctx.com Define.As3 ->
-				(* TODO : this would have a better place in genSWF9 I think - NC *)
-				(* 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 cf2 = {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.memq cf c.cl_overrides then begin
-					c.cl_fields <- PMap.remove cf.cf_name c.cl_fields;
-					fields
-				end else
-					cf2 :: fields
-				in
-				(cf2 :: inits, fields)
-			| _ -> (inits, cf :: fields)
-		) ([],[]) c.cl_ordered_fields in
-		c.cl_ordered_fields <- (List.rev fields);
-		match inits with
-		| [] -> ()
-		| _ ->
-			let el = List.map (fun cf ->
-				match cf.cf_expr with
-				| None -> assert false
-				| Some e ->
-					let lhs = mk (TField(ethis,FInstance (c,cf))) cf.cf_type e.epos in
-					cf.cf_expr <- None;
-					let eassign = mk (TBinop(OpAssign,lhs,e)) e.etype e.epos in
-					if Common.defined ctx.com Define.As3 then begin
-						let echeck = mk (TBinop(OpEq,lhs,(mk (TConst TNull) lhs.etype e.epos))) ctx.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([],ctx.com.basic.tvoid) in
-				let ce = mk (TFunction {
-					tf_args = [];
-					tf_type = ctx.com.basic.tvoid;
-					tf_expr = mk (TBlock el) ctx.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;
-				c.cl_constructor <- Some { ctor with cf_expr = Some ce };
-			| Some cf ->
-				match cf.cf_expr with
-				| Some { eexpr = TFunction f } ->
-					let bl = match f.tf_expr with {eexpr = TBlock b } -> b | x -> [x] in
-					let ce = mk (TFunction {f with tf_expr = mk (TBlock (el @ bl)) ctx.com.basic.tvoid c.cl_pos }) cf.cf_type cf.cf_pos in
-					c.cl_constructor <- Some {cf with cf_expr = Some ce }
-				| _ ->
-					assert false
-	in
-	match t with
-	| TClassDecl c ->
-		apply c
-	| _ ->
-		()
-
-(* Adds the __meta__ field if required *)
-let add_meta_field ctx t = match t with
-	| TClassDecl c ->
-		(match build_metadata ctx.com t with
-		| None -> ()
-		| Some e ->
-			let f = mk_field "__meta__" t_dynamic c.cl_pos in
-			f.cf_expr <- Some e;
-			c.cl_ordered_statics <- f :: c.cl_ordered_statics;
-			c.cl_statics <- PMap.add f.cf_name f c.cl_statics)
-	| _ ->
-		()
-
-(* Removes interfaces tagged with @:remove metadata *)
-let check_remove_metadata ctx t = match t with
-	| TClassDecl c ->
-		c.cl_implements <- List.filter (fun (c,_) -> not (Meta.has Meta.Remove c.cl_meta)) c.cl_implements;
-	| _ ->
-		()
-
-(* Checks for Void class fields *)
-let check_void_field ctx t = match t with
-	| TClassDecl c ->
-		let check f =
-			match follow f.cf_type with TAbstract({a_path=[],"Void"},_) -> error "Fields of type Void are not allowed" f.cf_pos | _ -> ();
-		in
-		List.iter check c.cl_ordered_fields;
-		List.iter check c.cl_ordered_statics;
-	| _ ->
-		()
-
 (* Promotes type parameters of abstracts to their implementation fields *)
 let promote_abstract_parameters ctx t = match t with
 	| TClassDecl ({cl_kind = KAbstractImpl a} as c) when a.a_types <> [] ->
@@ -826,728 +601,6 @@ let promote_abstract_parameters ctx t = match t with
 	| _ ->
 		()
 
-(*
-	- wraps implicit blocks in TIf, TFor, TWhile, TFunction and TTry with real ones
-*)
-let rec blockify_ast e =
-	match e.eexpr with
-	| TIf(e1,e2,eo) ->
-		{e with eexpr = TIf(blockify_ast e1,mk_block (blockify_ast e2),match eo with None -> None | Some e -> Some (mk_block (blockify_ast e)))}
-	| TFor(v,e1,e2) ->
-		{e with eexpr = TFor(v,blockify_ast e1,mk_block (blockify_ast e2))}
-	| TWhile(e1,e2,flag) ->
-		{e with eexpr = TWhile(blockify_ast e1,mk_block (blockify_ast e2),flag)}
-	| TFunction tf ->
-		{e with eexpr = TFunction {tf with tf_expr = mk_block (blockify_ast tf.tf_expr)}}
-	| TTry(e1,cl) ->
-		{e with eexpr = TTry(blockify_ast e1,List.map (fun (v,e) -> v,mk_block (blockify_ast e)) cl)}
-	| _ ->
-		Type.map_expr blockify_ast e
-
-let handle_side_effects com gen_temp e =
-	let block_el = ref [] in
-	let push e = block_el := e :: !block_el in
-	let declare_temp t eo p =
-		let v = gen_temp t in
-		begin match follow t,eo with
-			| TAbstract({a_path=[],"Void"},_),Some e -> com.warning (s_expr (s_type (print_context())) e) p;
-			| _ -> ()
-		end;
-		let e = mk (TVars [v,eo]) com.basic.tvoid p in
-		push e;
-		mk (TLocal v) t p
-	in
-	let push_block () =
-		let cur = !block_el in
-		block_el := [];
-		fun () ->
-			let added = !block_el in
-			block_el := cur;
-			List.rev added
-	in
-	let rec block f el =
-		let close = push_block() in
-		List.iter (fun e ->
-			push (f e)
-		) el;
-		close()
-	in
-	let rec loop e =
-		match e.eexpr with
-		| TBlock el ->
-			{e with eexpr = TBlock (block loop el)}
-		| TCall(e1,el) ->
-			{e with eexpr = TCall(loop e1,ordered_list el)}
-		| TNew(c,tl,el) ->
-			{e with eexpr = TNew(c,tl,ordered_list el)}
-		| TArrayDecl el ->
-			{e with eexpr = TArrayDecl (ordered_list el)}
-		| TObjectDecl fl ->
-			let el = ordered_list (List.map snd fl) in
-			{e with eexpr = TObjectDecl (List.map2 (fun (n,_) e -> n,e) fl el)}
-		| _ ->
-			Type.map_expr loop e
-	and ordered_list el =
-		let had_side_effect = ref false in
-		let rec no_side_effect e = match e.eexpr with
-			| TNew _ | TCall _ | TArrayDecl _ | TObjectDecl _ | TBinop ((OpAssignOp _ | OpAssign),_,_) | TUnop ((Increment|Decrement),_,_) ->
-				if !had_side_effect then
-					declare_temp e.etype (Some (loop e)) e.epos
-				else begin
-					had_side_effect := true;
-					e
-				end
-			| TConst _ | TLocal _ | TTypeExpr _ | TFunction _
-			| TReturn _ | TBreak | TContinue | TThrow _ | TCast (_,Some _) ->
-				e
-			| TBlock _ ->
-				loop e
-			| _ ->
-				Type.map_expr no_side_effect e
-		in
-		let rec loop2 acc el = match el with
-			| e :: el ->
-				let e = no_side_effect e in
-				if !had_side_effect then
-					(List.map no_side_effect (List.rev el)) @ e :: acc
-				else
-					loop2 (e :: acc) el
-			| [] ->
-				acc
-		in
-		List.map loop (loop2 [] (List.rev el))
-	in
-	let e = blockify_ast e in
-	let e = loop e in
-	match !block_el with
-		| [] ->
-			e
-		| el ->
-			mk (TBlock (List.rev (e :: el))) e.etype e.epos
-
-(*
-	Pushes complex right-hand side expression inwards.
-
-	return { exprs; value; } -> { exprs; return value; }
-	x = { exprs; value; } -> { exprs; x = value; }
-	var x = { exprs; value; } -> { var x; exprs; x = value; }
-*)
-let promote_complex_rhs ctx e =
-	let rec is_complex e = match e.eexpr with
-		| TBlock _ | TSwitch _ | TIf _ | TTry _ | TCast(_,Some _) -> true
-		| TBinop(_,e1,e2) -> is_complex e1 || is_complex e2
-		| TParenthesis e | TMeta(_,e) | TCast(e, None) -> is_complex e
-		| _ -> false
-	in
-	let rec loop f e = match e.eexpr with
-		| TBlock(el) ->
-			begin match List.rev el with
-				| elast :: el -> {e with eexpr = TBlock(block (List.rev ((loop f elast) :: el)))}
-				| [] -> e
-			end
-		| TSwitch(es,cases,edef) ->
-			{e with eexpr = TSwitch(es,List.map (fun (el,e) -> List.map find el,loop f e) cases,match edef with None -> None | Some e -> Some (loop f e))}
-		| TIf(eif,ethen,eelse) ->
-			{e with eexpr = TIf(find eif, loop f ethen, match eelse with None -> None | Some e -> Some (loop f e))}
-		| TTry(e1,el) ->
-			{e with eexpr = TTry(loop f e1, List.map (fun (el,e) -> el,loop f e) el)}
-		| TParenthesis e1 when not (Common.defined ctx Define.As3) ->
-			{e with eexpr = TParenthesis(loop f e1)}
-		| TMeta(m,e1) ->
-			{ e with eexpr = TMeta(m,loop f e1)}
-		| TReturn _ | TThrow _ ->
-			find e
-		| TCast(e1,None) when ctx.config.pf_ignore_unsafe_cast ->
-			loop f e1
-		| _ ->
-			f (find e)
-	and block el =
-		let r = ref [] in
-		List.iter (fun e ->
-			match e.eexpr with
-			| TVars(vl) ->
-				List.iter (fun (v,eo) ->
-					match eo with
-					| Some e when is_complex e ->
-						r := (loop (fun e -> mk (TBinop(OpAssign,mk (TLocal v) v.v_type e.epos,e)) v.v_type e.epos) e)
-							:: ((mk (TVars [v,None]) ctx.basic.tvoid e.epos))
-							:: !r
-					| Some e ->
-						r := (mk (TVars [v,Some (find e)]) ctx.basic.tvoid e.epos) :: !r
-					| None -> r := (mk (TVars [v,None]) ctx.basic.tvoid e.epos) :: !r
-
-				) vl
-			| _ -> r := (find e) :: !r
-		) el;
-		List.rev !r
-	and find e = match e.eexpr with
-		| TReturn (Some e1) -> loop (fun e -> {e with eexpr = TReturn (Some e)}) e1
-		| TBinop(OpAssign, ({eexpr = TLocal _ | TField _ | TArray _} as e1), e2) -> loop (fun er -> {e with eexpr = TBinop(OpAssign, e1, er)}) e2
-		| TBlock(el) -> {e with eexpr = TBlock (block el)}
-		| _ -> Type.map_expr find e
-	in
-	find e
-
-
-(* -------------------------------------------------------------------------- *)
-(* LOCAL VARIABLES USAGE *)
-
-type usage =
-	| Block of ((usage -> unit) -> unit)
-	| Loop of ((usage -> unit) -> unit)
-	| Function of ((usage -> unit) -> unit)
-	| Declare of tvar
-	| Use of tvar
-
-let rec local_usage f e =
-	match e.eexpr with
-	| TLocal v ->
-		f (Use v)
-	| TVars l ->
-		List.iter (fun (v,e) ->
-			(match e with None -> () | Some e -> local_usage f e);
-			f (Declare v);
-		) l
-	| TFunction tf ->
-		let cc f =
-			List.iter (fun (v,_) -> f (Declare v)) tf.tf_args;
-			local_usage f tf.tf_expr;
-		in
-		f (Function cc)
-	| TBlock l ->
-		f (Block (fun f -> List.iter (local_usage f) l))
-	| TFor (v,it,e) ->
-		local_usage f it;
-		f (Loop (fun f ->
-			f (Declare v);
-			local_usage f e;
-		))
-	| TWhile _ ->
-		f (Loop (fun f ->
-			iter (local_usage f) e
-		))
-	| TTry (e,catchs) ->
-		local_usage f e;
-		List.iter (fun (v,e) ->
-			f (Block (fun f ->
-				f (Declare v);
-				local_usage f e;
-			))
-		) catchs;
-	| TPatMatch dt ->
-		List.iter (fun (v,eo) ->
-			f (Declare v);
-			match eo with None -> () | Some e -> local_usage f e
-		) dt.dt_var_init;
-		let rec fdt dt = match dt with
-			| DTBind(bl,dt) ->
-				List.iter (fun ((v,_),e) ->
-					f (Declare v);
-					local_usage f e
-				) bl;
-				fdt dt
-			| DTExpr e -> local_usage f e
-			| DTGuard(e,dt1,dt2) ->
-				local_usage f e;
-				fdt dt1;
-				(match dt2 with None -> () | Some dt -> fdt dt)
-			| DTSwitch(e,cl,dto) ->
-				local_usage f e;
-				List.iter (fun (e,dt) ->
-					local_usage f e;
-					fdt dt
-				) cl;
-				(match dto with None -> () | Some dt -> fdt dt)
-			| DTGoto _ -> ()
-		in
-		Array.iter fdt dt.dt_dt_lookup
-	| _ ->
-		iter (local_usage f) e
-
-(* -------------------------------------------------------------------------- *)
-(* BLOCK VARIABLES CAPTURE *)
-
-(*
-	For some platforms, it will simply mark the variables which are used in closures
-	using the v_capture flag so it can be processed in a more optimized
-
-	For Flash/JS platforms, it will ensure that variables used in loop sub-functions
-	have an unique scope. It transforms the following expression :
-
-	for( x in array )
-		funs.push(function() return x++);
-
-	Into the following :
-
-	for( _x in array ) {
-		var x = [_x];
-		funs.push(function(x) { function() return x[0]++; }(x));
-	}
-*)
-
-let captured_vars com e =
-
-	let t = com.basic in
-
-	let rec mk_init av v pos =
-		mk (TVars [av,Some (mk (TArrayDecl [mk (TLocal v) v.v_type pos]) av.v_type pos)]) t.tvoid pos
-
-	and mk_var v used =
-		let v2 = alloc_var v.v_name (PMap.find v.v_id used) in
-		v2.v_meta <- v.v_meta;
-		v2
-
-	and wrap used e =
-		match e.eexpr with
-		| TVars vl ->
-			let vl = List.map (fun (v,ve) ->
-				if PMap.mem v.v_id used then
-					v, Some (mk (TArrayDecl (match ve with None -> [] | Some e -> [wrap used e])) v.v_type e.epos)
-				else
-					v, (match ve with None -> None | Some e -> Some (wrap used e))
-			) vl in
-			{ e with eexpr = TVars vl }
-		| TLocal v when PMap.mem v.v_id used ->
-			mk (TArray ({ e with etype = v.v_type },mk (TConst (TInt 0l)) t.tint e.epos)) e.etype e.epos
-		| TFor (v,it,expr) when PMap.mem v.v_id used ->
-			let vtmp = mk_var v used in
-			let it = wrap used it in
-			let expr = wrap used expr in
-			mk (TFor (vtmp,it,concat (mk_init v vtmp e.epos) expr)) e.etype e.epos
-		| TTry (expr,catchs) ->
-			let catchs = List.map (fun (v,e) ->
-				let e = wrap used e in
-				try
-					let vtmp = mk_var v used in
-					vtmp, concat (mk_init v vtmp e.epos) e
-				with Not_found ->
-					v, e
-			) catchs in
-			mk (TTry (wrap used expr,catchs)) e.etype e.epos
-		(* TODO: find out this does *)
-(* 		| TMatch (expr,enum,cases,def) ->
-			let cases = List.map (fun (il,vars,e) ->
-				let pos = e.epos in
-				let e = ref (wrap used e) in
-				let vars = match vars with
-					| None -> None
-					| Some l ->
-						Some (List.map (fun v ->
-							match v with
-							| Some v when PMap.mem v.v_id used ->
-								let vtmp = mk_var v used in
-								e := concat (mk_init v vtmp pos) !e;
-								Some vtmp
-							| _ -> v
-						) l)
-				in
-				il, vars, !e
-			) cases in
-			let def = match def with None -> None | Some e -> Some (wrap used e) in
-			mk (TMatch (wrap used expr,enum,cases,def)) e.etype e.epos *)
-		| TFunction f ->
-			(*
-				list variables that are marked as used, but also used in that
-				function and which are not declared inside it !
-			*)
-			let fused = ref PMap.empty in
-			let tmp_used = ref used in
-			let rec browse = function
-				| Block f | Loop f | Function f -> f browse
-				| Use v ->
-					if PMap.mem v.v_id !tmp_used then fused := PMap.add v.v_id v !fused;
-				| Declare v ->
-					tmp_used := PMap.remove v.v_id !tmp_used
-			in
-			local_usage browse e;
-			let vars = PMap.fold (fun v acc -> v :: acc) !fused [] in
-
-			(* in case the variable has been marked as used in a parallel scope... *)
-			let fexpr = ref (wrap used f.tf_expr) in
-			let fargs = List.map (fun (v,o) ->
-				if PMap.mem v.v_id used then
-					let vtmp = mk_var v used in
-					fexpr := concat (mk_init v vtmp e.epos) !fexpr;
-					vtmp, o
-				else
-					v, o
-			) f.tf_args in
-			let e = { e with eexpr = TFunction { f with tf_args = fargs; tf_expr = !fexpr } } in
-			(*
-				Create a new function scope to make sure that the captured loop variable
-				will not be overwritten in next loop iteration
-			*)
-			if com.config.pf_capture_policy = CPLoopVars then
-				mk (TCall (
-					mk_parent (mk (TFunction {
-						tf_args = List.map (fun v -> v, None) vars;
-						tf_type = e.etype;
-						tf_expr = mk_block (mk (TReturn (Some e)) e.etype e.epos);
-					}) (TFun (List.map (fun v -> v.v_name,false,v.v_type) vars,e.etype)) e.epos),
-					List.map (fun v -> mk (TLocal v) v.v_type e.epos) vars)
-				) e.etype e.epos
-			else
-				e
-		| _ ->
-			map_expr (wrap used) e
-
-	and do_wrap used e =
-		if PMap.is_empty used then
-			e
-		else
-			let used = PMap.map (fun v ->
-				let vt = v.v_type in
-				v.v_type <- t.tarray vt;
-				v.v_capture <- true;
-				vt
-			) used in
-			wrap used e
-
-	and out_loop e =
-		match e.eexpr with
-		| TFor _ | TWhile _ ->
-			(*
-				collect variables that are declared in loop but used in subfunctions
-			*)
-			let vars = ref PMap.empty in
-			let used = ref PMap.empty in
-			let depth = ref 0 in
-			let rec collect_vars in_loop = function
-				| Block f ->
-					let old = !vars in
-					f (collect_vars in_loop);
-					vars := old;
-				| Loop f ->
-					let old = !vars in
-					f (collect_vars true);
-					vars := old;
-				| Function f ->
-					incr depth;
-					f (collect_vars false);
-					decr depth;
-				| Declare v ->
-					if in_loop then vars := PMap.add v.v_id !depth !vars;
-				| Use v ->
-					try
-						let d = PMap.find v.v_id !vars in
-						if d <> !depth then used := PMap.add v.v_id v !used;
-					with Not_found ->
-						()
-			in
-			local_usage (collect_vars false) e;
-			do_wrap !used e
-		| _ ->
-			map_expr out_loop e
-	and all_vars e =
-		let vars = ref PMap.empty in
-		let used = ref PMap.empty in
-		let depth = ref 0 in
-		let rec collect_vars = function
-		| Block f ->
-			let old = !vars in
-			f collect_vars;
-			vars := old;
-		| Loop f ->
-			let old = !vars in
-			f collect_vars;
-			vars := old;
-		| Function f ->
-			incr depth;
-			f collect_vars;
-			decr depth;
-		| Declare v ->
-			vars := PMap.add v.v_id !depth !vars;
-		| Use v ->
-			try
-				let d = PMap.find v.v_id !vars in
-				if d <> !depth then used := PMap.add v.v_id v !used;
-			with Not_found -> ()
-		in
-		local_usage collect_vars e;
-		!used
-	in
-	(* mark all capture variables - also used in rename_local_vars at later stage *)
-	let captured = all_vars e in
-	PMap.iter (fun _ v -> v.v_capture <- true) captured;
-	match com.config.pf_capture_policy with
-	| CPNone -> e
-	| CPWrapRef -> do_wrap captured e
-	| CPLoopVars -> out_loop e
-
-(* -------------------------------------------------------------------------- *)
-(* RENAME LOCAL VARS *)
-
-let rename_local_vars com e =
-	let cfg = com.config in
-	let all_scope = (not cfg.pf_captured_scope) || (not cfg.pf_locals_scope) in
-	let vars = ref PMap.empty in
-	let all_vars = ref PMap.empty in
-	let vtemp = alloc_var "~" t_dynamic in
-	let rebuild_vars = ref false in
-	let rebuild m =
-		PMap.fold (fun v acc -> PMap.add v.v_name v acc) m PMap.empty
-	in
-	let save() =
-		let old = !vars in
-		if cfg.pf_unique_locals then (fun() -> ()) else (fun() -> vars := if !rebuild_vars then rebuild old else old)
-	in
-	let rename vars v =
-		let count = ref 1 in
-		while PMap.mem (v.v_name ^ string_of_int !count) vars do
-			incr count;
-		done;
-		v.v_name <- v.v_name ^ string_of_int !count;
-	in
-	let declare v p =
-		(match follow v.v_type with
-			| TAbstract ({a_path = [],"Void"},_) -> error "Arguments and variables of type Void are not allowed" p
-			| _ -> ());
-		(* chop escape char for all local variables generated *)
-		if String.unsafe_get v.v_name 0 = String.unsafe_get gen_local_prefix 0 then v.v_name <- "_g" ^ String.sub v.v_name 1 (String.length v.v_name - 1);
-		let look_vars = (if not cfg.pf_captured_scope && v.v_capture then !all_vars else !vars) in
-		(try
-			let v2 = PMap.find v.v_name look_vars in
-			(*
-				block_vars will create some wrapper-functions that are declaring
-				the same variable twice. In that case do not perform a rename since
-				we are sure it's actually the same variable
-			*)
-			if v == v2 then raise Not_found;
-			rename look_vars v;
-		with Not_found ->
-			());
-		vars := PMap.add v.v_name v !vars;
-		if all_scope then all_vars := PMap.add v.v_name v !all_vars;
-	in
-	(*
-		This is quite a rare case, when a local variable would otherwise prevent
-		accessing a type because it masks the type value or the package name.
-	*)
-	let check t =
-		match (t_infos t).mt_path with
-		| [], name | name :: _, _ ->
-			let vars = if cfg.pf_locals_scope then vars else all_vars in
-			(try
-				let v = PMap.find name !vars in
-				if v == vtemp then raise Not_found; (* ignore *)
-				rename (!vars) v;
-				rebuild_vars := true;
-				vars := PMap.add v.v_name v !vars
-			with Not_found ->
-				());
-			vars := PMap.add name vtemp !vars
-	in
-	let check_type t =
-		match follow t with
-		| TInst (c,_) -> check (TClassDecl c)
-		| TEnum (e,_) -> check (TEnumDecl e)
-		| TType (t,_) -> check (TTypeDecl t)
-		| TAbstract (a,_) -> check (TAbstractDecl a)
-		| TMono _ | TLazy _ | TAnon _ | TDynamic _ | TFun _ -> ()
-	in
-	let rec loop e =
-		match e.eexpr with
-		| TVars l ->
-			List.iter (fun (v,eo) ->
-				if not cfg.pf_locals_scope then declare v e.epos;
-				(match eo with None -> () | Some e -> loop e);
-				if cfg.pf_locals_scope then declare v e.epos;
-			) l
-		| TFunction tf ->
-			let old = save() in
-			List.iter (fun (v,_) -> declare v e.epos) tf.tf_args;
-			loop tf.tf_expr;
-			old()
-		| TBlock el ->
-			let old = save() in
-			List.iter loop el;
-			old()
-		| TFor (v,it,e1) ->
-			loop it;
-			let old = save() in
-			declare v e.epos;
-			loop e1;
-			old()
-		| TTry (e,catchs) ->
-			loop e;
-			List.iter (fun (v,e) ->
-				let old = save() in
-				declare v e.epos;
-				check_type v.v_type;
-				loop e;
-				old()
-			) catchs;
-		| TPatMatch dt ->
-			let rec fdt dt = match dt with
-				| DTSwitch(e,cl,dto) ->
-					loop e;
-					List.iter (fun (_,dt) ->
-						let old = save() in
-						fdt dt;
-						old();
-					) cl;
-					(match dto with None -> () | Some dt ->
-						let old = save() in
-						fdt dt;
-						old())
-				| DTBind(bl,dt) ->
-					List.iter (fun ((v,p),e) ->
-						declare v e.epos
-					) bl;
-					fdt dt
-				| DTExpr e -> loop e;
-				| DTGuard(e,dt1,dt2) ->
-					loop e;
-					fdt dt1;
-					(match dt2 with None -> () | Some dt -> fdt dt)
-				| DTGoto _ ->
-					()
-			in
-			Array.iter fdt dt.dt_dt_lookup
-		| TTypeExpr t ->
-			check t
-		| TNew (c,_,_) ->
-			Type.iter loop e;
-			check (TClassDecl c);
-		| TCast (e,Some t) ->
-			loop e;
-			check t;
-		| _ ->
-			Type.iter loop e
-	in
-	declare (alloc_var "this" t_dynamic) Ast.null_pos; (* force renaming of 'this' vars in abstract *)
-	loop e;
-	e
-
-(* -------------------------------------------------------------------------- *)
-(* CHECK LOCAL VARS INIT *)
-
-let check_local_vars_init e =
-	let intersect vl1 vl2 =
-		PMap.mapi (fun v t -> t && PMap.find v vl2) vl1
-	in
-	let join vars cvars =
-		List.iter (fun v -> vars := intersect !vars v) cvars
-	in
-	let restore vars old_vars declared =
-		(* restore variables declared in this block to their previous state *)
-		vars := List.fold_left (fun acc v ->
-			try	PMap.add v (PMap.find v old_vars) acc with Not_found -> PMap.remove v acc
-		) !vars declared;
-	in
-	let declared = ref [] in
-	let rec loop vars e =
-		match e.eexpr with
-		| TLocal v ->
-			let init = (try PMap.find v.v_id !vars with Not_found -> true) in
-			if not init then begin
-				if v.v_name = "this" then error "Missing this = value" e.epos
-				else error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
-			end
-		| TVars vl ->
-			List.iter (fun (v,eo) ->
-				match eo with
-				| None ->
-					declared := v.v_id :: !declared;
-					vars := PMap.add v.v_id false !vars
-				| Some e ->
-					loop vars e
-			) vl
-		| TBlock el ->
-			let old = !declared in
-			let old_vars = !vars in
-			declared := [];
-			List.iter (loop vars) el;
-			restore vars old_vars (List.rev !declared);
-			declared := old;
-		| TBinop (OpAssign,{ eexpr = TLocal v },e) when PMap.mem v.v_id !vars ->
-			loop vars e;
-			vars := PMap.add v.v_id true !vars
-		| TIf (e1,e2,eo) ->
-			loop vars e1;
-			let vbase = !vars in
-			loop vars e2;
-			(match eo with
-			| None -> vars := vbase
-			| Some e ->
-				let v1 = !vars in
-				vars := vbase;
-				loop vars e;
-				vars := intersect !vars v1)
-		| TWhile (cond,e,flag) ->
-			(match flag with
-			| NormalWhile ->
-				loop vars cond;
-				let old = !vars in
-				loop vars e;
-				vars := old;
-			| DoWhile ->
-				loop vars e;
-				loop vars cond)
-		| TTry (e,catches) ->
-			let cvars = List.map (fun (v,e) ->
-				let old = !vars in
-				loop vars e;
-				let v = !vars in
-				vars := old;
-				v
-			) catches in
-			loop vars e;
-			join vars cvars;
-		| TSwitch (e,cases,def) ->
-			loop vars e;
-			let cvars = List.map (fun (ec,e) ->
-				let old = !vars in
-				List.iter (loop vars) ec;
-				vars := old;
-				loop vars e;
-				let v = !vars in
-				vars := old;
-				v
-			) cases in
-			(match def with
-			| None when (match e.eexpr with TMeta((Meta.Exhaustive,_,_),_) | TParenthesis({eexpr = TMeta((Meta.Exhaustive,_,_),_)}) -> true | _ -> false) ->
-				(match cvars with
-				| cv :: cvars ->
-					PMap.iter (fun i b -> if b then vars := PMap.add i b !vars) cv;
-					join vars cvars
-				| [] -> ())
-			| None -> ()
-			| Some e ->
-				loop vars e;
-				join vars cvars)
-		| TPatMatch dt ->
-			let cvars = ref [] in
-			let rec fdt dt = match dt with
-				| DTExpr e ->
-					let old = !vars in
-					loop vars e;
-					restore vars old [];
-					cvars := !vars :: !cvars
-				| DTSwitch(e,cl,dto) ->
-					loop vars e;
-					List.iter (fun (_,dt) -> fdt dt) cl;
-					(match dto with None -> () | Some dt -> fdt dt)
-				| DTGuard(e,dt1,dt2) ->
-					fdt dt1;
-					(match dt2 with None -> () | Some dt -> fdt dt)
-				| DTBind(_,dt) -> fdt dt
-				| DTGoto _ -> ()
-			in
-			Array.iter fdt dt.dt_dt_lookup;
-			join vars !cvars
-		(* mark all reachable vars as initialized, since we don't exit the block  *)
-		| TBreak | TContinue | TReturn None ->
-			vars := PMap.map (fun _ -> true) !vars
-		| TThrow e | TReturn (Some e) ->
-			loop vars e;
-			vars := PMap.map (fun _ -> true) !vars
-		| _ ->
-			Type.iter (loop vars) e
-	in
-	loop (ref PMap.empty) e;
-	e
-
 (* -------------------------------------------------------------------------- *)
 (* ABSTRACT CASTS *)
 
@@ -1849,43 +902,6 @@ let update_cache_dependencies com =
 			()
 	) com.types
 
-(* -------------------------------------------------------------------------- *)
-(* POST PROCESS *)
-
-let pp_counter = ref 1
-
-let post_process ctx filters t =
-	(* ensure that we don't process twice the same (cached) module *)
-	let m = (t_infos t).mt_module.m_extra in
-	if m.m_processed = 0 then m.m_processed <- !pp_counter;
-	if m.m_processed = !pp_counter then
-	match t with
-	| TClassDecl c when is_removable_class c -> ()
-	| TClassDecl c ->
-		let process_field f =
-			match f.cf_expr with
-			| Some e when not (is_removable_field ctx f) ->
-				Abstract.cast_stack := f :: !Abstract.cast_stack;
-				f.cf_expr <- Some (List.fold_left (fun e f -> f e) e filters);
-				Abstract.cast_stack := List.tl !Abstract.cast_stack;
-			| _ -> ()
-		in
-		List.iter process_field c.cl_ordered_fields;
-		List.iter process_field c.cl_ordered_statics;
-		(match c.cl_constructor with
-		| None -> ()
-		| Some f -> process_field f);
-		(match c.cl_init with
-		| None -> ()
-		| Some e ->
-			c.cl_init <- Some (List.fold_left (fun e f -> f e) e filters));
-	| TEnumDecl _ -> ()
-	| TTypeDecl _ -> ()
-	| TAbstractDecl _ -> ()
-
-let post_process_end() =
-	incr pp_counter
-
 (* -------------------------------------------------------------------------- *)
 (* STACK MANAGEMENT EMULATION *)
 

File diff suppressed because it is too large
+ 1009 - 13
filters.ml


Some files were not shown because too many files changed in this diff