Browse Source

fix recursive printing and use `Unknown<0> : Constraints` for now

Simon Krajewski 5 năm trước cách đây
mục cha
commit
0084eea82e

+ 1 - 0
src/core/tFunctions.ml

@@ -4,6 +4,7 @@ open TType
 
 let monomorph_create_ref : (unit -> tmono) ref = ref (fun _ -> die "" __LOC__)
 let monomorph_bind_ref : (tmono -> t -> unit) ref = ref (fun _ _ -> die "" __LOC__)
+let monomorph_classify_constraints_ref : (tmono -> tmono_constraint_kind) ref = ref (fun _ -> die "" __LOC__)
 
 let has_meta m ml = List.exists (fun (m2,_,_) -> m = m2) ml
 let get_meta m ml = List.find (fun (m2,_,_) -> m = m2) ml

+ 6 - 8
src/core/tPrinting.ml

@@ -28,24 +28,22 @@ let s_module_type_kind = function
 	| TAbstractDecl a -> "TAbstractDecl(" ^ (s_type_path a.a_path) ^ ")"
 	| TTypeDecl t -> "TTypeDecl(" ^ (s_type_path t.t_path) ^ ")"
 
-let is_simn = false
-
 let rec s_type ctx t =
 	match t with
 	| TMono r ->
 		(match r.tm_type with
 		| None ->
-			let s_const = match r.tm_constraints with
-				| [] -> ""
-				| l when is_simn -> Printf.sprintf " : %s" (String.concat " & " (List.map s_constraint l))
-				| _ -> ""
-			in
 			begin try
 				let id = List.assq t (!ctx) in
-				Printf.sprintf "Unknown<%d>%s" id s_const
+				Printf.sprintf "Unknown<%d>" id
 			with Not_found ->
 				let id = List.length !ctx in
 				ctx := (t,id) :: !ctx;
+			let s_const = match !monomorph_classify_constraints_ref r with
+				| CUnknown -> ""
+				| CTypes tl -> " : " ^ String.concat " & " (List.map (fun (t,_) -> s_type ctx t) tl)
+				| CStructural(fields,_) -> " : " ^ s_type ctx (mk_anon ~fields (ref Closed))
+			in
 				Printf.sprintf "Unknown<%d>%s" id s_const
 			end
 		| Some t -> s_type ctx t)

+ 5 - 0
src/core/tType.ml

@@ -54,6 +54,11 @@ and tmono_constraint =
 	| MType of t * string option
 	| MOpenStructure
 
+and tmono_constraint_kind =
+	| CUnknown
+	| CStructural of (string,tclass_field) PMap.t * bool
+	| CTypes of (t * string option) list
+
 and tlazy =
 	| LAvailable of t
 	| LProcessing of (unit -> t)

+ 2 - 6
src/core/tUnification.ml

@@ -56,11 +56,6 @@ module Monomorph = struct
 		tm_constraints = [];
 	}
 
-	type constraint_kind =
-		| CUnknown
-		| CStructural of (string,tclass_field) PMap.t * bool
-		| CTypes of (t * string option) list
-
 	(* constraining *)
 
 	let add_constraint m constr =
@@ -996,4 +991,5 @@ let type_eq_custom = type_eq
 let type_eq param = type_eq {default_unification_context with equality_kind = param}
 
 ;;
-unify_ref := unify_custom;;
+unify_ref := unify_custom;;
+monomorph_classify_constraints_ref := Monomorph.classify_constraints

+ 2 - 2
tests/misc/projects/Issue5946/compile-fail.hxml.stderr

@@ -1,8 +1,8 @@
-Main.hx:4: characters 28-31 : Class<Two> should be Class<Unknown<0>>
+Main.hx:4: characters 28-31 : Class<Two> should be Class<Unknown<0> : One>
 Main.hx:4: characters 28-31 : Constraint check failure for downcast.S
 Main.hx:4: characters 28-31 : Two should be One
 Main.hx:4: characters 28-31 : For function argument 'c'
-Main.hx:5: characters 29-33 : Class<ITwo> should be Class<Unknown<0>>
+Main.hx:5: characters 29-33 : Class<ITwo> should be Class<Unknown<0> : IOne>
 Main.hx:5: characters 29-33 : Constraint check failure for downcast.S
 Main.hx:5: characters 29-33 : ITwo should be IOne
 Main.hx:5: characters 29-33 : For function argument 'c'

+ 1 - 1
tests/misc/projects/Issue7997/compile-fail.hxml.stderr

@@ -1,2 +1,2 @@
 Main.hx:4: characters 4-19 : Recursive type
-Main.hx:4: characters 4-19 : Unknown<0> appears in { args: Unknown<0> }
+Main.hx:4: characters 4-19 : Unknown<0> appears in { args: Unknown<0> : { field : Unknown<1>, args : Unknown<0> } }