move filters to safe

src/filters/filters.ml

@@ -27,228 +27,6 @@ open FiltersCommon
 
 let get_native_name = Native.get_native_name
 
-(* PASS 1 begin *)
-
-(* -------------------------------------------------------------------------- *)
-(* CHECK LOCAL VARS INIT *)
-
-let check_local_vars_init ctx 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 outside_vars = ref IntMap.empty in
-	(* Set variables which belong to current function *)
-	let set_all_vars vars =
-		vars := PMap.mapi (fun id is_set -> if IntMap.mem id !outside_vars then is_set else true) !vars
-	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 IntMap.mem v.v_id !outside_vars then
-					if v.v_name = "this" then warning ctx WVarInit "this might be used before assigning a value to it" e.epos
-					else warning ctx WVarInit ("Local variable " ^ v.v_name ^ " might be used before being initialized") e.epos
-				else
-					if v.v_name = "this" then raise_typing_error "Missing this = value" e.epos
-					else raise_typing_error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
-			end
-		| TVar (v,eo) ->
-			begin
-				match eo with
-				| None when (match v.v_kind with VInlinedConstructorVariable _ -> true | _ -> false) ->
-					()
-				| None ->
-					declared := v.v_id :: !declared;
-					vars := PMap.add v.v_id false !vars
-				| Some e ->
-					loop vars e
-			end
-		| 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 ->
-			begin match (Texpr.skip e).eexpr with
-				| TFunction _ ->
-					(* We can be sure that the function doesn't execute immediately, so it's fine to
-					   consider the local initialized (issue #9919). *)
-					vars := PMap.add v.v_id true !vars;
-					loop vars e;
-				| _ ->
-					loop vars e;
-					vars := PMap.add v.v_id true !vars
-			end
-		| TIf (e1,e2,eo) ->
-			loop vars e1;
-			let vbase = !vars in
-			loop vars e2;
-			(match eo with
-			| None -> vars := vbase
-			(* ignore else false cases (they are added by the side-effect handler) *)
-			| Some {eexpr = TConst (TBool(false))} -> ()
-			| Some e ->
-				let v1 = !vars in
-				vars := vbase;
-				loop vars e;
-				vars := intersect !vars v1)
-		| TWhile (cond,e,flag) ->
-			(match flag with
-			| NormalWhile when (match cond.eexpr with TParenthesis {eexpr = TConst (TBool true)} -> false | _ -> true) ->
-				loop vars cond;
-				let old = !vars in
-				loop vars e;
-				vars := old;
-			| _ ->
-				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 ({switch_subject = e;switch_cases = cases;switch_default = def} as switch) ->
-			loop vars e;
-			let cvars = List.map (fun {case_patterns = ec;case_expr = 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 switch.switch_exhaustive ->
-				(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)
-		(* mark all reachable vars as initialized, since we don't exit the block  *)
-		| TBreak | TContinue | TReturn None ->
-			set_all_vars vars
-		| TThrow e | TReturn (Some e) ->
-			loop vars e;
-			set_all_vars vars
-		| TFunction tf ->
-			let old = !outside_vars in
-			(* Mark all known variables as "outside" so we can ignore their initialization state within the function.
-			   We cannot use `vars` directly because we still care about initializations the function might make.
-			*)
-			PMap.iter (fun i _ -> outside_vars := IntMap.add i true !outside_vars) !vars;
-			loop vars tf.tf_expr;
-			outside_vars := old;
-		| _ ->
-			Type.iter (loop vars) e
-	in
-	loop (ref PMap.empty) e;
-	e
-
-let mark_switch_break_loops e =
-	let add_loop_label n e =
-		{ e with eexpr = TMeta ((Meta.LoopLabel,[(EConst(Int(string_of_int n, None)),e.epos)],e.epos), e) }
-	in
-	let in_switch = ref false in
-	let did_found = ref (-1) in
-	let num = ref 0 in
-	let cur_num = ref 0 in
-	let rec run e =
-		match e.eexpr with
-		| TFunction _ ->
-			let old_num = !num in
-			num := 0;
-				let ret = Type.map_expr run e in
-			num := old_num;
-			ret
-		| TWhile _ ->
-			let last_switch = !in_switch in
-			let last_found = !did_found in
-			let last_num = !cur_num in
-			in_switch := false;
-			incr num;
-			cur_num := !num;
-			did_found := -1;
-				let new_e = Type.map_expr run e in (* assuming that no loop will be found in the condition *)
-				let new_e = if !did_found <> -1 then add_loop_label !did_found new_e else new_e in
-			did_found := last_found;
-			in_switch := last_switch;
-			cur_num := last_num;
-
-			new_e
-		| TSwitch _ ->
-			let last_switch = !in_switch in
-			in_switch := true;
-				let new_e = Type.map_expr run e in
-			in_switch := last_switch;
-			new_e
-		| TBreak ->
-			if !in_switch then (
-				did_found := !cur_num;
-				add_loop_label !cur_num e
-			) else
-				e
-		| _ -> Type.map_expr run e
-	in
-	run e
-
-let fix_return_dynamic_from_void_function _ e =
-	let rec loop return_is_void e = match e.eexpr with
-		| TFunction fn ->
-			let is_void = ExtType.is_void (follow fn.tf_type) in
-			let body = loop is_void fn.tf_expr in
-			{ e with eexpr = TFunction { fn with tf_expr = body } }
-		| TReturn (Some return_expr) when return_is_void && t_dynamic == follow return_expr.etype ->
-			let return_pos = { e.epos with pmax = return_expr.epos.pmin - 1 } in
-			let exprs = [
-				loop return_is_void return_expr;
-				{ e with eexpr = TReturn None; epos = return_pos };
-			] in
-			{ e with
-				eexpr = TMeta (
-					(Meta.MergeBlock, [], null_pos),
-					mk (TBlock exprs) e.etype e.epos
-				);
-			}
-		| _ -> Type.map_expr (loop return_is_void) e
-	in
-	loop true e
-
-let check_abstract_as_value _ e =
-	let rec loop e =
-		match e.eexpr with
-		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
-		| TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
-			raise_typing_error "Cannot use abstract as value" e.epos
-		| _ -> Type.iter loop e
-	in
-	loop e;
-	e
-
-(* PASS 1 end *)
-
 (* PASS 2 begin *)
 
 (* Applies exclude macro (which turns types into externs) *)
@@ -653,16 +431,17 @@ let run tctx ectx main before_destruction =
 		"handle_abstract_casts",AbstractCast.handle_abstract_casts;
 	] in
 	List.iter (run_expression_filters tctx detail_times filters) new_types;
+	let cv_wrapper_impl = CapturedVars.get_wrapper_implementation com in
 	let filters = [
 		"local_statics",LocalStatic.run;
-		"fix_return_dynamic_from_void_function",fix_return_dynamic_from_void_function;
-		"check_local_vars_init",check_local_vars_init;
-		"check_abstract_as_value",check_abstract_as_value;
+		"fix_return_dynamic_from_void_function",SafeFilters.fix_return_dynamic_from_void_function;
+		"check_local_vars_init",CheckVarInit.check_local_vars_init;
+		"check_abstract_as_value",SafeFilters.check_abstract_as_value;
 		"Tre",if defined com Define.AnalyzerOptimize then Tre.run else (fun _ e -> e);
 		"reduce_expression",Optimizer.reduce_expression;
 		"inline_constructors",InlineConstructors.inline_constructors;
 		"Exceptions_filter",(fun _ -> Exceptions.filter ectx);
-		"captured_vars",(fun _ -> CapturedVars.captured_vars com);
+		"captured_vars",(fun _ -> CapturedVars.captured_vars com cv_wrapper_impl);
 	] in
 	List.iter (run_expression_filters tctx detail_times filters) new_types;
 	enter_stage com CAnalyzerStart;
@@ -670,13 +449,13 @@ let run tctx ectx main before_destruction =
 	enter_stage com CAnalyzerDone;
 	let locals = RenameVars.init com in
 	let filters = [
-		"sanitize",(fun _ e -> Optimizer.sanitize com e);
+		"sanitize",(fun _ e -> Sanitize.sanitize com.config e);
 		"add_final_return",(fun _ -> if com.config.pf_add_final_return then AddFinalReturn.add_final_return else (fun e -> e));
 		"RenameVars",(match com.platform with
 		| Eval -> (fun _ e -> e)
 		| Jvm -> (fun _ e -> e)
 		| _ -> (fun tctx e -> RenameVars.run tctx.c.curclass.cl_path locals e));
-		"mark_switch_break_loops",(fun _ -> mark_switch_break_loops);
+		"mark_switch_break_loops",SafeFilters.mark_switch_break_loops;
 	] in
 	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
 		Parallel.ParallelArray.iter pool (run_expression_filters tctx detail_times filters) (Array.of_list new_types)

src/filters/addFieldInits.ml → src/filters/safe/addFieldInits.ml

@@ -2,7 +2,6 @@ open Globals
 open Common
 open Type
 
-
 let add_field_inits cl_path locals com t =
 	let apply c =
 		let ethis = mk (TConst TThis) (TInst (c,extract_param_types c.cl_params)) c.cl_pos in
@@ -55,7 +54,7 @@ let add_field_inits cl_path locals com t =
 			| Some e ->
 				(* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *)
 				let e = RenameVars.run cl_path locals e in
-				let e = Optimizer.sanitize com e in
+				let e = Sanitize.sanitize com.config e in
 				let e = if com.config.pf_add_final_return then AddFinalReturn.add_final_return e else e in
 				cf.cf_expr <- Some e
 			| _ ->

src/filters/capturedVars.ml → src/filters/safe/capturedVars.ml

@@ -17,32 +17,13 @@
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
 open Globals
-open Type
 open Common
+open Type
 open LocalUsage
 
-(* 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 impl = match com.platform with
+let get_wrapper_implementation com =
+	let t = com.Common.basic in
+	match com.platform with
 	(* optimized version for Java - use native arrays *)
 	| Jvm ->
 		let cnativearray =
@@ -84,7 +65,26 @@ let captured_vars com e =
 			method mk_init av v pos =
 				mk (TVar (av,Some (mk (TArrayDecl [mk (TLocal v) v.v_type pos]) av.v_type pos))) t.tvoid pos
 		end
-	in
+
+(* 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 impl e =
 
 	let mk_var v used =
 		let v2 = alloc_var v.v_kind v.v_name (PMap.find v.v_id used) v.v_pos in

src/filters/safe/checkVarInit.ml

@@ -0,0 +1,140 @@
+open Globals
+open Common
+open Typecore
+open Error
+open Type
+
+let check_local_vars_init ctx 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 outside_vars = ref IntMap.empty in
+	(* Set variables which belong to current function *)
+	let set_all_vars vars =
+		vars := PMap.mapi (fun id is_set -> if IntMap.mem id !outside_vars then is_set else true) !vars
+	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 IntMap.mem v.v_id !outside_vars then
+					if v.v_name = "this" then warning ctx WVarInit "this might be used before assigning a value to it" e.epos
+					else warning ctx WVarInit ("Local variable " ^ v.v_name ^ " might be used before being initialized") e.epos
+				else
+					if v.v_name = "this" then raise_typing_error "Missing this = value" e.epos
+					else raise_typing_error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
+			end
+		| TVar (v,eo) ->
+			begin
+				match eo with
+				| None when (match v.v_kind with VInlinedConstructorVariable _ -> true | _ -> false) ->
+					()
+				| None ->
+					declared := v.v_id :: !declared;
+					vars := PMap.add v.v_id false !vars
+				| Some e ->
+					loop vars e
+			end
+		| 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 ->
+			begin match (Texpr.skip e).eexpr with
+				| TFunction _ ->
+					(* We can be sure that the function doesn't execute immediately, so it's fine to
+					   consider the local initialized (issue #9919). *)
+					vars := PMap.add v.v_id true !vars;
+					loop vars e;
+				| _ ->
+					loop vars e;
+					vars := PMap.add v.v_id true !vars
+			end
+		| TIf (e1,e2,eo) ->
+			loop vars e1;
+			let vbase = !vars in
+			loop vars e2;
+			(match eo with
+			| None -> vars := vbase
+			(* ignore else false cases (they are added by the side-effect handler) *)
+			| Some {eexpr = TConst (TBool(false))} -> ()
+			| Some e ->
+				let v1 = !vars in
+				vars := vbase;
+				loop vars e;
+				vars := intersect !vars v1)
+		| TWhile (cond,e,flag) ->
+			(match flag with
+			| NormalWhile when (match cond.eexpr with TParenthesis {eexpr = TConst (TBool true)} -> false | _ -> true) ->
+				loop vars cond;
+				let old = !vars in
+				loop vars e;
+				vars := old;
+			| _ ->
+				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 ({switch_subject = e;switch_cases = cases;switch_default = def} as switch) ->
+			loop vars e;
+			let cvars = List.map (fun {case_patterns = ec;case_expr = 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 switch.switch_exhaustive ->
+				(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)
+		(* mark all reachable vars as initialized, since we don't exit the block  *)
+		| TBreak | TContinue | TReturn None ->
+			set_all_vars vars
+		| TThrow e | TReturn (Some e) ->
+			loop vars e;
+			set_all_vars vars
+		| TFunction tf ->
+			let old = !outside_vars in
+			(* Mark all known variables as "outside" so we can ignore their initialization state within the function.
+			   We cannot use `vars` directly because we still care about initializations the function might make.
+			*)
+			PMap.iter (fun i _ -> outside_vars := IntMap.add i true !outside_vars) !vars;
+			loop vars tf.tf_expr;
+			outside_vars := old;
+		| _ ->
+			Type.iter (loop vars) e
+	in
+	loop (ref PMap.empty) e;
+	e

src/filters/safe/safeFilters.ml

@@ -0,0 +1,82 @@
+open Globals
+open Type
+
+let fix_return_dynamic_from_void_function _ e =
+	let rec loop return_is_void e = match e.eexpr with
+		| TFunction fn ->
+			let is_void = ExtType.is_void (follow fn.tf_type) in
+			let body = loop is_void fn.tf_expr in
+			{ e with eexpr = TFunction { fn with tf_expr = body } }
+		| TReturn (Some return_expr) when return_is_void && t_dynamic == follow return_expr.etype ->
+			let return_pos = { e.epos with pmax = return_expr.epos.pmin - 1 } in
+			let exprs = [
+				loop return_is_void return_expr;
+				{ e with eexpr = TReturn None; epos = return_pos };
+			] in
+			{ e with
+				eexpr = TMeta (
+					(Meta.MergeBlock, [], null_pos),
+					mk (TBlock exprs) e.etype e.epos
+				);
+			}
+		| _ -> Type.map_expr (loop return_is_void) e
+	in
+	loop true e
+
+let check_abstract_as_value _ e =
+	let rec loop e =
+		match e.eexpr with
+		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
+		| TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
+			Error.raise_typing_error "Cannot use abstract as value" e.epos
+		| _ -> Type.iter loop e
+	in
+	loop e;
+	e
+
+let mark_switch_break_loops _ e =
+	let add_loop_label n e =
+		{ e with eexpr = TMeta ((Meta.LoopLabel,[(EConst(Int(string_of_int n, None)),e.epos)],e.epos), e) }
+	in
+	let in_switch = ref false in
+	let did_found = ref (-1) in
+	let num = ref 0 in
+	let cur_num = ref 0 in
+	let rec run e =
+		match e.eexpr with
+		| TFunction _ ->
+			let old_num = !num in
+			num := 0;
+				let ret = Type.map_expr run e in
+			num := old_num;
+			ret
+		| TWhile _ ->
+			let last_switch = !in_switch in
+			let last_found = !did_found in
+			let last_num = !cur_num in
+			in_switch := false;
+			incr num;
+			cur_num := !num;
+			did_found := -1;
+				let new_e = Type.map_expr run e in (* assuming that no loop will be found in the condition *)
+				let new_e = if !did_found <> -1 then add_loop_label !did_found new_e else new_e in
+			did_found := last_found;
+			in_switch := last_switch;
+			cur_num := last_num;
+
+			new_e
+		| TSwitch _ ->
+			let last_switch = !in_switch in
+			in_switch := true;
+				let new_e = Type.map_expr run e in
+			in_switch := last_switch;
+			new_e
+		| TBreak ->
+			if !in_switch then (
+				did_found := !cur_num;
+				add_loop_label !cur_num e
+			) else
+				e
+		| _ -> Type.map_expr run e
+	in
+	run e

src/filters/safe/sanitize.ml

@@ -0,0 +1,198 @@
+open Ast
+open Type
+
+(* ---------------------------------------------------------------------- *)
+(* SANITIZE *)
+
+(*
+	makes sure that when an AST get generated to source code, it will not
+	generate expressions that evaluate differently. It is then necessary to
+	add parenthesises around some binary expressions when the AST does not
+	correspond to the natural operand priority order for the platform
+*)
+
+(*
+	this is the standard C++ operator precedence, which is also used by both JS and PHP
+*)
+let standard_precedence op =
+	let left = true and right = false in
+	match op with
+	| OpIn -> 4, right
+	| OpMult | OpDiv | OpMod -> 5, left
+	| OpAdd | OpSub -> 6, left
+	| OpShl | OpShr | OpUShr -> 7, left
+	| OpLt | OpLte | OpGt | OpGte -> 8, left
+	| OpEq | OpNotEq -> 9, left
+	| OpAnd -> 10, left
+	| OpXor -> 11, left
+	| OpOr -> 12, left
+	| OpInterval -> 13, right (* haxe specific *)
+	| OpBoolAnd -> 14, left
+	| OpBoolOr -> 15, left
+	| OpArrow -> 16, left
+	| OpNullCoal -> 17, right
+	| OpAssignOp OpAssign -> 18, right (* mimics ?: *)
+	| OpAssign | OpAssignOp _ -> 19, right
+
+let rec need_parent e =
+	match e.eexpr with
+	| TConst _ | TLocal _ | TArray _ | TField _ | TEnumParameter _ | TEnumIndex _ | TParenthesis _
+	| TCall _ | TNew _ | TTypeExpr _ | TObjectDecl _ | TArrayDecl _ | TIdent _ -> false
+	| TCast (e,None) | TMeta(_,e) -> need_parent e
+	| TCast _ | TThrow _ | TReturn _ | TTry _ | TSwitch _ | TIf _ | TWhile _ | TBinop _ | TContinue | TBreak
+	| TBlock _ | TVar _ | TFunction _ | TUnop _ -> true
+
+let sanitize_expr config e =
+	let parent e =
+		match e.eexpr with
+		| TParenthesis _ -> e
+		| _ -> mk (TParenthesis e) e.etype e.epos
+	in
+	let block e =
+		match e.eexpr with
+		| TBlock _ -> e
+		| _ -> mk (TBlock [e]) e.etype e.epos
+	in
+	let complex e =
+		(* complex expressions are the one that once generated to source consists in several expressions  *)
+		match e.eexpr with
+		| TVar _	(* needs to be put into blocks *)
+		| TCall ({ eexpr = TIdent "__js__" },_) (* we never know *)
+			-> block e
+		| _ -> e
+	in
+	(* tells if the printed expresssion ends with an if without else *)
+	let rec has_if e =
+		match e.eexpr with
+		| TIf (_,_,None) -> true
+		| TWhile (_,e,NormalWhile) -> has_if e
+		| _ -> false
+	in
+	match e.eexpr with
+	| TConst TNull ->
+		if config.PlatformConfig.pf_static && not (is_nullable e.etype) then begin
+			let rec loop t = match follow t with
+				| TMono _ -> () (* in these cases the null will cast to default value *)
+				| TFun _ -> () (* this is a bit a particular case, maybe flash-specific actually *)
+				(* TODO: this should use get_underlying_type, but we do not have access to Codegen here.  *)
+				| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> loop (apply_params a.a_params tl a.a_this)
+				| _ ->
+					if config != Common.default_config then (* This is atrocious *)
+						Error.raise_typing_error ("On static platforms, null can't be used as basic type " ^ s_type (print_context()) e.etype) e.epos
+			in
+			loop e.etype
+		end;
+		e
+	| TBinop (op,e1,e2) ->
+		let swap op1 op2 =
+			let p1, left1 = standard_precedence op1 in
+			let p2, _ = standard_precedence op2 in
+			left1 && p1 <= p2
+		in
+		let rec loop ee left =
+			match ee.eexpr with
+			| TBinop (op2,_,_) -> if left then not (swap op2 op) else swap op op2
+			| TIf _ -> if left then not (swap (OpAssignOp OpAssign) op) else swap op (OpAssignOp OpAssign)
+			| TCast (e,None) | TMeta (_,e) -> loop e left
+			| TConst (TInt i) when not left ->
+				(match op with
+					| OpAdd | OpSub -> (Int32.to_int i) < 0
+					| _ -> false
+				)
+			| TConst (TFloat flt) when not left ->
+				(match op with
+					| OpAdd | OpSub -> String.get flt 0 = '-'
+					| _ -> false
+				)
+			| _ -> false
+		in
+		let e1 = if loop e1 true then parent e1 else e1 in
+		let e2 = if loop e2 false then parent e2 else e2 in
+		{ e with eexpr = TBinop (op,e1,e2) }
+	| TUnop (Not,Prefix,{ eexpr = (TUnop (Not,Prefix,e1)) | (TParenthesis { eexpr = TUnop (Not,Prefix,e1) }) })
+		when ExtType.is_bool (Abstract.follow_with_abstracts_without_null e1.etype) ->
+		e1
+	| TUnop (op,mode,e1) ->
+		let rec loop ee =
+			match ee.eexpr with
+			| TConst (TInt i) when op = Neg && (Int32.to_int i) < 0 -> parent e1
+			| TConst (TFloat flt) when op = Neg && String.get flt 0 = '-' -> parent e1
+			| TBinop _ | TIf _ | TUnop _ -> parent e1
+			| TCast (e,None) | TMeta (_, e) -> loop e
+			| _ -> e1
+		in
+		{ e with eexpr = TUnop (op,mode,loop e1)}
+	| TIf (e1,e2,eelse) ->
+		let e1 = parent e1 in
+		let e2 = (if (eelse <> None && has_if e2) || (match e2.eexpr with TIf _ -> true | _ -> false) then block e2 else complex e2) in
+		let eelse = (match eelse with None -> None | Some e -> Some (complex e)) in
+		{ e with eexpr = TIf (e1,e2,eelse) }
+	| TWhile (e1,e2,flag) ->
+		let e1 = parent e1 in
+		let e2 = complex e2 in
+		{ e with eexpr = TWhile (e1,e2,flag) }
+	| TFunction f ->
+		let f = (match f.tf_expr.eexpr with
+			| TBlock exprs ->
+				if ExtType.is_void (follow f.tf_type) then
+					match List.rev exprs with
+					| { eexpr = TReturn None } :: rest -> { f with tf_expr = { f.tf_expr with eexpr = TBlock (List.rev rest) } }
+					| _ -> f
+				else
+					f
+			| _ -> { f with tf_expr = block f.tf_expr }
+		) in
+		{ e with eexpr = TFunction f }
+	| TCall (e2,args) ->
+		if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e
+	| TEnumParameter (e2,ef,i) ->
+		if need_parent e2 then { e with eexpr = TEnumParameter(parent e2,ef,i) } else e
+	| TEnumIndex e2 ->
+		if need_parent e2 then { e with eexpr = TEnumIndex(parent e2) } else e
+	| TField (e2,f) ->
+		if need_parent e2 then { e with eexpr = TField(parent e2,f) } else e
+	| TArray (e1,e2) ->
+		if need_parent e1 then { e with eexpr = TArray(parent e1,e2) } else e
+	| TTry (e1,catches) ->
+		let e1 = block e1 in
+		let catches = List.map (fun (v,e) -> v, block e) catches in
+		{ e with eexpr = TTry (e1,catches) }
+	| TSwitch switch ->
+		let e1 = parent switch.switch_subject in
+		let cases = List.map (fun case -> {case with case_expr = complex case.case_expr}) switch.switch_cases in
+		let def = Option.map complex switch.switch_default in
+		let switch = { switch with
+			switch_subject = e1;
+			switch_cases = cases;
+			switch_default = def;
+		} in
+		{ e with eexpr = TSwitch switch }
+	| _ ->
+		e
+
+let reduce_expr com e =
+	match e.eexpr with
+	| TBlock l ->
+		(match List.rev l with
+		| [] -> e
+		| ec :: l ->
+			(* remove all no-ops : not-final constants in blocks *)
+			match List.filter (fun e -> match e.eexpr with
+				| TConst _
+				| TBlock []
+				| TObjectDecl [] ->
+					false
+				| _ ->
+					true
+			) l with
+			| [] -> ec
+			| l -> { e with eexpr = TBlock (List.rev (ec :: l)) })
+	| TParenthesis ec ->
+		{ ec with epos = e.epos }
+	| TTry (e,[]) ->
+		e
+	| _ ->
+		e
+
+let rec sanitize config e =
+	sanitize_expr config (reduce_expr config (Type.map_expr (sanitize config) e))

src/optimization/optimizer.ml

@@ -26,209 +26,6 @@ open Error
 open Globals
 open Inline
 
-(* ---------------------------------------------------------------------- *)
-(* SANITIZE *)
-
-(*
-	makes sure that when an AST get generated to source code, it will not
-	generate expressions that evaluate differently. It is then necessary to
-	add parenthesises around some binary expressions when the AST does not
-	correspond to the natural operand priority order for the platform
-*)
-
-(*
-	this is the standard C++ operator precedence, which is also used by both JS and PHP
-*)
-let standard_precedence op =
-	let left = true and right = false in
-	match op with
-	| OpIn -> 4, right
-	| OpMult | OpDiv | OpMod -> 5, left
-	| OpAdd | OpSub -> 6, left
-	| OpShl | OpShr | OpUShr -> 7, left
-	| OpLt | OpLte | OpGt | OpGte -> 8, left
-	| OpEq | OpNotEq -> 9, left
-	| OpAnd -> 10, left
-	| OpXor -> 11, left
-	| OpOr -> 12, left
-	| OpInterval -> 13, right (* haxe specific *)
-	| OpBoolAnd -> 14, left
-	| OpBoolOr -> 15, left
-	| OpArrow -> 16, left
-	| OpNullCoal -> 17, right
-	| OpAssignOp OpAssign -> 18, right (* mimics ?: *)
-	| OpAssign | OpAssignOp _ -> 19, right
-
-let rec need_parent e =
-	match e.eexpr with
-	| TConst _ | TLocal _ | TArray _ | TField _ | TEnumParameter _ | TEnumIndex _ | TParenthesis _
-	| TCall _ | TNew _ | TTypeExpr _ | TObjectDecl _ | TArrayDecl _ | TIdent _ -> false
-	| TCast (e,None) | TMeta(_,e) -> need_parent e
-	| TCast _ | TThrow _ | TReturn _ | TTry _ | TSwitch _ | TIf _ | TWhile _ | TBinop _ | TContinue | TBreak
-	| TBlock _ | TVar _ | TFunction _ | TUnop _ -> true
-
-let sanitize_expr com e =
-	let parent e =
-		match e.eexpr with
-		| TParenthesis _ -> e
-		| _ -> mk (TParenthesis e) e.etype e.epos
-	in
-	let block e =
-		match e.eexpr with
-		| TBlock _ -> e
-		| _ -> mk (TBlock [e]) e.etype e.epos
-	in
-	let complex e =
-		(* complex expressions are the one that once generated to source consists in several expressions  *)
-		match e.eexpr with
-		| TVar _	(* needs to be put into blocks *)
-		| TCall ({ eexpr = TIdent "__js__" },_) (* we never know *)
-			-> block e
-		| _ -> e
-	in
-	(* tells if the printed expresssion ends with an if without else *)
-	let rec has_if e =
-		match e.eexpr with
-		| TIf (_,_,None) -> true
-		| TWhile (_,e,NormalWhile) -> has_if e
-		| _ -> false
-	in
-	match e.eexpr with
-	| TConst TNull ->
-		if com.config.pf_static && not (is_nullable e.etype) then begin
-			let rec loop t = match follow t with
-				| TMono _ -> () (* in these cases the null will cast to default value *)
-				| TFun _ -> () (* this is a bit a particular case, maybe flash-specific actually *)
-				(* TODO: this should use get_underlying_type, but we do not have access to Codegen here.  *)
-				| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> loop (apply_params a.a_params tl a.a_this)
-				| _ -> com.error ("On static platforms, null can't be used as basic type " ^ s_type (print_context()) e.etype) e.epos
-			in
-			loop e.etype
-		end;
-		e
-	| TBinop (op,e1,e2) ->
-		let swap op1 op2 =
-			let p1, left1 = standard_precedence op1 in
-			let p2, _ = standard_precedence op2 in
-			left1 && p1 <= p2
-		in
-		let rec loop ee left =
-			match ee.eexpr with
-			| TBinop (op2,_,_) -> if left then not (swap op2 op) else swap op op2
-			| TIf _ -> if left then not (swap (OpAssignOp OpAssign) op) else swap op (OpAssignOp OpAssign)
-			| TCast (e,None) | TMeta (_,e) -> loop e left
-			| TConst (TInt i) when not left ->
-				(match op with
-					| OpAdd | OpSub -> (Int32.to_int i) < 0
-					| _ -> false
-				)
-			| TConst (TFloat flt) when not left ->
-				(match op with
-					| OpAdd | OpSub -> String.get flt 0 = '-'
-					| _ -> false
-				)
-			| _ -> false
-		in
-		let e1 = if loop e1 true then parent e1 else e1 in
-		let e2 = if loop e2 false then parent e2 else e2 in
-		{ e with eexpr = TBinop (op,e1,e2) }
-	| TUnop (Not,Prefix,{ eexpr = (TUnop (Not,Prefix,e1)) | (TParenthesis { eexpr = TUnop (Not,Prefix,e1) }) })
-		when ExtType.is_bool (Abstract.follow_with_abstracts_without_null e1.etype) ->
-		e1
-	| TUnop (op,mode,e1) ->
-		let rec loop ee =
-			match ee.eexpr with
-			| TConst (TInt i) when op = Neg && (Int32.to_int i) < 0 -> parent e1
-			| TConst (TFloat flt) when op = Neg && String.get flt 0 = '-' -> parent e1
-			| TBinop _ | TIf _ | TUnop _ -> parent e1
-			| TCast (e,None) | TMeta (_, e) -> loop e
-			| _ -> e1
-		in
-		{ e with eexpr = TUnop (op,mode,loop e1)}
-	| TIf (e1,e2,eelse) ->
-		let e1 = parent e1 in
-		let e2 = (if (eelse <> None && has_if e2) || (match e2.eexpr with TIf _ -> true | _ -> false) then block e2 else complex e2) in
-		let eelse = (match eelse with None -> None | Some e -> Some (complex e)) in
-		{ e with eexpr = TIf (e1,e2,eelse) }
-	| TWhile (e1,e2,flag) ->
-		let e1 = parent e1 in
-		let e2 = complex e2 in
-		{ e with eexpr = TWhile (e1,e2,flag) }
-	| TFunction f ->
-		let f = (match f.tf_expr.eexpr with
-			| TBlock exprs ->
-				if ExtType.is_void (follow f.tf_type) then
-					match List.rev exprs with
-					| { eexpr = TReturn None } :: rest -> { f with tf_expr = { f.tf_expr with eexpr = TBlock (List.rev rest) } }
-					| _ -> f
-				else
-					f
-			| _ -> { f with tf_expr = block f.tf_expr }
-		) in
-		{ e with eexpr = TFunction f }
-	| TCall (e2,args) ->
-		if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e
-	| TEnumParameter (e2,ef,i) ->
-		if need_parent e2 then { e with eexpr = TEnumParameter(parent e2,ef,i) } else e
-	| TEnumIndex e2 ->
-		if need_parent e2 then { e with eexpr = TEnumIndex(parent e2) } else e
-	| TField (e2,f) ->
-		if need_parent e2 then { e with eexpr = TField(parent e2,f) } else e
-	| TArray (e1,e2) ->
-		if need_parent e1 then { e with eexpr = TArray(parent e1,e2) } else e
-	| TTry (e1,catches) ->
-		let e1 = block e1 in
-		let catches = List.map (fun (v,e) -> v, block e) catches in
-		{ e with eexpr = TTry (e1,catches) }
-	| TSwitch switch ->
-		let e1 = parent switch.switch_subject in
-		let cases = List.map (fun case -> {case with case_expr = complex case.case_expr}) switch.switch_cases in
-		let def = Option.map complex switch.switch_default in
-		let switch = { switch with
-			switch_subject = e1;
-			switch_cases = cases;
-			switch_default = def;
-		} in
-		{ e with eexpr = TSwitch switch }
-	| _ ->
-		e
-
-let reduce_expr com e =
-	match e.eexpr with
-	| TSwitch switch ->
-		List.iter (fun case ->
-			List.iter (fun e ->
-				match e.eexpr with
-				| TCall ({ eexpr = TField (_,FEnum _) },_) -> raise_typing_error "Not-constant enum in switch cannot be matched" e.epos
-				| _ -> ()
-			) case.case_patterns
-		) switch.switch_cases;
-		e
-	| TBlock l ->
-		(match List.rev l with
-		| [] -> e
-		| ec :: l ->
-			(* remove all no-ops : not-final constants in blocks *)
-			match List.filter (fun e -> match e.eexpr with
-				| TConst _
-				| TBlock []
-				| TObjectDecl [] ->
-					false
-				| _ ->
-					true
-			) l with
-			| [] -> ec
-			| l -> { e with eexpr = TBlock (List.rev (ec :: l)) })
-	| TParenthesis ec ->
-		{ ec with epos = e.epos }
-	| TTry (e,[]) ->
-		e
-	| _ ->
-		e
-
-let rec sanitize com e =
-	sanitize_expr com (reduce_expr com (Type.map_expr (sanitize com) e))
-
 (* ---------------------------------------------------------------------- *)
 (* REDUCE *)
 
@@ -333,9 +130,11 @@ let reduce_control_flow com e = match e.eexpr with
 	| _ ->
 		e
 
+open Sanitize
+
 let rec reduce_loop ctx stack e =
 	let e = Type.map_expr (reduce_loop ctx stack) e in
-	sanitize_expr ctx.com (match e.eexpr with
+	sanitize_expr ctx.com.config (match e.eexpr with
 	| TCall(e1,el) ->
 		begin match Texpr.skip e1 with
 			| { eexpr = TFunction func } as ef ->

src/typing/macroContext.ml

@@ -605,12 +605,13 @@ and flush_macro_context mint mctx =
 		mctx.com.types <- types;
 		mctx.com.Common.modules <- modules;
 		let ectx = Exceptions.create_exception_context mctx in
+		let cv_wrapper_impl = CapturedVars.get_wrapper_implementation mctx.com in
 		(* we should maybe ensure that all filters in Main are applied. Not urgent atm *)
 		let expr_filters = [
 			"handle_abstract_casts",AbstractCast.handle_abstract_casts;
 			"local_statics",LocalStatic.run;
 			"Exceptions",(fun _ -> Exceptions.filter ectx);
-			"captured_vars",(fun _ -> CapturedVars.captured_vars mctx.com);
+			"captured_vars",(fun _ -> CapturedVars.captured_vars mctx.com cv_wrapper_impl);
 		] in
 		(*
 			some filters here might cause side effects that would break compilation server.