Browse Source

remove Const flag (closes #3192)

Simon Krajewski 9 years ago
parent
commit
90c821df8f

+ 1 - 1
interp.ml

@@ -4578,7 +4578,7 @@ and encode_anon_status s =
 	let tag, pl = (match s with
 	let tag, pl = (match s with
 		| Closed -> 0, []
 		| Closed -> 0, []
 		| Opened -> 1, []
 		| Opened -> 1, []
-		| Type.Const -> 2, []
+		(* | Type.Const -> 2, [] *)
 		| Extend tl -> 3, [encode_ref tl (fun tl -> enc_array (List.map encode_type tl)) (fun() -> "<extended types>")]
 		| Extend tl -> 3, [encode_ref tl (fun tl -> enc_array (List.map encode_type tl)) (fun() -> "<extended types>")]
 		| Statics cl -> 4, [encode_clref cl]
 		| Statics cl -> 4, [encode_clref cl]
 		| EnumStatics en -> 5, [encode_enref en]
 		| EnumStatics en -> 5, [encode_enref en]

+ 0 - 8
optimizer.ml

@@ -515,14 +515,6 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
 			l.i_write <- true;
 			l.i_write <- true;
 			let e2 = map false e2 in
 			let e2 = map false e2 in
 			{e with eexpr = TBinop(op,{e1 with eexpr = TLocal l.i_subst},e2)}
 			{e with eexpr = TBinop(op,{e1 with eexpr = TLocal l.i_subst},e2)}
-		| TObjectDecl fl ->
-			let fl = List.map (fun (s,e) -> s,map false e) fl in
-			begin match follow e.etype with
-				| TAnon an when (match !(an.a_status) with Const -> true | _ -> false) ->
-					{e with eexpr = TObjectDecl fl; etype = TAnon { an with a_status = ref Closed}}
-				| _ ->
-					{e with eexpr = TObjectDecl fl}
-			end
 		| TFunction f ->
 		| TFunction f ->
 			(match f.tf_args with [] -> () | _ -> has_vars := true);
 			(match f.tf_args with [] -> () | _ -> has_vars := true);
 			let old = save_locals ctx and old_fun = !in_local_fun in
 			let old = save_locals ctx and old_fun = !in_local_fun in

+ 5 - 0
tests/misc/projects/Issue3192/Main1.hx

@@ -0,0 +1,5 @@
+class Main {
+    static function main() {
+		var a:{a:Int} = { a: 1, b: 2 };
+    }
+}

+ 2 - 0
tests/misc/projects/Issue3192/compile1-fail.hxml

@@ -0,0 +1,2 @@
+-main Main1
+--interp

+ 1 - 0
tests/misc/projects/Issue3192/compile1-fail.hxml.stderr

@@ -0,0 +1 @@
+Main1.hx:3: characters 18-32 : { b : Int, a : Int } has extra field b

+ 17 - 0
tests/unit/src/unit/issues/Issue3192.hx

@@ -0,0 +1,17 @@
+package unit.issues;
+
+class Issue3192 extends Test {
+	function test() {
+		var x1 = {x:1, y:2};
+		var x2 = ({x:1, y:2}:{x:Int,y:Int});
+		var x3:{x:Int,y:Int} = {x:1, y:2};
+		var y1:{} = x1;
+		var y2:{} = x2;
+		var y3:{} = x3;
+		var z1:{x:Int} = x1;
+		var z2:{x:Int} = x2;
+		var z3:{x:Int} = x3;
+		eq(1, x1.x);
+		eq(2, x1.y);
+	}
+}

+ 4 - 8
type.ml

@@ -89,7 +89,6 @@ and tfunc = {
 and anon_status =
 and anon_status =
 	| Closed
 	| Closed
 	| Opened
 	| Opened
-	| Const
 	| Extend of t list
 	| Extend of t list
 	| Statics of tclass
 	| Statics of tclass
 	| EnumStatics of tenum
 	| EnumStatics of tenum
@@ -1707,7 +1706,7 @@ let rec unify a b =
 			(match !(an.a_status) with
 			(match !(an.a_status) with
 			| Opened -> an.a_status := Closed;
 			| Opened -> an.a_status := Closed;
 			| Statics _ | EnumStatics _ | AbstractStatics _ -> error []
 			| Statics _ | EnumStatics _ | AbstractStatics _ -> error []
-			| Closed | Extend _ | Const -> ())
+			| Closed | Extend _ -> ())
 		with
 		with
 			Unify_error l -> error (cannot_unify a b :: l))
 			Unify_error l -> error (cannot_unify a b :: l))
 	| TAnon a1, TAnon a2 ->
 	| TAnon a1, TAnon a2 ->
@@ -1831,14 +1830,11 @@ and unify_anons a b a1 a2 =
 				| Opened ->
 				| Opened ->
 					if not (link (ref None) a f2.cf_type) then error [];
 					if not (link (ref None) a f2.cf_type) then error [];
 					a1.a_fields <- PMap.add n f2 a1.a_fields
 					a1.a_fields <- PMap.add n f2 a1.a_fields
-				| Const when Meta.has Meta.Optional f2.cf_meta ->
-					()
 				| _ ->
 				| _ ->
-					error [has_no_field a n];
+					if not (Meta.has Meta.Optional f2.cf_meta) then
+						error [has_no_field a n];
 		) a2.a_fields;
 		) a2.a_fields;
 		(match !(a1.a_status) with
 		(match !(a1.a_status) with
-		| Const when not (PMap.is_empty a2.a_fields) ->
-			PMap.iter (fun n _ -> if not (PMap.mem n a2.a_fields) then error [has_extra_field a n]) a1.a_fields;
 		| Opened ->
 		| Opened ->
 			a1.a_status := Closed
 			a1.a_status := Closed
 		| _ -> ());
 		| _ -> ());
@@ -1847,7 +1843,7 @@ and unify_anons a b a1 a2 =
 		| EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error [])
 		| EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error [])
 		| AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
 		| AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
 		| Opened -> a2.a_status := Closed
 		| Opened -> a2.a_status := Closed
-		| Const | Extend _ | Closed -> ())
+		| Extend _ | Closed -> ())
 	with
 	with
 		Unify_error l -> error (cannot_unify a b :: l))
 		Unify_error l -> error (cannot_unify a b :: l))
 
 

+ 4 - 38
typer.ml

@@ -152,34 +152,6 @@ let get_abstract_froms a pl =
 			acc
 			acc
 	) l a.a_from_field
 	) l a.a_from_field
 
 
-(*
-	temporally remove the constant flag from structures to allow larger unification
-*)
-let remove_constant_flag t callb =
-	let tmp = ref [] in
-	let rec loop t =
-		match follow t with
-		| TAnon a ->
-			if !(a.a_status) = Const then begin
-				a.a_status := Closed;
-				tmp := a :: !tmp;
-			end;
-			PMap.iter (fun _ f -> loop f.cf_type) a.a_fields;
-		|  _ ->
-			()
-	in
-	let restore() =
-		List.iter (fun a -> a.a_status := Const) (!tmp)
-	in
-	try
-		loop t;
-		let ret = callb (!tmp <> []) in
-		restore();
-		ret
-	with e ->
-		restore();
-		raise e
-
 let rec is_pos_infos = function
 let rec is_pos_infos = function
 	| TMono r ->
 	| TMono r ->
 		(match !r with
 		(match !r with
@@ -626,7 +598,7 @@ let rec unify_min_raise ctx (el:texpr list) : t =
 			let expr f = match f.cf_expr with None -> mk (TBlock []) f.cf_type f.cf_pos | Some e -> e in
 			let expr f = match f.cf_expr with None -> mk (TBlock []) f.cf_type f.cf_pos | Some e -> e in
 			let fields = List.fold_left (fun acc e ->
 			let fields = List.fold_left (fun acc e ->
 				match follow e.etype with
 				match follow e.etype with
-				| TAnon a when !(a.a_status) = Const ->
+				| TAnon a ->
 					if !fcount = -1 then begin
 					if !fcount = -1 then begin
 						fcount := field_count a;
 						fcount := field_count a;
 						PMap.map (fun f -> [expr f]) a.a_fields
 						PMap.map (fun f -> [expr f]) a.a_fields
@@ -1275,7 +1247,6 @@ let rec using_field ctx mode e i p =
 		| TMono _ -> raise Not_found
 		| TMono _ -> raise Not_found
 		| t -> t == t_dynamic
 		| t -> t == t_dynamic
 	in
 	in
-	let check_constant_struct = ref false in
 	let rec loop = function
 	let rec loop = function
 	| [] ->
 	| [] ->
 		raise Not_found
 		raise Not_found
@@ -1304,7 +1275,6 @@ let rec using_field ctx mode e i p =
 		with Not_found ->
 		with Not_found ->
 			loop l
 			loop l
 		| Unify_error el | Error (Unify el,_) ->
 		| Unify_error el | Error (Unify el,_) ->
-			if List.exists (function Has_extra_field _ -> true | _ -> false) el then check_constant_struct := true;
 			loop l
 			loop l
 	in
 	in
 	try loop ctx.m.module_using with Not_found ->
 	try loop ctx.m.module_using with Not_found ->
@@ -1315,8 +1285,7 @@ let rec using_field ctx mode e i p =
 		| _ -> assert false);
 		| _ -> assert false);
 		acc
 		acc
 	with Not_found ->
 	with Not_found ->
-	if not !check_constant_struct then raise Not_found;
-	remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found)
+	raise Not_found
 
 
 let rec type_ident_raise ctx i p mode =
 let rec type_ident_raise ctx i p mode =
 	match i with
 	match i with
@@ -3080,7 +3049,7 @@ and type_object_decl ctx fl with_type p =
 			let e = if is_quoted then wrap_quoted_meta e else e in
 			let e = if is_quoted then wrap_quoted_meta e else e in
 			(n,e)
 			(n,e)
 		) fl in
 		) fl in
-		let t = (TAnon { a_fields = !fields; a_status = ref Const }) in
+		let t = (TAnon { a_fields = !fields; a_status = ref Closed }) in
 		if not ctx.untyped then begin
 		if not ctx.untyped then begin
 			(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
 			(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
 				| [] -> ()
 				| [] -> ()
@@ -3107,12 +3076,9 @@ and type_object_decl ctx fl with_type p =
 			end else acc)
 			end else acc)
 		in
 		in
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
 		let fields , types = List.fold_left loop ([],PMap.empty) fl in
-		let x = ref Const in
-		ctx.opened <- x :: ctx.opened;
-		mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = x }) p
+		mk (TObjectDecl (List.rev fields)) (TAnon { a_fields = types; a_status = ref Closed }) p
 	| ODKWithStructure a ->
 	| ODKWithStructure a ->
 		let t, fl = type_fields a.a_fields in
 		let t, fl = type_fields a.a_fields in
-		if !(a.a_status) <> Const then a.a_status := Closed;
 		mk (TObjectDecl fl) t p
 		mk (TObjectDecl fl) t p
 	| ODKWithClass (c,tl) ->
 	| ODKWithClass (c,tl) ->
 		let _,ctor = get_constructor ctx c tl p in
 		let _,ctor = get_constructor ctx c tl p in