refactor a bit

src/context/typecore.ml

@@ -132,11 +132,17 @@ and typer = {
 	mutable opened : anon_status ref list;
 	mutable vthis : tvar option;
 	mutable in_call_args : bool;
-	mutable monomorphs : tmono list;
+	mutable monomorphs : monomorphs;
 	(* events *)
 	mutable on_error : typer -> string -> pos -> unit;
 	memory_marker : float array;
 }
+
+and monomorphs = {
+	mutable percall : tmono list;
+	mutable perfunction : tmono list;
+}
+
 exception Forbid_package of (string * path * pos) * pos list * string
 
 exception WithTypeError of error_msg * pos
@@ -537,8 +543,8 @@ let check_constraints map params tl p =
 let spawn_constrained_monos ctx p map params =
 	let monos = List.map (fun (s,_) ->
 		let mono = Monomorph.create() in
-		(* if ctx.curclass.cl_path = ([],"Main") then Monomorph.add_constraint mono "debug" p (MDebug s); *)
-		ctx.monomorphs <- mono :: ctx.monomorphs;
+		if Meta.has (Meta.Custom ":debug.monomorphs") ctx.curfield.cf_meta then Monomorph.add_constraint mono "debug" p (MDebug s);
+		ctx.monomorphs.percall <- mono :: ctx.monomorphs.percall;
 		TMono mono
 	) params in
 	let map t = map (apply_params params monos t) in
@@ -546,11 +552,11 @@ let spawn_constrained_monos ctx p map params =
 	monos
 
 let with_contextual_monos ctx f =
-	let old_monos = ctx.monomorphs in
-	ctx.monomorphs <- [];
+	let old_monos = ctx.monomorphs.percall in
+	ctx.monomorphs.percall <- [];
 	let r = f() in
 	(* List.iter (fun m -> ignore(Monomorph.close m)) ctx.monomorphs; *)
-	ctx.monomorphs <- old_monos;
+	ctx.monomorphs.percall <- old_monos;
 	r
 
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)

src/core/tPrinting.ml

@@ -33,13 +33,17 @@ let rec s_type ctx t =
 	| TMono r ->
 		(match r.tm_type with
 		| None ->
+			let s_const = match r.tm_constraints with
+				| [] -> ""
+				| l -> Printf.sprintf " : %s" (String.concat " & " (List.map (fun constr -> s_constraint constr.mc_kind) l))
+			in
 			begin try
 				let id = List.assq t (!ctx) in
-				Printf.sprintf "Unknown<%d>" id
+				Printf.sprintf "Unknown<%d>%s" id s_const
 			with Not_found ->
 				let id = List.length !ctx in
 				ctx := (t,id) :: !ctx;
-				Printf.sprintf "Unknown<%d>" id
+				Printf.sprintf "Unknown<%d>%s" id s_const
 			end
 		| Some t -> s_type ctx t)
 	| TEnum (e,tl) ->
@@ -101,6 +105,20 @@ and s_type_params ctx = function
 	| [] -> ""
 	| l -> "<" ^ String.concat ", " (List.map (s_type ctx) l) ^ ">"
 
+and extract_mono_name m =
+	let rec loop l = match l with
+		| [] -> "?"
+		| {mc_kind = MDebug s} :: _ -> s
+		| _ :: l -> loop l
+	in
+	loop m.tm_constraints
+
+and s_constraint = function
+	| MMono m -> Printf.sprintf "MMono %s" (extract_mono_name m)
+	| MField cf -> Printf.sprintf "MField %s" cf.cf_name
+	| MType t -> Printf.sprintf "MType %s" (s_type_kind t)
+	| MDebug _ -> "MDebug"
+
 let s_access is_read = function
 	| AccNormal -> "default"
 	| AccNo -> "null"

src/core/tUnification.ml

@@ -58,20 +58,6 @@ module Monomorph = struct
 
 	(* constraining *)
 
-	let extract_name m =
-		let rec loop l = match l with
-			| [] -> "?"
-			| {mc_kind = MDebug s} :: _ -> s
-			| _ :: l -> loop l
-		in
-		loop m.tm_constraints
-
-	let s_constraint = function
-		| MMono m -> Printf.sprintf "MMono %s" (extract_name m)
-		| MField cf -> Printf.sprintf "MField %s" cf.cf_name
-		| MType t -> Printf.sprintf "MType %s" (s_type_kind t)
-		| MDebug _ -> "MDebug"
-
 	let make_constraint name p kind =
 		{mc_kind = kind; mc_name = name; mc_pos = p}
 

src/typing/typeloadFunction.ml

@@ -45,12 +45,14 @@ let save_field_state ctx =
 	let old_ret = ctx.ret in
 	let old_fun = ctx.curfun in
 	let old_opened = ctx.opened in
+	let old_monos = ctx.monomorphs.perfunction in
 	let locals = ctx.locals in
 	(fun () ->
 		ctx.locals <- locals;
 		ctx.ret <- old_ret;
 		ctx.curfun <- old_fun;
 		ctx.opened <- old_opened;
+		ctx.monomorphs.perfunction <- old_monos;
 	)
 
 let type_var_field ctx t e stat do_display p =
@@ -108,6 +110,7 @@ let type_function ctx args ret fmode f do_display p =
 	ctx.curfun <- fmode;
 	ctx.ret <- ret;
 	ctx.opened <- [];
+	ctx.monomorphs.perfunction <- [];
 	let e = match f.f_expr with
 		| None ->
 			if ctx.com.display.dms_error_policy = EPIgnore then
@@ -221,6 +224,7 @@ let type_function ctx args ret fmode f do_display p =
 		| _ -> e
 	in
 	List.iter (fun r -> r := Closed) ctx.opened;
+	List.iter (fun m -> ignore(Monomorph.close m)) ctx.monomorphs.perfunction;
 	if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e));
 	e , fargs
 

src/typing/typeloadModule.ml

@@ -971,7 +971,10 @@ let type_types_into_module ctx m tdecls p =
 		in_loop = false;
 		opened = [];
 		in_call_args = false;
-		monomorphs = [];
+		monomorphs = {
+			percall = [];
+			perfunction = [];
+		};
 		vthis = None;
 		memory_marker = Typecore.memory_marker;
 	} in

src/typing/typer.ml

@@ -2691,7 +2691,10 @@ let rec create com =
 		opened = [];
 		vthis = None;
 		in_call_args = false;
-		monomorphs = [];
+		monomorphs = {
+			percall = [];
+			perfunction = [];
+		};
 		on_error = (fun ctx msg p -> ctx.com.error msg p);
 		memory_marker = Typecore.memory_marker;
 	} in