don't use arrays for interface memoization, optimize "this" to interface (no null check required)

src/generators/genhl.ml

@@ -53,6 +53,7 @@ type method_context = {
 	mret : ttype;
 	mdebug : Globals.pos DynArray.t;
 	mvars : (int, tvar) Hashtbl.t;
+	mhasthis : bool;
 	mutable mallocs : (ttype, allocator) PMap.t;
 	mutable mcaptured : method_capture;
 	mutable mcontinues : (int -> unit) list;
@@ -192,7 +193,7 @@ let lookup_alloc l v =
 	DynArray.add l.arr v;
 	id
 
-let method_context id t captured =
+let method_context id t captured hasthis =
 	{
 		mid = id;
 		mregs = new_lookup();
@@ -202,6 +203,7 @@ let method_context id t captured =
 		mret = t;
 		mbreaks = [];
 		mcontinues = [];
+		mhasthis = hasthis;
 		mcaptured = captured;
 		mtrys = 0;
 		mcaptreg = 0;
@@ -502,7 +504,6 @@ and class_type ?(tref=None) ctx c pl statics =
 			pfunctions = PMap.empty;
 			pnfields = -1;
 			pinterfaces = PMap.empty;
-			pninterfaces = 0;
 		} in
 		let t = HObj p in
 		(match tref with
@@ -525,7 +526,6 @@ and class_type ?(tref=None) ctx c pl statics =
 				p.psuper <- Some psup;
 				p.pfunctions <- psup.pfunctions;
 				p.pinterfaces <- psup.pinterfaces;
-				p.pninterfaces <- psup.pninterfaces;
 				psup.pnfields, psup.pvirtuals
 			| _ -> assert false
 		) in
@@ -565,17 +565,10 @@ and class_type ?(tref=None) ctx c pl statics =
 		if not statics then begin
 			(* add interfaces *)
 			List.iter (fun (i,pl) ->
-				let index = p.pninterfaces in
-				p.pinterfaces <- PMap.add (to_type ctx (TInst (i,pl))) index p.pinterfaces;
-				p.pninterfaces <- index + 1;
-				if index = 0 then begin
-					(* first interface : create field to store them *)
-					let fid = DynArray.length fa in
-					let t = HArray in
-					let name = "__interfaces__" in
-					p.pindex <- PMap.add name (fid + start_field, t) p.pindex;
-					DynArray.add fa (name, alloc_string ctx name, t);
-				end;
+				let fid = DynArray.length fa in
+				let t = to_type ctx (TInst (i,pl)) in
+				p.pinterfaces <- PMap.add t fid p.pinterfaces;
+				DynArray.add fa ("", 0, t);
 			) c.cl_implements;
 			(* check toString *)
 			(try
@@ -639,7 +632,6 @@ and enum_class ctx e =
 			pfunctions = PMap.empty;
 			pnfields = -1;
 			pinterfaces = PMap.empty;
-			pninterfaces = 0;
 		} in
 		let t = HObj p in
 		ctx.cached_types <- PMap.add cpath t ctx.cached_types;
@@ -948,20 +940,24 @@ and cast_to ?(force=false) ctx (r:reg) (t:ttype) p =
 	| HObj o, HVirtual _ ->
 		let out = alloc_tmp ctx t in
 		(try
-			let index = PMap.find t o.pinterfaces in
+			let fid = PMap.find t o.pinterfaces in
 			(* memoisation *)
-			let arr = alloc_tmp ctx HArray in
-			let fid, _ = get_index "__interfaces__" o in
-			let jnull = jump ctx (fun d -> OJNotNull (r,d)) in
-			op ctx (ONull out);
-			let jend = jump ctx (fun d -> OJAlways d) in
-			jnull();
-			op ctx (OField (arr, r, fid));
-			let rindex = reg_int ctx index in
-			op ctx (OGetArray (out, arr, rindex));
+			let need_null_check r =
+				not (r = 0 && ctx.m.mhasthis)
+			in
+			let jend = if need_null_check r then
+				let jnull = jump ctx (fun d -> OJNotNull (r,d)) in
+				op ctx (ONull out);
+				let jend = jump ctx (fun d -> OJAlways d) in
+				jnull();
+				jend
+			else
+				(fun() -> ())
+			in
+			op ctx (OField (out, r, fid));
 			let j = jump ctx (fun d -> OJNotNull (out,d)) in
 			op ctx (OToVirtual (out,r));
-			op ctx (OSetArray (arr, rindex, out));
+			op ctx (OSetField (r, fid, out));
 			jend();
 			j();
 		with Not_found ->
@@ -1775,9 +1771,9 @@ and eval_expr ctx e =
 			free ctx r;
 			let ret = alloc_tmp ctx (match tfun with HFun (_,r) -> r | _ -> HDyn) in
 			op ctx (OCallClosure (ret, r, el)); (* if it's a value, it's a closure *)
-			def_ret := Some (unsafe_cast_to ctx ret (to_type ctx e.etype) e.epos);
+			def_ret := Some (cast_to ~force:true ctx ret (to_type ctx e.etype) e.epos);
 		);
-		(match !def_ret with None -> unsafe_cast_to ctx ret (to_type ctx e.etype) e.epos | Some r -> r)
+		(match !def_ret with None -> cast_to ~force:true ctx ret (to_type ctx e.etype) e.epos | Some r -> r)
 	| TField (ec,FInstance({ cl_path = [],"Array" },[t],{ cf_name = "length" })) when to_type ctx t = HDyn ->
 		let r = alloc_tmp ctx HI32 in
 		op ctx (OCall1 (r,alloc_fun_path ctx (["hl";"types"],"ArrayDyn") "get_length", eval_null_check ctx ec));
@@ -2617,7 +2613,7 @@ and gen_method_wrapper ctx rt t p =
 		let old = ctx.m in
 		let targs, tret = (match t with HFun (args, ret) -> args, ret | _ -> assert false) in
 		let iargs, iret = (match rt with HFun (args, ret) -> args, ret | _ -> assert false) in
-		ctx.m <- method_context fid HDyn null_capture;
+		ctx.m <- method_context fid HDyn null_capture false;
 		let rfun = alloc_tmp ctx rt in
 		let rargs = List.map (fun t ->
 			let r = alloc_tmp ctx t in
@@ -2650,7 +2646,7 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 		| _ -> capt, false
 	) in
 
-	ctx.m <- method_context fidx (to_type ctx f.tf_type) capt;
+	ctx.m <- method_context fidx (to_type ctx f.tf_type) capt (cthis <> None);
 
 	set_curpos ctx f.tf_expr.epos;
 
@@ -2836,18 +2832,6 @@ let rec generate_member ctx c f =
 					op ctx (OSetThis (fid,r));
 				| _ -> ()
 			) c.cl_ordered_fields;
-			(* init interfaces *)
-			if c.cl_implements <> [] then begin
-				let fid, _ = (try get_index "__interfaces__" o with Not_found -> assert false) in
-				let arr = alloc_tmp ctx HArray in
-				op ctx (OGetThis (arr, fid));
-				let j = jump ctx (fun d -> OJNotNull (arr,d)) in
-				let rt = alloc_tmp ctx HType in
-				op ctx (OType (rt, HDyn));
-				op ctx (OCall2 (arr,alloc_std ctx "alloc_array" [HType;HI32] HArray, rt,reg_int ctx o.pninterfaces));
-				op ctx (OSetThis (fid, arr));
-				j();
-			end;
 		) in
 		ignore(make_fun ?gen_content ctx (s_type_path c.cl_path,f.cf_name) (alloc_fid ctx c f) (match f.cf_expr with Some { eexpr = TFunction f } -> f | _ -> abort "Missing function body" f.cf_pos) (Some c) None);
 		if f.cf_name = "toString" && not (List.memq f c.cl_overrides) && not (PMap.mem "__string" c.cl_fields) && is_to_string f.cf_type then begin
@@ -3372,7 +3356,7 @@ let generate com =
 		com = com;
 		optimize = not (Common.raw_defined com "hl-no-opt");
 		dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None;
-		m = method_context 0 HVoid null_capture;
+		m = method_context 0 HVoid null_capture false;
 		cints = new_lookup();
 		cstrings = new_lookup();
 		cfloats = new_lookup();

src/generators/hlcode.ml

@@ -58,7 +58,6 @@ and class_proto = {
 	mutable pindex : (string, int * ttype) PMap.t;
 	mutable pfunctions : (string, int) PMap.t;
 	mutable pinterfaces : (ttype, int) PMap.t;
-	mutable pninterfaces : int;
 }
 
 and enum_proto = {
@@ -233,7 +232,6 @@ let null_proto =
 		pindex = PMap.empty;
 		pfunctions = PMap.empty;
 		pinterfaces = PMap.empty;
-		pninterfaces = 0;
 	}
 
 let list_iteri f l =