common.ml 37 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230
  1. (*
  2. The Haxe Compiler
  3. Copyright (C) 2005-2019 Haxe Foundation
  4. This program is free software; you can redistribute it and/or
  5. modify it under the terms of the GNU General Public License
  6. as published by the Free Software Foundation; either version 2
  7. of the License, or (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  15. *)
  16. open Extlib_leftovers
  17. open Ast
  18. open Type
  19. open Globals
  20. open Lookup
  21. open Define
  22. open NativeLibraries
  23. open Warning
  24. type package_rule =
  25. | Forbidden
  26. | Remap of string
  27. type pos = Globals.pos
  28. let const_type basic const default =
  29. match const with
  30. | TString _ -> basic.tstring
  31. | TInt _ -> basic.tint
  32. | TFloat _ -> basic.tfloat
  33. | TBool _ -> basic.tbool
  34. | _ -> default
  35. type stats = {
  36. s_files_parsed : int ref;
  37. s_classes_built : int ref;
  38. s_methods_typed : int ref;
  39. s_macros_called : int ref;
  40. }
  41. (**
  42. The capture policy tells which handling we make of captured locals
  43. (the locals which are referenced in local functions)
  44. See details/implementation in Codegen.captured_vars
  45. *)
  46. type capture_policy =
  47. (** do nothing, let the platform handle it *)
  48. | CPNone
  49. (** wrap all captured variables into a single-element array to allow modifications *)
  50. | CPWrapRef
  51. (** similar to wrap ref, but will only apply to the locals that are declared in loops *)
  52. | CPLoopVars
  53. type exceptions_config = {
  54. (* Base types which may be thrown from Haxe code without wrapping. *)
  55. ec_native_throws : path list;
  56. (* Base types which may be caught from Haxe code without wrapping. *)
  57. ec_native_catches : path list;
  58. (*
  59. Hint exceptions filter to avoid wrapping for targets, which can throw/catch any type
  60. Ignored on targets with a specific native base type for exceptions.
  61. *)
  62. ec_avoid_wrapping : bool;
  63. (* Path of a native class or interface, which can be used for wildcard catches. *)
  64. ec_wildcard_catch : path;
  65. (*
  66. Path of a native base class or interface, which can be thrown.
  67. This type is used to cast `haxe.Exception.thrown(v)` calls to.
  68. For example `throw 123` is compiled to `throw (cast Exception.thrown(123):ec_base_throw)`
  69. *)
  70. ec_base_throw : path;
  71. (*
  72. Checks if throwing this expression is a special case for current target
  73. and should not be modified.
  74. *)
  75. ec_special_throw : texpr -> bool;
  76. }
  77. type var_scope =
  78. | FunctionScope
  79. | BlockScope
  80. type var_scoping_flags =
  81. (**
  82. Variables are hoisted in their scope
  83. *)
  84. | VarHoisting
  85. (**
  86. It's not allowed to shadow existing variables in a scope.
  87. *)
  88. | NoShadowing
  89. (**
  90. It's not allowed to shadow a `catch` variable.
  91. *)
  92. | NoCatchVarShadowing
  93. (**
  94. Local vars cannot have the same name as the current top-level package or
  95. (if in the root package) current class name
  96. *)
  97. | ReserveCurrentTopLevelSymbol
  98. (**
  99. Local vars cannot have a name used for any top-level symbol
  100. (packages and classes in the root package)
  101. *)
  102. | ReserveAllTopLevelSymbols
  103. (**
  104. Reserve all type-paths converted to "flat path" with `Path.flat_path`
  105. *)
  106. | ReserveAllTypesFlat
  107. (**
  108. List of names cannot be taken by local vars
  109. *)
  110. | ReserveNames of string list
  111. (**
  112. Cases in a `switch` won't have blocks, but will share the same outer scope.
  113. *)
  114. | SwitchCasesNoBlocks
  115. type var_scoping_config = {
  116. vs_flags : var_scoping_flags list;
  117. vs_scope : var_scope;
  118. }
  119. type platform_config = {
  120. (** has a static type system, with not-nullable basic types (Int/Float/Bool) *)
  121. pf_static : bool;
  122. (** has access to the "sys" package *)
  123. pf_sys : bool;
  124. (** captured variables handling (see before) *)
  125. pf_capture_policy : capture_policy;
  126. (** when calling a method with optional args, do we replace the missing args with "null" constants *)
  127. pf_pad_nulls : bool;
  128. (** add a final return to methods not having one already - prevent some compiler warnings *)
  129. pf_add_final_return : bool;
  130. (** does the platform natively support overloaded functions *)
  131. pf_overload : bool;
  132. (** can the platform use default values for non-nullable arguments *)
  133. pf_can_skip_non_nullable_argument : bool;
  134. (** type paths that are reserved on the platform *)
  135. pf_reserved_type_paths : path list;
  136. (** supports function == function **)
  137. pf_supports_function_equality : bool;
  138. (** uses utf16 encoding with ucs2 api **)
  139. pf_uses_utf16 : bool;
  140. (** target supports accessing `this` before calling `super(...)` **)
  141. pf_this_before_super : bool;
  142. (** target supports threads **)
  143. pf_supports_threads : bool;
  144. (** target supports Unicode **)
  145. pf_supports_unicode : bool;
  146. (** target supports rest arguments **)
  147. pf_supports_rest_args : bool;
  148. (** exceptions handling config **)
  149. pf_exceptions : exceptions_config;
  150. (** the scoping of local variables *)
  151. pf_scoping : var_scoping_config;
  152. (** target supports atomic operations via haxe.Atomic **)
  153. pf_supports_atomics : bool;
  154. }
  155. class compiler_callbacks = object(self)
  156. val before_typer_create = ref [];
  157. val after_init_macros = ref [];
  158. val mutable after_typing = [];
  159. val before_save = ref [];
  160. val after_save = ref [];
  161. val after_filters = ref [];
  162. val after_generation = ref [];
  163. val mutable null_safety_report = [];
  164. method add_before_typer_create (f : unit -> unit) : unit =
  165. before_typer_create := f :: !before_typer_create
  166. method add_after_init_macros (f : unit -> unit) : unit =
  167. after_init_macros := f :: !after_init_macros
  168. method add_after_typing (f : module_type list -> unit) : unit =
  169. after_typing <- f :: after_typing
  170. method add_before_save (f : unit -> unit) : unit =
  171. before_save := f :: !before_save
  172. method add_after_save (f : unit -> unit) : unit =
  173. after_save := f :: !after_save
  174. method add_after_filters (f : unit -> unit) : unit =
  175. after_filters := f :: !after_filters
  176. method add_after_generation (f : unit -> unit) : unit =
  177. after_generation := f :: !after_generation
  178. method add_null_safety_report (f : (string*pos) list -> unit) : unit =
  179. null_safety_report <- f :: null_safety_report
  180. method run handle_error r =
  181. match !r with
  182. | [] ->
  183. ()
  184. | l ->
  185. r := [];
  186. List.iter (fun f -> try f() with Error.Error err -> handle_error err) (List.rev l);
  187. self#run handle_error r
  188. method get_before_typer_create = before_typer_create
  189. method get_after_init_macros = after_init_macros
  190. method get_after_typing = after_typing
  191. method get_before_save = before_save
  192. method get_after_save = after_save
  193. method get_after_filters = after_filters
  194. method get_after_generation = after_generation
  195. method get_null_safety_report = null_safety_report
  196. end
  197. class file_keys = object(self)
  198. val cache = Hashtbl.create 0
  199. method get file =
  200. try
  201. Hashtbl.find cache file
  202. with Not_found ->
  203. let key = Path.UniqueKey.create file in
  204. Hashtbl.add cache file key;
  205. key
  206. end
  207. type shared_display_information = {
  208. mutable diagnostics_messages : diagnostic list;
  209. }
  210. type display_information = {
  211. mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list;
  212. mutable display_module_has_macro_defines : bool;
  213. mutable module_diagnostics : DisplayTypes.module_diagnostics list;
  214. }
  215. (* This information is shared between normal and macro context. *)
  216. type shared_context = {
  217. shared_display_information : shared_display_information;
  218. }
  219. type json_api = {
  220. send_result : Json.t -> unit;
  221. send_error : Json.t list -> unit;
  222. jsonrpc : Jsonrpc_handler.jsonrpc_handler;
  223. }
  224. type compiler_stage =
  225. | CCreated (* Context was just created *)
  226. | CInitialized (* Context was initialized (from CLI args and such). *)
  227. | CInitMacrosStart (* Init macros are about to run. *)
  228. | CInitMacrosDone (* Init macros did run - at this point the signature is locked. *)
  229. | CTypingDone (* The typer is done - at this point com.types/modules/main is filled. *)
  230. | CFilteringStart (* Filtering just started (nothing changed yet). *)
  231. | CAnalyzerStart (* Some filters did run, the analyzer is about to run. *)
  232. | CAnalyzerDone (* The analyzer just finished. *)
  233. | CSaveStart (* The type state is about to be saved. *)
  234. | CSaveDone (* The type state has been saved - at this point we can destroy things. *)
  235. | CDceStart (* DCE is about to run - everything is still available. *)
  236. | CDceDone (* DCE just finished. *)
  237. | CFilteringDone (* Filtering just finished. *)
  238. | CGenerationStart (* Generation is about to begin. *)
  239. | CGenerationDone (* Generation just finished. *)
  240. let s_compiler_stage = function
  241. | CCreated -> "CCreated"
  242. | CInitialized -> "CInitialized"
  243. | CInitMacrosStart -> "CInitMacrosStart"
  244. | CInitMacrosDone -> "CInitMacrosDone"
  245. | CTypingDone -> "CTypingDone"
  246. | CFilteringStart -> "CFilteringStart"
  247. | CAnalyzerStart -> "CAnalyzerStart"
  248. | CAnalyzerDone -> "CAnalyzerDone"
  249. | CSaveStart -> "CSaveStart"
  250. | CSaveDone -> "CSaveDone"
  251. | CDceStart -> "CDceStart"
  252. | CDceDone -> "CDceDone"
  253. | CFilteringDone -> "CFilteringDone"
  254. | CGenerationStart -> "CGenerationStart"
  255. | CGenerationDone -> "CGenerationDone"
  256. type report_mode =
  257. | RMNone
  258. | RMLegacyDiagnostics of (Path.UniqueKey.t list)
  259. | RMDiagnostics of (Path.UniqueKey.t list)
  260. | RMStatistics
  261. class module_lut = object(self)
  262. inherit [path,module_def] hashtbl_lookup as super
  263. val type_lut : (path,path) lookup = new hashtbl_lookup
  264. method add_module_type (m : module_def) (mt : module_type) =
  265. let t = t_infos mt in
  266. try
  267. let path2 = type_lut#find t.mt_path in
  268. let p = t.mt_pos in
  269. if m.m_path <> path2 && String.lowercase_ascii (s_type_path path2) = String.lowercase_ascii (s_type_path m.m_path) then Error.raise_typing_error ("Module " ^ s_type_path path2 ^ " is loaded with a different case than " ^ s_type_path m.m_path) p;
  270. let m2 = self#find path2 in
  271. let hex1 = Digest.to_hex m.m_extra.m_sign in
  272. let hex2 = Digest.to_hex m2.m_extra.m_sign in
  273. let s = if hex1 = hex2 then hex1 else Printf.sprintf "was %s, is %s" hex2 hex1 in
  274. Error.raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path) (s_type_path path2) s) p
  275. with Not_found ->
  276. type_lut#add t.mt_path m.m_path
  277. method! add (path : path) (m : module_def) =
  278. super#add path m;
  279. List.iter (fun mt -> self#add_module_type m mt) m.m_types
  280. method! remove (path : path) =
  281. try
  282. List.iter (fun mt -> type_lut#remove (t_path mt)) (self#find path).m_types;
  283. super#remove path;
  284. with Not_found ->
  285. ()
  286. method find_by_type (path : path) =
  287. self#find (type_lut#find path)
  288. method! clear =
  289. super#clear;
  290. type_lut#clear
  291. method get_type_lut = type_lut
  292. end
  293. class virtual abstract_hxb_lib = object(self)
  294. method virtual load : unit
  295. method virtual get_bytes : string -> path -> bytes option
  296. method virtual close : unit
  297. method virtual get_file_path : string
  298. end
  299. type context_main = {
  300. mutable main_class : path option;
  301. mutable main_expr : texpr option;
  302. }
  303. type context = {
  304. compilation_step : int;
  305. mutable stage : compiler_stage;
  306. cs : CompilationCache.t;
  307. mutable cache : CompilationCache.context_cache option;
  308. is_macro_context : bool;
  309. mutable json_out : json_api option;
  310. (* config *)
  311. version : int;
  312. mutable args : string list;
  313. mutable display : DisplayTypes.DisplayMode.settings;
  314. mutable debug : bool;
  315. mutable verbose : bool;
  316. mutable foptimize : bool;
  317. mutable platform : platform;
  318. mutable config : platform_config;
  319. empty_class_path : ClassPath.class_path;
  320. class_paths : ClassPaths.class_paths;
  321. main : context_main;
  322. mutable package_rules : (string,package_rule) PMap.t;
  323. mutable report_mode : report_mode;
  324. (* communication *)
  325. mutable print : string -> unit;
  326. mutable error : ?depth:int -> string -> pos -> unit;
  327. mutable error_ext : Error.error -> unit;
  328. mutable info : ?depth:int -> ?from_macro:bool -> string -> pos -> unit;
  329. mutable warning : ?depth:int -> ?from_macro:bool -> warning -> Warning.warning_option list list -> string -> pos -> unit;
  330. mutable warning_options : Warning.warning_option list list;
  331. mutable get_messages : unit -> compiler_message list;
  332. mutable filter_messages : (compiler_message -> bool) -> unit;
  333. mutable run_command : string -> int;
  334. mutable run_command_args : string -> string list -> int;
  335. (* typing setup *)
  336. mutable load_extern_type : (string * (path -> pos -> Ast.package option)) list; (* allow finding types which are not in sources *)
  337. callbacks : compiler_callbacks;
  338. defines : Define.define;
  339. mutable user_defines : (string, Define.user_define) Hashtbl.t;
  340. mutable user_metas : (string, Meta.user_meta) Hashtbl.t;
  341. mutable get_macros : unit -> context option;
  342. (* typing state *)
  343. mutable std : tclass;
  344. mutable global_metadata : (string list * metadata_entry * (bool * bool * bool)) list;
  345. shared : shared_context;
  346. display_information : display_information;
  347. file_keys : file_keys;
  348. mutable file_contents : (Path.UniqueKey.t * string option) list;
  349. parser_cache : (string,(type_def * pos) list) lookup;
  350. module_to_file : (path,ClassPaths.resolved_file) lookup;
  351. cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) lookup;
  352. stored_typed_exprs : (int, texpr) lookup;
  353. overload_cache : ((path * string),(Type.t * tclass_field) list) lookup;
  354. module_lut : module_lut;
  355. module_nonexistent_lut : (path,bool) lookup;
  356. fake_modules : (Path.UniqueKey.t,module_def) Hashtbl.t;
  357. mutable has_error : bool;
  358. pass_debug_messages : string DynArray.t;
  359. (* output *)
  360. mutable file : string;
  361. mutable features : (string,bool) Hashtbl.t;
  362. mutable modules : Type.module_def list;
  363. mutable types : Type.module_type list;
  364. mutable resources : (string,string) Hashtbl.t;
  365. functional_interface_lut : (path,(tclass * tclass_field)) lookup;
  366. (* target-specific *)
  367. mutable flash_version : float;
  368. mutable neko_lib_paths : string list;
  369. mutable include_files : (string * string) list;
  370. mutable native_libs : native_libraries;
  371. mutable hxb_libs : abstract_hxb_lib list;
  372. mutable net_std : string list;
  373. net_path_map : (path,string list * string list * string) Hashtbl.t;
  374. mutable js_gen : (unit -> unit) option;
  375. (* misc *)
  376. mutable basic : basic_types;
  377. memory_marker : float array;
  378. mutable hxb_reader_api : HxbReaderApi.hxb_reader_api option;
  379. hxb_reader_stats : HxbReader.hxb_reader_stats;
  380. mutable hxb_writer_config : HxbWriterConfig.t option;
  381. }
  382. let enter_stage com stage =
  383. (* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)
  384. com.stage <- stage
  385. let ignore_error com =
  386. let b = com.display.dms_error_policy = EPIgnore in
  387. if b then com.has_error <- true;
  388. b
  389. let module_warning com m w options msg p =
  390. DynArray.add m.m_extra.m_cache_bound_objects (Warning(w,msg,p));
  391. com.warning w options msg p
  392. (* Defines *)
  393. module Define = Define
  394. let defined com s =
  395. Define.defined com.defines s
  396. let raw_defined com v =
  397. Define.raw_defined com.defines v
  398. let defined_value com v =
  399. Define.defined_value com.defines v
  400. let defined_value_safe ?default com v =
  401. match default with
  402. | Some s -> Define.defined_value_safe ~default:s com.defines v
  403. | None -> Define.defined_value_safe com.defines v
  404. let define com v =
  405. Define.define com.defines v
  406. let raw_define com v =
  407. Define.raw_define com.defines v
  408. let define_value com k v =
  409. Define.define_value com.defines k v
  410. let convert_define k =
  411. String.concat "_" (ExtString.String.nsplit k "-")
  412. let is_next com = defined com HaxeNext
  413. let external_defined ctx k =
  414. Define.raw_defined ctx.defines (convert_define k)
  415. let external_defined_value ctx k =
  416. Define.raw_defined_value ctx.defines (convert_define k)
  417. let reserved_flags = [
  418. "true";"false";"null";"cross";"js";"lua";"neko";"flash";"php";"cpp";"java";"jvm";"python";"hl";"hlc";
  419. "swc";"macro";"sys";"static";"utf16";"haxe";"haxe_ver"
  420. ]
  421. let reserved_flag_namespaces = ["target"]
  422. let convert_and_validate k =
  423. let converted_flag = convert_define k in
  424. let raise_reserved description =
  425. raise (Arg.Bad (description ^ " and cannot be defined from the command line"))
  426. in
  427. if List.mem converted_flag reserved_flags then
  428. raise_reserved (Printf.sprintf "`%s` is a reserved compiler flag" k);
  429. List.iter (fun ns ->
  430. if ExtString.String.starts_with converted_flag (ns ^ ".") then
  431. raise_reserved (Printf.sprintf "`%s` uses the reserved compiler flag namespace `%s.*`" k ns)
  432. ) reserved_flag_namespaces;
  433. converted_flag
  434. let external_define_value ctx k v =
  435. raw_define_value ctx.defines (convert_and_validate k) v
  436. let external_define ctx k =
  437. Define.raw_define ctx.defines (convert_and_validate k)
  438. let external_undefine ctx k =
  439. Define.raw_undefine ctx.defines (convert_and_validate k)
  440. let defines_for_external ctx =
  441. PMap.foldi (fun k v acc ->
  442. let added_underscore = PMap.add k v acc in
  443. match ExtString.String.nsplit k "_" with
  444. | [_] -> added_underscore
  445. | split -> PMap.add (String.concat "-" split) v added_underscore;
  446. ) ctx.defines.values PMap.empty
  447. let get_es_version com =
  448. try int_of_string (defined_value com Define.JsEs) with _ -> 0
  449. let short_platform_name = function
  450. | Cross -> "x"
  451. | Js -> "js"
  452. | Lua -> "lua"
  453. | Neko -> "n"
  454. | Flash -> "swf"
  455. | Php -> "php"
  456. | Cpp -> "cpp"
  457. | Jvm -> "jvm"
  458. | Python -> "py"
  459. | Hl -> "hl"
  460. | Eval -> "evl"
  461. | CustomTarget n -> "c_" ^ n
  462. let stats =
  463. {
  464. s_files_parsed = ref 0;
  465. s_classes_built = ref 0;
  466. s_methods_typed = ref 0;
  467. s_macros_called = ref 0;
  468. }
  469. let default_config =
  470. {
  471. pf_static = true;
  472. pf_sys = true;
  473. pf_capture_policy = CPNone;
  474. pf_pad_nulls = false;
  475. pf_add_final_return = false;
  476. pf_overload = false;
  477. pf_can_skip_non_nullable_argument = true;
  478. pf_reserved_type_paths = [];
  479. pf_supports_function_equality = true;
  480. pf_uses_utf16 = true;
  481. pf_this_before_super = true;
  482. pf_supports_threads = false;
  483. pf_supports_unicode = true;
  484. pf_supports_rest_args = false;
  485. pf_exceptions = {
  486. ec_native_throws = [];
  487. ec_native_catches = [];
  488. ec_wildcard_catch = (["StdTypes"],"Dynamic");
  489. ec_base_throw = (["StdTypes"],"Dynamic");
  490. ec_avoid_wrapping = true;
  491. ec_special_throw = fun _ -> false;
  492. };
  493. pf_scoping = {
  494. vs_scope = BlockScope;
  495. vs_flags = [];
  496. };
  497. pf_supports_atomics = false;
  498. }
  499. let get_config com =
  500. let defined f = PMap.mem (Define.get_define_key f) com.defines.values in
  501. match com.platform with
  502. | Cross ->
  503. default_config
  504. | CustomTarget _ ->
  505. (* impossible to reach. see update_platform_config *)
  506. raise Exit
  507. | Js ->
  508. let es6 = get_es_version com >= 6 in
  509. {
  510. default_config with
  511. pf_static = false;
  512. pf_sys = false;
  513. pf_capture_policy = if es6 then CPNone else CPLoopVars;
  514. pf_reserved_type_paths = [([],"Object");([],"Error")];
  515. pf_this_before_super = not es6; (* cannot access `this` before `super()` when generating ES6 classes *)
  516. pf_supports_rest_args = true;
  517. pf_exceptions = { default_config.pf_exceptions with
  518. ec_native_throws = [
  519. ["js";"lib"],"Error";
  520. ["haxe"],"Exception";
  521. ];
  522. ec_avoid_wrapping = false;
  523. };
  524. pf_scoping = {
  525. vs_scope = if es6 then BlockScope else FunctionScope;
  526. vs_flags =
  527. (if defined Define.JsUnflatten then ReserveAllTopLevelSymbols else ReserveAllTypesFlat)
  528. :: if es6 then [NoShadowing; SwitchCasesNoBlocks;] else [VarHoisting; NoCatchVarShadowing];
  529. };
  530. pf_supports_atomics = true;
  531. }
  532. | Lua ->
  533. {
  534. default_config with
  535. pf_static = false;
  536. pf_capture_policy = CPLoopVars;
  537. pf_uses_utf16 = false;
  538. pf_supports_rest_args = true;
  539. pf_exceptions = { default_config.pf_exceptions with
  540. ec_avoid_wrapping = false;
  541. }
  542. }
  543. | Neko ->
  544. {
  545. default_config with
  546. pf_static = false;
  547. pf_pad_nulls = true;
  548. pf_uses_utf16 = false;
  549. pf_supports_threads = true;
  550. pf_supports_unicode = false;
  551. pf_scoping = { default_config.pf_scoping with
  552. vs_flags = [ReserveAllTopLevelSymbols];
  553. }
  554. }
  555. | Flash ->
  556. {
  557. default_config with
  558. pf_sys = false;
  559. pf_capture_policy = CPLoopVars;
  560. pf_can_skip_non_nullable_argument = false;
  561. pf_reserved_type_paths = [([],"Object");([],"Error")];
  562. pf_supports_rest_args = true;
  563. pf_exceptions = { default_config.pf_exceptions with
  564. ec_native_throws = [
  565. ["flash";"errors"],"Error";
  566. ["haxe"],"Exception";
  567. ];
  568. ec_native_catches = [
  569. ["flash";"errors"],"Error";
  570. ["haxe"],"Exception";
  571. ];
  572. ec_avoid_wrapping = false;
  573. };
  574. pf_scoping = {
  575. vs_scope = FunctionScope;
  576. vs_flags = [VarHoisting];
  577. };
  578. }
  579. | Php ->
  580. {
  581. default_config with
  582. pf_static = false;
  583. pf_uses_utf16 = false;
  584. pf_supports_rest_args = true;
  585. pf_exceptions = { default_config.pf_exceptions with
  586. ec_native_throws = [
  587. ["php"],"Throwable";
  588. ["haxe"],"Exception";
  589. ];
  590. ec_native_catches = [
  591. ["php"],"Throwable";
  592. ["haxe"],"Exception";
  593. ];
  594. ec_wildcard_catch = (["php"],"Throwable");
  595. ec_base_throw = (["php"],"Throwable");
  596. };
  597. pf_scoping = {
  598. vs_scope = FunctionScope;
  599. vs_flags = [VarHoisting]
  600. }
  601. }
  602. | Cpp ->
  603. {
  604. default_config with
  605. pf_capture_policy = CPWrapRef;
  606. pf_pad_nulls = true;
  607. pf_add_final_return = true;
  608. pf_supports_threads = true;
  609. pf_supports_unicode = (defined Define.Cppia) || not (defined Define.DisableUnicodeStrings);
  610. pf_scoping = { default_config.pf_scoping with
  611. vs_flags = [NoShadowing];
  612. vs_scope = FunctionScope;
  613. };
  614. pf_supports_atomics = true;
  615. }
  616. | Jvm ->
  617. {
  618. default_config with
  619. pf_capture_policy = CPWrapRef;
  620. pf_pad_nulls = true;
  621. pf_overload = true;
  622. pf_supports_threads = true;
  623. pf_supports_rest_args = true;
  624. pf_this_before_super = false;
  625. pf_exceptions = { default_config.pf_exceptions with
  626. ec_native_throws = [
  627. ["java";"lang"],"RuntimeException";
  628. ["haxe"],"Exception";
  629. ];
  630. ec_native_catches = [
  631. ["java";"lang"],"Throwable";
  632. ["haxe"],"Exception";
  633. ];
  634. ec_wildcard_catch = (["java";"lang"],"Throwable");
  635. ec_base_throw = (["java";"lang"],"RuntimeException");
  636. };
  637. pf_supports_atomics = true;
  638. }
  639. | Python ->
  640. {
  641. default_config with
  642. pf_static = false;
  643. pf_capture_policy = CPLoopVars;
  644. pf_uses_utf16 = false;
  645. pf_supports_threads = true;
  646. pf_supports_rest_args = true;
  647. pf_exceptions = { default_config.pf_exceptions with
  648. ec_native_throws = [
  649. ["python";"Exceptions"],"BaseException";
  650. ];
  651. ec_native_catches = [
  652. ["python";"Exceptions"],"BaseException";
  653. ];
  654. ec_wildcard_catch = ["python";"Exceptions"],"BaseException";
  655. ec_base_throw = ["python";"Exceptions"],"BaseException";
  656. };
  657. pf_scoping = {
  658. vs_scope = FunctionScope;
  659. vs_flags = [VarHoisting]
  660. };
  661. }
  662. | Hl ->
  663. {
  664. default_config with
  665. pf_capture_policy = CPWrapRef;
  666. pf_pad_nulls = true;
  667. pf_supports_threads = true;
  668. pf_supports_atomics = true;
  669. pf_scoping = {
  670. vs_scope = BlockScope;
  671. vs_flags = [NoShadowing]
  672. };
  673. }
  674. | Eval ->
  675. {
  676. default_config with
  677. pf_static = false;
  678. pf_pad_nulls = true;
  679. pf_uses_utf16 = false;
  680. pf_supports_threads = true;
  681. pf_capture_policy = CPWrapRef;
  682. }
  683. let memory_marker = [|Unix.time()|]
  684. let create compilation_step cs version args display_mode =
  685. let rec com = {
  686. compilation_step = compilation_step;
  687. cs = cs;
  688. cache = None;
  689. stage = CCreated;
  690. version = version;
  691. args = args;
  692. shared = {
  693. shared_display_information = {
  694. diagnostics_messages = [];
  695. }
  696. };
  697. display_information = {
  698. unresolved_identifiers = [];
  699. display_module_has_macro_defines = false;
  700. module_diagnostics = [];
  701. };
  702. debug = false;
  703. display = display_mode;
  704. verbose = false;
  705. foptimize = true;
  706. features = Hashtbl.create 0;
  707. platform = Cross;
  708. config = default_config;
  709. print = (fun s -> print_string s; flush stdout);
  710. run_command = Sys.command;
  711. run_command_args = (fun s args -> com.run_command (Printf.sprintf "%s %s" s (String.concat " " args)));
  712. empty_class_path = new ClassPath.directory_class_path "" User;
  713. class_paths = new ClassPaths.class_paths;
  714. main = {
  715. main_class = None;
  716. main_expr = None;
  717. };
  718. package_rules = PMap.empty;
  719. file = "";
  720. types = [];
  721. callbacks = new compiler_callbacks;
  722. global_metadata = [];
  723. modules = [];
  724. module_lut = new module_lut;
  725. module_nonexistent_lut = new hashtbl_lookup;
  726. fake_modules = Hashtbl.create 0;
  727. flash_version = 10.;
  728. resources = Hashtbl.create 0;
  729. net_std = [];
  730. native_libs = create_native_libs();
  731. hxb_libs = [];
  732. net_path_map = Hashtbl.create 0;
  733. neko_lib_paths = [];
  734. include_files = [];
  735. js_gen = None;
  736. load_extern_type = [];
  737. defines = {
  738. defines_signature = None;
  739. values = PMap.empty;
  740. };
  741. user_defines = Hashtbl.create 0;
  742. user_metas = Hashtbl.create 0;
  743. get_macros = (fun() -> None);
  744. info = (fun ?depth ?from_macro _ _ -> die "" __LOC__);
  745. warning = (fun ?depth ?from_macro _ _ _ -> die "" __LOC__);
  746. warning_options = [];
  747. error = (fun ?depth _ _ -> die "" __LOC__);
  748. error_ext = (fun _ -> die "" __LOC__);
  749. get_messages = (fun() -> []);
  750. filter_messages = (fun _ -> ());
  751. pass_debug_messages = DynArray.create();
  752. basic = {
  753. tvoid = mk_mono();
  754. tint = mk_mono();
  755. tfloat = mk_mono();
  756. tbool = mk_mono();
  757. tstring = mk_mono();
  758. tcoro_control = mk_mono();
  759. tnull = (fun _ -> die "Could use locate abstract Null<T> (was it redefined?)" __LOC__);
  760. tarray = (fun _ -> die "Could not locate class Array<T> (was it redefined?)" __LOC__);
  761. tcoro = (fun _ -> die "Could not locate abstract Coroutine<T> (was it redefined?)" __LOC__);
  762. };
  763. std = null_class;
  764. file_keys = new file_keys;
  765. file_contents = [];
  766. module_to_file = new hashtbl_lookup;
  767. stored_typed_exprs = new hashtbl_lookup;
  768. cached_macros = new hashtbl_lookup;
  769. memory_marker = memory_marker;
  770. parser_cache = new hashtbl_lookup;
  771. overload_cache = new hashtbl_lookup;
  772. json_out = None;
  773. has_error = false;
  774. report_mode = RMNone;
  775. is_macro_context = false;
  776. functional_interface_lut = new Lookup.hashtbl_lookup;
  777. hxb_reader_api = None;
  778. hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
  779. hxb_writer_config = None;
  780. } in
  781. com
  782. let is_diagnostics com = match com.report_mode with
  783. | RMLegacyDiagnostics _ | RMDiagnostics _ -> true
  784. | _ -> false
  785. let is_compilation com = com.display.dms_kind = DMNone && not (is_diagnostics com)
  786. let disable_report_mode com =
  787. let old = com.report_mode in
  788. com.report_mode <- RMNone;
  789. (fun () -> com.report_mode <- old)
  790. let log com str =
  791. if com.verbose then com.print (str ^ "\n")
  792. let clone com is_macro_context =
  793. let t = com.basic in
  794. { com with
  795. cache = None;
  796. basic = { t with
  797. tvoid = mk_mono();
  798. tint = mk_mono();
  799. tfloat = mk_mono();
  800. tbool = mk_mono();
  801. tstring = mk_mono();
  802. tcoro_control = mk_mono();
  803. };
  804. main = {
  805. main_class = None;
  806. main_expr = None;
  807. };
  808. features = Hashtbl.create 0;
  809. callbacks = new compiler_callbacks;
  810. display_information = {
  811. unresolved_identifiers = [];
  812. display_module_has_macro_defines = false;
  813. module_diagnostics = [];
  814. };
  815. defines = {
  816. values = com.defines.values;
  817. defines_signature = com.defines.defines_signature;
  818. };
  819. native_libs = create_native_libs();
  820. is_macro_context = is_macro_context;
  821. parser_cache = new hashtbl_lookup;
  822. module_to_file = new hashtbl_lookup;
  823. overload_cache = new hashtbl_lookup;
  824. module_lut = new module_lut;
  825. fake_modules = Hashtbl.create 0;
  826. hxb_reader_api = None;
  827. hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
  828. std = null_class;
  829. functional_interface_lut = new Lookup.hashtbl_lookup;
  830. empty_class_path = new ClassPath.directory_class_path "" User;
  831. class_paths = new ClassPaths.class_paths;
  832. }
  833. let file_time file = Extc.filetime file
  834. let flash_versions = List.map (fun v ->
  835. let maj = int_of_float v in
  836. let min = int_of_float (mod_float (v *. 10.) 10.) in
  837. v, string_of_int maj ^ (if min = 0 then "" else "_" ^ string_of_int min)
  838. ) [9.;10.;10.1;10.2;10.3;11.;11.1;11.2;11.3;11.4;11.5;11.6;11.7;11.8;11.9;12.0;13.0;14.0;15.0;16.0;17.0;18.0;19.0;20.0;21.0;22.0;23.0;24.0;25.0;26.0;27.0;28.0;29.0;31.0;32.0]
  839. let flash_version_tag = function
  840. | 6. -> 6
  841. | 7. -> 7
  842. | 8. -> 8
  843. | 9. -> 9
  844. | 10. | 10.1 -> 10
  845. | 10.2 -> 11
  846. | 10.3 -> 12
  847. | 11. -> 13
  848. | 11.1 -> 14
  849. | 11.2 -> 15
  850. | 11.3 -> 16
  851. | 11.4 -> 17
  852. | 11.5 -> 18
  853. | 11.6 -> 19
  854. | 11.7 -> 20
  855. | 11.8 -> 21
  856. | 11.9 -> 22
  857. | v when v >= 12.0 && float_of_int (int_of_float v) = v -> int_of_float v + 11
  858. | v -> failwith ("Invalid SWF version " ^ string_of_float v)
  859. let update_platform_config com =
  860. match com.platform with
  861. | CustomTarget _ ->
  862. () (* do nothing, configured with macro api *)
  863. | _ ->
  864. com.config <- get_config com
  865. let init_platform com =
  866. let name = platform_name com.platform in
  867. begin match com.platform with
  868. | Flash when Path.file_extension com.file = "swc" ->
  869. define com Define.Swc
  870. | Jvm ->
  871. raw_define com "java"
  872. | Hl ->
  873. if Path.file_extension com.file = "c" then define com Define.Hlc;
  874. | _ ->
  875. ()
  876. end;
  877. (* Set the source header, unless the user has set one already or the platform sets a custom one *)
  878. if not (defined com Define.SourceHeader) && (com.platform <> Hl) then
  879. define_value com Define.SourceHeader ("Generated by Haxe " ^ s_version_full);
  880. let forbid acc p = if p = name || PMap.mem p acc then acc else PMap.add p Forbidden acc in
  881. com.package_rules <- List.fold_left forbid com.package_rules ("java" :: (List.map platform_name platforms));
  882. update_platform_config com;
  883. if com.config.pf_static then begin
  884. raw_define com "target.static";
  885. define com Define.Static;
  886. end;
  887. if com.config.pf_sys then begin
  888. raw_define com "target.sys";
  889. define com Define.Sys
  890. end else
  891. com.package_rules <- PMap.add "sys" Forbidden com.package_rules;
  892. if com.config.pf_uses_utf16 then begin
  893. raw_define com "target.utf16";
  894. define com Define.Utf16;
  895. end;
  896. if com.config.pf_supports_threads then begin
  897. raw_define com "target.threaded";
  898. end;
  899. if com.config.pf_supports_unicode then begin
  900. raw_define com "target.unicode";
  901. end;
  902. raw_define_value com.defines "target.name" name;
  903. raw_define com (match com.platform with | CustomTarget _ -> "custom_target" | _ -> name);
  904. if com.config.pf_supports_atomics then begin
  905. raw_define com "target.atomics"
  906. end
  907. let set_platform com pf file =
  908. if com.platform <> Cross then failwith "Multiple targets";
  909. com.platform <- pf;
  910. com.file <- file
  911. let set_custom_target com name path =
  912. if List.find_opt (fun pf -> (platform_name pf) = name) platforms <> None then
  913. raise (Arg.Bad (Printf.sprintf "--custom-target cannot use reserved name %s" name));
  914. if String.length name > max_custom_target_len then
  915. raise (Arg.Bad (Printf.sprintf "--custom-target name %s exceeds the maximum of %d characters" name max_custom_target_len));
  916. let name_regexp = Str.regexp "^[a-zA-Z0-9\\_]+$" in
  917. if Str.string_match name_regexp name 0 then
  918. set_platform com (CustomTarget name) path
  919. else
  920. raise (Arg.Bad (Printf.sprintf "--custom-target name %s may only contain alphanumeric or underscore characters" name))
  921. let add_feature com f =
  922. Hashtbl.replace com.features f true
  923. let has_dce com =
  924. (try defined_value com Define.Dce <> "no" with Not_found -> false)
  925. (*
  926. TODO: The has_dce check is there because we mark types with @:directlyUsed in the DCE filter,
  927. which is not run in dce=no and thus we can't know if a type is used directly or not,
  928. so we just assume that they are.
  929. If we had dce filter always running (even with dce=no), we would have types marked with @:directlyUsed
  930. and we wouldn't need to generate unnecessary imports in dce=no, but that's good enough for now.
  931. *)
  932. let is_directly_used com meta =
  933. not (has_dce com) || Meta.has Meta.DirectlyUsed meta
  934. let rec has_feature com f =
  935. try
  936. Hashtbl.find com.features f
  937. with Not_found ->
  938. if com.types = [] then not (has_dce com) else
  939. match List.rev (ExtString.String.nsplit f ".") with
  940. | [] -> die "" __LOC__
  941. | [cl] -> has_feature com (cl ^ ".*")
  942. | field :: cl :: pack ->
  943. let r = (try
  944. let path = List.rev pack, cl in
  945. (match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) com.types with
  946. | t when field = "*" ->
  947. not (has_dce com) ||
  948. begin match t with
  949. | TClassDecl c ->
  950. has_class_flag c CUsed;
  951. | TAbstractDecl a ->
  952. Meta.has Meta.ValueUsed a.a_meta
  953. | _ -> Meta.has Meta.Used (t_infos t).mt_meta
  954. end;
  955. | TClassDecl c when (has_class_flag c CExtern) && (com.platform <> Js || cl <> "Array" && cl <> "Math") ->
  956. not (has_dce com) || has_class_field_flag (try PMap.find field c.cl_statics with Not_found -> PMap.find field c.cl_fields) CfUsed
  957. | TClassDecl c ->
  958. PMap.exists field c.cl_statics || PMap.exists field c.cl_fields
  959. | _ ->
  960. false)
  961. with Not_found ->
  962. false
  963. ) in
  964. Hashtbl.add com.features f r;
  965. r
  966. let allow_package ctx s =
  967. try
  968. if (PMap.find s ctx.package_rules) = Forbidden then ctx.package_rules <- PMap.remove s ctx.package_rules
  969. with Not_found ->
  970. ()
  971. let platform ctx p = ctx.platform = p
  972. let platform_name_macro com =
  973. if defined com Define.Macro then "macro"
  974. else platform_name com.platform
  975. let find_file ctx f =
  976. (ctx.class_paths#find_file f).file
  977. (* let find_file ctx f =
  978. let timer = Timer.timer ["find_file"] in
  979. Std.finally timer (find_file ctx) f *)
  980. let mem_size v =
  981. Objsize.size_with_headers (Objsize.objsize v [] [])
  982. let hash f =
  983. let h = ref 0 in
  984. for i = 0 to String.length f - 1 do
  985. h := !h * 223 + int_of_char (String.unsafe_get f i);
  986. done;
  987. if Sys.word_size = 64 then Int32.to_int (Int32.shift_right (Int32.shift_left (Int32.of_int !h) 1) 1) else !h
  988. let url_encode s add_char =
  989. let hex = "0123456789ABCDEF" in
  990. for i = 0 to String.length s - 1 do
  991. let c = String.unsafe_get s i in
  992. match c with
  993. | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '-' | '.' ->
  994. add_char c
  995. | _ ->
  996. add_char '%';
  997. add_char (String.unsafe_get hex (int_of_char c lsr 4));
  998. add_char (String.unsafe_get hex (int_of_char c land 0xF));
  999. done
  1000. let url_encode_s s =
  1001. let b = Buffer.create 0 in
  1002. url_encode s (Buffer.add_char b);
  1003. Buffer.contents b
  1004. (* UTF8 *)
  1005. let to_utf8 str p =
  1006. let u8 = try
  1007. UTF8.validate str;
  1008. str;
  1009. with
  1010. UTF8.Malformed_code ->
  1011. (* ISO to utf8 *)
  1012. let b = UTF8.Buf.create 0 in
  1013. String.iter (fun c -> UTF8.Buf.add_char b (UCharExt.of_char c)) str;
  1014. UTF8.Buf.contents b
  1015. in
  1016. let ccount = ref 0 in
  1017. UTF8.iter (fun c ->
  1018. let c = UCharExt.code c in
  1019. if (c >= 0xD800 && c <= 0xDFFF) || c >= 0x110000 then Error.abort "Invalid unicode char" p;
  1020. incr ccount;
  1021. if c > 0x10000 then incr ccount;
  1022. ) u8;
  1023. u8, !ccount
  1024. let utf16_add buf c =
  1025. let add c =
  1026. Buffer.add_char buf (char_of_int (c land 0xFF));
  1027. Buffer.add_char buf (char_of_int (c lsr 8));
  1028. in
  1029. if c >= 0 && c < 0x10000 then begin
  1030. if c >= 0xD800 && c <= 0xDFFF then failwith ("Invalid unicode char " ^ string_of_int c);
  1031. add c;
  1032. end else if c < 0x110000 then begin
  1033. let c = c - 0x10000 in
  1034. add ((c asr 10) + 0xD800);
  1035. add ((c land 1023) + 0xDC00);
  1036. end else
  1037. failwith ("Invalid unicode char " ^ string_of_int c)
  1038. let utf8_to_utf16 str zt =
  1039. let b = Buffer.create (String.length str * 2) in
  1040. (try UTF8.iter (fun c -> utf16_add b (UCharExt.code c)) str with Invalid_argument _ | UCharExt.Out_of_range -> ()); (* if malformed *)
  1041. if zt then utf16_add b 0;
  1042. Buffer.contents b
  1043. let utf16_to_utf8 str =
  1044. let b = Buffer.create 0 in
  1045. let add c = Buffer.add_char b (char_of_int (c land 0xFF)) in
  1046. let get i = int_of_char (String.unsafe_get str i) in
  1047. let rec loop i =
  1048. if i >= String.length str then ()
  1049. else begin
  1050. let c = get i in
  1051. if c < 0x80 then begin
  1052. add c;
  1053. loop (i + 2);
  1054. end else if c < 0x800 then begin
  1055. let c = c lor ((get (i + 1)) lsl 8) in
  1056. add c;
  1057. add (c lsr 8);
  1058. loop (i + 2);
  1059. end else
  1060. die "" __LOC__;
  1061. end
  1062. in
  1063. loop 0;
  1064. Buffer.contents b
  1065. let add_diagnostics_message ?(depth = 0) ?(code = None) com s p kind sev =
  1066. if sev = MessageSeverity.Error then com.has_error <- true;
  1067. let di = com.shared.shared_display_information in
  1068. di.diagnostics_messages <- (make_diagnostic ~depth ~code s p kind sev) :: di.diagnostics_messages
  1069. let display_error_ext com err =
  1070. if is_diagnostics com then begin
  1071. Error.recurse_error (fun depth err ->
  1072. add_diagnostics_message ~depth com (Error.error_msg err.err_message) err.err_pos MessageKind.DKCompilerMessage MessageSeverity.Error;
  1073. ) err;
  1074. end else
  1075. com.error_ext err
  1076. let display_error com ?(depth = 0) msg p =
  1077. display_error_ext com (Error.make_error ~depth (Custom msg) p)
  1078. let dump_path com =
  1079. Define.defined_value_safe ~default:"dump" com.defines Define.DumpPath
  1080. let adapt_defines_to_macro_context defines =
  1081. let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in
  1082. let to_remove = List.fold_left (fun acc d -> Define.get_define_key d :: acc) to_remove [Define.NoTraces] in
  1083. let to_remove = List.fold_left (fun acc (_, d) -> ("flash" ^ d) :: acc) to_remove flash_versions in
  1084. let macro_defines = {
  1085. values = PMap.foldi (fun k v acc ->
  1086. if List.mem k to_remove then acc else PMap.add k v acc) defines.values PMap.empty;
  1087. defines_signature = None
  1088. } in
  1089. Define.define macro_defines Define.Macro;
  1090. Define.raw_define macro_defines (platform_name Eval);
  1091. macro_defines
  1092. let adapt_defines_to_display_context defines =
  1093. let defines = adapt_defines_to_macro_context defines in
  1094. Define.define defines Define.Display;
  1095. defines
  1096. let is_legacy_completion com = match com.json_out with
  1097. | None -> true
  1098. | Some api -> !ServerConfig.legacy_completion
  1099. let get_entry_point com =
  1100. Option.map (fun path ->
  1101. let m = List.find (fun m -> m.m_path = path) com.modules in
  1102. let c =
  1103. match m.m_statics with
  1104. | Some c when (PMap.mem "main" c.cl_statics) -> c
  1105. | _ -> Option.get (ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types)
  1106. in
  1107. let e = Option.get com.main.main_expr in (* must be present at this point *)
  1108. (snd path, c, e)
  1109. ) com.main.main_class
  1110. let expand_coro_type basic args ret =
  1111. let ret_type = if ExtType.is_void (follow ret) then t_dynamic else ret in
  1112. let tcontinuation = tfun [ret_type; t_dynamic] basic.tvoid in
  1113. let args = args @ [("_hx_continuation",false,tcontinuation)] in
  1114. let ret = tfun [t_dynamic; basic.tcoro_control] basic.tvoid in
  1115. (args,ret)