瀏覽代碼

types directly reference modules and not their path
ensure that cached modules don't get post processed twice
sort modules by file before generation heuristic (prevent different generation order depending of cache hits)

Nicolas Cannasse 13 年之前
父節點
當前提交
5670a6aa65
共有 8 個文件被更改,包括 117 次插入94 次删除
  1. 22 11
      codegen.ml
  2. 2 2
      genswf9.ml
  3. 2 2
      genxml.ml
  4. 2 2
      interp.ml
  5. 16 16
      main.ml
  6. 27 12
      type.ml
  7. 29 26
      typeload.ml
  8. 17 23
      typer.ml

+ 22 - 11
codegen.ml

@@ -172,7 +172,7 @@ let extend_remoting ctx c t p async prot =
 	) decls in
 	) decls in
 	let m = Typeload.type_module ctx (t.tpackage,new_name) file decls p in
 	let m = Typeload.type_module ctx (t.tpackage,new_name) file decls p in
 	try
 	try
-		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.mtypes
+		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types
 	with Not_found ->
 	with Not_found ->
 		error ("Module " ^ s_type_path path ^ " does not define type " ^ t.tname) p
 		error ("Module " ^ s_type_path path ^ " does not define type " ^ t.tname) p
 	) in
 	) in
@@ -212,15 +212,18 @@ let rec build_generic ctx c p tl =
 		Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
 		Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
 	with Error(Module_not_found path,_) when path = (pack,name) ->
 	with Error(Module_not_found path,_) when path = (pack,name) ->
 		let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
 		let m = (try Hashtbl.find ctx.g.modules (Hashtbl.find ctx.g.types_module c.cl_path) with Not_found -> assert false) in
-		let ctx = { ctx with local_types = m.mtypes @ ctx.local_types } in
-		let cg = mk_class (pack,name) c.cl_pos in
+		let ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
 		let mg = {
 		let mg = {
-			mpath = cg.cl_path;
-			mfile = m.mfile;
-			mdeps = m.mdeps; (* share *)
-			mtypes = [TClassDecl cg];
+			m_id = alloc_mid();
+			m_path = (pack,name);
+			m_file = m.m_file;
+			m_deps = m.m_deps; (* share *)
+			m_types = [];
+			m_processed = 0;
 		} in
 		} in
-		Hashtbl.add ctx.g.modules mg.mpath mg;
+		let cg = mk_class mg (pack,name) c.cl_pos in
+		mg.m_types <- [TClassDecl cg];
+		Hashtbl.add ctx.g.modules mg.m_path mg;
 		let rec loop l1 l2 =
 		let rec loop l1 l2 =
 			match l1, l2 with
 			match l1, l2 with
 			| [] , [] -> []
 			| [] , [] -> []
@@ -461,10 +464,11 @@ let rec has_rtti c =
 	) c.cl_implements || (match c.cl_super with None -> false | Some (c,_) -> has_rtti c)
 	) c.cl_implements || (match c.cl_super with None -> false | Some (c,_) -> has_rtti c)
 
 
 let restore c =
 let restore c =
-	let meta = c.cl_meta and path = c.cl_path in
+	let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern in
 	let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
 	let fl = c.cl_fields and ofl = c.cl_ordered_fields and st = c.cl_statics and ost = c.cl_ordered_statics in
 	(fun() -> 
 	(fun() -> 
 		c.cl_meta <- meta;
 		c.cl_meta <- meta;
+		c.cl_extern <- ext;
 		c.cl_path <- path;
 		c.cl_path <- path;
 		c.cl_fields <- fl;
 		c.cl_fields <- fl;
 		c.cl_ordered_fields <- ofl;
 		c.cl_ordered_fields <- ofl;
@@ -476,7 +480,7 @@ let on_generate ctx t =
 	match t with
 	match t with
 	| TClassDecl c ->
 	| TClassDecl c ->
 		if c.cl_private then begin
 		if c.cl_private then begin
-			let rpath = (fst c.cl_module,"_" ^ snd c.cl_module) in
+			let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
 			if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 			if Hashtbl.mem ctx.g.types_module rpath then error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 		end;
 		end;
 		c.cl_restore <- restore c;
 		c.cl_restore <- restore c;
@@ -939,8 +943,14 @@ let check_local_vars_init e =
 (* -------------------------------------------------------------------------- *)
 (* -------------------------------------------------------------------------- *)
 (* POST PROCESS *)
 (* POST PROCESS *)
 
 
+let pp_counter = ref 1
+
 let post_process types filters =
 let post_process types filters =
+	(* ensure that we don't process twice the same (cached) module *)
 	List.iter (fun t ->
 	List.iter (fun t ->
+		let m = (t_infos t).mt_module in
+		if m.m_processed = 0 then m.m_processed <- !pp_counter;
+		if m.m_processed = !pp_counter then
 		match t with
 		match t with
 		| TClassDecl c ->
 		| TClassDecl c ->
 			let process_field f =
 			let process_field f =
@@ -960,7 +970,8 @@ let post_process types filters =
 				c.cl_init <- Some (List.fold_left (fun e f -> f e) e filters));
 				c.cl_init <- Some (List.fold_left (fun e f -> f e) e filters));
 		| TEnumDecl _ -> ()
 		| TEnumDecl _ -> ()
 		| TTypeDecl _ -> ()
 		| TTypeDecl _ -> ()
-	) types
+	) types;
+	incr pp_counter
 
 
 (* -------------------------------------------------------------------------- *)
 (* -------------------------------------------------------------------------- *)
 (* STACK MANAGEMENT EMULATION *)
 (* STACK MANAGEMENT EMULATION *)

+ 2 - 2
genswf9.ml

@@ -2208,8 +2208,8 @@ let resource_path name =
 	(["_res"],"_" ^ String.concat "_" (ExtString.String.nsplit name "."))
 	(["_res"],"_" ^ String.concat "_" (ExtString.String.nsplit name "."))
 
 
 let generate_resource ctx name =	
 let generate_resource ctx name =	
-	let c = mk_class (resource_path name) null_pos in
-	c.cl_super <- Some (mk_class (["flash";"utils"],"ByteArray") null_pos,[]);
+	let c = mk_class null_module (resource_path name) null_pos in
+	c.cl_super <- Some (mk_class null_module (["flash";"utils"],"ByteArray") null_pos,[]);
 	let t = TClassDecl c in
 	let t = TClassDecl c in
 	match generate_type ctx t with
 	match generate_type ctx t with
 	| Some (m,f) -> (t,m,f)
 	| Some (m,f) -> (t,m,f)

+ 2 - 2
genxml.ml

@@ -110,9 +110,9 @@ let gen_constr e =
 	) in
 	) in
 	node e.ef_name args t
 	node e.ef_name args t
 
 
-let gen_type_params ipos priv path params pos mpath =
+let gen_type_params ipos priv path params pos m =
 	let mpriv = (if priv then [("private","1")] else []) in
 	let mpriv = (if priv then [("private","1")] else []) in
-	let mpath = (if mpath <> path then [("module",snd (gen_path mpath false))] else []) in
+	let mpath = (if m.m_path <> path then [("module",snd (gen_path m.m_path false))] else []) in
 	let file = (if ipos && pos <> null_pos then [("file",pos.pfile)] else []) in
 	let file = (if ipos && pos <> null_pos then [("file",pos.pfile)] else []) in
 	gen_path path priv :: ("params", String.concat ":" (List.map fst params)) :: (file @ mpriv @ mpath)
 	gen_path path priv :: ("params", String.concat ":" (List.map fst params)) :: (file @ mpriv @ mpath)
 
 

+ 2 - 2
interp.ml

@@ -1771,7 +1771,7 @@ let macro_lib =
 						| name :: l -> if is_ident name then (Ast.EField (loop l,name),p) else (Ast.EType (loop l,name),p)
 						| name :: l -> if is_ident name then (Ast.EField (loop l,name),p) else (Ast.EType (loop l,name),p)
 					in
 					in
 					let t = t_infos t in
 					let t = t_infos t in
-					loop (List.rev (if t.mt_module = t.mt_path then fst t.mt_path @ [snd t.mt_path] else fst t.mt_module @ [snd t.mt_module;snd t.mt_path]))
+					loop (List.rev (if t.mt_module.m_path = t.mt_path then fst t.mt_path @ [snd t.mt_path] else fst t.mt_module.m_path @ [snd t.mt_module.m_path;snd t.mt_path]))
 				in
 				in
 				let rec loop = function
 				let rec loop = function
 					| VNull -> (Ast.EConst (Ast.Ident "null"),p)
 					| VNull -> (Ast.EConst (Ast.Ident "null"),p)
@@ -3502,7 +3502,7 @@ let rec encode_mtype t fields =
 		"pack", enc_array (List.map enc_string (fst i.mt_path));
 		"pack", enc_array (List.map enc_string (fst i.mt_path));
 		"name", enc_string (snd i.mt_path);
 		"name", enc_string (snd i.mt_path);
 		"pos", encode_pos i.mt_pos;
 		"pos", encode_pos i.mt_pos;
-		"module", enc_string (s_type_path i.mt_module);
+		"module", enc_string (s_type_path i.mt_module.m_path);
 		"isPrivate", VBool i.mt_private;
 		"isPrivate", VBool i.mt_private;
 		"meta", encode_meta i.mt_meta (fun m -> i.mt_meta <- m);
 		"meta", encode_meta i.mt_meta (fun m -> i.mt_meta <- m);
 	] @ fields)
 	] @ fields)

+ 16 - 16
main.ml

@@ -393,12 +393,12 @@ and wait_loop boot_com host port =
 			data
 			data
 	);
 	);
 	let cache_module sign m =
 	let cache_module sign m =
-		Hashtbl.replace cache.c_modules (m.Type.mpath,sign) (file_time m.Type.mfile,m);
+		Hashtbl.replace cache.c_modules (m.Type.m_path,sign) (file_time m.Type.m_file,m);
 		List.iter (fun t ->
 		List.iter (fun t ->
 			match t with
 			match t with
 			| Type.TClassDecl c -> c.Type.cl_restore()
 			| Type.TClassDecl c -> c.Type.cl_restore()
 			| _ -> ()
 			| _ -> ()
-		) m.Type.mtypes
+		) m.Type.m_types
 	in
 	in
 	let modules_added = Hashtbl.create 0 in
 	let modules_added = Hashtbl.create 0 in
 	Typeload.type_module_hook := (fun (ctx:Typecore.typer) mpath p ->
 	Typeload.type_module_hook := (fun (ctx:Typecore.typer) mpath p ->
@@ -408,38 +408,38 @@ and wait_loop boot_com host port =
 		let dep = ref None in
 		let dep = ref None in
 		let rec check m =
 		let rec check m =
 			try
 			try
-				Hashtbl.find modules_added m.Type.mpath
+				Hashtbl.find modules_added m.Type.m_path
 			with Not_found -> try
 			with Not_found -> try
-				!(Hashtbl.find modules_checked m.Type.mpath)
+				!(Hashtbl.find modules_checked m.Type.m_path)
 			with Not_found ->
 			with Not_found ->
 			let ok = ref true in
 			let ok = ref true in
-			Hashtbl.add modules_checked m.Type.mpath ok;
+			Hashtbl.add modules_checked m.Type.m_path ok;
 			try
 			try
-				let time, m = Hashtbl.find cache.c_modules (m.Type.mpath,sign) in
-				if m.Type.mfile <> Common.get_full_path (Typeload.resolve_module_file com2 m.Type.mpath (ref[]) p) then raise Not_found;
-				if file_time m.Type.mfile <> time then raise Not_found;
-				PMap.iter (fun m2 _ -> if not (check m2) then begin dep := Some m2; raise Not_found end) !(m.Type.mdeps);
+				let time, m = Hashtbl.find cache.c_modules (m.Type.m_path,sign) in
+				if m.Type.m_file <> Common.get_full_path (Typeload.resolve_module_file com2 m.Type.m_path (ref[]) p) then raise Not_found;
+				if file_time m.Type.m_file <> time then raise Not_found;
+				PMap.iter (fun m2 _ -> if not (check m2) then begin dep := Some m2; raise Not_found end) !(m.Type.m_deps);
 				true
 				true
 			with Not_found ->
 			with Not_found ->
-				Hashtbl.add modules_added m.Type.mpath false;
+				Hashtbl.add modules_added m.Type.m_path false;
 				ok := false;
 				ok := false;
 				!ok
 				!ok
 		in
 		in
 		let rec add_modules m =
 		let rec add_modules m =
-			if Hashtbl.mem modules_added m.Type.mpath then
+			if Hashtbl.mem modules_added m.Type.m_path then
 				()
 				()
 			else begin
 			else begin
-				Hashtbl.add modules_added m.Type.mpath true;
-				if verbose then print_endline ("Reusing  cached module " ^ Ast.s_type_path m.Type.mpath);
+				Hashtbl.add modules_added m.Type.m_path true;
+				if verbose then print_endline ("Reusing  cached module " ^ Ast.s_type_path m.Type.m_path);
 				Typeload.add_module ctx m p;
 				Typeload.add_module ctx m p;
-				PMap.iter (fun m2 _ -> add_modules m2) !(m.Type.mdeps);
+				PMap.iter (fun m2 _ -> add_modules m2) !(m.Type.m_deps);
 			end
 			end
 		in
 		in
 		try
 		try
 			let _, m = Hashtbl.find cache.c_modules (mpath,sign) in
 			let _, m = Hashtbl.find cache.c_modules (mpath,sign) in
 			if com2.dead_code_elimination then raise Not_found;
 			if com2.dead_code_elimination then raise Not_found;
 			if not (check m) then begin
 			if not (check m) then begin
-				if verbose then print_endline ("Skipping cached module " ^ Ast.s_type_path mpath ^ (match !dep with None -> "" | Some m -> "(" ^ Ast.s_type_path m.Type.mpath ^ ")"));
+				if verbose then print_endline ("Skipping cached module " ^ Ast.s_type_path mpath ^ (match !dep with None -> "" | Some m -> "(" ^ Ast.s_type_path m.Type.m_path ^ ")"));
 				raise Not_found;
 				raise Not_found;
 			end;
 			end;
 			add_modules m;
 			add_modules m;
@@ -942,7 +942,7 @@ with
 			try
 			try
 				let ctx = Typer.create com in
 				let ctx = Typer.create com in
 				let m = Typeload.load_module ctx (p,c) Ast.null_pos in
 				let m = Typeload.load_module ctx (p,c) Ast.null_pos in
-				complete_fields (List.map (fun t -> snd (Type.t_path t),"","") (List.filter (fun t -> not (Type.t_infos t).Type.mt_private) m.Type.mtypes))
+				complete_fields (List.map (fun t -> snd (Type.t_path t),"","") (List.filter (fun t -> not (Type.t_infos t).Type.mt_private) m.Type.m_types))
 			with _ ->
 			with _ ->
 				error ctx ("Could not load module " ^ (Ast.s_type_path (p,c))) Ast.null_pos)
 				error ctx ("Could not load module " ^ (Ast.s_type_path (p,c))) Ast.null_pos)
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) ->
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) ->

+ 27 - 12
type.ml

@@ -151,7 +151,7 @@ and metadata = Ast.metadata
 
 
 and tinfos = {
 and tinfos = {
 	mt_path : path;
 	mt_path : path;
-	mt_module : path;
+	mt_module : module_def;
 	mt_pos : Ast.pos;
 	mt_pos : Ast.pos;
 	mt_private : bool;
 	mt_private : bool;
 	mt_doc : Ast.documentation;
 	mt_doc : Ast.documentation;
@@ -160,7 +160,7 @@ and tinfos = {
 
 
 and tclass = {
 and tclass = {
 	mutable cl_path : path;
 	mutable cl_path : path;
-	mutable cl_module : path;
+	mutable cl_module : module_def;
 	mutable cl_pos : Ast.pos;
 	mutable cl_pos : Ast.pos;
 	mutable cl_private : bool;
 	mutable cl_private : bool;
 	mutable cl_doc : Ast.documentation;
 	mutable cl_doc : Ast.documentation;
@@ -196,7 +196,7 @@ and tenum_field = {
 
 
 and tenum = {
 and tenum = {
 	mutable e_path : path;
 	mutable e_path : path;
-	e_module : path;
+	e_module : module_def;
 	e_pos : Ast.pos;
 	e_pos : Ast.pos;
 	e_private : bool;
 	e_private : bool;
 	e_doc : Ast.documentation;
 	e_doc : Ast.documentation;
@@ -210,7 +210,7 @@ and tenum = {
 
 
 and tdef = {
 and tdef = {
 	t_path : path;
 	t_path : path;
-	t_module : path;
+	t_module : module_def;
 	t_pos : Ast.pos;
 	t_pos : Ast.pos;
 	t_private : bool;
 	t_private : bool;
 	t_doc : Ast.documentation;
 	t_doc : Ast.documentation;
@@ -224,17 +224,23 @@ and module_type =
 	| TEnumDecl of tenum
 	| TEnumDecl of tenum
 	| TTypeDecl of tdef
 	| TTypeDecl of tdef
 
 
-type module_def = {
-	mpath : path;
-	mtypes : module_type list;
-	mfile : string;
-	mdeps : (module_def,unit) PMap.t ref;
+and module_def = {
+	m_id : int;
+	m_path : path;
+	m_file : string;
+	mutable m_types : module_type list;
+	mutable m_processed : int;
+	m_deps : (module_def,unit) PMap.t ref;
 }
 }
 
 
 let alloc_var =
 let alloc_var =
 	let uid = ref 0 in
 	let uid = ref 0 in
 	(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false })
 	(fun n t -> incr uid; { v_name = n; v_type = t; v_id = !uid; v_capture = false })
 
 
+let alloc_mid = 
+	let mid = ref 0 in
+	(fun() -> incr mid; !mid)
+
 let mk e t p = { eexpr = e; etype = t; epos = p }
 let mk e t p = { eexpr = e; etype = t; epos = p }
 
 
 let mk_block e =
 let mk_block e =
@@ -252,10 +258,10 @@ let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r)
 
 
 let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
 let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
 
 
-let mk_class path pos =
+let mk_class m path pos =
 	{
 	{
 		cl_path = path;
 		cl_path = path;
-		cl_module = path;
+		cl_module = m;
 		cl_pos = pos;
 		cl_pos = pos;
 		cl_doc = None;
 		cl_doc = None;
 		cl_meta = [];
 		cl_meta = [];
@@ -278,8 +284,17 @@ let mk_class path pos =
 		cl_restore = (fun() -> ());
 		cl_restore = (fun() -> ());
 	}
 	}
 
 
+let null_module = {
+		m_id = alloc_mid();
+		m_path = [] , "";
+		m_types = [];
+		m_file = "";
+		m_processed = 0;
+		m_deps = ref PMap.empty;
+	}
+
 let null_class =
 let null_class =
-	let c = mk_class ([],"") Ast.null_pos in
+	let c = mk_class null_module ([],"") Ast.null_pos in
 	c.cl_private <- true;
 	c.cl_private <- true;
 	c
 	c
 
 

+ 29 - 26
typeload.ml

@@ -77,9 +77,9 @@ let rec load_type_def ctx p t =
 				let m = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let m = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let tpath = (t.tpackage,tname) in
 				let tpath = (t.tpackage,tname) in
 				try
 				try
-					List.find (fun t -> not (t_infos t).mt_private && t_path t = tpath) m.mtypes
+					List.find (fun t -> not (t_infos t).mt_private && t_path t = tpath) m.m_types
 				with
 				with
-					Not_found -> raise (Error (Type_not_found (m.mpath,tname),p))
+					Not_found -> raise (Error (Type_not_found (m.m_path,tname),p))
 			in
 			in
 			let rec loop = function
 			let rec loop = function
 				| [] -> raise Exit
 				| [] -> raise Exit
@@ -92,7 +92,7 @@ let rec load_type_def ctx p t =
 			in
 			in
 			try
 			try
 				if not no_pack then raise Exit;
 				if not no_pack then raise Exit;
-				(match fst ctx.current.mpath with
+				(match fst ctx.current.m_path with
 				| [] -> raise Exit
 				| [] -> raise Exit
 				| x :: _ ->
 				| x :: _ ->
 					(* this can occur due to haxe remoting : a module can be
 					(* this can occur due to haxe remoting : a module can be
@@ -103,7 +103,7 @@ let rec load_type_def ctx p t =
 						| Forbidden -> raise Exit
 						| Forbidden -> raise Exit
 						| _ -> ())
 						| _ -> ())
 					with Not_found -> ());
 					with Not_found -> ());
-				loop (List.rev (fst ctx.current.mpath));
+				loop (List.rev (fst ctx.current.m_path));
 			with
 			with
 				Exit -> next()
 				Exit -> next()
 
 
@@ -150,7 +150,7 @@ let rec load_instance ctx t p allow_no_params =
 						| EConst (Float f) -> "F" ^ f
 						| EConst (Float f) -> "F" ^ f
 						| _ -> "Expr"
 						| _ -> "Expr"
 					) in
 					) in
-					let c = mk_class ([],name) p in
+					let c = mk_class null_module ([],name) p in
 					c.cl_kind <- KExpr e;
 					c.cl_kind <- KExpr e;
 					TInst (c,[])
 					TInst (c,[])
 				| TPType t -> load_complex_type ctx p t
 				| TPType t -> load_complex_type ctx p t
@@ -187,7 +187,7 @@ and load_complex_type ctx p t =
 			let rec loop t =
 			let rec loop t =
 				match follow t with
 				match follow t with
 				| TInst (c,tl) ->
 				| TInst (c,tl) ->
-					let c2 = mk_class (fst c.cl_path,"+" ^ snd c.cl_path) p in
+					let c2 = mk_class null_module (fst c.cl_path,"+" ^ snd c.cl_path) p in
 					c2.cl_private <- true;
 					c2.cl_private <- true;
 					PMap.iter (fun f _ ->
 					PMap.iter (fun f _ ->
 						try
 						try
@@ -281,7 +281,7 @@ and load_complex_type ctx p t =
 let hide_types ctx =
 let hide_types ctx =
 	let old_locals = ctx.local_types in
 	let old_locals = ctx.local_types in
 	let old_type_params = ctx.type_params in
 	let old_type_params = ctx.type_params in
-	ctx.local_types <- ctx.g.std.mtypes;
+	ctx.local_types <- ctx.g.std.m_types;
 	ctx.type_params <- [];
 	ctx.type_params <- [];
 	(fun() ->
 	(fun() ->
 		ctx.local_types <- old_locals;
 		ctx.local_types <- old_locals;
@@ -530,7 +530,7 @@ let set_heritance ctx c herits p =
 	List.iter loop (List.filter (ctx.g.do_inherit ctx c p) herits)
 	List.iter loop (List.filter (ctx.g.do_inherit ctx c p) herits)
 
 
 let type_type_params ctx path get_params p (n,flags) =
 let type_type_params ctx path get_params p (n,flags) =
-	let c = mk_class (fst path @ [snd path],n) p in
+	let c = mk_class ctx.current (fst path @ [snd path],n) p in
 	c.cl_kind <- KTypeParameter;
 	c.cl_kind <- KTypeParameter;
 	let t = TInst (c,[]) in
 	let t = TInst (c,[]) in
 	match flags with
 	match flags with
@@ -1152,14 +1152,14 @@ let add_module ctx m p =
 		let t = t_infos t in
 		let t = t_infos t in
 		try
 		try
 			let m2 = Hashtbl.find ctx.g.types_module t.mt_path in
 			let m2 = Hashtbl.find ctx.g.types_module t.mt_path in
-			if m.mpath <> m2 && String.lowercase (s_type_path m2) = String.lowercase (s_type_path m.mpath) then error ("Module " ^ s_type_path m2 ^ " is loaded with a different case than " ^ s_type_path m.mpath) p;
+			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
 			error ("Type name " ^ s_type_path t.mt_path ^ " is redefined from module " ^ s_type_path m2) p
 		with
 		with
 			Not_found ->
 			Not_found ->
-				Hashtbl.add ctx.g.types_module t.mt_path m.mpath
+				Hashtbl.add ctx.g.types_module t.mt_path m.m_path
 	in
 	in
-	List.iter decl_type m.mtypes;
-	Hashtbl.add ctx.g.modules m.mpath m
+	List.iter decl_type m.m_types;
+	Hashtbl.add ctx.g.modules m.m_path m
 
 
 let type_module ctx m file tdecls loadp =
 let type_module ctx m file tdecls loadp =
 	(* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
 	(* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
@@ -1168,13 +1168,21 @@ let type_module ctx m file tdecls loadp =
 		if List.exists (fun t -> snd (t_path t) = name) (!decls) then error ("Type name " ^ name ^ " is already defined in this module") loadp;
 		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 m @ ["_" ^ snd m], name) else (fst m, name)
 		if priv then (fst m @ ["_" ^ snd m], name) else (fst m, name)
 	in
 	in
+	let m = {
+		m_id = alloc_mid();
+		m_path = m;
+		m_types = [];
+		m_file = Common.get_full_path file;
+		m_deps = ref PMap.empty;
+		m_processed = 0;
+	} in
 	List.iter (fun (d,p) ->
 	List.iter (fun (d,p) ->
 		match d with
 		match d with
 		| EImport _ | EUsing _ -> ()
 		| EImport _ | EUsing _ -> ()
 		| EClass d ->
 		| EClass d ->
 			let priv = List.mem HPrivate d.d_flags in
 			let priv = List.mem HPrivate d.d_flags in
 			let path = make_path d.d_name priv in
 			let path = make_path d.d_name priv in
-			let c = mk_class path p in
+			let c = mk_class m path p in
 			c.cl_module <- m;
 			c.cl_module <- m;
 			c.cl_private <- priv;
 			c.cl_private <- priv;
 			c.cl_doc <- d.d_doc;
 			c.cl_doc <- d.d_doc;
@@ -1211,12 +1219,7 @@ let type_module ctx m file tdecls loadp =
 			} in
 			} in
 			decls := TTypeDecl t :: !decls
 			decls := TTypeDecl t :: !decls
 	) tdecls;
 	) tdecls;
-	let m = {
-		mpath = m;
-		mtypes = List.rev !decls;
-		mfile = Common.get_full_path file;
-		mdeps = ref PMap.empty;
-	} in
+	m.m_types <- List.rev !decls;
 	add_module ctx m loadp;
 	add_module ctx m loadp;
 	(* PASS 2 : build types structure - does not type any expression ! *)
 	(* PASS 2 : build types structure - does not type any expression ! *)
 	let ctx = {
 	let ctx = {
@@ -1228,7 +1231,7 @@ let type_module ctx m file tdecls loadp =
 		ret = ctx.ret;
 		ret = ctx.ret;
 		current = m;
 		current = m;
 		locals = PMap.empty;
 		locals = PMap.empty;
-		local_types = ctx.g.std.mtypes @ m.mtypes;
+		local_types = ctx.g.std.m_types @ m.m_types;
 		local_using = [];
 		local_using = [];
 		type_params = [];
 		type_params = [];
 		curmethod = "";
 		curmethod = "";
@@ -1244,15 +1247,15 @@ let type_module ctx m file tdecls loadp =
 	} in
 	} in
 	let delays = ref [] in
 	let delays = ref [] in
 	let get_class name =
 	let get_class name =
-		let c = List.find (fun d -> match d with TClassDecl { cl_path = _ , n } -> n = name | _ -> false) m.mtypes in
+		let c = List.find (fun d -> match d with TClassDecl { cl_path = _ , n } -> n = name | _ -> false) m.m_types in
 		match c with TClassDecl c -> c | _ -> assert false
 		match c with TClassDecl c -> c | _ -> assert false
 	in
 	in
 	let get_enum name =
 	let get_enum name =
-		let e = List.find (fun d -> match d with TEnumDecl { e_path = _ , n } -> n = name | _ -> false) m.mtypes in
+		let e = List.find (fun d -> match d with TEnumDecl { e_path = _ , n } -> n = name | _ -> false) m.m_types in
 		match e with TEnumDecl e -> e | _ -> assert false
 		match e with TEnumDecl e -> e | _ -> assert false
 	in
 	in
 	let get_tdef name =
 	let get_tdef name =
-		let s = List.find (fun d -> match d with TTypeDecl { t_path = _ , n } -> n = name | _ -> false) m.mtypes in
+		let s = List.find (fun d -> match d with TTypeDecl { t_path = _ , n } -> n = name | _ -> false) m.m_types in
 		match s with TTypeDecl s -> s | _ -> assert false
 		match s with TTypeDecl s -> s | _ -> assert false
 	in
 	in
 	(* here is an additional PASS 1 phase, which handle the type parameters declaration, with lazy contraints *)
 	(* here is an additional PASS 1 phase, which handle the type parameters declaration, with lazy contraints *)
@@ -1276,7 +1279,7 @@ let type_module ctx m file tdecls loadp =
 			(match t.tsub with
 			(match t.tsub with
 			| None ->
 			| None ->
 				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
-				let types = List.filter (fun t -> not (t_infos t).mt_private) md.mtypes in
+				let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in
 				ctx.local_types <- ctx.local_types @ types
 				ctx.local_types <- ctx.local_types @ types
 			| Some _ ->
 			| Some _ ->
 				let t = load_type_def ctx p t in
 				let t = load_type_def ctx p t in
@@ -1286,7 +1289,7 @@ let type_module ctx m file tdecls loadp =
 			(match t.tsub with
 			(match t.tsub with
 			| None ->
 			| None ->
 				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
 				let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
-				let types = List.filter (fun t -> not (t_infos t).mt_private) md.mtypes in
+				let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in
 				ctx.local_using <- ctx.local_using @ (List.map (resolve_typedef ctx) types);
 				ctx.local_using <- ctx.local_using @ (List.map (resolve_typedef ctx) types);
 			| Some _ ->
 			| Some _ ->
 				let t = load_type_def ctx p t in
 				let t = load_type_def ctx p t in
@@ -1450,5 +1453,5 @@ let load_module ctx m p =
 			) in
 			) in
 			type_module ctx m file decls p
 			type_module ctx m file decls p
 	) in
 	) in
-	ctx.current.mdeps := PMap.add m2 () !(ctx.current.mdeps);
+	ctx.current.m_deps := PMap.add m2 () !(ctx.current.m_deps);
 	m2
 	m2

+ 17 - 23
typer.ml

@@ -217,7 +217,7 @@ let rec type_module_type ctx t tparams p =
 	| TClassDecl c ->
 	| TClassDecl c ->
 		let t_tmp = {
 		let t_tmp = {
 			t_path = fst c.cl_path, "#" ^ snd c.cl_path;
 			t_path = fst c.cl_path, "#" ^ snd c.cl_path;
-			t_module = c.cl_path;
+			t_module = c.cl_module;
 			t_doc = None;
 			t_doc = None;
 			t_pos = c.cl_pos;
 			t_pos = c.cl_pos;
 			t_type = TAnon {
 			t_type = TAnon {
@@ -251,7 +251,7 @@ let rec type_module_type ctx t tparams p =
 		) e.e_constrs PMap.empty in
 		) e.e_constrs PMap.empty in
 		let t_tmp = {
 		let t_tmp = {
 			t_path = fst e.e_path, "#" ^ snd e.e_path;
 			t_path = fst e.e_path, "#" ^ snd e.e_path;
-			t_module = e.e_path;
+			t_module = e.e_module;
 			t_doc = None;
 			t_doc = None;
 			t_pos = e.e_pos;
 			t_pos = e.e_pos;
 			t_type = TAnon {
 			t_type = TAnon {
@@ -1274,12 +1274,12 @@ and type_access ctx e p mode =
 								let md = Typeload.load_module ctx m p in
 								let md = Typeload.load_module ctx m p in
 								(* first look for existing subtype *)
 								(* first look for existing subtype *)
 								(try
 								(try
-									let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = (fst m,sname)) md.mtypes in
+									let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = (fst m,sname)) md.m_types in
 									Some (fields path (fun _ -> AKExpr (type_module_type ctx t None p)))
 									Some (fields path (fun _ -> AKExpr (type_module_type ctx t None p)))
 								with Not_found -> try
 								with Not_found -> try
 								(* then look for main type statics *)
 								(* then look for main type statics *)
 									if fst m = [] then raise Not_found; (* ensure that we use def() to resolve local types first *)
 									if fst m = [] then raise Not_found; (* ensure that we use def() to resolve local types first *)
-									let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = m) md.mtypes in
+									let t = List.find (fun t -> not (t_infos t).mt_private && t_path t = m) md.m_types in
 									Some (get_static t)
 									Some (get_static t)
 								with Not_found ->
 								with Not_found ->
 									None)
 									None)
@@ -1295,7 +1295,7 @@ and type_access ctx e p mode =
 								| _ :: l -> loop (List.rev l)
 								| _ :: l -> loop (List.rev l)
 						in
 						in
 						(match pack with
 						(match pack with
-						| [] -> loop (fst ctx.current.mpath)
+						| [] -> loop (fst ctx.current.m_path)
 						| _ ->
 						| _ ->
 							match check_module (pack,name) sname with
 							match check_module (pack,name) sname with
 							| Some r -> r
 							| Some r -> r
@@ -1970,7 +1970,7 @@ let dce_finalize ctx =
 			match t with
 			match t with
 			| TClassDecl c -> check_class c
 			| TClassDecl c -> check_class c
 			| _ -> ()
 			| _ -> ()
-		) m.mtypes
+		) m.m_types
 	) ctx.g.modules
 	) ctx.g.modules
 
 
 (*
 (*
@@ -2005,7 +2005,7 @@ let dce_optimize ctx =
 			match t with
 			match t with
 			| TClassDecl c -> check_class c
 			| TClassDecl c -> check_class c
 			| _ -> ()
 			| _ -> ()
-		) m.mtypes
+		) m.m_types
 	) ctx.g.modules
 	) ctx.g.modules
 
 
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
@@ -2054,7 +2054,6 @@ type state =
 
 
 let generate ctx =
 let generate ctx =
 	let types = ref [] in
 	let types = ref [] in
-	let modules = ref [] in
 	let states = Hashtbl.create 0 in
 	let states = Hashtbl.create 0 in
 	let state p = try Hashtbl.find states p with Not_found -> NotYet in
 	let state p = try Hashtbl.find states p with Not_found -> NotYet in
 	let statics = ref PMap.empty in
 	let statics = ref PMap.empty in
@@ -2159,8 +2158,9 @@ let generate ctx =
 		) c.cl_statics
 		) c.cl_statics
 
 
 	in
 	in
-	Hashtbl.iter (fun _ m -> modules := m :: !modules; List.iter loop m.mtypes) ctx.g.modules;
-	get_main ctx, List.rev !types, List.rev !modules
+	let sorted_modules = List.sort (fun m1 m2 -> compare m1.m_file m2.m_file) (Hashtbl.fold (fun _ m acc -> m :: acc) ctx.g.modules []) in	
+	List.iter (fun m -> List.iter loop m.m_types) sorted_modules;
+	get_main ctx, List.rev !types, sorted_modules
 
 
 (* ---------------------------------------------------------------------- *)
 (* ---------------------------------------------------------------------- *)
 (* MACROS *)
 (* MACROS *)
@@ -2256,7 +2256,7 @@ let make_macro_api ctx p =
 		Interp.get_module = (fun s ->
 		Interp.get_module = (fun s ->
 			typing_timer ctx (fun() ->
 			typing_timer ctx (fun() ->
 				let path = parse_path s in
 				let path = parse_path s in
-				List.map make_instance (Typeload.load_module ctx path p).mtypes
+				List.map make_instance (Typeload.load_module ctx path p).m_types
 			)
 			)
 		);
 		);
 		Interp.on_generate = (fun f ->
 		Interp.on_generate = (fun f ->
@@ -2423,7 +2423,7 @@ let load_macro ctx cpath f p =
 	) in
 	) in
 	let mctx = Interp.get_ctx() in
 	let mctx = Interp.get_ctx() in
 	let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
 	let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
-	ctx2.local_types <- (Typeload.load_module ctx2 m p).mtypes;
+	ctx2.local_types <- (Typeload.load_module ctx2 m p).m_types;
 	let meth = (match Typeload.load_instance ctx2 { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = None } p true with
 	let meth = (match Typeload.load_instance ctx2 { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = None } p true with
 		| TInst (c,_) -> (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
 		| TInst (c,_) -> (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
 		| _ -> error "Macro should be called on a class" p
 		| _ -> error "Macro should be called on a class" p
@@ -2587,12 +2587,6 @@ let call_init_macro ctx e =
 (* TYPER INITIALIZATION *)
 (* TYPER INITIALIZATION *)
 
 
 let rec create com =
 let rec create com =
-	let empty =	{
-		mpath = [] , "";
-		mtypes = [];
-		mfile = "";
-		mdeps = ref PMap.empty;
-	} in
 	let ctx = {
 	let ctx = {
 		com = com;
 		com = com;
 		t = com.basic;
 		t = com.basic;
@@ -2606,7 +2600,7 @@ let rec create com =
 			doinline = not (Common.defined com "no_inline" || com.display);
 			doinline = not (Common.defined com "no_inline" || com.display);
 			hook_generate = [];
 			hook_generate = [];
 			get_build_infos = (fun() -> None);
 			get_build_infos = (fun() -> None);
-			std = empty;
+			std = null_module;
 			do_inherit = Codegen.on_inherit;
 			do_inherit = Codegen.on_inherit;
 			do_create = create;
 			do_create = create;
 			do_macro = type_macro;
 			do_macro = type_macro;
@@ -2628,7 +2622,7 @@ let rec create com =
 		curmethod = "";
 		curmethod = "";
 		curclass = null_class;
 		curclass = null_class;
 		tthis = mk_mono();
 		tthis = mk_mono();
-		current = empty;
+		current = null_module;
 		opened = [];
 		opened = [];
 		param_type = None;
 		param_type = None;
 		vthis = None;
 		vthis = None;
@@ -2657,13 +2651,13 @@ let rec create com =
 				let cpp = platform com Cpp in
 				let cpp = platform com Cpp in
 				ctx.t.tnull <- if not (f9 || cpp) then (fun t -> t) else (fun t -> if is_nullable t then TType (td,[t]) else t);
 				ctx.t.tnull <- if not (f9 || cpp) then (fun t -> t) else (fun t -> if is_nullable t then TType (td,[t]) else t);
 			| _ -> ());
 			| _ -> ());
-	) ctx.g.std.mtypes;
+	) ctx.g.std.m_types;
 	let m = Typeload.load_module ctx ([],"String") null_pos in
 	let m = Typeload.load_module ctx ([],"String") null_pos in
-	(match m.mtypes with
+	(match m.m_types with
 	| [TClassDecl c] -> ctx.t.tstring <- TInst (c,[])
 	| [TClassDecl c] -> ctx.t.tstring <- TInst (c,[])
 	| _ -> assert false);
 	| _ -> assert false);
 	let m = Typeload.load_module ctx ([],"Array") null_pos in
 	let m = Typeload.load_module ctx ([],"Array") null_pos in
-	(match m.mtypes with
+	(match m.m_types with
 	| [TClassDecl c] -> ctx.t.tarray <- (fun t -> TInst (c,[t]))
 	| [TClassDecl c] -> ctx.t.tarray <- (fun t -> TInst (c,[t]))
 	| _ -> assert false);
 	| _ -> assert false);
 	ctx
 	ctx