Browse Source

[typer] replace some mk_mono with spawn_monomorph

This doesn't change anything yet and is just to reduce the diff of an eventual PR. The main purpose is that we now have a context.
Simon Krajewski 5 years ago
parent
commit
5fad913a1c

+ 1 - 1
src/context/abstractCast.ml

@@ -115,7 +115,7 @@ let find_array_access_raise ctx a pl e1 e2o p =
 		match cfl with
 		| [] -> raise Not_found
 		| cf :: cfl ->
-			let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+			let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in
 			let map t = apply_params a.a_params pl (apply_params cf.cf_params monos t) in
 			let check_constraints () =
 				List.iter2 (fun m (name,t) -> match follow t with

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

@@ -54,7 +54,7 @@ let collect_static_extensions ctx items e p =
 					acc
 				else begin
 					let f = { f with cf_type = opt_type f.cf_type } in
-					let monos = List.map (fun _ -> mk_mono()) f.cf_params in
+					let monos = List.map (fun _ -> spawn_monomorph ctx p) f.cf_params in
 					let map = apply_params f.cf_params monos in
 					match follow (map f.cf_type) with
 					| TFun((_,_,TType({t_path=["haxe";"macro"], "ExprOf"}, [t])) :: args, ret)

+ 9 - 1
src/context/typecore.ml

@@ -176,6 +176,14 @@ let type_expr ?(mode=MGet) ctx e with_type = (!type_expr_ref) ~mode ctx e with_t
 let unify_min ctx el = (!unify_min_ref) ctx el
 let unify_min_for_type_source ctx el src = (!unify_min_for_type_source_ref) ctx el src
 
+let spawn_monomorph' ctx p =
+	let mono = Monomorph.create () in
+	(* ctx.monomorphs.perfunction <- (mono,p) :: ctx.monomorphs.perfunction; *)
+	mono
+
+let spawn_monomorph ctx p =
+	TMono (spawn_monomorph' ctx p)
+
 let make_static_this c p =
 	let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in
 	mk (TTypeExpr (TClassDecl c)) ta p
@@ -185,7 +193,7 @@ let make_static_field_access c cf t p =
 	mk (TField (ethis,(FStatic (c,cf)))) t p
 
 let make_static_call ctx c cf map args t p =
-	let monos = List.map (fun _ -> mk_mono()) cf.cf_params in
+	let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in
 	let map t = map (apply_params cf.cf_params monos t) in
 	let ef = make_static_field_access c cf (map cf.cf_type) p in
 	make_call ctx ef args (map t) p

+ 1 - 1
src/typing/calls.ml

@@ -848,7 +848,7 @@ let array_access ctx e1 e2 mode p =
 				let skip_abstract = fast_eq et at in
 				loop ~skip_abstract at
 			| _, _ ->
-				let pt = mk_mono() in
+				let pt = spawn_monomorph ctx p in
 				let t = ctx.t.tarray pt in
 				begin try
 					unify_raise ctx et t p

+ 1 - 1
src/typing/fields.ml

@@ -325,7 +325,7 @@ let rec type_field cfg ctx e i p mode =
 				| _ ->
 					display_error ctx (StringError.string_error i (string_source t) (s_type (print_context()) t ^ " has no field " ^ i)) pfield;
 		end;
-		AKExpr (mk (TField (e,FDynamic i)) (mk_mono()) p)
+		AKExpr (mk (TField (e,FDynamic i)) (spawn_monomorph ctx p) p)
 	in
 	let does_forward a stat =
 		try

+ 1 - 1
src/typing/generic.ml

@@ -283,7 +283,7 @@ let rec build_generic ctx c p tl =
 				t
 			in
 			let r = exc_protect ctx (fun r ->
-				let t = mk_mono() in
+				let t = spawn_monomorph ctx p in
 				r := lazy_processing (fun() -> t);
 				let t0 = f() in
 				unify_raise ctx t0 t p;

+ 3 - 3
src/typing/instanceBuilder.ml

@@ -39,7 +39,7 @@ let build_macro_type ctx pl p =
 	) in
 	let old = ctx.ret in
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
-		| None -> mk_mono()
+		| None -> spawn_monomorph ctx p
 		| Some _ -> ctx.ret
 	) in
 	ctx.ret <- old;
@@ -58,7 +58,7 @@ let build_macro_build ctx c pl cfl p =
 	let old = ctx.ret,ctx.get_build_infos in
 	ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
 	let t = (match ctx.g.do_macro ctx MMacroType path field args p with
-		| None -> mk_mono()
+		| None -> spawn_monomorph ctx p
 		| Some _ -> ctx.ret
 	) in
 	ctx.ret <- fst old;
@@ -74,7 +74,7 @@ let build_instance ctx mtype p =
 		if ctx.pass > PBuildClass then ignore(c.cl_build());
 		let build f s =
 			let r = exc_protect ctx (fun r ->
-				let t = mk_mono() in
+				let t = spawn_monomorph ctx p in
 				r := lazy_processing (fun() -> t);
 				let tf = (f()) in
 				unify_raise ctx tf t p;

+ 1 - 1
src/typing/macroContext.ml

@@ -734,7 +734,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 				| MMacroType ->
 					"ComplexType",(fun () ->
 						let t = if v = Interp.vnull then
-							mk_mono()
+							spawn_monomorph ctx p
 						else try
 							let ct = Interp.decode_ctype v in
 							Typeload.load_complex_type ctx false ct;

+ 1 - 1
src/typing/matcher.ml

@@ -176,7 +176,7 @@ module Pattern = struct
 	let unify_type_pattern ctx mt t p =
 		let tcl = get_general_module_type ctx mt p in
 		match tcl with
-			| TAbstract(a,_) -> unify ctx (TAbstract(a,[mk_mono()])) t p
+			| TAbstract(a,_) -> unify ctx (TAbstract(a,[spawn_monomorph ctx p])) t p
 			| _ -> die "" __LOC__
 
 	let rec make pctx toplevel t e =

+ 15 - 14
src/typing/typer.ml

@@ -165,7 +165,8 @@ let check_error ctx err p = match err with
 (* ---------------------------------------------------------------------- *)
 (* PASS 3 : type expression & check structure *)
 
-let rec unify_min_raise basic (el:texpr list) : t =
+let rec unify_min_raise ctx (el:texpr list) : t =
+	let basic = ctx.com.basic in
 	let rec base_types t =
 		let tl = ref [] in
 		let rec loop t = (match t with
@@ -193,7 +194,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 		!tl
 	in
 	match el with
-	| [] -> mk_mono()
+	| [] -> spawn_monomorph ctx null_pos
 	| [e] -> e.etype
 	| _ ->
 		let rec chk_null e = is_null e.etype || is_explicit_null e.etype ||
@@ -222,7 +223,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 				with Unify_error _ ->
 					true, t
 		in
-		let has_error, t = loop (mk_mono()) el in
+		let has_error, t = loop (spawn_monomorph ctx null_pos) el in
 		if not has_error then
 			t
 		else try
@@ -246,7 +247,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 					raise Not_found
 			) PMap.empty el in
 			let fields = PMap.foldi (fun n el acc ->
-				let t = try unify_min_raise basic el with Unify_error _ -> raise Not_found in
+				let t = try unify_min_raise ctx el with Unify_error _ -> raise Not_found in
 				PMap.add n (mk_field n t (List.hd el).epos null_pos) acc
 			) fields PMap.empty in
 			mk_anon ~fields (ref Closed)
@@ -282,7 +283,7 @@ let rec unify_min_raise basic (el:texpr list) : t =
 				List.hd !common_types
 
 let unify_min ctx el =
-	try unify_min_raise ctx.com.basic el
+	try unify_min_raise ctx el
 	with Error (Unify l,p) ->
 		if not ctx.untyped then display_error ctx (error_msg (Unify l)) p;
 		(List.hd el).etype
@@ -328,7 +329,7 @@ let rec type_ident_raise ctx i p mode =
 		AKExpr (mk (TConst TSuper) t p)
 	| "null" ->
 		if mode = MGet then
-			AKExpr (null (mk_mono()) p)
+			AKExpr (null (spawn_monomorph ctx p) p)
 		else
 			AKNo i
 	| _ ->
@@ -1133,7 +1134,7 @@ and type_unop ctx op flag e p =
 				let rec loop opl = match opl with
 					| [] -> raise Not_found
 					| (op2,flag2,cf) :: opl when op == op2 && flag == flag2 ->
-						let m = mk_mono() in
+						let m = spawn_monomorph ctx p in
 						let tcf = apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type) in
 						if Meta.has Meta.Impl cf.cf_meta then begin
 							if type_iseq (tfun [apply_params a.a_params pl a.a_this] m) tcf then cf,tcf,m else loop opl
@@ -1948,11 +1949,11 @@ and type_map_declaration ctx e1 el with_type p =
 			| TInst({cl_path=["haxe";"ds"],"IntMap"},[tv]) -> ctx.t.tint,tv,true
 			| TInst({cl_path=["haxe";"ds"],"StringMap"},[tv]) -> ctx.t.tstring,tv,true
 			| TInst({cl_path=["haxe";"ds"],("ObjectMap" | "EnumValueMap")},[tk;tv]) -> tk,tv,true
-			| _ -> mk_mono(),mk_mono(),false
+			| _ -> spawn_monomorph ctx p,spawn_monomorph ctx p,false
 		in
 		match with_type with
 		| WithType.WithType(t,_) -> get_map_params t
-		| _ -> (mk_mono(),mk_mono(),false)
+		| _ -> (spawn_monomorph ctx p,spawn_monomorph ctx p,false)
 	in
 	let keys = Hashtbl.create 0 in
 	let check_key e_key =
@@ -1992,7 +1993,7 @@ and type_map_declaration ctx e1 el with_type p =
 			(e1 :: el_k,e2 :: el_v)
 		) ([],[]) el_kv in
 		let unify_min_resume el = try
-			unify_min_raise ctx.com.basic el
+			unify_min_raise ctx el
 		with Error (Unify l,p) when ctx.in_call_args ->
 			 raise (WithTypeError(Unify l,p))
 		in
@@ -2166,7 +2167,7 @@ and type_array_decl ctx el with_type p =
 	| None ->
 		let el = List.map (fun e -> type_expr ctx e WithType.value) el in
 		let t = try
-			unify_min_raise ctx.com.basic el
+			unify_min_raise ctx el
 		with Error (Unify l,p) ->
 			if !allow_array_dynamic || ctx.untyped || ctx.com.display.dms_error_policy = EPIgnore then
 				t_dynamic
@@ -2184,7 +2185,7 @@ and type_array_decl ctx el with_type p =
 		mk (TArrayDecl el) (ctx.t.tarray t) p)
 
 and type_array_comprehension ctx e with_type p =
-	let v = gen_local ctx (mk_mono()) p in
+	let v = gen_local ctx (spawn_monomorph ctx p) p in
 	let et = ref (EConst(Ident "null"),p) in
 	let comprehension_pos = p in
 	let rec map_compr (e,p) =
@@ -2615,7 +2616,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		type_try ctx e1 catches with_type p
 	| EThrow e ->
 		let e = type_expr ctx e WithType.value in
-		mk (TThrow e) (mk_mono()) p
+		mk (TThrow e) (spawn_monomorph ctx p) p
 	| ECall (e,el) ->
 		type_call ~mode ctx e el with_type false p
 	| ENew (t,el) ->
@@ -2637,7 +2638,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 		}
 	| ECast (e,None) ->
 		let e = type_expr ctx e WithType.value in
-		mk (TCast (e,None)) (mk_mono()) p
+		mk (TCast (e,None)) (spawn_monomorph ctx p) p
 	| ECast (e, Some t) ->
 		type_cast ctx e t p
 	| EDisplay (e,dk) ->

+ 1 - 1
src/typing/typerBase.ml

@@ -122,7 +122,7 @@ let rec type_module_type ctx t tparams p =
 		let types = (match tparams with None -> Monomorph.spawn_constrained_monos (fun t -> t) e.e_params | Some l -> l) in
 		mk (TTypeExpr (TEnumDecl e)) (TType (e.e_type,types)) p
 	| TTypeDecl s ->
-		let t = apply_params s.t_params (List.map (fun _ -> mk_mono()) s.t_params) s.t_type in
+		let t = apply_params s.t_params (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) s.t_type in
 		DeprecationCheck.check_typedef ctx.com s p;
 		(match follow t with
 		| TEnum (e,params) ->

+ 1 - 1
src/typing/typerDisplay.ml

@@ -150,7 +150,7 @@ let raise_toplevel ctx dk with_type (subject,psubject) =
 	DisplayToplevel.collect_and_raise ctx (match dk with DKPattern _ -> TKPattern psubject | _ -> TKExpr psubject) with_type (CRToplevel expected_type) (subject,psubject) psubject
 
 let display_dollar_type ctx p make_type =
-	let mono = mk_mono() in
+	let mono = spawn_monomorph ctx p in
 	let doc = doc_from_string "Outputs type of argument as a warning and uses argument as value" in
 	let arg = ["expression",false,mono] in
 	begin match ctx.com.display.dms_kind with