Bladeren bron

[typer] add tmono type

Simon Krajewski 6 jaren geleden
bovenliggende
commit
5e5ffb8104

+ 2 - 2
src/codegen/codegen.ml

@@ -94,7 +94,7 @@ let update_cache_dependencies t =
 		| TAnon an ->
 			PMap.iter (fun _ cf -> check_field m cf) an.a_fields
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| Some t -> check_t m t
 			| _ -> ())
 		| TLazy f ->
@@ -247,7 +247,7 @@ let fix_abstract_inheritance com t =
 let rec is_volatile t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> is_volatile t
 		| _ -> false)
 	| TLazy f ->

+ 2 - 2
src/codegen/gencommon/castDetect.ml

@@ -189,13 +189,13 @@ let rec type_eq gen param a b =
 				with
 					Not_found ->
 						if is_closed a2 then Type.error [has_no_field b n];
-						if not (link (ref None) b f1.cf_type) then Type.error [cannot_unify a b];
+						if not (link (Monomorph.create()) b f1.cf_type) then Type.error [cannot_unify a b];
 						a2.a_fields <- PMap.add n f1 a2.a_fields
 			) a1.a_fields;
 			PMap.iter (fun n f2 ->
 				if not (PMap.mem n a1.a_fields) then begin
 					if is_closed a1 then Type.error [has_no_field a n];
-					if not (link (ref None) a f2.cf_type) then Type.error [cannot_unify a b];
+					if not (link (Monomorph.create()) a f2.cf_type) then Type.error [cannot_unify a b];
 					a1.a_fields <- PMap.add n f2 a1.a_fields
 				end;
 			) a2.a_fields;

+ 1 - 1
src/codegen/gencommon/closuresToClass.ml

@@ -305,7 +305,7 @@ let rec get_type_params acc t =
 		| TEnum(_, params)
 		| TInst(_, params) ->
 			List.fold_left get_type_params acc params
-		| TMono r -> (match !r with
+		| TMono r -> (match r.tm_type with
 			| Some t -> get_type_params acc t
 			| None -> acc)
 		| _ -> get_type_params acc (follow_once t)

+ 5 - 5
src/codegen/gencommon/gencommon.ml

@@ -104,7 +104,7 @@ let rec like_i64 t =
 let follow_once t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> t
 		| _ -> t_dynamic) (* avoid infinite loop / should be the same in this context *)
 	| TLazy f ->
@@ -165,7 +165,7 @@ let anon_class t =
 			| AbstractStatics a -> TAbstractDecl a
 			| _ -> assert false)
 	| TLazy f -> t_to_md (lazy_type f)
-	| TMono r -> (match !r with | Some t -> t_to_md t | None -> assert false)
+	| TMono r -> (match r.tm_type with | Some t -> t_to_md t | None -> assert false)
 	| _ -> assert false
 
 
@@ -656,7 +656,7 @@ let init_ctx gen =
 	let follow t =
 		match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| Some t -> follow_f t
 			| _ -> Some t)
 		| TLazy f ->
@@ -1068,8 +1068,8 @@ let add_constructor cl cf =
 let rec replace_mono t =
 	match t with
 	| TMono t ->
-		(match !t with
-		| None -> t := Some t_dynamic
+		(match t.tm_type with
+		| None -> Monomorph.bind t t_dynamic
 		| Some _ -> ())
 	| TEnum (_,p) | TInst (_,p) | TType (_,p) | TAbstract (_,p) ->
 		List.iter replace_mono p

+ 1 - 1
src/codegen/gencommon/hardNullableSynf.ml

@@ -52,7 +52,7 @@ let rec is_null_t gen t = match gen.greal_type t with
 		in
 
 		Some (take_off_null of_t)
-	| TMono r -> (match !r with | Some t -> is_null_t gen t | None -> None)
+	| TMono r -> (match r.tm_type with | Some t -> is_null_t gen t | None -> None)
 	| TLazy f -> is_null_t gen (lazy_type f)
 	| TType (t, tl) ->
 		is_null_t gen (apply_params t.t_params tl t.t_type)

+ 1 - 1
src/codegen/gencommon/normalize.ml

@@ -34,7 +34,7 @@ let rec filter_param stack t =
 	| TInst({ cl_kind = KTypeParameter _ } as c,_) when Meta.has Meta.EnumConstructorParam c.cl_meta ->
 		t_dynamic
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| None -> t_dynamic
 		| Some t -> filter_param stack t)
 	| TInst(_,[]) | TEnum(_,[]) | TAbstract(_,[]) ->

+ 2 - 2
src/codegen/genxml.ml

@@ -72,7 +72,7 @@ let tpath t =
 let rec follow_param t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> follow_param t
 		| _ -> t)
 	| TAbstract ({ a_path = [],"Null" },[t]) ->
@@ -92,7 +92,7 @@ let gen_meta meta =
 
 let rec gen_type ?(values=None) t =
 	match t with
-	| TMono m -> (match !m with None -> tag "unknown" | Some t -> gen_type t)
+	| TMono m -> (match m.tm_type with None -> tag "unknown" | Some t -> gen_type t)
 	| TEnum (e,params) -> gen_type_decl "e" (TEnumDecl e) params
 	| TInst (c,params) -> gen_type_decl "c" (TClassDecl c) params
 	| TAbstract (a,params) -> gen_type_decl "x" (TAbstractDecl a) params

+ 2 - 2
src/codegen/overloads.ml

@@ -26,7 +26,7 @@ let compare_overload_args ?(get_vmtype) ?(ctx) t1 t2 f1 f2 =
 		| Some ctx -> not (distinguishes_funs_as_params ctx) in
 	let rec follow_skip_null t = match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| Some t -> follow_skip_null t
 			| _ -> t)
 		| TLazy f ->
@@ -112,7 +112,7 @@ struct
 		| TAbstract(a,tl) -> simplify_t (Abstract.get_underlying_type a tl)
 		| TType(t, tl) ->
 			simplify_t (apply_params t.t_params tl t.t_type)
-		| TMono r -> (match !r with
+		| TMono r -> (match r.tm_type with
 			| Some t -> simplify_t t
 			| None -> t_dynamic)
 		| TAnon _ -> t_dynamic

+ 1 - 1
src/compiler/displayOutput.ml

@@ -393,7 +393,7 @@ let load_display_content_standalone ctx input =
 let promote_type_hints tctx =
 	let rec explore_type_hint (md,p,t) =
 		match t with
-		| TMono r -> (match !r with None -> () | Some t -> explore_type_hint (md,p,t))
+		| TMono r -> (match r.tm_type with None -> () | Some t -> explore_type_hint (md,p,t))
 		| TLazy f -> explore_type_hint (md,p,lazy_type f)
 		| TInst(({cl_name_pos = pn;cl_path = (_,name)}),_)
 		| TEnum(({e_name_pos = pn;e_path = (_,name)}),_)

+ 1 - 1
src/context/display/displayEmitter.ml

@@ -65,7 +65,7 @@ let raise_position_of_type t =
 	let mt =
 		let rec follow_null t =
 			match t with
-				| TMono r -> (match !r with None -> raise_positions [null_pos] | Some t -> follow_null t)
+				| TMono r -> (match r.tm_type with None -> raise_positions [null_pos] | Some t -> follow_null t)
 				| TLazy f -> follow_null (lazy_type f)
 				| TAbstract({a_path = [],"Null"},[t]) -> follow_null t
 				| TDynamic _ -> !t_dynamic_def

+ 1 - 1
src/core/abstract.ml

@@ -53,7 +53,7 @@ let rec get_underlying_type ?(return_first=false) a pl =
 	let maybe_recurse t =
 		let rec loop t = match t with
 			| TMono r ->
-				(match !r with
+				(match r.tm_type with
 				| Some t -> loop t
 				| _ -> t)
 			| TLazy f ->

+ 1 - 1
src/core/display/completionItem.ml

@@ -429,7 +429,7 @@ module CompletionType = struct
 		}
 		and from_type values t = match t with
 			| TMono r ->
-				begin match !r with
+				begin match r.tm_type with
 					| None -> CTMono
 					| Some t -> from_type values t
 				end

+ 1 - 1
src/core/error.ml

@@ -138,7 +138,7 @@ module BetterErrors = struct
 	let rec s_type ctx t =
 		match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> Printf.sprintf "Unknown<%d>" (try List.assq t (!ctx) with Not_found -> let n = List.length !ctx in ctx := (t,n) :: !ctx; n)
 			| Some t -> s_type ctx t)
 		| TEnum (e,tl) ->

+ 1 - 1
src/core/json/genjson.ml

@@ -188,7 +188,7 @@ let rec generate_ast_type_param ctx tp = jobject [
 let rec generate_type ctx t =
 	let rec loop t = match t with
 		| TMono r ->
-			begin match !r with
+			begin match r.tm_type with
 			| None -> "TMono",None
 			| Some t -> loop t
 			end

+ 72 - 38
src/core/type.ml

@@ -52,7 +52,7 @@ type module_check_policy =
 	| NoCheckShadowing
 
 type t =
-	| TMono of t option ref
+	| TMono of tmono
 	| TEnum of tenum * tparams
 	| TInst of tclass * tparams
 	| TType of tdef * tparams
@@ -62,6 +62,10 @@ type t =
 	| TLazy of tlazy ref
 	| TAbstract of tabstract * tparams
 
+and tmono = {
+	mutable tm_type : t option;
+}
+
 and tlazy =
 	| LAvailable of t
 	| LProcessing of (unit -> t)
@@ -385,6 +389,9 @@ type flag_tclass_field =
 	| CfFinal
 	| CfModifiesThis (* This is set for methods which reassign `this`. E.g. `this = value` *)
 
+let monomorph_create_ref : (unit -> tmono) ref = ref (fun _ -> assert false)
+let monomorph_bind_ref : (tmono -> t -> unit) ref = ref (fun _ _ -> ())
+
 (* Flags *)
 
 let has_flag flags flag =
@@ -442,7 +449,7 @@ let mk_cast e t p = mk (TCast(e,None)) t p
 
 let null t p = mk (TConst TNull) t p
 
-let mk_mono() = TMono (ref None)
+let mk_mono() = TMono (!monomorph_create_ref ())
 
 let rec t_dynamic = TDynamic t_dynamic
 
@@ -599,7 +606,7 @@ let lazy_wait f = LWait f
 let map loop t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| None -> t
 		| Some t -> loop t) (* erase*)
 	| TEnum (_,[]) | TInst (_,[]) | TType (_,[]) ->
@@ -637,7 +644,7 @@ let duplicate t =
 	let monos = ref [] in
 	let rec loop t =
 		match t with
-		| TMono { contents = None } ->
+		| TMono { tm_type = None } ->
 			(try
 				List.assq t !monos
 			with Not_found ->
@@ -670,7 +677,7 @@ let apply_params ?stack cparams params t =
 		with Not_found ->
 		match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> t
 			| Some t -> loop t)
 		| TEnum (e,tl) ->
@@ -735,12 +742,12 @@ let apply_params ?stack cparams params t =
 			| [] ->
 				t
 			| [TMono r] ->
-				(match !r with
+				(match r.tm_type with
 				| Some tt when t == tt ->
 					(* for dynamic *)
 					let pt = mk_mono() in
 					let t = TInst (c,[pt]) in
-					(match pt with TMono r -> r := Some t | _ -> assert false);
+					(match pt with TMono r -> !monomorph_bind_ref r t | _ -> assert false);
 					t
 				| _ -> TInst (c,List.map loop tl))
 			| _ ->
@@ -795,7 +802,7 @@ let try_apply_params_rec cparams params t success =
 let rec follow t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> follow t
 		| _ -> t)
 	| TLazy f ->
@@ -809,7 +816,7 @@ let rec follow t =
 let follow_once t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| None -> t
 		| Some t -> t)
 	| TAbstract _ | TEnum _ | TInst _ | TFun _ | TAnon _ | TDynamic _ ->
@@ -822,7 +829,7 @@ let follow_once t =
 let rec follow_without_null t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> follow_without_null t
 		| _ -> t)
 	| TLazy f ->
@@ -836,7 +843,7 @@ let rec ambiguate_funs t =
 	match t with
 	| TFun _ -> TFun ([], t_dynamic)
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some _ -> assert false
 		| _ -> t)
 	| TInst (a, pl) ->
@@ -856,7 +863,7 @@ let rec ambiguate_funs t =
 
 let rec is_nullable = function
 	| TMono r ->
-		(match !r with None -> false | Some t -> is_nullable t)
+		(match r.tm_type with None -> false | Some t -> is_nullable t)
 	| TAbstract ({ a_path = ([],"Null") },[_]) ->
 		true
 	| TLazy f ->
@@ -883,7 +890,7 @@ let rec is_nullable = function
 
 let rec is_null ?(no_lazy=false) = function
 	| TMono r ->
-		(match !r with None -> false | Some t -> is_null t)
+		(match r.tm_type with None -> false | Some t -> is_null t)
 	| TAbstract ({ a_path = ([],"Null") },[t]) ->
 		not (is_nullable (follow t))
 	| TLazy f ->
@@ -896,7 +903,7 @@ let rec is_null ?(no_lazy=false) = function
 (* Determines if we have a Null<T>. Unlike is_null, this returns true even if the wrapped type is nullable itself. *)
 let rec is_explicit_null = function
 	| TMono r ->
-		(match !r with None -> false | Some t -> is_explicit_null t)
+		(match r.tm_type with None -> false | Some t -> is_explicit_null t)
 	| TAbstract ({ a_path = ([],"Null") },[t]) ->
 		true
 	| TLazy f ->
@@ -908,7 +915,7 @@ let rec is_explicit_null = function
 
 let rec has_mono t = match t with
 	| TMono r ->
-		(match !r with None -> true | Some t -> has_mono t)
+		(match r.tm_type with None -> true | Some t -> has_mono t)
 	| TInst(_,pl) | TEnum(_,pl) | TAbstract(_,pl) | TType(_,pl) ->
 		List.exists has_mono pl
 	| TDynamic _ ->
@@ -944,7 +951,7 @@ let rec module_type_of_type = function
 	| TAbstract(a,_) -> TAbstractDecl a
 	| TLazy f -> module_type_of_type (lazy_type f)
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> module_type_of_type t
 		| _ -> raise Exit)
 	| _ ->
@@ -1110,8 +1117,8 @@ let rec s_type_kind t =
 	let map tl = String.concat ", " (List.map s_type_kind tl) in
 	match t with
 	| TMono r ->
-		begin match !r with
-			| None -> "TMono (None)"
+		begin match r.tm_type with
+			| None -> Printf.sprintf "TMono (None)"
 			| Some t -> "TMono (Some (" ^ (s_type_kind t) ^ "))"
 		end
 	| TEnum(en,tl) -> Printf.sprintf "TEnum(%s, [%s])" (s_type_path en.e_path) (map tl)
@@ -1132,8 +1139,16 @@ let s_module_type_kind = function
 let rec s_type ctx t =
 	match t with
 	| TMono r ->
-		(match !r with
-		| None -> Printf.sprintf "Unknown<%d>" (try List.assq t (!ctx) with Not_found -> let n = List.length !ctx in ctx := (t,n) :: !ctx; n)
+		(match r.tm_type with
+		| None ->
+			begin try
+				let id = List.assq t (!ctx) in
+				Printf.sprintf "Unknown<%d>" id
+			with Not_found ->
+				let id = List.length !ctx in
+				ctx := (t,id) :: !ctx;
+				Printf.sprintf "Unknown<%d>" id
+			end
 		| Some t -> s_type ctx t)
 	| TEnum (e,tl) ->
 		s_type_path e.e_path ^ s_type_params ctx tl
@@ -1180,7 +1195,7 @@ and s_fun ctx t void =
 	| TAbstract ({ a_path = ([],"Void") },[]) when void ->
 		"(" ^ s_type ctx t ^ ")"
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| None -> s_type ctx t
 		| Some t -> s_fun ctx t void)
 	| TLazy f ->
@@ -1737,13 +1752,29 @@ end
 
 (* ======= Unification ======= *)
 
+module Monomorph = struct
+	let create () = {
+		tm_type = None;
+	}
+
+	let do_bind m t =
+		(* assert(m.tm_type = None); *) (* TODO: should be here, but matcher.ml does some weird bind handling at the moment. *)
+		m.tm_type <- Some t
+
+	let rec bind m t =
+		m.tm_type <- Some t
+
+	let unbind m =
+		m.tm_type <- None
+end
+
 let rec link e a b =
 	(* tell if setting a == b will create a type-loop *)
 	let rec loop t =
 		if t == a then
 			true
 		else match t with
-		| TMono t -> (match !t with None -> false | Some t -> loop t)
+		| TMono t -> (match t.tm_type with None -> false | Some t -> loop t)
 		| TEnum (_,tl) -> List.exists loop tl
 		| TInst (_,tl) | TType (_,tl) | TAbstract (_,tl) -> List.exists loop tl
 		| TFun (tl,t) -> List.exists (fun (_,_,t) -> loop t) tl || loop t
@@ -1767,7 +1798,7 @@ let rec link e a b =
 	else if b == t_dynamic then
 		true
 	else begin
-		e := Some b;
+		Monomorph.bind e b;
 		true
 	end
 
@@ -1785,8 +1816,8 @@ let would_produce_recursive_anon field_acceptor field_donor =
 	with Exit -> true
 
 let link_dynamic a b = match follow a,follow b with
-	| TMono r,TDynamic _ -> r := Some b
-	| TDynamic _,TMono r -> r := Some a
+	| TMono r,TDynamic _ -> Monomorph.bind r b
+	| TDynamic _,TMono r -> Monomorph.bind r a
 	| _ -> ()
 
 let fast_eq_check type_param_check a b =
@@ -1824,9 +1855,9 @@ let rec shallow_eq a b =
 		and b = follow b in
 		fast_eq_check shallow_eq a b
 		|| match a , b with
-			| t, TMono { contents = None } when t == t_dynamic -> true
-			| TMono { contents = None }, t when t == t_dynamic -> true
-			| TMono { contents = None }, TMono { contents = None } -> true
+			| t, TMono { tm_type = None } when t == t_dynamic -> true
+			| TMono { tm_type = None }, t when t == t_dynamic -> true
+			| TMono { tm_type = None }, TMono { tm_type = None } -> true
 			| TAnon a1, TAnon a2 ->
 				let fields_eq() =
 					let rec loop fields1 fields2 =
@@ -2001,11 +2032,11 @@ let rec type_eq param a b =
 	| TLazy f , _ -> type_eq param (lazy_type f) b
 	| _ , TLazy f -> type_eq param a (lazy_type f)
 	| TMono t , _ ->
-		(match !t with
+		(match t.tm_type with
 		| None -> if param = EqCoreType || not (link t a b) then error [cannot_unify a b]
 		| Some t -> type_eq param t b)
 	| _ , TMono t ->
-		(match !t with
+		(match t.tm_type with
 		| None -> if param = EqCoreType || not (link t b a) then error [cannot_unify a b]
 		| Some t -> type_eq param a t)
 	| TAbstract ({a_path=[],"Null"},[t1]),TAbstract ({a_path=[],"Null"},[t2]) ->
@@ -2067,13 +2098,13 @@ let rec type_eq param a b =
 				with
 					Not_found ->
 						if is_closed a2 then error [has_no_field b n];
-						if not (link (ref None) b f1.cf_type) then error [cannot_unify a b];
+						if not (link (Monomorph.create()) b f1.cf_type) then error [cannot_unify a b];
 						a2.a_fields <- PMap.add n f1 a2.a_fields
 			) a1.a_fields;
 			PMap.iter (fun n f2 ->
 				if not (PMap.mem n a1.a_fields) then begin
 					if is_closed a1 then error [has_no_field a n];
-					if not (link (ref None) a f2.cf_type) then error [cannot_unify a b];
+					if not (link (Monomorph.create()) a f2.cf_type) then error [cannot_unify a b];
 					a1.a_fields <- PMap.add n f2 a1.a_fields
 				end;
 			) a2.a_fields;
@@ -2133,11 +2164,11 @@ let rec unify a b =
 	| TLazy f , _ -> unify (lazy_type f) b
 	| _ , TLazy f -> unify a (lazy_type f)
 	| TMono t , _ ->
-		(match !t with
+		(match t.tm_type with
 		| None -> if not (link t a b) then error [cannot_unify a b]
 		| Some t -> unify t b)
 	| _ , TMono t ->
-		(match !t with
+		(match t.tm_type with
 		| None -> if not (link t b a) then error [cannot_unify a b]
 		| Some t -> unify a t)
 	| TType (t,tl) , _ ->
@@ -2421,7 +2452,7 @@ and unify_anons a b a1 a2 =
 			Not_found ->
 				match !(a1.a_status) with
 				| Opened ->
-					if not (link (ref None) a f2.cf_type) then error [];
+					if not (link (Monomorph.create()) a f2.cf_type) then error [];
 					a1.a_fields <- PMap.add n f2 a1.a_fields
 				| Const when Meta.has Meta.Optional f2.cf_meta ->
 					()
@@ -2844,7 +2875,7 @@ module TExprToExpr = struct
 
 	let rec convert_type = function
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> raise Exit
 			| Some t -> convert_type t)
 		| TInst ({cl_private = true; cl_path=_,name},tl)
@@ -2985,7 +3016,7 @@ end
 
 module ExtType = struct
 	let is_mono = function
-		| TMono { contents = None } -> true
+		| TMono { tm_type = None } -> true
 		| _ -> false
 
 	let is_void = function
@@ -3035,7 +3066,7 @@ module ExtType = struct
 			| TAbstract(a,_) -> check a.a_meta
 			| TLazy f -> loop (lazy_type f)
 			| TMono r ->
-				(match !r with
+				(match r.tm_type with
 				| Some t -> loop t
 				| _ -> false)
 			| _ ->
@@ -3140,3 +3171,6 @@ let s_class_path c =
 		| _ -> c.cl_path
 	in
 	s_type_path path
+;;
+monomorph_bind_ref := Monomorph.bind;;
+monomorph_create_ref := Monomorph.create;;

+ 1 - 1
src/generators/genas3.ml

@@ -279,7 +279,7 @@ let rec type_str ctx t p =
 	| TFun _ ->
 		"Function"
 	| TMono r ->
-		(match !r with None -> "*" | Some t -> type_str ctx t p)
+		(match r.tm_type with None -> "*" | Some t -> type_str ctx t p)
 	| TAnon _ | TDynamic _ ->
 		"*"
 	| TType (t,args) ->

+ 5 - 5
src/generators/gencpp.ml

@@ -633,7 +633,7 @@ let rec is_objc_type t =
    | TInst(cl,_) -> cl.cl_extern && Meta.has Meta.Objc cl.cl_meta
    | TType(td,_) -> (Meta.has Meta.Objc td.t_meta)
    | TAbstract (a,_) -> (Meta.has Meta.Objc a.a_meta)
-   | TMono r -> (match !r with | Some t -> is_objc_type t | _ -> false)
+   | TMono r -> (match r.tm_type with | Some t -> is_objc_type t | _ -> false)
    | TLazy f -> is_objc_type (lazy_type f)
    | _ -> false
 ;;
@@ -753,7 +753,7 @@ and type_string_suff suffix haxe_type remap =
    let type_string = type_string_remap remap in
    let join_class_path_remap = if remap then join_class_path_remap else join_class_path in
    (match haxe_type with
-   | TMono r -> (match !r with None -> "Dynamic" ^ suffix | Some t -> type_string_suff suffix t remap)
+   | TMono r -> (match r.tm_type with None -> "Dynamic" ^ suffix | Some t -> type_string_suff suffix t remap)
    | TAbstract ({ a_path = ([],"Void") },[]) -> "Void"
    | TAbstract ({ a_path = ([],"Bool") },[]) -> "bool"
    | TAbstract ({ a_path = ([],"Float") },[]) -> "Float"
@@ -1734,7 +1734,7 @@ let rec cpp_type_of stack ctx haxe_type =
    else begin
       let stack = haxe_type :: stack in
       (match haxe_type with
-      | TMono r -> (match !r with None -> TCppDynamic | Some t -> cpp_type_of stack ctx t)
+      | TMono r -> (match r.tm_type with None -> TCppDynamic | Some t -> cpp_type_of stack ctx t)
 
       | TEnum (enum,params) ->  TCppEnum(enum)
 
@@ -4732,7 +4732,7 @@ let find_referenced_types_flags ctx obj field_name super_deps constructor_deps h
       if not (List.exists (fun t2 -> Type.fast_eq in_type t2) !visited) then begin
          visited := in_type :: !visited;
          begin match follow in_type with
-         | TMono r -> (match !r with None -> () | Some t -> visit_type t)
+         | TMono r -> (match r.tm_type with None -> () | Some t -> visit_type t)
          | TEnum (enum,params) -> add_type enum.e_path
          (* If a class has a template parameter, then we treat it as dynamic - except
             for the Array, Class, FastIterator or Pointer classes, for which we do a fully typed object *)
@@ -7216,7 +7216,7 @@ class script_writer ctx filename asciiOut =
    val mutable indents = []
    val mutable just_finished_block = false
    val mutable classCount = 0
-   val mutable return_type = TMono(ref None)
+   val mutable return_type = TMono(Monomorph.create())
    val buffer = Buffer.create 0
    val identTable = Hashtbl.create 0
    val fileTable = Hashtbl.create 0

+ 3 - 3
src/generators/gencs.ml

@@ -112,7 +112,7 @@ let rec is_null t =
 		| TAbstract( { a_path = ([], "Null") }, _ ) -> true
 		| TType( t, tl ) -> is_null (apply_params t.t_params tl t.t_type)
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| Some t -> is_null t
 			| _ -> false)
 		| TLazy f ->
@@ -1081,7 +1081,7 @@ let generate con =
 					(if ret = "object" then "void" else ret) ^ "*"
 				(* end of basic types *)
 				| TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
-				| TMono r -> (match !r with | None -> "object" | Some t -> t_s (run_follow gen t))
+				| TMono r -> (match r.tm_type with | None -> "object" | Some t -> t_s (run_follow gen t))
 				| TInst ({ cl_path = [], "String" }, []) -> "string"
 				| TEnum (e, params) -> ("global::" ^ (module_s (TEnumDecl e)))
 				| TInst (cl, _ :: _) when Meta.has Meta.Enum cl.cl_meta ->
@@ -1909,7 +1909,7 @@ let generate con =
 						gen_attributes w tdef.t_meta;
 						run (follow_once t)
 					| TMono r ->
-						(match !r with
+						(match r.tm_type with
 						| Some t -> run t
 						| _ -> () (* avoid infinite loop / should be the same in this context *))
 					| TLazy f ->

+ 1 - 1
src/generators/genhl.ml

@@ -367,7 +367,7 @@ let get_rec_cache ctx t none_callback not_found_callback =
 let rec to_type ?tref ctx t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| None -> HDyn
 		| Some t -> to_type ?tref ctx t)
 	| TType (td,tl) ->

+ 3 - 3
src/generators/genhxold.ml

@@ -70,7 +70,7 @@ let generate_type com t =
 	let rec notnull t =
 		match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> t
 			| Some t -> notnull t)
 		| TLazy f ->
@@ -86,7 +86,7 @@ let generate_type com t =
 	and stype t =
 		match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> "Unknown"
 			| Some t -> stype t)
 		| TInst ({ cl_kind = KTypeParameter _ } as c,tl) ->
@@ -113,7 +113,7 @@ let generate_type com t =
 	and ftype t =
 		match t with
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> stype t
 			| Some t -> ftype t)
 		| TLazy f ->

+ 2 - 2
src/generators/genjava.ml

@@ -1254,7 +1254,7 @@ let generate con =
 				| TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p
 				| TAbstract ({ a_path = [], "Dynamic" },[]) ->
 						path_s_import pos (["java";"lang"], "Object") []
-				| TMono r -> (match !r with | None -> "java.lang.Object" | Some t -> t_s stack pos (run_follow gen t))
+				| TMono r -> (match r.tm_type with | None -> "java.lang.Object" | Some t -> t_s stack pos (run_follow gen t))
 				| TInst ({ cl_path = [], "String" }, []) ->
 						path_s_import pos (["java";"lang"], "String") []
 				| TAbstract ({ a_path = [], "Class" }, [p]) | TAbstract ({ a_path = [], "Enum" }, [p])
@@ -1877,7 +1877,7 @@ let generate con =
 					gen_annotations w ~add_newline:false tdef.t_meta;
 					run (follow_once t)
 				| TMono r ->
-					(match !r with
+					(match r.tm_type with
 					| Some t -> run t
 					| _ -> () (* avoid infinite loop / should be the same in this context *))
 				| TLazy f ->

+ 1 - 1
src/generators/genjvm.ml

@@ -225,7 +225,7 @@ let rec jsignature_of_type stack t =
 		end
 	| TDynamic _ -> object_sig
 	| TMono r ->
-		begin match !r with
+		begin match r.tm_type with
 		| Some t -> jsignature_of_type t
 		| None -> object_sig
 		end

+ 1 - 1
src/generators/genphp7.ml

@@ -1377,7 +1377,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name =
 				| TDynamic _ -> "mixed"
 				| TLazy _ -> fail ~msg:"TLazy not implemented" self#pos __POS__
 				| TMono mono ->
-					(match !mono with
+					(match mono.tm_type with
 						| None -> "mixed"
 						| Some t -> self#use_t t
 					)

+ 1 - 1
src/generators/genswf.ml

@@ -88,7 +88,7 @@ let build_dependencies t =
 		| TLazy f ->
 			add_type_rec l (lazy_type f)
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| None -> ()
 			| Some t -> add_type_rec l t)
 		| TType (tt,pl) ->

+ 1 - 1
src/generators/genswf9.ml

@@ -185,7 +185,7 @@ let type_path ctx path =
 let rec follow_basic t =
 	match t with
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> follow_basic t
 		| _ -> t)
 	| TLazy f ->

+ 1 - 1
src/macro/eval/evalMain.ml

@@ -536,7 +536,7 @@ let handle_decoding_error f v t =
 			(* TODO: might need some more of these, not sure *)
 			assert false
 		| TMono r ->
-			begin match !r with
+			begin match r.tm_type with
 				| None -> ()
 				| Some t -> loop tabs t v
 			end

+ 4 - 4
src/macro/macroApi.ml

@@ -1047,8 +1047,8 @@ and encode_abref ab =
 and encode_type t =
 	let rec loop = function
 		| TMono r ->
-			(match !r with
-			| None -> 0, [encode_ref r (fun r -> match !r with None -> vnull | Some t -> encode_type t) (fun() -> "<mono>")]
+			(match r.tm_type with
+			| None -> 0, [encode_ref r (fun r -> match r.tm_type with None -> vnull | Some t -> encode_type t) (fun() -> "<mono>")]
 			| Some t -> loop t)
 		| TEnum (e, pl) ->
 			1 , [encode_ref e encode_tenum (fun() -> s_type_path e.e_path); encode_tparams pl]
@@ -1083,7 +1083,7 @@ and encode_type t =
 and encode_lazy_type t =
 	let rec loop = function
 		| TMono r ->
-			(match !r with
+			(match r.tm_type with
 			| Some t -> loop t
 			| _ -> encode_type t)
 		| TLazy f ->
@@ -1783,7 +1783,7 @@ let macro_api ccom get_api =
 			let follow_once t =
 				match t with
 				| TMono r ->
-					(match !r with
+					(match r.tm_type with
 					| None -> t
 					| Some t -> t)
 				| TAbstract (a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->

+ 2 - 2
src/optimization/analyzerTexpr.ml

@@ -154,14 +154,14 @@ let type_change_ok com t1 t2 =
 		true
 	else begin
 		let rec map t = match t with
-			| TMono r -> (match !r with None -> t_dynamic | Some t -> map t)
+			| TMono r -> (match r.tm_type with None -> t_dynamic | Some t -> map t)
 			| _ -> Type.map map t
 		in
 		let t1 = map t1 in
 		let t2 = map t2 in
 		let rec is_nullable_or_whatever = function
 			| TMono r ->
-				(match !r with None -> false | Some t -> is_nullable_or_whatever t)
+				(match r.tm_type with None -> false | Some t -> is_nullable_or_whatever t)
 			| TAbstract ({ a_path = ([],"Null") },[_]) ->
 				true
 			| TLazy f ->

+ 1 - 1
src/optimization/dce.ml

@@ -301,7 +301,7 @@ let rec to_string dce t = match t with
 		else
 			to_string dce (Abstract.get_underlying_type a tl)
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> to_string dce t
 		| _ -> ())
 	| TLazy f ->

+ 1 - 1
src/typing/fields.ml

@@ -526,7 +526,7 @@ let rec type_field cfg ctx e i p mode =
 		let x = ref Opened in
 		let t = TAnon { a_fields = PMap.add i f PMap.empty; a_status = x } in
 		ctx.opened <- x :: ctx.opened;
-		r := Some t;
+		Monomorph.bind r t;
 		field_access ctx mode f (FAnon f) (Type.field_type f) e p
 	| TAbstract (a,pl) ->
 		let static_abstract_access_through_instance = ref false in

+ 2 - 2
src/typing/generic.ml

@@ -49,7 +49,7 @@ let make_generic ctx ps pt p =
 				| TAbstract(a,tl) -> (s_type_path_underscore a.a_path) ^ (loop_tl top tl)
 				| _ when not top ->
 					follow_or t top (fun() -> "_") (* allow unknown/incompatible types as type parameters to retain old behavior *)
-				| TMono { contents = None } -> raise (Generic_Exception (("Could not determine type for parameter " ^ s), p))
+				| TMono { tm_type = None } -> raise (Generic_Exception (("Could not determine type for parameter " ^ s), p))
 				| TDynamic _ -> "Dynamic"
 				| t ->
 					follow_or t top (fun() -> raise (Generic_Exception (("Unsupported type parameter: " ^ (s_type (print_context()) t) ^ ")"), p)))
@@ -199,7 +199,7 @@ let rec build_generic ctx c p tl =
 			| TType (t,tl) -> add_dep t.t_module tl
 			| TAbstract (a,tl) -> add_dep a.a_module tl
 			| TMono r ->
-				(match !r with
+				(match r.tm_type with
 				| None -> ()
 				| Some t -> loop t)
 			| TLazy f ->

+ 7 - 4
src/typing/matcher.ml

@@ -46,14 +46,17 @@ let unapply_type_parameters params monos =
 	List.iter2 (fun (_,t1) t2 ->
 		match t2,follow t2 with
 		| TMono m1,TMono m2 ->
-			unapplied := (m1,!m1) :: !unapplied;
-			m1 := Some t1;
+			unapplied := (m1,m1.tm_type) :: !unapplied;
+			Monomorph.bind m1 t1;
 		| _ -> ()
 	) params monos;
 	!unapplied
 
 let reapply_type_parameters unapplied =
-	List.iter (fun (m,o) -> m := o) unapplied
+	List.iter (fun (m,o) -> match o with
+		| None -> Monomorph.unbind m
+		| Some t -> Monomorph.bind m t
+	) unapplied
 
 let get_general_module_type ctx mt p =
 	let rec loop = function
@@ -156,7 +159,7 @@ module Pattern = struct
 		mutable current_locals : (string, tvar * pos) PMap.t;
 		mutable in_reification : bool;
 		is_postfix_match : bool;
-		unapply_type_parameters : unit -> (Type.t option ref * Type.t option) list;
+		unapply_type_parameters : unit -> (tmono * Type.t option) list;
 	}
 
 	exception Bad_pattern of string

+ 5 - 5
src/typing/nullSafety.ml

@@ -71,7 +71,7 @@ let is_string_type t =
 *)
 let rec is_nullable_type = function
 	| TMono r ->
-		(match !r with None -> false | Some t -> is_nullable_type t)
+		(match r.tm_type with None -> false | Some t -> is_nullable_type t)
 	| TAbstract ({ a_path = ([],"Null") },[t]) ->
 		true
 	| TAbstract (a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
@@ -194,9 +194,9 @@ class unificator =
 						self#unify (lazy_type f) b
 					| _, TLazy f -> self#unify a (lazy_type f)
 					| TMono t, _ ->
-						(match !t with None -> () | Some t -> self#unify t b)
+						(match t.tm_type with None -> () | Some t -> self#unify t b)
 					| _, TMono t ->
-						(match !t with None -> () | Some t -> self#unify a t)
+						(match t.tm_type with None -> () | Some t -> self#unify a t)
 					| TType (t,tl), _ ->
 						self#unify_rec a b (fun() -> self#unify (apply_params t.t_params tl t.t_type) b)
 					| _, TType (t,tl) ->
@@ -300,7 +300,7 @@ let is_trace expr =
 *)
 let rec unfold_null t =
 	match t with
-		| TMono r -> (match !r with None -> t | Some t -> unfold_null t)
+		| TMono r -> (match r.tm_type with None -> t | Some t -> unfold_null t)
 		| TAbstract ({ a_path = ([],"Null") }, [t]) -> unfold_null t
 		| TLazy f -> unfold_null (lazy_type f)
 		| TType (t,tl) -> unfold_null (apply_params t.t_params tl t.t_type)
@@ -326,7 +326,7 @@ let rec can_pass_type src dst =
 	else
 		(* TODO *)
 		match dst with
-			| TMono r -> (match !r with None -> true | Some t -> can_pass_type src t)
+			| TMono r -> (match r.tm_type with None -> true | Some t -> can_pass_type src t)
 			| TEnum (_, params) -> true
 			| TInst _ -> true
 			| TType (t, tl) -> can_pass_type src (apply_params t.t_params tl t.t_type)

+ 5 - 5
src/typing/typeload.ml

@@ -378,12 +378,12 @@ and load_complex_type' ctx allow_display (t,p) =
 				) r.fitems in
 				raise_fields l (CRStructExtension true) r.fsubject
 		) tl in
-		let tr = ref None in
+		let tr = Monomorph.create() in
 		let t = TMono tr in
 		let r = exc_protect ctx (fun r ->
 			r := lazy_processing (fun() -> t);
 			let ta = make_extension_type ctx tl in
-			tr := Some ta;
+			Monomorph.bind tr ta;
 			ta
 		) "constraint" in
 		TLazy r
@@ -420,11 +420,11 @@ and load_complex_type' ctx allow_display (t,p) =
 					) r.fitems in
 					raise_fields l (CRStructExtension false) r.fsubject
 			) tl in
-			let tr = ref None in
+			let tr = Monomorph.create() in
 			let t = TMono tr in
 			let r = exc_protect ctx (fun r ->
 				r := lazy_processing (fun() -> t);
-				tr := Some (match il with
+				Monomorph.bind tr (match il with
 					| [i] ->
 						mk_extension i
 					| _ ->
@@ -578,7 +578,7 @@ and init_meta_overloads ctx co cf =
 			ctx.type_params <- old;
 			false
 		| (Meta.Overload,[],_) when ctx.com.config.pf_overload ->
-			let topt (n,_,t) = match t with | TMono t when !t = None -> error ("Explicit type required for overload functions\nFor function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in
+			let topt (n,_,t) = match t with | TMono t when t.tm_type = None -> error ("Explicit type required for overload functions\nFor function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in
 			(match follow cf.cf_type with
 			| TFun (args,_) -> List.iter topt args
 			| _ -> () (* could be a variable *));

+ 2 - 2
src/typing/typeloadFields.ml

@@ -460,7 +460,7 @@ let create_class_context ctx c context_init p =
 		tthis = (match abstract with
 			| Some a ->
 				(match a.a_this with
-				| TMono r when !r = None -> TAbstract (a,List.map snd c.cl_params)
+				| TMono r when r.tm_type = None -> TAbstract (a,List.map snd c.cl_params)
 				| t -> t)
 			| None -> TInst (c,List.map snd c.cl_params));
 		on_error = (fun ctx msg ep ->
@@ -628,7 +628,7 @@ let bind_type (ctx,cctx,fctx) cf r p =
 	let rec is_full_type t =
 		match t with
 		| TFun (args,ret) -> is_full_type ret && List.for_all (fun (_,_,t) -> is_full_type t) args
-		| TMono r -> (match !r with None -> false | Some t -> is_full_type t)
+		| TMono r -> (match r.tm_type with None -> false | Some t -> is_full_type t)
 		| TAbstract _ | TInst _ | TEnum _ | TLazy _ | TDynamic _ | TAnon _ | TType _ -> true
 	in
 	let force_macro () =

+ 4 - 4
src/typing/typeloadModule.ml

@@ -272,7 +272,7 @@ let module_pass_1 ctx m tdecls loadp =
 			(* failsafe in case the typedef is not initialized (see #3933) *)
 			delay ctx PBuildModule (fun () ->
 				match t.t_type with
-				| TMono r -> (match !r with None -> r := Some com.basic.tvoid | _ -> ())
+				| TMono r -> (match r.tm_type with None -> Monomorph.bind r com.basic.tvoid | _ -> ())
 				| _ -> ()
 			);
 			decls := (TTypeDecl t, decl) :: !decls;
@@ -711,7 +711,7 @@ let init_module_type ctx context_init do_init (decl,p) =
 					if tt == t.t_type then error "Recursive typedef is not allowed" p;
 					match tt with
 					| TMono r ->
-						(match !r with
+						(match r.tm_type with
 						| None -> ()
 						| Some t -> check_rec t)
 					| TLazy f ->
@@ -732,8 +732,8 @@ let init_module_type ctx context_init do_init (decl,p) =
 		) in
 		(match t.t_type with
 		| TMono r ->
-			(match !r with
-			| None -> r := Some tt;
+			(match r.tm_type with
+			| None -> Monomorph.bind r tt;
 			| Some _ -> assert false);
 		| _ -> assert false);
 		if ctx.com.platform = Cs && t.t_meta <> [] then

+ 2 - 2
src/typing/typer.ml

@@ -69,7 +69,7 @@ let rec classify t =
 	| TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KNumParam t
 	| TAbstract (a,[]) when List.exists (fun t -> match classify t with KString -> true | _ -> false) a.a_to -> KStrParam t
 	| TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) ctl -> KStrParam t
-	| TMono r when !r = None -> KUnk
+	| TMono r when r.tm_type = None -> KUnk
 	| TDynamic _ -> KDyn
 	| _ -> KOther
 
@@ -189,7 +189,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 				(* prioritize the most generic definition *)
 				tl := t :: !tl;
 			| TLazy f -> loop (lazy_type f)
-			| TMono r -> (match !r with None -> () | Some t -> loop t)
+			| TMono r -> (match r.tm_type with None -> () | Some t -> loop t)
 			| _ -> tl := t :: !tl)
 		in
 		loop t;

+ 1 - 1
src/typing/typerBase.ml

@@ -50,7 +50,7 @@ let mk_infos ctx p params =
 
 let rec is_pos_infos = function
 	| TMono r ->
-		(match !r with
+		(match r.tm_type with
 		| Some t -> is_pos_infos t
 		| _ -> false)
 	| TLazy f ->