Преглед изворни кода

fixes in typesystem for anonymous.

Nicolas Cannasse пре 18 година
родитељ
комит
70cdc4fcc1
3 измењених фајлова са 69 додато и 27 уклоњено
  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
 	optional RTTI for Spod Object
 	bugfix related to callback in neko code generator
 	bugfix related to callback in neko code generator
 	more type error stack (now includes type parameters)
 	more type error stack (now includes type parameters)
+	type system fixes in anonymous subtyping
+	added Iterable<T>, changed Lambda
 
 
 2007-01-01: 1.10
 2007-01-01: 1.10
 	fix in haxe.remoting.SocketConnection.readAnswer
 	fix in haxe.remoting.SocketConnection.readAnswer

+ 37 - 21
type.ml

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

+ 30 - 6
typer.ml

@@ -75,6 +75,12 @@ type switch_mode =
 
 
 exception Error of error_msg * pos
 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
 let unify_error_msg ctx = function
 	| Cannot_unify (t1,t2) ->
 	| Cannot_unify (t1,t2) ->
 		s_type ctx t1 ^ " should be " ^ s_type ctx 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 ^ " :"
 		"Invalid type for field " ^ s ^ " :"
 	| Has_no_field (t,n) ->
 	| Has_no_field (t,n) ->
 		s_type ctx t ^ " has no field " ^ 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 ->
 	| Invalid_visibility n ->
 		"The field " ^ n ^ " is not public"
 		"The field " ^ n ^ " is not public"
 	| Not_matching_optional n ->
 	| Not_matching_optional n ->
@@ -1070,13 +1076,31 @@ let type_field ctx e i p get =
 			if is_closed a then
 			if is_closed a then
 				no_field()
 				no_field()
 			else
 			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;
 			a.a_fields <- PMap.add i f a.a_fields;
 			field_access ctx get f (field_type f) e p
 			field_access ctx get f (field_type f) e p
 		)
 		)
 	| TMono r ->
 	| TMono r ->
 		if ctx.untyped && Plugin.defined "swf-mark" && Plugin.defined "flash" then ctx.warn "Mark" p;
 		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 x = ref Opened in
 		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
 		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
 		ctx.opened <- x :: ctx.opened;
 		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 ->
 	| 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) -> 
 		List.iter2 (fun (n,o1,a1) (_,o2,a2) -> 
 			if o1 <> o2 then raise (Unify_error [Not_matching_optional n]);
 			if o1 <> o2 then raise (Unify_error [Not_matching_optional n]);
-			type_eq false a1 a2
+			type_eq EqStrict a1 a2
 		) args targs;
 		) args targs;
 		Type.unify r tr
 		Type.unify r tr
 	| _ , _ ->
 	| _ , _ ->
-		type_eq false ft t
+		type_eq EqStrict ft t
 
 
 let check_overriding ctx c p () =
 let check_overriding ctx c p () =
 	match c.cl_super with
 	match c.cl_super with