[pull] development from HaxeFoundation:development

src/compiler/args.ml

@@ -111,9 +111,9 @@ let parse_args com =
 		),"<name[=path]>","generate code for a custom target");
 		("Target",[],["-x"], Arg.String (fun cl ->
 			let cpath = Path.parse_type_path cl in
-			(match com.main_class with
+			(match com.main.main_class with
 				| Some c -> if cpath <> c then raise (Arg.Bad "Multiple --main classes specified")
-				| None -> com.main_class <- Some cpath);
+				| None -> com.main.main_class <- Some cpath);
 			actx.classes <- cpath :: actx.classes;
 			Common.define com Define.Interp;
 			set_platform com Eval "";
@@ -138,9 +138,9 @@ let parse_args com =
 			actx.hxb_libs <- lib :: actx.hxb_libs
 		),"<path>","add a hxb library");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
-			if com.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
+			if com.main.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
 			let cpath = Path.parse_type_path cl in
-			com.main_class <- Some cpath;
+			com.main.main_class <- Some cpath;
 			actx.classes <- cpath :: actx.classes
 		),"<class>","select startup class");
 		("Compilation",["-L";"--library"],["-lib"],Arg.String (fun _ -> ()),"<name[:ver]>","use a haxelib library");

src/compiler/compilationCache.ml

@@ -108,7 +108,7 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 
 (* Pointers for memory inspection. *)
 	method get_pointers : unit array =
-		[|Obj.magic files;Obj.magic modules|]
+		[|Obj.magic files;Obj.magic modules;Obj.magic binary_cache|]
 end
 
 let create_directory path mtime = {

src/compiler/compilationContext.ml

@@ -54,6 +54,7 @@ and compilation_context = {
 	mutable has_next : bool;
 	mutable has_error : bool;
 	comm : communication;
+	mutable runtime_args : string list;
 }
 
 type compilation_callbacks = {

src/compiler/compiler.ml

@@ -336,15 +336,15 @@ let finalize_typing ctx tctx =
 	enter_stage com CFilteringStart;
 	ServerMessage.compiler_stage com;
 	let main, types, modules = run_or_diagnose ctx (fun () -> Finalization.generate tctx) in
-	com.main <- main;
+	com.main.main_expr <- main;
 	com.types <- types;
 	com.modules <- modules;
 	t()
 
 let filter ctx tctx before_destruction =
 	let t = Timer.timer ["filters"] in
 	DeprecationCheck.run ctx.com;
-	run_or_diagnose ctx (fun () -> Filters.run tctx ctx.com.main before_destruction);
+	run_or_diagnose ctx (fun () -> Filters.run tctx ctx.com.main.main_expr before_destruction);
 	t()
 
 let compile ctx actx callbacks =
@@ -509,6 +509,7 @@ let create_context comm cs compilation_step params = {
 	has_next = false;
 	has_error = false;
 	comm = comm;
+	runtime_args = [];
 }
 
 module HighLevel = struct
@@ -614,7 +615,7 @@ module HighLevel = struct
 			| "--run" :: cl :: args ->
 				let acc = cl :: "-x" :: acc in
 				let ctx = create_context (List.rev acc) in
-				ctx.com.sys_args <- args;
+				ctx.runtime_args <- args;
 				[],Some ctx
 			| ("-L" | "--library" | "-lib") :: name :: args ->
 				let libs,args = find_subsequent_libs [name] args in

src/compiler/displayProcessing.ml

@@ -143,7 +143,7 @@ let process_display_file com actx =
 			DPKNone
 		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
 			actx.classes <- [];
-			com.main_class <- None;
+			com.main.main_class <- None;
 			begin match com.file_contents with
 			| [_, Some input] ->
 				com.file_contents <- [];
@@ -154,7 +154,7 @@ let process_display_file com actx =
 		| dfp ->
 			if dfp = DFPOnly then begin
 				actx.classes <- [];
-				com.main_class <- None;
+				com.main.main_class <- None;
 			end;
 			let real = Path.get_real_path (DisplayPosition.display_position#get).pfile in
 			let path = match get_module_path_from_file_path com real with

src/compiler/generate.ml

@@ -121,9 +121,16 @@ let generate ctx tctx ext actx =
 		| Java when not actx.jvm_flag -> Path.mkdir_from_path (com.file ^ "/.")
 		| _ -> Path.mkdir_from_path com.file
 	end;
-	if actx.interp then
-		Std.finally (Timer.timer ["interp"]) MacroContext.interpret tctx
-	else begin
+	if actx.interp then begin
+		let timer = Timer.timer ["interp"] in
+		let old = tctx.com.args in
+		tctx.com.args <- ctx.runtime_args;
+		let restore () =
+			tctx.com.args <- old;
+			timer ()
+		in
+		Std.finally restore MacroContext.interpret tctx
+	end else begin
 		let generate,name = match com.platform with
 		| Flash ->
 			let header = try

src/compiler/hxb/hxbWriter.ml

@@ -2237,8 +2237,8 @@ module HxbWriter = struct
 			let deps = DynArray.create () in
 			PMap.iter (fun _ mdep ->
 				match mdep.md_kind with
-				| MCode | MExtern | MFake when mdep.md_sign = m.m_extra.m_sign ->
-						DynArray.add deps mdep.md_path;
+				| MCode | MExtern when mdep.md_sign = m.m_extra.m_sign ->
+					DynArray.add deps mdep.md_path;
 				| _ ->
 					()
 			) m.m_extra.m_deps;

src/context/common.ml

@@ -340,6 +340,11 @@ class virtual abstract_hxb_lib = object(self)
 	method virtual get_file_path : string
 end
 
+type context_main = {
+	mutable main_class : path option;
+	mutable main_expr : texpr option;
+}
+
 type context = {
 	compilation_step : int;
 	mutable stage : compiler_stage;
@@ -349,8 +354,7 @@ type context = {
 	mutable json_out : json_api option;
 	(* config *)
 	version : int;
-	args : string list;
-	mutable sys_args : string list;
+	mutable args : string list;
 	mutable display : DisplayTypes.DisplayMode.settings;
 	mutable debug : bool;
 	mutable verbose : bool;
@@ -359,7 +363,7 @@ type context = {
 	mutable config : platform_config;
 	empty_class_path : ClassPath.class_path;
 	class_paths : ClassPaths.class_paths;
-	mutable main_class : path option;
+	main : context_main;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable report_mode : report_mode;
 	(* communication *)
@@ -400,7 +404,6 @@ type context = {
 	mutable file : string;
 	mutable features : (string,bool) Hashtbl.t;
 	mutable modules : Type.module_def list;
-	mutable main : Type.texpr option;
 	mutable types : Type.module_type list;
 	mutable resources : (string,string) Hashtbl.t;
 	(* target-specific *)
@@ -806,7 +809,6 @@ let create compilation_step cs version args display_mode =
 			display_module_has_macro_defines = false;
 			module_diagnostics = [];
 		};
-		sys_args = args;
 		debug = false;
 		display = display_mode;
 		verbose = false;
@@ -819,7 +821,10 @@ let create compilation_step cs version args display_mode =
 		run_command_args = (fun s args -> com.run_command (Printf.sprintf "%s %s" s (String.concat " " args)));
 		empty_class_path = new ClassPath.directory_class_path "" User;
 		class_paths = new ClassPaths.class_paths;
-		main_class = None;
+		main = {
+			main_class = None;
+			main_expr = None;
+		};
 		package_rules = PMap.empty;
 		file = "";
 		types = [];
@@ -828,7 +833,6 @@ let create compilation_step cs version args display_mode =
 		modules = [];
 		module_lut = new module_lut;
 		module_nonexistent_lut = new hashtbl_lookup;
-		main = None;
 		flash_version = 10.;
 		resources = Hashtbl.create 0;
 		net_std = [];
@@ -907,7 +911,10 @@ let clone com is_macro_context =
 			tbool = mk_mono();
 			tstring = mk_mono();
 		};
-		main_class = None;
+		main = {
+			main_class = None;
+			main_expr = None;
+		};
 		features = Hashtbl.create 0;
 		callbacks = new compiler_callbacks;
 		display_information = {
@@ -1231,6 +1238,6 @@ let get_entry_point com =
 			| Some c when (PMap.mem "main" c.cl_statics) -> c
 			| _ -> Option.get (ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types)
 		in
-		let e = Option.get com.main in (* must be present at this point *)
+		let e = Option.get com.main.main_expr in (* must be present at this point *)
 		(snd path, c, e)
-	) com.main_class
+	) com.main.main_class

src/context/display/displayFields.ml

@@ -250,54 +250,51 @@ let collect ctx e_ast e dk with_type p =
 					end
 				| _ -> items
 			in
-			(* Anon own fields *)
-			let fields = match !(an.a_status) with
-				| ClassStatics c -> c.cl_statics
-				| _ -> an.a_fields
+			let iter_fields origin fields f_allow f_make =
+				let items = PMap.fold (fun cf acc ->
+					if is_new_item acc cf.cf_name && f_allow cf then begin
+						let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta cf.cf_meta) cf.cf_type in
+						PMap.add cf.cf_name (f_make (CompletionClassField.make cf CFSMember origin true) (cf.cf_type,ct)) acc
+					end else
+						acc
+				) fields items in
+				items
 			in
-			PMap.foldi (fun name cf acc ->
-				if is_new_item acc name then begin
-					let allow_static_abstract_access c cf =
+			begin match !(an.a_status) with
+				| ClassStatics ({cl_kind = KAbstractImpl a} as c) ->
+					Display.merge_core_doc ctx (TClassDecl c);
+					let f_allow cf =
 						should_access c cf false &&
 						(not (has_class_field_flag cf CfImpl) || has_class_field_flag cf CfEnum)
 					in
-					let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta cf.cf_meta) cf.cf_type in
-					let add origin make_field =
-						PMap.add name (make_field (CompletionClassField.make cf CFSMember origin true) (cf.cf_type,ct)) acc
+					let f_make ccf =
+						if has_class_field_flag ccf.CompletionClassField.field CfEnum then
+							make_ci_enum_abstract_field a ccf
+						else
+							make_ci_class_field ccf
 					in
-					match !(an.a_status) with
-						| ClassStatics ({cl_kind = KAbstractImpl a} as c) ->
-							if allow_static_abstract_access c cf then
-								let make = if has_class_field_flag cf CfEnum then
-										(make_ci_enum_abstract_field a)
-									else
-										make_ci_class_field
-								in
-								add (Self (TAbstractDecl a)) make
-							else
-								acc;
-						| ClassStatics c ->
-							Display.merge_core_doc ctx (TClassDecl c);
-							if should_access c cf true then add (Self (TClassDecl c)) make_ci_class_field else acc;
-						| EnumStatics en ->
-							let ef = PMap.find name en.e_constrs in
-							PMap.add name (make_ci_enum_field (CompletionEnumField.make ef (Self (TEnumDecl en)) true) (cf.cf_type,ct)) acc
-						| AbstractStatics a ->
-							Display.merge_core_doc ctx (TAbstractDecl a);
-							let check = match a.a_impl with
-								| None -> true
-								| Some c -> allow_static_abstract_access c cf
-							in
-							if check then add (Self (TAbstractDecl a)) make_ci_class_field else acc;
-						| _ ->
-							let origin = match t with
-								| TType(td,_) -> Self (TTypeDecl td)
-								| _ -> AnonymousStructure an
-							in
-							add origin make_ci_class_field;
-				end else
-					acc
-			) fields items
+					iter_fields (Self (TClassDecl c)) c.cl_statics f_allow f_make
+				| ClassStatics c ->
+					Display.merge_core_doc ctx (TClassDecl c);
+					let f_allow cf = should_access c cf true in
+					iter_fields (Self (TClassDecl c)) c.cl_statics f_allow make_ci_class_field
+				| AbstractStatics ({a_impl = Some c} as a) ->
+					Display.merge_core_doc ctx (TAbstractDecl a);
+					let f_allow cf = should_access c cf true in
+					iter_fields (Self (TAbstractDecl a)) c.cl_statics f_allow make_ci_class_field
+				| EnumStatics en ->
+					PMap.fold (fun ef acc ->
+						let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta ef.ef_meta) ef.ef_type in
+						let cef = CompletionEnumField.make ef (Self (TEnumDecl en)) true in
+						PMap.add ef.ef_name (make_ci_enum_field cef (ef.ef_type,ct)) acc
+					) en.e_constrs items
+				| _ ->
+					let origin = match t with
+						| TType(td,_) -> Self (TTypeDecl td)
+						| _ -> AnonymousStructure an
+					in
+					iter_fields origin an.a_fields (fun _ -> true) make_ci_class_field
+			end
 		| TFun (args,ret) ->
 			(* A function has no field except the magic .bind one. *)
 			if is_new_item items "bind" then begin

src/context/display/importHandling.ml

@@ -152,7 +152,7 @@ let init_import ctx path mode p =
 				| Some(newname,pname) ->
 					let mt = get_type tname in
 					check_alias mt newname pname;
-					ctx.m.import_resolution#add (module_type_resolution mt (Some newname) p2)
+					ctx.m.import_resolution#add (module_type_resolution mt (Some newname) p)
 				end
 			| [tsub,p2] ->
 				let pu = punion p1 p2 in

src/context/memory.ml

@@ -169,6 +169,9 @@ let get_memory_json (cs : CompilationCache.t) mreq =
 				"size",jint (mem_size cache_mem.(1));
 				"list",jarray l;
 			];
+			"binaryCache",jobject [
+				"size",jint (mem_size cache_mem.(2));
+			];
 		]
 	| MModule(sign,path) ->
 		let cc = cs#get_context sign in

src/generators/gencpp.ml

@@ -8478,7 +8478,7 @@ let generate_cppia ctx =
       );
    ) common_ctx.types;
 
-   (match common_ctx.main with
+   (match common_ctx.main.main_expr with
    | None -> script#writeOpLine IaNoMain;
    | Some e -> script#writeOpLine IaMain;
          script#gen_expression e
@@ -8590,7 +8590,7 @@ let generate_source ctx =
    List.iter (fun job -> job () ) !jobs;
 
 
-   (match common_ctx.main with
+   (match common_ctx.main.main_expr with
    | None -> generate_dummy_main common_ctx
    | Some e ->
       let main_field = { (mk_field "__main__" t_dynamic e.epos null_pos) with
@@ -8653,7 +8653,7 @@ let generate_source ctx =
      end;
    end;
 
-   let output_name = match  common_ctx.main_class with
+   let output_name = match  common_ctx.main.main_class with
    | Some path -> (snd path)
    | _ -> "output" in
 

src/generators/genhl.ml

@@ -4187,7 +4187,7 @@ let generate com =
 
 	let ctx = create_context com false dump in
 	add_types ctx com.types;
-	let code = build_code ctx com.types com.main in
+	let code = build_code ctx com.types com.main.main_expr in
 	Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
 	if dump then begin
 		(match ctx.dump_out with None -> () | Some ch -> IO.close_out ch);

src/generators/genjs.ml

@@ -1970,7 +1970,7 @@ let generate com =
 	end;
 	List.iter (gen_block_element ~newline_after:true ~keep_blocks:(ctx.es_version >= 6) ctx) (List.rev ctx.inits);
 	List.iter (generate_static ctx) (List.rev ctx.statics);
-	(match com.main with
+	(match com.main.main_expr with
 	| None -> ()
 	| Some e -> gen_expr ctx e; newline ctx);
 	if ctx.js_modern then begin

src/generators/genlua.ml

@@ -2200,7 +2200,7 @@ let generate com =
             gen_value ctx { e with eexpr = TFunction fn; etype = TFun ([],com.basic.tvoid) };
         println ctx ", _hx_handle_error)";
         println ctx "if not success then _G.error(err) end";
-    ) com.main;
+    ) com.main.main_expr;
 
     if anyExposed then
         println ctx "return _hx_exports";

src/generators/genneko.ml

@@ -780,7 +780,7 @@ let generate com =
 		{ psource = "<header>"; pline = 1; }
 	) in
 	let el = build ctx com.types in
-	let emain = (match com.main with None -> [] | Some e -> [gen_expr ctx e]) in
+	let emain = (match com.main.main_expr with None -> [] | Some e -> [gen_expr ctx e]) in
 	let e = (EBlock ((header()) @ libs :: el @ emain), null_pos) in
 	let source = Common.defined com Define.NekoSource in
 	let use_nekoc = Common.defined com Define.UseNekoc in

src/generators/genphp7.ml

@@ -4038,7 +4038,7 @@ class generator (ctx:php_generator_context) =
 			Returns PHP code for entry point
 		*)
 		method private get_entry_point : (string * string) option =
-			match ctx.pgc_common.main with
+			match ctx.pgc_common.main.main_expr with
 				| None -> None
 				| Some expr ->
 					let writer = new code_writer ctx ([], "") "" in