split typecore.context (use 'g' for shared globals)

codegen.ml

@@ -154,14 +154,14 @@ let rec build_generic ctx c p tl =
 	else try
 		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.modules (Hashtbl.find ctx.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 mg = {
 			mpath = cg.cl_path;
 			mtypes = [TClassDecl cg];
 		} in
-		Hashtbl.add ctx.modules mg.mpath mg;
+		Hashtbl.add ctx.g.modules mg.mpath mg;
 		let rec loop l1 l2 =
 			match l1, l2 with
 			| [] , [] -> []
@@ -219,14 +219,13 @@ let extend_xml_proxy ctx c t file p =
 	let t = Typeload.load_complex_type ctx p t in
 	let file = (try Common.find_file ctx.com file with Not_found -> file) in
 	let used = ref PMap.empty in
-	let rec delay() =
-		if !(ctx.delays) <> [] then ctx.delays := !(ctx.delays) @ [[delay]]
-		else PMap.iter (fun id used ->
+	let print_results() =
+		PMap.iter (fun id used ->
 			if not used then ctx.com.warning (id ^ " is not used") p;
 		) (!used)
 	in
 	let check_used = Common.defined ctx.com "check-xml-proxy" in
-	if check_used then delay();
+	if check_used then ctx.g.hook_generate <- print_results :: ctx.g.hook_generate;
 	try
 		let rec loop = function
 			| Xml.Element (_,attrs,childs) ->
@@ -311,7 +310,7 @@ let build_instance ctx mtype p =
 					unify_raise ctx (build_generic ctx c p pl) t p;
 					t
 				) in
-				ctx.delays := [fun() -> ignore ((!r)())] :: !(ctx.delays);
+				delay ctx (fun() -> ignore ((!r)()));
 				TLazy r
 			| _ ->
 				TInst (c,pl)

typecore.ml

@@ -19,20 +19,23 @@
 open Common
 open Type
 
-type typer = {
-	(* shared *)
-	com : context;
-	mutable api : context_type_api;
+type typer_globals = {
 	types_module : (path, path) Hashtbl.t;
 	modules : (path , module_def) Hashtbl.t;
-	delays : (unit -> unit) list list ref;
+	mutable delayed : (unit -> unit) list;
 	constructs : (path , Ast.access list * Ast.type_param list * Ast.func) Hashtbl.t;
 	doinline : bool;
-	mutable core_api : typer option ref;
-	mutable macros : typer option ref;
+	mutable core_api : typer option;
+	mutable macros : typer option;
 	mutable std : module_def;
-	mutable untyped : bool;
-	mutable super_call : bool;
+	mutable hook_generate : (unit -> unit) list;
+}
+
+and typer = {
+	(* shared *)
+	com : context;
+	mutable api : context_type_api;
+	g : typer_globals;
 	(* per-module *)
 	current : module_def;
 	mutable local_types : module_type list;
@@ -43,6 +46,8 @@ type typer = {
 	mutable type_params : (string * t) list;
 	(* per-function *)
 	mutable curmethod : string;
+	mutable untyped : bool;
+	mutable in_super_call : bool;
 	mutable in_constructor : bool;
 	mutable in_static : bool;
 	mutable in_loop : bool;
@@ -211,6 +216,9 @@ let rec is_null = function
 let not_opened = ref Closed
 let mk_anon fl = TAnon { a_fields = fl; a_status = not_opened; }
 
+let delay ctx f =
+	ctx.g.delayed <- f :: ctx.g.delayed
+
 let mk_field name t = {
 	cf_name = name;
 	cf_type = t;

typeload.ml

@@ -150,7 +150,7 @@ let rec load_instance ctx t p allow_no_params =
 						) c.cl_implements;
 						t
 					) in
-					ctx.delays := [(fun () -> ignore(!r()))] :: !(ctx.delays);
+					delay ctx (fun () -> ignore(!r()));
 					TLazy r
 				| _ -> assert false
 			) tparams types in
@@ -237,7 +237,7 @@ and load_complex_type ctx p t =
 let hide_types ctx =
 	let old_locals = ctx.local_types in
 	let old_type_params = ctx.type_params in
-	ctx.local_types <- ctx.std.mtypes;
+	ctx.local_types <- ctx.g.std.mtypes;
 	ctx.type_params <- [];
 	(fun() ->
 		ctx.local_types <- old_locals;
@@ -475,7 +475,7 @@ let type_type_params ctx path p (n,flags) =
 			set_heritance ctx c (List.map (fun t -> HImplements t) flags) p;
 			t
 		) in
-		ctx.delays := [(fun () -> ignore(!r()))] :: !(ctx.delays);
+		delay ctx (fun () -> ignore(!r()));
 		n, TLazy r
 
 let type_function ctx args ret static constr f p =
@@ -565,16 +565,16 @@ let type_meta ctx meta =
 			ml
 		| Some ml -> ml
 	in
-	ctx.delays := [[fun() -> ignore(get_meta())]] @ !(ctx.delays);
+	delay ctx (fun() -> ignore(get_meta()));
 	get_meta
 
 let init_core_api ctx c =
-	let ctx2 = (match !(ctx.core_api) with
+	let ctx2 = (match ctx.g.core_api with
 		| None ->
 			let com = ctx.com in
 			let com = { com with class_path = com.std_path; type_api = { com.type_api with tvoid = com.type_api.tvoid } } in
 			let ctx2 = (!do_create) com in
-			ctx.core_api := Some ctx2;
+			ctx.g.core_api <- Some ctx2;
 			ctx2
 		| Some c ->
 			c
@@ -629,7 +629,7 @@ let init_class ctx c p herits fields meta =
 	set_heritance ctx c herits p;
 	let core_api = has_meta ":core_api" meta in
 	let is_macro = has_meta ":macro" meta in
-	if core_api then ctx.delays := [(fun() -> init_core_api ctx c)] :: !(ctx.delays);
+	if core_api then delay ctx ((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 ||
@@ -863,7 +863,7 @@ let init_class ctx c p herits fields meta =
 	*)
 	let rec define_constructor ctx c =
 		try
-			Some (Hashtbl.find ctx.constructs c.cl_path)
+			Some (Hashtbl.find ctx.g.constructs c.cl_path)
 		with Not_found ->
 			match c.cl_super with
 			| None -> None
@@ -910,8 +910,8 @@ let init_class ctx c p herits fields meta =
 					) f.f_args } in
 					let _, _, cf, delayed = loop_cf (FFun ("new",None,[],acc,pl,fnew)) p in
 					c.cl_constructor <- Some cf;
-					Hashtbl.add ctx.constructs c.cl_path (acc,pl,f);
-					ctx.delays := [delayed] :: !(ctx.delays);
+					Hashtbl.add ctx.g.constructs c.cl_path (acc,pl,f);
+					delay ctx delayed;
 					infos
 	in
 	(*
@@ -936,12 +936,12 @@ let type_module ctx m tdecls loadp =
 		let tpath = if priv then (fst m @ ["_" ^ snd m], name) else (fst m, name) in
 		if priv && List.exists (fun t -> tpath = t_path t) (!decls) then error ("Type name " ^ name ^ " is already defined in this module") p;
 		try
-			let m2 = Hashtbl.find ctx.types_module tpath in
+			let m2 = Hashtbl.find ctx.g.types_module tpath in
 			if m <> m2 && String.lowercase (s_type_path m2) = String.lowercase (s_type_path m) then error ("Module " ^ s_type_path m2 ^ " is loaded with a different case than " ^ s_type_path m) loadp;
 			error ("Type name " ^ s_type_path tpath ^ " is redefined from module " ^ s_type_path m2) p
 		with
 			Not_found ->
-				Hashtbl.add ctx.types_module tpath m;
+				Hashtbl.add ctx.g.types_module tpath m;
 				tpath
 	in
 	List.iter (fun (d,p) ->
@@ -957,7 +957,7 @@ let type_module ctx m tdecls loadp =
 			(* store the constructor for later usage *)
 			List.iter (fun (cf,_) ->
 				match cf with
-				| FFun ("new",_,_,acc,pl,f) -> Hashtbl.add ctx.constructs path (acc,pl,f)
+				| FFun ("new",_,_,acc,pl,f) -> Hashtbl.add ctx.g.constructs path (acc,pl,f)
 				| _ -> ()
 			) d.d_data;
 			decls := TClassDecl c :: !decls
@@ -994,36 +994,29 @@ let type_module ctx m tdecls loadp =
 		mpath = m;
 		mtypes = List.rev !decls;
 	} in
-	Hashtbl.add ctx.modules m.mpath m;
+	Hashtbl.add ctx.g.modules m.mpath m;
 	(* PASS 2 : build types structure - does not type any expression ! *)
 	let ctx = {
 		com = ctx.com;
+		g = ctx.g;
 		api = ctx.api;
-		core_api = ctx.core_api;
-		macros = ctx.macros;
-		modules = ctx.modules;
-		delays = ctx.delays;
-		constructs = ctx.constructs;
-		types_module = ctx.types_module;
 		curclass = ctx.curclass;
 		tthis = ctx.tthis;
-		std = ctx.std;
 		ret = ctx.ret;
-		doinline = ctx.doinline;
 		current = m;
 		locals = PMap.empty;
 		locals_map = PMap.empty;
 		locals_map_inv = PMap.empty;
-		local_types = ctx.std.mtypes @ m.mtypes;
+		local_types = ctx.g.std.mtypes @ m.mtypes;
 		local_using = [];
 		type_params = [];
 		curmethod = "";
-		super_call = false;
+		untyped = false;
+		in_super_call = false;
 		in_constructor = false;
 		in_static = false;
 		in_display = false;
 		in_loop = false;
-		untyped = false;
 		opened = [];
 		param_type = None;
 	} in
@@ -1123,7 +1116,7 @@ let type_module ctx m tdecls loadp =
 			| _ -> assert false);
 	) tdecls;
 	(* PASS 3 : type checking, delayed until all modules and types are built *)
-	ctx.delays := !delays :: !(ctx.delays);
+	List.iter (delay ctx) (List.rev (!delays));
 	m
 
 let parse_module ctx m p =
@@ -1187,7 +1180,7 @@ let parse_module ctx m p =
 
 let load_module ctx m p =
 	try
-		Hashtbl.find ctx.modules m
+		Hashtbl.find ctx.g.modules m
 	with
 		Not_found ->
 			let decls = (try

typer.ml

@@ -157,7 +157,7 @@ let unify_call_params ctx name el args p inline =
 	let rec loop acc l l2 skip =
 		match l , l2 with
 		| [] , [] ->
-			if not (inline && ctx.doinline) && (Common.defined ctx.com "flash" || Common.defined ctx.com "js") then
+			if not (inline && ctx.g.doinline) && (Common.defined ctx.com "flash" || Common.defined ctx.com "js") then
 				List.rev (no_opt acc)
 			else
 				List.rev (List.map fst acc)
@@ -273,7 +273,7 @@ let get_constructor c p =
 
 let make_call ctx e params t p =
 	try
-		if not ctx.doinline then raise Exit;
+		if not ctx.g.doinline then raise Exit;
 		let ethis, fname = (match e.eexpr with TField (ethis,fname) -> ethis, fname | _ -> raise Exit) in
 		let f = (match follow ethis.etype with
 			| TInst (c,params) -> snd (try class_field c fname with Not_found -> raise Exit)
@@ -426,10 +426,10 @@ let type_ident ctx i is_type p mode =
 			| Some (c,params) -> TInst(c,params)
 		) in
 		if ctx.in_static then error "Cannot access super from a static function" p;
-		if mode = MSet || not ctx.super_call then
+		if mode = MSet || not ctx.in_super_call then
 			AKNo i
 		else begin
-			ctx.super_call <- false;
+			ctx.in_super_call <- false;
 			AKExpr (mk (TConst TSuper) t p)
 		end
 	| "null" ->
@@ -1606,7 +1606,7 @@ and type_call ctx e el p =
 		mk (TCall (mk (TConst TSuper) t sp,el)) ctx.api.tvoid p
 	| _ ->
 		(match e with
-		| EField ((EConst (Ident "super"),_),_) , _ | EType ((EConst (Ident "super"),_),_) , _ -> ctx.super_call <- true
+		| EField ((EConst (Ident "super"),_),_) , _ | EType ((EConst (Ident "super"),_),_) , _ -> ctx.in_super_call <- true
 		| _ -> ());		
 		match type_access ctx (fst e) (snd e) MCall with
 		| AKInline (ethis,f,t) ->
@@ -1625,7 +1625,11 @@ and type_call ctx e el p =
 		| AKMacro (ethis,f) ->
 			(match ethis.eexpr with
 			| TTypeExpr (TClassDecl c) ->
-				error "TODO" p
+				let ctx2 = (match ctx.g.macros with
+					| Some ctx -> ctx
+					| None -> assert false
+				) in
+				assert false
 			| _ -> assert false)
 		| acc ->
 			let e = acc_get ctx acc p in
@@ -1653,8 +1657,8 @@ and type_call ctx e el p =
 (* FINALIZATION *)
 
 let rec finalize ctx =
-	let delays = List.concat !(ctx.delays) in
-	ctx.delays := [];
+	let delays = ctx.g.delayed in
+	ctx.g.delayed <- [];
 	match delays with
 	| [] -> () (* at last done *)
 	| l ->
@@ -1669,7 +1673,7 @@ let get_type_module ctx t =
 				mfound := m;
 				raise Exit;
 			end;
-		) ctx.modules;
+		) ctx.g.modules;
 		(* @Main, other generated classes ? *)
 		{
 			mtypes = [t];
@@ -1780,7 +1784,7 @@ let types ctx main excludes =
 		) c.cl_statics
 
 	in
-	Hashtbl.iter (fun _ m -> List.iter loop m.mtypes) ctx.modules;
+	Hashtbl.iter (fun _ m -> List.iter loop m.mtypes) ctx.g.modules;
 	(match main with
 	| None -> ()
 	| Some cl ->
@@ -1828,18 +1832,22 @@ let create com =
 	let ctx = {
 		com = com;
 		api = com.type_api;
-		core_api = ref None;
-		macros = ref None;
-		modules = Hashtbl.create 0;
-		types_module = Hashtbl.create 0;
-		constructs = Hashtbl.create 0;
-		delays = ref [];
-		doinline = not (Common.defined com "no_inline");
+		g = {
+			core_api = None;
+			macros = None;
+			modules = Hashtbl.create 0;
+			types_module = Hashtbl.create 0;
+			constructs = Hashtbl.create 0;
+			delayed = [];
+			doinline = not (Common.defined com "no_inline");
+			hook_generate = [];
+			std = empty;
+		};
+		untyped = false;
 		in_constructor = false;
 		in_static = false;
 		in_loop = false;
-		untyped = false;
-		super_call = false;
+		in_super_call = false;
 		in_display = false;
 		ret = mk_mono();
 		locals = PMap.empty;
@@ -1852,7 +1860,6 @@ let create com =
 		curclass = null_class;
 		tthis = mk_mono();
 		current = empty;
-		std = empty;
 		opened = [];
 		param_type = None;
 	} in
@@ -1861,7 +1868,7 @@ let create com =
 	ctx.api.on_generate <- Codegen.on_generate ctx;
 	ctx.api.get_type_module <- get_type_module ctx;
 	ctx.api.optimize <- Optimizer.reduce_expression ctx;
-	ctx.std <- (try
+	ctx.g.std <- (try
 		Typeload.load_module ctx ([],"StdTypes") null_pos
 	with
 		Error (Module_not_found ([],"StdTypes"),_) -> error "Standard library not found" null_pos
@@ -1885,7 +1892,7 @@ let create com =
 				let cpp = platform com Cpp in
 				ctx.api.tnull <- if not (f9 || cpp) then (fun t -> t) else (fun t -> if is_nullable t then TType (td,[t]) else t);
 			| _ -> ());
-	) ctx.std.mtypes;
+	) ctx.g.std.mtypes;
 	let m = Typeload.load_module ctx ([],"String") null_pos in
 	(match m.mtypes with
 	| [TClassDecl c] -> ctx.api.tstring <- TInst (c,[])