evacuate some things from typecore.ml

src/context/typecore.ml

@@ -450,58 +450,8 @@ let add_local ctx k n t p =
 	ctx.f.locals <- PMap.add n v ctx.f.locals;
 	v
 
-let display_identifier_error ctx ?prepend_msg msg p =
-	let prepend = match prepend_msg with Some s -> s ^ " " | _ -> "" in
-	display_error ctx.com (prepend ^ msg) p
-
-let check_identifier_name ?prepend_msg ctx name kind p =
-	if starts_with name '$' then
-		display_identifier_error ctx ?prepend_msg ((StringHelper.capitalize kind) ^ " names starting with a dollar are not allowed: \"" ^ name ^ "\"") p
-	else if not (Lexer.is_valid_identifier name) then
-		display_identifier_error ctx ?prepend_msg ("\"" ^ (StringHelper.s_escape name) ^ "\" is not a valid " ^ kind ^ " name.") p
-
-let check_field_name ctx name p =
-	match name with
-	| "new" -> () (* the only keyword allowed in field names *)
-	| _ -> check_identifier_name ctx name "field" p
-
-let check_uppercase_identifier_name ?prepend_msg ctx name kind p =
-	if String.length name = 0 then
-		display_identifier_error ?prepend_msg ctx ((StringHelper.capitalize kind) ^ " name must not be empty.") p
-	else if Ast.is_lower_ident name then
-		display_identifier_error ?prepend_msg ctx ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter: \"" ^ name ^ "\"") p
-	else
-		check_identifier_name ?prepend_msg ctx name kind p
-
-let check_module_path ctx (pack,name) p =
-	let full_path = StringHelper.s_escape (if pack = [] then name else (String.concat "." pack) ^ "." ^ name) in
-	check_uppercase_identifier_name ~prepend_msg:("Module \"" ^ full_path ^ "\" does not have a valid name.") ctx name "module" p;
-	try
-		List.iter (fun part -> Path.check_package_name part) pack;
-	with Failure msg ->
-		display_error_ext ctx.com (make_error
-			~sub:[make_error (Custom msg) p]
-			(Custom ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:"))
-			p
-		)
-
-let check_local_variable_name ctx name origin p =
-	match name with
-	| "this" -> () (* TODO: vars named `this` should technically be VGenerated, not VUser *)
-	| _ ->
-		let s_var_origin origin =
-			match origin with
-			| TVOLocalVariable -> "variable"
-			| TVOArgument -> "function argument"
-			| TVOForVariable -> "for variable"
-			| TVOPatternVariable -> "pattern variable"
-			| TVOCatchVariable -> "catch variable"
-			| TVOLocalFunction -> "function"
-		in
-		check_identifier_name ctx name (s_var_origin origin) p
-
 let add_local_with_origin ctx origin n t p =
-	check_local_variable_name ctx n origin p;
+	Naming.check_local_variable_name ctx.com n origin p;
 	add_local ctx (VUser origin) n t p
 
 let gen_local_prefix = "`"
@@ -594,16 +544,6 @@ let is_forced_inline c cf =
 let needs_inline ctx c cf =
 	cf.cf_kind = Method MethInline && ctx.allow_inline && (ctx.g.doinline || is_forced_inline c cf)
 
-let clone_type_parameter map path ttp =
-	let c = ttp.ttp_class in
-	let c = {c with cl_path = path} in
-	let def = Option.map map ttp.ttp_default in
-	let constraints = match ttp.ttp_constraints with
-		| None -> None
-		| Some constraints -> Some (lazy (List.map map (Lazy.force constraints)))
-	in
-	mk_type_param c ttp.ttp_host def constraints
-
 (** checks if we can access to a given class field using current context *)
 let can_access ctx c cf stat =
 	if (has_class_field_flag cf CfPublic) then
@@ -739,40 +679,6 @@ let merge_core_doc ctx mt =
 		end
 	| _ -> ())
 
-let field_to_type_path com e =
-	let rec loop e pack name = match e with
-		| EField(e,f,_),p when Char.lowercase_ascii (String.get f 0) <> String.get f 0 -> (match name with
-			| [] | _ :: [] ->
-				loop e pack (f :: name)
-			| _ -> (* too many name paths *)
-				display_error com ("Unexpected " ^ f) p;
-				raise Exit)
-		| EField(e,f,_),_ ->
-			loop e (f :: pack) name
-		| EConst(Ident f),_ ->
-			let pack, name, sub = match name with
-				| [] ->
-					let fchar = String.get f 0 in
-					if Char.uppercase_ascii fchar = fchar then
-						pack, f, None
-					else begin
-						display_error com "A class name must start with an uppercase letter" (snd e);
-						raise Exit
-					end
-				| [name] ->
-					f :: pack, name, None
-				| [name; sub] ->
-					f :: pack, name, Some sub
-				| _ ->
-					die "" __LOC__
-			in
-			{ tpackage=pack; tname=name; tparams=[]; tsub=sub }
-		| _,pos ->
-			display_error com "Unexpected expression when building strict meta" pos;
-			raise Exit
-	in
-	loop e [] []
-
 let safe_mono_close ctx m p =
 	try
 		Monomorph.close m

src/core/naming.ml

@@ -1,6 +1,8 @@
 open Globals
 open Ast
 open Type
+open Common
+open Error
 
 (** retrieve string from @:native metadata or raise Not_found *)
 let get_native_name meta =
@@ -84,3 +86,54 @@ let apply_native_paths t =
 			())
 	with Not_found ->
 		()
+
+
+let display_identifier_error com ?prepend_msg msg p =
+	let prepend = match prepend_msg with Some s -> s ^ " " | _ -> "" in
+	Common.display_error com (prepend ^ msg) p
+
+let check_identifier_name ?prepend_msg com name kind p =
+	if starts_with name '$' then
+		display_identifier_error com ?prepend_msg ((StringHelper.capitalize kind) ^ " names starting with a dollar are not allowed: \"" ^ name ^ "\"") p
+	else if not (Lexer.is_valid_identifier name) then
+		display_identifier_error com ?prepend_msg ("\"" ^ (StringHelper.s_escape name) ^ "\" is not a valid " ^ kind ^ " name.") p
+
+let check_field_name com name p =
+	match name with
+	| "new" -> () (* the only keyword allowed in field names *)
+	| _ -> check_identifier_name com name "field" p
+
+let check_uppercase_identifier_name ?prepend_msg com name kind p =
+	if String.length name = 0 then
+		display_identifier_error ?prepend_msg com ((StringHelper.capitalize kind) ^ " name must not be empty.") p
+	else if Ast.is_lower_ident name then
+		display_identifier_error ?prepend_msg com ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter: \"" ^ name ^ "\"") p
+	else
+		check_identifier_name ?prepend_msg com name kind p
+
+let check_module_path com (pack,name) p =
+	let full_path = StringHelper.s_escape (if pack = [] then name else (String.concat "." pack) ^ "." ^ name) in
+	check_uppercase_identifier_name ~prepend_msg:("Module \"" ^ full_path ^ "\" does not have a valid name.") com name "module" p;
+	try
+		List.iter (fun part -> Path.check_package_name part) pack;
+	with Failure msg ->
+		display_error_ext com (make_error
+			~sub:[make_error (Custom msg) p]
+			(Custom ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:"))
+			p
+		)
+
+let check_local_variable_name com name origin p =
+	match name with
+	| "this" -> () (* TODO: vars named `this` should technically be VGenerated, not VUser *)
+	| _ ->
+		let s_var_origin origin =
+			match origin with
+			| TVOLocalVariable -> "variable"
+			| TVOArgument -> "function argument"
+			| TVOForVariable -> "for variable"
+			| TVOPatternVariable -> "pattern variable"
+			| TVOCatchVariable -> "catch variable"
+			| TVOLocalFunction -> "function"
+		in
+		check_identifier_name com name (s_var_origin origin) p

src/typing/functionArguments.ml

@@ -100,7 +100,7 @@ object(self)
 					loop ((v,None) :: acc) false syntax typed
 				| ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed ->
 					delay ctx.g PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn);
-					if not is_extern then check_local_variable_name ctx name TVOArgument pn;
+					if not is_extern then Naming.check_local_variable_name ctx.com name TVOArgument pn;
 					let eo = type_function_arg_value ctx t eo do_display in
 					let v = make_local name (VUser TVOArgument) t m pn in
 					if do_display && DisplayPosition.display_position#enclosed_in pn then

src/typing/generic.ml

@@ -231,6 +231,16 @@ let build_instances ctx t p =
 	in
 	loop t
 
+let clone_type_parameter map path ttp =
+	let c = ttp.ttp_class in
+	let c = {c with cl_path = path} in
+	let def = Option.map map ttp.ttp_default in
+	let constraints = match ttp.ttp_constraints with
+		| None -> None
+		| Some constraints -> Some (lazy (List.map map (Lazy.force constraints)))
+	in
+	mk_type_param c ttp.ttp_host def constraints
+
 let clone_type_parameter gctx mg path ttp =
 	let ttp = clone_type_parameter (generic_substitute_type gctx) path ttp in
 	ttp.ttp_class.cl_module <- mg;

src/typing/strictMeta.ml

@@ -124,6 +124,40 @@ let make_meta ctx texpr extra =
 		| _ ->
 			display_error ctx.com "Unexpected expression" texpr.epos; die "" __LOC__
 
+let field_to_type_path com e =
+	let rec loop e pack name = match e with
+		| EField(e,f,_),p when Char.lowercase_ascii (String.get f 0) <> String.get f 0 -> (match name with
+			| [] | _ :: [] ->
+				loop e pack (f :: name)
+			| _ -> (* too many name paths *)
+				display_error com ("Unexpected " ^ f) p;
+				raise Exit)
+		| EField(e,f,_),_ ->
+			loop e (f :: pack) name
+		| EConst(Ident f),_ ->
+			let pack, name, sub = match name with
+				| [] ->
+					let fchar = String.get f 0 in
+					if Char.uppercase_ascii fchar = fchar then
+						pack, f, None
+					else begin
+						display_error com "A class name must start with an uppercase letter" (snd e);
+						raise Exit
+					end
+				| [name] ->
+					f :: pack, name, None
+				| [name; sub] ->
+					f :: pack, name, Some sub
+				| _ ->
+					die "" __LOC__
+			in
+			{ tpackage=pack; tname=name; tparams=[]; tsub=sub }
+		| _,pos ->
+			display_error com "Unexpected expression when building strict meta" pos;
+			raise Exit
+	in
+	loop e [] []
+
 let get_strict_meta ctx meta params pos =
 	let pf = ctx.com.platform in
 	let changed_expr, fields_to_check, ctype = match params with

src/typing/typeloadFields.ml

@@ -1596,7 +1596,7 @@ let init_field (ctx,cctx,fctx) f =
 	let name = fst f.cff_name in
 	TypeloadCheck.check_global_metadata ctx f.cff_meta (fun m -> f.cff_meta <- m :: f.cff_meta) c.cl_module.m_path c.cl_path (Some name);
 	let p = f.cff_pos in
-	if not (has_class_flag c CExtern) && not (Meta.has Meta.Native f.cff_meta) then Typecore.check_field_name ctx name p;
+	if not (has_class_flag c CExtern) && not (Meta.has Meta.Native f.cff_meta) then Naming.check_field_name ctx.com name p;
 	List.iter (fun acc ->
 		match (fst acc, f.cff_kind) with
 		| AFinal, FProp _ when not (has_class_flag c CExtern) && ctx.com.platform <> Java -> invalid_modifier_on_property ctx.com fctx (Ast.s_placed_access acc) (snd acc)

src/typing/typeloadModule.ml

@@ -87,7 +87,7 @@ module ModuleLevel = struct
 			let p = snd decl in
 			let check_type_name type_name meta =
 				let module_name = snd m.m_path in
-				if type_name <> module_name && not (Meta.has Meta.Native meta) then Typecore.check_uppercase_identifier_name ctx_m type_name "type" p;
+				if type_name <> module_name && not (Meta.has Meta.Native meta) then Naming.check_uppercase_identifier_name ctx_m.com type_name "type" p;
 			in
 			let acc = (match fst decl with
 			| EImport _ | EUsing _ ->
@@ -727,7 +727,7 @@ let type_module ctx_from mpath file ?(dont_check_path=false) ?(is_extern=false)
 	ctx_from.com.module_lut#add m.m_path m;
 	let tdecls = ModuleLevel.handle_import_hx ctx_from.com ctx_from.g m tdecls p in
 	let ctx_m = type_types_into_module ctx_from.com ctx_from.g m tdecls p in
-	if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Typecore.check_module_path ctx_m m.m_path p;
+	if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Naming.check_module_path ctx_m.com m.m_path p;
 	m
 
 (* let type_module ctx mpath file ?(is_extern=false) tdecls p =