Bläddra i källkod

[hl] add tgroup for number check, add tests and fixes (#12418)

* [hl] add tgroup for number check, add tests and fixes

* [tests] add some more tests on mod/div, bitwise op

* Fix tgroup size val on Null X

* Rework tgroup with a simpler definition
Yuxiao Mao 5 dagar sedan
förälder
incheckning
5d4cf46e65

+ 140 - 190
src/generators/genhl.ml

@@ -74,6 +74,7 @@ type array_impl = {
 	abase : tclass;
 	adyn : tclass;
 	aobj : tclass;
+	aui8 : tclass;
 	aui16 : tclass;
 	ai32 : tclass;
 	af32 : tclass;
@@ -156,7 +157,7 @@ let is_extern_field f =
 
 let is_array_class name =
 	match name with
-	| "hl.types.ArrayDyn" | "hl.types.ArrayBytes_Int" | "hl.types.ArrayBytes_Float" | "hl.types.ArrayObj" | "hl.types.ArrayBytes_hl_F32" | "hl.types.ArrayBytes_hl_UI16" | "hl.types.ArrayBytes_hl_I64" -> true
+	| "hl.types.ArrayDyn" | "hl.types.ArrayBytes_Int" | "hl.types.ArrayBytes_Float" | "hl.types.ArrayObj" | "hl.types.ArrayBytes_hl_F32" | "hl.types.ArrayBytes_hl_UI16" | "hl.types.ArrayBytes_hl_UI8" | "hl.types.ArrayBytes_hl_I64" -> true
 	| _ -> false
 
 let is_array_type t =
@@ -201,13 +202,6 @@ let tuple_type ctx tl =
 		ctx.cached_tuples <- PMap.add tl ct ctx.cached_tuples;
 		ct
 
-let type_size_bits = function
-	| HUI8 | HBool -> 0
-	| HUI16 -> 1
-	| HI32 | HF32 -> 2
-	| HI64 | HF64 -> 3
-	| _ -> die "" __LOC__
-
 let new_lookup() =
 	{
 		arr = DynArray.create();
@@ -288,11 +282,13 @@ let array_class ctx t =
 		ctx.array_impl.ai32
 	| HUI16 ->
 		ctx.array_impl.aui16
+	| HUI8 ->
+		ctx.array_impl.aui8
 	| HF32 ->
 		ctx.array_impl.af32
 	| HF64 ->
 		ctx.array_impl.af64
-	| HI64 ->
+	| HI64 | HGUID ->
 		begin match ctx.array_impl.ai64 with
 		| None -> die "" __LOC__
 		| Some c -> c
@@ -976,71 +972,59 @@ let shl ctx idx v =
 	end
 
 let set_default ctx r =
-	match rtype ctx r with
-	| HUI8 | HUI16 | HI32 | HI64 ->
+	let t = rtype ctx r in
+	match get_group t, t with
+	| GInt, _ ->
 		op ctx (OInt (r,alloc_i32 ctx 0l))
-	| HF32 | HF64 ->
+	| GFloat, _ ->
 		op ctx (OFloat (r,alloc_float ctx 0.))
-	| HBool ->
+	| GBool, _ ->
 		op ctx (OBool (r, false))
-	| HType ->
+	| _, HType ->
 		op ctx (OType (r, HVoid))
 	| _ ->
 		op ctx (ONull r)
 
 let read_mem ctx rdst bytes index t =
-	match t with
-	| HUI8 ->
-		op ctx (OGetUI8 (rdst,bytes,index))
-	| HUI16 ->
-		op ctx (OGetUI16 (rdst,bytes,index))
-	| HI32 | HI64 | HF32 | HF64 ->
+	match get_group t with
+	| GInt | GFloat ->
+		let nb = type_size_bits t in
+		if nb == 0 then op ctx (OGetUI8 (rdst,bytes,index)) else
+		if nb == 1 then op ctx (OGetUI16 (rdst,bytes,index)) else
 		op ctx (OGetMem (rdst,bytes,index))
 	| _ ->
 		die "" __LOC__
 
 let write_mem ctx bytes index t r =
-	match t with
-	| HUI8 ->
-		op ctx (OSetUI8 (bytes,index,r))
-	| HUI16 ->
-		op ctx (OSetUI16 (bytes,index,r))
-	| HI32 | HI64 | HF32 | HF64 ->
+	match get_group t with
+	| GInt | GFloat ->
+		let nb = type_size_bits t in
+		if nb == 0 then op ctx (OSetUI8 (bytes,index,r)) else
+		if nb == 1 then op ctx (OSetUI16 (bytes,index,r)) else
 		op ctx (OSetMem (bytes,index,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
 	if t1 == t2 then t1 else
-	match t1, t2 with
-	| (HUI8|HUI16|HI32|HI64|HF32|HF64|HGUID), (HUI8|HUI16|HI32|HI64|HF32|HF64|HGUID) -> common_type_number ctx t1 t2 p
-	| (HUI8|HUI16|HI32|HI64|HF32|HF64|HGUID as t1), (HNull t2)
-	| (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64|HGUID 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
+	match get_group t1, get_group t2, t1, t2 with
+	| (GInt | GFloat), (GInt | GFloat), _, _ -> common_type_number t1 t2
+	| ((GInt | GFloat) | GNull (GInt | GFloat)), ((GInt | GFloat) | GNull (GInt | GFloat)), _, _ ->
+		let ti1 = get_inner_type t1 in
+		let ti2 = get_inner_type t2 in
+		if for_eq then HNull (common_type_number ti1 ti2) else common_type_number ti1 ti2
+	| GBool, GNull GBool, _, _ when for_eq -> t2
+	| GNull GBool, GBool, _, _ when for_eq -> t1
+	| _, (GInt | GFloat), HDyn, _ -> HF64
+	| (GInt | GFloat), _, _, 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
+	| _, _, HObj _, HVirtual _ | _, _, HVirtual _, HObj _ | _, _, HVirtual _, HVirtual _ -> HDyn
+	| _, _, HFun _, HFun _ -> HDyn
 	| _ ->
 		abort ("Can't find common type " ^ tstr t1 ^ " and " ^ tstr t2) p
 
@@ -1175,22 +1159,22 @@ and to_string ctx (r:reg) p =
 and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 	let rt = rtype ctx r in
 	if safe_cast rt t then r else
-	match rt, t with
-	| _, HVoid ->
+	match get_group rt, get_group t, rt, t with
+	| _, _, _, HVoid ->
 		alloc_tmp ctx HVoid
-	| HVirtual _, HVirtual _ ->
+	| _, _, HVirtual _, HVirtual _ ->
 		let tmp = alloc_tmp ctx HDyn in
 		op ctx (OMov (tmp,r));
 		cast_to ctx tmp t p
-	| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64), (HF32 | HF64) ->
+	| (GInt | GFloat), GFloat, _, _ ->
 		let tmp = alloc_tmp ctx t in
 		op ctx (OToSFloat (tmp, r));
 		tmp
-	| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HGUID), (HUI8 | HUI16 | HI32 | HI64 | HGUID) ->
+	| (GInt | GFloat), GInt, _, _ ->
 		let tmp = alloc_tmp ctx t in
 		op ctx (OToInt (tmp, r));
 		tmp
-	| HObj o, HVirtual _ ->
+	| _, _, HObj o, HVirtual _ ->
 		let out = alloc_tmp ctx t in
 		(try
 			let rec lookup_intf o =
@@ -1225,31 +1209,31 @@ and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 			(* not an interface *)
 			op ctx (OToVirtual (out,r)));
 		out
-	| (HDynObj | HDyn) , HVirtual _ ->
+	| _, _, (HDynObj | HDyn) , HVirtual _ ->
 		let out = alloc_tmp ctx t in
 		op ctx (OToVirtual (out,r));
 		out
-	| HDyn, _ ->
+	| _, _, HDyn, _ ->
 		let out = alloc_tmp ctx t in
 		op ctx (OSafeCast (out, r));
 		out
-	| HNull rt, _ when t = rt ->
+	| _, _, HNull rt, _ when t = rt ->
 		let out = alloc_tmp ctx t in
 		op ctx (OSafeCast (out, r));
 		out
-	| HVoid, HDyn ->
+	| _, _, HVoid, HDyn ->
 		let tmp = alloc_tmp ctx HDyn in
 		op ctx (ONull tmp);
 		tmp
-	| _ , HDyn ->
+	| _, _, _ , HDyn ->
 		let tmp = alloc_tmp ctx HDyn in
 		op ctx (OToDyn (tmp, r));
 		tmp
-	| _, HNull t when rt == t ->
-		let tmp = alloc_tmp ctx (HNull t) in
+	| _, _, _, HNull ti when rt = ti ->
+		let tmp = alloc_tmp ctx (HNull rt) in
 		op ctx (OToDyn (tmp, r));
 		tmp
-	| HNull t1, HNull t2 ->
+	| _, _, HNull t1, HNull _ ->
 		let j = jump ctx (fun n -> OJNull (r,n)) in
 		let rtmp = alloc_tmp ctx t1 in
 		op ctx (OSafeCast (rtmp,r));
@@ -1258,7 +1242,7 @@ and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 		j();
 		op ctx (ONull out);
 		out
-	| HRef t1, HNull t2 ->
+	| _, _, HRef t1, HNull _ ->
 		let j = jump ctx (fun n -> OJNull (r,n)) in
 		let rtmp = alloc_tmp ctx t1 in
 		op ctx (OUnref (rtmp,r));
@@ -1267,31 +1251,35 @@ and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 		j();
 		op ctx (ONull out);
 		out
-	| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64), HNull ((HF32 | HF64) as t) ->
+	| (GInt | GFloat), GNull GFloat, _, HNull t ->
 		let tmp = alloc_tmp ctx t in
 		op ctx (OToSFloat (tmp, r));
 		let r = alloc_tmp ctx (HNull t) in
 		op ctx (OToDyn (r,tmp));
 		r
-	| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64), HNull ((HUI8 | HUI16 | HI32) as t) ->
+	| (GInt | GFloat), GNull GInt, _, HNull t ->
 		let tmp = alloc_tmp ctx t in
 		op ctx (OToInt (tmp, r));
 		let r = alloc_tmp ctx (HNull t) in
 		op ctx (OToDyn (r,tmp));
 		r
-	| HNull ((HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64) as it), (HF32 | HF64) ->
+	| GNull (GInt | GFloat), GFloat, HNull it, _ ->
 		let i = alloc_tmp ctx it in
 		op ctx (OSafeCast (i,r));
 		let tmp = alloc_tmp ctx t in
 		op ctx (OToSFloat (tmp, i));
 		tmp
-	| HNull ((HF32 | HF64) as it), (HUI8 | HUI16 | HI32 | HI64) ->
+	| GNull GFloat, GInt, HNull it, _ ->
 		let i = alloc_tmp ctx it in
 		op ctx (OSafeCast (i,r));
 		let tmp = alloc_tmp ctx t in
 		op ctx (OToInt (tmp, i));
 		tmp
-	| HFun (args1,ret1), HFun (args2, ret2) when List.length args1 = List.length args2 ->
+	| GNull GInt, GInt, _, _ ->
+		let out = alloc_tmp ctx t in
+		op ctx (OSafeCast (out, r));
+		out
+	| _, _, HFun (args1,ret1), HFun (args2, ret2) when List.length args1 = List.length args2 ->
 		let fid = gen_method_wrapper ctx rt t p in
 		let fr = alloc_tmp ctx t in
 		op ctx (OJNotNull (r,2));
@@ -1299,11 +1287,11 @@ and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 		op ctx (OJAlways 1);
 		op ctx (OInstanceClosure (fr,fid,r));
 		fr
-	| HObj _, HObj _ when is_array_type rt && is_array_type t ->
+	| _, _, HObj _, HObj _ when is_array_type rt && is_array_type t ->
 		let out = alloc_tmp ctx t in
 		op ctx (OSafeCast (out, r));
 		out
-	| HNull _, HRef t2 ->
+	| _, _, HNull _, HRef t2 ->
 		let out = alloc_tmp ctx t in
 		op ctx (OJNotNull (r,2));
 		op ctx (ONull out);
@@ -1315,7 +1303,7 @@ and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 		op ctx (ORef (out,r2));
 		j();
 		out
-	| _, HRef t2 ->
+	| _, _, _, HRef t2 ->
 		let r = cast_to ctx r t2 p in
 		let r2 = alloc_tmp ctx t2 in
 		op ctx (OMov (r2, r));
@@ -1473,8 +1461,8 @@ and get_access ctx e =
 		ANone
 
 and array_read ctx ra (at,vt) ridx p =
-	match at with
-	| HUI8 | HUI16 | HI32 | HF32 | HF64 | HI64 ->
+	match get_group at, at with
+	| (GInt | GFloat as tg), _ ->
 		(* check bounds *)
 		hold ctx ridx;
 		let length = alloc_tmp ctx HI32 in
@@ -1482,10 +1470,10 @@ and array_read ctx ra (at,vt) ridx p =
 		op ctx (OField (length, ra, 0));
 		let j = jump ctx (fun i -> OJULt (ridx,length,i)) in
 		let r = alloc_tmp ctx (match at with HUI8 | HUI16 -> HI32 | _ -> at) in
-		(match at with
-		| HUI8 | HUI16 | HI32 | HI64 ->
+		(match tg with
+		| GInt ->
 			op ctx (OInt (r,alloc_i32 ctx 0l));
-		| HF32 | HF64 ->
+		| GFloat ->
 			op ctx (OFloat (r,alloc_float ctx 0.));
 		| _ ->
 			die "" __LOC__);
@@ -1496,7 +1484,7 @@ and array_read ctx ra (at,vt) ridx p =
 		read_mem ctx r hbytes (shl ctx ridx (type_size_bits at)) at;
 		jend();
 		cast_to ctx r vt p
-	| HDyn ->
+	| _, HDyn ->
 		(* call getDyn *)
 		let r = alloc_tmp ctx HDyn in
 		op ctx (OCallMethod (r,0,[ra;ridx]));
@@ -1556,17 +1544,17 @@ and jump_expr ctx e jcond =
 		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)
+		(match get_group t1, get_group t2 with
+		| GNull _, (GInt | GFloat | GBool)
+		| (GInt | GFloat | GBool), GNull _
 			->
+			let ti1 = get_inner_type t1 in
+			let ti2 = get_inner_type t2 in
 			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 t = common_type_number ti1 ti2 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
@@ -1598,12 +1586,11 @@ and jump_expr ctx e jcond =
 				| 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)
+		(match get_group t1, get_group t2, t1, t2 with
+		| ((GInt | GFloat) | GNull (GInt | GFloat)), ((GInt | GFloat) | GNull (GInt | GFloat)), _, _
 			->
+			let ti1 = get_inner_type t1 in
+			let ti2 = get_inner_type t2 in
 			if ctx.w_null_compare && (is_nullt t1 || is_nullt t2) then
 				ctx.com.warning WGenerator [] (Printf.sprintf "Null compare: %s %s %s" (tstr t1) (s_binop jop) (tstr t2)) e.epos;
 			let r1 = eval_expr ctx e1 in
@@ -1612,7 +1599,7 @@ and jump_expr ctx e jcond =
 			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 t = common_type_number ti1 ti2 in
 			let a = cast_to ctx r1 t e1.epos in
 			hold ctx a;
 			let b = cast_to ctx r2 t e2.epos in
@@ -1622,9 +1609,9 @@ and jump_expr ctx e jcond =
 			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
+		| _, _, 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
@@ -1889,12 +1876,10 @@ and eval_expr ctx e =
 		| "$bytes_sizebits", [eb] ->
 			(match follow eb.etype with
 			| TAbstract({a_path = ["hl"],"BytesAccess"},[t]) ->
-				reg_int ctx (match to_type ctx t with
-				| HUI8 -> 0
-				| HUI16 -> 1
-				| HI32 | HF32 -> 2
-				| HI64 | HF64 -> 3
-				| t -> abort ("Unsupported basic type " ^ tstr t) e.epos)
+				let t = to_type ctx t in
+				reg_int ctx (match get_group t with
+				| GInt | GFloat -> type_size_bits t
+				| _ -> abort ("Unsupported basic type " ^ tstr t) e.epos)
 			| _ ->
 				abort "Invalid BytesAccess" eb.epos);
 		| "$bytes_nullvalue", [eb] ->
@@ -1902,12 +1887,12 @@ and eval_expr ctx e =
 			| TAbstract({a_path = ["hl"],"BytesAccess"},[t]) ->
 				let t = to_type ctx t in
 				let r = alloc_tmp ctx t in
-				(match t with
-				| HUI8 | HUI16 | HI32 | HI64 ->
+				(match get_group t with
+				| GInt ->
 					op ctx (OInt (r,alloc_i32 ctx 0l))
-				| HF32 | HF64 ->
+				| GFloat ->
 					op ctx (OFloat (r, alloc_float ctx 0.))
-				| t ->
+				| _ ->
 					abort ("Unsupported basic type " ^ tstr t) e.epos);
 				r
 			| _ ->
@@ -1920,30 +1905,12 @@ and eval_expr ctx e =
 				let pos = eval_to ctx pos HI32 in
 				free ctx b;
 				let t = to_type ctx t in
-				(match t with
-				| HUI8 ->
-					let r = alloc_tmp ctx HI32 in
-					op ctx (OGetUI8 (r, b, pos));
-					r
-				| HUI16 ->
-					let r = alloc_tmp ctx HI32 in
-					op ctx (OGetUI16 (r, b, shl ctx pos 1));
-					r
-				| HI32 ->
-					let r = alloc_tmp ctx HI32 in
-					op ctx (OGetMem (r, b, shl ctx pos 2));
-					r
-				| HI64 ->
-					let r = alloc_tmp ctx HI64 in
-					op ctx (OGetMem (r, b, shl ctx pos 3));
-					r
-				| HF32 ->
-					let r = alloc_tmp ctx HF32 in
-					op ctx (OGetMem (r, b, shl ctx pos 2));
-					r
-				| HF64 ->
-					let r = alloc_tmp ctx HF64 in
-					op ctx (OGetMem (r, b, shl ctx pos 3));
+				(match get_group t with
+				| GInt | GFloat ->
+					let nb = type_size_bits t in
+					let r = alloc_tmp ctx (if nb <= 1 then HI32 else t) in
+					let ridx = shl ctx pos nb in
+					read_mem ctx r b ridx t;
 					r
 				| _ ->
 					abort ("Unsupported basic type " ^ tstr t) e.epos)
@@ -1957,39 +1924,13 @@ and eval_expr ctx e =
 				let pos = eval_to ctx pos HI32 in
 				hold ctx pos;
 				let t = to_type ctx t in
-				let v = (match t with
-				| HUI8 ->
-					let v = eval_to ctx value HI32 in
-					op ctx (OSetUI8 (b, pos, v));
-					v
-				| HUI16 ->
-					let v = eval_to ctx value HI32 in
-					hold ctx v;
-					op ctx (OSetUI16 (b, shl ctx pos 1, v));
-					free ctx v;
-					v
-				| HI32 ->
-					let v = eval_to ctx value HI32 in
-					hold ctx v;
-					op ctx (OSetMem (b, shl ctx pos 2, v));
-					free ctx v;
-					v
-				| HI64 ->
-					let v = eval_to ctx value HI64 in
-					hold ctx v;
-					op ctx (OSetMem (b, shl ctx pos 3, v));
-					free ctx v;
-					v
-				| HF32 ->
-					let v = eval_to ctx value HF32 in
+				let v = (match get_group t with
+				| (GInt | GFloat) ->
+					let nb = type_size_bits t in
+					let v = eval_to ctx value (if nb <= 1 then HI32 else t) in
 					hold ctx v;
-					op ctx (OSetMem (b, shl ctx pos 2, v));
-					free ctx v;
-					v
-				| HF64 ->
-					let v = eval_to ctx value HF64 in
-					hold ctx v;
-					op ctx (OSetMem (b, shl ctx pos 3, v));
+					let ridx = shl ctx pos nb in
+					write_mem ctx b ridx t v;
 					free ctx v;
 					v
 				| _ ->
@@ -2484,31 +2425,34 @@ and eval_expr ctx e =
 			let rec loop bop =
 				match bop with
 				| OpAdd ->
-					(match rtype ctx r with
-					| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 ->
+					let t = rtype ctx r in
+					(match get_group t, t with
+					| (GInt | GFloat), _ ->
 						op ctx (OAdd (r,a,b))
-					| HObj { pname = "String" } ->
+					| _, HObj { pname = "String" } ->
 						op ctx (OCall2 (r,alloc_fun_path ctx ([],"String") "__add__",to_string ctx a e1.epos,to_string ctx b e2.epos))
-					| HDyn ->
+					| _, HDyn ->
 						op ctx (OCall2 (r,alloc_fun_path ctx ([],"Std") "__add__",a,b))
-					| t ->
+					| _ ->
 						abort ("Cannot add " ^ tstr t) e.epos)
 				| OpSub | OpMult | OpMod | OpDiv ->
-					(match rtype ctx r with
-					| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 ->
+					let t = rtype ctx r in
+					(match get_group t, t with
+					| (GInt | GFloat), _ ->
 						(match bop with
 						| OpSub -> op ctx (OSub (r,a,b))
 						| OpMult -> op ctx (OMul (r,a,b))
 						| OpMod -> op ctx (if unsigned e1.etype then OUMod (r,a,b) else OSMod (r,a,b))
 						| OpDiv -> op ctx (OSDiv (r,a,b)) (* don't use UDiv since both operands are float already *)
 						| _ -> die "" __LOC__)
-					| HDyn ->
+					| _, HDyn ->
 						op ctx (OCall3 (r, alloc_std ctx "dyn_op" [HI32;HDyn;HDyn] HDyn, reg_int ctx (match bop with OpSub -> 1 | OpMult -> 2 | OpMod -> 3 | OpDiv -> 4 | _ -> die "" __LOC__), a, b))
 					| _ ->
 						die "" __LOC__)
 				| OpShl | OpShr | OpUShr | OpAnd | OpOr | OpXor ->
-					(match rtype ctx r with
-					| HUI8 | HUI16 | HI32 | HI64 ->
+					let t = rtype ctx r in
+					(match get_group t, t with
+					| GInt, _ ->
 						(match bop with
 						| OpShl -> op ctx (OShl (r,a,b))
 						| OpShr -> op ctx (if unsigned e1.etype then OUShr (r,a,b) else OSShr (r,a,b))
@@ -2517,7 +2461,7 @@ and eval_expr ctx e =
 						| OpOr -> op ctx (OOr (r,a,b))
 						| OpXor -> op ctx (OXor (r,a,b))
 						| _ -> ())
-					| HDyn ->
+					| _, HDyn ->
 						op ctx (OCall3 (r, alloc_std ctx "dyn_op" [HI32;HDyn;HDyn] HDyn, reg_int ctx (match bop with OpShl -> 5 | OpShr -> 6 | OpUShr -> 7 | OpAnd -> 8 | OpOr -> 9 | OpXor -> 10 | _ -> die "" __LOC__), a, b))
 					| _ ->
 						die "" __LOC__)
@@ -2603,8 +2547,8 @@ and eval_expr ctx e =
 					let j = jump ctx (fun i -> OJULt (ridx,len,i)) in
 					op ctx (OCall2 (alloc_tmp ctx HVoid, alloc_fun_path ctx (array_class ctx at).cl_path "__expand", ra, ridx));
 					j();
-					match at with
-					| HI32 | HF64 | HUI16 | HF32 | HI64 ->
+					match get_group at with
+					| GInt | GFloat ->
 						let b = alloc_tmp ctx HBytes in
 						op ctx (OField (b,ra,1));
 						write_mem ctx b (shl ctx ridx (type_size_bits at)) at v
@@ -2707,29 +2651,30 @@ and eval_expr ctx e =
 		tmp
 	| TUnop (Increment|Decrement as uop,fix,v) ->
 		let rec unop r =
-			match rtype ctx r with
-			| HUI8 | HUI16 | HI32 | HI64 ->
+			let t = rtype ctx r in
+			match get_group t, t with
+			| GInt, _ ->
 				if uop = Increment then op ctx (OIncr r) else op ctx (ODecr r)
-			| HF32 | HF64 as t ->
+			| GFloat, _ ->
 				hold ctx r;
 				let tmp = alloc_tmp ctx t in
 				free ctx r;
 				op ctx (OFloat (tmp,alloc_float ctx 1.));
 				if uop = Increment then op ctx (OAdd (r,r,tmp)) else op ctx (OSub (r,r,tmp))
-			| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as t) ->
+			| GNull (GInt | GFloat), HNull t ->
 				hold ctx r;
 				let tmp = alloc_tmp ctx t in
 				free ctx r;
 				op ctx (OSafeCast (tmp,r));
 				unop tmp;
 				op ctx (OToDyn (r,tmp));
-			| HDyn when uop = Increment ->
+			| _, HDyn when uop = Increment ->
 				hold ctx r;
 				let tmp = alloc_tmp ctx HDyn in
 				free ctx r;
 				op ctx (OToDyn (tmp, reg_int ctx 1));
 				op ctx (OCall2 (r,alloc_fun_path ctx ([],"Std") "__add__",r,tmp))
-			| HDyn when uop = Decrement ->
+			| _, HDyn when uop = Decrement ->
 				let r2 = alloc_tmp ctx HF64 in
 				hold ctx r2;
 				let tmp = alloc_tmp ctx HF64 in
@@ -2876,12 +2821,16 @@ and eval_expr ctx e =
 			array_bytes 2 HI32 "I32" (fun b i r -> OSetMem (b,i,r))
 		| HUI16 ->
 			array_bytes 1 HI32 "UI16" (fun b i r -> OSetUI16 (b,i,r))
+		| HUI8 ->
+			array_bytes 0 HI32 "UI8" (fun b i r -> OSetUI8 (b,i,r))
 		| HF32 ->
 			array_bytes 2 HF32 "F32" (fun b i r -> OSetMem (b,i,r))
 		| HF64 ->
 			array_bytes 3 HF64 "F64" (fun b i r -> OSetMem (b,i,r))
 		| HI64 ->
 			array_bytes 3 HI64 "I64" (fun b i r -> OSetMem (b,i,r))
+		| HGUID ->
+			array_bytes 3 HGUID "HGUID" (fun b i r -> OSetMem (b,i,r))
 		| _ ->
 			let at = if is_dynamic et then et else HDyn in
 			let size = reg_int ctx (List.length el) in
@@ -3204,8 +3153,8 @@ and gen_assign_op ctx acc e1 f =
 			let j = jump ctx (fun i -> OJULt (ridx,len,i)) in
 			op ctx (OCall2 (alloc_tmp ctx HVoid, alloc_fun_path ctx (array_class ctx at).cl_path "__expand", ra, ridx));
 			j();
-			match at with
-			| HUI8 | HUI16 | HI32 | HF32 | HF64 | HI64->
+			match get_group at with
+			| GInt | GFloat ->
 				let hbytes = alloc_tmp ctx HBytes in
 				op ctx (OField (hbytes, ra, 1));
 				let ridx = shl ctx ridx (type_size_bits at) in
@@ -3393,18 +3342,18 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 			(* if optional but not null, turn into a not nullable here *)
 			let j = jump ctx (fun n -> OJNotNull (r,n)) in
 			let t = alloc_tmp ctx vt in
-			(match vt with
-			| HUI8 | HUI16 | HI32 | HI64 ->
+			(match get_group vt with
+			| GInt ->
 				(match c.eexpr with
 				| TConst (TInt i) -> op ctx (OInt (t,alloc_i32 ctx i))
 				| TConst (TFloat s) -> op ctx (OInt (t,alloc_i32 ctx  (Int32.of_float (float_of_string s))))
 				| _ -> die "" __LOC__)
-			| HF32 | HF64 ->
+			| GFloat ->
 				(match c.eexpr with
 				| TConst (TInt i) -> op ctx (OFloat (t,alloc_float ctx (Int32.to_float i)))
 				| TConst (TFloat s) -> op ctx (OFloat (t,alloc_float ctx  (float_of_string s)))
 				| _ -> die "" __LOC__)
-			| HBool ->
+			| GBool ->
 				(match c.eexpr with
 				| TConst (TBool b) -> op ctx (OBool (t,b))
 				| _ -> die "" __LOC__)
@@ -3473,10 +3422,10 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 			op ctx (ORet (alloc_tmp ctx HVoid))
 		else if has_final_jump f.tf_expr then begin
 			let r = alloc_tmp ctx tret in
-			(match tret with
-			| HI32 | HUI8 | HUI16 | HI64 -> op ctx (OInt (r,alloc_i32 ctx 0l))
-			| HF32 | HF64 -> op ctx (OFloat (r,alloc_float ctx 0.))
-			| HBool -> op ctx (OBool (r,false))
+			(match get_group tret with
+			| GInt -> op ctx (OInt (r,alloc_i32 ctx 0l))
+			| GFloat -> op ctx (OFloat (r,alloc_float ctx 0.))
+			| GBool -> op ctx (OBool (r,false))
 			| _ -> op ctx (ONull r));
 			op ctx (ORet r)
 		end;
@@ -4225,6 +4174,7 @@ let create_context com =
 			abase = get_class "ArrayBase";
 			adyn = get_class "ArrayDyn";
 			aobj = get_class "ArrayObj";
+			aui8 = get_class "ArrayBytes_hl_UI8";
 			aui16 = get_class "ArrayBytes_hl_UI16";
 			ai32 = get_class "ArrayBytes_Int";
 			af32 = get_class "ArrayBytes_hl_F32";

+ 67 - 70
src/generators/hl2c.ml

@@ -122,7 +122,7 @@ let s_comp = function
 let core_types =
 	let vp = { vfields = [||]; vindex = PMap.empty } in
 	let ep = { ename = ""; eid = 0; eglobal = None; efields = [||] } in
-	[HVoid;HUI8;HUI16;HI32;HI64;HF32;HF64;HBool;HBytes;HDyn;HFun ([],HVoid);HObj null_proto;HArray HDyn;HType;HRef HVoid;HVirtual vp;HDynObj;HAbstract ("",0);HEnum ep;HNull HVoid;HMethod ([],HVoid);HStruct null_proto]
+	[HVoid;HUI8;HUI16;HI32;HI64;HF32;HF64;HBool;HBytes;HDyn;HFun ([],HVoid);HObj null_proto;HArray HDyn;HType;HRef HVoid;HVirtual vp;HDynObj;HAbstract ("",0);HEnum ep;HMethod ([],HVoid);HStruct null_proto]
 
 let tname str =
 	let n = String.concat "__" (ExtString.String.nsplit str ".") in
@@ -174,16 +174,35 @@ let cast_fun s args t =
 	sprintf "((%s (*)(%s))%s)" (ctype t) (args_repr args) s
 
 let dyn_value_field t =
-	"->v." ^ match t with
+	"v." ^ match t with
 	| HUI8 -> "ui8"
 	| HUI16 -> "ui16"
 	| HI32 -> "i"
-	| HI64 -> "i64"
+	| HI64 | HGUID -> "i64"
 	| HF32 -> "f"
 	| HF64 -> "d"
 	| HBool -> "b"
 	| _ -> "ptr"
 
+let type_kind_info t =
+	(* type_kind_id, type_kind, wrap_char, dyn_prefix *)
+	match get_group t, t with
+	| _, HVoid ->
+		0, t, "v", "p"
+	| (GBool | GInt), _ ->
+		let nb = type_size_bits t in
+		if nb <= 2 then
+			1, HI32, "i", "i" (* same int representation *)
+		else
+			4, HI64, "i64", "i64"
+	| GFloat, _ ->
+		let nb = type_size_bits t in
+		if nb <= 2 then
+			2, HF32, "f", "f"
+		else
+			3, HF64, "d", "d"
+	| _	-> 5, HDyn, "p", "p"
+
 let type_id t =
 	match t with
 	| HVoid -> "HVOID"
@@ -393,19 +412,10 @@ let generate_reflection gctx ctx =
 
 	let funByArgs = Hashtbl.create 0 in
 	let type_kind t =
-		match t with
-		| HVoid | HF32 | HF64 | HI64 -> t
-		| HBool | HUI8 | HUI16 | HI32 -> HI32
-		| _ -> HDyn
+		let _, k, _, _ = type_kind_info t in k
 	in
 	let type_kind_id t =
-		match t with
-		| HVoid -> 0
-		| HBool | HUI8 | HUI16 | HI32 -> 1 (* same int representation *)
-		| HF32 -> 2
-		| HF64 -> 3
-		| HI64 -> 4
-		| _ -> 5
+		let tid, _, _, _ = type_kind_info t in tid
 	in
 	let add_fun args t =
 		let nargs = List.length args in
@@ -426,7 +436,7 @@ let generate_reflection gctx ctx =
 	) gctx.hlcode.functions;
 	Array.iter (fun f -> add_fun f.fe_args f.fe_ret) gctx.ftable;
 	let argsCounts = List.sort compare (Hashtbl.fold (fun i _ acc -> i :: acc) funByArgs []) in
-	sexpr "static int TKIND[] = {%s}" (String.concat "," (List.map (fun t -> string_of_int (type_kind_id (type_kind t))) core_types));
+	sexpr "static int TKIND[] = {%s}" (String.concat "," (List.map (fun t -> string_of_int (type_kind_id t)) core_types));
 	line "";
 	line "void *hlc_static_call( void *fun, hl_type *t, void **args, vdynamic *out ) {";
 	block ctx;
@@ -461,8 +471,8 @@ let generate_reflection gctx ctx =
 				expr call;
 				expr "return NULL";
 			end else begin
-				sexpr "out%s = %s" (dyn_value_field t) call;
-				sexpr "return &out%s" (dyn_value_field t);
+				sexpr "out->%s = %s" (dyn_value_field t) call;
+				sexpr "return &out->%s" (dyn_value_field t);
 			end;
 			unblock ctx;
 		) (Hashtbl.find funByArgs nargs);
@@ -477,13 +487,8 @@ let generate_reflection gctx ctx =
 	unblock ctx;
 	line "}";
 	line "";
-	let wrap_char = function
-		| HVoid -> "v"
-		| HUI8 | HUI16 | HBool | HI32 -> "i"
-		| HF32 -> "f"
-		| HF64 -> "d"
-		| HI64 -> "i64"
-		| _ -> "p"
+	let wrap_char t =
+		let _, _, wchar, _ = type_kind_info t in wchar
 	in
 	let make_wrap_name args t =
 		String.concat "" (List.map wrap_char args) ^ "_" ^ wrap_char t
@@ -596,16 +601,12 @@ let generate_function gctx ctx f =
 	in
 
 
-	let dyn_prefix = function
-		| HUI8 | HUI16 | HI32 | HBool -> "i"
-		| HF32 -> "f"
-		| HF64 -> "d"
-		| HI64 -> "i64"
-		| _ -> "p"
+	let dyn_prefix t =
+		let _, _, _, dyn = type_kind_info t in dyn
 	in
 
 	let type_value_opt t =
-		match t with HF32 | HF64 | HI64 -> "" | _ -> "," ^ type_value ctx t
+		match t with HF32 | HF64 | HI64 | HGUID -> "" | _ -> "," ^ type_value ctx t
 	in
 
 	let dyn_call r f pl =
@@ -771,26 +772,27 @@ let generate_function gctx ctx f =
 				two ways (same type) for eq
 				one way for comparisons
 			*)
-			match rtype a, rtype b with
-			| (HUI8 | HUI16 | HI32 | HF32 | HF64 | HBool | HI64), (HUI8 | HUI16 | HI32 | HF32 | HF64 | HBool | HI64) ->
-				phys_compare()
-			| HBytes, HBytes | HArray _,HArray _ ->
+			let ta = rtype a in
+			let tb = rtype b in
+			match get_group ta, get_group tb, ta, tb with
+			| (GInt | GFloat | GBool), (GInt | GFloat | GBool), _, _
+			| _, _, HBytes, HBytes | _, _, HArray _, HArray _ ->
 				phys_compare()
-			| HType, HType ->
+			| _, _, HType, HType ->
 				sexpr "if( hl_same_type(%s,%s) %s 0 ) {} else goto %s" (reg a) (reg b) (s_comp op) (label d)
-			| HNull t, HNull _ ->
+			| _, _, HNull t, HNull _ ->
 				let field = dyn_value_field t in
-				let pcompare = sprintf "(%s%s %s %s%s)" (reg a) field (s_comp op) (reg b) field in
+				let pcompare = sprintf "(%s->%s %s %s->%s)" (reg a) field (s_comp op) (reg b) field in
 				if op = CEq then
 					sexpr "if( %s == %s || (%s && %s && %s) ) goto %s" (reg a) (reg b) (reg a) (reg b) pcompare (label d)
 				else if op = CNeq then
 					sexpr "if( %s != %s && (!%s || !%s || %s) ) goto %s" (reg a) (reg b) (reg a) (reg b) pcompare (label d)
 				else
 					sexpr "if( %s && %s && %s ) goto %s" (reg a) (reg b) pcompare (label d)
-			| (HDyn | HFun _), _ | _, (HDyn | HFun _) ->
+			| _, _, (HDyn | HFun _), _ | _, _, _, (HDyn | HFun _) ->
 				let inv = if op = CGt || op = CGte then "&& i != hl_invalid_comparison " else "" in
 				sexpr "{ int i = hl_dyn_compare((vdynamic*)%s,(vdynamic*)%s); if( i %s 0 %s) goto %s; }" (reg a) (reg b) (s_comp op) inv (label d)
-			| HObj oa, HObj _ ->
+			| _, _, HObj oa, HObj _ ->
 				(try
 					let fid = PMap.find "__compare" oa.pfunctions in
 					if op = CEq then
@@ -801,27 +803,27 @@ let generate_function gctx ctx f =
 						sexpr "if( %s && %s && %s(%s,(vdynamic*)%s) %s 0 ) goto %s" (reg a) (reg b) (funname fid) (reg a) (reg b) (s_comp op) (label d)
 				with Not_found ->
 					phys_compare())
-			| HStruct _, HStruct _ ->
+			| _, _, HStruct _, HStruct _ ->
 				phys_compare()
-			| HVirtual _, HVirtual _ ->
+			| _, _, HVirtual _, HVirtual _ ->
 				if op = CEq then
 					sexpr "if( %s == %s || (%s && %s && %s->value && %s->value && %s->value == %s->value) ) goto %s" (reg a) (reg b) (reg a) (reg b) (reg a) (reg b) (reg a) (reg b) (label d)
 				else if op = CNeq then
 					sexpr "if( %s != %s && (!%s || !%s || !%s->value || !%s->value || %s->value != %s->value) ) goto %s" (reg a) (reg b) (reg a) (reg b) (reg a) (reg b) (reg a) (reg b) (label d)
 				else
 					Globals.die "" __LOC__
-			| HEnum _, HEnum _ | HDynObj, HDynObj | HAbstract _, HAbstract _ ->
+			| _, _, HEnum _, HEnum _ | _, _, HDynObj, HDynObj | _, _, HAbstract _, HAbstract _ ->
 				phys_compare()
-			| HVirtual _, HObj _->
+			| _, _, HVirtual _, HObj _->
 				if op = CEq then
 					sexpr "if( %s ? (%s && %s->value == (vdynamic*)%s) : (%s == NULL) ) goto %s" (reg a) (reg b) (reg a) (reg b) (reg b) (label d)
 				else if op = CNeq then
 					sexpr "if( %s ? (%s == NULL || %s->value != (vdynamic*)%s) : (%s != NULL) ) goto %s" (reg a) (reg b) (reg a) (reg b) (reg b) (label d)
 				else
 					Globals.die "" __LOC__
-			| HObj _, HVirtual _ ->
+			| _, _, HObj _, HVirtual _ ->
 				compare_op op b a d
-			| ta, tb ->
+			| _ ->
 				failwith ("Don't know how to compare " ^ tstr ta ^ " and " ^ tstr tb ^ " (hlc)")
 		in
 		match op with
@@ -855,34 +857,39 @@ let generate_function gctx ctx f =
 		| OMul (r,a,b) ->
 			sexpr "%s = %s * %s" (reg r) (reg a) (reg b)
 		| OSDiv (r,a,b) ->
-			(match rtype r with
-			| HUI8 | HUI16 | HI32 ->
+			(match get_group (rtype r) with
+			| GInt ->
 				sexpr "%s = (%s == 0 || %s == -1) ? %s * %s : %s / %s" (reg r) (reg b) (reg b) (reg a) (reg b) (reg a) (reg b)
 			| _ ->
 				sexpr "%s = %s / %s" (reg r) (reg a) (reg b))
 		| OUDiv (r,a,b) ->
 			sexpr "%s = %s == 0 ? 0 : ((unsigned)%s) / ((unsigned)%s)" (reg r) (reg b) (reg a) (reg b)
 		| OSMod (r,a,b) ->
-			(match rtype r with
-			| HUI8 | HUI16 | HI32 | HI64 ->
+			let rt = rtype r in
+			(match get_group rt with
+			| GInt ->
 				sexpr "%s = (%s == 0 || %s == -1) ? 0 : %s %% %s" (reg r) (reg b) (reg b) (reg a) (reg b)
-			| HF32 ->
-				sexpr "%s = fmodf(%s,%s)" (reg r) (reg a) (reg b)
-			| HF64 ->
-				sexpr "%s = fmod(%s,%s)" (reg r) (reg a) (reg b)
+			| GFloat ->
+				if type_size_bits rt <= 2 then
+					sexpr "%s = fmodf(%s,%s)" (reg r) (reg a) (reg b)
+				else
+					sexpr "%s = fmod(%s,%s)" (reg r) (reg a) (reg b)
 			| _ ->
 				Globals.die "" __LOC__)
 		| OUMod (r,a,b) ->
 			sexpr "%s = %s == 0 ? 0 : ((unsigned)%s) %% ((unsigned)%s)" (reg r) (reg b) (reg a) (reg b)
 		| OShl (r,a,b) ->
-			let size = (match rtype r with HUI8 -> 8 | HUI16 -> 16 | HI32 -> 32 | HI64 -> 64 |_ -> Globals.die "" __LOC__ ) in
+			let t = rtype r in
+			let size = (match get_group t with GInt -> Int.shift_left 8 (type_size_bits t) | _ -> Globals.die "" __LOC__ ) in
 			sexpr "%s = %s << (%s %% %d)" (reg r) (reg a) (reg b) size
 		| OSShr (r,a,b) ->
-			let size = (match rtype r with HUI8 -> 8 | HUI16 -> 16 | HI32 -> 32 | HI64 -> 64 |_ -> Globals.die "" __LOC__ ) in
+			let t = rtype r in
+			let size = (match get_group t with GInt -> Int.shift_left 8 (type_size_bits t) | _ -> Globals.die "" __LOC__ ) in
 			sexpr "%s = %s >> (%s %% %d)" (reg r) (reg a) (reg b) size
 		| OUShr (r,a,b) ->
-			let size = (match rtype r with HUI8 -> 8 | HUI16 -> 16 | HI32 -> 32 | HI64 -> 64 |_ -> Globals.die "" __LOC__ ) in
-			let prefix = (match rtype r with HI64 -> "uint64" | _ -> "unsigned") in
+			let t = rtype r in
+			let size = (match get_group t with GInt -> Int.shift_left 8 (type_size_bits t) | _ -> Globals.die "" __LOC__ ) in
+			let prefix = (match type_size_bits t with 3 -> "uint64" | _ -> "unsigned") in
 			sexpr "%s = ((%s)%s) >> (%s %% %d)" (reg r) prefix (reg a) (reg b) size
 		| OAnd (r,a,b) ->
 			sexpr "%s = %s & %s" (reg r) (reg a) (reg b)
@@ -981,17 +988,7 @@ let generate_function gctx ctx f =
 				block();
 			end;
 			sexpr "%s = hl_alloc_dynamic(%s)" (reg r) (type_value ctx (rtype v));
-			(match rtype v with
-			| HUI8 | HUI16 | HI32 | HBool ->
-				sexpr "%s->v.i = %s" (reg r) (reg v)
-			| HI64 ->
-				sexpr "%s->v.i64 = %s" (reg r) (reg v)
-			| HF32 ->
-				sexpr "%s->v.f = %s" (reg r) (reg v)
-			| HF64 ->
-				sexpr "%s->v.d = %s" (reg r) (reg v)
-			| _ ->
-				sexpr "%s->v.ptr = %s" (reg r) (reg v));
+			sexpr "%s->%s = %s" (reg r) (dyn_value_field (rtype v)) (reg v);
 			if is_ptr (rtype v) then begin
 				unblock();
 				line "}";
@@ -1052,7 +1049,7 @@ let generate_function gctx ctx f =
 			let tsrc = rtype v in
 			let t = rtype r in
 			if tsrc = HNull t then
-				sexpr "%s = %s ? %s%s : 0" (reg r) (reg v) (reg v) (dyn_value_field t)
+				sexpr "%s = %s ? %s->%s : 0" (reg r) (reg v) (reg v) (dyn_value_field t)
 			else
 				sexpr "%s = (%s)hl_dyn_cast%s(&%s,%s%s)" (reg r) (ctype t) (dyn_prefix t) (reg v) (type_value ctx (rtype v)) (type_value_opt t)
 		| OUnsafeCast (r,v) ->

+ 56 - 14
src/generators/hlcode.ml

@@ -85,6 +85,13 @@ and virtual_proto = {
 	mutable vindex : (string, int) PMap.t;
 }
 
+type tgroup =
+	| GInt
+	| GFloat
+	| GBool
+	| GNull of tgroup
+	| GOther
+
 type unused = int
 type field
 
@@ -268,20 +275,56 @@ let is_struct = function
 	| HStruct _ | HPacked _ -> true
 	| _ -> false
 
-let is_int = function
-	| HUI8 | HUI16 | HI32 | HI64 | HGUID -> true
+let get_group t =
+	match t with
+	| HUI8 | HUI16 | HI32 | HI64 | HGUID -> GInt
+	| HF32 | HF64 -> GFloat
+	| HBool -> GBool
+	| HNull (HUI8 | HUI16 | HI32 | HI64 | HGUID) -> GNull GInt
+	| HNull (HF32 | HF64) -> GNull GFloat
+	| HNull HBool -> GNull GBool
+	| HNull _ -> Globals.die "" __LOC__
+	| _ -> GOther
+
+let get_inner_type t =
+	match t with
+	| HNull t -> t
+	| _ -> t
+
+let type_size_bits = function
+	| HUI8 | HBool -> 0
+	| HUI16 -> 1
+	| HI32 | HF32 -> 2
+	| HI64 | HGUID | HF64 -> 3
+	| _ -> Globals.die "" __LOC__
+
+let common_type_number t1 t2 =
+	if t1 == t2 then t1 else
+	match get_group t1, get_group t2 with
+	| GInt, GInt -> if type_size_bits t1 > type_size_bits t2 then t1 else t2
+	| GInt, GFloat -> t2 (* possible loss of precision *)
+	| GFloat, GInt -> t1
+	| GFloat, GFloat -> if type_size_bits t1 > type_size_bits t2 then t1 else t2
+	| _ -> Globals.die "" __LOC__
+
+let is_int t =
+	match get_group t with
+	| GInt -> true
 	| _ -> false
 
-let is_float = function
-	| HF32 | HF64 -> true
+let is_float t =
+	match get_group t with
+	| GFloat -> true
 	| _ -> false
 
-let is_number = function
-	| HUI8 | HUI16 | HI32 | HI64 | HGUID | HF32 | HF64 -> true
+let is_number t =
+	match get_group t with
+	| GInt | GFloat -> true
 	| _ -> false
 
-let is_nullt = function
-	| HNull t -> not (is_nullable t)
+let is_nullt t =
+	match get_group t with
+	| GNull _ -> true
 	| _ -> false
 
 (*
@@ -318,13 +361,12 @@ let rec tsame t1 t2 =
 let compatible_element_types t1 t2 =
 	if t1 == t2 then
 		true (* equal types are always compatible *)
-	else match t1,t2 with
-	| (HI32 | HF32),(HI32 | HF32)
-	| (HI64 | HF64),(HI64 | HF64) ->
-		true (* same size numbers are also compatible *)
+	else match get_group t1, get_group t2 with
+	| (GInt | GFloat), (GInt | GFloat) ->
+		type_size_bits t1 = type_size_bits t2 (* same size numbers are also compatible *)
 	| _ ->
 		(* no other number combinations are compatible, but everything else is *)
-		not (is_number t1) && not (is_number t2)
+		true
 
 (*
 	can we use a value of t1 as t2
@@ -434,7 +476,7 @@ let gather_types (code:code) =
 		| _ ->
 			()
 	in
-	List.iter (fun t -> get_type t) [HVoid; HUI8; HUI16; HI32; HI64; HF32; HF64; HBool; HType; HDyn]; (* make sure all basic types get lower indexes *)
+	List.iter (fun t -> get_type t) [HVoid; HUI8; HUI16; HI32; HI64; HGUID; HF32; HF64; HBool; HType; HDyn]; (* make sure all basic types get lower indexes *)
 	Array.iter (fun g -> get_type g) code.globals;
 	Array.iter (fun (_,_,t,_) -> get_type t) code.natives;
 	Array.iter (fun f ->

+ 36 - 37
src/generators/hlinterp.ml

@@ -120,11 +120,14 @@ type context = {
 }
 
 let default t =
-	match t with
-	| HUI8 | HUI16 | HI32 -> VInt Int32.zero
-	| HI64 -> VInt64 Int64.zero
-	| HF32 | HF64 -> VFloat 0.
-	| HBool -> VBool false
+	match get_group t with
+	| GInt ->
+		if type_size_bits t <= 2 then
+			VInt Int32.zero
+		else
+			VInt64 Int64.zero
+	| GFloat -> VFloat 0.
+	| GBool -> VBool false
 	| _ -> if is_nullable t then VNull else VUndef
 
 let get_type = function
@@ -144,27 +147,27 @@ let v_dynamic = function
 	| _ -> false
 
 let rec is_compatible v t =
-	match v, t with
-	| VInt _, (HUI8 | HUI16 | HI32) -> true
-	| VInt64 _, HI64 -> true
-	| VFloat _, (HF32 | HF64) -> true
-	| VBool _, HBool -> true
-	| _, HVoid -> true
-	| VNull, t -> is_nullable t
-	| VObj o, HObj _ -> safe_cast (HObj o.oproto.pclass) t
-	| VClosure _, HFun _ -> safe_cast (match get_type v with None -> Globals.die "" __LOC__ | Some t -> t) t
-	| VBytes _, HBytes -> true
-	| VDyn (_,t1), HNull t2 -> tsame t1 t2
-	| v, HNull t -> is_compatible v t
-	| v, HDyn -> v_dynamic v
-	| VType _, HType -> true
-	| VArray _, HArray _ -> true
-	| VDynObj _, HDynObj -> true
-	| VVirtual v, HVirtual _ -> safe_cast (HVirtual v.vtype) t
-	| VRef (_,t1), HRef t2 -> tsame t1 t2
-	| VAbstract _, HAbstract _ -> true
-	| VEnum _, HEnum _ -> true
-	| VStruct v, HStruct _ -> safe_cast (HStruct v.oproto.pclass) t
+	match v, get_group t, t with
+	| VInt _, GInt, _ -> type_size_bits t <= 2
+	| VInt64 _, GInt, _ -> type_size_bits t == 3
+	| VFloat _, GFloat, _ -> true
+	| VBool _, GBool, _ -> true
+	| _, _, HVoid -> true
+	| VNull, _, _ -> is_nullable t
+	| VObj o, _, HObj _ -> safe_cast (HObj o.oproto.pclass) t
+	| VClosure _, _, HFun _ -> safe_cast (match get_type v with None -> Globals.die "" __LOC__ | Some t -> t) t
+	| VBytes _, _, HBytes -> true
+	| VDyn (_,t1), _, HNull ti -> tsame t1 ti
+	| v, _, HNull ti -> is_compatible v ti
+	| v, _, HDyn -> v_dynamic v
+	| VType _, _, HType -> true
+	| VArray _, _, HArray _ -> true
+	| VDynObj _, _, HDynObj -> true
+	| VVirtual v, _, HVirtual _ -> safe_cast (HVirtual v.vtype) t
+	| VRef (_,t1), _, HRef t2 -> tsame t1 t2
+	| VAbstract _, _, HAbstract _ -> true
+	| VEnum _, _, HEnum _ -> true
+	| VStruct v, _, HStruct _ -> safe_cast (HStruct v.oproto.pclass) t
 	| _ -> false
 
 type cast =
@@ -2212,19 +2215,13 @@ let check comerror code =
 			if not (safe_cast (rtype r) t) then error (reg_inf r ^ " should be " ^ tstr t ^ " and not " ^ tstr (rtype r))
 		in
 		let numeric r =
-			match rtype r with
-			| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 -> ()
-			| _ -> error (reg_inf r ^ " should be numeric")
+			if not (is_number (rtype r)) then error (reg_inf r ^ " should be numeric")
 		in
 		let int r =
-			match rtype r with
-			| HUI8 | HUI16 | HI32 | HI64 -> ()
-			| _ -> error (reg_inf r ^ " should be integral")
+			if not (is_int (rtype r)) then error (reg_inf r ^ " should be integral")
 		in
 		let float r =
-			match rtype r with
-			| HF32 | HF64 -> ()
-			| _ -> error (reg_inf r ^ " should be float")
+			if not (is_float (rtype r)) then error (reg_inf r ^ " should be float")
 		in
 		let call f args r =
 			match ftypes.(f) with
@@ -2433,7 +2430,8 @@ let check comerror code =
 				reg b HBytes;
 				reg p HI32;
 			| OGetMem (r,b,p) ->
-				(match rtype r with HI32 | HI64 | HF32 | HF64 -> () | _ -> error (reg_inf r ^ " should be numeric"));
+				let t = rtype r in
+				(match get_group t with (GInt | GFloat) when type_size_bits t >= 2 -> () | _ -> error (reg_inf r ^ " should be numeric"));
 				reg b HBytes;
 				reg p HI32;
 			| OSetUI8 (r,p,v) | OSetUI16 (r,p,v) ->
@@ -2443,7 +2441,8 @@ let check comerror code =
 			| OSetMem (r,p,v) ->
 				reg r HBytes;
 				reg p HI32;
-				(match rtype v with HI32 | HI64 | HF32 | HF64 -> () | _ -> error (reg_inf r ^ " should be numeric"));
+				let t = rtype v in
+				(match get_group t with (GInt | GFloat) when type_size_bits t >= 2 -> () | _ -> error (reg_inf r ^ " should be numeric"));
 			| OSetArray (a,i,v) ->
 				(match rtype a with HAbstract ("hl_carray",_) | HArray _ -> () | _ -> reg a (HArray HDyn));
 				reg i HI32;

+ 12 - 0
std/hl/types/ArrayBase.hx

@@ -125,6 +125,14 @@ class ArrayBase extends ArrayAccess {
 		return a;
 	}
 
+	public static function allocUI8(bytes:BytesAccess<UI8>, length:Int) @:privateAccess {
+		var a:ArrayBytes.ArrayUI8 = untyped $new(ArrayBytes.ArrayUI8);
+		a.length = length;
+		a.bytes = bytes;
+		a.size = length;
+		return a;
+	}
+
 	public static function allocUI16(bytes:BytesAccess<UI16>, length:Int) @:privateAccess {
 		var a:ArrayBytes.ArrayUI16 = untyped $new(ArrayBytes.ArrayUI16);
 		a.length = length;
@@ -157,5 +165,9 @@ class ArrayBase extends ArrayAccess {
 		a.size = length;
 		return a;
 	}
+
+	public static function allocHGUID(bytes:BytesAccess<I64>, length:Int) @:privateAccess {
+		return allocI64(bytes, length);
+	}
 	#end
 }

+ 2 - 0
std/hl/types/ArrayBytes.hx

@@ -367,8 +367,10 @@ class BytesIterator<T> extends ArrayIterator<T> {
 
 typedef ArrayI32 = ArrayBytes<Int>;
 typedef ArrayUI16 = ArrayBytes<UI16>;
+typedef ArrayUI8 = ArrayBytes<UI8>;
 typedef ArrayF32 = ArrayBytes<F32>;
 typedef ArrayF64 = ArrayBytes<Float>;
 #if (hl_ver >= version("1.13.0") && !hl_legacy32)
 typedef ArrayI64 = ArrayBytes<I64>;
+typedef ArrayGUID = ArrayBytes<I64>;
 #end

+ 6 - 0
tests/misc/hl/projects/Issue12039/Main.hx

@@ -13,5 +13,11 @@ class Main {
 		$type((f1 : Single) / (f2 : Single));
 		$type(f1 / s2);
 		$type(s1 / f2);
+		$type(s1 % s2);
+		$type(s1 % (f2 : Single));
+		$type((f1 : Single) % s2);
+		$type((f1 : Single) % (f2 : Single));
+		$type(f1 % s2);
+		$type(s1 % f2);
 	}
 }

+ 6 - 0
tests/misc/hl/projects/Issue12039/compile.hxml.stderr

@@ -7,3 +7,9 @@ Main.hx:12: characters 9-27 : Warning : Single
 Main.hx:13: characters 9-38 : Warning : Single
 Main.hx:14: characters 9-16 : Warning : Float
 Main.hx:15: characters 9-16 : Warning : Float
+Main.hx:16: characters 9-16 : Warning : Single
+Main.hx:17: characters 9-27 : Warning : Single
+Main.hx:18: characters 9-27 : Warning : Single
+Main.hx:19: characters 9-38 : Warning : Single
+Main.hx:20: characters 9-16 : Warning : Float
+Main.hx:21: characters 9-16 : Warning : Float

+ 266 - 1
tests/unit/src/unit/TestHL.hx

@@ -22,6 +22,52 @@ class Bar {
 	public var val:Int;
 }
 
+private class Numbers {
+	public var ui8 : hl.UI8;
+	public var ui16 : hl.UI16;
+	public var i32 : Int;
+	public var i64 : hl.I64;
+	public var guid : hl.GUID;
+	public function new() {
+	}
+	public function loadInt64( v : hl.I64 ) {
+		ui8 = cast v;
+		ui16 = cast v;
+		i32 = cast v;
+		i64 = cast v;
+		guid = cast v;
+	}
+	public function loadInt( v : Int ) {
+		ui8 = cast v;
+		ui16 = cast v;
+		i32 = cast v;
+		i64 = cast v;
+		guid = cast v;
+	}
+	public function loadUI16( v : hl.UI16 ) {
+		ui8 = cast v;
+		ui16 = cast v;
+		i32 = cast v;
+		i64 = cast v;
+		guid = cast v;
+	}
+	public function loadUI8( v : hl.UI8 ) {
+		ui8 = cast v;
+		ui16 = cast v;
+		i32 = cast v;
+		i64 = cast v;
+		guid = cast v;
+	}
+}
+
+private typedef NumbersNull = {
+	?nui8 : hl.UI8,
+	?nui16 : hl.UI16,
+	?ni32 : Int,
+	?ni64 : hl.I64,
+	?nguid : hl.GUID,
+}
+
 class TestHL extends Test {
 	function testRetTypeTP() {
 		var box = new Box(new Foo());
@@ -63,4 +109,223 @@ class TestHL extends Test {
 		//refTest(i);
 		//eq(i, 20);
 	}
-}
+
+	public function testNumberCompare() {
+		var num = new Numbers(); // prevent @:analyzer(ignore)
+		var v : hl.I64 = haxe.Int64.make(0xF, 1);
+		num.loadInt64(v);
+		f(num.i32 == v);
+		f(v == num.i32);
+		f(num.ui16 == v);
+		f(v == num.ui16);
+		f(num.ui8 == v);
+		f(v == num.ui8);
+
+		var v : Int = 0xF0000001;
+		num.loadInt(v);
+		t(num.i64 == v);
+		t(v == num.i64);
+		f(num.ui16 == v);
+		f(v == num.ui16);
+		f(num.ui8 == v);
+		f(v == num.ui8);
+
+		var v : hl.UI16 = 0xF001;
+		num.loadUI16(v);
+		t(num.i64 == v);
+		t(v == num.i64);
+		t(num.i32 == v);
+		t(v == num.i32);
+		f(num.ui8 == v);
+		f(v == num.ui8);
+
+		var v : hl.UI8 = 0xF1;
+		num.loadUI8(v);
+		t(num.i64 == v);
+		t(v == num.i64);
+		t(num.i32 == v);
+		t(v == num.i32);
+		t(num.ui16 == v);
+		t(v == num.ui16);
+	}
+
+	public function testNumbersNull() {
+		var num : NumbersNull = {};
+		t(cast(num.nui8, hl.UI16) == 0);
+		t(cast(num.nui8, Int) == 0);
+		t(cast(num.nui8, hl.I64) == 0);
+		t(cast(num.nui8, hl.GUID) == 0);
+
+		t(cast(num.nui16, hl.UI8) == 0);
+		t(cast(num.nui16, Int) == 0);
+		t(cast(num.nui16, hl.I64) == 0);
+		t(cast(num.nui16, hl.GUID) == 0);
+
+		t(cast(num.ni32, hl.UI8) == 0);
+		t(cast(num.ni32, hl.UI16) == 0);
+		t(cast(num.ni32, hl.I64) == 0);
+		t(cast(num.ni32, hl.GUID) == 0);
+
+		t(cast(num.ni64, hl.UI8) == 0);
+		t(cast(num.ni64, hl.UI16) == 0);
+		t(cast(num.ni64, Int) == 0);
+		t(cast(num.ni64, hl.GUID) == 0);
+
+		t(cast(num.nguid, hl.UI8) == 0);
+		t(cast(num.nguid, hl.UI16) == 0);
+		t(cast(num.nguid, Int) == 0);
+		t(cast(num.nguid, hl.I64) == 0);
+
+		var v = new Numbers();
+		v.loadInt64(0x123456789ABCDEF0i64);
+		var num : NumbersNull = {
+			nui8 : v.ui8,
+			nui16 : v.ui16,
+			ni32 : v.i32,
+			ni64 : v.i64,
+			nguid : v.guid,
+		}
+		t(num.nui8 == v.ui8);
+		t(num.nui16 == v.ui16);
+		t(num.ni32 == v.i32);
+		t(num.ni64 == v.i64);
+		t(num.nguid == v.guid);
+	}
+
+	public function testNumberArray() {
+		var arr : Array<hl.GUID> = [];
+		var i64 : hl.I64 = haxe.Int64.make(1, 1);
+		var guid : hl.GUID = haxe.Int64.make(2, -1);
+		arr.push(i64);
+		arr.push(guid);
+		arr.push(10);
+		t(arr[0] == i64);
+		t(arr[1] == guid);
+		t(arr[2] == 10);
+
+		var arr : Array<hl.I64> = [];
+		var i64 : hl.I64 = haxe.Int64.make(1, 1);
+		var guid : hl.GUID = haxe.Int64.make(2, -1);
+		arr.push(i64);
+		arr.push(guid);
+		arr.push(10);
+		t(arr[0] == i64);
+		t(arr[1] == guid);
+		t(arr[2] == 10);
+
+		var arr : Array<hl.UI16> = [];
+		var ui16 : hl.UI16 = 8;
+		var i32 : Int = 32;
+		var i32big : Int = 0xDEADBEEF;
+		arr.push(ui16);
+		arr.push(i32);
+		arr.push(i32big);
+		arr.push(10);
+		t(arr[0] == ui16);
+		t(arr[1] == i32);
+		f(arr[2] == i32big);
+		t(arr[2] == 0xBEEF);
+		t(arr[3] == 10);
+
+		var arr : Array<hl.UI8> = [];
+		var ui8 : hl.UI16 = 0xF7;
+		var ui16 : hl.UI16 = 8;
+		var i32 : Int = 32;
+		var i32big : Int = 0xDEADBEEF;
+		arr.push(ui16);
+		arr.push(i32);
+		arr.push(i32big);
+		arr.push(10);
+		arr.push(ui8);
+		t(arr[0] == ui16);
+		t(arr[1] == i32);
+		f(arr[2] == i32big);
+		t(arr[2] == 0xEF);
+		t(arr[3] == 10);
+		t(arr[4] == ui8);
+	}
+
+	public function testNumberOp() {
+		var a = new Numbers();
+		a.loadInt64(0x123456789ABCDEF0i64);
+		var b = new Numbers();
+		b.loadInt64(0xF0123456789ABCDEi64);
+
+		t(a.ui8 + b.ui8 == (206 : hl.UI8));
+		t(a.ui8 + b.ui8 == 206);
+		t(a.ui8 - b.ui8 == 18);
+		t(a.ui8 * b.ui8 == 32);
+		t(a.ui8 << 1 == 480); // Int
+		t(a.ui8 >> 1 == 120);
+		t(a.ui8 % b.ui8 == 18);
+		t(a.ui8 & b.ui8 == 208);
+		t(a.ui8 | b.ui8 == 254);
+		t(a.ui8 ^ b.ui8 == 46);
+
+		t(a.ui16 + b.ui16 == (39886 : hl.UI16));
+		t(a.ui16 + b.ui16 == 39886);
+		t(a.ui16 - b.ui16 == 8722);
+		t(a.ui16 * b.ui16 == 37920);
+		t(a.ui16 << 1 == 114144); // Int
+		t(a.ui16 >> 1 == 28536);
+		t(a.ui16 % b.ui16 == 8722);
+		t(a.ui16 & b.ui16 == 40144);
+		t(a.ui16 | b.ui16 == 65278);
+		t(a.ui16 ^ b.ui16 == 25134);
+
+		t(a.ui8 + a.ui16 == 57312);
+		t(a.ui16 + a.ui8 == 57312);
+		t(a.ui8 + a.i32 == 224); // UI8
+		t(a.i32 + a.ui8 == 224);
+		t(a.ui16 + a.i32 == 48608); // UI16
+		t(a.i32 + a.ui16 == 48608);
+
+		t(a.i64 + b.i64 == 163971058432973774i64);
+		t(a.i64 - b.i64 == 2459565876494606866i64);
+		t(a.i64 * b.i64 == -3777164426036014048i64);
+		t(a.i64 << 1 == a.i64 * 2i64);
+		t(a.i64 >> 1 == a.i64 / 2i64);
+		t(a.i64 / b.i64 == -1i64); // hl.I64.div return I64
+		t(a.i64 % b.i64 == a.i64 + b.i64);
+		t(a.i64 & b.i64 == b.i64 & a.i64);
+		t(a.i64 | b.i64 == -993476380043837698i64);
+		t(a.i64 | b.i64 == b.i64 | a.i64);
+		t(a.i64 ^ b.i64 == -2150923818520649170i64);
+		t(a.i64 ^ b.i64 == b.i64 ^ a.i64);
+	}
+
+	private function numberFun( v : Numbers, ui8 : hl.UI8, ui16 : hl.UI16, i32 : Int, i64: hl.I64, guid : hl.GUID ) {
+		t(v.ui8 == ui8);
+		t(v.ui16 == ui16);
+		t(v.i32 == i32);
+		t(v.i64 == i64);
+		t(v.guid == guid);
+	}
+
+	private function numberFunOpt( ?v : Numbers, ?ui8 : hl.UI8, ?ui16 : hl.UI16, ?i32 : Int, ?i64: hl.I64, ?guid : hl.GUID ) {
+		t(v?.ui8 == ui8);
+		t(v?.ui16 == ui16);
+		t(v?.i32 == i32);
+		t(v?.i64 == i64);
+		t(v?.guid == guid);
+	}
+
+	private function numberFunDefault( v : Numbers, ui8 : hl.UI8 = 1, ui16 : hl.UI16 = 1, i32 : Int = 1, i64: hl.I64 = 1, guid : hl.GUID = 1 ) {
+		t(v.ui8 == ui8);
+		t(v.ui16 == ui16);
+		t(v.i32 == i32);
+		t(v.i64 == i64);
+		t(v.guid == guid);
+	}
+
+	public function testNumberCall() {
+		var v = new Numbers();
+		v.loadInt64(0x123456789ABCDEF0i64);
+		numberFun(v, v.ui8, v.ui16, v.i32, v.i64, v.guid);
+		numberFunOpt(v, v.ui8, v.ui16, v.i32, v.i64, v.guid);
+		numberFunOpt();
+		var v = new Numbers();
+		v.loadInt(1);
+		numberFunDefault(v);
+	}
+}