Browse Source

more TestIssues passing

Nicolas Cannasse 9 years ago
parent
commit
772b2a9f69
3 changed files with 46 additions and 14 deletions
  1. 41 12
      genhl.ml
  2. 4 2
      std/hl/_std/Reflect.hx
  3. 1 0
      std/hl/types/Api.hx

+ 41 - 12
genhl.ml

@@ -703,7 +703,7 @@ and resolve_class ctx c pl statics =
 
 and field_type ctx f p =
 	match f with
-	| FInstance (c,pl,f) ->
+	| FInstance (c,pl,f) | FClosure (Some (c,pl),f) ->
 		let creal = resolve_class ctx c pl false in
 		let rec loop c =
 			try
@@ -1853,7 +1853,7 @@ and eval_expr ctx e =
 						| OpSub -> op ctx (OSub (r,a,b))
 						| OpMult -> op ctx (OMul (r,a,b))
 						| OpMod -> op ctx (if is_unsigned() then OUMod (r,a,b) else OSMod (r,a,b))
-						| OpDiv -> op ctx (if is_unsigned() then OUDiv (r,a,b) else OSDiv (r,a,b))
+						| OpDiv -> op ctx (OSDiv (r,a,b)) (* don't use UDiv since both operands are float already *)
 						| _ -> assert false)
 					| _ ->
 						assert false)
@@ -2161,7 +2161,13 @@ and eval_expr ctx e =
 			) el;
 			let tmp = if et = HDyn then alloc_tmp ctx (class_type ctx ctx.array_impl.aobj [] false) else r in
 			op ctx (OCall1 (tmp, alloc_fun_path ctx (["hl";"types"],"ArrayObj") "alloc", a));
-			if tmp <> r then op ctx (OSafeCast (r, tmp));
+			if tmp <> r then begin
+				let re = alloc_tmp ctx HBool in
+				op ctx (OBool (re,true));
+				let ren = alloc_tmp ctx (HNull HBool) in
+				op ctx (OToDyn (ren, re));
+				op ctx (OCall2 (r, alloc_fun_path ctx (["hl";"types"],"ArrayDyn") "alloc", tmp, ren));
+			end;
 		);
 		r
 	| TArray _ ->
@@ -3274,6 +3280,7 @@ type value =
 	| VDynObj of vdynobj
 	| VEnum of int * value array
 	| VAbstract of vabstract
+	| VVarArgs of vfunction * value option
 
 and vabstract =
 	| AHashBytes of (string, value) Hashtbl.t
@@ -3336,10 +3343,11 @@ let get_type = function
 	| VArray _ -> Some HArray
 	| VClosure (f,None) -> Some (match f with FFun f -> f.ftype | FNativeFun (_,_,t) -> t)
 	| VClosure (f,Some _) -> Some (match f with FFun { ftype = HFun(_::args,ret) } | FNativeFun (_,_,HFun(_::args,ret)) -> HFun (args,ret) | _ -> assert false)
+	| VVarArgs _ -> Some (HFun ([],HDyn))
 	| _ -> None
 
 let v_dynamic = function
-	| VNull	| VDyn _ | VObj _ | VClosure _ | VArray _ | VVirtual _ | VDynObj _ -> true
+	| VNull	| VDyn _ | VObj _ | VClosure _ | VArray _ | VVirtual _ | VDynObj _ | VVarArgs _ -> true
 	| _ -> false
 
 let rec is_compatible v t =
@@ -3371,6 +3379,7 @@ type cast =
 	| CNo
 	| CDyn of ttype
 	| CUnDyn of ttype
+	| CCast of ttype * ttype
 
 let interp code =
 
@@ -3527,6 +3536,7 @@ let interp code =
 		| VDynObj d -> "dynobj(" ^ String.concat "," (Hashtbl.fold (fun f i acc -> (f^":"^vstr_d d.dvalues.(i)) :: acc) d.dfields []) ^ ")"
 		| VEnum (i,vals) -> "enum#" ^ string_of_int i  ^ "(" ^ String.concat "," (Array.to_list (Array.map vstr_d vals)) ^ ")"
 		| VAbstract _ -> "abstract"
+		| VVarArgs _ -> "varargs"
 
 	and vstr v t =
 		match v with
@@ -3567,6 +3577,7 @@ let interp code =
 					n ^ "(" ^ String.concat "," (List.map2 vstr (Array.to_list vals) (Array.to_list pl)) ^ ")"
 			| _ ->
 				assert false)
+		| VVarArgs _ -> "varargs"
 
 	and fstr = function
 		| FFun f -> "function@" ^ string_of_int f.findex
@@ -3694,23 +3705,27 @@ let interp code =
 		| (HI8|HI16|HI32|HF32|HF64), HNull ((HI8|HI16|HI32|HF32|HF64) as rt) ->
 			let v = dyn_cast v t rt in
 			VDyn (v,rt)
+		| HBool, HNull HBool ->
+			VDyn (v,HBool)
 		| _, HDyn ->
 			make_dyn v t
 		| HFun (args1,t1), HFun (args2,t2) when List.length args1 = List.length args2 ->
 			(match v with
 			| VClosure (fn,farg) ->
-				let conv = List.map2 (fun t1 t2 ->
-					if safe_cast t2 t1 || (t2 = HDyn && is_dynamic t1) then CNo
+				let get_conv t1 t2 =
+					if safe_cast t1 t2 || (t2 = HDyn && is_dynamic t1) then CNo
 					else if t2 = HDyn then CDyn t1
 					else if t1 = HDyn then CUnDyn t2
-					else invalid()
-				) args1 args2 in
-				let rconv = if safe_cast t1 t2 then CNo else if t2 = HDyn then CDyn t1 else if t1 = HDyn then CUnDyn t2 else invalid() in
+					else CCast (t1,t2)
+				in
+				let conv = List.map2 get_conv args2 args1 in
+				let rconv = get_conv t1 t2 in
 				let convert v c =
 					match c with
 					| CNo -> v
 					| CDyn t -> make_dyn v t
 					| CUnDyn t -> dyn_cast v HDyn t
+					| CCast (t1,t2) -> dyn_cast v t1 t2
 				in
 				VClosure (FNativeFun ("~convert",(fun args ->
 					let args = List.map2 convert args conv in
@@ -3719,6 +3734,10 @@ let interp code =
 				),rt),None)
 			| _ ->
 				assert false)
+		| HDyn, HFun (targs,tret) when (match v with VVarArgs _ -> true | _ -> false) ->
+			VClosure (FNativeFun ("~varargs",(fun args ->
+				dyn_call v (List.map2 (fun v t -> (v,t)) args targs) tret
+			),rt),None)
 		| HDyn, _ ->
 			(match get_type v with
 			| None -> assert false
@@ -3758,6 +3777,9 @@ let interp code =
 			dyn_cast v fret tret
 		| VNull ->
 			null_access()
+		| VVarArgs (f,a) ->
+			let arr = VArray (Array.of_list (List.map (fun (v,t) -> make_dyn v t) args),HDyn) in
+			dyn_call (VClosure (f,a)) [arr,HArray] tret
 		| _ ->
 			throw_msg (vstr_d v ^ " cannot be called")
 
@@ -3935,6 +3957,9 @@ let interp code =
 			let r = dyn_compare a t b t in
 			if r = invalid_comparison then false else op r 0
 		in
+		let ufloat v =
+			if v < 0l then Int32.to_float v +. 4294967296. else Int32.to_float v
+		in
 		let rec loop() =
 			let op = f.code.(!pos) in
 			incr pos;
@@ -3950,9 +3975,9 @@ let interp code =
 			| OSub (r,a,b) -> set r (numop Int32.sub ( -. ) a b)
 			| OMul (r,a,b) -> set r (numop Int32.mul ( *. ) a b)
 			| OSDiv (r,a,b) -> set r (numop (fun a b -> if b = 0l then 0l else Int32.div a b) ( /. ) a b)
-			| OUDiv (r,a,b) -> set r (iop (fun a b -> if b = 0l then 0l else assert false (* TODO : unsigned div *)) a b)
+			| OUDiv (r,a,b) -> set r (iop (fun a b -> if b = 0l then 0l else Int32.of_float ((ufloat a) /. (ufloat b))) a b)
 			| OSMod (r,a,b) -> set r (numop (fun a b -> if b = 0l then 0l else Int32.rem a b) mod_float a b)
-			| OUMod (r,a,b) -> set r (iop (fun a b -> if b = 0l then 0l else assert false (* TODO : unsigned mod *)) a b)
+			| OUMod (r,a,b) -> set r (iop (fun a b -> if b = 0l then 0l else Int32.of_float (mod_float (ufloat a) (ufloat b))) a b)
 			| OShl (r,a,b) -> set r (iop (fun a b -> Int32.shift_left a (Int32.to_int b)) a b)
 			| OSShr (r,a,b) -> set r (iop (fun a b -> Int32.shift_right a (Int32.to_int b)) a b)
 			| OUShr (r,a,b) -> set r (iop (fun a b -> Int32.shift_right_logical a (Int32.to_int b)) a b)
@@ -3990,7 +4015,7 @@ let interp code =
 			| OJAlways i -> pos := !pos + i
 			| OToDyn (r,a) -> set r (make_dyn (get a) f.regs.(a))
 			| OToSFloat (r,a) -> set r (match get a with VInt v -> VFloat (Int32.to_float v) | VFloat _ as v -> v | _ -> assert false)
-			| OToUFloat (r,a) -> set r (match get a with VInt v -> VFloat (if v < 0l then Int32.to_float v +. 4294967296. else Int32.to_float v) | VFloat _ as v -> v | _ -> assert false)
+			| OToUFloat (r,a) -> set r (match get a with VInt v -> VFloat (ufloat v) | VFloat _ as v -> v | _ -> assert false)
 			| OToInt (r,a) -> set r (match get a with VFloat v -> VInt (Int32.of_float v) | VInt _ as v -> v | _ -> assert false)
 			| OLabel _ -> ()
 			| ONew r ->
@@ -4836,6 +4861,10 @@ let interp code =
 				| [VClosure (_,None)] -> VNull
 				| [VClosure (_,Some v)] -> v
 				| _ -> assert false)
+			| "make_var_args" ->
+				(function
+				| [VClosure (f,arg)] -> VVarArgs (f,arg)
+				| _ -> assert false)
 			| "bytes_find" ->
 				(function
 				| [VBytes src; VInt pos; VInt len; VBytes chk; VInt cpos; VInt clen; ] ->

+ 4 - 2
std/hl/_std/Reflect.hx

@@ -128,8 +128,10 @@ class Reflect {
 	}
 
 	static function _makeVarArgs( f : Array<Dynamic> -> Dynamic ) : Dynamic {
-		throw "TODO";
-		return null;
+		return hl.types.Api.makeVarArgs(function(args:hl.types.NativeArray<Dynamic>) {
+			var arr = hl.types.ArrayDyn.alloc(hl.types.ArrayObj.alloc(args), true);
+			return f(cast arr);
+		});
 	}
 
 }

+ 1 - 0
std/hl/types/Api.hx

@@ -10,5 +10,6 @@ extern class Api {
 	@:hlNative("std","get_closure_value") static function getClosureValue( f : haxe.Constraints.Function ) : Dynamic;
 	@:hlNative("std","no_closure") static function noClosure( f : haxe.Constraints.Function ) : haxe.Constraints.Function;
 	@:hlNative("std", "safe_cast") static function safeCast( v : Dynamic, t : Type ) : Dynamic;
+	@:hlNative("std", "make_var_args") static function makeVarArgs( v : NativeArray<Dynamic> -> Dynamic ) : Dynamic;
 
 }