diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 0c26dd72ed6..906269742f1 100644 --- a/src/generators/genhl.ml +++ b/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__) diff --git a/src/generators/hlcode.ml b/src/generators/hlcode.ml index 1636c2546db..889015c6795 100644 --- a/src/generators/hlcode.ml +++ b/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 *) diff --git a/tests/unit/src/unit/TestOps.hx b/tests/unit/src/unit/TestOps.hx index 5893cb068b7..474c1aff894 100644 --- a/tests/unit/src/unit/TestOps.hx +++ b/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 = 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 = 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 = -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 = null; + + t(null == nullBool); + t(nullBool == null); + f(false == nullBool); + f(nullBool == false); + t(false != nullBool); + t(nullBool != false); + + // int + var nullInt:Null = 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 = 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 }