[everywhere] add coro argument to TFun

Author: Simn

src/codegen/codegen.ml

@@ -90,7 +90,7 @@ let update_cache_dependencies t =
 		| TAbstract(a,tl) ->
 			add_dependency m a.a_module;
 			List.iter (check_t m) tl;
-		| TFun(targs,tret) ->
+		| TFun(targs,tret,_) ->
 			List.iter (fun (_,_,t) -> check_t m t) targs;
 			check_t m tret;
 		| TAnon an ->
@@ -157,9 +157,13 @@ let rec find_field com c f =
 
 let fix_override com c f fd =
 	let f2 = (try Some (find_field com c f) with Not_found -> None) in
+	let extract_fun f2 = match follow f2.cf_type with
+		| TFun (args,ret,coro) -> args, ret, coro
+		| _ -> die "" __LOC__
+	in
 	match f2,fd with
 		| Some (f2), Some(fd) ->
-			let targs, tret = (match follow f2.cf_type with TFun (args,ret) -> args, ret | _ -> die "" __LOC__) in
+			let targs, tret, coro = extract_fun f2 in
 			let changed_args = ref [] in
 			let prefix = "_tmp_" in
 			let nargs = List.map2 (fun ((v,ct) as cur) (_,_,t2) ->
@@ -197,10 +201,10 @@ let fix_override com c f fd =
 			let targs = List.map (fun(v,c) -> (v.v_name, Option.is_some c, v.v_type)) nargs in
 			let fde = (match f.cf_expr with None -> die "" __LOC__ | Some e -> e) in
 			f.cf_expr <- Some { fde with eexpr = TFunction fd2 };
-			f.cf_type <- TFun(targs,tret);
+			f.cf_type <- TFun(targs,tret,coro);
 		| Some(f2), None when (has_class_flag c CInterface) ->
-			let targs, tret = (match follow f2.cf_type with TFun (args,ret) -> args, ret | _ -> die "" __LOC__) in
-			f.cf_type <- TFun(targs,tret)
+			let targs, tret, coro = extract_fun f2 in
+			f.cf_type <- TFun(targs,tret,coro)
 		| _ ->
 			()
 
@@ -334,7 +338,7 @@ module Dump = struct
 							| Some e -> " = " ^ (s_cf_expr f));
 						| Method m -> if ((has_class_flag c CExtern) || (has_class_flag c CInterface)) then (
 							match f.cf_type with
-							| TFun(al,t) -> print "(%s):%s;" (String.concat ", " (
+							| TFun(al,t,_) -> print "(%s):%s;" (String.concat ", " (
 								List.map (fun (n,o,t) -> n ^ ":" ^ (s_type t)) al))
 								(s_type t)
 							| _ -> ()
@@ -365,7 +369,7 @@ module Dump = struct
 					let f = PMap.find n e.e_constrs in
 					print "\t%s%s;\n" f.ef_name (
 						match f.ef_type with
-						| TFun (al,t) -> Printf.sprintf "(%s)" (String.concat ", "
+						| TFun (al,t,_) -> Printf.sprintf "(%s)" (String.concat ", "
 							(List.map (fun (n,o,t) -> (if o then "?" else "") ^ n ^ ":" ^ (s_type t)) al))
 						| _ -> "")
 				) e.e_names;
@@ -502,7 +506,7 @@ module UnificationCallback = struct
 		List.rev (loop [] el tl)
 
 	let check_call f el t = match follow t with
-		| TFun(args,_) ->
+		| TFun(args,_,_) ->
 			check_call_params f el args
 		| _ ->
 			List.map (fun e -> f e t_dynamic) el

src/codegen/gencommon/castDetect.ml

@@ -176,7 +176,7 @@ let rec type_eq gen param a b =
 	| TInst (c1,tl1) , TInst (c2,tl2) ->
 		if c1 != c2 && not (param = EqCoreType && c1.cl_path = c2.cl_path) && (match c1.cl_kind, c2.cl_kind with KExpr _, KExpr _ -> false | _ -> true) then Type.error [cannot_unify a b];
 		List.iter2 (type_eq gen param) tl1 tl2
-	| TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 ->
+	| TFun (l1,r1,coro1) , TFun (l2,r2,coro2) when coro1 = coro2 && List.length l1 = List.length l2 ->
 		(try
 			type_eq gen param r1 r2;
 			List.iter2 (fun (n,o1,t1) (_,o2,t2) ->
@@ -513,7 +513,7 @@ let rec handle_cast gen e real_to_t real_from_t =
 				e
 			else
 				mk_cast true to_t e
-		| TFun(args, ret), TFun(args2, ret2) ->
+		| TFun(args, ret, coro1), TFun(args2, ret2, coro2) when coro1 = coro2 ->
 			let get_args = List.map (fun (_,_,t) -> t) in
 			(try List.iter2 (type_eq gen (EqBothDynamic)) (ret :: get_args args) (ret2 :: get_args args2); e with | Unify_error _ | Invalid_argument _ -> mk_cast true to_t e)
 		| _, _ ->
@@ -611,7 +611,7 @@ let choose_ctor gen cl tparams etl maybe_empty_t p =
 			let count = ref 0 in
 			let is_empty_call = Type.type_iseq t empty_t in
 			let ret = List.filter (fun cf -> match follow cf.cf_type with
-				| TFun([_,_,t],_) ->
+				| TFun([_,_,t],_,_) ->
 					replace_mono t; incr count; is_empty_call = (Type.type_iseq t empty_t)
 				| _ -> false) ctors
 			in
@@ -690,7 +690,7 @@ let change_rest tfun elist =
 			List.rev acc
 	in
 	let args,ret = get_fun tfun in
-	TFun(loop [] args elist, ret)
+	TFun(loop [] args elist, ret, false)
 
 let fastcast_if_needed gen expr real_to_t real_from_t =
 	if Common.defined gen.gcon Define.FastCast then begin
@@ -724,7 +724,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist
 				efield
 			| Some ecall ->
 				match follow efield.etype with
-					| TFun(_,ret) ->
+					| TFun(_,ret,_) ->
 						(* closures will be handled by the closure handler. So we will just hint what's the expected type *)
 						(* FIXME: should closures have also its arguments cast correctly? In the current implementation I think not. TO_REVIEW *)
 						handle_cast gen { ecall with eexpr = TCall(efield, elist) } (gen.greal_type ecall.etype) ret
@@ -741,7 +741,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist
 			let args_list args = (if not calls_parameters_explicitly then t_dynamic else snd args) :: (List.map (fun (n,o,t) -> t) (fst args)) in
 
 			let monos = List.map (fun _ -> mk_mono()) params in
-			let original = args_list (get_fun (apply_params params monos (TFun(fst original_args,snd original_args)))) in
+			let original = args_list (get_fun (apply_params params monos (TFun(fst original_args,snd original_args,false)))) in
 			let applied = args_list applied_args in
 
 			(try
@@ -865,7 +865,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist
 			else begin
 				(* infer arguments *)
 				(* let called_t = TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype) in *)
-				let called_t = match follow e1.etype with | TFun _ -> e1.etype | _ -> TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype)	in (* workaround for issue #1742 *)
+				let called_t = match follow e1.etype with | TFun _ -> e1.etype | _ -> TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype, false)	in (* workaround for issue #1742 *)
 				let called_t = change_rest called_t elist in
 				let original = (get_fun (apply_params cl.cl_params params actual_t)) in
 				let applied = (get_fun called_t) in
@@ -935,7 +935,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist
 				let pt = match e with | None -> real_type | Some _ -> snd (get_fun e1.etype) in
 				let _params = match follow pt with | TEnum(_, p) -> p | _ -> gen.gcon.warning (debug_expr e1) e1.epos; die "" __LOC__ in
 				let args, ret = get_fun efield.ef_type in
-				let actual_t = TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret) in
+				let actual_t = TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret, false) in
 				(*
 					because of differences on how <Dynamic> is handled on the platforms, this is a hack to be able to
 					correctly use class field type parameters with RealTypeParams
@@ -1158,14 +1158,14 @@ let configure gen ?(overloads_cast_to_base = false) maybe_empty_t calls_paramete
 					let args,rt = get_fun (apply_params sup.cl_params stl cf.cf_type) in
 					let eparams = List.map2 (fun e (_,_,t) ->
 						handle (run e) t e.etype
-					) (wrap_rest_args gen (TFun (args,rt)) eparams e.epos) args in
+					) (wrap_rest_args gen (TFun (args,rt,false)) eparams e.epos) args in
 					{ e with eexpr = TCall(ef, eparams) }
 				with | Not_found ->
 					gen.gcon.warning "No overload found for this constructor call" e.epos;
 					{ e with eexpr = TCall(ef, List.map run eparams) })
 			| TCall (ef, eparams) ->
 				(match ef.etype with
-					| TFun(p, ret) ->
+					| TFun(p, ret, _) ->
 						handle ({ e with eexpr = TCall(run ef, List.map2 (fun param (_,_,t) -> handle (run param) t param.etype) eparams p) }) e.etype ret
 					| _ -> Type.map_expr run e
 				)
@@ -1186,7 +1186,7 @@ let configure gen ?(overloads_cast_to_base = false) maybe_empty_t calls_paramete
 				let args,rt = get_fun (apply_params sup.cl_params stl cf.cf_type) in
 				let eparams = List.map2 (fun e (_,_,t) ->
 					handle (run e) t e.etype
-				) (wrap_rest_args gen (TFun (args,rt)) eparams e.epos) args in
+				) (wrap_rest_args gen (TFun (args,rt,false)) eparams e.epos) args in
 				{ e with eexpr = TNew(cl, tparams, eparams) }
 			with | Not_found ->
 				gen.gcon.warning "No overload found for this constructor call" e.epos;

src/codegen/gencommon/closuresToClass.ml

@@ -106,7 +106,7 @@ let rec cleanup_delegate e = match e.eexpr with
 	| _ -> e
 
 let funct gen t = match follow (run_follow gen t) with
-	| TFun(args,ret) -> args,ret
+	| TFun(args,ret,_) -> args,ret
 	| _ -> raise Not_found
 
 let mk_conversion_fun gen e =
@@ -235,7 +235,7 @@ let traverse gen ?tparam_anon_decl ?tparam_anon_acc (handle_anon_func:texpr->tfu
 										dynamic_func_call { e with eexpr = TCall(run e1, List.map run params) }
 									| _ ->
 										let i = ref 0 in
-										let t = TFun(List.map (fun e -> incr i; "arg" ^ (string_of_int !i), false, e.etype) params, e.etype) in
+										let t = TFun(List.map (fun e -> incr i; "arg" ^ (string_of_int !i), false, e.etype) params, e.etype, false) in
 										dynamic_func_call { e with eexpr = TCall( mk_castfast t (run e1), List.map run params ) }
 						)
 					(* | FNotFound ->
@@ -247,7 +247,7 @@ let traverse gen ?tparam_anon_decl ?tparam_anon_acc (handle_anon_func:texpr->tfu
 								dynamic_func_call { e with eexpr = TCall(run e1, List.map run params) }
 							| _ ->
 								let i = ref 0 in
-								let t = TFun(List.map (fun e -> incr i; "arg" ^ (string_of_int !i), false, e.etype) params, e.etype) in
+								let t = TFun(List.map (fun e -> incr i; "arg" ^ (string_of_int !i), false, e.etype) params, e.etype, false) in
 								dynamic_func_call { e with eexpr = TCall( mk_castfast t (run e1), List.map run params ) }
 				)
 			| TFunction tf ->
@@ -264,7 +264,7 @@ let traverse gen ?tparam_anon_decl ?tparam_anon_acc (handle_anon_func:texpr->tfu
 						let t = TFun(List.map (fun e ->
 								incr i;
 								("p" ^ (string_of_int !i), false, e.etype)
-							) params, e.etype)
+							) params, e.etype, false)
 						in
 						fun e -> mk_castfast t e
 				in
@@ -281,7 +281,7 @@ let rec get_type_params acc t =
 		| TInst(( { cl_kind = KTypeParameter constraints } as cl), []) ->
 			let params = List.fold_left get_type_params acc constraints in
 			List.filter (fun t -> not (List.memq t acc)) (cl :: params) @ acc;
-		| TFun (params,tret) ->
+		| TFun (params,tret,_) ->
 			List.fold_left get_type_params acc ( tret :: List.map (fun (_,_,t) -> t) params )
 		| TDynamic t ->
 			(match t with | TDynamic _ -> acc | _ -> get_type_params acc t)
@@ -325,7 +325,7 @@ let get_captured expr =
 			| TFunction(tf) ->
 				List.iter (fun (v,_) -> Hashtbl.add ignored v.v_id v) tf.tf_args;
 				(match follow expr.etype with
-					| TFun(args,ret) ->
+					| TFun(args,ret,_) ->
 						List.iter (fun (_,_,t) ->
 							check_params t
 						) args;
@@ -466,7 +466,7 @@ let configure gen ft =
 				ifield,ifield,sa
 			| Some _ ->
 				let pos = cls.cl_pos in
-				let cf = mk_class_field "Delegate" (TFun(fun_args tfunc.tf_args, tfunc.tf_type)) true pos (Method MethNormal) [] in
+				let cf = mk_class_field "Delegate" (TFun(fun_args tfunc.tf_args, tfunc.tf_type, false)) true pos (Method MethNormal) [] in
 				cf.cf_expr <- Some { fexpr with eexpr = TFunction { tfunc with tf_expr = func_expr }; };
 				add_class_field_flag cf CfFinal;
 				cls.cl_ordered_fields <- cf :: cls.cl_ordered_fields;
@@ -506,7 +506,7 @@ let configure gen ft =
 			epos = pos;
 		} in
 
-		let ctor_type = (TFun(ctor_sig, gen.gcon.basic.tvoid)) in
+		let ctor_type = (TFun(ctor_sig, gen.gcon.basic.tvoid, false)) in
 		let ctor = mk_class_field "new" ctor_type true cls.cl_pos (Method(MethNormal)) [] in
 		ctor.cf_expr <- Some(
 		{
@@ -789,13 +789,13 @@ struct
 				UPDATE: the fix will be that Int64 won't be a typedef to Float/Int
 			*)
 			let changed_sig, arity, type_number, changed_sig_ret, is_void, is_dynamic_func = match follow old_sig with
-				| TFun(_sig, ret) ->
+				| TFun(_sig, ret, coro) ->
 					let type_n, ret_t = rettype_real_to_func ret in
 					let arity = List.length _sig in
 					let is_dynamic_func = arity >= max_arity in
 					let ret_t = if is_dynamic_func then t_dynamic else ret_t in
 
-					(TFun(args_real_to_func_sig _sig, ret_t), arity, type_n, ret_t, ExtType.is_void ret, is_dynamic_func)
+					(TFun(args_real_to_func_sig _sig, ret_t, coro), arity, type_n, ret_t, ExtType.is_void ret, is_dynamic_func)
 				| _ -> (print_endline (s_type (print_context()) (follow old_sig) )); die "" __LOC__
 			in
 
@@ -868,12 +868,12 @@ struct
 			let invoke_fun = if params_len >= max_arity then "invokeDynamic" else "invoke" ^ (string_of_int params_len) ^ postfix in
 			let invoke_fun = mk_internal_name "hx" invoke_fun in
 			let fun_t = match follow tc.etype with
-				| TFun(_sig, _) ->
-					TFun(args_real_to_func_sig _sig, ret_t)
+				| TFun(_sig, _, coro) ->
+					TFun(args_real_to_func_sig _sig, ret_t, coro)
 				| _ ->
 					let i = ref 0 in
 					let _sig = List.map (fun p -> let name = "arg" ^ (string_of_int !i) in incr i; (name,false,p.etype) ) params in
-					TFun(args_real_to_func_sig _sig, ret_t)
+					TFun(args_real_to_func_sig _sig, ret_t, false)
 			in
 
 			let may_cast = match follow call_expr.etype with
@@ -904,7 +904,7 @@ struct
 			let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in
 
 			let mk_invoke_i i is_float =
-				let cf = mk_class_field (iname i is_float) (TFun(func_sig_i i, if is_float then basic.tfloat else t_dynamic)) false pos (Method MethNormal) [] in
+				let cf = mk_class_field (iname i is_float) (TFun(func_sig_i i, (if is_float then basic.tfloat else t_dynamic),false)) false pos (Method MethNormal) [] in
 				cf
 			in
 
@@ -963,7 +963,7 @@ struct
 
 				let fn_expr = map_fn i ret (List.map fst args) api in
 
-				let t = TFun(fun_args args, ret) in
+				let t = TFun(fun_args args, ret, false) in
 
 				let tfunction =
 					{
@@ -1010,7 +1010,7 @@ struct
 			in
 
 			let args = [dynamic_arg, None] in
-			let dyn_t = TFun(fun_args args, t_dynamic) in
+			let dyn_t = TFun(fun_args args, t_dynamic, false) in
 			let dyn_cf = mk_class_field (mk_internal_name "hx" "invokeDynamic") dyn_t false pos (Method MethNormal) [] in
 
 			dyn_cf.cf_expr <- Some {
@@ -1024,7 +1024,7 @@ struct
 			};
 
 			let additional_cfs = begin
-				let new_t = TFun(["arity", false, basic.tint; "type", false, basic.tint],basic.tvoid) in
+				let new_t = TFun(["arity", false, basic.tint; "type", false, basic.tint],basic.tvoid, false) in
 				let new_cf = mk_class_field "new" (new_t) true pos (Method MethNormal) [] in
 				let v_arity, v_type = alloc_var "arity" basic.tint, alloc_var "type" basic.tint in
 				let mk_assign v field = mk (TBinop (OpAssign, mk_this field v.v_type, mk_local v pos)) v.v_type pos in
@@ -1095,7 +1095,7 @@ struct
 			let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in
 
 			let mk_invoke_switch i api =
-				let t = TFun (func_sig_i i, t_dynamic) in
+				let t = TFun (func_sig_i i, t_dynamic, false) in
 				(* case i: return this.invokeX_o(0, 0, 0, 0, 0, ... arg[0], args[1]....); *)
 				[make_int gen.gcon.basic i pos], mk_return (mk (TCall(mk_this (iname i false) t, mk_dyn_call i api)) t_dynamic pos)
 			in
@@ -1109,7 +1109,7 @@ struct
 			let type_name = mk_internal_name "fn" "type" in
 			let mk_expr i is_float vars =
 				let call_expr =
-					let call_t = TFun(List.map (fun v -> (v.v_name, false, v.v_type)) vars, if is_float then t_dynamic else basic.tfloat) in
+					let call_t = TFun(List.map (fun v -> (v.v_name, false, v.v_type)) vars, (if is_float then t_dynamic else basic.tfloat), false) in
 					{
 						eexpr = TCall(mk_this (iname i (not is_float)) call_t, List.map (fun v -> mk_local v pos) vars);
 						etype = if is_float then t_dynamic else basic.tfloat;

src/codegen/gencommon/enumToClass.ml

@@ -118,7 +118,7 @@ struct
 			incr i;
 
 			let cf = match follow ef.ef_type with
-				| TFun(params,ret) ->
+				| TFun(params,ret,_) ->
 					let dup_types =
 						if handle_type_params then
 							List.map (fun (s,t) -> (s, TInst (map_param (get_cl_t t), []))) en.e_params

src/codegen/gencommon/enumToClass2.ml

@@ -108,7 +108,7 @@ module EnumToClass2Modf = struct
 			let etag = make_string gen.gcon.basic name pos in
 			let efields = ref [] in
 			(match follow ef.ef_type with
-				| TFun(_, _) ->
+				| TFun(_, _, _) ->
 					(* erase type params *)
 					let ef_type =
 						let t = apply_params en.e_params (List.map (fun _ -> t_dynamic) en.e_params) ef.ef_type in
@@ -162,7 +162,7 @@ module EnumToClass2Modf = struct
 
 					ctor_block := (mk (TCall(esuper,[make_int gen.gcon.basic index pos])) basic.tvoid pos) :: !ctor_block;
 
-					let cf_ctor_t = TFun (params, basic.tvoid) in
+					let cf_ctor_t = TFun (params, basic.tvoid, false) in
 					let cf_ctor = mk_class_field "new" cf_ctor_t true pos (Method MethNormal) [] in
 					cf_ctor.cf_expr <- Some {
 						eexpr = TFunction {
@@ -175,7 +175,7 @@ module EnumToClass2Modf = struct
 					};
 					cl_ctor.cl_constructor <- Some cf_ctor;
 
-					let cf_toString_t = TFun ([],basic.tstring) in
+					let cf_toString_t = TFun ([],basic.tstring,false) in
 					let cf_toString = mk_class_field "toString" cf_toString_t true pos (Method MethNormal) [] in
 
 					let etoString_args = mk_array_decl t_dynamic !efields pos in
@@ -227,7 +227,7 @@ module EnumToClass2Modf = struct
 						equals_exprs := (List.rev !param_equal_checks) @ !equals_exprs;
 						equals_exprs := mk_return (make_bool gen.gcon.basic true pos) :: !equals_exprs;
 
-						let cf_Equals_t = TFun([("other",false,t_dynamic)],basic.tbool) in
+						let cf_Equals_t = TFun([("other",false,t_dynamic)],basic.tbool,false) in
 						let cf_Equals = mk_class_field "Equals" cf_Equals_t true pos (Method MethNormal) [] in
 						cf_Equals.cf_expr <- Some {
 							eexpr = TFunction {
@@ -243,7 +243,7 @@ module EnumToClass2Modf = struct
 
 					(* add GetHashCode field *)
 					begin
-						let cf_GetHashCode_t = TFun([],basic.tint) in
+						let cf_GetHashCode_t = TFun([],basic.tint,false) in
 						let cf_GetHashCode = mk_class_field "GetHashCode" cf_GetHashCode_t true pos (Method MethNormal) [] in
 						cf_GetHashCode.cf_expr <- Some {
 							eexpr = TFunction {
@@ -260,7 +260,7 @@ module EnumToClass2Modf = struct
 					end
 
 				| _ ->
-					let cf_ctor_t = TFun([], basic.tvoid) in
+					let cf_ctor_t = TFun([], basic.tvoid,false) in
 					let cf_ctor = mk_class_field "new" cf_ctor_t true pos (Method MethNormal) [] in
 					cf_ctor.cf_expr <- Some {
 						eexpr = TFunction {
@@ -376,7 +376,7 @@ module EnumToClass2Exprf = struct
 				let ecast = mk (TCall (mk (TIdent "__as__") t_dynamic f.epos, [f])) (TInst (cl_ctor, [])) f.epos in
 
 				(match ef.ef_type with
-				| TFun (params, _) ->
+				| TFun (params, _, _) ->
 					let fname, _, _ = List.nth params i in
 					field ecast fname e.etype e.epos
 				| _ -> Globals.die "" __LOC__)