瀏覽代碼

[typer] remove tparams argument to type_module_type

because it's always None except for inner recursion
Simon Krajewski 2 年之前
父節點
當前提交
21e768cd0f

+ 3 - 3
src/typing/calls.ml

@@ -91,7 +91,7 @@ let mk_array_get_call ctx (cf,tf,r,e1) c ebase p = match cf.cf_expr with
 		if not (Meta.has Meta.NoExpr cf.cf_meta) then display_error ctx.com "Recursive array get method" p;
 		mk (TArray(ebase,e1)) r p
 	| _ ->
-		let et = type_module_type ctx (TClassDecl c) None p in
+		let et = type_module_type ctx (TClassDecl c) p in
 		let ef = mk (TField(et,(FStatic(c,cf)))) tf p in
 		make_call ctx ef [ebase;e1] r p
 
@@ -102,7 +102,7 @@ let mk_array_set_call ctx (cf,tf,r,e1,evalue) c ebase p =
 			let ea = mk (TArray(ebase,e1)) r p in
 			mk (TBinop(OpAssign,ea,evalue)) r p
 		| _ ->
-			let et = type_module_type ctx (TClassDecl c) None p in
+			let et = type_module_type ctx (TClassDecl c) p in
 			let ef = mk (TField(et,(FStatic(c,cf)))) tf p in
 			make_call ctx ef [ebase;e1;evalue] r p
 
@@ -160,7 +160,7 @@ let rec acc_get ctx g =
 					c2.cl_ordered_statics <- cf :: c2.cl_ordered_statics;
 					cf
 				in
-				let e_t = type_module_type ctx (TClassDecl c2) None p in
+				let e_t = type_module_type ctx (TClassDecl c2) p in
 				FieldAccess.get_field_expr (FieldAccess.create e_t cf (FHStatic c2) true p) FRead
 			in
 			let e_def = FieldAccess.get_field_expr fa FRead in

+ 1 - 1
src/typing/fields.ml

@@ -347,7 +347,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 				| Statics { cl_kind = KAbstractImpl a } ->
 					type_field_by_forward_static (fun() ->
 						let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in
-						let et = type_module_type ctx mt None p in
+						let et = type_module_type ctx mt p in
 						type_field_by_e type_field_by_type et
 					) a
 				| _ -> raise Not_found

+ 1 - 1
src/typing/finalization.ml

@@ -44,7 +44,7 @@ let get_main ctx types =
 		in
 		if not (ExtType.is_void (follow r)) then raise_typing_error (Printf.sprintf "Return type of main function should be Void (found %s)" (s_type (print_context()) r)) f.cf_name_pos;
 		f.cf_meta <- (Dce.mk_keep_meta f.cf_pos) :: f.cf_meta;
-		let emain = type_module_type ctx (TClassDecl c) None null_pos in
+		let emain = type_module_type ctx (TClassDecl c) null_pos in
 		let main = mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos in
 		let call_static path method_name =
 			let et = List.find (fun t -> t_path t = path) types in

+ 1 - 1
src/typing/matcher/exprToPattern.ml

@@ -193,7 +193,7 @@ let rec make pctx toplevel t e =
 			let restore = catch_errors () in
 			begin try
 				let mt = module_type_of_type t in
-				let e_mt = TyperBase.type_module_type ctx mt None p in
+				let e_mt = TyperBase.type_module_type ctx mt p in
 				let e = type_field_access ctx ~resume:true e_mt s in
 				restore();
 				check_expr e

+ 1 - 1
src/typing/matcher/texprConverter.ml

@@ -24,7 +24,7 @@ let constructor_to_texpr ctx con =
 	| ConEnum(en,ef) -> mk (TConst (TInt (Int32.of_int ef.ef_index))) ctx.t.tint p
 	| ConConst ct -> make_const_texpr ctx.com.basic ct p
 	| ConArray i -> make_int ctx.com.basic i p
-	| ConTypeExpr mt -> TyperBase.type_module_type ctx mt None p
+	| ConTypeExpr mt -> TyperBase.type_module_type ctx mt p
 	| ConStatic(c,cf) -> make_static_field c cf p
 	| ConFields _ -> raise_typing_error "Something went wrong" p
 

+ 1 - 1
src/typing/operators.ml

@@ -713,7 +713,7 @@ let type_assign_op ctx op e1 e2 with_type p =
 		let eget = BinopResult.to_texpr vr eget (fun e -> e) in
 		unify ctx eget.etype r_get p;
 		let cf_set,tf_set,r_set,ekey,eget = AbstractCast.find_array_write_access ctx a tl ekey eget p in
-		let et = type_module_type ctx (TClassDecl c) None p in
+		let et = type_module_type ctx (TClassDecl c) p in
 		let e = match cf_set.cf_expr,cf_get.cf_expr with
 			| None,None ->
 				let ea = mk (TArray(ebase,ekey)) r_get p in

+ 7 - 7
src/typing/typer.ml

@@ -400,7 +400,7 @@ let rec type_ident_raise ctx i p mode with_type =
 		| None -> raise Not_found
 		| Some c ->
 			let f = PMap.find i c.cl_statics in
-			let e = type_module_type ctx (TClassDecl c) None p in
+			let e = type_module_type ctx (TClassDecl c) p in
 			field_access ctx mode f (FHStatic c) e p
 		)
 	with Not_found -> try
@@ -423,7 +423,7 @@ let rec type_ident_raise ctx i p mode with_type =
 						if not (has_class_field_flag cf CfEnum) then
 							loop l
 						else begin
-							let et = type_module_type ctx (TClassDecl c) None p in
+							let et = type_module_type ctx (TClassDecl c) p in
 							let inline = match cf.cf_kind with
 								| Var {v_read = AccInline} -> true
 								|  _ -> false
@@ -445,7 +445,7 @@ let rec type_ident_raise ctx i p mode with_type =
 				| TEnumDecl e ->
 					try
 						let ef = PMap.find i e.e_constrs in
-						let et = type_module_type ctx t None p in
+						let et = type_module_type ctx t p in
 						ImportHandling.mark_import_position ctx pt;
 						wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef p) p)
 					with
@@ -456,7 +456,7 @@ let rec type_ident_raise ctx i p mode with_type =
 		(* lookup imported globals *)
 		let t, name, pi = PMap.find i ctx.m.module_globals in
 		ImportHandling.mark_import_position ctx pi;
-		let e = type_module_type ctx t None p in
+		let e = type_module_type ctx t p in
 		type_field_default_cfg ctx e name p mode with_type
 
 and type_ident ctx i p mode with_type =
@@ -474,7 +474,7 @@ and type_ident ctx i p mode with_type =
 			resolved_to_type_parameter := true;
 			let c = match follow (extract_param_type t) with TInst(c,_) -> c | _ -> die "" __LOC__ in
 			if TypeloadCheck.is_generic_parameter ctx c && Meta.has Meta.Const c.cl_meta then begin
-				let e = type_module_type ctx (TClassDecl c) None p in
+				let e = type_module_type ctx (TClassDecl c) p in
 				AKExpr {e with etype = (extract_param_type t)}
 			end else
 				raise Not_found
@@ -1267,7 +1267,7 @@ and type_map_declaration ctx e1 el with_type p =
 	let cf = PMap.find "set" c.cl_statics in
 	let v = gen_local ctx tmap p in
 	let ev = mk (TLocal v) tmap p in
-	let ec = type_module_type ctx (TClassDecl c) None p in
+	let ec = type_module_type ctx (TClassDecl c) p in
 	let ef = mk (TField(ec,FStatic(c,cf))) (tfun [tkey;tval] ctx.t.tvoid) p in
 	let el = ev :: List.map2 (fun e1 e2 -> (make_call ctx ef [ev;e1;e2] ctx.com.basic.tvoid p)) el_k el_v in
 	let enew = mk (TNew(c,[tkey;tval],[])) tmap p in
@@ -2056,7 +2056,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 			let mt = Typeload.load_type_def ctx p_t tp in
 			if ctx.in_display && DisplayPosition.display_position#enclosed_in p_t then
 				DisplayEmitter.display_module_type ctx mt p_t;
-			let e_t = type_module_type ctx mt None p_t in
+			let e_t = type_module_type ctx mt p_t in
 			let e_Std_isOfType =
 				match Typeload.load_type_raise ctx ([],"Std") "Std" p with
 				| TClassDecl c ->

+ 41 - 38
src/typing/typerBase.ml

@@ -183,48 +183,51 @@ let assign_to_this_is_allowed ctx =
 			)
 		| _ -> false
 
-let rec type_module_type ctx t tparams p =
-	match t with
-	| TClassDecl {cl_kind = KGenericBuild _} ->
-		let _,_,f = InstanceBuilder.build_instance ctx t p in
-		let t = f (match tparams with None -> [] | Some tl -> tl) in
-		let mt = try
-			module_type_of_type t
-		with Exit ->
-			if follow t == t_dynamic then Typeload.load_type_def ctx p (mk_type_path ([],"Dynamic"))
-			else raise_typing_error "Invalid module type" p
-		in
-		type_module_type ctx mt None p
-	| TClassDecl c ->
-		let t_tmp = class_module_type c in
-		mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
-	| TEnumDecl e ->
-		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_typedef s (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) in
-		DeprecationCheck.check_typedef (create_deprecation_context ctx) s p;
-		(match follow t with
-		| TEnum (e,params) ->
-			type_module_type ctx (TEnumDecl e) (Some params) p
-		| TInst (c,params) ->
-			type_module_type ctx (TClassDecl c) (Some params) p
-		| TAbstract (a,params) ->
-			type_module_type ctx (TAbstractDecl a) (Some params) p
-		| _ ->
-			raise_typing_error (s_type_path s.t_path ^ " is not a value") p)
-	| TAbstractDecl { a_impl = Some c } ->
-		type_module_type ctx (TClassDecl c) tparams p
-	| TAbstractDecl a ->
-		if not (Meta.has Meta.RuntimeValue a.a_meta) then raise_typing_error (s_type_path a.a_path ^ " is not a value") p;
-		let t_tmp = abstract_module_type a [] in
-		mk (TTypeExpr (TAbstractDecl a)) (TType (t_tmp,[])) p
+let type_module_type ctx t p =
+	let rec loop t tparams =
+		match t with
+		| TClassDecl {cl_kind = KGenericBuild _} ->
+			let _,_,f = InstanceBuilder.build_instance ctx t p in
+			let t = f (match tparams with None -> [] | Some tl -> tl) in
+			let mt = try
+				module_type_of_type t
+			with Exit ->
+				if follow t == t_dynamic then Typeload.load_type_def ctx p (mk_type_path ([],"Dynamic"))
+				else raise_typing_error "Invalid module type" p
+			in
+			loop mt None
+		| TClassDecl c ->
+			let t_tmp = class_module_type c in
+			mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
+		| TEnumDecl e ->
+			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_typedef s (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) in
+			DeprecationCheck.check_typedef (create_deprecation_context ctx) s p;
+			(match follow t with
+			| TEnum (e,params) ->
+				loop (TEnumDecl e) (Some params)
+			| TInst (c,params) ->
+				loop (TClassDecl c) (Some params)
+			| TAbstract (a,params) ->
+				loop (TAbstractDecl a) (Some params)
+			| _ ->
+				raise_typing_error (s_type_path s.t_path ^ " is not a value") p)
+		| TAbstractDecl { a_impl = Some c } ->
+			loop (TClassDecl c) tparams
+		| TAbstractDecl a ->
+			if not (Meta.has Meta.RuntimeValue a.a_meta) then raise_typing_error (s_type_path a.a_path ^ " is not a value") p;
+			let t_tmp = abstract_module_type a [] in
+			mk (TTypeExpr (TAbstractDecl a)) (TType (t_tmp,[])) p
+	in
+	loop t None
 
 let type_type ctx tpath p =
-	type_module_type ctx (Typeload.load_type_def ctx p (mk_type_path tpath)) None p
+	type_module_type ctx (Typeload.load_type_def ctx p (mk_type_path tpath)) p
 
 let mk_module_type_access ctx t p =
-	AKExpr (type_module_type ctx t None p)
+	AKExpr (type_module_type ctx t p)
 
 let s_field_access tabs fa =
 	let st = s_type (print_context()) in

+ 2 - 2
src/typing/typerDotPath.ml

@@ -44,7 +44,7 @@ let resolve_module_field ctx m path p mode with_type =
 		raise Not_found
 	| {name = name; pos = p} :: path_rest, Some c ->
 		let f = PMap.find name c.cl_statics in (* raises Not_found *)
-		let e = type_module_type ctx (TClassDecl c) None p in
+		let e = type_module_type ctx (TClassDecl c) p in
 		field_access ctx mode f (FHStatic c) e p, path_rest
 
 let resolve_module_type ctx m name p =
@@ -93,7 +93,7 @@ let resolve_unqualified ctx name next_path p mode with_type =
 			*)
 			match next_path with
 			| {name = field; pos = pfield} :: next_path ->
-				let e = type_module_type ctx t None p in
+				let e = type_module_type ctx t p in
 				let access = type_field (TypeFieldConfig.create true) ctx e field pfield mode with_type in
 				access, next_path
 			| _ ->