浏览代码

finalized new pass system : less passes, use cl_build and module lazyness

Nicolas Cannasse 13 年之前
父节点
当前提交
75f06203c2
共有 4 个文件被更改,包括 296 次插入221 次删除
  1. 4 4
      codegen.ml
  2. 57 35
      typecore.ml
  3. 214 163
      typeload.ml
  4. 21 19
      typer.ml

+ 4 - 4
codegen.ml

@@ -186,7 +186,7 @@ let extend_remoting ctx c t p async prot =
 		| _ -> d
 	) decls in
 	let m = Typeload.type_module ctx (t.tpackage,new_name) file decls p in
-	add_dependency ctx.current m;
+	add_dependency ctx.m.curmod m;
 	try
 		List.find (fun tdecl -> snd (t_path tdecl) = new_name) m.m_types
 	with Not_found ->
@@ -271,7 +271,7 @@ let rec build_generic ctx c p tl =
 			()
 	in
 	List.iter check_recursive tl;
-	let gctx = make_generic ctx c.cl_types tl p in
+	let gctx = try make_generic ctx c.cl_types tl p with Generic_Exception (msg,p) -> error msg p in
 	let name = (snd c.cl_path) ^ "_" ^ gctx.name in
 	if !recurse then begin
 		if not (has_meta ":?genericRec" c.cl_meta) then c.cl_meta <- (":?genericRec",[],p) :: c.cl_meta;
@@ -280,7 +280,7 @@ let rec build_generic ctx c p tl =
 		Typeload.load_instance ctx { tpackage = pack; tname = name; tparams = []; tsub = None } p false
 	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 ctx = { ctx with local_types = m.m_types @ ctx.local_types } in
+		let ctx = { ctx with m = { ctx.m with module_types = m.m_types @ ctx.m.module_types } } in
 		let mg = {
 			m_id = alloc_mid();
 			m_path = (pack,name);
@@ -291,7 +291,7 @@ let rec build_generic ctx c p tl =
 		mg.m_types <- [TClassDecl cg];
 		Hashtbl.add ctx.g.modules mg.m_path mg;
 		add_dependency mg m;
-		add_dependency ctx.current mg;
+		add_dependency ctx.m.curmod mg;
 		(* ensure that type parameters are set in dependencies *)
 		let dep_stack = ref [] in
 		let rec loop t =

+ 57 - 35
typecore.ml

@@ -39,11 +39,7 @@ type macro_mode =
 
 type typer_pass =
 	| PBuildModule			(* build the module structure and setup module type parameters *)
-	| PInitModuleTypes		(* load imports and set typedefs : dont follow types ! *)
-	| PResolveTypedefs		(* using and other functions that need to follow typededs *)
-	| PSetInherit			(* build the class extends/implements *)
 	| PBuildClass			(* build the class structure *)
-	| PDefineConstructor	(* add an inherited constructor *)
 	| PTypeField			(* type the class field, allow access to types structures *)
 	| PCheckConstraint		(* perform late constraint checks with inferred types *)
 	| PForce				(* usually ensure that lazy have been evaluated *)
@@ -70,19 +66,21 @@ type typer_globals = {
 	do_build_instance : typer -> module_type -> pos -> ((string * t) list * path * (t list -> t));
 }
 
+and typer_module = {
+	curmod : module_def;
+	mutable module_types : module_type list;
+	mutable module_using : tclass list;
+}
+
 and typer = {
 	(* shared *)
 	com : context;
-	mutable pass : typer_pass;
-	mutable t : basic_types;
+	t : basic_types;
 	g : typer_globals;
-	mutable in_macro : bool;
-	mutable macro_depth : int;
-	mutable on_error : typer -> string -> pos -> unit;
+	(* variable *)
+	mutable pass : typer_pass;
 	(* per-module *)
-	current : module_def;
-	mutable local_types : module_type list;
-	mutable local_using : tclass list;
+	mutable m : typer_module;
 	(* per-class *)
 	mutable curclass : tclass;
 	mutable tthis : t;
@@ -93,12 +91,16 @@ and typer = {
 	mutable in_super_call : bool;
 	mutable in_loop : bool;
 	mutable in_display : bool;
+	mutable in_macro : bool;
+	mutable macro_depth : int;
 	mutable curfun : current_fun;
 	mutable ret : t;
 	mutable locals : (string, tvar) PMap.t;
 	mutable opened : anon_status ref list;
 	mutable param_type : t option;
 	mutable vthis : tvar option;
+	(* events *)
+	mutable on_error : typer -> string -> pos -> unit;
 }
 
 type error_msg =
@@ -174,11 +176,7 @@ let rec error_msg = function
 
 let pass_name = function
 	| PBuildModule -> "build-module"
-	| PInitModuleTypes -> "init-types"
-	| PResolveTypedefs -> "resolve-types"
-	| PSetInherit -> "set-inherit"
 	| PBuildClass -> "build-class"
-	| PDefineConstructor -> "define-constructor"
 	| PTypeField -> "type-field"
 	| PCheckConstraint -> "check-constraint"
 	| PForce -> "force"
@@ -262,6 +260,17 @@ let rec flush_pass ctx p (where:string) =
 
 let make_pass ctx f = f
 
+let exc_protect ctx f (where:string) =
+	let rec r = ref (fun() ->
+		try
+			f r
+		with
+			| Error (m,p) ->
+				display_error ctx (error_msg m) p;
+				raise Fatal_error
+	) in
+	r
+
 let fake_modules = Hashtbl.create 0
 let create_fake_module ctx file =
 	let file = Common.unique_full_path file in
@@ -294,11 +303,14 @@ let context_ident ctx =
 let debug ctx str =
 	if Common.defined ctx.com "cdebug" then prerr_endline (context_ident ctx ^ !delay_tabs ^ str)
 
-let pass_infos ctx p =
-	let inf = Ast.s_type_path ctx.current.m_path in
-	let inf = (match snd ctx.curclass.cl_path with "" -> inf | n when n = snd ctx.current.m_path -> inf | n -> inf ^ "." ^ n) in
+let ctx_pos ctx =
+	let inf = Ast.s_type_path ctx.m.curmod.m_path in
+	let inf = (match snd ctx.curclass.cl_path with "" -> inf | n when n = snd ctx.m.curmod.m_path -> inf | n -> inf ^ "." ^ n) in
 	let inf = (match ctx.curfield.cf_name with "" -> inf | n -> inf ^ ":" ^ n) in
-	let inf = pass_name p ^ " ("  ^ inf ^ ")" in
+	inf
+
+let pass_infos ctx p =
+	let inf = pass_name p ^ " ("  ^ ctx_pos ctx ^ ")" in
 	let inf = if ctx.pass > p then inf ^ " ??CURPASS=" ^ pass_name ctx.pass else inf in
 	inf
 
@@ -315,7 +327,7 @@ let delay ctx p f =
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 	in
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
-	if p <> PForce then debug ctx ("add " ^ inf)
+	debug ctx ("add " ^ inf)
 
 let pending_passes ctx =
 	let rec loop acc = function
@@ -330,13 +342,23 @@ let display_error ctx msg p =
 	debug ctx ("ERROR " ^ msg);
 	display_error ctx msg p
 
-let make_pass ctx f =
-	let inf = pass_infos ctx ctx.pass in
+let make_pass ?inf ctx f =
+	let inf = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in
 	(fun v ->
 		debug ctx ("run " ^ inf ^ pending_passes ctx);
 		let old = !delay_tabs in
 		delay_tabs := !delay_tabs ^ "\t";
-		let t = f v in
+		let t = (try
+			f v
+		with
+			| Fatal_error ->
+				delay_tabs := old;
+				raise Fatal_error
+			| exc when not (Common.defined ctx.com "stack") ->
+				debug ctx ("FATAL " ^ Printexc.to_string exc);
+				delay_tabs := old;
+				raise exc
+		) in
 		delay_tabs := old;
 		t
 	)
@@ -350,14 +372,9 @@ let rec flush_pass ctx p where =
 				ctx.g.debug_delayed <- rest
 			| (f,inf,ctx2) :: l ->
 				ctx.g.debug_delayed <- (p2,l) :: rest;
-				let old = !delay_tabs in
-				(match p2 with
-				| PForce | PTypeField | PBuildClass -> ()
-				| _ ->
-					debug ctx ("run " ^ inf ^ pending_passes ctx2);
-					delay_tabs := !delay_tabs ^ "\t");
-				(try f() with Fatal_error -> delay_tabs := old; raise Fatal_error | exc when not (Common.defined ctx.com "stack") -> debug ctx ("FATAL " ^ Printexc.to_string exc); delay_tabs := old; raise exc);
-				delay_tabs := old);
+				match p2 with
+				| PTypeField | PBuildClass -> f()
+				| _ -> (make_pass ~inf ctx f)());
 			loop()
 		| _ ->
 			()
@@ -372,12 +389,12 @@ let rec flush_pass ctx p where =
 		debug ctx "flush-done";
 	| _ ->
 		()
-*/*)
-(* --------------------------------------------------- *)
 
+let make_where ctx where =
+	where ^ " (" ^ ctx_pos ctx ^ ")"
 
 let exc_protect ctx f (where:string) =
-	let f = make_pass ctx f in
+	let f = make_pass ~inf:(make_where ctx where) ctx f in
 	let rec r = ref (fun() ->
 		try
 			f r
@@ -387,3 +404,8 @@ let exc_protect ctx f (where:string) =
 				raise Fatal_error
 	) in
 	r
+
+*/*)
+(* --------------------------------------------------- *)
+
+

+ 214 - 163
typeload.ml

@@ -21,6 +21,84 @@ open Type
 open Common
 open Typecore
 
+(*
+	Build module structure : should be atomic - no type loading is possible
+*)
+let make_module ctx mpath file 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)
+	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
+	List.iter (fun decl ->
+		let p = snd decl in
+		match fst decl with
+		| EImport _ | EUsing _ -> ()
+		| EClass d ->
+			let priv = List.mem HPrivate d.d_flags in
+			let path = make_path d.d_name priv in
+			let c = mk_class m path p in
+			c.cl_module <- m;
+			c.cl_private <- priv;
+			c.cl_doc <- d.d_doc;
+			c.cl_meta <- d.d_meta;
+			decls := (TClassDecl c, decl) :: !decls
+		| EEnum d ->
+			let priv = List.mem EPrivate d.d_flags in
+			let path = make_path d.d_name priv in
+			let e = {
+				e_path = path;
+				e_module = m;
+				e_pos = p;
+				e_doc = d.d_doc;
+				e_meta = d.d_meta;
+				e_types = [];
+				e_private = priv;
+				e_extern = List.mem EExtern d.d_flags;
+				e_constrs = PMap.empty;
+				e_names = [];
+			} in
+			decls := (TEnumDecl e, decl) :: !decls
+		| ETypedef d ->
+			let priv = List.mem EPrivate d.d_flags in
+			let path = make_path d.d_name priv in
+			let t = {
+				t_path = path;
+				t_module = m;
+				t_pos = p;
+				t_doc = d.d_doc;
+				t_private = priv;
+				t_types = [];
+				t_type = mk_mono();
+				t_meta = d.d_meta;
+			} in
+			decls := (TTypeDecl t, decl) :: !decls
+	   | EAbstract d ->
+			let priv = List.mem APrivAbstract d.d_flags in
+			let path = make_path d.d_name priv in
+			let a = {
+				a_path = path;
+				a_private = priv;
+				a_module = m;
+				a_pos = p;
+				a_doc = d.d_doc;
+				a_types = [];
+				a_meta = d.d_meta;
+				a_sub = [];
+				a_super = [];
+			} in
+			decls := (TAbstractDecl a, decl) :: !decls
+	) tdecls;
+	let decls = List.rev !decls in
+	m.m_types <- List.map fst decls;
+	m, decls
+
 let parse_file com file p =
 	let ch = (try open_in_bin file with _ -> error ("Could not open " ^ file) p) in
 	let t = Common.timer "parsing" in
@@ -72,7 +150,7 @@ let rec load_type_def ctx p t =
 		List.find (fun t2 ->
 			let tp = t_path t2 in
 			tp = (t.tpackage,tname) || (no_pack && snd tp = tname)
-		) ctx.local_types
+		) ctx.m.module_types
 	with
 		Not_found ->
 			let next() =
@@ -102,7 +180,7 @@ let rec load_type_def ctx p t =
 			in
 			try
 				if not no_pack then raise Exit;
-				(match fst ctx.current.m_path with
+				(match fst ctx.m.curmod.m_path with
 				| [] -> raise Exit
 				| x :: _ ->
 					(* this can occur due to haxe remoting : a module can be
@@ -113,7 +191,7 @@ let rec load_type_def ctx p t =
 						| Forbidden -> raise Exit
 						| _ -> ())
 					with Not_found -> ());
-				loop (List.rev (fst ctx.current.m_path));
+				loop (List.rev (fst ctx.m.curmod.m_path));
 			with
 				Exit -> next()
 
@@ -234,7 +312,6 @@ and load_complex_type ctx p t =
 			let t = TMono tr in
 			let r = exc_protect ctx (fun r ->
 				r := (fun _ -> t);
-				flush_pass ctx PInitModuleTypes "ct_extend";
 				tr := Some (loop i);
 				t
 			) "constraint" in
@@ -335,12 +412,12 @@ and init_meta_overloads ctx cf =
 	cf.cf_overloads <- List.map (fun (args,ret,params) -> { cf with cf_type = TFun (args,ret); cf_params = params }) (List.rev !overloads)
 
 let hide_types ctx =
-	let old_locals = ctx.local_types in
+	let old_m = ctx.m in
 	let old_type_params = ctx.type_params in
-	ctx.local_types <- ctx.g.std.m_types;
+	ctx.m <- { curmod = ctx.g.std; module_types = ctx.g.std.m_types; module_using = [] };
 	ctx.type_params <- [];
 	(fun() ->
-		ctx.local_types <- old_locals;
+		ctx.m <- old_m;
 		ctx.type_params <- old_type_params;
 	)
 
@@ -428,7 +505,8 @@ let copy_meta meta_src meta_target sl =
 	) meta_src;
 	!meta
 
-let check_overriding ctx c p =
+let check_overriding ctx c =
+	let p = c.cl_pos in
 	match c.cl_super with
 	| None ->
 		(match c.cl_overrides with
@@ -481,7 +559,8 @@ let class_field_no_interf c i =
 			let t , f = raw_class_field (fun f -> f.cf_type) c i in
 			apply_params c.cl_types tl t , f
 
-let rec check_interface ctx c p intf params =
+let rec check_interface ctx c intf params =
+	let p = c.cl_pos in
 	PMap.iter (fun i f ->
 		try
 			let t2, f2 = class_field_no_interf c i in
@@ -507,14 +586,14 @@ let rec check_interface ctx c p intf params =
 				if not c.cl_interface then display_error ctx ("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") p
 	) intf.cl_fields;
 	List.iter (fun (i2,p2) ->
-		check_interface ctx c p i2 (List.map (apply_params intf.cl_types params) p2)
+		check_interface ctx c i2 (List.map (apply_params intf.cl_types params) p2)
 	) intf.cl_implements
 
-let check_interfaces ctx c p =
+let check_interfaces ctx c =
 	match c.cl_path with
 	| "Proxy" :: _ , _ -> ()
 	| _ ->
-	List.iter (fun (intf,params) -> check_interface ctx c p intf params) c.cl_implements
+	List.iter (fun (intf,params) -> check_interface ctx c intf params) c.cl_implements
 
 let rec return_flow ctx e =
 	let error() = display_error ctx "A return is missing here" e.epos; raise Exit in
@@ -561,14 +640,16 @@ let rec return_flow ctx e =
 (* PASS 1 & 2 : Module and Class Structure *)
 
 let set_heritance ctx c herits p =
-	let ctx = { ctx with curclass = c; type_params = c.cl_types; pass = PSetInherit } in
+	let ctx = { ctx with curclass = c; type_params = c.cl_types; } in
 	let process_meta csup =
 		List.iter (fun m ->
 			match m with
 			| ":final", _, _ -> if not (Type.has_meta ":hack" c.cl_meta || (match c.cl_kind with KTypeParameter _ -> true | _ -> false)) then error "Cannot extend a final class" p;
+			| ":autoBuild", el, p -> c.cl_meta <- (":build",el,p) :: m :: c.cl_meta
 			| _ -> ()
 		) csup.cl_meta
 	in
+	let has_interf = ref false in
 	let rec loop = function
 		| HPrivate | HExtern | HInterface ->
 			()
@@ -582,6 +663,7 @@ let set_heritance ctx c herits p =
 			| TInst ({ cl_path = [],"Xml" },_) when ((not (platform ctx.com Cpp)) && (match c.cl_path with "mt" :: _ , _ -> false | _ -> true)) ->
 				error "Cannot extend basic class" p;
 			| TInst (csup,params) ->
+				csup.cl_build();
 				if is_parent c csup then error "Recursive class" p;
 				if c.cl_interface then error "Cannot extend an interface" p;
 				if csup.cl_interface then error "Cannot extend by using an interface" p;
@@ -595,9 +677,14 @@ let set_heritance ctx c herits p =
 				if c.cl_array_access <> None then error "Duplicate array access" p;
 				c.cl_array_access <- Some t
 			| TInst (intf,params) ->
+				intf.cl_build();
 				if is_parent c intf then error "Recursive class" p;
 				process_meta intf;
-				c.cl_implements <- (intf, params) :: c.cl_implements
+				c.cl_implements <- (intf, params) :: c.cl_implements;
+				if not !has_interf then begin
+					delay ctx PForce (fun() -> check_interfaces ctx c);
+					has_interf := true;
+				end
 			| TDynamic t ->
 				if c.cl_dynamic <> None then error "Cannot have several dynamics" p;
 				c.cl_dynamic <- Some t
@@ -612,7 +699,7 @@ let set_heritance ctx c herits p =
 		| _ :: _ -> t
 		| [] ->
 			try
-				let lt = List.find (fun lt -> snd (t_path lt) = t.tname) ctx.local_types in
+				let lt = List.find (fun lt -> snd (t_path lt) = t.tname) ctx.m.module_types in
 				{ t with tpackage = fst (t_path lt) }
 			with
 				Not_found -> t
@@ -626,7 +713,7 @@ let set_heritance ctx c herits p =
 
 let rec type_type_params ctx path get_params p tp =
 	let n = tp.tp_name in
-	let c = mk_class ctx.current (fst path @ [snd path],n) p in
+	let c = mk_class ctx.m.curmod (fst path @ [snd path],n) p in
 	c.cl_types <- List.map (type_type_params ctx c.cl_path get_params p) tp.tp_params;
 	let t = TInst (c,List.map snd c.cl_types) in
 	match tp.tp_constraints with
@@ -852,18 +939,20 @@ let build_module_def ctx mt meta fvars fbuild =
 	with Error (Custom msg,p) ->
 		display_error ctx msg p
 
-let init_class ctx c p herits fields =
-	let ctx = { ctx with curclass = c; type_params = c.cl_types; pass = PBuildClass } in
+let init_class ctx c p context_init herits fields =
+	let ctx = {
+		ctx with
+		curclass = c;
+		type_params = c.cl_types;
+		pass = PBuildClass;
+		tthis = TInst (c,List.map snd c.cl_types);
+		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 *)
+			if ep.pfile <> c.cl_pos.pfile then ctx.com.error "Defined in this class" c.cl_pos
+		);
+	} in
 	incr stats.s_classes_built;
-	(* make sure super classes/interfaces are built and propagate transitive properties *)
-	List.iter (fun (csup,_) ->
-		csup.cl_build();
-		List.iter (fun m ->
-			match m with
-			| ":autoBuild", el, p -> c.cl_meta <- (":build",el,p) :: m :: c.cl_meta;
-			| _ -> ()
-		) csup.cl_meta
-	) (match c.cl_super with None -> c.cl_implements | Some cs -> cs :: c.cl_implements);
 	let fields = patch_class ctx c fields in
 	let fields = ref fields in
 	let get_fields() = !fields in
@@ -880,7 +969,6 @@ let init_class ctx c p herits fields =
 		List.filter (fun f -> List.mem AStatic f.cff_access) fields, []
 	end else fields, herits in
 	if core_api && not (ctx.com.display || Common.defined ctx.com "dce") then delay ctx PForce (fun() -> init_core_api ctx c);
-	let tthis = TInst (c,List.map snd c.cl_types) in
 	let rec extends_public c =
 		List.exists (fun (c,_) -> c.cl_path = (["haxe"],"Public") || extends_public c) c.cl_implements ||
 		match c.cl_super with
@@ -969,6 +1057,7 @@ let init_class ctx c p herits fields =
 			let r = exc_protect ctx (fun r ->
 				if not !return_partial_type then begin
 					r := (fun() -> t);
+					context_init();
 					if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name);
 					let e = type_var_field ctx t e stat p in
 					let e = (match cf.cf_kind with
@@ -1010,19 +1099,22 @@ let init_class ctx c p herits fields =
 
 	(* ----------------------- FIELD INIT ----------------------------- *)
 
+	let has_override = ref false in
+
 	let loop_cf f =
 		let name = f.cff_name in
 		let p = f.cff_pos in
 		let stat = List.mem AStatic f.cff_access in
 		let inline = List.mem AInline f.cff_access in
 		let override = List.mem AOverride f.cff_access in
-		let ctx = { ctx with
-			tthis = tthis;
-			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 *)
-				if ep.pfile <> c.cl_pos.pfile then ctx.com.error "Defined in this class" c.cl_pos
-			);
+		if override && not !has_override then begin
+			has_override := true;
+			delay ctx PForce (fun() -> check_overriding ctx c);
+		end;
+		(* build the per-field context *)
+		let ctx = {
+			ctx with
+			pass = PBuildClass; (* will be set later to PTypeExpr *)
 		} in
 		match f.cff_kind with
 		| FVar (t,e) ->
@@ -1055,7 +1147,6 @@ let init_class ctx c p herits fields =
 				cf_overloads = [];
 			} in
 			ctx.curfield <- cf;
-			ctx.pass <- PTypeField;
 			bind_var ctx cf e stat inline;
 			f, false, cf
 		| FFun fd ->
@@ -1127,10 +1218,10 @@ let init_class ctx c p herits fields =
 			} in
 			init_meta_overloads ctx cf;
 			ctx.curfield <- cf;
-			ctx.pass <- PTypeField;
 			let r = exc_protect ctx (fun r ->
 				if not !return_partial_type then begin
 					r := (fun() -> t);
+					context_init();
 					incr stats.s_methods_typed;
 					if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ name);
 					let e , fargs = type_function ctx args ret (if constr then FConstructor else if stat then FStatic else FMember) fd p in
@@ -1206,7 +1297,6 @@ let init_class ctx c p herits fields =
 				cf_overloads = [];
 			} in
 			ctx.curfield <- cf;
-			ctx.pass <- PTypeField;
 			bind_var ctx cf eo stat inline;
 			delay ctx PForce (fun() -> (!check_get)());
 			delay ctx PForce (fun() -> (!check_set)());
@@ -1266,13 +1356,23 @@ let init_class ctx c p herits fields =
 	*)
 	let rec add_constructor c =
 		match c.cl_constructor, c.cl_super with
-		| None, Some (csup,cparams) when not c.cl_extern ->
-			add_constructor csup;
-			(match csup.cl_constructor with
-			| None -> ()
-			| Some cf ->
-				ignore (follow cf.cf_type); (* make sure it's typed *)
-				let args = (match cf.cf_expr with
+		| None, Some ({ cl_constructor = Some cfsup } as csup,cparams) when not c.cl_extern ->
+			let cf = {
+				cfsup with
+				cf_pos = p;
+				cf_meta = [];
+				cf_doc = None;
+				cf_expr = None;
+			} in
+			let r = exc_protect ctx (fun r ->
+				let t = mk_mono() in
+				r := (fun() -> t);
+				let ctx = { ctx with
+					curfield = cf;
+					pass = PTypeField;
+				} in
+				ignore (follow cfsup.cf_type); (* make sure it's typed *)
+				let args = (match cfsup.cf_expr with
 					| Some { eexpr = TFunction f } ->
 						List.map (fun (v,def) ->
 							(*
@@ -1287,7 +1387,7 @@ let init_class ctx c p herits fields =
 							| _ -> v, def
 						) f.tf_args
 					| _ ->
-						match follow cf.cf_type with
+						match follow cfsup.cf_type with
 						| TFun (args,_) -> List.map (fun (n,o,t) -> alloc_var n (if o then ctx.t.tnull t else t), if o then Some TNull else None) args
 						| _ -> assert false
 				) in
@@ -1299,14 +1399,24 @@ let init_class ctx c p herits fields =
 					tf_type = ctx.t.tvoid;
 					tf_expr = super_call;
 				}) (TFun (List.map (fun (v,c) -> v.v_name, c <> None, v.v_type) vars,ctx.t.tvoid)) p in
-				c.cl_constructor <- Some { cf with cf_pos = p; cf_type = constr.etype; cf_meta = []; cf_doc = None; cf_expr = Some constr })
+				cf.cf_expr <- Some constr;
+				cf.cf_type <- t;
+				unify ctx t constr.etype p;
+				t
+			) "add_constructor" in
+			cf.cf_type <- TLazy r;
+			c.cl_constructor <- Some cf;
+			delay ctx PForce (fun() -> ignore((!r)()));
 		| _ ->
 			(* nothing to do *)
 			()
 	in
-	if c.cl_constructor = None & c.cl_super <> None then delay ctx PDefineConstructor (fun() -> add_constructor c);
+	add_constructor c;
 	(* push delays in reverse order so they will be run in correct order *)
-	List.iter (fun (ctx,r) -> delay ctx PTypeField (fun() -> ignore((!r)()))) !delayed_expr
+	List.iter (fun (ctx,r) ->
+		ctx.pass <- PTypeField;
+		delay ctx PTypeField (fun() -> ignore((!r)()))
+	) !delayed_expr
 
 let resolve_typedef t =
 	match t with
@@ -1332,9 +1442,14 @@ let add_module ctx m p =
 	List.iter decl_type m.m_types;
 	Hashtbl.add ctx.g.modules m.m_path m
 
-let init_module_type ctx usings (decl,p) =
+(*
+	In this pass, we can access load and access other modules types, but we cannot follow them or access their structure
+	since they have not been setup. We also build a context_init list that will be evaluated the first time we evaluate
+	an expression into the context
+*)
+let init_module_type ctx context_init do_init (decl,p) =
 	let get_type name =
-		try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.current.m_types with Not_found -> assert false
+		try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types with Not_found -> assert false
 	in
 	match decl with
 	| EImport t ->
@@ -1342,11 +1457,10 @@ let init_module_type ctx usings (decl,p) =
 		| None ->
 			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.m_types in
-			ctx.local_types <- ctx.local_types @ types
+			ctx.m.module_types <- ctx.m.module_types @ types
 		| Some _ ->
 			let t = load_type_def ctx p t in
-			ctx.local_types <- ctx.local_types @ [t]
-		)
+			ctx.m.module_types <- ctx.m.module_types @ [t])
 	| EUsing t ->
 		let filter_classes types =
 			let rec loop acc types = match List.rev types with
@@ -1361,45 +1475,49 @@ let init_module_type ctx usings (decl,p) =
 			in
 			loop [] types
 		in
-		(* make sure using are processed in the declaration order *)
-		if !usings = [] then delay ctx PResolveTypedefs (fun() -> List.iter (fun f -> f()) (List.rev !usings));
-		usings := (fun() ->
+		context_init := (fun() ->
 			match t.tsub with
 			| None ->
 				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.m_types in
-				flush_pass ctx PInitModuleTypes "using";
-				ctx.local_using <- ctx.local_using @ (filter_classes types);
-				ctx.local_types <- ctx.local_types @ types
+				ctx.m.module_using <- filter_classes types @ ctx.m.module_using;
+				ctx.m.module_types <- types @ ctx.m.module_types
 			| Some _ ->
 				let t = load_type_def ctx p t in
-				flush_pass ctx PInitModuleTypes "using";
-				ctx.local_using <- ctx.local_using @ (filter_classes [t]);
-				ctx.local_types <- ctx.local_types @ [t]
-		) :: !usings
+				ctx.m.module_using <- filter_classes [t] @ ctx.m.module_using;
+				ctx.m.module_types <- t :: ctx.m.module_types
+		) :: !context_init
 	| EClass d ->
 		let c = (match get_type d.d_name with TClassDecl c -> c | _ -> assert false) in
 		let herits = d.d_flags in
-		if has_meta ":generic" c.cl_meta && c.cl_types <> [] then c.cl_kind <- KGeneric;
+		(*
+			we need to check rtti has early as class declaration, but we can't resolve imports,
+			so let's have a quick heuristic for backward compatibility
+		*)
+		let implements_rtti() =
+			let rtti = List.exists (function
+				| HImplements { tpackage = ["haxe";"rtti"]; tname = "Generic" } -> true
+				| HImplements { tpackage = []; tname = "Generic" } -> List.exists (fun t -> t_path t = (["haxe";"rtti"],"Generic")) ctx.m.module_types
+				| _ -> false
+			) herits in
+			if rtti && Common.defined ctx.com "haxe3" then error ("Implementing haxe.rtti.Generic is deprecated in haxe 3, please use @:generic instead") c.cl_pos;
+			has_meta ":generic" c.cl_meta || rtti
+		in
+		if implements_rtti() && c.cl_types <> [] then c.cl_kind <- KGeneric;
 		if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
-		(* for debug only - we can't shadow ctx since it will get injected 'using' *)
-		ctx.curclass <- c;
 		c.cl_extern <- List.mem HExtern herits;
 		c.cl_interface <- List.mem HInterface herits;
-		delay ctx PForce (fun() -> check_overriding ctx c p);
-		delay ctx PForce (fun() -> check_interfaces ctx c p);
-		delay ctx PSetInherit (fun() -> set_heritance ctx c herits p);
-		let build() = 
+		let build() =
 			c.cl_build <- (fun()->());
-			flush_pass ctx PSetInherit "build";
-			init_class ctx c p d.d_flags d.d_data
+			set_heritance ctx c herits p;
+			init_class ctx c p do_init d.d_flags d.d_data
 		in
-		let old = ctx.pass in
 		ctx.pass <- PBuildClass;
+		ctx.curclass <- c;
 		c.cl_build <- make_pass ctx build;
-		delay ctx PBuildClass (fun() -> c.cl_build());
-		ctx.pass <- old;
+		ctx.pass <- PBuildModule;
 		ctx.curclass <- null_class;
+		delay ctx PBuildClass (fun() -> c.cl_build());
 	| EEnum d ->
 		let e = (match get_type d.d_name with TEnumDecl e -> e | _ -> assert false) in
 		let ctx = { ctx with type_params = e.e_types } in
@@ -1487,97 +1605,27 @@ let init_module_type ctx usings (decl,p) =
 			| ASuperType t -> a.a_super <- load_complex_type ctx p t :: a.a_super
 		) d.d_flags
 
-let type_module ctx m file tdecls loadp =
-	(* PASS 1 : build module structure - does not load any module or type - should be atomic ! *)
-	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 m @ ["_" ^ snd m], name) else (fst m, name)
-	in
-	let m = {
-		m_id = alloc_mid();
-		m_path = m;
-		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
-	List.iter (fun decl ->
-		let p = snd decl in
-		match fst decl with
-		| EImport _ | EUsing _ -> ()
-		| EClass d ->
-			let priv = List.mem HPrivate d.d_flags in
-			let path = make_path d.d_name priv in
-			let c = mk_class m path p in
-			c.cl_module <- m;
-			c.cl_private <- priv;
-			c.cl_doc <- d.d_doc;
-			c.cl_meta <- d.d_meta;
-			decls := (TClassDecl c, decl) :: !decls
-		| EEnum d ->
-			let priv = List.mem EPrivate d.d_flags in
-			let path = make_path d.d_name priv in
-			let e = {
-				e_path = path;
-				e_module = m;
-				e_pos = p;
-				e_doc = d.d_doc;
-				e_meta = d.d_meta;
-				e_types = [];
-				e_private = priv;
-				e_extern = List.mem EExtern d.d_flags;
-				e_constrs = PMap.empty;
-				e_names = [];
-			} in
-			decls := (TEnumDecl e, decl) :: !decls
-		| ETypedef d ->
-			let priv = List.mem EPrivate d.d_flags in
-			let path = make_path d.d_name priv in
-			let t = {
-				t_path = path;
-				t_module = m;
-				t_pos = p;
-				t_doc = d.d_doc;
-				t_private = priv;
-				t_types = [];
-				t_type = mk_mono();
-				t_meta = d.d_meta;
-			} in
-			decls := (TTypeDecl t, decl) :: !decls
-	   | EAbstract d ->
-			let priv = List.mem APrivAbstract d.d_flags in
-			let path = make_path d.d_name priv in
-			let a = {
-				a_path = path;
-				a_private = priv;
-				a_module = m;
-				a_pos = p;
-				a_doc = d.d_doc;
-				a_types = [];
-				a_meta = d.d_meta;
-				a_sub = [];
-				a_super = [];
-			} in
-			decls := (TAbstractDecl a, decl) :: !decls
-	) tdecls;
-	let decls = List.rev !decls in
-	m.m_types <- List.map fst decls;
-	add_module ctx m loadp;
+let type_module ctx m file tdecls p =
+	let m, decls = make_module ctx m file tdecls p in
+	add_module ctx m p;
 	(* define the per-module context for the next pass *)
 	let ctx = {
 		com = ctx.com;
 		g = ctx.g;
 		t = ctx.t;
-		pass = PInitModuleTypes;
+		m = {
+			curmod = m;
+			module_types = ctx.g.std.m_types @ m.m_types;
+			module_using = [];
+		};
+		pass = PBuildModule;
 		on_error = (fun ctx msg p -> ctx.com.error msg p);
 		macro_depth = ctx.macro_depth;
 		curclass = null_class;
 		curfield = null_field;
 		tthis = ctx.tthis;
 		ret = ctx.ret;
-		current = m;
 		locals = PMap.empty;
-		local_types = ctx.g.std.m_types @ m.m_types;
-		local_using = [];
 		type_params = [];
 		curfun = FStatic;
 		untyped = false;
@@ -1604,11 +1652,17 @@ let type_module ctx m file tdecls loadp =
 		| _ ->
 			assert false
 	) decls;
-	(* enter the next pass *)
-	let usings = ref [] in
-	delay ctx PInitModuleTypes (fun() -> List.iter (init_module_type ctx usings) tdecls);
+	(* 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
 
+
 let resolve_module_file com m remap p =
 	let file = (match m with
 		| [] , name -> name
@@ -1698,11 +1752,8 @@ let load_module ctx m p =
 			with Forbid_package (inf,pl) when p <> Ast.null_pos ->
 				raise (Forbid_package (inf,p::pl))
 	) in
-	add_dependency ctx.current m2;
-	(match ctx.pass with
-	| PTypeField -> flush_pass ctx PBuildClass "load_module"
-	| PSetInherit -> flush_pass ctx PInitModuleTypes "load_module"
-	| _ -> ());
+	add_dependency ctx.m.curmod m2;
+	if ctx.pass = PTypeField then flush_pass ctx PBuildClass "load_module";
 	m2
 
 ;;

+ 21 - 19
typer.ml

@@ -630,7 +630,7 @@ let using_field ctx mode e i p =
 		with Not_found ->
 			loop l
 	in
-	loop ctx.local_using
+	loop ctx.m.module_using
 
 let get_this ctx p =
 	match ctx.curfun with
@@ -700,7 +700,7 @@ let type_ident_raise ?(imported_enums=true) ctx i p mode =
 			(match e with
 			| Some ({ eexpr = TFunction f } as e) ->
 				(* create a fake class with a fake field to emulate inlining *)
-				let c = mk_class ctx.current (["local"],v.v_name) e.epos in
+				let c = mk_class ctx.m.curmod (["local"],v.v_name) e.epos in
 				let cf = { (mk_field v.v_name v.v_type e.epos) with cf_params = params; cf_expr = Some e; cf_kind = Method MethInline } in
 				c.cl_extern <- true;
 				c.cl_fields <- PMap.add cf.cf_name cf PMap.empty;
@@ -747,7 +747,7 @@ let type_ident_raise ?(imported_enums=true) ctx i p mode =
 					with
 						Not_found -> loop l
 		in
-		let e = loop ctx.local_types in
+		let e = loop ctx.m.module_types in
 		if mode = MSet then
 			AKNo i
 		else
@@ -1289,7 +1289,7 @@ and type_unop ctx op flag e p =
 
 and type_switch ctx e cases def need_val with_type p =
 	let eval = type_expr ctx e in
-	let old = ctx.local_types in
+	let old_m = ctx.m in
 	let enum = ref None in
 	let used_cases = Hashtbl.create 0 in
 	let is_fake_enum e =
@@ -1299,7 +1299,8 @@ and type_switch ctx e cases def need_val with_type p =
 	| TEnum (e,_) when is_fake_enum e -> ()
 	| TEnum (e,params) ->
 		enum := Some (Some (e,params));
-		ctx.local_types <- TEnumDecl e :: ctx.local_types
+		(* hack to prioritize enum lookup *)
+		ctx.m <- { ctx.m with module_types = TEnumDecl e :: ctx.m.module_types }
 	| TMono _ ->
 		enum := Some None;
 	| t ->
@@ -1374,7 +1375,7 @@ and type_switch ctx e cases def need_val with_type p =
 		) el in
 		el, e2
 	) cases in
-	ctx.local_types <- old;
+	ctx.m <- old_m;
 	let el = ref [] in
 	let type_case_code e =
 		let e = (match e with
@@ -1753,7 +1754,7 @@ and type_access ctx e p mode =
 								| _ :: l -> loop (List.rev l)
 						in
 						(match pack with
-						| [] -> loop (fst ctx.current.m_path)
+						| [] -> loop (fst ctx.m.curmod.m_path)
 						| _ ->
 							match check_module (pack,name) sname with
 							| Some r -> r
@@ -2021,7 +2022,6 @@ and type_expr ctx ?(need_val=true) (e,p) =
 		type_call ctx e el None p
 	| ENew (t,el) ->
 		let t = Typeload.load_instance ctx t p true in
-		flush_pass ctx PDefineConstructor "new";
 		let el, c , params = (match follow t with
 		| TInst ({cl_kind = KTypeParameter tl} as c,params) ->
 			(* first check field parameters, then class parameters *)
@@ -2249,7 +2249,7 @@ and type_expr ctx ?(need_val=true) (e,p) =
 				) c.cl_ordered_statics;
 				!acc
 		in
-		let use_methods = loop PMap.empty ctx.local_using in
+		let use_methods = loop PMap.empty ctx.m.module_using in
 		let fields = PMap.fold (fun f acc -> PMap.add f.cf_name f acc) fields use_methods in
 		let fields = PMap.fold (fun f acc -> f :: acc) fields [] in
 		let t = (if iscall then
@@ -2850,7 +2850,7 @@ let make_macro_api ctx p =
 			ctx.curfield.cf_name;
 		);
 		Interp.get_local_using = (fun() ->
-			ctx.local_using;
+			ctx.m.module_using;
 		);
 		Interp.get_local_vars = (fun () ->
 			ctx.locals;
@@ -2862,10 +2862,10 @@ let make_macro_api ctx p =
 		);
 		Interp.define_type = (fun v ->
 			let m, tdef, pos = (try Interp.decode_type_def v with Interp.Invalid_expr -> Interp.exc (Interp.VString "Invalid type definition")) in
-			let mdep = Typeload.type_module ctx m ctx.current.m_extra.m_file [tdef,pos] pos in
+			let mdep = Typeload.type_module ctx m ctx.m.curmod.m_extra.m_file [tdef,pos] pos in
 			mdep.m_extra.m_kind <- MFake;
 			mdep.m_extra.m_time <- -1.;
-			add_dependency ctx.current mdep;
+			add_dependency ctx.m.curmod mdep;
 		);
 		Interp.module_dependency = (fun mpath file ismacro ->
 			let m = typing_timer ctx (fun() -> Typeload.load_module ctx (parse_path mpath) p) in
@@ -2875,7 +2875,7 @@ let make_macro_api ctx p =
 				add_dependency m (create_fake_module ctx file);
 		);
 		Interp.current_module = (fun() ->
-			ctx.current
+			ctx.m.curmod
 		);
 	}
 
@@ -2938,8 +2938,8 @@ let load_macro ctx cpath f p =
 	let mctx = Interp.get_ctx() in
 	let m = (try Hashtbl.find ctx.g.types_module cpath with Not_found -> cpath) in
 	let mloaded = Typeload.load_module ctx2 m p in
-	ctx2.local_types <- mloaded.m_types;
-	add_dependency ctx.current mloaded;
+	ctx2.m <- { curmod = mloaded; module_types = mloaded.m_types; module_using = [] };
+	add_dependency ctx.m.curmod mloaded;
 	let cl, meth = (match Typeload.load_instance ctx2 { tpackage = fst cpath; tname = snd cpath; tparams = []; tsub = None } p true with
 		| TInst (c,_) ->
 			finalize ctx2;
@@ -3088,7 +3088,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
 			| None -> (fun() -> raise Interp.Abort)
 			| Some e -> Interp.eval mctx (Genneko.gen_expr mctx.Interp.gen (type_expr ctx e))
 		) in
-		ctx.current.m_extra.m_time <- -1.; (* disable caching for modules having macro-in-macro *)
+		ctx.m.curmod.m_extra.m_time <- -1.; (* disable caching for modules having macro-in-macro *)
 		let e = (EConst (Ident "__dollar__delay_call"),p) in
 		Some (EUntyped (ECall (e,[EConst (Int (string_of_int pos)),p]),p),p)
 	end else
@@ -3147,6 +3147,11 @@ let rec create com =
 			do_optimize = Optimizer.reduce_expression;
 			do_build_instance = Codegen.build_instance;
 		};
+		m = {
+			curmod = null_module;
+			module_types = [];
+			module_using = [];
+		};
 		pass = PBuildModule;
 		macro_depth = 0;
 		untyped = false;
@@ -3157,13 +3162,10 @@ let rec create com =
 		in_macro = Common.defined com "macro";
 		ret = mk_mono();
 		locals = PMap.empty;
-		local_types = [];
-		local_using = [];
 		type_params = [];
 		curclass = null_class;
 		curfield = null_field;
 		tthis = mk_mono();
-		current = null_module;
 		opened = [];
 		param_type = None;
 		vthis = None;