[hl] introduce HMethod to differentiate direct function ptr from field

src/generators/genhl.ml

@@ -402,16 +402,7 @@ let rec to_type ?tref ctx t =
 			| None -> ()
 			| Some r -> r := Some t);
 			ctx.anons_cache <- (a,t) :: ctx.anons_cache;
-			let fields = PMap.fold (fun cf acc ->
-				match cf.cf_kind with
-				| Var _ when (match follow cf.cf_type with TFun _ -> true | _ -> false) ->
-					(* allowing functions will crash unit tests *)
-					acc
-				| Method _ ->
-					acc
-				| _ ->
-					(cf.cf_name,alloc_string ctx cf.cf_name,to_type ctx cf.cf_type) :: acc
-			) a.a_fields [] in
+			let fields = PMap.fold (fun cf acc -> cfield_type ctx cf :: acc) a.a_fields [] in
 			if fields = [] then
 				let t = HDyn in
 				ctx.anons_cache <- (a,t) :: List.tl ctx.anons_cache;
@@ -483,6 +474,14 @@ and resolve_class ctx c pl statics =
 	| _ ->
 		c
 
+and cfield_type ctx cf =
+	let t = to_type ctx cf.cf_type in
+	let t = (match cf.cf_kind, t with
+		| Method (MethNormal|MethInline), HFun (args,ret) -> HMethod (args,ret)
+		| _ -> t
+	) in
+	(cf.cf_name,alloc_string ctx cf.cf_name,t)
+
 and field_type ctx f p =
 	match f with
 	| FInstance (c,pl,f) | FClosure (Some (c,pl),f) ->
@@ -553,7 +552,7 @@ and class_type ?(tref=None) ctx c pl statics =
 		ctx.cached_types <- PMap.add c.cl_path t ctx.cached_types;
 		let rec loop c =
 			let fields = List.fold_left (fun acc (i,_) -> loop i @ acc) [] c.cl_implements in
-			PMap.fold (fun cf acc -> (cf.cf_name,alloc_string ctx cf.cf_name,to_type ctx cf.cf_type) :: acc) c.cl_fields fields
+			PMap.fold (fun cf acc -> cfield_type ctx cf :: acc) c.cl_fields fields
 		in
 		let fields = loop c in
 		vp.vfields <- Array.of_list fields;
@@ -3708,10 +3707,10 @@ let write_code ch code debug =
 		| HBool -> byte 7
 		| HBytes -> byte 8
 		| HDyn -> byte 9
-		| HFun (args,ret) ->
+		| HFun (args,ret) | HMethod (args,ret) ->
 			let n = List.length args in
 			if n > 0xFF then assert false;
-			byte 10;
+			byte (match t with HFun _ -> 10 | _ -> 20);
 			byte n;
 			List.iter write_type args;
 			write_type ret

src/generators/hl2c.ml

@@ -101,7 +101,7 @@ let tname str =
 	if Hashtbl.mem keywords ("_" ^ n) then "__" ^ n else n
 
 let is_gc_ptr = function
-	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HType | HRef _ -> false
+	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HType | HRef _ | HMethod _ -> false
 	| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ -> true
 
 let is_ptr = function
@@ -129,6 +129,7 @@ let rec ctype_no_ptr = function
 	| HAbstract (name,_) -> name,1
 	| HEnum _ -> "venum",1
 	| HNull _ -> "vdynamic",1
+	| HMethod _ -> "void",1
 
 let ctype t =
 	let t, nptr = ctype_no_ptr t in
@@ -173,6 +174,7 @@ let type_id t =
 	| HAbstract _ -> "HABSTRACT"
 	| HEnum _ -> "HENUM"
 	| HNull _ -> "HNULL"
+	| HMethod _ -> "HMETHOD"
 
 let var_type n t =
 	ctype t ^ " " ^ ident n
@@ -275,6 +277,7 @@ let generate_reflection ctx =
 		| HVoid | HF32 | HF64 | HI64 -> t
 		| HBool | HUI8 | HUI16 | HI32 -> HI32
 		| HBytes | HDyn | HFun _ | HObj _ | HArray | HType | HRef _ | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ -> HDyn
+		| HMethod _ -> assert false
 	in
 	let type_kind_id t =
 		match t with

src/generators/hlcode.ml

@@ -46,6 +46,7 @@ type ttype =
 	| HAbstract of string * string index
 	| HEnum of enum_proto
 	| HNull of ttype
+	| HMethod of ttype list * ttype
 
 and class_proto = {
 	pname : string;
@@ -253,7 +254,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 -> true
+	| HBytes | HDyn | HFun _ | HObj _ | HArray | HVirtual _ | HDynObj | HAbstract _ | HEnum _ | HNull _ | HRef _ | HType | HMethod _ -> true
 	| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HVoid -> false
 
 
@@ -281,6 +282,7 @@ let rec tsame t1 t2 =
 	if t1 == t2 then true else
 	match t1, t2 with
 	| HFun (args1,ret1), HFun (args2,ret2) when List.length args1 = List.length args2 -> List.for_all2 tsame args1 args2 && tsame ret2 ret1
+	| HMethod (args1,ret1), HMethod (args2,ret2) when List.length args1 = List.length args2 -> List.for_all2 tsame args1 args2 && tsame ret2 ret1
 	| HObj p1, HObj p2 -> p1 == p2
 	| HEnum e1, HEnum e2 -> e1 == e2
 	| HAbstract (_,a1), HAbstract (_,a2) -> a1 == a2
@@ -375,7 +377,7 @@ let gather_types (code:code) =
 		DynArray.add arr t;
 		types := PMap.add t index !types;
 		match t with
-		| HFun (args, ret) ->
+		| HFun (args, ret) | HMethod (args, ret) ->
 			List.iter get_type args;
 			get_type ret
 		| HObj p ->
@@ -421,6 +423,7 @@ let rec tstr ?(stack=[]) ?(detailed=false) t =
 	| HBytes -> "bytes"
 	| HDyn  -> "dyn"
 	| HFun (args,ret) -> "(" ^ String.concat "," (List.map (tstr ~stack ~detailed) args) ^ "):" ^ tstr ~stack ~detailed ret
+	| HMethod (args,ret) -> "method:(" ^ String.concat "," (List.map (tstr ~stack ~detailed) args) ^ "):" ^ tstr ~stack ~detailed ret
 	| HObj o when not detailed -> "#" ^ o.pname
 	| HObj o ->
 		let fields = "{" ^ String.concat "," (List.map (fun(s,_,t) -> s ^ " : " ^ tstr ~detailed:false t) (Array.to_list o.pfields)) ^ "}" in

src/generators/hlinterp.ml

@@ -1072,7 +1072,8 @@ let interp ctx f args =
 					| HDynObj -> 16
 					| HAbstract _ -> 17
 					| HEnum _ -> 18
-					| HNull _ -> 19)))
+					| HNull _ -> 19
+					| HMethod _ -> 20)))
 				| _ -> assert false);
 		| ORef (r,v) ->
 			set r (VRef (RStack (v + spos),rtype v))
@@ -2323,16 +2324,24 @@ let check code macros =
 				(match rl with
 				| [] -> assert false
 				| obj :: rl2 ->
-					let t, rl = (match rtype obj with
-						| HVirtual v ->
-							let _, _, t = v.vfields.(m) in
-							t, rl2
-						| _ ->
-							tfield obj m true, rl
-					) in
-					match t with
-					| HFun (targs, tret) when List.length targs = List.length rl -> List.iter2 reg rl targs; check tret (rtype r)
-					| t -> check t (HFun (List.map rtype rl, rtype r)))
+					let check_args targs tret rl =
+						if List.length targs <> List.length rl then false else begin
+							List.iter2 reg rl targs;
+							check tret (rtype r);
+							true;
+						end
+					in
+					match rtype obj with
+					| HVirtual v ->
+						let _, _, t = v.vfields.(m) in
+						(match t with
+						| HMethod (args,ret) when check_args args ret rl2 -> ()
+						| _ -> check t (HMethod (List.map rtype rl, rtype r)))
+					| _ ->
+						let t = tfield obj m true in
+						match t with
+						| HFun (args, ret) when check_args args ret rl -> ()
+						| _ -> check t (HFun (List.map rtype rl, rtype r)))
 			| OCallClosure (r,f,rl) ->
 				(match rtype f with
 				| HFun (targs,tret) when List.length targs = List.length rl -> List.iter2 reg rl targs; check tret (rtype r)