[hl] Rework Null<Int/Float/Bool> comparison for spec/alloc (#11612)

* [tests] import some ops tests from genjvm

* echo lines on flash unit tests

* Something that pass the spec test

* Add jnull when compare nullnum with num

* Improve syntax and fun name

* Remove the use of common_type_safe_number

* Also skip todyn for Null<Bool>/Bool eq

* Revert TestOps as Flash fail

* Revert "Revert TestOps as Flash fail"

This reverts commit f82a51c29599ed69b9ec7d5726d97f0cf585b16d.

* Do not do testNadakoOps for flash

---------

Co-authored-by: Simon Krajewski <[email protected]>
Co-authored-by: Aurel Bílý <[email protected]>

src/generators/genhl.ml

@@ -951,34 +951,39 @@ let write_mem ctx bytes index t r =
 	| _ ->
 		die "" __LOC__
 
+let common_type_number ctx t1 t2 p =
+	if t1 == t2 then t1 else
+	match t1, t2 with
+	| HUI8, (HUI16 | HI32 | HI64 | HF32 | HF64) -> t2
+	| HUI16, (HI32 | HI64 | HF32 | HF64) -> t2
+	| (HI32 | HI64), HF32 -> t2 (* possible loss of precision *)
+	| (HI32 | HI64 | HF32), HF64 -> t2
+	| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> t1
+	| _ ->
+		die "" __LOC__
+
 let common_type ctx e1 e2 for_eq p =
 	let t1 = to_type ctx e1.etype in
 	let t2 = to_type ctx e2.etype in
-	let rec loop t1 t2 =
-		if t1 == t2 then t1 else
-		match t1, t2 with
-		| HUI8, (HUI16 | HI32 | HI64 | HF32 | HF64) -> t2
-		| HUI16, (HI32 | HI64 | HF32 | HF64) -> t2
-		| (HI32 | HI64), HF32 -> t2 (* possible loss of precision *)
-		| (HI32 | HI64 | HF32), HF64 -> t2
-		| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> t1
-		| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HNull t2) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
-		| (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
-		| (HNull t1), (HNull t2) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
-		| HDyn, (HUI8|HUI16|HI32|HI64|HF32|HF64) -> HF64
-		| (HUI8|HUI16|HI32|HI64|HF32|HF64), HDyn -> HF64
-		| HDyn, _ -> HDyn
-		| _, HDyn -> HDyn
-		| _ when for_eq && safe_cast t1 t2 -> t2
-		| _ when for_eq && safe_cast t2 t1 -> t1
-		| HBool, HNull HBool when for_eq -> t2
-		| HNull HBool, HBool when for_eq -> t1
-		| HObj _, HVirtual _ | HVirtual _, HObj _ | HVirtual _ , HVirtual _ -> HDyn
-		| HFun _, HFun _ -> HDyn
-		| _ ->
-			abort ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) p
-	in
-	loop t1 t2
+	if t1 == t2 then t1 else
+	match t1, t2 with
+	| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> common_type_number ctx t1 t2 p
+	| (HUI8|HUI16|HI32|HI64|HF32|HF64 as t1), (HNull t2)
+	| (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64 as t2)
+	| (HNull t1), (HNull t2)
+		-> if for_eq then HNull (common_type_number ctx t1 t2 p) else common_type_number ctx t1 t2 p
+	| HDyn, (HUI8|HUI16|HI32|HI64|HF32|HF64) -> HF64
+	| (HUI8|HUI16|HI32|HI64|HF32|HF64), HDyn -> HF64
+	| HDyn, _ -> HDyn
+	| _, HDyn -> HDyn
+	| _ when for_eq && safe_cast t1 t2 -> t2
+	| _ when for_eq && safe_cast t2 t1 -> t1
+	| HBool, HNull HBool when for_eq -> t2
+	| HNull HBool, HBool when for_eq -> t1
+	| HObj _, HVirtual _ | HVirtual _, HObj _ | HVirtual _ , HVirtual _ -> HDyn
+	| HFun _, HFun _ -> HDyn
+	| _ ->
+		abort ("Can't find common type " ^ tstr t1 ^ " and " ^ tstr t2) p
 
 let captured_index ctx v =
 	if not (has_var_flag v VCaptured) then None else try Some (PMap.find v.v_id ctx.m.mcaptured.c_map) with Not_found -> None
@@ -1479,24 +1484,92 @@ and jump_expr ctx e jcond =
 			jump ctx (fun i -> OJAlways i)
 		else
 			(fun i -> ())
-	| TBinop (OpEq | OpNotEq | OpGt | OpGte | OpLt | OpLte as jop, e1, e2) ->
-		let t = common_type ctx e1 e2 (match jop with OpEq | OpNotEq -> true | _ -> false) e.epos in
-		let r1 = eval_to ctx e1 t in
-		hold ctx r1;
-		let r2 = eval_to ctx e2 t in
-		free ctx r1;
-		let unsigned = unsigned_op e1 e2 in
-		jump ctx (fun i ->
-			let lt a b = if unsigned then OJULt (a,b,i) else if not jcond && is_float t then OJNotGte (a,b,i) else OJSLt (a,b,i) in
-			let gte a b = if unsigned then OJUGte (a,b,i) else if not jcond && is_float t then OJNotLt (a,b,i) else OJSGte (a,b,i) in
+	| TBinop (OpEq | OpNotEq as jop, e1, e2) ->
+		let jumpeq r1 r2 = jump ctx (fun i ->
 			match jop with
 			| OpEq -> if jcond then OJEq (r1,r2,i) else OJNotEq (r1,r2,i)
 			| OpNotEq -> if jcond then OJNotEq (r1,r2,i) else OJEq (r1,r2,i)
-			| OpGt -> if jcond then lt r2 r1 else gte r2 r1
-			| OpGte -> if jcond then gte r1 r2 else lt r1 r2
-			| OpLt -> if jcond then lt r1 r2 else gte r1 r2
-			| OpLte -> if jcond then gte r2 r1 else lt r2 r1
 			| _ -> die "" __LOC__
+		) in
+		let t1 = to_type ctx e1.etype in
+		let t2 = to_type ctx e2.etype in
+		(match t1, t2 with
+		| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
+		| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
+		| HNull (HBool as ti1), (HBool as ti2)
+		| (HBool as ti1), HNull (HBool as ti2)
+			->
+			let t1,t2,e1,e2 = if is_nullt t2 then t2,t1,e2,e1 else t1,t2,e1,e2 in
+			let r1 = eval_expr ctx e1 in
+			hold ctx r1;
+			let jnull = if is_nullt t1 then jump ctx (fun i -> OJNull (r1, i)) else (fun i -> ()) in
+			let t = common_type_number ctx ti1 ti2 e.epos in (* HBool has t==ti1==ti2 *)
+			let a = cast_to ctx r1 t e1.epos in
+			hold ctx a;
+			let b = eval_to ctx e2 t in
+			free ctx a;
+			free ctx r1;
+			let j = jumpeq a b in
+			if jcond then (jnull(););
+			(fun() -> if not jcond then (jnull();); j());
+		| _ ->
+			let t = common_type ctx e1 e2 true e.epos in
+			let a = eval_to ctx e1 t in
+			hold ctx a;
+			let b = eval_to ctx e2 t in
+			free ctx a;
+			let j = jumpeq a b in
+			(fun() -> j());
+		)
+	| TBinop (OpGt | OpGte | OpLt | OpLte as jop, e1, e2) ->
+		let t1 = to_type ctx e1.etype in
+		let t2 = to_type ctx e2.etype in
+		let unsigned = unsigned_op e1 e2 in
+		let jumpcmp t r1 r2 = jump ctx (fun i ->
+			let lt a b = if unsigned then OJULt (a,b,i) else if not jcond && is_float t then OJNotGte (a,b,i) else OJSLt (a,b,i) in
+			let gte a b = if unsigned then OJUGte (a,b,i) else if not jcond && is_float t then OJNotLt (a,b,i) else OJSGte (a,b,i) in
+			match jop with
+				| OpGt -> if jcond then lt r2 r1 else gte r2 r1
+				| OpGte -> if jcond then gte r1 r2 else lt r1 r2
+				| OpLt -> if jcond then lt r1 r2 else gte r1 r2
+				| OpLte -> if jcond then gte r2 r1 else lt r2 r1
+				| _ -> die "" __LOC__
+		) in
+		(match t1, t2 with
+		| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
+		| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
+		| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
+		| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
+			->
+			let r1 = eval_expr ctx e1 in
+			hold ctx r1;
+			let jnull1 = if is_nullt t1 then jump ctx (fun i -> OJNull (r1, i)) else (fun i -> ()) in
+			let r2 = eval_expr ctx e2 in
+			hold ctx r2;
+			let jnull2 = if is_nullt t2 then jump ctx (fun i -> OJNull (r2, i)) else (fun i -> ()) in
+			let t = common_type_number ctx ti1 ti2 e.epos in
+			let a = cast_to ctx r1 t e1.epos in
+			hold ctx a;
+			let b = cast_to ctx r2 t e2.epos in
+			free ctx a;
+			free ctx r1;
+			free ctx r2;
+			let j = jumpcmp t a b in
+			if jcond then (jnull1(); jnull2(););
+			(fun() -> if not jcond then (jnull1(); jnull2();); j());
+		| HObj { pname = "String" }, HObj { pname = "String" }
+		| HDyn, _
+		| _, HDyn
+			->
+			let t = common_type ctx e1 e2 false e.epos in
+			let a = eval_to ctx e1 t in
+			hold ctx a;
+			let b = eval_to ctx e2 t in
+			free ctx a;
+			let j = jumpcmp t a b in
+			(fun() -> j());
+		| _ ->
+			abort ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) e.epos
 		)
 	| TBinop (OpBoolAnd, e1, e2) ->
 		let j = jump_expr ctx e1 false in
@@ -2341,23 +2414,9 @@ and eval_expr ctx e =
 			jexit());
 		out
 	| TBinop (bop, e1, e2) ->
-		let is_unsigned() = unsigned_op e1 e2 in
-		let boolop r f =
-			let j = jump ctx f in
-			op ctx (OBool (r,false));
-			op ctx (OJAlways 1);
-			j();
-			op ctx (OBool (r, true));
-		in
-		let binop r a b =
+		let arithbinop r a b =
 			let rec loop bop =
 				match bop with
-				| OpLte -> boolop r (fun d -> if is_unsigned() then OJUGte (b,a,d) else OJSLte (a,b,d))
-				| OpGt -> boolop r (fun d -> if is_unsigned() then OJULt (b,a,d) else OJSGt (a,b,d))
-				| OpGte -> boolop r (fun d -> if is_unsigned() then OJUGte (a,b,d) else OJSGte (a,b,d))
-				| OpLt -> boolop r (fun d -> if is_unsigned() then OJULt (a,b,d) else OJSLt (a,b,d))
-				| OpEq -> boolop r (fun d -> OJEq (a,b,d))
-				| OpNotEq -> boolop r (fun d -> OJNotEq (a,b,d))
 				| OpAdd ->
 					(match rtype ctx r with
 					| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 ->
@@ -2404,23 +2463,13 @@ and eval_expr ctx e =
 			loop bop
 		in
 		(match bop with
-		| OpLte | OpGt | OpGte | OpLt ->
+		| OpLte | OpGt | OpGte | OpLt | OpEq | OpNotEq ->
 			let r = alloc_tmp ctx HBool in
-			let t = common_type ctx e1 e2 false e.epos in
-			let a = eval_to ctx e1 t in
-			hold ctx a;
-			let b = eval_to ctx e2 t in
-			free ctx a;
-			binop r a b;
-			r
-		| OpEq | OpNotEq ->
-			let r = alloc_tmp ctx HBool in
-			let t = common_type ctx e1 e2 true e.epos in
-			let a = eval_to ctx e1 t in
-			hold ctx a;
-			let b = eval_to ctx e2 t in
-			free ctx a;
-			binop r a b;
+			let j = jump_expr ctx e false in
+			op ctx (OBool (r, true));
+			op ctx (OJAlways 1);
+			j();
+			op ctx (OBool (r, false));
 			r
 		| OpAdd | OpSub | OpMult | OpDiv | OpMod | OpShl | OpShr | OpUShr | OpAnd | OpOr | OpXor ->
 			let t = (match to_type ctx e.etype with HNull t -> t | t -> t) in
@@ -2437,7 +2486,7 @@ and eval_expr ctx e =
 			hold ctx a;
 			let b = eval e2 in
 			free ctx a;
-			binop r a b;
+			arithbinop r a b;
 			r
 		| OpAssign ->
 			let value() = eval_to ctx e2 (real_type ctx e1) in
@@ -2555,7 +2604,7 @@ and eval_expr ctx e =
 					hold ctx r;
 					let b = if bop = OpAdd && is_string (rtype ctx r) then to_string ctx (eval_expr ctx e2) e2.epos else eval_to ctx e2 (rtype ctx r) in
 					free ctx r;
-					binop r r b;
+					arithbinop r r b;
 					r))
 		| OpInterval | OpArrow | OpIn | OpNullCoal ->
 			die "" __LOC__)

src/generators/hlcode.ml

@@ -45,7 +45,7 @@ type ttype =
 	| HDynObj
 	| HAbstract of string * string index
 	| HEnum of enum_proto
-	| HNull of ttype
+	| HNull of ttype (* for not nullable type only *)
 	| HMethod of ttype list * ttype
 	| HStruct of class_proto
 	| HPacked of ttype
@@ -277,6 +277,12 @@ let is_number = function
 	| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 -> true
 	| _ -> false
 
+let is_nullt = function
+	| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64) -> true
+	| HNull HBool -> true
+	| HNull _ -> Globals.die "" __LOC__
+	| _ -> false
+
 (*
 	does the runtime value carry its type
 *)

tests/unit/src/unit/TestOps.hx

@@ -101,4 +101,207 @@ class TestOps extends Test {
 
 	static function getA() return { a:1 };
 
+	#if target.static
+
+	function testNullOps() {
+		var a:Null<Int> = 10;
+		// arithmetic
+		eq(9, a - 1);
+		eq(20, a * 2);
+		eq(5., a / 2); // careful with Float comparison...
+		eq(1, a % 3);
+
+		// bit
+		eq(20, a << 1);
+		eq(5, a >> 1);
+		eq(5, a >>> 1);
+		eq(10, a & 15);
+		eq(15, a | 15);
+		eq(2, a ^ 8);
+
+		// unary
+		eq(-10, -a);
+		eq(-11, ~a);
+
+		// boolean
+		var b:Null<Bool> = true;
+		eq(false, !b);
+		eq(false, b && falseValue);
+		eq(true, b && trueValue);
+		eq(true, b || falseValue);
+		eq(true, b || trueValue);
+
+		b = false;
+		eq(true, !b);
+		eq(false, b && falseValue);
+		eq(false, b && trueValue);
+		eq(false, b || falseValue);
+		eq(true, b || trueValue);
+
+		eq(true, a > 5);
+		eq(true, a >= 5);
+		eq(false, a < 5);
+		eq(false, a <= 5);
+		eq(true, a != 5);
+		eq(false, a != 10);
+
+		eq(false, 0 > a);
+		eq(false, 0 >= a);
+		eq(true, 0 < a);
+		eq(true, 0 <= a);
+		eq(true, 0 != a);
+		eq(false, 0 == a);
+
+		var minusA:Null<Int> = -10;
+		eq(true, 0 > minusA);
+		eq(true, 0 >= minusA);
+		eq(false, 0 < minusA);
+		eq(false, 0 <= minusA);
+		eq(true, 0 != minusA);
+		eq(false, 0 == minusA);
+	}
+
+	#if !flash // Will not fix for flash
+
+	function testNadakoOps() {
+		// bool
+		var nullBool:Null<Bool> = null;
+
+		t(null == nullBool);
+		t(nullBool == null);
+		f(false == nullBool);
+		f(nullBool == false);
+		t(false != nullBool);
+		t(nullBool != false);
+
+		// int
+		var nullInt:Null<Int> = null;
+
+		t(null == nullInt);
+		t(nullInt == null);
+		f(0 == nullInt);
+		f(nullInt == 0);
+		t(0 != nullInt);
+		t(nullInt != 0);
+
+		f(0 > nullInt);
+		f(0 >= nullInt);
+		f(0 < nullInt);
+		f(0 <= nullInt);
+
+		f(nullInt > 0);
+		f(nullInt >= 0);
+		f(nullInt < 0);
+		f(nullInt <= 0);
+
+		f(1 > nullInt);
+		f(1 >= nullInt);
+		f(1 < nullInt);
+		f(1 <= nullInt);
+
+		f(nullInt > 1);
+		f(nullInt >= 1);
+		f(nullInt < 1);
+		f(nullInt <= 1);
+
+		f(-1 > nullInt);
+		f(-1 >= nullInt);
+		f(-1 < nullInt);
+		f(-1 <= nullInt);
+
+		f(nullInt > -1);
+		f(nullInt >= -1);
+		f(nullInt < -1);
+		f(nullInt <= -1);
+
+		// // float
+		var nullFloat:Null<Float> = null;
+
+		t(null == nullFloat);
+		t(nullFloat == null);
+		f(0. == nullFloat);
+		f(nullFloat == 0.);
+		t(0. != nullFloat);
+		t(nullFloat != 0.);
+
+		f(0. > nullFloat);
+		f(0. >= nullFloat);
+		f(0. < nullFloat);
+		f(0. <= nullFloat);
+
+		f(nullFloat > 0.);
+		f(nullFloat >= 0.);
+		f(nullFloat < 0.);
+		f(nullFloat <= 0.);
+
+		f(1. > nullFloat);
+		f(1. >= nullFloat);
+		f(1. < nullFloat);
+		f(1. <= nullFloat);
+
+		f(nullFloat > 1.);
+		f(nullFloat >= 1.);
+		f(nullFloat < 1.);
+		f(nullFloat <= 1.);
+
+		f(-1. > nullFloat);
+		f(-1. >= nullFloat);
+		f(-1. < nullFloat);
+		f(-1. <= nullFloat);
+
+		f(nullFloat > -1.);
+		f(nullFloat >= -1.);
+		f(nullFloat < -1.);
+		f(nullFloat <= -1.);
+	}
+
+	#end
+
+	function testDynamicOps() {
+		var a:Dynamic = 10;
+		// arithmetic
+		eq(9., a - 1);
+		eq(20., a * 2);
+		feq(5., a / 2);
+		feq(1., a % 3);
+
+		// bit
+		eq(20, a << 1);
+		eq(5, a >> 1);
+		eq(5, a >>> 1);
+		eq(10, a & 15);
+		eq(15, a | 15);
+		eq(2, a ^ 8);
+
+		// unary
+		eq(-10., -a);
+		eq(-11, ~a);
+
+		// boolean
+		var b:Dynamic = true;
+		eq(false, !b);
+		eq(false, b && falseValue);
+		eq(true, b && trueValue);
+		eq(true, b || falseValue);
+		eq(true, b || trueValue);
+
+		b = false;
+		eq(true, !b);
+		eq(false, b && falseValue);
+		eq(false, b && trueValue);
+		eq(false, b || falseValue);
+		eq(true, b || trueValue);
+
+		eq(true, a > 5);
+		eq(true, a >= 5);
+		eq(false, a < 5);
+		eq(false, a <= 5);
+		eq(true, a != 5);
+		eq(false, a != 10);
+	}
+
+	static var trueValue = true;
+	static var falseValue = false;
+
+	#end
 }