merge sanitize and reduce_expression

more sanitizing, less parenthesis in JS

genjs.ml

@@ -197,15 +197,6 @@ let rec gen_call ctx e el =
 		concat ctx "," (gen_value ctx) el;
 		spr ctx ")"
 
-and gen_value_op ctx e =
-	match e.eexpr with
-	| TBinop (op,_,_) when op = Ast.OpAnd || op = Ast.OpOr || op = Ast.OpXor ->
-		spr ctx "(";
-		gen_value ctx e;
-		spr ctx ")";
-	| _ ->
-		gen_value ctx e
-
 and gen_expr ctx e =
 	match e.eexpr with
 	| TConst c -> gen_constant ctx e.epos c
@@ -217,15 +208,10 @@ and gen_expr ctx e =
 		spr ctx "[";
 		gen_value ctx e2;
 		spr ctx "]";
-	| TBinop (op,{ eexpr = TField (e1,s) },e2) ->
-		gen_value_op ctx e1;
-		spr ctx (field s);
-		print ctx " %s " (Ast.s_binop op);
-		gen_value_op ctx e2;
 	| TBinop (op,e1,e2) ->
-		gen_value_op ctx e1;
+		gen_value ctx e1;
 		print ctx " %s " (Ast.s_binop op);
-		gen_value_op ctx e2;
+		gen_value ctx e2;
 	| TField (x,s) ->
 		gen_value ctx x;
 		spr ctx (field s)
@@ -557,7 +543,11 @@ and gen_value ctx e =
 		loop el;
 		v();
 	| TIf (cond,e,eo) ->
-		spr ctx "(";
+		let cond = (match cond.eexpr with
+			| TParenthesis { eexpr = TBinop ((Ast.OpAssign | Ast.OpAssignOp _),_,_) } -> cond
+			| TParenthesis e -> e
+			| _ -> cond
+		) in
 		gen_value ctx cond;
 		spr ctx "?";
 		gen_value ctx e;
@@ -565,7 +555,6 @@ and gen_value ctx e =
 		(match eo with
 		| None -> spr ctx "null"
 		| Some e -> gen_value ctx e);
-		spr ctx ")"
 	| TSwitch (cond,cases,def) ->
 		let v = value true in
 		gen_expr ctx (mk (TSwitch (cond,

main.ml

@@ -465,7 +465,8 @@ try
 			config_macros := e :: !config_macros
 		)," : call the given macro before typing anything else");
 		("--dead-code-elimination", Arg.Unit (fun () ->
-			com.dead_code_elimination <- true
+			com.dead_code_elimination <- true;
+			Common.add_filter com (fun() -> Optimizer.filter_dead_code com);
 		)," : remove unused methods");
 		("-swf9",Arg.String (fun file ->
 			set_platform Flash file;
@@ -578,14 +579,11 @@ try
 		com.lines <- Lexer.build_line_index();
 		if com.platform = Flash9 then Common.add_filter com (fun() -> List.iter Codegen.fix_overrides com.types);
 		let filters = [
+			if com.foptimize then Optimizer.reduce_expression ctx else Optimizer.sanitize;
 			Codegen.check_local_vars_init;
 			Codegen.block_vars com;
 		] in
-		let filters = (match com.platform with Js | Php | Cpp -> Optimizer.sanitize :: filters | _ -> filters) in
-		let filters = (if not com.foptimize then filters else Optimizer.reduce_expression ctx :: filters) in
 		Codegen.post_process com filters;
-		if com.dead_code_elimination then
-			Common.add_filter com (fun() -> Optimizer.filter_dead_code com);
 		Common.add_filter com (fun() -> List.iter (Codegen.on_generate ctx) com.types);
 		List.iter (fun f -> f()) (List.rev com.filters);
 		if Common.defined com "dump" then Codegen.dump_types com;

optimizer.ml

@@ -118,14 +118,14 @@ let type_inline ctx cf f ethis params tret p =
 			let term, t = (match def with Some d when term -> true, d.etype | _ -> false, e.etype) in
 			let cases = List.map (fun (i,vl,e) ->
 				let old = save_locals ctx in
-				let vl = opt (List.map (fun (n,t) -> opt (fun n -> add_local ctx n t) n, t)) vl in 
+				let vl = opt (List.map (fun (n,t) -> opt (fun n -> add_local ctx n t) n, t)) vl in
 				let e = map term e in
 				old();
 				i, vl, e
 			) cases in
 			{ e with eexpr = TMatch (map false e,en,cases,opt (map term) def); etype = t }
 		| TTry (e1,catches) ->
-			{ e with eexpr = TTry (map term e1,List.map (fun (v,t,e) -> 
+			{ e with eexpr = TTry (map term e1,List.map (fun (v,t,e) ->
 				let old = save_locals ctx in
 				let v = add_local ctx v t in
 				let e = map term e in
@@ -208,7 +208,10 @@ let type_inline ctx cf f ethis params tret p =
 	else
 		let wrap e =
 			(* we can't mute the type of the expression because it is not correct to do so *)
-			mk (TCast (e,None)) tret e.epos
+			if e.etype == tret then
+				e
+			else
+				mk (TParenthesis e) tret e.epos
 		in
 		let e = (match e.eexpr, init with
 			| TBlock [e] , None -> wrap e
@@ -339,17 +342,96 @@ let optimize_for_loop ctx i e1 e2 p =
 	| _ ->
 		None
 
+(* ---------------------------------------------------------------------- *)
+(* 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
+*)
+
+let conflicts op op2 left =
+	match op, op2 with
+	(*
+		these three have the same precedence in haXe but different in other languages
+	*)
+	| (OpOr | OpXor | OpAnd), (OpOr | OpXor | OpAnd) -> true
+	(*
+		bitshifts have higher priority in haXe than in ECMAScript
+	*)
+	| (OpShl | OpShr | OpUShr | OpEq | OpNotEq | OpGt | OpLt | OpGte | OpLte) , (OpShl | OpShr | OpUShr | OpEq | OpNotEq | OpGt | OpLt | OpGte | OpLte) -> true
+	(*
+		% have have higher priority than / * in haXe than in ECMAScript
+	*)
+	| OpMult, OpMult -> false
+	| (OpMult | OpDiv | OpMod) , (OpMult | OpDiv | OpMod) -> true
+	(*
+		there is no real ambiguity here, but it's more easy to read if both are separated
+	*)
+	| (OpBoolAnd | OpBoolOr), (OpBoolAnd | OpBoolOr) -> op != op2
+	| _ ->
+		Parser.swap op2 op
+
+let sanitize_expr e =
+	let parent e =
+		mk (TParenthesis e) e.etype e.epos
+	in
+	let block e =
+		mk (TBlock [e]) e.etype e.epos
+	in
+	match e.eexpr with
+	| TBinop (op,e1,e2) ->
+		let rec loop ee left =
+			match ee.eexpr with
+			| TBinop (op2,_,_) -> conflicts op op2 left
+			| TIf _ -> Parser.is_not_assign op
+			| TCast (e,None) -> loop e left
+			| _ -> 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 (op,mode,e2) ->
+		let rec loop ee =
+			match ee.eexpr with
+			| TBinop _ -> parent e2
+			| TCast (e,None) -> loop e
+			| _ -> e2
+		in
+		{ e with eexpr = TUnop (op,mode,loop e2) }
+	| TIf (e1,e2,eelse) ->
+		let e1 = (match e1.eexpr with
+			| TParenthesis _ -> e1
+			| _ -> parent e1
+		) in
+		let e2 = (match e2.eexpr, eelse with
+			| TIf (_,_,Some _) , _ | TIf (_,_,None), Some _ -> block e2
+			| _ -> e2
+		) in
+		{ e with eexpr = TIf (e1,e2,eelse) }
+	| TFunction f ->
+		(match f.tf_expr.eexpr with
+		| TBlock _ -> e
+		| _ -> { e with eexpr = TFunction { f with tf_expr = block f.tf_expr } })
+	| _ ->
+		e
+
+let rec sanitize e =
+	Type.map_expr sanitize (sanitize_expr e)
+
 (* ---------------------------------------------------------------------- *)
 (* REDUCE *)
 
-let rec reduce_loop ctx is_sub e =
+let rec reduce_loop ctx e =
 	let is_float t =
 		match follow t with
 		| TInst ({ cl_path = ([],"Float") },_) -> true
 		| _ -> false
 	in
-	let e = Type.map_expr (reduce_loop ctx (match e.eexpr with TBlock _ -> false | _ -> true)) e in
-	match e.eexpr with
+	let e = Type.map_expr (reduce_loop ctx) e in
+	sanitize_expr (match e.eexpr with
 	| TIf ({ eexpr = TConst (TBool t) },e1,e2) ->
 		(if t then e1 else match e2 with None -> { e with eexpr = TBlock [] } | Some e -> e)
 	| TWhile ({ eexpr = TConst (TBool false) },sub,flag) ->
@@ -454,7 +536,8 @@ let rec reduce_loop ctx is_sub e =
 			| OpAssign -> e
 			| _ ->
 				error "You cannot directly compare enums with arguments. Use either 'switch' or 'Type.enumEq'" e.epos)
-		| _ -> e)
+		| _ ->
+			e)
 	| TUnop (op,flag,esub) ->
 		(match op, esub.eexpr with
 		| Not, TConst (TBool f) -> { e with eexpr = TConst (TBool (not f)) }
@@ -479,8 +562,13 @@ let rec reduce_loop ctx is_sub e =
 			| Some e -> e)
 		| _ ->
 			e)
-	| TParenthesis ({ eexpr = TConst _ } as ec) | TBlock [{ eexpr = TConst _ } as ec] ->
+	| TBlock [{ eexpr = TConst _ } as ec] ->
 		{ ec with epos = e.epos }
+	| TParenthesis ec ->
+		(match ec.eexpr with
+		| TBinop _ -> e (* TODO : we could remove this after we check all operators works well *)
+		| TNew _ when ctx.com.platform = Cpp -> e (* TODO : fix in cpp generator *)
+		| _ -> { ec with epos = e.epos })
 	| TSwitch (_,cases,_) ->
 		List.iter (fun (cl,_) ->
 			List.iter (fun e ->
@@ -491,24 +579,24 @@ let rec reduce_loop ctx is_sub e =
 		) cases;
 		e
 	| _ ->
-		e
+		e)
 
 let reduce_expression ctx e =
-	if ctx.com.foptimize then reduce_loop ctx false e else e
-	
+	if ctx.com.foptimize then reduce_loop ctx e else e
+
 (* ---------------------------------------------------------------------- *)
 (* ELIMINATE DEAD CODE *)
 
 (*
-	if dead code elimination is on, any class without fields is eliminated from the output. Also inline members 
+	if dead code elimination is on, any class without fields is eliminated from the output. Also inline members
 	are eliminated unless marked as @:keep
 *)
-	
+
 let filter_dead_code com =
 	let s_class c = s_type_path c.cl_path in
 	let s_field c cf = (s_class c) ^ "." ^ cf.cf_name in
 	let remove_inlines c =
-		let remove_inline_fields lst = 
+		let remove_inline_fields lst =
 			List.filter(fun cf ->
 				match cf.cf_kind with
 				| Var k when ((k.v_read = AccInline) && (not (has_meta ":keep" cf.cf_meta))) ->
@@ -527,8 +615,8 @@ let filter_dead_code com =
 	com.types <- List.filter (fun t ->
 		match t with
 		| TClassDecl c ->
-			if (c.cl_extern or has_meta ":keep" c.cl_meta) then 
-				true 
+			if (c.cl_extern or has_meta ":keep" c.cl_meta) then
+				true
 			else (
 				remove_inlines c;
 				match (c.cl_ordered_statics, c.cl_ordered_fields, c.cl_constructor) with
@@ -540,35 +628,3 @@ let filter_dead_code com =
 		| _ ->
 			true
 	) com.types
-
-
-(* ---------------------------------------------------------------------- *)
-(* 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
-*)
-
-let rec sanitize e =
-	match e.eexpr with
-	| TBinop (op,e1,e2) ->
-		let parent e = mk (TParenthesis e) e.etype e.epos in
-		let e1 = sanitize e1 in
-		let e2 = sanitize e2 in
-		let e1 = (match e1.eexpr with
-			| TBinop (op2,_,_) when Parser.swap op2 op -> parent e1
-			| _ -> e1
-		) in
-		let e2 = (match e2.eexpr with
-			| TBinop (op2,_,_) when Parser.swap op2 op -> parent e2
-			| _ -> e2
-		) in
-		{ e with eexpr = TBinop (op,e1,e2) }
-	| TUnop (op,mode,({ eexpr = TBinop _ } as e)) ->
-		{ e with eexpr = TUnop (op,mode,mk (TParenthesis e) e.etype e.epos) }
-	| _ ->
-		Type.map_expr sanitize e
-

tests/unit/Test.hx

@@ -181,6 +181,7 @@ class Test #if swf_mark implements mt.Protect #end #if as3 implements haxe.Publi
 		tf.selectable = true;
 		#end
 		var classes = [
+			new TestOps(),
 			new TestBasetypes(),
 			new TestReflect(),
 			new TestBytes(),
@@ -192,7 +193,9 @@ class Test #if swf_mark implements mt.Protect #end #if as3 implements haxe.Publi
 			new TestResource(),
 			new TestEReg(),
 			new TestType(),
+			#if !macro
 			new TestXML(),
+			#end
 			new TestMeta(),
 //			new TestRemoting(),
 		];

tests/unit/TestMisc.hx

@@ -245,6 +245,7 @@ class TestMisc extends Test {
 		// check that operations are correctly generated
 		var x = 3; // prevent optimization
 		eq( 2 * foo(x), 16 );
+		eq( -foo(x), -8 );
 	}
 
 	function testEvalAccessOrder() {

tests/unit/TestOps.hx

@@ -0,0 +1,37 @@
+package unit;
+
+class TestOps extends Test {
+	
+	public function testOps()
+	{
+		eq(1 + 2 + "", "3");
+		eq((1 + 2) + "", "3");
+		eq(1 + (2 + ""), "12");
+		
+		eq(4 - 3 + "", "1");
+		eq((4 - 3) + "", "1");
+		//eq(4 - (3 + ""), "1");
+		
+		eq(4 | 3 & 1, 1);
+		eq((4 | 3) & 1, 1);
+		eq(4 | (3 & 1), 5);
+		
+		eq(4 & 3 | 1, 1);
+		eq((4 & 3) | 1, 1);
+		eq(4 & (3 | 1), 0);
+		
+		eq( - 5 + 1, -4 );
+		eq( - (5 + 1), -6 );
+		
+		t( 3 == 7 >> 1 );
+		
+		eq( 5 % 3 * 4, 8 );
+		eq( (5 % 3) * 4, 8 );
+		eq( 5 % (3 * 4), 5 );
+		
+		eq( 20 / 2 / 2, 5 );
+		eq( (20 / 2) / 2, 5 );
+		eq( 20 / (2 / 2), 20 );
+	}
+	
+}

tests/unit/params.hxml

@@ -0,0 +1,4 @@
+-debug
+-cp ..
+-resource res1.txt
+-resource res2.bin

tests/unit/unit.hxml

@@ -1,43 +1,28 @@
 -cp ..
 -swf unit8.swf
+-swf-version 8
 -swf-header 300:300:30:FFFFFF
 -main unit.Test
--resource res1.txt
--resource res2.bin
--D noopt
+params.hxml
 --next
 -swf9 unit9.swf
 -main unit.Test
--debug
--cp ..
--resource res1.txt
--resource res2.bin
--D noopt
+params.hxml
 --next
 -as3 as3
 -cp ..
 -main unit.Test
--D noopt
 --next
 -js unit.js
 unit.Test
--cp ..
--resource res1.txt
--resource res2.bin
--D noopt
+params.hxml
 --next
 -neko unit.n
 -main unit.Test
--cp ..
--resource res1.txt
--resource res2.bin
--D noopt
+params.hxml
 --next
--cp ..
--resource res1.txt
--resource res2.bin
--D noopt
 -main unit.Test
+params.hxml
 --interp
 --next
 -neko remoting.n
@@ -46,18 +31,11 @@ unit.Test
 --next
 -php php
 -main unit.Test
--cp ..
--resource res1.txt
--resource res2.bin
--D noopt
+params.hxml
 --next
 -neko runcpp.n
 -main RunCpp
 --next
 -cpp cpp
--debug
 -main unit.Test
--cp ..
--resource res1.txt
--resource res2.bin
--D noopt
+params.hxml

tests/unit/unit.hxproj

@@ -21,7 +21,7 @@
     <option flashStrict="False" />
     <option mainClass="unit.Test" />
     <option enabledebug="False" />
-    <option additional="-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt&#xA;&#xA;# Flash9&#xA;--next&#xA;-swf9 unit9.swf&#xA;-main unit.Test&#xA;-debug&#xA;-cp ..&#xA;-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt&#xA;&#xA;# AS3&#xA;--next&#xA;-as3 as3&#xA;-cp ..&#xA;-main unit.Test&#xA;-D noopt&#xA;#-cmd mxmlc -default-size 800 600 -debug -output unit9_as3.swf as3/__main__.as&#xA;&#xA;# JS&#xA;--next&#xA;-js unit.js&#xA;unit.Test&#xA;-cp ..&#xA;-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt&#xA;&#xA;# Neko&#xA;--next&#xA;-neko unit.n&#xA;-main unit.Test&#xA;-cp ..&#xA;-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt&#xA;&#xA;# MACROS&#xA;--next&#xA;-cp ..&#xA;-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt&#xA;-main unit.Test&#xA;--interp&#xA;&#xA;# RemotingServer&#xA;--next&#xA;-neko remoting.n&#xA;-main unit.RemotingServer&#xA;-cp ..&#xA;&#xA;# PHP&#xA;--next&#xA;-php php&#xA;-main unit.Test&#xA;-cp ..&#xA;-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt&#xA;&#xA;# CPP&#xA;--next&#xA;-neko runcpp.n&#xA;-main RunCpp&#xA;--next&#xA;-cpp cpp&#xA;-debug&#xA;-main unit.Test&#xA;-cp ..&#xA;-resource res1.txt&#xA;-resource res2.bin&#xA;-D noopt" />
+    <option additional="params.hxml&#xA;&#xA;# Flash9&#xA;--next&#xA;-swf9 unit9.swf&#xA;-main unit.Test&#xA;params.hxml&#xA;&#xA;# AS3&#xA;--next&#xA;-as3 as3&#xA;-cp ..&#xA;-main unit.Test&#xA;#-cmd mxmlc -default-size 800 600 -debug -output unit9_as3.swf as3/__main__.as&#xA;&#xA;# JS&#xA;--next&#xA;-js unit.js&#xA;unit.Test&#xA;params.hxml&#xA;&#xA;# Neko&#xA;--next&#xA;-neko unit.n&#xA;-main unit.Test&#xA;params.hxml&#xA;&#xA;# MACROS&#xA;--next&#xA;-main unit.Test&#xA;params.hxml&#xA;--interp&#xA;&#xA;# RemotingServer&#xA;--next&#xA;-neko remoting.n&#xA;-main unit.RemotingServer&#xA;-cp ..&#xA;&#xA;# PHP&#xA;--next&#xA;-php php&#xA;-main unit.Test&#xA;params.hxml&#xA;&#xA;# CPP&#xA;--next&#xA;-neko runcpp.n&#xA;-main RunCpp&#xA;--next&#xA;-cpp cpp&#xA;-main unit.Test&#xA;params.hxml" />
   </build>
   <!-- haxelib libraries -->
   <haxelib>

typer.ml

@@ -283,7 +283,7 @@ let make_call ctx e params t p =
 		if f.cf_kind <> Method MethInline then raise Exit;
 		if not ctx.g.doinline then (match cl with Some { cl_extern = true } -> () | _ -> raise Exit);
 		ignore(follow f.cf_type); (* force evaluation *)
-		let params = List.map (Optimizer.reduce_expression ctx) params in
+		let params = List.map (ctx.g.do_optimize ctx) params in
 		(match f.cf_expr with
 		| Some { eexpr = TFunction fd } ->
 			(match Optimizer.type_inline ctx f fd ethis params t p with