Browse Source

local functions parameters inference.

Nicolas Cannasse 18 years ago
parent
commit
20a828535a
3 changed files with 55 additions and 26 deletions
  1. 1 0
      doc/CHANGES.txt
  2. 24 0
      std/List.hx
  3. 30 26
      typer.ml

+ 1 - 0
doc/CHANGES.txt

@@ -15,6 +15,7 @@
 	no more dontUseCache (haxe.Serializer.USE_CACHE, default to false)
 	small genxml/haxedoc improvements
 	added Type.enumEq
+	local function parameters are now inferred in several cases
 
 2007-01-01: 1.10
 	fix in haxe.remoting.SocketConnection.readAnswer

+ 24 - 0
std/List.hx

@@ -238,4 +238,28 @@ class List<T> {
 		}
 		return b;
 	}
+
+	/**
+		Tells if an element is in the list, the elements will
+		be tested using normal equality. A comparison method can be passed
+		instead of an element to perform a specific comparison.
+	**/
+	public function exists( ?elt : T, ?cmp : T -> Bool ) : Bool {
+		var l = h;
+		if( cmp != null ) {
+			while( l != null ) {
+				if( cmp(l[0]) )
+					return true;
+				l = l[1];
+			}
+			return false;
+		}
+		while( l != null ) {
+			if( elt == l[0] )
+				return true;
+			l = l[1];
+		}
+		return false;
+	}
+
 }

+ 30 - 26
typer.ml

@@ -715,6 +715,22 @@ let rec return_flow ctx e =
 (* ---------------------------------------------------------------------- *)
 (* PASS 3 : type expression & check structure *)
 
+let type_expr_with_type ctx e t =
+	match e with
+	| (EFunction _,_) ->
+		let old = ctx.param_type in
+		(try
+			ctx.param_type <- t;
+			let e = (!type_expr_ref) ctx e in
+			ctx.param_type <- old;
+			e
+		with
+			exc -> 
+				ctx.param_type <- old;
+				raise exc)
+	| _ ->
+		(!type_expr_ref) ctx e
+
 let unify_call_params ctx name el args p =
 	let error txt =
 		let format_arg = (fun (name,opt,_) -> (if opt then "?" else "") ^ name) in
@@ -767,30 +783,17 @@ let unify_call_params ctx name el args p =
 			| [name,ul] -> arg_error ul name true
 			| _ -> error "Invalid");
 			[]
-		| e :: l, (name,opt,t) :: l2 ->
-			let old = ctx.param_type in
-			let e = (try
-				ctx.param_type <- Some t;
-				let e = (!type_expr_ref) ctx e in
-				ctx.param_type <- old;
-				e
+		| ee :: l, (name,opt,t) :: l2 ->
+			let e = type_expr_with_type ctx ee (Some t) in
+			try
+				unify_raise ctx e.etype t e.epos;
+				loop ((e,false) :: acc) l l2 skip
 			with
-				exc -> 
-					ctx.param_type <- old;
-					raise exc
-			) in
-			let rec inner_loop acc skip =
-				try
-					unify_raise ctx e.etype t e.epos;
-					loop ((e,false) :: acc) l l2 skip
-				with
-					Error (Unify ul,_) ->
-						if opt then
-							inner_loop (default_value t :: acc) ((name,ul) :: skip)
-						else
-							arg_error ul name false
-			in
-			inner_loop acc skip
+				Error (Unify ul,_) ->
+					if opt then
+						loop (default_value t :: acc) (ee :: l) l2 ((name,ul) :: skip)
+					else
+						arg_error ul name false
 	in
 	loop [] el args []
 
@@ -1101,7 +1104,7 @@ let rec type_binop ctx op e1 e2 p =
 	match op with
 	| OpAssign ->
 		let e1 = type_access ctx (fst e1) (snd e1) false in
-		let e2 = type_expr ctx e2 in
+		let e2 = type_expr_with_type ctx e2 (match e1 with AccNo _ -> None | AccExpr e  | AccSetField (e,_,_) | AccSet(e,_,_,_) -> Some e.etype) in
 		(match e1 with
 		| AccNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p
 		| AccExpr e1 ->
@@ -1606,7 +1609,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				let e = (match e with
 					| None -> None
 					| Some e ->
-						let e = type_expr ctx e in
+						let e = type_expr_with_type ctx e (Some t) in
 						unify ctx e.etype t p;
 						Some e
 				) in
@@ -1865,7 +1868,8 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		let args = List.map (fun (s,opt,t) -> s , opt, load_type_opt ctx p t) f.f_args in
 		(match ctx.param_type with
 		| None -> ()
-		| Some t -> 
+		| Some t ->
+			ctx.param_type <- None;
 			match follow t with
 			| TFun (args2,_) when List.length args2 = List.length args ->
 				List.iter2 (fun (_,_,t1) (_,_,t2) ->