Browse Source

pull stricter tanon changes and remove some debug

Simon Krajewski 1 năm trước cách đây
mục cha
commit
d3268ab9d9

+ 0 - 22
src/compiler/hxb/hxbReader.ml

@@ -673,25 +673,6 @@ class hxb_reader
 		| 11 ->
 			TEnum(self#read_enum_ref,[])
 		| 12 ->
-			(* let tp = self#read_path in *)
-			(* begin match self#read_u8 with *)
-			(* 	| 0 -> TType({null_typedef with t_type = (mk_anon (ref Closed)); t_path = tp; t_module = current_module },[]) *)
-			(* 	| 1 -> TType({null_typedef with t_type = (TAnon self#read_anon_ref); t_path = tp; t_module = current_module },[]) *)
-			(* 	| 4 -> *)
-			(* 		let c = self#read_class_ref in *)
-			(* 		let t_tmp = class_module_type c in *)
-			(* 		TType(t_tmp,[]) *)
-			(* 	| 5 -> *)
-			(* 		let e = self#read_enum_ref in *)
-			(* 		let t_tmp = enum_module_type e.e_module e.e_path e.e_pos in *)
-			(* 		TType(t_tmp,[]) *)
-			(* 	| 6 -> *)
-			(* 		let a = self#read_abstract_ref in *)
-			(* 		let t_tmp = abstract_module_type a [] in *)
-			(* 		TType(t_tmp,[]) *)
-			(* 	| _ -> *)
-			(* 		TType(self#read_typedef_ref,[]) *)
-			(* end *)
 			TType(self#read_typedef_ref,[])
 		| 13 ->
 			let c = self#read_class_ref in
@@ -1331,9 +1312,6 @@ class hxb_reader
 
 	method read_enum (e : tenum) =
 		self#read_common_module_type (Obj.magic e);
-		(* (match self#read_u8 with *)
-		(* | 0 -> e.e_type.t_type <- (mk_anon (ref Closed)) *)
-		(* | _ -> e.e_type.t_type <- TAnon self#read_anon_ref); *)
 		e.e_extern <- self#read_bool;
 		e.e_names <- self#read_list (fun () -> self#read_string);
 

+ 0 - 26
src/compiler/hxb/hxbWriter.ml

@@ -513,21 +513,6 @@ class ['a] hxb_writer
 			chunk#write_byte 19;
 			self#write_typedef_ref td;
 			self#write_types tl
-			(* self#write_path td.t_path; *)
-			(* begin match td.t_type with *)
-			(* 	| TAnon an when PMap.is_empty an.a_fields -> *)
-			(* 		chunk#write_byte 0; *)
-			(* 		self#write_types tl *)
-			(* 	| TAnon an -> *)
-			(* 		chunk#write_byte 1; *)
-			(* 		self#write_anon_ref an td.t_params; *)
-			(* 		self#write_types tl *)
-			(* 	| _ -> *)
-			(* 		chunk#write_byte 2; *)
-			(* 		(1* self#write_type_instance ~debug (apply_typedef td tl); *1) *)
-			(* 		self#write_typedef_ref td; *)
-			(* 		self#write_types tl *)
-			(* end; *)
 		| TAbstract(a,tl) ->
 			chunk#write_byte 20;
 			self#write_abstract_ref a;
@@ -1412,23 +1397,12 @@ class ['a] hxb_writer
 		);
 
 	method write_enum (e : tenum) =
-		(* debug_msg (Printf.sprintf "Write enum %s" (snd e.e_path)); *)
 		self#select_type e.e_path;
 		self#write_common_module_type (Obj.magic e);
-
-		(* (match e.e_type.t_type with *)
-		(* | TAnon an when PMap.is_empty an.a_fields -> *)
-		(* 	chunk#write_byte 0; *)
-		(* | TAnon an -> *)
-		(* 	chunk#write_byte 1; *)
-		(* 	self#write_anon_ref an e.e_type.t_params *)
-		(* | _ -> assert false); *)
-
 		chunk#write_bool e.e_extern;
 		chunk#write_list e.e_names chunk#write_string;
 
 	method write_typedef (td : tdef) =
-		(* debug_msg (Printf.sprintf "Write typedef %s %s >>" (s_type_path td.t_path) (s_type_kind td.t_type)); *)
 		self#select_type td.t_path;
 		self#write_common_module_type (Obj.magic td);
 		self#write_type_instance td.t_type;

+ 9 - 3
src/core/tUnification.ml

@@ -29,6 +29,7 @@ type eq_kind =
 	| EqRightDynamic
 	| EqBothDynamic
 	| EqDoNotFollowNull (* like EqStrict, but does not follow Null<T> *)
+	| EqStrictStrict (* TODO *)
 
 type unification_context = {
 	allow_transitive_cast   : bool;
@@ -491,6 +492,7 @@ let rec_stack_default stack value fcheck frun def =
 let rec type_eq uctx a b =
 	let param = uctx.equality_kind in
 	let can_follow t = match param with
+		| EqStrictStrict -> false
 		| EqCoreType -> false
 		| EqDoNotFollowNull -> not (is_explicit_null t)
 		| _ -> true
@@ -522,9 +524,9 @@ let rec type_eq uctx a b =
 		()
 	| TAbstract ({a_path=[],"Null"},[t1]),TAbstract ({a_path=[],"Null"},[t2]) ->
 		type_eq uctx t1 t2
-	| TAbstract ({a_path=[],"Null"},[t]),_ when param <> EqDoNotFollowNull ->
+	| TAbstract ({a_path=[],"Null"},[t]),_ when param <> EqDoNotFollowNull && param <> EqStrictStrict ->
 		type_eq uctx t b
-	| _,TAbstract ({a_path=[],"Null"},[t]) when param <> EqDoNotFollowNull ->
+	| _,TAbstract ({a_path=[],"Null"},[t]) when param <> EqDoNotFollowNull && param <> EqStrictStrict ->
 		type_eq uctx a t
 	| TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 ->
 		type_eq_params uctx a b tl1 tl2
@@ -574,7 +576,7 @@ let rec type_eq uctx a b =
 			PMap.iter (fun n f1 ->
 				try
 					let f2 = PMap.find n a2.a_fields in
-					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || param = EqDoNotFollowNull || not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
+					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || param = EqDoNotFollowNull || param = EqStrictStrict || not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
 					let a = f1.cf_type and b = f2.cf_type in
 					(try type_eq uctx a b with Unify_error l -> error (invalid_field n :: l));
 					if (has_class_field_flag f1 CfPublic) != (has_class_field_flag f2 CfPublic) then error [invalid_visibility n];
@@ -1008,6 +1010,10 @@ and unifies_from_field uctx a b ab tl (t,cf) =
 			let map = apply_params ab.a_params tl in
 			let monos = Monomorph.spawn_constrained_monos map cf.cf_params in
 			let map t = map (apply_params cf.cf_params monos t) in
+			(* trace' (s_type_kind t); *)
+			(* trace' (s_type_kind r); *)
+			(* trace' (s_type_kind (map t)); *)
+			(* trace' (s_type_kind (map r)); *)
 			let uctx = get_abstract_context uctx a b ab in
 			let unify_func = get_abstract_unify_func uctx EqStrict in
 			unify_func a (map t);

+ 2 - 2
src/typing/tanon_identification.ml

@@ -65,8 +65,8 @@ object(self)
 			allow_abstract_cast = false;
 			allow_dynamic_to_cast = false;
 			allow_arg_name_mismatch = false;
-			equality_kind = EqDoNotFollowNull;
-			equality_underlying = true;
+			equality_kind = EqStrictStrict;
+			equality_underlying = false;
 			strict_field_kind = true;
 		} else {default_unification_context with equality_kind = EqDoNotFollowNull} in