diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 6e3fa8750aa..e40459bdac7 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -276,8 +276,10 @@ let do_type ctx mctx actx = let cs = com.cs in CommonCache.maybe_add_context_sign cs com "before_init_macros"; com.stage <- CInitMacrosStart; + ServerMessage.compiler_stage com; List.iter (MacroContext.call_init_macro ctx.com mctx) (List.rev actx.config_macros); com.stage <- CInitMacrosDone; + ServerMessage.compiler_stage com; let tctx = Setup.create_typer_context ctx actx.native_libs in tctx.g.macros <- mctx; check_defines ctx.com; @@ -289,6 +291,7 @@ let do_type ctx mctx actx = Finalization.finalize tctx; ) (); com.stage <- CTypingDone; + ServerMessage.compiler_stage com; (* If we are trying to find references, let's syntax-explore everything we know to check for the identifier we are interested in. We then type only those modules that contain the identifier. *) begin match com.display.dms_kind with @@ -302,6 +305,7 @@ let finalize_typing ctx tctx = let t = Timer.timer ["finalize"] in let com = ctx.com in com.stage <- CFilteringStart; + ServerMessage.compiler_stage com; let main, types, modules = run_or_diagnose ctx Finalization.generate tctx in com.main <- main; com.types <- types; @@ -347,6 +351,7 @@ let compile ctx actx callbacks = List.iter (fun f -> f()) (List.rev (actx.pre_compilation)); t(); com.stage <- CInitialized; + ServerMessage.compiler_stage com; if actx.classes = [([],"Std")] && not actx.force_typing then begin if actx.cmds = [] && not actx.did_something then actx.raise_usage(); end else begin @@ -354,6 +359,7 @@ let compile ctx actx callbacks = (* let tctx = Setup.create_typer_context ctx actx.native_libs in *) (* tctx.g.macros <- mctx; *) com.stage <- CTyperCreated; + ServerMessage.compiler_stage com; (* let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in *) let tctx = try do_type ctx mctx actx @@ -370,8 +376,10 @@ let compile ctx actx callbacks = if ctx.has_error then raise Abort; Generate.check_auxiliary_output com actx; com.stage <- CGenerationStart; + ServerMessage.compiler_stage com; if not actx.no_output then Generate.generate ctx tctx ext actx; com.stage <- CGenerationDone; + ServerMessage.compiler_stage com; end; Sys.catch_break false; com.callbacks#run com.callbacks#get_after_generation; diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml index f53e538497b..bca50584cd0 100644 --- a/src/compiler/serverMessage.ml +++ b/src/compiler/serverMessage.ml @@ -4,6 +4,7 @@ open CompilationCache open Type type server_message_options = { + mutable print_compiler_stage : bool; mutable print_added_directory : bool; mutable print_found_directories : bool; mutable print_changed_directories : bool; @@ -30,6 +31,7 @@ type server_message_options = { } let config = { + print_compiler_stage = true; print_added_directory = false; print_found_directories = false; print_changed_directories = false; @@ -61,6 +63,9 @@ let sign_string com = let sign_id = (cs#get_context sign)#get_index in Printf.sprintf "%2i,%3s: " sign_id (short_platform_name com.platform) +let compiler_stage com = + if config.print_compiler_stage then print_endline (Printf.sprintf "compiler stage: %s" (s_compiler_stage com.stage)) + let added_directory com tabs dir = if config.print_added_directory then print_endline (Printf.sprintf "%sadded directory %s" (sign_string com) dir) @@ -156,6 +161,7 @@ let uncaught_error s = if config.print_uncaught_error then print_endline ("Uncaught Error : " ^ s) let enable_all () = + config.print_compiler_stage <- true; config.print_added_directory <- true; config.print_found_directories <- true; config.print_changed_directories <- true; @@ -180,6 +186,7 @@ let enable_all () = config.print_new_context <- true let set_by_name name value = match name with + | "compilerStage" -> config.print_compiler_stage <- value | "addedDirectory" -> config.print_added_directory <- value | "foundDirectories" -> config.print_found_directories <- value; | "changedDirectories" -> config.print_changed_directories <- value; diff --git a/src/context/common.ml b/src/context/common.ml index 5eecd221283..90f9d629dee 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -271,6 +271,24 @@ type compiler_stage = | CGenerationStart (* Generation is about to begin. *) | CGenerationDone (* Generation just finished. *) +let s_compiler_stage = function + | CCreated -> "CCreated" + | CInitialized -> "CInitialized" + | CTyperCreated -> "CTyperCreated" + | CInitMacrosStart -> "CInitMacrosStart" + | CInitMacrosDone -> "CInitMacrosDone" + | CTypingDone -> "CTypingDone" + | CFilteringStart -> "CFilteringStart" + | CAnalyzerStart -> "CAnalyzerStart" + | CAnalyzerDone -> "CAnalyzerDone" + | CSaveStart -> "CSaveStart" + | CSaveDone -> "CSaveDone" + | CDceStart -> "CDceStart" + | CDceDone -> "CDceDone" + | CFilteringDone -> "CFilteringDone" + | CGenerationStart -> "CGenerationStart" + | CGenerationDone -> "CGenerationDone" + type report_mode = | RMNone | RMDiagnostics of Path.UniqueKey.t list diff --git a/src/core/ast.ml b/src/core/ast.ml index d62f62ecf3d..ce9be2ea052 100644 --- a/src/core/ast.ml +++ b/src/core/ast.ml @@ -391,8 +391,10 @@ type type_decl = type_def * pos type package = string list * type_decl list let mk_type_path ?(params=[]) ?sub (pack,name) = - if name = "" then + if name = "" then begin + trace_call_stack ~n:20 (); raise (Invalid_argument "Empty module name is not allowed"); + end; { tpackage = pack; tname = name; tsub = sub; tparams = params; } let mk_evar ?(final=false) ?(static=false) ?(t:type_hint option) ?eo ?(meta=[]) name = diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 5de64fd7768..f25b0c2510e 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -595,11 +595,12 @@ let init_macro_interp mctx mint = ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Expr") p); ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Type") p); Interp.init mint; - if !macro_enable_cache && not (Common.defined mctx.com Define.NoMacroCache) then begin + (* if !macro_enable_cache && not (Common.defined mctx.com Define.NoMacroCache) then begin *) macro_interp_cache := Some mint; - end + (* end *) and flush_macro_context mint mctx = + trace "flush macro context"; let t = macro_timer mctx.com ["flush"] in let mctx = (match mctx.g.macros with None -> die "" __LOC__ | Some (_,mctx) -> mctx) in Finalization.finalize mctx; @@ -665,8 +666,10 @@ let create_macro_interp api mctx = | None -> let mint = Interp.create com2 api true in Interp.select mint; + trace "init macro interp"; mint, (fun() -> init_macro_interp mctx mint) | Some mint -> + trace "reuse interp"; Interp.do_reuse mint api; mint, (fun() -> ()) ) in @@ -790,7 +793,8 @@ let load_macro' ctx display cpath f p = fst (load_macro'' ctx.com (get_macro_context ctx) display cpath f p) let do_call_macro com api cpath f args p = - if com.verbose then Common.log com ("Calling macro " ^ s_type_path cpath ^ "." ^ f ^ " (" ^ p.pfile ^ ":" ^ string_of_int (Lexer.get_error_line p) ^ ")"); + (* if com.verbose then Common.log com ("Calling macro " ^ s_type_path cpath ^ "." ^ f ^ " (" ^ p.pfile ^ ":" ^ string_of_int (Lexer.get_error_line p) ^ ")"); *) + (* trace ("Calling macro " ^ s_type_path cpath ^ "." ^ f ^ " (" ^ p.pfile ^ ":" ^ string_of_int (Lexer.get_error_line p) ^ ")"); *) let t = macro_timer com ["execution";s_type_path cpath ^ "." ^ f] in incr stats.s_macros_called; let r = Interp.call_path (Interp.get_ctx()) ((fst cpath) @ [snd cpath]) f args api in @@ -799,6 +803,7 @@ let do_call_macro com api cpath f args p = r let load_macro ctx com display cpath f p = + trace (Printf.sprintf "load macro %s:%s" (s_type_path cpath) f); let api = make_macro_api ctx p in let mctx = get_macro_context ctx in let meth,mloaded = load_macro'' com mctx display cpath f p in @@ -816,6 +821,7 @@ type macro_arg_type = | MAOther let type_macro ctx mode cpath f (el:Ast.expr list) p = + trace (Printf.sprintf "type macro %s:%s" (s_type_path cpath) f); let mctx = get_macro_context ctx in let mctx, (margs,mret,mclass,mfield), call_macro = load_macro mctx ctx.com (mode = MDisplay) cpath f p in let margs = diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 49a418913a1..325b6f845eb 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -477,6 +477,8 @@ let apply_macro ctx mode path el p = | meth :: name :: pack -> (List.rev pack,name), meth | _ -> raise_typing_error "Invalid macro path" p ) in + trace "do_macro"; + if ctx.com.is_macro_context then trace "from macro context"; ctx.g.do_macro ctx mode cpath meth el p let build_module_def ctx mt meta fvars context_init fbuild =