[hl] add element type to HArray

src/generators/genhl.ml

@@ -470,7 +470,7 @@ let rec to_type ?tref ctx t =
 			| ["hl"], "UI16" -> HUI16
 			| ["hl"], "UI8" -> HUI8
 			| ["hl"], "I64" -> HI64
-			| ["hl"], "NativeArray" -> HArray
+			| ["hl"], "NativeArray" -> HArray (to_type ctx (List.hd pl))
 			| ["haxe";"macro"], "Position" -> HAbstract ("macro_pos", alloc_string ctx "macro_pos")
 			| _ -> failwith ("Unknown core type " ^ s_type_path a.a_path))
 		else
@@ -1462,7 +1462,7 @@ and array_read ctx ra (at,vt) ridx p =
 		let jend = jump ctx (fun i -> OJAlways i) in
 		j();
 		let tmp = alloc_tmp ctx HDyn in
-		let harr = alloc_tmp ctx HArray in
+		let harr = alloc_tmp ctx (HArray vt) in
 		op ctx (OField (harr,ra,1));
 		op ctx (OGetArray (tmp,harr,ridx));
 		op ctx (OMov (r,unsafe_cast_to ctx tmp vt p));
@@ -2004,23 +2004,25 @@ and eval_expr ctx e =
 				let arr = eval_expr ctx e in
 				op ctx (ONullCheck arr);
 				op ctx (OArraySize (r, arr))
+			| TAbstract ({ a_path = ["hl"],"NativeArray" },[t]) ->
+				op ctx (OArraySize (r, eval_to ctx e (HArray (to_type ctx t))))
 			| _ ->
-				op ctx (OArraySize (r, eval_to ctx e HArray)));
+				invalid());
 			r
 		| "$aalloc", [esize] ->
 			let et = (match follow e.etype with TAbstract ({ a_path = ["hl"],"NativeArray" },[t]) -> to_type ctx t | _ -> invalid()) in
 			let size = eval_to ctx esize HI32 in
-			let a = alloc_tmp ctx HArray in
+			let a = alloc_tmp ctx (HArray et) in
 			let rt = alloc_tmp ctx HType in
 			op ctx (OType (rt,et));
-			op ctx (OCall2 (a,alloc_std ctx "alloc_array" [HType;HI32] HArray,rt,size));
+			op ctx (OCall2 (a,alloc_std ctx "alloc_array" [HType;HI32] (HArray et),rt,size));
 			a
 		| "$aget", [a; pos] ->
 			(*
 				read/write on arrays are unsafe : the type of NativeArray needs to be correcly set.
 			*)
 			let at = (match follow a.etype with TAbstract ({ a_path = ["hl"],"NativeArray" },[t]) -> to_type ctx t | _ -> invalid()) in
-			let arr = eval_to ctx a HArray in
+			let arr = eval_to ctx a (HArray at) in
 			hold ctx arr;
 			let pos = eval_to ctx pos HI32 in
 			free ctx arr;
@@ -2029,7 +2031,7 @@ and eval_expr ctx e =
 			cast_to ctx r (to_type ctx e.etype) e.epos
 		| "$aset", [a; pos; value] ->
 			let et = (match follow a.etype with TAbstract ({ a_path = ["hl"],"NativeArray" },[t]) -> to_type ctx t | _ -> invalid()) in
-			let arr = eval_to ctx a HArray in
+			let arr = eval_to ctx a (HArray et) in
 			hold ctx arr;
 			let pos = eval_to ctx pos HI32 in
 			hold ctx pos;
@@ -2106,12 +2108,12 @@ and eval_expr ctx e =
 		| "$resources", [] ->
 			let tdef = (try List.find (fun t -> (t_infos t).mt_path = (["haxe";"_Resource"],"ResourceContent")) ctx.com.types with Not_found -> die "" __LOC__) in
 			let t = class_type ctx (match tdef with TClassDecl c -> c | _ -> die "" __LOC__) [] false in
-			let arr = alloc_tmp ctx HArray in
+			let arr = alloc_tmp ctx (HArray HBytes) in
 			let rt = alloc_tmp ctx HType in
 			op ctx (OType (rt,t));
 			let res = Hashtbl.fold (fun k v acc -> (k,v) :: acc) ctx.com.resources [] in
 			let size = reg_int ctx (List.length res) in
-			op ctx (OCall2 (arr,alloc_std ctx "alloc_array" [HType;HI32] HArray,rt,size));
+			op ctx (OCall2 (arr,alloc_std ctx "alloc_array" [HType;HI32] (HArray HBytes),rt,size));
 			let ro = alloc_tmp ctx t in
 			let rb = alloc_tmp ctx HBytes in
 			let ridx = reg_int ctx 0 in
@@ -2555,7 +2557,7 @@ and eval_expr ctx e =
 						op ctx (OField (b,ra,1));
 						write_mem ctx b (shl ctx ridx (type_size_bits at)) at v
 					| _ ->
-						let arr = alloc_tmp ctx HArray in
+						let arr = alloc_tmp ctx (HArray vt) in
 						op ctx (OField (arr,ra,1));
 						op ctx (OSetArray (arr,ridx,cast_to ctx v (if is_dynamic at then at else HDyn) e.epos))
 				);
@@ -2828,11 +2830,11 @@ and eval_expr ctx e =
 			array_bytes 3 HF64 "F64" (fun b i r -> OSetMem (b,i,r))
 		| _ ->
 			let at = if is_dynamic et then et else HDyn in
-			let a = alloc_tmp ctx HArray in
+			let a = alloc_tmp ctx (HArray at) in
 			let rt = alloc_tmp ctx HType in
 			op ctx (OType (rt,at));
 			let size = reg_int ctx (List.length el) in
-			op ctx (OCall2 (a,alloc_std ctx "alloc_array" [HType;HI32] HArray,rt,size));
+			op ctx (OCall2 (a,alloc_std ctx "alloc_array" [HType;HI32] (HArray at),rt,size));
 			hold ctx a;
 			list_iteri (fun i e ->
 				let r = eval_to ctx e at in
@@ -3119,7 +3121,7 @@ and gen_assign_op ctx acc e1 f =
 		let r = f r in
 		op ctx (OSetEnumField (ctx.m.mcaptreg,idx,r));
 		r
-	| AArray (ra,(at,_),ridx) ->
+	| AArray (ra,(at,vt),ridx) ->
 		hold ctx ra;
 		hold ctx ridx;
 		let r = (match at with
@@ -3153,7 +3155,7 @@ and gen_assign_op ctx acc e1 f =
 				free ctx hbytes;
 				r
 			| _ ->
-				let arr = alloc_tmp ctx HArray in
+				let arr = alloc_tmp ctx (HArray vt) in
 				op ctx (OField (arr,ra,1));
 				let r = alloc_tmp ctx at in
 				op ctx (OGetArray (r,arr,ridx));
@@ -3655,10 +3657,10 @@ let generate_static_init ctx types main =
 				in
 				if (has_class_flag c CInterface) then begin
 					let l = gather_implements() in
-					let ra = alloc_tmp ctx HArray in
+					let ra = alloc_tmp ctx (HArray HType) in
 					let rt = alloc_tmp ctx HType in
 					op ctx (OType (rt, HType));
-					op ctx (OCall2 (ra, alloc_std ctx "alloc_array" [HType;HI32] HArray, rt, reg_int ctx (List.length l)));
+					op ctx (OCall2 (ra, alloc_std ctx "alloc_array" [HType;HI32] (HArray HType), rt, reg_int ctx (List.length l)));
 					list_iteri (fun i intf ->
 						op ctx (OType (rt, to_type ctx (TInst (intf,[]))));
 						op ctx (OSetArray (ra, reg_int ctx i, rt));
@@ -3701,7 +3703,7 @@ let generate_static_init ctx types main =
 						die "" __LOC__
 				in
 
-				let avalues = alloc_tmp ctx HArray in
+				let avalues = alloc_tmp ctx (HArray t) in
 				op ctx (OField (avalues, r, index "__evalues__"));
 
 				List.iter (fun n ->
@@ -3989,7 +3991,7 @@ let write_code ch code debug =
 			Array.iter (fun (_,n,t) -> write_index n; write_type t) p.pfields;
 			Array.iter (fun f -> write_index f.fid; write_index f.fmethod; write_index (match f.fvirtual with None -> -1 | Some i -> i)) p.pproto;
 			List.iter (fun (fid,fidx) -> write_index fid; write_index fidx) p.pbindings;
-		| HArray ->
+		| HArray _ ->
 			byte 12
 		| HType ->
 			byte 13

src/generators/hl2c.ml

@@ -117,15 +117,15 @@ 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;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;HNull HVoid;HMethod ([],HVoid);HStruct null_proto]
 
 let tname str =
 	let n = String.concat "__" (ExtString.String.nsplit str ".") in
 	ident n
 
 let is_gc_ptr = function
 	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HType | HRef _ | HMethod _ | HPacked _ -> false
-	| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HStruct _ -> true
+	| HBytes | HDyn | HFun _ | HObj _ | HArray _ | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HStruct _ -> true
 
 let is_ptr = function
 	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool -> false
@@ -144,7 +144,7 @@ let rec ctype_no_ptr = function
 	| HDyn -> "vdynamic",1
 	| HFun _ -> "vclosure",1
 	| HObj p | HStruct p -> tname p.pname,0
-	| HArray -> "varray",1
+	| HArray _ -> "varray",1
 	| HType -> "hl_type",1
 	| HRef t -> let s,i = ctype_no_ptr t in s,i + 1
 	| HVirtual _ -> "vvirtual",1
@@ -192,7 +192,7 @@ let type_id t =
 	| HDyn -> "HDYN"
 	| HFun _ -> "HFUN"
 	| HObj _ -> "HOBJ"
-	| HArray -> "HARRAY"
+	| HArray _ -> "HARRAY"
 	| HType -> "HTYPE"
 	| HRef _ -> "HREF"
 	| HVirtual _ -> "HVIRTUAL"
@@ -237,7 +237,7 @@ let define ctx s =
 
 let rec define_type ctx t =
 	match t with
-	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray | HType | HDynObj | HNull _ | HRef _ -> ()
+	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray _ | HType | HDynObj | HNull _ | HRef _ -> ()
 	| HAbstract _ ->
 		define ctx "#include <hl/natives.h>";
 	| HFun (args,ret) | HMethod (args,ret) ->
@@ -744,7 +744,7 @@ let generate_function ctx f =
 			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 ->
+			| HBytes, HBytes | HArray _,HArray _ ->
 				phys_compare()
 			| HType, HType ->
 				sexpr "if( hl_same_type(%s,%s) %s 0 ) {} else goto %s" (reg a) (reg b) (s_comp op) (label d)
@@ -1095,7 +1095,7 @@ let generate_function ctx f =
 			sexpr "hl_assert()"
 		| ORefData (r,d) ->
 			(match rtype d with
-			| HArray ->
+			| HArray _ ->
 				sexpr "%s = (%s)hl_aptr(%s,void*)" (reg r) (ctype (rtype r)) (reg d)
 			| _ ->
 				Globals.die "" __LOC__)
@@ -1138,7 +1138,7 @@ let make_types_idents htypes =
 	let types_descs = ref PMap.empty in
 	let rec make_desc t =
 		match t with
-		| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray | HType | HRef _ | HDynObj | HNull _ ->
+		| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray _ | HType | HRef _ | HDynObj | HNull _ ->
 			DSimple t
 		| HFun (tl,t) ->
 			DFun (List.map make_desc tl, make_desc t, true)

src/generators/hlcode.ml

@@ -38,7 +38,7 @@ type ttype =
 	| HDyn
 	| HFun of ttype list * ttype
 	| HObj of class_proto
-	| HArray
+	| HArray of ttype
 	| HType
 	| HRef of ttype
 	| HVirtual of virtual_proto
@@ -258,7 +258,7 @@ let list_mapi f l =
 *)
 let is_nullable t =
 	match t with
-	| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HRef _ | HType | HMethod _ | HStruct _ -> true
+	| HBytes | HDyn | HFun _ | HObj _ | HArray _ | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HRef _ | HType | HMethod _ | HStruct _ -> true
 	| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HVoid | HPacked _ -> false
 
 let is_struct = function
@@ -288,7 +288,7 @@ let is_nullt = function
 *)
 let is_dynamic t =
 	match t with
-	| HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HNull _ | HEnum _ -> true
+	| HDyn | HFun _ | HObj _ | HArray _ | HVirtual _ | HDynObj | HNull _ | HEnum _ -> true
 	| _ -> false
 
 let rec tsame t1 t2 =
@@ -314,6 +314,17 @@ let rec tsame t1 t2 =
 	| HRef t1, HRef t2 -> tsame t1 t2
 	| _ -> false
 
+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 *)
+	| _ ->
+		(* no other number combinations are compatible, but everything else is *)
+		not (is_number t1) && not (is_number t2)
+
 (*
 	can we use a value of t1 as t2
 *)
@@ -345,6 +356,8 @@ let rec safe_cast t1 t2 =
 		safe_cast t1 t2
 	| HFun (args1,t1), HFun (args2,t2) when List.length args1 = List.length args2 ->
 		List.for_all2 (fun t1 t2 -> safe_cast t2 t1 || (t1 = HDyn && is_dynamic t2)) args1 args2 && safe_cast t1 t2
+	| HArray t1,HArray t2 ->
+		compatible_element_types t1 t2
 	| _ ->
 		tsame t1 t2
 
@@ -456,8 +469,8 @@ let rec tstr ?(stack=[]) ?(detailed=false) t =
 		let proto = "{"  ^ String.concat "," (List.map (fun p -> (match p.fvirtual with None -> "" | Some _ -> "virtual ") ^ p.fname ^ "@" ^  string_of_int p.fmethod) (Array.to_list o.pproto)) ^ "}" in
 		let str = o.pname ^ "[" ^ (match o.psuper with None -> "" | Some p -> ">" ^ p.pname ^ " ") ^ "fields=" ^ fields ^ " proto=" ^ proto ^ "]" in
 		(match t with HObj o -> str | _ -> "@" ^ str)
-	| HArray ->
-		"array"
+	| HArray t ->
+		"array(" ^ (tstr ~stack ~detailed t) ^ ")"
 	| HType ->
 		"type"
 	| HRef t ->

src/generators/hlinterp.ml

@@ -132,7 +132,7 @@ let get_type = function
 	| VObj o -> Some (HObj o.oproto.pclass)
 	| VDynObj _ -> Some HDynObj
 	| VVirtual v -> Some (HVirtual v.vtype)
-	| VArray _ -> Some HArray
+	| VArray (_,t) -> Some (HArray t)
 	| 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) | _ -> Globals.die "" __LOC__)
 	| VVarArgs _ -> Some (HFun ([],HDyn))
@@ -158,7 +158,7 @@ let rec is_compatible v t =
 	| v, HNull t -> is_compatible v t
 	| v, HDyn -> v_dynamic v
 	| VType _, HType -> true
-	| VArray _, HArray -> true
+	| VArray _, HArray _ -> true
 	| VDynObj _, HDynObj -> true
 	| VVirtual v, HVirtual _ -> safe_cast (HVirtual v.vtype) t
 	| VRef (_,t1), HRef t2 -> tsame t1 t2
@@ -526,7 +526,7 @@ and dyn_call ctx v args tret =
 		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 ctx (VClosure (f,a)) [arr,HArray] tret
+		dyn_call ctx (VClosure (f,a)) [arr,HArray HDyn] tret
 	| _ ->
 		throw_msg ctx (vstr_d ctx v ^ " cannot be called")
 
@@ -1073,7 +1073,7 @@ let interp ctx f args =
 					| HDyn -> 9
 					| HFun _ -> 10
 					| HObj _ -> 11
-					| HArray -> 12
+					| HArray _ -> 12
 					| HType -> 13
 					| HRef _ -> 14
 					| HVirtual _ -> 15
@@ -2424,7 +2424,7 @@ let check comerror code =
 			| ORethrow r ->
 				reg r HDyn
 			| OGetArray (v,a,i) ->
-				(match rtype a with HAbstract ("hl_carray",_) -> () | _ -> reg a HArray);
+				(match rtype a with HAbstract ("hl_carray",_) | HArray _ -> () | _ -> reg a (HArray HDyn));
 				reg i HI32;
 				ignore(rtype v);
 			| OGetUI8 (r,b,p) | OGetUI16(r,b,p) ->
@@ -2444,7 +2444,7 @@ let check comerror code =
 				reg p HI32;
 				(match rtype v with HI32 | HI64 | HF32 | HF64 -> () | _ -> error (reg_inf r ^ " should be numeric"));
 			| OSetArray (a,i,v) ->
-				(match rtype a with HAbstract ("hl_carray",_) -> () | _ -> reg a HArray);
+				(match rtype a with HAbstract ("hl_carray",_) | HArray _ -> () | _ -> reg a (HArray HDyn));
 				reg i HI32;
 				ignore(rtype v);
             | OUnsafeCast (a,b) | OSafeCast (a,b) ->
@@ -2523,8 +2523,12 @@ let check comerror code =
 			| OAssert _ ->
 				()
 			| ORefData (r,d) ->
-				reg d HArray;
-				(match rtype r with HRef _ -> () | _ -> reg r (HRef HDyn))
+				(match rtype r with
+					| HRef t ->
+						reg d (HArray t);
+					| _ ->
+						reg d (HArray HDyn);
+						reg r (HRef HDyn))
 			| ORefOffset (r,r2,off) ->
 				(match rtype r2 with HRef _ -> () | _ -> reg r2 (HRef HDyn));
 				reg r (rtype r2);