Przeglądaj źródła

fixes in typesystem for anonymous.

Nicolas Cannasse 18 lat temu
rodzic
commit
70cdc4fcc1
3 zmienionych plików z 69 dodań i 27 usunięć
  1. 2 0
      doc/CHANGES.txt
  2. 37 21
      type.ml
  3. 30 6
      typer.ml

+ 2 - 0
doc/CHANGES.txt

@@ -19,6 +19,8 @@
 	optional RTTI for Spod Object
 	bugfix related to callback in neko code generator
 	more type error stack (now includes type parameters)
+	type system fixes in anonymous subtyping
+	added Iterable<T>, changed Lambda
 
 2007-01-01: 1.10
 	fix in haxe.remoting.SocketConnection.readAnswer

+ 37 - 21
type.ml

@@ -433,7 +433,7 @@ type unify_error =
 	| Cannot_unify of t * t
 	| Invalid_field_type of string
 	| Has_no_field of t * string
-	| Invalid_access of string * bool
+	| Invalid_access of string * bool * field_access * field_access
 	| Invalid_visibility of string
 	| Not_matching_optional of string
 	| Cant_force_optional
@@ -442,15 +442,24 @@ exception Unify_error of unify_error list
 
 let cannot_unify a b = Cannot_unify (a,b)
 let invalid_field n = Invalid_field_type n
-let invalid_access n get = Invalid_access (n,get)
+let invalid_access n get a b = Invalid_access (n,get,a,b)
 let invalid_visibility n = Invalid_visibility n
 let has_no_field t n = Has_no_field (t,n)
 let error l = raise (Unify_error l)
 
+let unify_access a1 a2 =
+	a1 = a2 || (a1 = NormalAccess && (a2 = NoAccess || a2 = F9MethodAccess))
+	|| (a1 = F9MethodAccess && a2 = NoAccess)
+
 let eq_stack = ref []
 
+type eq_kind =
+	| EqStrict
+	| EqRightDynamic
+	| EqBothDynamic
+
 let rec type_eq param a b =
-	if a == b || (param && b == t_dynamic) then
+	if a == b then
 		()
 	else match a , b with
 	| TLazy f , _ -> type_eq param (!f()) b
@@ -499,8 +508,8 @@ let rec type_eq param a b =
 			PMap.iter (fun n f1 ->
 				try
 					let f2 = PMap.find n a2.a_fields in
-					if f1.cf_get <> f2.cf_get then error [invalid_access n true];
-					if f1.cf_set <> f2.cf_set then error [invalid_access n false];
+					if f1.cf_get <> f2.cf_get && (param = EqStrict || not (unify_access f1.cf_get f2.cf_get)) then error [invalid_access n true f1.cf_get f2.cf_get];
+					if f1.cf_set <> f2.cf_set && (param = EqStrict || not (unify_access f1.cf_set f2.cf_set)) then error [invalid_access n false f1.cf_set f2.cf_set];
 					try
 						type_eq param f1.cf_type f2.cf_type
 					with
@@ -519,26 +528,27 @@ let rec type_eq param a b =
 				end;
 			) a2.a_fields;			
 		with
-			Unify_error l -> error (cannot_unify a b :: l))
+			Unify_error l -> error (cannot_unify a b :: l))	
 	| _ , _ ->
-		error [cannot_unify a b]
+		if b == t_dynamic && (param = EqRightDynamic || param = EqBothDynamic) then
+			()
+		else if a == t_dynamic && param = EqBothDynamic then
+			()
+		else
+			error [cannot_unify a b]
 
 and type_peq params (_,a) (_,b) =
 	type_eq params a b
 
 let type_iseq a b =
 	try
-		type_eq false a b;
+		type_eq EqStrict a b;
 		true
 	with
 		Unify_error _ -> false
 
 let unify_stack = ref []
 
-let unify_access a1 a2 =
-	a1 = a2 || (a1 = NormalAccess && (a2 = NoAccess || a2 = F9MethodAccess))
-	|| (a1 = F9MethodAccess && a2 = NormalAccess) (* unsafe, but no inference of prop. set *)
-
 let field_type f =
 	match f.cf_params with
 	| [] -> f.cf_type
@@ -630,11 +640,11 @@ let rec unify a b =
 		(try
 			PMap.iter (fun n f2 ->
 				let ft, f1 = (try class_field c n with Not_found -> error [has_no_field a n]) in
-				if not (unify_access f1.cf_get f2.cf_get) then error [invalid_access n true];
-				if not (unify_access f1.cf_set f2.cf_set) then error [invalid_access n false];
+				if not (unify_access f1.cf_get f2.cf_get) then error [invalid_access n true f1.cf_get f2.cf_get];
+				if not (unify_access f1.cf_set f2.cf_set) then error [invalid_access n false f1.cf_set f2.cf_set];
 				if f2.cf_public && not f1.cf_public then error [invalid_visibility n];
 				try
-					unify (apply_params c.cl_types tl ft) f2.cf_type
+					unify_with_access (apply_params c.cl_types tl ft) f2
 				with
 					Unify_error l -> error (invalid_field n :: l)
 			) an.a_fields;
@@ -646,11 +656,11 @@ let rec unify a b =
 			PMap.iter (fun n f2 ->
 			try
 				let f1 = PMap.find n a1.a_fields in
-				if not (unify_access f1.cf_get f2.cf_get) then error [invalid_access n true];
-				if not (unify_access f1.cf_set f2.cf_set) then error [invalid_access n false];
+				if not (unify_access f1.cf_get f2.cf_get) then error [invalid_access n true f1.cf_get f2.cf_get];
+				if not (unify_access f1.cf_set f2.cf_set) then error [invalid_access n false f1.cf_set f2.cf_set];
 				if f2.cf_public && not f1.cf_public then error [invalid_visibility n];
 				try
-					unify f1.cf_type f2.cf_type;
+					unify_with_access f1.cf_type f2;
 				with
 					Unify_error l -> error (invalid_field n :: l)
 			with
@@ -670,7 +680,7 @@ let rec unify a b =
 		| TDynamic t2 ->
 			if t2 != b then
 				(try 
-					type_eq true t t2
+					type_eq EqRightDynamic t t2
 				with
 					Unify_error l -> error (cannot_unify a b :: l));
 		| _ ->
@@ -682,7 +692,7 @@ let rec unify a b =
 		| TDynamic t2 ->
 			if t2 != a then
 				(try 
-					type_eq true t t2
+					type_eq EqRightDynamic t t2
 				with
 					Unify_error l -> error (cannot_unify a b :: l));
 		| _ ->
@@ -701,7 +711,7 @@ and unify_types a b tl1 tl2 =
 			| _  -> error []
 			);
 			match vb with
-			| VNo -> type_eq true ta tb
+			| VNo -> type_eq EqRightDynamic ta tb
 			| VCo -> unify ta tb
 			| VContra -> unify tb ta
 			| VBi -> ()
@@ -709,6 +719,12 @@ and unify_types a b tl1 tl2 =
 	with
 		Unify_error l -> error ((cannot_unify a b) :: l)
 
+and unify_with_access t f =
+	match f.cf_get, f.cf_set with
+	| NoAccess , _ -> unify f.cf_type t
+	| _ , NoAccess -> unify t f.cf_type
+	| _ , _ -> type_eq EqBothDynamic t f.cf_type
+
 let rec iter f e =
 	match e.eexpr with
 	| TConst _

+ 30 - 6
typer.ml

@@ -75,6 +75,12 @@ type switch_mode =
 
 exception Error of error_msg * pos
 
+let access_str = function
+	| NormalAccess -> "default"
+	| NoAccess -> "null"
+	| MethodAccess m -> m
+	| F9MethodAccess -> "f9dynamic"
+
 let unify_error_msg ctx = function
 	| Cannot_unify (t1,t2) ->
 		s_type ctx t1 ^ " should be " ^ s_type ctx t2
@@ -82,8 +88,8 @@ let unify_error_msg ctx = function
 		"Invalid type for field " ^ s ^ " :"
 	| Has_no_field (t,n) ->
 		s_type ctx t ^ " has no field " ^ n
-	| Invalid_access (f,get) ->
-		"Inconsistent " ^ (if get then "getter" else "setter") ^ " for field " ^ f
+	| Invalid_access (f,get,a,b) ->
+		"Inconsistent " ^ (if get then "getter" else "setter") ^ " for field " ^ f ^ " : " ^ access_str a ^ " should be " ^ access_str b
 	| Invalid_visibility n ->
 		"The field " ^ n ^ " is not public"
 	| Not_matching_optional n ->
@@ -1070,13 +1076,31 @@ let type_field ctx e i p get =
 			if is_closed a then
 				no_field()
 			else
-			let f = mk_field i (mk_mono()) in
+			let f = {
+				cf_name = i;
+				cf_type = mk_mono();
+				cf_doc = None;
+				cf_public = true;
+				cf_get = NormalAccess;
+				cf_set = if get then NoAccess else NormalAccess;
+				cf_expr = None;
+				cf_params = [];
+			} in
 			a.a_fields <- PMap.add i f a.a_fields;
 			field_access ctx get f (field_type f) e p
 		)
 	| TMono r ->
 		if ctx.untyped && Plugin.defined "swf-mark" && Plugin.defined "flash" then ctx.warn "Mark" p;
-		let f = mk_field i (mk_mono()) in
+		let f = {
+			cf_name = i;
+			cf_type = mk_mono();
+			cf_doc = None;
+			cf_public = true;
+			cf_get = NormalAccess;
+			cf_set = if get then NoAccess else NormalAccess;
+			cf_expr = None;
+			cf_params = [];
+		} in
 		let x = ref Opened in
 		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
 		ctx.opened <- x :: ctx.opened;
@@ -1987,11 +2011,11 @@ let valid_redefinition ctx f t =
 	| TFun (args,r) , TFun (targs,tr) when f.cf_expr <> None && List.length args = List.length targs ->
 		List.iter2 (fun (n,o1,a1) (_,o2,a2) -> 
 			if o1 <> o2 then raise (Unify_error [Not_matching_optional n]);
-			type_eq false a1 a2
+			type_eq EqStrict a1 a2
 		) args targs;
 		Type.unify r tr
 	| _ , _ ->
-		type_eq false ft t
+		type_eq EqStrict ft t
 
 let check_overriding ctx c p () =
 	match c.cl_super with