[typer] refactor typeloading a bit

src/compiler/server.ml

@@ -441,7 +441,7 @@ let add_modules sctx ctx m p =
 						a.a_meta <- List.filter (fun (m,_,_) -> m <> Meta.ValueUsed) a.a_meta
 					| _ -> ()
 				) m.m_types;
-				TypeloadModule.add_module ctx m p;
+				TypeloadModule.ModuleLevel.add_module ctx m p;
 				PMap.iter (Hashtbl.replace com.resources) m.m_extra.m_binded_res;
 				PMap.iter (fun _ m2 -> add_modules (tabs ^ "  ") m0 m2) m.m_extra.m_deps
 			)

src/context/display/displayTexpr.ml

@@ -108,7 +108,7 @@ let check_display_enum ctx decls en =
 	PMap.iter (fun _ ef ->
 		if display_position#enclosed_in ef.ef_pos then begin
 			let sef = find_enum_field_by_position se ef.ef_name_pos in
-			ignore(TypeloadModule.load_enum_field ctx en (TEnum (en,extract_param_types en.e_params)) (ref false) (ref 0) sef)
+			ignore(TypeloadModule.TypeLevel.load_enum_field ctx en (TEnum (en,extract_param_types en.e_params)) (ref false) (ref 0) sef)
 		end
 	) en.e_constrs
 
@@ -143,7 +143,7 @@ let check_display_module ctx decls m =
 		| (EImport _ | EUsing _),_ -> true
 		| _ -> false
 	) decls in
-	let imports = TypeloadModule.handle_import_hx ctx m imports null_pos in
+	let imports = TypeloadModule.ModuleLevel.handle_import_hx ctx m imports null_pos in
 	let ctx = TypeloadModule.type_types_into_module ctx m imports null_pos in
 	List.iter (fun md ->
 		let infos = t_infos md in

src/context/typecore.ml

@@ -136,7 +136,6 @@ and typer = {
 	mutable delayed_display : DisplayTypes.display_exception_kind option;
 	mutable monomorphs : monomorphs;
 	(* events *)
-	mutable on_error : typer -> string -> pos -> unit;
 	memory_marker : float array;
 }
 
@@ -597,6 +596,40 @@ 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 (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 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/typing/macroContext.ml

@@ -364,7 +364,7 @@ let make_macro_api ctx p =
 		MacroApi.add_module_check_policy = (fun sl il b i ->
 			let add ctx =
 				ctx.g.module_check_policies <- (List.fold_left (fun acc s -> (ExtString.String.nsplit s ".",List.map Obj.magic il,b) :: acc) ctx.g.module_check_policies sl);
-				Hashtbl.iter (fun _ m -> m.m_extra.m_check_policy <- TypeloadModule.get_policy ctx m.m_path) ctx.g.modules;
+				Hashtbl.iter (fun _ m -> m.m_extra.m_check_policy <- TypeloadModule.get_policy ctx.g m.m_path) ctx.g.modules;
 			in
 			let add_macro ctx = match ctx.g.macros with
 				| None -> ()

src/typing/strictMeta.ml

@@ -0,0 +1,154 @@
+open Globals
+open Ast
+open Type
+open Common
+open Typecore
+
+let get_native_repr md pos =
+	let path, meta = match md with
+		| TClassDecl cl -> cl.cl_path, cl.cl_meta
+		| TEnumDecl e -> e.e_path, e.e_meta
+		| TTypeDecl t -> t.t_path, t.t_meta
+		| TAbstractDecl a -> a.a_path, a.a_meta
+	in
+	let rec loop acc = function
+		| (Meta.JavaCanonical,[EConst(String(pack,_)),_; EConst(String(name,_)),_],_) :: _ ->
+			ExtString.String.nsplit pack ".", name
+		| (Meta.Native,[EConst(String(name,_)),_],_) :: meta ->
+			loop (Ast.parse_path name) meta
+		| _ :: meta ->
+			loop acc meta
+		| [] ->
+			acc
+	in
+	let pack, name = loop path meta in
+	match pack with
+		| [] ->
+			(EConst(Ident(name)), pos)
+		| hd :: tl ->
+			let rec loop pack expr = match pack with
+				| hd :: tl ->
+					loop tl (efield(expr,hd),pos)
+				| [] ->
+					(efield(expr,name),pos)
+			in
+			loop tl (EConst(Ident(hd)),pos)
+
+let rec process_meta_argument ?(toplevel=true) ctx expr = match expr.eexpr with
+	| TField(e,f) ->
+		(efield(process_meta_argument ~toplevel:false ctx e,field_name f),expr.epos)
+	| TConst(TInt i) ->
+		(EConst(Int (Int32.to_string i, None)), expr.epos)
+	| TConst(TFloat f) ->
+		(EConst(Float (f, None)), expr.epos)
+	| TConst(TString s) ->
+		(EConst(String(s,SDoubleQuotes)), expr.epos)
+	| TConst TNull ->
+		(EConst(Ident "null"), expr.epos)
+	| TConst(TBool b) ->
+		(EConst(Ident (string_of_bool b)), expr.epos)
+	| TCast(e,_) | TMeta(_,e) | TParenthesis(e) ->
+		process_meta_argument ~toplevel ctx e
+	| TTypeExpr md when toplevel ->
+		let p = expr.epos in
+		if ctx.com.platform = Cs then
+			(ECall( (EConst(Ident "typeof"), p), [get_native_repr md expr.epos] ), p)
+		else
+			(efield(get_native_repr md expr.epos, "class"), p)
+	| TTypeExpr md ->
+		get_native_repr md expr.epos
+	| _ ->
+		display_error ctx.com "This expression is too complex to be a strict metadata argument" expr.epos;
+		(EConst(Ident "null"), expr.epos)
+
+let handle_fields ctx fields_to_check with_type_expr =
+	List.map (fun ((name,_,_),expr) ->
+		let pos = snd expr in
+		let field = (efield(with_type_expr,name), pos) in
+		let fieldexpr = (EConst(Ident name),pos) in
+		let left_side = match ctx.com.platform with
+			| Cs -> field
+			| Java -> (ECall(field,[]),pos)
+			| _ -> die "" __LOC__
+		in
+
+		let left = type_expr ctx left_side NoValue in
+		let right = type_expr ctx expr (WithType.with_type left.etype) in
+		unify ctx left.etype right.etype (snd expr);
+		(EBinop(Ast.OpAssign,fieldexpr,process_meta_argument ctx right), pos)
+	) fields_to_check
+
+let make_meta ctx texpr extra =
+	match texpr.eexpr with
+		| TNew(c,_,el) ->
+			ECall(get_native_repr (TClassDecl c) texpr.epos, (List.map (process_meta_argument ctx) el) @ extra), texpr.epos
+		| TTypeExpr(md) ->
+			ECall(get_native_repr md texpr.epos, extra), texpr.epos
+		| _ ->
+			display_error ctx.com "Unexpected expression" texpr.epos; die "" __LOC__
+
+let get_strict_meta ctx meta params pos =
+	let pf = ctx.com.platform in
+	let changed_expr, fields_to_check, ctype = match params with
+		| [ECall(ef, el),p] ->
+			let tpath = field_to_type_path ctx.com ef in
+			begin match pf with
+			| Cs ->
+				let el, fields = match List.rev el with
+					| (EObjectDecl(decl),_) :: el ->
+						List.rev el, decl
+					| _ ->
+						el, []
+				in
+				(ENew((tpath,snd ef), el), p), fields, CTPath tpath
+			| Java ->
+				let fields = match el with
+				| [EObjectDecl(fields),_] ->
+					fields
+				| [] ->
+					[]
+				| (_,p) :: _ ->
+					display_error ctx.com "Object declaration expected" p;
+					[]
+				in
+				ef, fields, CTPath tpath
+			| _ ->
+				Error.typing_error "@:strict is not supported on this target" p
+			end
+		| [EConst(Ident i),p as expr] ->
+			let tpath = { tpackage=[]; tname=i; tparams=[]; tsub=None } in
+			if pf = Cs then
+				(ENew((tpath,p), []), p), [], CTPath tpath
+			else
+				expr, [], CTPath tpath
+		| [ (EField(_),p as field) ] ->
+			let tpath = field_to_type_path ctx.com field in
+			if pf = Cs then
+				(ENew((tpath,p), []), p), [], CTPath tpath
+			else
+				field, [], CTPath tpath
+		| _ ->
+			display_error ctx.com "A @:strict metadata must contain exactly one parameter. Please check the documentation for more information" pos;
+			raise Exit
+	in
+	let texpr = type_expr ctx changed_expr NoValue in
+	let with_type_expr = (ECheckType( (EConst (Ident "null"), pos), (ctype,null_pos) ), pos) in
+	let extra = handle_fields ctx fields_to_check with_type_expr in
+	meta, [make_meta ctx texpr extra], pos
+
+let check_strict_meta ctx metas =
+	let pf = ctx.com.platform in
+	match pf with
+		| Cs | Java ->
+			let ret = ref [] in
+			List.iter (function
+				| Meta.AssemblyStrict,params,pos -> (try
+					ret := get_strict_meta ctx Meta.AssemblyMeta params pos :: !ret
+				with | Exit -> ())
+				| Meta.Strict,params,pos -> (try
+					ret := get_strict_meta ctx Meta.Meta params pos :: !ret
+				with | Exit -> ())
+				| _ -> ()
+			) metas;
+			!ret
+		| _ -> []

src/typing/typeload.ml

@@ -753,40 +753,6 @@ let load_type_hint ?(opt=false) ctx pcur t =
 (* ---------------------------------------------------------------------- *)
 (* PASS 1 & 2 : Module and Class Structure *)
 
-let field_to_type_path com e =
-	let rec loop e pack name = match e with
-		| EField(e,f,_),p when Char.lowercase (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 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 [] []
-
 type type_param_host =
 	| TPHType
 	| TPHConstructor

src/typing/typeloadFields.ml

@@ -563,12 +563,6 @@ let create_typer_context_for_class ctx cctx p =
 				| TMono r when r.tm_type = None -> TAbstract (a,extract_param_types c.cl_params)
 				| t -> t)
 			| None -> TInst (c,extract_param_types c.cl_params));
-		on_error = (fun ctx msg ep ->
-			ctx.com.error msg ep;
-			(* macros expressions might reference other code, let's recall which class we are actually compiling *)
-			let open TFunctions in
-			if not (ExtString.String.starts_with msg "...") && !locate_macro_error && (is_pos_outside_class c ep) && not (is_module_fields_class c) then ctx.com.error (compl_msg "Defined in this class") c.cl_pos
-		);
 	} in
 	ctx
 

src/typing/typer.ml

@@ -2011,7 +2011,6 @@ let rec create com =
 		monomorphs = {
 			perfunction = [];
 		};
-		on_error = (fun ctx msg p -> ctx.com.error msg p);
 		memory_marker = Typecore.memory_marker;
 	} in
 	ctx.g.std <- (try