add MDynamic (#11890)

src/core/error.ml

@@ -188,7 +188,7 @@ module BetterErrors = struct
 				let name = Printf.sprintf "Unknown<%d>" (try List.assq t (!ctx) with Not_found -> let n = List.length !ctx in ctx := (t,n) :: !ctx; n) in
 				List.fold_left (fun s modi -> match modi with
 					| MNullable _ -> Printf.sprintf "Null<%s>" s
-					| MOpenStructure -> s
+					| MOpenStructure | MDynamic -> s
 				) name r.tm_modifiers
 			| Some t ->
 				s_type ctx t)

src/core/tPrinting.ml

@@ -30,7 +30,16 @@ let s_module_type_kind = function
 
 let show_mono_ids = true
 
-let rec s_type ctx t =
+let rec s_mono_constraint_kind s_type constr =
+	let rec loop = function
+		| CUnknown -> ""
+		| CTypes tl -> String.concat " & " (List.map (fun (t,_) -> s_type t) tl)
+		| CStructural(fields,_) -> s_type (mk_anon ~fields (ref Closed))
+		| CMixed l -> String.concat " & " (List.map loop l)
+	in
+	loop constr
+
+and s_type ctx t =
 	match t with
 	| TMono r ->
 		(match r.tm_type with
@@ -44,7 +53,7 @@ let rec s_type ctx t =
 				let s = s ^ extra in
 				List.fold_left (fun s modi -> match modi with
 					| MNullable _ -> Printf.sprintf "Null<%s>" s
-					| MOpenStructure -> s
+					| MOpenStructure | MDynamic -> s
 				) s r.tm_modifiers
 			in
 			begin try
@@ -54,13 +63,7 @@ let rec s_type ctx t =
 				let id = List.length !ctx in
 				ctx := (t,id) :: !ctx;
 				let s_const =
-					let rec loop = function
-					| CUnknown -> ""
-					| CTypes tl -> String.concat " & " (List.map (fun (t,_) -> s_type ctx t) tl)
-					| CStructural(fields,_) -> s_type ctx (mk_anon ~fields (ref Closed))
-					| CMixed l -> String.concat " & " (List.map loop l)
-					in
-					let s = loop (!monomorph_classify_constraints_ref r) in
+					let s = s_mono_constraint_kind (s_type ctx) (!monomorph_classify_constraints_ref r) in
 					if s = "" then s else " : " ^ s
 				in
 				print_name id s_const

src/core/tType.ml

@@ -101,6 +101,7 @@ and tmono_constraint_kind =
 and tmono_modifier =
 	| MNullable of (t -> t)
 	| MOpenStructure
+	| MDynamic (* There was a unificaiton against Dynamic, which didn't bind the mono *)
 
 and tlazy =
 	| LAvailable of t

src/core/tUnification.ml

@@ -100,6 +100,12 @@ module Monomorph = struct
 	let add_modifier m modi =
 		m.tm_modifiers <- modi :: m.tm_modifiers
 
+	let has_modifier m f =
+		List.exists f m.tm_modifiers
+
+	let is_dynamic m =
+		has_modifier m (function MDynamic -> true | _ -> false)
+
 	(* constraining *)
 
 	let add_up_constraint m ((t,name) as constr) =
@@ -159,7 +165,7 @@ module Monomorph = struct
 		in
 		List.iter check m.tm_down_constraints;
 		List.iter (function
-			| MNullable _ ->
+			| MNullable _ | MDynamic ->
 				()
 			| MOpenStructure ->
 				is_open := true
@@ -231,7 +237,7 @@ module Monomorph = struct
 		(* assert(m.tm_type = None); *) (* TODO: should be here, but matcher.ml does some weird bind handling at the moment. *)
 		let t = List.fold_left (fun t modi -> match modi with
 			| MNullable f -> f t
-			| MOpenStructure -> t
+			| MOpenStructure | MDynamic -> t
 		) t m.tm_modifiers in
 		m.tm_type <- Some t;
 		m.tm_down_constraints <- [];
@@ -286,7 +292,8 @@ module Monomorph = struct
 			let constraints = classify_down_constraints m in
 			match constraints with
 			| CUnknown ->
-				()
+				if is_dynamic m then
+					do_bind m t_dynamic
 			| CTypes [(t,_)] ->
 				(* TODO: silently not binding doesn't seem correct, but it's likely better than infinite recursion *)
 				if get_recursion t = None then do_bind m t;
@@ -372,9 +379,11 @@ let link uctx e a b =
 	(* tell is already a ~= b *)
 	if loop b then
 		(follow b) == a
-	else if b == t_dynamic then
+	else if b == t_dynamic then begin
+		if not (Monomorph.is_dynamic e) then
+			Monomorph.add_modifier e MDynamic;
 		true
-	else begin
+	end else begin
 		Monomorph.bind e b;
 		true
 	end