allow local functions to have both type parameters and be inlined (fixed issue #889)

parser.ml

@@ -602,6 +602,10 @@ and parse_var_decl = parser
 		| [< '(Binop OpAssign,_); e = expr >] -> (name,t,Some e)
 		| [< >] -> (name,t,None)
 
+and inline_function = parser
+	| [< '(Kwd Inline,_); '(Kwd Function,p1) >] -> true, p1
+	| [< '(Kwd Function,p1) >] -> false, p1
+
 and expr = parser
 	| [< '(BrOpen,p1); b = block1; '(BrClose,p2); s >] ->
 		let e = (b,punion p1 p2) in
@@ -630,7 +634,7 @@ and expr = parser
 		| [< >] -> serror())
 	| [< '(POpen,p1); e = expr; '(PClose,p2); s >] -> expr_next (EParenthesis e, punion p1 p2) s
 	| [< '(BkOpen,p1); l = parse_array_decl; '(BkClose,p2); s >] -> expr_next (EArrayDecl l, punion p1 p2) s
-	| [< '(Kwd Function,p1); name = popt ident; pl = parse_constraint_params; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->
+	| [< inl, p1 = inline_function; name = popt ident; pl = parse_constraint_params; '(POpen,_); al = psep Comma parse_fun_param; '(PClose,_); t = parse_type_opt; s >] ->
 		let make e =
 			let f = {
 				f_params = pl;
@@ -638,7 +642,7 @@ and expr = parser
 				f_args = al;
 				f_expr = Some e;
 			} in
-			EFunction ((match name with None -> None | Some (name,_) -> Some name),f), punion p1 (pos e)
+			EFunction ((match name with None -> None | Some (name,_) -> Some (if inl then "inline_" ^ name else name)),f), punion p1 (pos e)
 		in
 		(try
 			expr_next (make (secure_expr s)) s

type.ml

@@ -56,6 +56,8 @@ type t =
 
 and tparams = t list
 
+and type_params = (string * t) list
+
 and tconstant =
 	| TInt of int32
 	| TFloat of string
@@ -70,6 +72,7 @@ and tvar = {
 	mutable v_name : string;
 	mutable v_type : t;
 	mutable v_capture : bool;
+	mutable v_extra : (type_params * texpr option) option;
 }
 
 and tfunc = {
@@ -134,7 +137,7 @@ and tclass_field = {
 	mutable cf_doc : Ast.documentation;
 	mutable cf_meta : metadata;
 	mutable cf_kind : field_kind;
-	cf_params : (string * t) list;
+	cf_params : type_params;
 	mutable cf_expr : texpr option;
 	mutable cf_overloads : tclass_field list;
 }
@@ -170,7 +173,7 @@ and tclass = {
 	mutable cl_kind : tclass_kind;
 	mutable cl_extern : bool;
 	mutable cl_interface : bool;
-	mutable cl_types : (string * t) list;
+	mutable cl_types : type_params;
 	mutable cl_super : (tclass * tparams) option;
 	mutable cl_implements : (tclass * tparams) list;
 	mutable cl_fields : (string , tclass_field) PMap.t;
@@ -204,7 +207,7 @@ and tenum = {
 	mutable e_meta : metadata;
 
 	mutable e_extern : bool;
-	mutable e_types : (string * t) list;
+	mutable e_types : type_params;
 	mutable e_constrs : (string , tenum_field) PMap.t;
 	mutable e_names : string list;
 }
@@ -216,7 +219,7 @@ and tdef = {
 	t_private : bool;
 	t_doc : Ast.documentation;
 	mutable t_meta : metadata;
-	mutable t_types : (string * t) list;
+	mutable t_types : type_params;
 	mutable t_type : t;
 }
 
@@ -253,7 +256,7 @@ and module_kind =
 
 let alloc_var =
 	let uid = ref 0 in
-	(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false })
+	(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false; v_extra = None })
 
 let alloc_mid = 
 	let mid = ref 0 in

typeload.ml

@@ -590,6 +590,38 @@ let type_type_params ctx path get_params p (n,flags) =
 		delay ctx (fun () -> ignore(!r()));
 		n, TLazy r
 
+let type_function_params ctx fd fname fmeta p =
+	let params = ref [] in
+	params := List.map (fun (n,flags) ->
+		(match flags with
+		| [] -> ()
+		| _ ->
+			(** look if the type is contained into arguments **)
+			let rec lookup_type t =
+				match t with
+				| CTPath { tpackage = []; tname = n2 } when n = n2 -> true
+				| CTPath p -> List.exists lookup_tparam p.tparams
+				| CTFunction (cl,r) -> List.exists lookup_type (r::cl)
+				| CTExtend (_,fl) | CTAnonymous fl -> List.exists lookup_cfield fl
+				| CTOptional t | CTParent t -> lookup_type t						
+			and lookup_cfield f =
+				match f.cff_kind with
+				| FVar (None,_) -> false
+				| FProp (_,_,t,_) | FVar (Some t,_) -> lookup_type t
+				| FFun f -> lookup_fun f
+			and lookup_fun f =
+				List.exists (fun (_,_,t,_) -> match t with None -> false | Some t -> lookup_type t) f.f_args || 
+				List.exists (fun (_,tl) -> List.exists lookup_type tl) f.f_params ||
+				(match f.f_type with None -> false | Some t -> lookup_type t)
+			and lookup_tparam = function
+				| TPType t -> lookup_type t
+				| TPExpr _ -> false
+			in
+			if lookup_fun { fd with f_type = None; f_params = [] } && not (has_meta ":allowConstraint" fmeta) then error "This notation is not allowed because it can't be checked" p);
+		type_type_params ctx ([],fname) (fun() -> !params) p (n,flags)
+	) fd.f_params;
+	!params
+
 let type_function ctx args ret fmode f p =
 	let locals = save_locals ctx in
 	let fargs = List.map (fun (n,c,t) ->
@@ -980,36 +1012,7 @@ let init_class ctx c p herits fields =
 			let delay = bind_var ctx cf e stat inline in
 			f, false, cf, delay
 		| FFun fd ->
-			let params = ref [] in
-			params := List.map (fun (n,flags) ->
-				(match flags with
-				| [] -> ()
-				| _ ->
-					(** look if the type is contained into arguments **)
-					let rec lookup_type t =
-						match t with
-						| CTPath { tpackage = []; tname = n2 } when n = n2 -> true
-						| CTPath p -> List.exists lookup_tparam p.tparams
-						| CTFunction (cl,r) -> List.exists lookup_type (r::cl)
-						| CTExtend (_,fl) | CTAnonymous fl -> List.exists lookup_cfield fl
-						| CTOptional t | CTParent t -> lookup_type t						
-					and lookup_cfield f =
-						match f.cff_kind with
-						| FVar (None,_) -> false
-						| FProp (_,_,t,_) | FVar (Some t,_) -> lookup_type t
-						| FFun f -> lookup_fun f
-					and lookup_fun f =
-						List.exists (fun (_,_,t,_) -> match t with None -> false | Some t -> lookup_type t) f.f_args || 
-						List.exists (fun (_,tl) -> List.exists lookup_type tl) f.f_params ||
-						(match f.f_type with None -> false | Some t -> lookup_type t)
-					and lookup_tparam = function
-						| TPType t -> lookup_type t
-						| TPExpr _ -> false
-					in
-					if lookup_fun { fd with f_type = None; f_params = [] } && not (has_meta ":allowConstraint" f.cff_meta) then error "This notation is not allowed because it can't be checked" p);
-				type_type_params ctx ([],name) (fun() -> !params) p (n,flags)
-			) fd.f_params;
-			let params = !params in
+			let params = type_function_params ctx fd f.cff_name f.cff_meta p in
 			if inline && c.cl_interface then error "You can't declare inline methods in interfaces" p;
 			let is_macro = (is_macro && stat) || has_meta ":macro" f.cff_meta in
 			let f, stat, fd = if not is_macro || stat then

typer.ml

@@ -623,7 +623,21 @@ let type_ident_raise ?(imported_enums=true) ctx i p mode =
 	| _ ->
 	try
 		let v = PMap.find i ctx.locals in
-		AKExpr (mk (TLocal v) v.v_type p)
+		(match v.v_extra with
+		| Some (params,e) ->
+			let t = monomorphs params v.v_type in
+			(match e with
+			| Some ({ eexpr = TFunction f } as e) ->
+				(* create a fake class with a fake field to emulate inlining *)
+				let c = mk_class ctx.current (["local"],v.v_name) e.epos in
+				let cf = { (mk_field v.v_name v.v_type e.epos) with cf_params = params; cf_expr = Some e; cf_kind = Method MethInline } in				
+				c.cl_extern <- true;
+				c.cl_fields <- PMap.add cf.cf_name cf PMap.empty;
+				AKInline (mk (TConst TNull) (TInst (c,[])) p, cf, t)
+			| _ -> 
+				AKExpr (mk (TLocal v) t p))
+		| _ -> 
+			AKExpr (mk (TLocal v) v.v_type p))
 	with Not_found -> try
 		(* member variable lookup *)
 		if ctx.curfun = FStatic then raise Not_found;
@@ -1877,6 +1891,9 @@ and type_expr ctx ?(need_val=true) (e,p) =
 	| EUnop (op,flag,e) ->
 		type_unop ctx op flag e p
 	| EFunction (name,f) ->
+		let params = Typeload.type_function_params ctx f "localfun" [] p in
+		let old = ctx.type_params in
+		ctx.type_params <- params @ ctx.type_params;
 		let rt = Typeload.load_type_opt ctx p f.f_type in
 		let args = List.map (fun (s,opt,t,c) ->
 			let t = Typeload.load_type_opt ctx p t in
@@ -1896,20 +1913,23 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				) args args2;
 			| _ -> ());
 		let ft = TFun (fun_args args,rt) in
-		let vname = (match name with
-			| None -> None
-			| Some v -> Some (add_local ctx v ft)
+		let inline, v = (match name with
+			| None -> false, None
+			| Some v when ExtString.String.starts_with v "inline_" -> true, Some (add_local ctx (String.sub v 7 (String.length v - 7)) ft)
+			| Some v -> false, Some (add_local ctx v ft)
 		) in
 		let e , fargs = Typeload.type_function ctx args rt (match ctx.curfun with FStatic -> FStatic | _ -> FMemberLocal) f p in
+		ctx.type_params <- old;
 		let f = {
 			tf_args = fargs;
 			tf_type = rt;
 			tf_expr = e;
 		} in
 		let e = mk (TFunction f) ft p in
-		(match vname with
+		(match v with
 		| None -> e
 		| Some v ->
+			if params <> [] || inline then v.v_extra <- Some (params,if inline then Some e else None);
 			let rec loop = function
 				| Codegen.Block f | Codegen.Loop f | Codegen.Function f -> f loop
 				| Codegen.Use v2 when v == v2 -> raise Exit
@@ -1917,13 +1937,16 @@ and type_expr ctx ?(need_val=true) (e,p) =
 			in
 			let is_rec = (try Codegen.local_usage loop e; false with Exit -> true) in
 			if is_rec then begin
+				if inline then display_error ctx "Inline function cannot be recursive" e.epos;
 				let vnew = add_local ctx v.v_name ft in
 				mk (TVars [vnew,Some (mk (TBlock [
 					mk (TVars [v,Some (mk (TConst TNull) ft p)]) ctx.t.tvoid p;
 					mk (TBinop (OpAssign,mk (TLocal v) ft p,e)) ft p;
 					mk (TLocal v) ft p
 				]) ft p)]) ctx.t.tvoid p
-			end else
+			end else if inline then
+				mk (TBlock []) ctx.t.tvoid p (* do not add variable since it will be inlined *)
+			else
 				mk (TVars [v,Some e]) ctx.t.tvoid p)
 	| EUntyped e ->
 		let old = ctx.untyped in