move some things around in typeload.ml

This is not as bad as it looks and really comes down to splitting up some functions and renaming some others. It also gets rid of the typer context in places that shouldn't have any typer context anyway, such as pass 1 things.

typeload.ml

@@ -24,17 +24,16 @@ open Typecore
 
 let locate_macro_error = ref true
 
-let transform_abstract_field ctx this_t a_t a f =
+let transform_abstract_field com this_t a_t a f =
 	let stat = List.mem AStatic f.cff_access in
 	let p = f.cff_pos in
 	match f.cff_kind with
 	| FProp (("get" | "never"),("set" | "never"),_,_) when not stat ->
 		(* TODO: hack to avoid issues with abstract property generation on As3 *)
-		if Common.defined ctx.com Define.As3 then f.cff_meta <- (Meta.Extern,[],p) :: f.cff_meta;
+		if Common.defined com Define.As3 then f.cff_meta <- (Meta.Extern,[],p) :: f.cff_meta;
 		{ f with cff_access = AStatic :: f.cff_access; cff_meta = (Meta.Impl,[],p) :: f.cff_meta }
 	| FProp _ when not stat ->
-		display_error ctx "Member property accessors must be get/set or never" p;
-		f
+		error "Member property accessors must be get/set or never" p;
 	| FFun fu when f.cff_name = "new" && not stat ->
 		let init p = (EVars ["this",Some this_t,None],p) in
 		let cast e = (ECast(e,None)),pos e in
@@ -70,21 +69,24 @@ let transform_abstract_field ctx this_t a_t a f =
 	| _ ->
 		f
 
+let make_module ctx mpath file loadp =
+	let m = {
+		m_id = alloc_mid();
+		m_path = mpath;
+		m_types = [];
+		m_extra = module_extra (Common.unique_full_path file) (Common.get_signature ctx.com) (file_time file) (if ctx.in_macro then MMacro else MCode);
+	} in
+	m
+
 (*
 	Build module structure : should be atomic - no type loading is possible
 *)
-let make_module ctx mpath file tdecls loadp =
+let module_pass_1 com m tdecls loadp =
 	let decls = ref [] in
 	let make_path name priv =
 		if List.exists (fun (t,_) -> snd (t_path t) = name) !decls then error ("Type name " ^ name ^ " is already defined in this module") loadp;
-		if priv then (fst mpath @ ["_" ^ snd mpath], name) else (fst mpath, name)
+		if priv then (fst m.m_path @ ["_" ^ snd m.m_path], name) else (fst m.m_path, name)
 	in
-	let m = {
-		m_id = alloc_mid();
-		m_path = mpath;
-		m_types = [];
-		m_extra = module_extra (Common.unique_full_path file) (Common.get_signature ctx.com) (file_time file) (if ctx.in_macro then MMacro else MCode);
-	} in
 	let pt = ref None in
 	let rec make_decl acc decl =
 		let p = snd decl in
@@ -92,9 +94,7 @@ let make_module ctx mpath file tdecls loadp =
 		| EImport _ | EUsing _ ->
 			(match !pt with
 			| None -> acc
-			| Some pt ->
-				display_error ctx "import and using may not appear after a type declaration" p;
-				error "Previous type declaration found here" pt)
+			| Some _ -> error "import and using may not appear after a type declaration" p)
 		| EClass d ->
 			if String.length d.d_name > 0 && d.d_name.[0] = '$' then error "Type names starting with a dollar are not allowed" p;
 			pt := Some p;
@@ -192,7 +192,7 @@ let make_module ctx mpath file tdecls loadp =
 					| _ :: l -> loop l
 				in
 				let this_t = loop d.d_flags in
-				let fields = List.map (transform_abstract_field ctx this_t a_t a) fields in
+				let fields = List.map (transform_abstract_field com this_t a_t a) fields in
 				let meta = ref [] in
 				if has_meta Meta.Dce a.a_meta then meta := (Meta.Dce,[],p) :: !meta;
 				let acc = make_decl acc (EClass { d_name = d.d_name ^ "_Impl_"; d_flags = [HPrivate]; d_data = fields; d_doc = None; d_params = []; d_meta = !meta },p) in
@@ -213,8 +213,7 @@ let make_module ctx mpath file tdecls loadp =
 	in
 	let tdecls = List.fold_left make_decl [] tdecls in
 	let decls = List.rev !decls in
-	m.m_types <- List.map fst decls;
-	m, decls, List.rev tdecls
+	decls, List.rev tdecls
 
 let parse_file com file p =
 	let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
@@ -2029,7 +2028,7 @@ module ClassInitializer = struct
 						| Some a ->
 							let a_t = TExprToExpr.convert_type (TAbstract(a,List.map snd a.a_params)) in
 							let this_t = TExprToExpr.convert_type a.a_this in
-							transform_abstract_field ctx this_t a_t a f
+							transform_abstract_field ctx.com this_t a_t a f
 						| None ->
 							f
 					in
@@ -2771,17 +2770,6 @@ let resolve_typedef t =
 		| _ -> t
 
 let add_module ctx m p =
-	let decl_type t =
-		let t = t_infos t in
-		try
-			let m2 = Hashtbl.find ctx.g.types_module t.mt_path in
-			if m.m_path <> m2 && String.lowercase (s_type_path m2) = String.lowercase (s_type_path m.m_path) then error ("Module " ^ s_type_path m2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p;
-			error ("Type name " ^ s_type_path t.mt_path ^ " is redefined from module " ^ s_type_path m2) p
-		with
-			Not_found ->
-				Hashtbl.add ctx.g.types_module t.mt_path m.m_path
-	in
-	List.iter decl_type m.m_types;
 	Hashtbl.add ctx.g.modules m.m_path m
 
 (*
@@ -3181,10 +3169,49 @@ let rec init_module_type ctx context_init do_init (decl,p) =
 				error "Abstract is missing underlying type declaration" a.a_pos
 		end
 
-let type_module ctx m file ?(is_extern=false) tdecls p =
-	let m, decls, tdecls = make_module ctx m file tdecls p in
-	if is_extern then m.m_extra.m_kind <- MExtern;
-	add_module ctx m p;
+let module_pass_2 ctx m decls tdecls p =
+	(* here is an additional PASS 1 phase, which define the type parameters for all module types.
+		 Constraints are handled lazily (no other type is loaded) because they might be recursive anyway *)
+	List.iter (fun d ->
+		match d with
+		| (TClassDecl c, (EClass d, p)) ->
+			c.cl_params <- type_type_params ctx c.cl_path (fun() -> c.cl_params) p d.d_params;
+		| (TEnumDecl e, (EEnum d, p)) ->
+			e.e_params <- type_type_params ctx e.e_path (fun() -> e.e_params) p d.d_params;
+		| (TTypeDecl t, (ETypedef d, p)) ->
+			t.t_params <- type_type_params ctx t.t_path (fun() -> t.t_params) p d.d_params;
+		| (TAbstractDecl a, (EAbstract d, p)) ->
+			a.a_params <- type_type_params ctx a.a_path (fun() -> a.a_params) p d.d_params;
+		| _ ->
+			assert false
+	) decls;
+	(* setup module types *)
+	let context_init = ref [] in
+	let do_init() =
+		match !context_init with
+		| [] -> ()
+		| l -> context_init := []; List.iter (fun f -> f()) (List.rev l)
+	in
+	List.iter (init_module_type ctx context_init do_init) tdecls
+
+(*
+	Creates a module context for [m] and types [tdecls] using it.
+*)
+let type_types_into_module ctx m tdecls p =
+	let decls, tdecls = module_pass_1 ctx.com m tdecls p in
+	let types = List.map fst decls in
+	m.m_types <- m.m_types @ types;
+	let decl_type t =
+		let t = t_infos t in
+		try
+			let m2 = Hashtbl.find ctx.g.types_module t.mt_path in
+			if m.m_path <> m2 && String.lowercase (s_type_path m2) = String.lowercase (s_type_path m.m_path) then error ("Module " ^ s_type_path m2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p;
+			error ("Type name " ^ s_type_path t.mt_path ^ " is redefined from module " ^ s_type_path m2) p
+		with
+			Not_found ->
+				Hashtbl.add ctx.g.types_module t.mt_path m.m_path
+	in
+	List.iter decl_type types;
 	(* define the per-module context for the next pass *)
 	let ctx = {
 		com = ctx.com;
@@ -3225,31 +3252,17 @@ let type_module ctx m file ?(is_extern=false) tdecls p =
 		(* this will ensure both String and (indirectly) Array which are basic types which might be referenced *)
 		ignore(load_core_type ctx "String");
 	end;
-	(* here is an additional PASS 1 phase, which define the type parameters for all module types.
-		 Constraints are handled lazily (no other type is loaded) because they might be recursive anyway *)
-	List.iter (fun d ->
-		match d with
-		| (TClassDecl c, (EClass d, p)) ->
-			c.cl_params <- type_type_params ctx c.cl_path (fun() -> c.cl_params) p d.d_params;
-		| (TEnumDecl e, (EEnum d, p)) ->
-			e.e_params <- type_type_params ctx e.e_path (fun() -> e.e_params) p d.d_params;
-		| (TTypeDecl t, (ETypedef d, p)) ->
-			t.t_params <- type_type_params ctx t.t_path (fun() -> t.t_params) p d.d_params;
-		| (TAbstractDecl a, (EAbstract d, p)) ->
-			a.a_params <- type_type_params ctx a.a_path (fun() -> a.a_params) p d.d_params;
-		| _ ->
-			assert false
-	) decls;
-	(* setup module types *)
-	let context_init = ref [] in
-	let do_init() =
-		match !context_init with
-		| [] -> ()
-		| l -> context_init := []; List.iter (fun f -> f()) (List.rev l)
-	in
-	List.iter (init_module_type ctx context_init do_init) tdecls;
-	m
+	module_pass_2 ctx m decls tdecls p
 
+(*
+	Creates a new module and types [tdecls] into it.
+*)
+let type_module ctx mpath file ?(is_extern=false) tdecls p =
+	let m = make_module ctx mpath file p in
+	add_module ctx m p;
+	type_types_into_module ctx m tdecls p;
+	if is_extern then m.m_extra.m_kind <- MExtern;
+	m
 
 let resolve_module_file com m remap p =
 	let forbid = ref false in