: additional path");
- ("-v", Unit (fun () -> verbose := true), ": turn on verbose mode");
- ("-n", String (fun f -> remf := f::!remf),": don't compile this file");
- ("-mak", Unit (fun () -> gen_make := true), ": generate Makefile");
- ("-lp", String (fun f -> lflags := f::!lflags), " : linker parameter");
- ("-cp", String (fun f -> cflags := f::!cflags), "
: compiler parameter");
- ("-pp", String (fun c -> preprocessor := Some c), " : preprocessor");
- ("-epp", Unit (fun() -> error_process := true), ": use MSVC error messages format");
- ("-cpp", Unit (fun() -> chars_process := true), ": convert characters range in errors to file expression");
- ("-g", Unit (fun () -> lflags := "-g"::!lflags; cflags := "-g"::!cflags), ": compile/link in debug mode");
- ("-P", String (fun f -> priority := f::!priority), ": give linking priority to a file when linking ordering failed");
-] in
-Arg.parse arg_spec (fun arg -> argfiles := arg :: !argfiles) usage;
-let files = List.concat (List.map (list_files true) (List.rev !argfiles)) in
-let files = List.filter (fun (_,f) ->
- let name = Filename.basename f in
- not(List.exists (fun f -> Filename.basename f = name) !remf)) files in
-let compile_mode = get_compile_mode !compile_mode files in
-let output_file , compile_mode = (match !output_file with
- | None -> get_output_file !compile_cma compile_mode , compile_mode
- | Some file ->
- match extension file , compile_mode with
- | "CMA" , CM_OPT
- | "CMXA", CM_BYTE -> failwith "Mixed bytecode and native compilation files."
- | "CMA" , _ ->
- compile_cma := true;
- Some file , CM_BYTE
- | "CMXA" , _ ->
- compile_cma := true;
- Some file , CM_OPT
- | _ , _ ->
- Some file , compile_mode)
-in
-let opt = (compile_mode = CM_OPT) in
-if !compile_cma then lflags := "-a"::!lflags;
-match files with
- | [] -> Arg.usage arg_spec usage
- | _ ->
- let files = remove_duplicates files in
- let get_path (_,f) = "-I " ^ escape (Filename.dirname f) in
- let paths = List.map (fun p -> "-I " ^ (escape p)) !paths in
- let paths = remove_duplicates (paths@(List.map get_path files)) in
- let p4param = if_some (fun cmd -> "-pp " ^ (escape cmd)) !preprocessor "" in
- match !do_clean,!gen_make with
- | true,true ->
- failwith "Cannot have -mak & -clean at the same time"
- | false,false ->
- if_some delete_file output_file ();
- List.iter (pre_compile !rebuild_all) files;
- List.iter check_existence files;
- let g = build_graph opt (p4param::paths) files in
- let files = graph_topological_sort !rebuild_all g [] [] in
- List.iter (compile opt (!cflags @ p4param::paths)) files;
- if_some (link opt (!lflags @ paths) g (List.rev !priority)) output_file ();
- print "Done";
- | true,false ->
- print "Cleaning...";
- if_some delete_file output_file ();
- let to_clean = List.fold_left (clean_targets opt) [] files in
- List.iter delete_file to_clean;
- if opt && !compile_cma then
- if_some (fun f -> delete_file (f +! (if Sys.os_type = "Win32" then LIB else A))) output_file ();
- | false,true ->
- List.iter (pre_compile !rebuild_all) files;
- let g = build_graph opt (p4param::paths) files in
- let out = open_out "Makefile" in
- let fprint s = output_string out (s^"\n") in
- let genmak f =
- let ext = if opt then CMX else CMO in
- match f.ext with
- | MLL ->
- fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n")
- | MLY ->
- fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n");
- fprint ((f.name +! CMI)^": "^(f.name +! ML)^" "^(f.name +! MLI)^"\n")
- | _ when f.deps <> [] ->
- fprint (f.target^": "^(flatten f.deps)^"\n")
- | _ ->
- ()
- in
- let compiles = graph_topological_sort true g [] [] in
- let libs = List.filter is_lib compiles in
- let cmos = List.filter (fun f -> f.ext = ML) compiles in
- fprint "# Makefile generated by OCamake ";
- fprint "# http://tech.motion-twin.com";
- fprint ".SUFFIXES : .ml .mli .cmo .cmi .cmx .mll .mly";
- fprint "";
- fprint ("ALL_CFLAGS= $(CFLAGS) "^(flatten (!cflags @ p4param::paths)));
- fprint ("LIBS="^(flatten (List.map (fun f -> f.name) libs)));
- let targets = flatten (List.map (fun f -> f.target) cmos) in
- (match output_file with
- | None ->
- fprint "";
- fprint ("all: "^targets^"\n");
- | Some out ->
- fprint ("LFLAGS= -o "^out^" "^(flatten (!lflags @ paths)));
- fprint "";
- fprint ("all: "^out^"\n");
- fprint (out^": "^targets);
- (* I need to reuse the list of targets since $^ is for Make and $** for NMake *)
- fprint ("\t"^(if opt then "ocamlopt" else "ocamlc")^" $(LFLAGS) $(LIBS) "^targets^"\n"));
- List.iter genmak g;
- fprint "";
- fprint "clean:";
- let cleanfiles = flatten (List.fold_left (clean_targets opt) [] files) in
- if_some (fun o ->
- fprint ("\trm -f "^o);
- if opt && !compile_cma then fprint ("\trm -f "^(o +! LIB)^" "^(o +! A));
- ) output_file ();
- fprint ("\trm -f "^cleanfiles);
- fprint "";
- fprint "wclean:";
- if_some (fun o ->
- fprint ("\t-@del "^o^" 2>NUL");
- if opt && !compile_cma then fprint ("\t-@del "^(o +! LIB)^" "^(o +! A)^" 2>NUL");
- ) output_file ();
- fprint ("\t-@del "^cleanfiles^" 2>NUL");
- fprint "";
- fprint "# SUFFIXES";
- fprint ".ml.cmo:\n\tocamlc $(ALL_CFLAGS) -c $<\n";
- fprint ".ml.cmx:\n\tocamlopt $(ALL_CFLAGS) -c $<\n";
- fprint ".mli.cmi:\n\tocamlc $(ALL_CFLAGS) $<\n";
- fprint ".mll.ml:\n\tocamllex $<\n";
- fprint ".mly.ml:\n\tocamlyacc $<\n";
- close_out out
-with
- Failure msg ->
- Pervasives.flush Pervasives.stdout;
- prerr_endline msg;
- Pervasives.flush Pervasives.stderr;
- exit 1;
-
-(* ************************************************************************ *)
diff --git a/libs/swflib/swflib.sln b/libs/swflib/swflib.sln
deleted file mode 100644
index f54fa701975..00000000000
--- a/libs/swflib/swflib.sln
+++ /dev/null
@@ -1,21 +0,0 @@
-Microsoft Visual Studio Solution File, Format Version 8.00
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "swflib", "swflib.vcproj", "{A9DD9D90-85E1-4FCF-8C09-42BF78942849}"
- ProjectSection(ProjectDependencies) = postProject
- EndProjectSection
-EndProject
-Global
- GlobalSection(SolutionConfiguration) = preSolution
- Bytecode = Bytecode
- Native code = Native code
- EndGlobalSection
- GlobalSection(ProjectConfiguration) = postSolution
- {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.ActiveCfg = Bytecode|Win32
- {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.Build.0 = Bytecode|Win32
- {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.ActiveCfg = Native code|Win32
- {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.Build.0 = Native code|Win32
- EndGlobalSection
- GlobalSection(ExtensibilityGlobals) = postSolution
- EndGlobalSection
- GlobalSection(ExtensibilityAddIns) = postSolution
- EndGlobalSection
-EndGlobal
diff --git a/libs/swflib/swflib.vcproj b/libs/swflib/swflib.vcproj
deleted file mode 100644
index c7a98a04a6e..00000000000
--- a/libs/swflib/swflib.vcproj
+++ /dev/null
@@ -1,80 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/libs/ttflib/Makefile b/libs/ttflib/Makefile
deleted file mode 100644
index 3cbb76d3e41..00000000000
--- a/libs/ttflib/Makefile
+++ /dev/null
@@ -1,31 +0,0 @@
-OCAMLOPT=ocamlopt
-OCAMLC=ocamlc
-
-FLAGS=-package extlib -safe-string -I ../extlib-leftovers -I ../swflib
-FILES=tTFData tTFParser tTFTools tTFSwfWriter tTFCanvasWriter tTFJsonWriter
-LIBS=extLib swflib unix
-
-OUTPUT=ttf
-
-all: native bytecode
-
-native: ttflib.cmxa
-
-bytecode: ttflib.cma
-
-ttflib.cmxa: $(FILES:=.ml)
- ocamlfind $(OCAMLOPT) $(FLAGS) $(FILES:=.ml) -g -a -o ttflib.cmxa
-
-ttflib.cma: $(FILES:=.ml)
- ocamlfind $(OCAMLC) $(FLAGS) $(FILES:=.ml) -g -a -o ttflib.cma
-
-exec:
- ocamlfind $(OCAMLOPT) $(FLAGS) $(LIBS:=.cmxa) $(FILES:=.ml) main.ml -g -o $(OUTPUT)
-
-clean:
- rm -rf ttflib.cmxa ttflib.cma ttflib.lib ttflib.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo)
-
-.PHONY: all native bytecode clean exec
-
-Makefile: ;
-$(FILES:=.ml): ;
diff --git a/libs/ttflib/dune b/libs/ttflib/dune
deleted file mode 100644
index a6b89f8f656..00000000000
--- a/libs/ttflib/dune
+++ /dev/null
@@ -1,14 +0,0 @@
-(include_subdirs no)
-
-(env
- (_
- (flags (-w -3 -w -27 -w -35))
- )
-)
-
-(library
- (name ttflib)
- (libraries extlib extlib_leftovers swflib unix)
- (modules (:standard \ main))
- (wrapped false)
-)
diff --git a/libs/ttflib/main.ml b/libs/ttflib/main.ml
deleted file mode 100644
index ab500ec5240..00000000000
--- a/libs/ttflib/main.ml
+++ /dev/null
@@ -1,139 +0,0 @@
-open TTFData
-
-exception Abort
-
-let gen_hxswfml_debug fontname =
- let xml = "
-
-
-
-
-
-
- "
- in
- Std.output_file (fontname ^ ".fxml") xml;
- if Sys.command "haxe -main Main -swf main.swf" <> 0 then failwith "Error while executing haxe";
- if Sys.command ("hxswfml xml2swf \"" ^ fontname ^ ".fxml\" \"" ^ fontname ^ ".swf\" -no-strict") <> 0 then failwith "Error while executing hxswfml";
- Unix.unlink (fontname ^ ".fxml");
- Unix.unlink "main.swf"
-
-let normalize_path p =
- let l = String.length p in
- if l = 0 then
- "./"
- else begin
- let p = String.concat "/" (ExtString.String.nsplit p "\\") in
- match p.[l-1] with
- | '/' -> p
- | _ -> p ^ "/"
- end
-
-let mk_dir_rec dir =
- let dir = normalize_path dir in
- let parts = ExtString.String.nsplit dir "/" in
- let rec create acc = function
- | [] -> ()
- | "" :: [] -> ()
- | d :: l ->
- let dir = String.concat "/" (List.rev (d :: acc)) in
- if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;
- create (d :: acc) l
- in
- create [] parts
-
-let exit msg =
- prerr_endline msg;
- raise Abort
-
-let process args =
- let fonts = ref [] in
- let range_str = ref "" in
- let targets = ref [] in
- let debug_hxswfml = ref false in
- let args_callback s = fonts := s :: !fonts in
- let usage = Printf.sprintf
- "Ttf (-swf|-canvas)"
- in
- let basic_args = [
- ("-range",Arg.String (fun str ->
- range_str := str;
- )," : specifies the character range");
- ("-swf",Arg.String (fun dir ->
- mk_dir_rec dir;
- let f ttf range_str =
- let config = {
- ttfc_range_str = range_str;
- ttfc_font_name = None;
- ttfc_font_weight = TFWRegular;
- ttfc_font_posture = TFPNormal;
- } in
- let f2 = TTFSwfWriter.to_swf ttf config in
- let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".dat")) in
- let b = IO.output_bits ch in
- IO.write_i16 ch 1;
- TTFSwfWriter.write_font2 ch b f2;
- IO.close_out ch;
- if !debug_hxswfml then begin
- if not (Sys.file_exists "Main.hx") then failwith "Could not find Main.hx required for -hxswfml-debug";
- let main = Std.input_file "Main.hx" in
- let old = Sys.getcwd () in
- Sys.chdir dir;
- Std.output_file ~filename:"Main.hx" ~text:main;
- gen_hxswfml_debug ttf.ttf_font_name;
- Unix.unlink "Main.hx";
- Sys.chdir old;
- end
- in
- targets := f :: !targets;
- )," : generate swf tag data to ");
- ("-canvas", Arg.String (fun dir ->
- mk_dir_rec dir;
- let f ttf range_str =
- let glyphs = TTFCanvasWriter.to_canvas ttf range_str in
- let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".js")) in
- TTFCanvasWriter.write_font ch ttf glyphs;
- IO.close_out ch;
- in
- targets := f :: !targets;
- )," : generate canvas draw commands to ");
- ("-json", Arg.String (fun dir ->
- mk_dir_rec dir;
- let f ttf range_str =
- let glyphs = TTFJsonWriter.to_json ttf range_str in
- let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".js")) in
- TTFJsonWriter.write_font ch ttf glyphs;
- IO.close_out ch;
- in
- targets := f :: !targets;
- )," : generate json-encoded glyph information to ");
- ("-hxswfml-debug", Arg.Unit (fun () ->
- debug_hxswfml := true;
- ),": generate debug swf with hxswfml")
- ] in
- if Array.length Sys.argv = 1 then
- Arg.usage basic_args usage
- else begin
- Arg.parse basic_args args_callback usage;
- match !fonts,!targets with
- | [],_ ->
- prerr_endline "Missing font argument";
- Arg.usage basic_args usage
- | _,[] ->
- prerr_endline "No targets specified (-swf|-canvas|-json)";
- Arg.usage basic_args usage
- | fonts,targets ->
- List.iter (fun font ->
- let ch = try open_in_bin font with _ -> exit ("No such file: " ^ font) in
- let ttf = TTFParser.parse ch in
- List.iter (fun target ->
- target ttf !range_str
- ) targets;
- close_in ch;
- ) fonts;
- end
-;;
-try
- process Sys.argv;
-with Abort ->
- ()
diff --git a/libs/ttflib/tTFCanvasWriter.ml b/libs/ttflib/tTFCanvasWriter.ml
deleted file mode 100644
index c8112315688..00000000000
--- a/libs/ttflib/tTFCanvasWriter.ml
+++ /dev/null
@@ -1,50 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open TTFTools
-
-let rec write_glyph ttf key glyf =
- key,TTFTools.build_glyph_paths ttf false glyf
-
-let write_font ch ttf glyphs =
- let scale = 1024. /. (float_of_int ttf.ttf_head.hd_units_per_em) in
- List.iter (fun (key,paths) ->
- IO.nwrite_string ch (Printf.sprintf "\tfunction key%i(ctx) {\n" key);
- IO.nwrite_string ch "\t\tctx.beginPath();\n";
- List.iter (fun path ->
- IO.nwrite_string ch (match path.gp_type with
- | 0 -> Printf.sprintf "\t\tctx.moveTo(%.2f,%.2f);\n" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
- | 1 -> Printf.sprintf "\t\tctx.lineTo(%.2f,%.2f);\n" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
- | 2 -> Printf.sprintf "\t\tctx.quadraticCurveTo(%.2f,%.2f,%.2f,%.2f);\n" (path.gp_cx *. scale) (path.gp_cy *. scale *. (-1.)) (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
- | _ -> assert false)
- ) paths;
- IO.nwrite_string ch "\t\tctx.fill();\n";
- IO.nwrite_string ch "\t}\n";
- ) glyphs;
- ()
-
-let to_canvas ttf range_str =
- let lut = TTFTools.build_lut ttf range_str in
- let glyfs = Hashtbl.fold (fun k v acc -> (k,ttf.ttf_glyfs.(v)) :: acc) lut [] in
- let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
- List.map (fun (k,g) -> write_glyph ttf k g) glyfs
diff --git a/libs/ttflib/tTFData.ml b/libs/ttflib/tTFData.ml
deleted file mode 100644
index bd917a9c218..00000000000
--- a/libs/ttflib/tTFData.ml
+++ /dev/null
@@ -1,360 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-type header = {
- hd_major_version : int;
- hd_minor_version : int;
- hd_num_tables : int;
- hd_search_range : int;
- hd_entry_selector : int;
- hd_range_shift : int;
-}
-
-type entry = {
- entry_table_name : string;
- entry_checksum : int32;
- entry_offset : int32;
- entry_length: int32;
-}
-
-(* GLYF *)
-
-type glyf_header = {
- gh_num_contours : int;
- gh_xmin : int;
- gh_ymin : int;
- gh_xmax : int;
- gh_ymax : int;
-}
-
-type glyf_simple = {
- gs_end_pts_of_contours : int array;
- gs_instruction_length : int;
- gs_instructions : char array;
- gs_flags : int array;
- gs_x_coordinates : int array;
- gs_y_coordinates : int array;
-}
-
-type transformation_option =
- | NoScale
- | Scale of float
- | ScaleXY of float * float
- | ScaleMatrix of float * float * float * float
-
-type glyf_component = {
- gc_flags : int;
- gc_glyf_index : int;
- gc_arg1 : int;
- gc_arg2 : int;
- gc_transformation : transformation_option;
-}
-
-type glyf =
- | TGlyfSimple of glyf_header * glyf_simple
- | TGlyfComposite of glyf_header * glyf_component list
- | TGlyfNull
-
-(* HMTX *)
-
-type hmtx = {
- advance_width : int;
- left_side_bearing : int;
-}
-
-(* CMAP *)
-
-type cmap_subtable_header = {
- csh_platform_id : int;
- csh_platform_specific_id : int;
- csh_offset : int32;
-}
-
-type cmap_format_0 = {
- c0_format : int;
- c0_length : int;
- c0_language : int;
- c0_glyph_index_array : char array;
-}
-
-type cmap_format_4 = {
- c4_format : int;
- c4_length : int;
- c4_language : int;
- c4_seg_count_x2 : int;
- c4_search_range : int;
- c4_entry_selector : int;
- c4_range_shift : int;
- c4_end_code : int array;
- c4_reserved_pad : int;
- c4_start_code : int array;
- c4_id_delta : int array;
- c4_id_range_offset : int array;
- c4_glyph_index_array : int array;
-}
-
-type cmap_format_6 = {
- c6_format : int;
- c6_length : int;
- c6_language : int;
- c6_first_code : int;
- c6_entry_count : int;
- c6_glyph_index_array : int array;
-}
-
-type cmap_format_12_group = {
- c12g_start_char_code : int32;
- c12g_end_char_code : int32;
- c12g_start_glyph_code : int32;
-}
-
-type cmap_format_12 = {
- c12_format : int32;
- c12_length : int32;
- c12_language : int32;
- c12_num_groups : int32;
- c12_groups : cmap_format_12_group list;
-}
-
-type cmap_subtable_def =
- | Cmap0 of cmap_format_0
- | Cmap4 of cmap_format_4
- | Cmap6 of cmap_format_6
- | Cmap12 of cmap_format_12
- | CmapUnk of string
-
-type cmap_subtable = {
- cs_header : cmap_subtable_header;
- cs_def : cmap_subtable_def;
-}
-
-type cmap = {
- cmap_version : int;
- cmap_num_subtables : int;
- cmap_subtables : cmap_subtable list;
-}
-
-(* KERN *)
-
-type kern_subtable_header = {
- ksh_length : int32;
- ksh_coverage : int;
- ksh_tuple_index : int;
-}
-
-type kern_pair = {
- kern_left : int;
- kern_right : int;
- kern_value : int;
-}
-
-type kern_format_0 = {
- k0_num_pairs : int;
- k0_search_range : int;
- k0_entry_selector : int;
- k0_range_shift : int;
- k0_pairs : kern_pair list;
-}
-
-type kern_format_2 = {
- k2_row_width : int;
- k2_left_offset_table : int;
- k2_right_offset_table : int;
- k2_array : int;
- k2_first_glyph : int;
- k2_num_glyphs : int;
- k2_offsets : int list;
-}
-
-type kern_subtable_def =
- | Kern0 of kern_format_0
- | Kern2 of kern_format_2
-
-type kern_subtable = {
- ks_header : kern_subtable_header;
- ks_def : kern_subtable_def;
-}
-
-type kern = {
- kern_version : int32;
- kern_num_tables : int32;
- kern_subtables : kern_subtable list;
-}
-
-(* NAME *)
-
-type name_record = {
- nr_platform_id : int;
- nr_platform_specific_id : int;
- nr_language_id : int;
- nr_name_id : int;
- nr_length : int;
- nr_offset : int;
- mutable nr_value : string;
-}
-
-type name = {
- name_format : int;
- name_num_records : int;
- name_offset : int;
- name_records : name_record array;
-}
-
-(* HEAD *)
-
-type head = {
- hd_version : int32;
- hd_font_revision : int32;
- hd_checksum_adjustment : int32;
- hd_magic_number : int32;
- hd_flags : int;
- hd_units_per_em : int;
- hd_created : float;
- hd_modified : float;
- hd_xmin : int;
- hd_ymin : int;
- hd_xmax : int;
- hd_ymax : int;
- hd_mac_style : int;
- hd_lowest_rec_ppem : int;
- hd_font_direction_hint : int;
- hd_index_to_loc_format : int;
- hd_glyph_data_format : int;
-}
-
-(* HHEA *)
-
-type hhea = {
- hhea_version : int32;
- hhea_ascent : int;
- hhea_descent : int;
- hhea_line_gap : int;
- hhea_advance_width_max : int;
- hhea_min_left_side_bearing : int;
- hhea_min_right_side_bearing : int;
- hhea_x_max_extent : int;
- hhea_caret_slope_rise : int;
- hhea_caret_slope_run : int;
- hhea_caret_offset : int;
- hhea_reserved : string;
- hhea_metric_data_format : int;
- hhea_number_of_hmetrics :int;
-}
-
-(* LOCA *)
-
-type loca = int32 array
-
-(* MAXP *)
-
-type maxp = {
- maxp_version_number : int32;
- maxp_num_glyphs : int;
- maxp_max_points : int;
- maxp_max_contours : int;
- maxp_max_component_points : int;
- maxp_max_component_contours : int;
- maxp_max_zones : int;
- maxp_max_twilight_points : int;
- maxp_max_storage : int;
- maxp_max_function_defs : int;
- maxp_max_instruction_defs :int;
- maxp_max_stack_elements : int;
- maxp_max_size_of_instructions :int;
- maxp_max_component_elements :int;
- maxp_max_component_depth :int;
-}
-
-(* OS2 *)
-
-type os2 = {
- os2_version : int;
- os2_x_avg_char_width : int;
- os2_us_weight_class : int;
- os2_us_width_class : int;
- os2_fs_type : int;
- os2_y_subscript_x_size : int;
- os2_y_subscript_y_size : int;
- os2_y_subscript_x_offset : int;
- os2_y_subscript_y_offset : int;
- os2_y_superscript_x_size : int;
- os2_y_superscript_y_size : int;
- os2_y_superscript_x_offset : int;
- os2_y_superscript_y_offset : int;
- os2_y_strikeout_size : int;
- os2_y_strikeout_position : int;
- os2_s_family_class : int;
- os2_b_family_type : int;
- os2_b_serif_style : int;
- os2_b_weight : int;
- os2_b_proportion : int;
- os2_b_contrast : int;
- os2_b_stroke_variation : int;
- os2_b_arm_style : int;
- os2_b_letterform : int;
- os2_b_midline : int;
- os2_b_x_height : int;
- os2_ul_unicode_range_1 : int32;
- os2_ul_unicode_range_2 : int32;
- os2_ul_unicode_range_3 : int32;
- os2_ul_unicode_range_4 : int32;
- os2_ach_vendor_id : int32;
- os2_fs_selection : int;
- os2_us_first_char_index : int;
- os2_us_last_char_index : int;
- os2_s_typo_ascender : int;
- os2_s_typo_descender : int;
- os2_s_typo_line_gap : int;
- os2_us_win_ascent : int;
- os2_us_win_descent : int;
-}
-
-type ttf = {
- ttf_header : header;
- ttf_font_name : string;
- ttf_directory: (string,entry) Hashtbl.t;
- ttf_glyfs : glyf array;
- ttf_hmtx : hmtx array;
- ttf_cmap : cmap;
- ttf_head : head;
- ttf_loca : loca;
- ttf_hhea : hhea;
- ttf_maxp : maxp;
- ttf_name : name;
- ttf_os2 : os2;
- ttf_kern : kern option;
-}
-
-type ttf_font_weight =
- | TFWRegular
- | TFWBold
-
-type ttf_font_posture =
- | TFPNormal
- | TFPItalic
-
-type ttf_config = {
- mutable ttfc_range_str : string;
- mutable ttfc_font_name : string option;
- mutable ttfc_font_weight : ttf_font_weight;
- mutable ttfc_font_posture : ttf_font_posture;
-}
diff --git a/libs/ttflib/tTFJsonWriter.ml b/libs/ttflib/tTFJsonWriter.ml
deleted file mode 100644
index dbc1f3a5a40..00000000000
--- a/libs/ttflib/tTFJsonWriter.ml
+++ /dev/null
@@ -1,49 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open TTFTools
-
-let rec write_glyph ttf key glyf =
- key,TTFTools.build_glyph_paths ttf false glyf
-
-let write_font ch ttf glyphs =
- let scale = 1024. /. (float_of_int ttf.ttf_head.hd_units_per_em) in
- IO.nwrite_string ch "{\n\t";
- IO.nwrite_string ch (String.concat ",\n\t" (List.map (fun (key,paths) ->
- (Printf.sprintf "\"g%i\":[" key)
- ^ (String.concat "," (List.map (fun path ->
- match path.gp_type with
- | 0 -> Printf.sprintf "[0,%.2f,%.2f]" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
- | 1 -> Printf.sprintf "[1,%.2f,%.2f]" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
- | 2 -> Printf.sprintf "[2,%.2f,%.2f,%.2f,%.2f]" (path.gp_cx *. scale) (path.gp_cy *. scale *. (-1.)) (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
- | _ -> assert false
- ) paths))
- ^ "]";
- ) glyphs));
- IO.nwrite_string ch "\n}"
-
-let to_json ttf range_str =
- let lut = TTFTools.build_lut ttf range_str in
- let glyfs = Hashtbl.fold (fun k v acc -> (k,ttf.ttf_glyfs.(v)) :: acc) lut [] in
- let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
- List.map (fun (k,g) -> write_glyph ttf k g) glyfs
diff --git a/libs/ttflib/tTFParser.ml b/libs/ttflib/tTFParser.ml
deleted file mode 100644
index 9b3468ac7ee..00000000000
--- a/libs/ttflib/tTFParser.ml
+++ /dev/null
@@ -1,688 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open IO
-
-type ctx = {
- file : Stdlib.in_channel;
- ch : input;
- mutable entry : entry;
-}
-
-let rd16 = BigEndian.read_i16
-let rdu16 = BigEndian.read_ui16
-let rd32 = BigEndian.read_i32
-let rd32r = BigEndian.read_real_i32
-
-let parse_header ctx =
- let ch = ctx.ch in
- let major_version = rdu16 ch in
- let minor_version = rdu16 ch in
- let num_tables = rdu16 ch in
- let search_range = rdu16 ch in
- let entry_selector = rdu16 ch in
- let range_shift = rdu16 ch in
- {
- hd_major_version = major_version;
- hd_minor_version = minor_version;
- hd_num_tables = num_tables;
- hd_search_range = search_range;
- hd_entry_selector = entry_selector;
- hd_range_shift = range_shift;
- }
-
-let parse_directory ctx header =
- let ch = ctx.ch in
- let directory = Hashtbl.create 0 in
- for i = 0 to header.hd_num_tables - 1 do
- let name = nread_string ch 4 in
- let cs = rd32r ch in
- let off = rd32r ch in
- let length = rd32r ch in
- Hashtbl.add directory name {
- entry_table_name = name;
- entry_checksum = cs;
- entry_offset = off;
- entry_length = length;
- }
- done;
- directory
-
-let parse_head_table ctx =
- let ch = ctx.ch in
- let version = rd32r ch in
- let font_revision = rd32r ch in
- let checksum_adjustment = rd32r ch in
- let magic_number = rd32r ch in
- let flags = rdu16 ch in
- let units_per_em = rdu16 ch in
- let created = BigEndian.read_double ch in
- let modified = BigEndian.read_double ch in
- let xmin = rd16 ch in
- let ymin = rd16 ch in
- let xmax = rd16 ch in
- let ymax = rd16 ch in
- let mac_style = rdu16 ch in
- let lowest_rec_ppem = rdu16 ch in
- let font_direction_hint = rd16 ch in
- let index_to_loc_format = rd16 ch in
- let glyph_data_format = rd16 ch in
- {
- hd_version = version;
- hd_font_revision = font_revision;
- hd_checksum_adjustment = checksum_adjustment;
- hd_magic_number = magic_number;
- hd_flags = flags;
- hd_units_per_em = units_per_em;
- hd_created = created;
- hd_modified = modified;
- hd_xmin = xmin;
- hd_ymin = ymin;
- hd_xmax = xmax;
- hd_ymax = ymax;
- hd_mac_style = mac_style;
- hd_lowest_rec_ppem = lowest_rec_ppem;
- hd_font_direction_hint = font_direction_hint;
- hd_index_to_loc_format = index_to_loc_format;
- hd_glyph_data_format = glyph_data_format;
- }
-
-let parse_hhea_table ctx =
- let ch = ctx.ch in
- let version = rd32r ch in
- let ascender = rd16 ch in
- let descender = rd16 ch in
- let line_gap = rd16 ch in
- let advance_width_max = rdu16 ch in
- let min_left_side_bearing = rd16 ch in
- let min_right_side_bearing = rd16 ch in
- let x_max_extent = rd16 ch in
- let caret_slope_rise = rd16 ch in
- let caret_slope_run = rd16 ch in
- let caret_offset = rd16 ch in
- let reserved = nread_string ch 8 in
- let metric_data_format = rd16 ch in
- let number_of_hmetrics = rdu16 ch in
- {
- hhea_version = version;
- hhea_ascent = ascender;
- hhea_descent = descender;
- hhea_line_gap = line_gap;
- hhea_advance_width_max = advance_width_max;
- hhea_min_left_side_bearing = min_left_side_bearing;
- hhea_min_right_side_bearing = min_right_side_bearing;
- hhea_x_max_extent = x_max_extent;
- hhea_caret_slope_rise = caret_slope_rise;
- hhea_caret_slope_run = caret_slope_run;
- hhea_caret_offset = caret_offset;
- hhea_reserved = reserved;
- hhea_metric_data_format = metric_data_format;
- hhea_number_of_hmetrics = number_of_hmetrics;
- }
-
-let parse_maxp_table ctx =
- let ch = ctx.ch in
- let version_number = rd32r ch in
- let num_glyphs = rdu16 ch in
- let max_points = rdu16 ch in
- let max_contours = rdu16 ch in
- let max_component_points = rdu16 ch in
- let max_component_contours = rdu16 ch in
- let max_zones = rdu16 ch in
- let max_twilight_points = rdu16 ch in
- let max_storage = rdu16 ch in
- let max_function_defs = rdu16 ch in
- let max_instruction_defs = rdu16 ch in
- let max_stack_elements = rdu16 ch in
- let max_size_of_instructions = rdu16 ch in
- let max_component_elements = rdu16 ch in
- let max_component_depth = rdu16 ch in
- {
- maxp_version_number = version_number;
- maxp_num_glyphs = num_glyphs;
- maxp_max_points = max_points;
- maxp_max_contours = max_contours;
- maxp_max_component_points = max_component_points;
- maxp_max_component_contours = max_component_contours;
- maxp_max_zones = max_zones;
- maxp_max_twilight_points = max_twilight_points;
- maxp_max_storage = max_storage;
- maxp_max_function_defs = max_function_defs;
- maxp_max_instruction_defs = max_instruction_defs;
- maxp_max_stack_elements = max_stack_elements;
- maxp_max_size_of_instructions = max_size_of_instructions;
- maxp_max_component_elements = max_component_elements;
- maxp_max_component_depth = max_component_depth;
- }
-
-let parse_loca_table head maxp ctx =
- let ch = ctx.ch in
- if head.hd_index_to_loc_format = 0 then
- Array.init (maxp.maxp_num_glyphs + 1) (fun _ -> Int32.of_int ((rdu16 ch) * 2))
- else
- Array.init (maxp.maxp_num_glyphs + 1) (fun _ -> rd32r ch)
-
-let parse_hmtx_table maxp hhea ctx =
- let ch = ctx.ch in
- let last_advance_width = ref 0 in (* check me 1/2*)
- Array.init maxp.maxp_num_glyphs (fun i ->
- let advance_width = if i > hhea.hhea_number_of_hmetrics-1 then (* check me 2/2*)
- !last_advance_width
- else
- rdu16 ch
- in
- last_advance_width := advance_width;
- let left_side_bearing = rd16 ch in
- {
- advance_width = advance_width;
- left_side_bearing = left_side_bearing;
- }
- )
-
-let parse_cmap_table ctx =
- let ch = ctx.ch in
- let version = rdu16 ch in
- let num_subtables = rdu16 ch in
- let dir = ExtList.List.init num_subtables (fun _ ->
- let platform_id = rdu16 ch in
- let platform_specific_id = rdu16 ch in
- let offset = rd32r ch in
- {
- csh_platform_id = platform_id;
- csh_platform_specific_id = platform_specific_id;
- csh_offset = offset;
- }
- ) in
- let dir = List.stable_sort (fun csh1 csh2 ->
- if csh1.csh_platform_id < csh2.csh_platform_id then -1
- else if csh1.csh_platform_id > csh2.csh_platform_id then 1
- else compare csh1.csh_platform_specific_id csh2.csh_platform_specific_id
- ) dir in
- let parse_sub entry =
- seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + (Int32.to_int entry.csh_offset));
- let format = rdu16 ch in
- let def = match format with
- | 0 ->
- let length = rdu16 ch in
- let language = rdu16 ch in
- let glyph_index = Array.init 256 (fun _ -> read ch) in
- Cmap0 {
- c0_format = 0;
- c0_length = length;
- c0_language = language;
- c0_glyph_index_array = glyph_index;
- }
- | 4 ->
- let length = rdu16 ch in
- let language = rdu16 ch in
- let seg_count_x2 = rdu16 ch in
- let seg_count = seg_count_x2 / 2 in
- let search_range = rdu16 ch in
- let entry_selector = rdu16 ch in
- let range_shift = rdu16 ch in
- let end_code = Array.init seg_count (fun _ -> rdu16 ch) in
- let reserved = rdu16 ch in
- assert (reserved = 0);
- let start_code = Array.init seg_count (fun _ -> rdu16 ch) in
- let id_delta = Array.init seg_count (fun _ -> rdu16 ch) in
- let id_range_offset = Array.init seg_count (fun _ -> rdu16 ch) in
- let count = (length - (8 * seg_count + 16)) / 2 in
- let glyph_index = Array.init count (fun _ -> rdu16 ch) in
- Cmap4 {
- c4_format = format;
- c4_length = length;
- c4_language = language;
- c4_seg_count_x2 = seg_count_x2;
- c4_search_range = search_range;
- c4_entry_selector = entry_selector;
- c4_range_shift = range_shift;
- c4_end_code = end_code;
- c4_reserved_pad = reserved;
- c4_start_code = start_code;
- c4_id_delta = id_delta;
- c4_id_range_offset = id_range_offset;
- c4_glyph_index_array = glyph_index;
- }
- | 6 ->
- let length = rdu16 ch in
- let language = rdu16 ch in
- let first_code = rdu16 ch in
- let entry_count = rdu16 ch in
- let glyph_index = Array.init entry_count (fun _ -> rdu16 ch) in
- Cmap6 {
- c6_format = format;
- c6_length = length;
- c6_language = language;
- c6_first_code = first_code;
- c6_entry_count = entry_count;
- c6_glyph_index_array = glyph_index;
- }
- | 12 ->
- ignore (rd16 ch);
- let length = rd32r ch in
- let language = rd32r ch in
- let num_groups = rd32r ch in
- let groups = ExtList.List.init (Int32.to_int num_groups) (fun _ ->
- let start = rd32r ch in
- let stop = rd32r ch in
- let start_glyph = rd32r ch in
- {
- c12g_start_char_code = start;
- c12g_end_char_code = stop;
- c12g_start_glyph_code = start_glyph;
- }
- ) in
- Cmap12 {
- c12_format = Int32.of_int 12;
- c12_length = length;
- c12_language = language;
- c12_num_groups = num_groups;
- c12_groups = groups;
- }
- | x ->
- failwith ("Not implemented format: " ^ (string_of_int x));
- in
- {
- cs_def = def;
- cs_header = entry;
- }
-
- in
- {
- cmap_version = version;
- cmap_num_subtables = num_subtables;
- cmap_subtables = List.map parse_sub dir;
- }
-
-let parse_glyf_table maxp loca cmap hmtx ctx =
- let ch = ctx.ch in
- let parse_glyf i =
- seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + (Int32.to_int loca.(i)));
- let num_contours = rd16 ch in
- let xmin = rd16 ch in
- let ymin = rd16 ch in
- let xmax = rd16 ch in
- let ymax = rd16 ch in
- let header = {
- gh_num_contours = num_contours;
- gh_xmin = xmin;
- gh_ymin = ymin;
- gh_xmax = xmax;
- gh_ymax = ymax;
- } in
- if num_contours >= 0 then begin
- let num_points = ref 0 in
- let end_pts_of_contours = Array.init num_contours (fun i ->
- let v = rdu16 ch in
- if i = num_contours - 1 then num_points := v + 1;
- v
- ) in
- let instruction_length = rdu16 ch in
- let instructions = Array.init instruction_length (fun _ ->
- read ch
- ) in
- let flags = DynArray.create () in
- let rec loop index =
- if index >= !num_points then () else begin
- let v = read_byte ch in
- let incr = if (v land 8) == 0 then begin
- DynArray.add flags v;
- 1
- end else begin
- let r = (int_of_char (read ch)) in
- for i = 0 to r do DynArray.add flags v done;
- r + 1
- end in
- loop (index + incr)
- end
- in
- loop 0;
- assert (DynArray.length flags = !num_points);
- let x_coordinates = Array.init !num_points (fun i ->
- let flag = DynArray.get flags i in
- if flag land 0x10 <> 0 then begin
- if flag land 0x02 <> 0 then read_byte ch
- else 0
- end else begin
- if flag land 0x02 <> 0 then -read_byte ch
- else rd16 ch
- end
- ) in
- let y_coordinates = Array.init !num_points (fun i ->
- let flag = DynArray.get flags i in
- if flag land 0x20 <> 0 then begin
- if flag land 0x04 <> 0 then read_byte ch
- else 0
- end else begin
- if flag land 0x04 <> 0 then -read_byte ch
- else rd16 ch
- end;
- ) in
- TGlyfSimple (header, {
- gs_end_pts_of_contours = end_pts_of_contours;
- gs_instruction_length = instruction_length;
- gs_instructions = instructions;
- gs_flags = DynArray.to_array flags;
- gs_x_coordinates = x_coordinates;
- gs_y_coordinates = y_coordinates;
- })
- end else if num_contours = -1 then begin
- let acc = DynArray.create () in
- let rec loop () =
- let flags = rdu16 ch in
- let glyph_index = rdu16 ch in
- let arg1,arg2 = if flags land 1 <> 0 then begin
- let arg1 = rd16 ch in
- let arg2 = rd16 ch in
- arg1,arg2
- end else begin
- let arg1 = read_byte ch in
- let arg2 = read_byte ch in
- arg1,arg2
- end in
- let fmt214 i = (float_of_int i) /. (float_of_int 0x4000) in
- let fmode = if flags land 8 <> 0 then
- Scale (fmt214 (rd16 ch))
- else if flags land 64 <> 0 then begin
- let s1 = fmt214 (rd16 ch) in
- let s2 = fmt214 (rd16 ch) in
- ScaleXY (s1,s2)
- end else if flags land 128 <> 0 then begin
- let a = fmt214 (rd16 ch) in
- let b = fmt214 (rd16 ch) in
- let c = fmt214 (rd16 ch) in
- let d = fmt214 (rd16 ch) in
- ScaleMatrix (a,b,c,d)
- end else
- NoScale
- in
- DynArray.add acc {
- gc_flags = flags;
- gc_glyf_index = glyph_index;
- gc_arg1 = if flags land 2 <> 0 then arg1 else 0;
- gc_arg2 = if flags land 2 <> 0 then arg2 else 0;
- gc_transformation = fmode;
- };
- if flags land 0x20 <> 0 then loop ();
- in
- loop ();
- TGlyfComposite (header,(DynArray.to_list acc))
- end else
- failwith "Unknown Glyf"
- in
- Array.init maxp.maxp_num_glyphs (fun i ->
- let len = (Int32.to_int loca.(i + 1)) - (Int32.to_int loca.(i)) in
- if len > 0 then parse_glyf i else TGlyfNull
- )
-
-let parse_kern_table ctx =
- let ch = ctx.ch in
- let version = Int32.of_int (rd16 ch) in
- let num_tables = Int32.of_int (rd16 ch) in
- let tables = ExtList.List.init (Int32.to_int num_tables) (fun _ ->
- let length = Int32.of_int (rdu16 ch) in
- let tuple_index = rdu16 ch in
- let coverage = rdu16 ch in
- let def = match coverage lsr 8 with
- | 0 ->
- let num_pairs = rdu16 ch in
- let search_range = rdu16 ch in
- let entry_selector = rdu16 ch in
- let range_shift = rdu16 ch in
- let kerning_pairs = ExtList.List.init num_pairs (fun _ ->
- let left = rdu16 ch in
- let right = rdu16 ch in
- let value = rd16 ch in
- {
- kern_left = left;
- kern_right = right;
- kern_value = value;
- }
- ) in
- Kern0 {
- k0_num_pairs = num_pairs;
- k0_search_range = search_range;
- k0_entry_selector = entry_selector;
- k0_range_shift = range_shift;
- k0_pairs = kerning_pairs;
- }
- | 2 ->
- let row_width = rdu16 ch in
- let left_offset_table = rdu16 ch in
- let right_offset_table = rdu16 ch in
- let array_offset = rdu16 ch in
- let first_glyph = rdu16 ch in
- let num_glyphs = rdu16 ch in
- let offsets = ExtList.List.init num_glyphs (fun _ ->
- rdu16 ch
- ) in
- Kern2 {
- k2_row_width = row_width;
- k2_left_offset_table = left_offset_table;
- k2_right_offset_table = right_offset_table;
- k2_array = array_offset;
- k2_first_glyph = first_glyph;
- k2_num_glyphs = num_glyphs;
- k2_offsets = offsets;
- }
- | i ->
- failwith ("Unknown kerning: " ^ (string_of_int i));
- in
- {
- ks_def = def;
- ks_header = {
- ksh_length = length;
- ksh_coverage = coverage;
- ksh_tuple_index = tuple_index;
- }
- }
- ) in
- {
- kern_version = version;
- kern_num_tables = num_tables;
- kern_subtables = tables;
- }
-
-let parse_name_table ctx =
- let ch = ctx.ch in
- let format = rdu16 ch in
- let num_records = rdu16 ch in
- let offset = rdu16 ch in
- let records = Array.init num_records (fun _ ->
- let platform_id = rdu16 ch in
- let platform_specific_id = rdu16 ch in
- let language_id = rdu16 ch in
- let name_id = rdu16 ch in
- let length = rdu16 ch in
- let offset = rdu16 ch in
- {
- nr_platform_id = platform_id;
- nr_platform_specific_id = platform_specific_id;
- nr_language_id = language_id;
- nr_name_id = name_id;
- nr_length = length;
- nr_offset = offset;
- nr_value = "";
- }
- ) in
- let ttf_name = ref "" in
- (* TODO: use real utf16 conversion *)
- let set_name n =
- let l = ExtList.List.init (String.length n / 2) (fun i -> String.make 1 n.[i * 2 + 1]) in
- ttf_name := String.concat "" l
- in
- let records = Array.map (fun r ->
- seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + offset + r.nr_offset);
- r.nr_value <- nread_string ch r.nr_length;
- if r.nr_name_id = 4 && r.nr_platform_id = 3 || r.nr_platform_id = 0 then set_name r.nr_value;
- r
- ) records in
- {
- name_format = format;
- name_num_records = num_records;
- name_offset = offset;
- name_records = records;
- },!ttf_name
-
-let parse_os2_table ctx =
- let ch = ctx.ch in
- let version = rdu16 ch in
- let x_avg_char_width = rd16 ch in
- let us_weight_class = rdu16 ch in
- let us_width_class = rdu16 ch in
- let fs_type = rd16 ch in
- let y_subscript_x_size = rd16 ch in
- let y_subscript_y_size = rd16 ch in
- let y_subscript_x_offset = rd16 ch in
- let y_subscript_y_offset = rd16 ch in
- let y_superscript_x_size = rd16 ch in
- let y_superscript_y_size = rd16 ch in
- let y_superscript_x_offset = rd16 ch in
- let y_superscript_y_offset = rd16 ch in
- let y_strikeout_size = rd16 ch in
- let y_strikeout_position = rd16 ch in
- let s_family_class = rd16 ch in
-
- let b_family_type = read_byte ch in
- let b_serif_style = read_byte ch in
- let b_weight = read_byte ch in
- let b_proportion = read_byte ch in
- let b_contrast = read_byte ch in
- let b_stroke_variation = read_byte ch in
- let b_arm_style = read_byte ch in
- let b_letterform = read_byte ch in
- let b_midline = read_byte ch in
- let b_x_height = read_byte ch in
-
- let ul_unicode_range_1 = rd32r ch in
- let ul_unicode_range_2 = rd32r ch in
- let ul_unicode_range_3 = rd32r ch in
- let ul_unicode_range_4 = rd32r ch in
- let ach_vendor_id = rd32r ch in
- let fs_selection = rd16 ch in
- let us_first_char_index = rdu16 ch in
- let us_last_char_index = rdu16 ch in
- let s_typo_ascender = rd16 ch in
- let s_typo_descender = rd16 ch in
- let s_typo_line_gap = rd16 ch in
- let us_win_ascent = rdu16 ch in
- let us_win_descent = rdu16 ch in
- {
- os2_version = version;
- os2_x_avg_char_width = x_avg_char_width;
- os2_us_weight_class = us_weight_class;
- os2_us_width_class = us_width_class;
- os2_fs_type = fs_type;
- os2_y_subscript_x_size = y_subscript_x_size;
- os2_y_subscript_y_size = y_subscript_y_size;
- os2_y_subscript_x_offset = y_subscript_x_offset;
- os2_y_subscript_y_offset = y_subscript_y_offset;
- os2_y_superscript_x_size = y_superscript_x_size;
- os2_y_superscript_y_size = y_superscript_y_size;
- os2_y_superscript_x_offset = y_superscript_x_offset;
- os2_y_superscript_y_offset = y_superscript_y_offset;
- os2_y_strikeout_size = y_strikeout_size;
- os2_y_strikeout_position = y_strikeout_position;
- os2_s_family_class = s_family_class;
- os2_b_family_type = b_family_type;
- os2_b_serif_style = b_serif_style;
- os2_b_weight = b_weight;
- os2_b_proportion = b_proportion;
- os2_b_contrast = b_contrast;
- os2_b_stroke_variation = b_stroke_variation;
- os2_b_arm_style = b_arm_style;
- os2_b_letterform = b_letterform;
- os2_b_midline = b_midline;
- os2_b_x_height = b_x_height;
- os2_ul_unicode_range_1 = ul_unicode_range_1;
- os2_ul_unicode_range_2 = ul_unicode_range_2;
- os2_ul_unicode_range_3 = ul_unicode_range_3;
- os2_ul_unicode_range_4 = ul_unicode_range_4;
- os2_ach_vendor_id = ach_vendor_id;
- os2_fs_selection = fs_selection;
- os2_us_first_char_index = us_first_char_index;
- os2_us_last_char_index = us_last_char_index;
- os2_s_typo_ascender = s_typo_ascender;
- os2_s_typo_descender = s_typo_descender;
- os2_s_typo_line_gap = s_typo_line_gap;
- os2_us_win_ascent = us_win_ascent;
- os2_us_win_descent = us_win_descent;
- }
-
-let parse file : ttf =
- let ctx = {
- file = file;
- ch = input_channel file;
- entry = {
- entry_table_name = "";
- entry_offset = Int32.of_int 0;
- entry_length = Int32.of_int 0;
- entry_checksum = Int32.of_int 0;
- }
- } in
- let header = parse_header ctx in
- let directory = parse_directory ctx header in
- let parse_table entry f =
- seek_in file (Int32.to_int entry.entry_offset);
- ctx.entry <- entry;
- f ctx
- in
- let parse_req_table name f =
- try
- let entry = Hashtbl.find directory name in
- parse_table entry f
- with Not_found ->
- failwith (Printf.sprintf "Required table %s could not be found" name)
- in
- let parse_opt_table name f =
- try
- let entry = Hashtbl.find directory name in
- Some (parse_table entry f)
- with Not_found ->
- None
- in
- let head = parse_req_table "head" parse_head_table in
- let hhea = parse_req_table "hhea" parse_hhea_table in
- let maxp = parse_req_table "maxp" parse_maxp_table in
- let loca = parse_req_table "loca" (parse_loca_table head maxp) in
- let hmtx = parse_req_table "hmtx" (parse_hmtx_table maxp hhea) in
- let cmap = parse_req_table "cmap" (parse_cmap_table) in
- let glyfs = parse_req_table "glyf" (parse_glyf_table maxp loca cmap hmtx) in
- let kern = parse_opt_table "kern" (parse_kern_table) in
- let name,ttf_name = parse_req_table "name" (parse_name_table) in
- let os2 = parse_req_table "OS/2" (parse_os2_table) in
- {
- ttf_header = header;
- ttf_font_name = ttf_name;
- ttf_directory = directory;
- ttf_head = head;
- ttf_hhea = hhea;
- ttf_maxp = maxp;
- ttf_loca = loca;
- ttf_hmtx = hmtx;
- ttf_cmap = cmap;
- ttf_glyfs = glyfs;
- ttf_name = name;
- ttf_os2 = os2;
- ttf_kern = kern;
- }
diff --git a/libs/ttflib/tTFSwfWriter.ml b/libs/ttflib/tTFSwfWriter.ml
deleted file mode 100644
index d812147ed66..00000000000
--- a/libs/ttflib/tTFSwfWriter.ml
+++ /dev/null
@@ -1,211 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open Swf
-
-let num_bits x =
- if x = 0 then
- 0
- else
- let rec loop n v =
- if v = 0 then n else loop (n + 1) (v lsr 1)
- in
- loop 1 (abs x)
-
-let round x = int_of_float (floor (x +. 0.5))
-
-let to_twips v = round (v *. 20.)
-
-type ctx = {
- ttf : ttf;
-}
-
-let begin_fill =
- SRStyleChange {
- scsr_move = None;
- scsr_fs0 = Some(1);
- scsr_fs1 = None;
- scsr_ls = None;
- scsr_new_styles = None;
- }
-
-let end_fill =
- SRStyleChange {
- scsr_move = None;
- scsr_fs0 = None;
- scsr_fs1 = None;
- scsr_ls = None;
- scsr_new_styles = None;
- }
-
-let align_bits x nbits = x land ((1 lsl nbits ) - 1)
-
-let move_to ctx x y =
- let x = to_twips x in
- let y = to_twips y in
- let nbits = max (num_bits x) (num_bits y) in
- SRStyleChange {
- scsr_move = Some (nbits, align_bits x nbits, align_bits y nbits);
- scsr_fs0 = Some(1);
- scsr_fs1 = None;
- scsr_ls = None;
- scsr_new_styles = None;
- }
-
-let line_to ctx x y =
- let x = to_twips x in
- let y = to_twips y in
- if x = 0 && y = 0 then raise Exit;
- let nbits = max (num_bits x) (num_bits y) in
- SRStraightEdge {
- sser_nbits = nbits;
- sser_line = (if x = 0 then None else Some(align_bits x nbits)), (if y = 0 then None else Some(align_bits y nbits));
- }
-
-let curve_to ctx cx cy ax ay =
- let cx = to_twips cx in
- let cy = to_twips cy in
- let ax = to_twips ax in
- let ay = to_twips ay in
- let nbits = max (max (num_bits cx) (num_bits cy)) (max (num_bits ax) (num_bits ay)) in
- SRCurvedEdge {
- scer_nbits = nbits;
- scer_cx = align_bits cx nbits;
- scer_cy = align_bits cy nbits;
- scer_ax = align_bits ax nbits;
- scer_ay = align_bits ay nbits;
- }
-
-open TTFTools
-
-let write_paths ctx paths =
- let scale = 1024. /. (float_of_int ctx.ttf.ttf_head.hd_units_per_em) in
- let srl = DynArray.create () in
- List.iter (fun path ->
- try
- DynArray.add srl (match path.gp_type with
- | 0 -> move_to ctx (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
- | 1 -> line_to ctx (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
- | 2 -> curve_to ctx (path.gp_cx *. scale) ((-1.) *. path.gp_cy *. scale) (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
- | _ -> assert false)
- with Exit ->
- ()
- ) paths;
- DynArray.add srl (end_fill);
- {
- srs_nfbits = 1;
- srs_nlbits = 0;
- srs_records = DynArray.to_list srl;
- }
-
-let rec write_glyph ctx key glyf =
- {
- font_char_code = key;
- font_shape = write_paths ctx (TTFTools.build_glyph_paths ctx.ttf true glyf);
- }
-
-let write_font_layout ctx lut =
- let scale = 1024. /. (float_of_int ctx.ttf.ttf_head.hd_units_per_em) in
- let hmtx = Hashtbl.fold (fun k v acc -> (k,ctx.ttf.ttf_hmtx.(v)) :: acc) lut [] in
- let hmtx = List.stable_sort (fun a b -> compare (fst a) (fst b)) hmtx in
- let hmtx = List.map (fun (k,g) -> g) hmtx in
- {
- font_ascent = round((float_of_int ctx.ttf.ttf_os2.os2_us_win_ascent) *. scale *. 20.);
- font_descent = round((float_of_int ctx.ttf.ttf_os2.os2_us_win_descent) *. scale *. 20.);
- font_leading = round(((float_of_int(ctx.ttf.ttf_os2.os2_us_win_ascent + ctx.ttf.ttf_os2.os2_us_win_descent - ctx.ttf.ttf_head.hd_units_per_em)) *. scale) *. 20.);
- font_glyphs_layout = Array.of_list( ExtList.List.mapi (fun i h ->
- {
- font_advance = round((float_of_int h.advance_width) *. scale *. 20.);
- font_bounds = {rect_nbits=0; left=0; right=0; top=0; bottom=0};
- }) hmtx );
- font_kerning = [];
- }
-
-let bi v = if v then 1 else 0
-
-let int_from_langcode lc =
- match lc with
- | LCNone -> 0
- | LCLatin -> 1
- | LCJapanese -> 2
- | LCKorean -> 3
- | LCSimplifiedChinese -> 4
- | LCTraditionalChinese -> 5
-
-let write_font2 ch b f2 =
- IO.write_bits b 1 (bi true);
- IO.write_bits b 1 (bi f2.font_shift_jis);
- IO.write_bits b 1 (bi f2.font_is_small);
- IO.write_bits b 1 (bi f2.font_is_ansi);
- IO.write_bits b 1 (bi f2.font_wide_offsets);
- IO.write_bits b 1 (bi f2.font_wide_codes);
- IO.write_bits b 1 (bi f2.font_is_italic);
- IO.write_bits b 1 (bi f2.font_is_bold);
- IO.write_byte ch (int_from_langcode f2.font_language);
- IO.write_byte ch ((String.length f2.font_name) + 1);
- IO.nwrite_string ch f2.font_name;
- IO.write_byte ch 0;
- IO.write_ui16 ch (Array.length f2.font_glyphs);
- let glyph_offset = ref (((Array.length f2.font_glyphs) * 4)+4) in
- Array.iter (fun g ->
- IO.write_i32 ch !glyph_offset;
- glyph_offset := !glyph_offset + SwfParser.font_shape_records_length g.font_shape;
- )f2.font_glyphs;
- IO.write_i32 ch !glyph_offset;
- Array.iter (fun g -> SwfParser.write_shape_without_style ch g.font_shape;) f2.font_glyphs;
- Array.iter (fun g -> IO.write_ui16 ch g.font_char_code; )f2.font_glyphs;
- IO.write_i16 ch f2.font_layout.font_ascent;
- IO.write_i16 ch f2.font_layout.font_descent;
- IO.write_i16 ch f2.font_layout.font_leading;
- Array.iter (fun g ->
- let fa = ref g.font_advance in
- if (!fa) < -32767 then fa := -32768;(* fix or check *)
- if (!fa) > 32766 then fa := 32767;
- IO.write_i16 ch !fa;) f2.font_layout.font_glyphs_layout;
- Array.iter (fun g -> SwfParser.write_rect ch g.font_bounds;) f2.font_layout.font_glyphs_layout;
- IO.write_ui16 ch 0 (* TODO: optional FontKerningTable *)
-
-let to_swf ttf config =
- let ctx = {
- ttf = ttf;
- } in
- let lut = TTFTools.build_lut ttf config.ttfc_range_str in
- let glyfs = Hashtbl.fold (fun k v acc -> (k,ctx.ttf.ttf_glyfs.(v)) :: acc) lut [] in
- let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
- let glyfs = List.map (fun (k,g) -> write_glyph ctx k g) glyfs in
- let glyfs_font_layout = write_font_layout ctx lut in
- let glyfs = Array.of_list glyfs in
- {
- font_shift_jis = false;
- font_is_small = false;
- font_is_ansi = false;
- font_wide_offsets = true;
- font_wide_codes = true;
- font_is_italic = config.ttfc_font_posture = TFPItalic;
- font_is_bold = config.ttfc_font_weight = TFWBold;
- font_language = LCNone;
- font_name = (match config.ttfc_font_name with Some s -> s | None -> ttf.ttf_font_name);
- font_glyphs = glyfs;
- font_layout = glyfs_font_layout;
- }
-;;
diff --git a/libs/ttflib/tTFTools.ml b/libs/ttflib/tTFTools.ml
deleted file mode 100644
index d9bf568eacd..00000000000
--- a/libs/ttflib/tTFTools.ml
+++ /dev/null
@@ -1,275 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-open Extlib_leftovers
-open TTFData
-
-type glyf_transformation_matrix = {
- mutable a : float;
- mutable b : float;
- mutable c : float;
- mutable d : float;
- mutable tx : float;
- mutable ty : float;
-}
-
-type glyf_path = {
- gp_type : int;
- gp_x : float;
- gp_y : float;
- gp_cx : float;
- gp_cy : float;
-}
-
-type simple_point = {
- x : float;
- y : float;
-}
-
-let mk_path t x y cx cy = {
- gp_type = t;
- gp_x = x;
- gp_y = y;
- gp_cx = cx;
- gp_cy = cy;
-}
-
-let identity () = {
- a = 1.0;
- b = 0.0;
- c = 0.0;
- d = 1.0;
- tx = 0.0;
- ty = 0.0;
-}
-
-let multiply m x y =
- x *. m.a +. y *. m.b +. m.tx,
- x *. m.c +. y *. m.d +. m.ty
-
-(* TODO: check if this can be done in the parser directly *)
-let matrix_from_composite gc =
- let a,b,c,d = match gc.gc_transformation with
- | NoScale -> 1.0,0.0,0.0,1.0
- | Scale f -> f,0.0,0.0,f
- | ScaleXY(fx,fy) -> fx,0.0,0.0,fy
- | ScaleMatrix (a,b,c,d) -> a,b,c,d
- in
- let arg1 = float_of_int gc.gc_arg1 in
- let arg2 = float_of_int gc.gc_arg2 in
- {
- a = a;
- b = b;
- c = c;
- d = d;
- (* TODO: point offsets *)
- tx = arg1 *. a +. arg2 *. b;
- ty = arg1 *. c +. arg2 *. d;
- }
-
-let relative_matrix m = {m with tx = 0.0; ty = 0.0}
-
-let make_coords relative mo g = match mo with
- | None ->
- Array.init (Array.length g.gs_x_coordinates) (fun i -> float_of_int g.gs_x_coordinates.(i),float_of_int g.gs_y_coordinates.(i))
- | Some m ->
- let m = if relative then relative_matrix m else m in
- Array.init (Array.length g.gs_x_coordinates) (fun i ->
- let x,y = float_of_int g.gs_x_coordinates.(i),float_of_int g.gs_y_coordinates.(i) in
- multiply m x y
- )
-
-let build_paths relative mo g =
- let len = Array.length g.gs_x_coordinates in
- let current_end = ref 0 in
- let end_pts = Array.init len (fun i ->
- if g.gs_end_pts_of_contours.(!current_end) = i then begin
- incr current_end;
- true
- end else
- false
- ) in
- let is_on i = g.gs_flags.(i) land 0x01 <> 0 in
- let is_end i = end_pts.(i) in
- let arr = DynArray.create () in
- let tx,ty = match mo with None -> 0.0,0.0 | Some m -> m.tx,m.ty in
- let last_added = ref {
- x = 0.0;
- y = 0.0;
- } in
- let add_rel t x y cx cy =
- let p = match t with
- | 0 ->
- mk_path t (x +. tx) (y +. ty) cx cy
- | 1 ->
- mk_path t (x -. !last_added.x) (y -. !last_added.y) cx cy
- | 2 ->
- mk_path t (x -. cx) (y -. cy) (cx -. !last_added.x) (cy -. !last_added.y)
- | _ ->
- assert false
- in
- last_added := { x = x; y = y; };
- DynArray.add arr p
- in
- let add_abs t x y cx cy = DynArray.add arr (mk_path t x y cx cy) in
- let add = if relative then add_rel else add_abs in
- let coords = make_coords relative mo g in
-
- let left = ref [] in
- let right = ref [] in
- let new_contour = ref true in
- let p = ref { x = 0.0; y = 0.0 } in
- for i = 0 to len - 1 do
- p := {
- x = !p.x +. fst coords.(i);
- y = !p.y +. snd coords.(i);
- };
- let p = !p in
- let is_on = is_on i in
- let is_end = is_end i in
- let rec flush pl = match pl with
- | c :: a :: [] -> add 2 a.x a.y c.x c.y
- | a :: [] -> add 1 a.x a.y 0.0 0.0
- | c1 :: c2 :: pl ->
- add 2 (c1.x +. (c2.x -. c1.x) /. 2.0) (c1.y +. (c2.y -. c1.y) /. 2.0) c1.x c1.y;
- flush (c2 :: pl)
- | _ ->
- Printf.printf "Fail, len: %i\n" (List.length pl);
- in
- if !new_contour then begin
- if is_on then begin
- new_contour := false;
- add 0 p.x p.y 0.0 0.0;
- end;
- left := p :: !left
- end else if is_on || is_end then begin
- right := p :: !right;
- if is_on then begin
- flush (List.rev !right);
- right := []
- end;
- if is_end then begin
- new_contour := true;
- flush ((List.rev !right) @ (List.rev !left));
- left := [];
- right := [];
- end
- end else
- right := p :: !right
- done;
- DynArray.to_list arr
-
-let rec build_glyph_paths ttf relative ?(transformation=None) glyf =
- match glyf with
- | TGlyfSimple (h,g) ->
- build_paths relative transformation g
- | TGlyfComposite (h,gl) ->
- List.concat (List.map (fun g ->
- let t = Some (matrix_from_composite g) in
- build_glyph_paths ttf relative ~transformation:t (ttf.ttf_glyfs.(g.gc_glyf_index))
- ) gl)
- | TGlyfNull ->
- []
-
-let map_char_code cc c4 =
- let index = ref 0 in
- let seg_count = c4.c4_seg_count_x2 / 2 in
- if cc >= 0xFFFF then 0 else begin
- for i = 0 to seg_count - 1 do
- if c4.c4_end_code.(i) >= cc && c4.c4_start_code.(i) <= cc then begin
- if c4.c4_id_range_offset.(i) > 0 then
- let v = c4.c4_id_range_offset.(i)/2 + cc - c4.c4_start_code.(i) - seg_count + i in
- index := c4.c4_glyph_index_array.(v)
- else
- index := (c4.c4_id_delta.(i) + cc) mod 65536
- end
- done;
- !index
- end
-
-let parse_range_str str =
- let last = ref (Char.code '\\') in
- let range = ref false in
- let lut = Hashtbl.create 0 in
- UTF8.iter (fun code ->
- let code = UCharExt.code code in
- if code = Char.code '-' && !last <> Char.code '\\' then
- range := true
- else if !range then begin
- range := false;
- for i = !last to code do
- Hashtbl.replace lut i true;
- done;
- end else begin
- Hashtbl.replace lut code true;
- last := code;
- end
- ) str;
- if !range then Hashtbl.replace lut (Char.code '-') true;
- lut
-
-let build_lut ttf range_str =
- let lut = Hashtbl.create 0 in
- Hashtbl.add lut 0 0;
- Hashtbl.add lut 1 1;
- Hashtbl.add lut 2 2;
- let add_character = if range_str = "" then
- fun k v -> Hashtbl.replace lut k v
- else begin
- let range = parse_range_str range_str in
- fun k v -> if Hashtbl.mem range k then Hashtbl.replace lut k v
- end
- in
- let make_cmap4_map c4 =
- let seg_count = c4.c4_seg_count_x2 / 2 in
- for i = 0 to seg_count - 1 do
- for j = c4.c4_start_code.(i) to c4.c4_end_code.(i) do
- let index = map_char_code j c4 in
- add_character j index;
- done;
- done
- in
-(* let make_cmap12_map c12 =
- List.iter (fun group ->
- let rec loop cc gi =
- add_character cc gi;
- if cc < (Int32.to_int group.c12g_end_char_code) then loop (cc + 1) (gi + 1)
- in
- loop (Int32.to_int group.c12g_start_char_code) (Int32.to_int group.c12g_start_glyph_code)
- ) c12.c12_groups
- in *)
- List.iter (fun st -> match st.cs_def with
- | Cmap0 c0 ->
- Array.iteri (fun i c -> add_character i (int_of_char c)) c0.c0_glyph_index_array;
- | Cmap4 c4 ->
- make_cmap4_map c4;
- | Cmap12 c12 ->
- (*
- TODO: this causes an exception with some fonts:
- Fatal error: exception IO.Overflow("write_ui16")
- *)
- (* make_cmap12_map ctx lut c12; *)
- ()
- | _ ->
- (* TODO *)
- ()
- ) ttf.ttf_cmap.cmap_subtables;
- lut
diff --git a/src-json/meta.json b/src-json/meta.json
index 3aea8fb5e70..52585d954ed 100644
--- a/src-json/meta.json
+++ b/src-json/meta.json
@@ -524,6 +524,12 @@
"platforms": ["hl"],
"targets": ["TClass", "TClassField"]
},
+ {
+ "name": "HxbId",
+ "metadata": ":hxb.id",
+ "doc": "Internally used by hxb",
+ "internal": true
+ },
{
"name": "HxCompletion",
"metadata": ":hx.completion",
@@ -720,12 +726,6 @@
"metadata": ":macro",
"doc": "(deprecated)"
},
- {
- "name": "MaybeUsed",
- "metadata": ":maybeUsed",
- "doc": "Internally used by DCE to mark fields that might be kept.",
- "internal": true
- },
{
"name": "MergeBlock",
"metadata": ":mergeBlock",
diff --git a/src-json/warning.json b/src-json/warning.json
index 54d544f3524..03e5eab0fc2 100644
--- a/src-json/warning.json
+++ b/src-json/warning.json
@@ -117,6 +117,14 @@
"name": "WConstructorInliningCancelled",
"doc": "Constructor call could not be inlined because a field is uninitialized",
"parent": "WTyper"
+ },
+ {
+ "name": "WHxb",
+ "doc": "Hxb (either --hxb output or haxe compiler cache) related warnings"
+ },
+ {
+ "name": "WUnboundTypeParameter",
+ "doc": "Hxb (either --hxb output or haxe compiler cache) failed to link a type parameter to an actual type",
+ "parent": "WHxb"
}
-
-]
\ No newline at end of file
+]
diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml
index 42fe3a04136..0631180fced 100644
--- a/src/codegen/codegen.ml
+++ b/src/codegen/codegen.ml
@@ -307,7 +307,7 @@ module Dump = struct
| Some f -> print_field false f);
List.iter (print_field false) c.cl_ordered_fields;
List.iter (print_field true) c.cl_ordered_statics;
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e ->
print "\n\tstatic function __init__() ";
@@ -388,8 +388,8 @@ module Dump = struct
let dep = Hashtbl.create 0 in
List.iter (fun m ->
print "%s:\n" (Path.UniqueKey.lazy_path m.m_extra.m_file);
- PMap.iter (fun _ (sign,mpath) ->
- let m2 = com.module_lut#find mpath in
+ PMap.iter (fun _ mdep ->
+ let m2 = com.module_lut#find mdep.md_path in
let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in
print "\t%s\n" file;
let l = try Hashtbl.find dep file with Not_found -> [] in
@@ -490,14 +490,9 @@ let map_source_header com f =
(* Static extensions for classes *)
module ExtClass = struct
-
- let add_cl_init c e = match c.cl_init with
- | None -> c.cl_init <- Some e
- | Some e' -> c.cl_init <- Some (concat e' e)
-
let add_static_init c cf e p =
let ethis = Texpr.Builder.make_static_this c p in
let ef1 = mk (TField(ethis,FStatic(c,cf))) cf.cf_type p in
let e_assign = mk (TBinop(OpAssign,ef1,e)) e.etype p in
- add_cl_init c e_assign
+ TClass.add_cl_init c e_assign
end
diff --git a/src/codegen/gencommon/castDetect.ml b/src/codegen/gencommon/castDetect.ml
index f301bf4f163..1c0981ff55a 100644
--- a/src/codegen/gencommon/castDetect.ml
+++ b/src/codegen/gencommon/castDetect.ml
@@ -193,7 +193,7 @@ let rec type_eq gen param a b =
PMap.iter (fun n f1 ->
try
let f2 = PMap.find n a2.a_fields in
- if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then Type.error [invalid_kind n f1.cf_kind f2.cf_kind];
+ if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind ~strict:false f1.cf_kind f2.cf_kind)) then Type.error [invalid_kind n f1.cf_kind f2.cf_kind];
try
type_eq gen param f1.cf_type f2.cf_type
with
diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml
index ed45fd75b44..f79951d01c1 100644
--- a/src/codegen/gencommon/closuresToClass.ml
+++ b/src/codegen/gencommon/closuresToClass.ml
@@ -393,7 +393,12 @@ let configure gen ft =
in
(*let cltypes = List.map (fun cl -> (snd cl.cl_path, TInst(map_param cl, []) )) tparams in*)
- let cltypes = List.map (fun cl -> mk_type_param cl TPHType None None) tparams in
+ let cltypes = List.map (fun cl ->
+ let lol = cl.cl_kind in
+ let ttp = mk_type_param cl TPHType None None in
+ cl.cl_kind <- lol;
+ ttp
+ ) tparams in
(* create a new class that extends abstract function class, with a ctor implementation that will setup all captured variables *)
let cfield = match gen.gcurrent_classfield with
diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml
index c800e688c4b..b4af589c180 100644
--- a/src/codegen/gencommon/gencommon.ml
+++ b/src/codegen/gencommon/gencommon.ml
@@ -723,8 +723,8 @@ let run_filters_from gen t filters =
gen.gcurrent_classfield <- None;
(match c.cl_init with
| None -> ()
- | Some e ->
- c.cl_init <- Some (List.fold_left (fun e f -> f e) e filters));
+ | Some f ->
+ process_field f);
| TClassDecl _ | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ ->
()
@@ -1142,9 +1142,7 @@ let clone_param ttp =
let ret = mk_class cl.cl_module (fst cl.cl_path, snd cl.cl_path ^ "_c") cl.cl_pos null_pos in
ret.cl_implements <- cl.cl_implements;
ret.cl_kind <- cl.cl_kind;
- let ttp = mk_type_param ret ttp.ttp_host ttp.ttp_default ttp.ttp_constraints in
- ret.cl_kind <- KTypeParameter ttp;
- ttp
+ mk_type_param ret ttp.ttp_host ttp.ttp_default ttp.ttp_constraints
let get_cl_t t =
match follow t with | TInst (cl,_) -> cl | _ -> die "" __LOC__
diff --git a/src/codegen/gencommon/initFunction.ml b/src/codegen/gencommon/initFunction.ml
index 347fadf1f47..a1957b40eed 100644
--- a/src/codegen/gencommon/initFunction.ml
+++ b/src/codegen/gencommon/initFunction.ml
@@ -71,7 +71,7 @@ let handle_override_dynfun acc e this field =
let handle_class gen cl =
let com = gen.gcon in
- let init = match cl.cl_init with
+ let init = match TClass.get_cl_init cl with
| None -> []
| Some i -> [i]
in
@@ -109,7 +109,7 @@ let handle_class gen cl =
let init = List.rev init in
(match init with
| [] -> cl.cl_init <- None
- | _ -> cl.cl_init <- Some (mk (TBlock init) com.basic.tvoid cl.cl_pos));
+ | _ -> TClass.set_cl_init cl (mk (TBlock init) com.basic.tvoid cl.cl_pos));
(* FIXME: find a way to tell OverloadingConstructor to execute this code even with empty constructors *)
let vars, funs = List.fold_left (fun (acc_vars,acc_funs) cf ->
diff --git a/src/codegen/genxml.ml b/src/codegen/genxml.ml
index 64c19c1ef25..70ebc26efae 100644
--- a/src/codegen/genxml.ml
+++ b/src/codegen/genxml.ml
@@ -81,7 +81,7 @@ let rec follow_param t =
t
let gen_meta meta =
- let meta = List.filter (fun (m,_,_) -> match m with Meta.Used | Meta.MaybeUsed | Meta.RealPath | Meta.Pure -> false | _ -> true) meta in
+ let meta = List.filter (fun (m,_,_) -> match m with Meta.Used | Meta.RealPath | Meta.Pure | Meta.HxbId -> false | _ -> true) meta in
match meta with
| [] -> []
| _ ->
diff --git a/src/compiler/args.ml b/src/compiler/args.ml
index b275f262f84..45edbf9008f 100644
--- a/src/compiler/args.ml
+++ b/src/compiler/args.ml
@@ -48,6 +48,7 @@ let parse_args com =
let actx = {
classes = [([],"Std")];
xml_out = None;
+ hxb_out = None;
json_out = None;
cmds = [];
config_macros = [];
@@ -58,6 +59,7 @@ let parse_args com =
interp = false;
jvm_flag = false;
swf_version = false;
+ hxb_libs = [];
native_libs = [];
raise_usage = (fun () -> ());
display_arg = None;
@@ -109,29 +111,36 @@ let parse_args com =
),"","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 (!Globals.macro_platform) "";
+ set_platform com Eval "";
actx.interp <- true;
),"","interpret the program using internal macro system");
("Target",["--interp"],[], Arg.Unit (fun() ->
Common.define com Define.Interp;
- set_platform com (!Globals.macro_platform) "";
+ set_platform com Eval "";
actx.interp <- true;
),"","interpret the program using internal macro system");
("Target",["--run"],[], Arg.Unit (fun() ->
raise (Arg.Bad "--run requires an argument: a Haxe module name")
), " [args...]","interpret a Haxe module with command line arguments");
("Compilation",["-p";"--class-path"],["-cp"],Arg.String (fun path ->
- com.class_path <- Path.add_trailing_slash path :: com.class_path
+ com.class_paths#add (new ClassPath.directory_class_path (Path.add_trailing_slash path) User);
),"","add a directory to find source files");
+ ("Compilation",[],["-libcp"],Arg.String (fun path ->
+ com.class_paths#add (new ClassPath.directory_class_path (Path.add_trailing_slash path) Lib);
+ ),"","add a directory to find source files");
+ ("Compilation",["--hxb-lib"],["-hxb-lib"],Arg.String (fun file ->
+ let lib = create_native_lib file false HxbLib in
+ actx.hxb_libs <- lib :: actx.hxb_libs
+ ),"","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
),"","select startup class");
("Compilation",["-L";"--library"],["-lib"],Arg.String (fun _ -> ()),"","use a haxelib library");
@@ -269,6 +278,9 @@ let parse_args com =
("Services",["--json"],[],Arg.String (fun file ->
actx.json_out <- Some file
),"","generate JSON types description");
+ ("Services",["--hxb"],[], Arg.String (fun file ->
+ actx.hxb_out <- Some file;
+ ),"", "generate haxe binary representation to target archive");
("Optimization",["--no-output"],[], Arg.Unit (fun() -> actx.no_output <- true),"","compiles but does not generate any file");
("Debug",["--times"],[], Arg.Unit (fun() -> Timer.measure_times := true),"","measure compilation times");
("Optimization",["--no-inline"],[],Arg.Unit (fun () ->
diff --git a/src/compiler/compilationCache.ml b/src/compiler/compilationCache.ml
index 77ca6b1f42c..0b4b2a0b455 100644
--- a/src/compiler/compilationCache.ml
+++ b/src/compiler/compilationCache.ml
@@ -5,7 +5,7 @@ open Type
open Define
type cached_file = {
- c_file_path : string;
+ c_file_path : ClassPaths.resolved_file;
c_time : float;
c_package : string list;
c_decls : type_decl list;
@@ -23,9 +23,18 @@ type cached_native_lib = {
c_nl_files : (path,Ast.package) Hashtbl.t;
}
-class context_cache (index : int) = object(self)
+let get_module_name_of_cfile file cfile = match cfile.c_module_name with
+ | None ->
+ let name = Path.module_name_of_file file in
+ cfile.c_module_name <- Some name;
+ name
+ | Some name ->
+ name
+
+class context_cache (index : int) (sign : Digest.t) = object(self)
val files : (Path.UniqueKey.t,cached_file) Hashtbl.t = Hashtbl.create 0
val modules : (path,module_def) Hashtbl.t = Hashtbl.create 0
+ val binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
val removed_files = Hashtbl.create 0
val mutable json = JNull
val mutable initialized = false
@@ -57,17 +66,41 @@ class context_cache (index : int) = object(self)
method find_module_opt path =
Hashtbl.find_opt modules path
- method cache_module path value =
- Hashtbl.replace modules path value
+ method find_module_extra path =
+ try (Hashtbl.find modules path).m_extra with Not_found -> (Hashtbl.find binary_cache path).mc_extra
+
+ method cache_module config warn anon_identification path m =
+ match m.m_extra.m_kind with
+ | MImport ->
+ Hashtbl.add modules m.m_path m
+ | _ ->
+ let writer = HxbWriter.create config warn anon_identification in
+ HxbWriter.write_module writer m;
+ let chunks = HxbWriter.get_chunks writer in
+ Hashtbl.replace binary_cache path {
+ mc_path = path;
+ mc_id = m.m_id;
+ mc_chunks = chunks;
+ mc_extra = { m.m_extra with m_cache_state = MSGood }
+ }
+
+ method clear_cache =
+ Hashtbl.clear modules
(* initialization *)
method is_initialized = initialized
method set_initialized value = initialized <- value
+ method get_sign = sign
method get_index = index
method get_files = files
method get_modules = modules
+
+ method get_hxb = binary_cache
+ method get_hxb_module path = Hashtbl.find binary_cache path
+
+ (* TODO handle hxb cache there too *)
method get_removed_files = removed_files
method get_json = json
@@ -75,7 +108,7 @@ class context_cache (index : int) = 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 = {
@@ -115,18 +148,18 @@ class cache = object(self)
try
Hashtbl.find contexts sign
with Not_found ->
- let cache = new context_cache (Hashtbl.length contexts) in
+ let cache = new context_cache (Hashtbl.length contexts) sign in
context_list <- cache :: context_list;
Hashtbl.add contexts sign cache;
cache
- method add_info sign desc platform class_path defines =
+ method add_info sign desc platform (class_paths : ClassPaths.class_paths) defines =
let cc = self#get_context sign in
let jo = JObject [
"index",JInt cc#get_index;
"desc",JString desc;
"platform",JString (platform_name platform);
- "classPaths",JArray (List.map (fun s -> JString s) class_path);
+ "classPaths",JArray (List.map (fun s -> JString s) class_paths#as_string_list);
"signature",JString (Digest.to_hex sign);
"defines",JArray (PMap.foldi (fun k v acc -> JObject [
"key",JString k;
@@ -174,7 +207,14 @@ class cache = object(self)
Hashtbl.iter (fun _ cc ->
Hashtbl.iter (fun _ m ->
if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_cache_state <- MSBad (Tainted reason)
- ) cc#get_modules
+ ) cc#get_modules;
+ let open HxbData in
+ Hashtbl.iter (fun _ mc ->
+ if Path.UniqueKey.lazy_key mc.mc_extra.m_file = file_key then
+ mc.mc_extra.m_cache_state <- match reason, mc.mc_extra.m_cache_state with
+ | CheckDisplayFile, (MSBad _ as state) -> state
+ | _ -> MSBad (Tainted reason)
+ ) cc#get_hxb
) contexts
(* haxelibs *)
@@ -267,11 +307,3 @@ type context_options =
| NormalContext
| MacroContext
| NormalAndMacroContext
-
-let get_module_name_of_cfile file cfile = match cfile.c_module_name with
- | None ->
- let name = Path.module_name_of_file file in
- cfile.c_module_name <- Some name;
- name
- | Some name ->
- name
\ No newline at end of file
diff --git a/src/compiler/compilationContext.ml b/src/compiler/compilationContext.ml
index 53f99885e1a..f6697e4e136 100644
--- a/src/compiler/compilationContext.ml
+++ b/src/compiler/compilationContext.ml
@@ -11,6 +11,7 @@ type native_lib_kind =
| NetLib
| JavaLib
| SwfLib
+ | HxbLib
type native_lib_arg = {
lib_file : string;
@@ -21,6 +22,7 @@ type native_lib_arg = {
type arg_context = {
mutable classes : Globals.path list;
mutable xml_out : string option;
+ mutable hxb_out : string option;
mutable json_out : string option;
mutable cmds : string list;
mutable config_macros : string list;
@@ -31,6 +33,7 @@ type arg_context = {
mutable interp : bool;
mutable jvm_flag : bool;
mutable swf_version : bool;
+ mutable hxb_libs : native_lib_arg list;
mutable native_libs : native_lib_arg list;
mutable raise_usage : unit -> unit;
mutable display_arg : string option;
@@ -51,11 +54,13 @@ and compilation_context = {
mutable has_next : bool;
mutable has_error : bool;
comm : communication;
+ mutable runtime_args : string list;
}
type compilation_callbacks = {
before_anything : compilation_context -> unit;
after_target_init : compilation_context -> unit;
+ after_save : compilation_context -> unit;
after_compilation : compilation_context -> unit;
}
diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml
index 9e9b61dc6f8..93ee2464f6b 100644
--- a/src/compiler/compiler.ml
+++ b/src/compiler/compiler.ml
@@ -78,8 +78,15 @@ let run_command ctx cmd =
module Setup = struct
let initialize_target ctx com actx =
init_platform com;
+ com.class_paths#lock_context (platform_name com.platform) false;
let add_std dir =
- com.class_path <- List.filter (fun s -> not (List.mem s com.std_path)) com.class_path @ List.map (fun p -> p ^ dir ^ "/_std/") com.std_path @ com.std_path
+ com.class_paths#modify_inplace (fun cp -> match cp#scope with
+ | Std ->
+ let cp' = new ClassPath.directory_class_path (cp#path ^ dir ^ "/_std/") StdTarget in
+ cp :: [cp']
+ | _ ->
+ [cp]
+ );
in
match com.platform with
| Cross ->
@@ -162,9 +169,14 @@ module Setup = struct
add_std "eval";
"eval"
- let create_typer_context ctx macros native_libs =
+ let init_native_libs com native_libs =
+ (* Native lib pass 1: Register *)
+ let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in
+ (* Native lib pass 2: Initialize *)
+ List.iter (fun f -> f()) fl
+
+ let create_typer_context ctx macros =
let com = ctx.com in
- Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
let buffer = Buffer.create 64 in
Buffer.add_string buffer "Defines: ";
PMap.iter (fun k v -> match v with
@@ -174,15 +186,13 @@ module Setup = struct
Buffer.truncate buffer (Buffer.length buffer - 1);
Common.log com (Buffer.contents buffer);
com.callbacks#run com.error_ext com.callbacks#get_before_typer_create;
- (* Native lib pass 1: Register *)
- let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in
- (* Native lib pass 2: Initialize *)
- List.iter (fun f -> f()) fl;
TyperEntry.create com macros
let executable_path() =
Extc.executable_path()
+ open ClassPath
+
let get_std_class_paths () =
try
let p = Sys.getenv "HAXE_STD_PATH" in
@@ -196,7 +206,7 @@ module Setup = struct
l
in
let parts = Str.split_delim (Str.regexp "[;:]") p in
- "" :: List.map Path.add_trailing_slash (loop parts)
+ List.map (fun s -> s,Std) (loop parts)
with Not_found ->
let base_path = Path.get_real_path (try executable_path() with _ -> "./") in
if Sys.os_type = "Unix" then
@@ -204,17 +214,24 @@ module Setup = struct
let lib_path = Filename.concat prefix_path "lib" in
let share_path = Filename.concat prefix_path "share" in
[
- "";
- Path.add_trailing_slash (Filename.concat share_path "haxe/std");
- Path.add_trailing_slash (Filename.concat lib_path "haxe/std");
- Path.add_trailing_slash (Filename.concat base_path "std");
+ (Filename.concat share_path "haxe/std"),Std;
+ (Filename.concat lib_path "haxe/std"),Std;
+ (Filename.concat base_path "std"),Std;
]
else
[
- "";
- Path.add_trailing_slash (Filename.concat base_path "std");
+ (Filename.concat base_path "std"),Std;
]
+ let init_std_class_paths com =
+ List.iter (fun (s,scope) ->
+ try if Sys.is_directory s then
+ let cp = new ClassPath.directory_class_path (Path.add_trailing_slash s) scope in
+ com.class_paths#add cp
+ with Sys_error _ -> ()
+ ) (List.rev (get_std_class_paths ()));
+ com.class_paths#add com.empty_class_path
+
let setup_common_context ctx =
let com = ctx.com in
ctx.com.print <- ctx.comm.write_out;
@@ -254,8 +271,7 @@ module Setup = struct
) (filter_messages false (fun _ -> true))));
com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
com.run_command <- run_command ctx;
- com.class_path <- get_std_class_paths ();
- com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path
+ init_std_class_paths com
end
@@ -272,23 +288,23 @@ let check_defines com =
end
(** Creates the typer context and types [classes] into it. *)
-let do_type ctx mctx actx display_file_dot_path macro_cache_enabled =
+let do_type ctx mctx actx display_file_dot_path =
let com = ctx.com in
let t = Timer.timer ["typing"] in
let cs = com.cs in
CommonCache.maybe_add_context_sign cs com "before_init_macros";
enter_stage com CInitMacrosStart;
ServerMessage.compiler_stage com;
-
+ Setup.init_native_libs com actx.hxb_libs;
let mctx = List.fold_left (fun mctx path ->
Some (MacroContext.call_init_macro ctx.com mctx path)
) mctx (List.rev actx.config_macros) in
enter_stage com CInitMacrosDone;
ServerMessage.compiler_stage com;
- MacroContext.macro_enable_cache := macro_cache_enabled;
let macros = match mctx with None -> None | Some mctx -> mctx.g.macros in
- let tctx = Setup.create_typer_context ctx macros actx.native_libs in
+ Setup.init_native_libs com actx.native_libs;
+ let tctx = Setup.create_typer_context ctx macros in
let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in
check_defines ctx.com;
CommonCache.lock_signature com "after_init_macros";
@@ -320,7 +336,7 @@ 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()
@@ -328,7 +344,7 @@ let finalize_typing ctx tctx =
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 =
@@ -336,8 +352,6 @@ let compile ctx actx callbacks =
(* Set up display configuration *)
DisplayProcessing.process_display_configuration ctx;
let display_file_dot_path = DisplayProcessing.process_display_file com actx in
- let macro_cache_enabled = !MacroContext.macro_enable_cache in
- MacroContext.macro_enable_cache := true;
let mctx = match com.platform with
| CustomTarget name ->
begin try
@@ -355,6 +369,12 @@ let compile ctx actx callbacks =
callbacks.after_target_init ctx;
let t = Timer.timer ["init"] in
List.iter (fun f -> f()) (List.rev (actx.pre_compilation));
+ begin match actx.hxb_out with
+ | None ->
+ ()
+ | Some file ->
+ com.hxb_writer_config <- HxbWriterConfig.process_argument file
+ end;
t();
enter_stage com CInitialized;
ServerMessage.compiler_stage com;
@@ -362,9 +382,18 @@ let compile ctx actx callbacks =
if actx.cmds = [] && not actx.did_something then actx.raise_usage();
end else begin
(* Actual compilation starts here *)
- let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path macro_cache_enabled in
+ let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path in
DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
finalize_typing ctx tctx;
+ let is_compilation = is_compilation com in
+ com.callbacks#add_after_save (fun () ->
+ callbacks.after_save ctx;
+ if is_compilation then match com.hxb_writer_config with
+ | Some config ->
+ Generate.check_hxb_output ctx config;
+ | None ->
+ ()
+ );
if is_diagnostics com then
filter ctx tctx (fun () -> DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path)
else begin
@@ -372,9 +401,10 @@ let compile ctx actx callbacks =
filter ctx tctx (fun () -> ());
end;
if ctx.has_error then raise Abort;
- Generate.check_auxiliary_output com actx;
+ if is_compilation then Generate.check_auxiliary_output com actx;
enter_stage com CGenerationStart;
ServerMessage.compiler_stage com;
+ Generate.maybe_generate_dump ctx tctx;
if not actx.no_output then Generate.generate ctx tctx ext actx;
enter_stage com CGenerationDone;
ServerMessage.compiler_stage com;
@@ -432,6 +462,7 @@ with
let finalize ctx =
ctx.comm.flush ctx;
+ List.iter (fun lib -> lib#close) ctx.com.hxb_libs;
(* In server mode any open libs are closed by the lib_build_task. In offline mode
we should do it here to be safe. *)
if not ctx.comm.is_server then begin
@@ -488,6 +519,7 @@ let create_context comm cs compilation_step params = {
has_next = false;
has_error = false;
comm = comm;
+ runtime_args = [];
}
module HighLevel = struct
@@ -531,7 +563,7 @@ module HighLevel = struct
if l = "" then
acc
else if l.[0] <> '-' then
- "-cp" :: l :: acc
+ "-libcp" :: l :: acc
else match (try ExtString.String.split l " " with _ -> l, "") with
| ("-L",dir) ->
"--neko-lib-path" :: (String.sub l 3 (String.length l - 3)) :: acc
@@ -593,7 +625,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
diff --git a/src/compiler/displayOutput.ml b/src/compiler/displayOutput.ml
index 99ba1280bbd..bd7795a4a78 100644
--- a/src/compiler/displayOutput.ml
+++ b/src/compiler/displayOutput.ml
@@ -326,7 +326,10 @@ let handle_display_exception_json ctx dex api =
let ctx = DisplayJson.create_json_context api.jsonrpc (match dex with DisplayFields _ -> true | _ -> false) in
api.send_result (DisplayException.to_json ctx dex)
| DisplayNoResult ->
- api.send_result JNull
+ (match ctx.com.display.dms_kind with
+ | DMDefault -> api.send_error [jstring "No completion point"]
+ | _ -> api.send_result JNull
+ )
| _ ->
handle_display_exception_old ctx dex
diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml
index aa25ae6008c..d2dde9cef58 100644
--- a/src/compiler/displayProcessing.ml
+++ b/src/compiler/displayProcessing.ml
@@ -121,6 +121,7 @@ let process_display_file com actx =
let rec loop = function
| [] -> None
| cp :: l ->
+ let cp = cp#path in
let cp = (if cp = "" then "./" else cp) in
let c = Path.add_trailing_slash (Path.get_real_path cp) in
let clen = String.length c in
@@ -135,14 +136,14 @@ let process_display_file com actx =
end else
loop l
in
- loop com.class_path
+ loop com.class_paths#as_list
in
match com.display.dms_display_file_policy with
| DFPNo ->
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 <- [];
@@ -153,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
@@ -223,7 +224,7 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
let load_display_file_standalone (ctx : Typecore.typer) file =
let com = ctx.com in
- let pack,decls = TypeloadParse.parse_module_file com file null_pos in
+ let pack,decls = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
let path = Path.FilePath.parse file in
let name = match path.file_name with
| None -> "?DISPLAY"
@@ -236,7 +237,7 @@ let load_display_file_standalone (ctx : Typecore.typer) file =
let parts = ExtString.String.nsplit dir (if path.backslash then "\\" else "/") in
let parts = List.rev (ExtList.List.drop (List.length pack) (List.rev parts)) in
let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in
- com.class_path <- dir :: com.class_path
+ com.class_paths#add (new ClassPath.directory_class_path dir User)
end;
ignore(TypeloadModule.type_module ctx (pack,name) file ~dont_check_path:true decls null_pos)
@@ -318,7 +319,7 @@ let process_global_display_mode com tctx =
let symbols =
let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in
List.fold_left (fun acc (file_key,cfile) ->
- let file = cfile.c_file_path in
+ let file = cfile.c_file_path.file in
if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
else
diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml
index 1cbcd6df139..04718ece5e0 100644
--- a/src/compiler/generate.ml
+++ b/src/compiler/generate.ml
@@ -1,5 +1,7 @@
open Globals
open CompilationContext
+open TType
+open Tanon_identification
let check_auxiliary_output com actx =
begin match actx.xml_out with
@@ -19,6 +21,76 @@ let check_auxiliary_output com actx =
Genjson.generate com.types file
end
+let export_hxb com config cc platform zip m =
+ let open HxbData in
+ match m.m_extra.m_kind with
+ | MCode | MMacro | MFake | MExtern -> begin
+ (* Printf.eprintf "Export module %s\n" (s_type_path m.m_path); *)
+ let l = platform :: (fst m.m_path @ [snd m.m_path]) in
+ let path = (String.concat "/" l) ^ ".hxb" in
+
+ try
+ let hxb_cache = cc#get_hxb_module m.m_path in
+ let out = IO.output_string () in
+ write_header out;
+ List.iter (fun (kind,data) ->
+ write_chunk_prefix kind (Bytes.length data) out;
+ IO.nwrite out data
+ ) hxb_cache.mc_chunks;
+ let data = IO.close_out out in
+ zip#add_entry data path;
+ with Not_found ->
+ let anon_identification = new tanon_identification in
+ let warn w s p = com.Common.warning w com.warning_options s p in
+ let writer = HxbWriter.create config warn anon_identification in
+ HxbWriter.write_module writer m;
+ let out = IO.output_string () in
+ HxbWriter.export writer out;
+ zip#add_entry (IO.close_out out) path;
+ end
+ | _ ->
+ ()
+
+let check_hxb_output ctx config =
+ let open HxbWriterConfig in
+ let com = ctx.com in
+ let match_path_list l sl_path =
+ List.exists (fun sl -> Ast.match_path true sl_path sl) l
+ in
+ let try_write () =
+ let path = config.HxbWriterConfig.archive_path in
+ let path = Str.global_replace (Str.regexp "\\$target") (platform_name ctx.com.platform) path in
+ let t = Timer.timer ["generate";"hxb"] in
+ Path.mkdir_from_path path;
+ let zip = new Zip_output.zip_output path 6 in
+ let export com config =
+ let cc = CommonCache.get_cache com in
+ let target = Common.platform_name_macro com in
+ List.iter (fun m ->
+ let t = Timer.timer ["generate";"hxb";s_type_path m.m_path] in
+ let sl_path = fst m.m_path @ [snd m.m_path] in
+ if not (match_path_list config.exclude sl_path) || match_path_list config.include' sl_path then
+ Std.finally t (export_hxb com config cc target zip) m
+ ) com.modules;
+ in
+ Std.finally (fun () ->
+ zip#close;
+ t()
+ ) (fun () ->
+ if config.target_config.generate then
+ export com config.target_config;
+ begin match com.get_macros() with
+ | Some mcom when config.macro_config.generate ->
+ export mcom config.macro_config
+ | _ ->
+ ()
+ end;
+ ) ()
+ in
+ try
+ try_write ()
+ with Sys_error s ->
+ CompilationContext.error ctx (Printf.sprintf "Could not write to %s: %s" config.archive_path s) null_pos
let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
| [width; height; fps] ->
@@ -32,12 +104,8 @@ let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
let delete_file f = try Sys.remove f with _ -> ()
-let generate ctx tctx ext actx =
+let maybe_generate_dump ctx tctx =
let com = tctx.Typecore.com in
- (* check file extension. In case of wrong commandline, we don't want
- to accidentaly delete a source file. *)
- if Path.file_extension com.file = ext then delete_file com.file;
- if com.platform = Flash || com.platform = Cpp || com.platform = Hl then List.iter (Codegen.fix_overrides com) com.types;
if Common.defined com Define.Dump then begin
Codegen.Dump.dump_types com;
Option.may Codegen.Dump.dump_types (com.get_macros())
@@ -47,7 +115,14 @@ let generate ctx tctx ext actx =
if not com.is_macro_context then match tctx.Typecore.g.Typecore.macros with
| None -> ()
| Some(_,ctx) -> Codegen.Dump.dump_dependencies ~target_override:(Some "macro") ctx.Typecore.com
- end;
+ end
+
+let generate ctx tctx ext actx =
+ let com = tctx.Typecore.com in
+ (* check file extension. In case of wrong commandline, we don't want
+ to accidentaly delete a source file. *)
+ if Path.file_extension com.file = ext then delete_file com.file;
+ if com.platform = Flash || com.platform = Cpp || com.platform = Hl then List.iter (Codegen.fix_overrides com) com.types;
begin match com.platform with
| Neko | Hl | Eval when actx.interp -> ()
| Cpp when Common.defined com Define.Cppia -> ()
@@ -55,9 +130,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
diff --git a/src/compiler/hxb/hxbData.ml b/src/compiler/hxb/hxbData.ml
new file mode 100644
index 00000000000..5bc8499a802
--- /dev/null
+++ b/src/compiler/hxb/hxbData.ml
@@ -0,0 +1,127 @@
+open Globals
+open Type
+
+exception HxbFailure of string
+
+(*
+ MD = module
+ MT = module type
+ CL = class
+ EN = enum
+ AB = abstract
+ TD = typedef
+ AN = anon
+ CF = class field
+ EF = enum field
+ AF = anon field
+ EX = expression
+ EO = end of (Types | Fields | Module)
+ ..F = forward definition
+ ..R = reference
+ ..D = definition
+*)
+
+type chunk_kind =
+ | STR (* string pool *)
+ | DOC (* doc pool *)
+ | MDF (* module foward *)
+ | MTF (* module types forward *)
+ (* Module type references *)
+ | MDR (* module references *)
+ | CLR (* class references *)
+ | ENR (* enum references *)
+ | ABR (* abstract references *)
+ | TDR (* typedef references *)
+ (* Field references *)
+ | AFR (* anon field references *)
+ (* Own module type definitions *)
+ | CLD (* class definition *)
+ | END (* enum definition *)
+ | ABD (* abstract definition *)
+ | TDD (* typedef definition *)
+ | EOT (* end of module types *)
+ (* Field references *)
+ | EFR (* enum field references *)
+ | CFR (* class field references *)
+ (* Own field definitions *)
+ | CFD (* class fields *)
+ | EFD (* enum fields *)
+ | AFD (* abstract fields *)
+ | EOF (* end of fields *)
+ | EXD (* class field expressions *)
+ | EOM (* end of module *)
+
+type cached_chunk = chunk_kind * bytes
+type cached_chunks = cached_chunk list
+
+type module_cache = {
+ mc_path : path;
+ mc_id : int;
+ mc_chunks : cached_chunks;
+ mc_extra : module_def_extra;
+}
+
+let string_of_chunk_kind = function
+ | STR -> "STR"
+ | DOC -> "DOC"
+ | MDF -> "MDF"
+ | MTF -> "MTF"
+ | MDR -> "MDR"
+ | CLR -> "CLR"
+ | ENR -> "ENR"
+ | ABR -> "ABR"
+ | TDR -> "TDR"
+ | AFR -> "AFR"
+ | EFR -> "EFR"
+ | CFR -> "CFR"
+ | CLD -> "CLD"
+ | END -> "END"
+ | ABD -> "ABD"
+ | TDD -> "TDD"
+ | EOT -> "EOT"
+ | CFD -> "CFD"
+ | EFD -> "EFD"
+ | AFD -> "AFD"
+ | EOF -> "EOF"
+ | EXD -> "EXD"
+ | EOM -> "EOM"
+
+let chunk_kind_of_string = function
+ | "STR" -> STR
+ | "DOC" -> DOC
+ | "MDF" -> MDF
+ | "MTF" -> MTF
+ | "MDR" -> MDR
+ | "CLR" -> CLR
+ | "ENR" -> ENR
+ | "ABR" -> ABR
+ | "TDR" -> TDR
+ | "AFR" -> AFR
+ | "EFR" -> EFR
+ | "CFR" -> CFR
+ | "CLD" -> CLD
+ | "END" -> END
+ | "ABD" -> ABD
+ | "TDD" -> TDD
+ | "EOT" -> EOT
+ | "CFD" -> CFD
+ | "EFD" -> EFD
+ | "AFD" -> AFD
+ | "EOF" -> EOF
+ | "EXD" -> EXD
+ | "EOM" -> EOM
+ | name -> raise (HxbFailure ("Invalid chunk name: " ^ name))
+
+let error (s : string) =
+ Printf.eprintf "[error] %s\n" s;
+ raise (HxbFailure s)
+
+let hxb_version = 1
+
+let write_header ch =
+ IO.nwrite_string ch "hxb";
+ IO.write_byte ch hxb_version
+
+let write_chunk_prefix kind length ch =
+ IO.nwrite ch (Bytes.unsafe_of_string (string_of_chunk_kind kind));
+ IO.write_real_i32 ch (Int32.of_int length)
\ No newline at end of file
diff --git a/src/compiler/hxb/hxbLib.ml b/src/compiler/hxb/hxbLib.ml
new file mode 100644
index 00000000000..3497f56fe24
--- /dev/null
+++ b/src/compiler/hxb/hxbLib.ml
@@ -0,0 +1,63 @@
+open Globals
+open Common
+open ExtString
+
+class hxb_library file_path = object(self)
+ inherit abstract_hxb_lib
+ val zip = lazy (Zip.open_in file_path)
+
+ val mutable cached_files = []
+ val modules = Hashtbl.create 0
+ val mutable closed = false
+ val mutable loaded = false
+
+ method load =
+ if not loaded then begin
+ loaded <- true;
+ let close = Timer.timer ["hxblib";"read"] in
+ List.iter (function
+ | ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".hxb" ->
+ let pack = String.nsplit filename "/" in
+ begin match List.rev pack with
+ | [] -> ()
+ | name :: pack ->
+ let name = String.sub name 0 (String.length name - 4) in
+ let pack = List.rev pack in
+ Hashtbl.add modules (pack,name) (filename,entry);
+ end
+ | _ -> ()
+ ) (Zip.entries (Lazy.force zip));
+ close();
+ end
+
+ method get_bytes (target : string) (path : path) =
+ try
+ let path = (target :: fst path,snd path) in
+ let (filename,entry) = Hashtbl.find modules path in
+ let close = Timer.timer ["hxblib";"get bytes"] in
+ let zip = Lazy.force zip in
+ let data = Zip.read_entry zip entry in
+ close();
+ Some (Bytes.unsafe_of_string data)
+ with Not_found ->
+ None
+
+ method close =
+ if not closed then begin
+ closed <- true;
+ Zip.close_in (Lazy.force zip)
+ end
+
+ method get_file_path = file_path
+end
+
+
+let create_hxb_lib com file_path =
+ let file = if Sys.file_exists file_path then
+ file_path
+ else try
+ Common.find_file com file_path
+ with Not_found ->
+ failwith ("hxb lib " ^ file_path ^ " not found")
+ in
+ new hxb_library file
diff --git a/src/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml
new file mode 100644
index 00000000000..a8cd5651d16
--- /dev/null
+++ b/src/compiler/hxb/hxbReader.ml
@@ -0,0 +1,2000 @@
+open Globals
+open Ast
+open Type
+open HxbData
+open HxbReaderApi
+
+type field_reader_context = {
+ t_pool : Type.t Array.t;
+ pos : pos ref;
+ vars : tvar Array.t;
+ mutable tthis : Type.t option;
+}
+
+let create_field_reader_context p ts vars tthis = {
+ t_pool = ts;
+ pos = ref p;
+ vars = vars;
+ tthis = tthis;
+}
+
+type hxb_reader_stats = {
+ modules_fully_restored : int ref;
+ modules_partially_restored : int ref;
+}
+
+let create_hxb_reader_stats () = {
+ modules_fully_restored = ref 0;
+ modules_partially_restored = ref 0;
+}
+
+module ClassFieldInfo = struct
+ type t = {
+ type_parameters : typed_type_param array;
+ }
+
+ let create params = {
+ type_parameters = params;
+ }
+end
+
+module ClassFieldInfos = struct
+ type t = {
+ infos : ClassFieldInfo.t DynArray.t;
+ }
+
+ let meta = Meta.HxbId
+
+ let create () = {
+ infos = DynArray.create ()
+ }
+
+ let get infos cf =
+ let _,_,p = Meta.get meta cf.cf_meta in
+ DynArray.get infos.infos p.pmin
+
+ let unset infos cf =
+ cf.cf_meta <- Meta.remove meta cf.cf_meta
+
+ let set infos info cf =
+ let index = DynArray.length infos.infos in
+ DynArray.add infos.infos info;
+ cf.cf_meta <- (meta,[],{null_pos with pmin = index}) :: cf.cf_meta
+end
+
+module BytesWithPosition = struct
+ type t = {
+ bytes : bytes;
+ mutable pos : int;
+ }
+
+ let create bytes = {
+ bytes;
+ pos = 0;
+ }
+
+ let read_byte b =
+ let i = Bytes.unsafe_get b.bytes b.pos in
+ b.pos <- b.pos + 1;
+ int_of_char i
+
+ let read_bytes b length =
+ let out = Bytes.create length in
+ Bytes.blit b.bytes b.pos out 0 length;
+ b.pos <- b.pos + length;
+ out
+
+ let read_i16 i =
+ let ch2 = read_byte i in
+ let ch1 = read_byte i in
+ let n = ch1 lor (ch2 lsl 8) in
+ if ch2 land 128 <> 0 then
+ n - 65536
+ else
+ n
+
+ let read_real_i32 ch =
+ let ch1 = read_byte ch in
+ let ch2 = read_byte ch in
+ let ch3 = read_byte ch in
+ let base = Int32.of_int (ch1 lor (ch2 lsl 8) lor (ch3 lsl 16)) in
+ let big = Int32.shift_left (Int32.of_int (read_byte ch)) 24 in
+ Int32.logor base big
+
+ let read_i64 ch =
+ let big = Int64.of_int32 (read_real_i32 ch) in
+ let ch4 = read_byte ch in
+ let ch3 = read_byte ch in
+ let ch2 = read_byte ch in
+ let ch1 = read_byte ch in
+ let base = Int64.of_int (ch1 lor (ch2 lsl 8) lor (ch3 lsl 16)) in
+ let small = Int64.logor base (Int64.shift_left (Int64.of_int ch4) 24) in
+ Int64.logor (Int64.shift_left big 32) small
+
+ let read_double ch =
+ Int64.float_of_bits (read_i64 ch)
+end
+
+open BytesWithPosition
+
+let rec read_uleb128 ch =
+ let b = read_byte ch in
+ if b >= 0x80 then
+ (b land 0x7F) lor ((read_uleb128 ch) lsl 7)
+ else
+ b
+
+let read_leb128 ch =
+ let rec read acc shift =
+ let b = read_byte ch in
+ let acc = ((b land 0x7F) lsl shift) lor acc in
+ if b >= 0x80 then
+ read acc (shift + 7)
+ else
+ (b, acc, shift + 7)
+ in
+ let last, acc, shift = read 0 0 in
+ let res = (if (last land 0x40) <> 0 then
+ acc lor ((lnot 0) lsl shift)
+ else
+ acc) in
+ res
+
+let dump_stats name stats =
+ print_endline (Printf.sprintf "hxb_reader stats for %s" name);
+ print_endline (Printf.sprintf " modules partially restored: %i" (!(stats.modules_fully_restored) - !(stats.modules_partially_restored)));
+ print_endline (Printf.sprintf " modules fully restored: %i" !(stats.modules_fully_restored));
+
+class hxb_reader
+ (mpath : path)
+ (stats : hxb_reader_stats)
+= object(self)
+ val mutable api = Obj.magic ""
+ val mutable current_module = null_module
+
+ val mutable ch = BytesWithPosition.create (Bytes.create 0)
+ val mutable string_pool = Array.make 0 ""
+ val mutable doc_pool = Array.make 0 ""
+
+ val mutable classes = Array.make 0 null_class
+ val mutable abstracts = Array.make 0 null_abstract
+ val mutable enums = Array.make 0 null_enum
+ val mutable typedefs = Array.make 0 null_typedef
+ val mutable anons = Array.make 0 null_tanon
+ val mutable anon_fields = Array.make 0 null_field
+ val mutable tmonos = Array.make 0 (mk_mono())
+ val mutable class_fields = Array.make 0 null_field
+ val mutable enum_fields = Array.make 0 null_enum_field
+
+ val mutable type_type_parameters = Array.make 0 (mk_type_param null_class TPHType None None)
+ val mutable field_type_parameters = Array.make 0 (mk_type_param null_class TPHMethod None None)
+ val mutable local_type_parameters = Array.make 0 (mk_type_param null_class TPHLocal None None)
+
+ val mutable field_type_parameter_offset = 0
+ val empty_anon = mk_anon (ref Closed)
+
+ method resolve_type pack mname tname =
+ try
+ api#resolve_type pack mname tname
+ with Not_found ->
+ dump_backtrace();
+ error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname)))
+
+ (* Primitives *)
+
+ method read_i32 =
+ read_real_i32 ch
+
+ method read_i16 =
+ read_i16 ch
+
+ method read_f64 =
+ read_double ch
+
+ method read_bool =
+ read_byte ch <> 0
+
+ method read_from_string_pool pool =
+ pool.(read_uleb128 ch)
+
+ method read_string =
+ self#read_from_string_pool string_pool
+
+ method read_raw_string =
+ let l = read_uleb128 ch in
+ Bytes.unsafe_to_string (read_bytes ch l)
+
+ (* Basic compounds *)
+
+ method read_list : 'a . (unit -> 'a) -> 'a list = fun f ->
+ let l = read_uleb128 ch in
+ List.init l (fun _ -> f ())
+
+ method read_option : 'a . (unit -> 'a) -> 'a option = fun f ->
+ match read_byte ch with
+ | 0 ->
+ None
+ | _ ->
+ Some (f())
+
+ method read_path =
+ let pack = self#read_list (fun () -> self#read_string) in
+ let name = self#read_string in
+ (pack,name)
+
+ method read_full_path =
+ let pack = self#read_list (fun () -> self#read_string) in
+ let mname = self#read_string in
+ let tname = self#read_string in
+ (pack,mname,tname)
+
+ method read_documentation =
+ let doc_own = self#read_option (fun () ->
+ self#read_from_string_pool doc_pool
+ ) in
+ let doc_inherited = self#read_list (fun () ->
+ self#read_from_string_pool doc_pool
+ ) in
+ {doc_own;doc_inherited}
+
+ method read_pos =
+ let file = self#read_string in
+ let min = read_leb128 ch in
+ let max = read_leb128 ch in
+ let pos = {
+ pfile = file;
+ pmin = min;
+ pmax = max;
+ } in
+ pos
+
+ method read_pos_pair =
+ let file = self#read_string in
+ let min1 = read_leb128 ch in
+ let max1 = read_leb128 ch in
+ let min2 = read_leb128 ch in
+ let max2 = read_leb128 ch in
+ let pos1 = {
+ pfile = file;
+ pmin = min1;
+ pmax = max1;
+ } in
+ let pos2 = {
+ pos1 with
+ pmin = pos1.pmin + min2;
+ pmax = pos1.pmin + max2;
+ } in
+ pos1,pos2
+
+ method read_metadata_entry : metadata_entry =
+ let name = self#read_string in
+ let p = self#read_pos in
+ let el = self#read_list (fun () -> self#read_expr) in
+ (Meta.from_string name,el,p)
+
+ method read_metadata =
+ self#read_list (fun () -> self#read_metadata_entry)
+
+ (* References *)
+
+ method read_class_ref =
+ classes.(read_uleb128 ch)
+
+ method read_abstract_ref =
+ abstracts.(read_uleb128 ch)
+
+ method read_enum_ref =
+ enums.(read_uleb128 ch)
+
+ method read_typedef_ref =
+ typedefs.(read_uleb128 ch)
+
+ method read_field_ref =
+ class_fields.(read_uleb128 ch)
+
+ method read_enum_field_ref =
+ enum_fields.(read_uleb128 ch)
+
+ method read_anon_ref =
+ match read_byte ch with
+ | 0 ->
+ anons.(read_uleb128 ch)
+ | 1 ->
+ let an = anons.(read_uleb128 ch) in
+ self#read_anon an
+ | _ ->
+ assert false
+
+ method read_anon_field_ref =
+ match read_byte ch with
+ | 0 ->
+ anon_fields.(read_uleb128 ch)
+ | 1 ->
+ let cf = anon_fields.(read_uleb128 ch) in
+ self#read_class_field_and_overloads_data cf;
+ cf
+ | _ ->
+ assert false
+
+ (* Expr *)
+
+ method get_binop i = match i with
+ | 0 -> OpAdd
+ | 1 -> OpMult
+ | 2 -> OpDiv
+ | 3 -> OpSub
+ | 4 -> OpAssign
+ | 5 -> OpEq
+ | 6 -> OpNotEq
+ | 7 -> OpGt
+ | 8 -> OpGte
+ | 9 -> OpLt
+ | 10 -> OpLte
+ | 11 -> OpAnd
+ | 12 -> OpOr
+ | 13 -> OpXor
+ | 14 -> OpBoolAnd
+ | 15 -> OpBoolOr
+ | 16 -> OpShl
+ | 17 -> OpShr
+ | 18 -> OpUShr
+ | 19 -> OpMod
+ | 20 -> OpInterval
+ | 21 -> OpArrow
+ | 22 -> OpIn
+ | 23 -> OpNullCoal
+ | _ -> OpAssignOp (self#get_binop (i - 30))
+
+ method get_unop i = match i with
+ | 0 -> Increment,Prefix
+ | 1 -> Decrement,Prefix
+ | 2 -> Not,Prefix
+ | 3 -> Neg,Prefix
+ | 4 -> NegBits,Prefix
+ | 5 -> Spread,Prefix
+ | 6 -> Increment,Postfix
+ | 7 -> Decrement,Postfix
+ | 8 -> Not,Postfix
+ | 9 -> Neg,Postfix
+ | 10 -> NegBits,Postfix
+ | 11 -> Spread,Postfix
+ | _ -> assert false
+
+ method read_placed_name =
+ let s = self#read_string in
+ let p = self#read_pos in
+ (s,p)
+
+ method read_type_path =
+ let pack = self#read_list (fun () -> self#read_string) in
+ let name = self#read_string in
+ let tparams = self#read_list (fun () -> self#read_type_param_or_const) in
+ let tsub = self#read_option (fun () -> self#read_string) in
+ {
+ tpackage = pack;
+ tname = name;
+ tparams = tparams;
+ tsub = tsub;
+ }
+
+ method read_placed_type_path =
+ let tp = self#read_type_path in
+ let pfull,ppath = self#read_pos_pair in
+ {
+ path = tp;
+ pos_full = pfull;
+ pos_path = ppath;
+ }
+
+ method read_type_param =
+ let pn = self#read_placed_name in
+ let ttp = self#read_list (fun () -> self#read_type_param) in
+ let tho = self#read_option (fun () -> self#read_type_hint) in
+ let def = self#read_option (fun () -> self#read_type_hint) in
+ let meta = self#read_metadata in
+ {
+ tp_name = pn;
+ tp_params = ttp;
+ tp_constraints = tho;
+ tp_meta = meta;
+ tp_default = def;
+ }
+
+ method read_type_param_or_const =
+ match read_byte ch with
+ | 0 -> TPType (self#read_type_hint)
+ | 1 -> TPExpr (self#read_expr)
+ | _ -> assert false
+
+ method read_func_arg =
+ let pn = self#read_placed_name in
+ let b = self#read_bool in
+ let meta = self#read_metadata in
+ let tho = self#read_option (fun () -> self#read_type_hint) in
+ let eo = self#read_option (fun () -> self#read_expr) in
+ (pn,b,meta,tho,eo)
+
+ method read_func =
+ let params = self#read_list (fun () -> self#read_type_param) in
+ let args = self#read_list (fun () -> self#read_func_arg) in
+ let tho = self#read_option (fun () -> self#read_type_hint) in
+ let eo = self#read_option (fun () -> self#read_expr) in
+ {
+ f_params = params;
+ f_args = args;
+ f_type = tho;
+ f_expr = eo;
+ }
+
+ method read_complex_type =
+ match read_byte ch with
+ | 0 -> CTPath (self#read_placed_type_path)
+ | 1 ->
+ let thl = self#read_list (fun () -> self#read_type_hint) in
+ let th = self#read_type_hint in
+ CTFunction(thl,th)
+ | 2 -> CTAnonymous (self#read_list (fun () -> self#read_cfield))
+ | 3 -> CTParent (self#read_type_hint)
+ | 4 ->
+ let ptp = self#read_list (fun () -> self#read_placed_type_path) in
+ let cffl = self#read_list (fun () -> self#read_cfield) in
+ CTExtend(ptp,cffl)
+ | 5 -> CTOptional (self#read_type_hint)
+ | 6 ->
+ let pn = self#read_placed_name in
+ let th = self#read_type_hint in
+ CTNamed(pn,th)
+ | 7 -> CTIntersection (self#read_list (fun () -> self#read_type_hint))
+ | _ -> assert false
+
+ method read_type_hint =
+ let ct = self#read_complex_type in
+ let p = self#read_pos in
+ (ct,p)
+
+ method read_access =
+ match read_byte ch with
+ | 0 -> APublic
+ | 1 -> APrivate
+ | 2 -> AStatic
+ | 3 -> AOverride
+ | 4 -> ADynamic
+ | 5 -> AInline
+ | 6 -> AMacro
+ | 7 -> AFinal
+ | 8 -> AExtern
+ | 9 -> AAbstract
+ | 10 -> AOverload
+ | 11 -> AEnum
+ | _ -> assert false
+
+ method read_placed_access =
+ let ac = self#read_access in
+ let p = self#read_pos in
+ (ac,p)
+
+ method read_cfield_kind =
+ match read_byte ch with
+ | 0 ->
+ let tho = self#read_option (fun () -> self#read_type_hint) in
+ let eo = self#read_option (fun () -> self#read_expr) in
+ FVar(tho,eo)
+ | 1 -> FFun (self#read_func)
+ | 2 ->
+ let pn1 = self#read_placed_name in
+ let pn2 = self#read_placed_name in
+ let tho = self#read_option (fun () -> self#read_type_hint) in
+ let eo = self#read_option (fun () -> self#read_expr) in
+ FProp(pn1,pn2,tho,eo)
+ | _ -> assert false
+
+ method read_cfield =
+ let pn = self#read_placed_name in
+ let doc = self#read_option (fun () -> self#read_documentation) in
+ let pos = self#read_pos in
+ let meta = self#read_metadata in
+ let access = self#read_list (fun () -> self#read_placed_access) in
+ let kind = self#read_cfield_kind in
+ {
+ cff_name = pn;
+ cff_doc = doc;
+ cff_pos = pos;
+ cff_meta = meta;
+ cff_access = access;
+ cff_kind = kind;
+ }
+
+ method read_expr =
+ let p = self#read_pos in
+ let e = match read_byte ch with
+ | 0 ->
+ let s = self#read_string in
+ let suffix = self#read_option (fun () -> self#read_string) in
+ EConst (Int (s, suffix))
+ | 1 ->
+ let s = self#read_string in
+ let suffix = self#read_option (fun () -> self#read_string) in
+ EConst (Float (s, suffix))
+ | 2 ->
+ let s = self#read_string in
+ let qs = begin match read_byte ch with
+ | 0 -> SDoubleQuotes
+ | 1 -> SSingleQuotes
+ | _ -> assert false
+ end in
+ EConst (String (s,qs))
+ | 3 ->
+ EConst (Ident (self#read_string))
+ | 4 ->
+ let s1 = self#read_string in
+ let s2 = self#read_string in
+ EConst (Regexp(s1,s2))
+ | 5 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ EArray(e1,e2)
+ | 6 ->
+ let op = self#get_binop (read_byte ch) in
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ EBinop(op,e1,e2)
+ | 7 ->
+ let e = self#read_expr in
+ let s = self#read_string in
+ let kind = begin match read_byte ch with
+ | 0 -> EFNormal
+ | 1 -> EFSafe
+ | _ -> assert false
+ end in
+ EField(e,s,kind)
+ | 8 ->
+ EParenthesis (self#read_expr)
+ | 9 ->
+ let fields = self#read_list (fun () ->
+ let n = self#read_string in
+ let p = self#read_pos in
+ let qs = begin match read_byte ch with
+ | 0 -> NoQuotes
+ | 1 -> DoubleQuotes
+ | _ -> assert false
+ end in
+ let e = self#read_expr in
+ ((n,p,qs),e)
+ ) in
+ EObjectDecl fields
+ | 10 ->
+ let el = self#read_list (fun () -> self#read_expr) in
+ EArrayDecl el
+ | 11 ->
+ let e = self#read_expr in
+ let el = self#read_list (fun () -> self#read_expr) in
+ ECall(e,el)
+ | 12 ->
+ let ptp = self#read_placed_type_path in
+ let el = self#read_list (fun () -> self#read_expr) in
+ ENew(ptp,el)
+ | 13 ->
+ let (op,flag) = self#get_unop (read_byte ch) in
+ let e = self#read_expr in
+ EUnop(op,flag,e)
+ | 14 ->
+ let vl = self#read_list (fun () ->
+ let name = self#read_placed_name in
+ let final = self#read_bool in
+ let static = self#read_bool in
+ let t = self#read_option (fun () -> self#read_type_hint) in
+ let expr = self#read_option (fun () -> self#read_expr) in
+ let meta = self#read_metadata in
+ {
+ ev_name = name;
+ ev_final = final;
+ ev_static = static;
+ ev_type = t;
+ ev_expr = expr;
+ ev_meta = meta;
+ }
+ ) in
+ EVars vl
+ | 15 ->
+ let fk = begin match read_byte ch with
+ | 0 -> FKAnonymous
+ | 1 ->
+ let pn = self#read_placed_name in
+ let b = self#read_bool in
+ FKNamed(pn,b)
+ | 2 -> FKArrow
+ | _ -> assert false end in
+ let f = self#read_func in
+ EFunction(fk,f)
+ | 16 ->
+ EBlock (self#read_list (fun () -> self#read_expr))
+ | 17 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ EFor(e1,e2)
+ | 18 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ EIf(e1,e2,None)
+ | 19 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ let e3 = self#read_expr in
+ EIf(e1,e2,Some e3)
+ | 20 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ EWhile(e1,e2,NormalWhile)
+ | 21 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ EWhile(e1,e2,DoWhile)
+ | 22 ->
+ let e1 = self#read_expr in
+ let cases = self#read_list (fun () ->
+ let el = self#read_list (fun () -> self#read_expr) in
+ let eg = self#read_option (fun () -> self#read_expr) in
+ let eo = self#read_option (fun () -> self#read_expr) in
+ let p = self#read_pos in
+ (el,eg,eo,p)
+ ) in
+ let def = self#read_option (fun () ->
+ let eo = self#read_option (fun () -> self#read_expr) in
+ let p = self#read_pos in
+ (eo,p)
+ ) in
+ ESwitch(e1,cases,def)
+ | 23 ->
+ let e1 = self#read_expr in
+ let catches = self#read_list (fun () ->
+ let pn = self#read_placed_name in
+ let th = self#read_option (fun () -> self#read_type_hint) in
+ let e = self#read_expr in
+ let p = self#read_pos in
+ (pn,th,e,p)
+ ) in
+ ETry(e1,catches)
+ | 24 -> EReturn None
+ | 25 -> EReturn (Some (self#read_expr))
+ | 26 -> EBreak
+ | 27 -> EContinue
+ | 28 -> EUntyped (self#read_expr)
+ | 29 -> EThrow (self#read_expr)
+ | 30 -> ECast ((self#read_expr),None)
+ | 31 ->
+ let e1 = self#read_expr in
+ let th = self#read_type_hint in
+ ECast(e1,Some th)
+ | 32 ->
+ let e1 = self#read_expr in
+ let th = self#read_type_hint in
+ EIs(e1,th)
+ | 33 ->
+ let e1 = self#read_expr in
+ let dk = begin match read_byte ch with
+ | 0 -> DKCall
+ | 1 -> DKDot
+ | 2 -> DKStructure
+ | 3 -> DKMarked
+ | 4 -> DKPattern (self#read_bool)
+ | _ -> assert false end in
+ EDisplay(e1,dk)
+ | 34 ->
+ let e1 = self#read_expr in
+ let e2 = self#read_expr in
+ let e3 = self#read_expr in
+ ETernary(e1,e2,e3)
+ | 35 ->
+ let e1 = self#read_expr in
+ let th = self#read_type_hint in
+ ECheckType(e1,th)
+ | 36 ->
+ let m = self#read_metadata_entry in
+ let e = self#read_expr in
+ EMeta(m,e)
+ | _ -> assert false
+ in
+ (e,p)
+
+ (* Type instances *)
+
+ method resolve_ttp_ref = function
+ | 1 ->
+ let i = read_uleb128 ch in
+ (type_type_parameters.(i))
+ | 2 ->
+ let i = read_uleb128 ch in
+ (field_type_parameters.(i))
+ | 3 ->
+ let k = read_uleb128 ch in
+ local_type_parameters.(k)
+ | _ ->
+ die "" __LOC__
+
+ method read_type_instance =
+ let read_fun_arg () =
+ let name = self#read_string in
+ let opt = self#read_bool in
+ let t = self#read_type_instance in
+ (name,opt,t)
+ in
+ match (read_byte ch) with
+ | 0 ->
+ let i = read_uleb128 ch in
+ tmonos.(i)
+ | 1 ->
+ let i = read_uleb128 ch in
+ (type_type_parameters.(i)).ttp_type
+ | 2 ->
+ let i = read_uleb128 ch in
+ (field_type_parameters.(i)).ttp_type
+ | 3 ->
+ let k = read_uleb128 ch in
+ local_type_parameters.(k).ttp_type
+ | 4 ->
+ t_dynamic
+ | 10 ->
+ let c = self#read_class_ref in
+ c.cl_type
+ | 11 ->
+ let en = self#read_enum_ref in
+ en.e_type
+ | 12 ->
+ let a = self#read_abstract_ref in
+ TType(abstract_module_type a [],[])
+ | 13 ->
+ let e = self#read_expr in
+ let c = {null_class with cl_kind = KExpr e; cl_module = current_module } in
+ TInst(c, [])
+ | 20 ->
+ TFun([],api#basic_types.tvoid)
+ | 21 ->
+ let arg1 = read_fun_arg () in
+ TFun([arg1],api#basic_types.tvoid)
+ | 22 ->
+ let arg1 = read_fun_arg () in
+ let arg2 = read_fun_arg () in
+ TFun([arg1;arg2],api#basic_types.tvoid)
+ | 23 ->
+ let arg1 = read_fun_arg () in
+ let arg2 = read_fun_arg () in
+ let arg3 = read_fun_arg () in
+ TFun([arg1;arg2;arg3],api#basic_types.tvoid)
+ | 24 ->
+ let arg1 = read_fun_arg () in
+ let arg2 = read_fun_arg () in
+ let arg3 = read_fun_arg () in
+ let arg4 = read_fun_arg () in
+ TFun([arg1;arg2;arg3;arg4],api#basic_types.tvoid)
+ | 29 ->
+ let args = self#read_list read_fun_arg in
+ TFun(args,api#basic_types.tvoid)
+ | 30 ->
+ let ret = self#read_type_instance in
+ TFun([],ret)
+ | 31 ->
+ let arg1 = read_fun_arg () in
+ let ret = self#read_type_instance in
+ TFun([arg1],ret)
+ | 32 ->
+ let arg1 = read_fun_arg () in
+ let arg2 = read_fun_arg () in
+ let ret = self#read_type_instance in
+ TFun([arg1;arg2],ret)
+ | 33 ->
+ let arg1 = read_fun_arg () in
+ let arg2 = read_fun_arg () in
+ let arg3 = read_fun_arg () in
+ let ret = self#read_type_instance in
+ TFun([arg1;arg2;arg3],ret)
+ | 34 ->
+ let arg1 = read_fun_arg () in
+ let arg2 = read_fun_arg () in
+ let arg3 = read_fun_arg () in
+ let arg4 = read_fun_arg () in
+ let ret = self#read_type_instance in
+ TFun([arg1;arg2;arg3;arg4],ret)
+ | 39 ->
+ let args = self#read_list read_fun_arg in
+ let ret = self#read_type_instance in
+ TFun(args,ret)
+ | 40 ->
+ let c = self#read_class_ref in
+ TInst(c,[])
+ | 41 ->
+ let c = self#read_class_ref in
+ let t1 = self#read_type_instance in
+ TInst(c,[t1])
+ | 42 ->
+ let c = self#read_class_ref in
+ let t1 = self#read_type_instance in
+ let t2 = self#read_type_instance in
+ TInst(c,[t1;t2])
+ | 49 ->
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ TInst(c,tl)
+ | 50 ->
+ let en = self#read_enum_ref in
+ TEnum(en,[])
+ | 51 ->
+ let en = self#read_enum_ref in
+ let t1 = self#read_type_instance in
+ TEnum(en,[t1])
+ | 52 ->
+ let en = self#read_enum_ref in
+ let t1 = self#read_type_instance in
+ let t2 = self#read_type_instance in
+ TEnum(en,[t1;t2])
+ | 59 ->
+ let e = self#read_enum_ref in
+ let tl = self#read_types in
+ TEnum(e,tl)
+ | 60 ->
+ let td = self#read_typedef_ref in
+ TType(td,[])
+ | 61 ->
+ let td = self#read_typedef_ref in
+ let t1 = self#read_type_instance in
+ TType(td,[t1])
+ | 62 ->
+ let td = self#read_typedef_ref in
+ let t1 = self#read_type_instance in
+ let t2 = self#read_type_instance in
+ TType(td,[t1;t2])
+ | 69 ->
+ let t = self#read_typedef_ref in
+ let tl = self#read_types in
+ TType(t,tl)
+ | 70 ->
+ let a = self#read_abstract_ref in
+ TAbstract(a,[])
+ | 71 ->
+ let a = self#read_abstract_ref in
+ let t1 = self#read_type_instance in
+ TAbstract(a,[t1])
+ | 72 ->
+ let a = self#read_abstract_ref in
+ let t1 = self#read_type_instance in
+ let t2 = self#read_type_instance in
+ TAbstract(a,[t1;t2])
+ | 79 ->
+ let a = self#read_abstract_ref in
+ let tl = self#read_types in
+ TAbstract(a,tl)
+ | 80 ->
+ empty_anon
+ | 81 ->
+ TAnon self#read_anon_ref
+ | 89 ->
+ TDynamic (Some self#read_type_instance)
+ | 100 ->
+ api#basic_types.tvoid
+ | 101 ->
+ api#basic_types.tint
+ | 102 ->
+ api#basic_types.tfloat
+ | 103 ->
+ api#basic_types.tbool
+ | 104 ->
+ api#basic_types.tstring
+ | i ->
+ error (Printf.sprintf "Bad type instance id: %i" i)
+
+ method read_types =
+ self#read_list (fun () -> self#read_type_instance)
+
+ method read_type_parameters_forward =
+ let length = read_uleb128 ch in
+ Array.init length (fun _ ->
+ let path = self#read_path in
+ let pos = self#read_pos in
+ let host = match read_byte ch with
+ | 0 -> TPHType
+ | 1 -> TPHConstructor
+ | 2 -> TPHMethod
+ | 3 -> TPHEnumConstructor
+ | 4 -> TPHAnonField
+ | 5 -> TPHLocal
+ | i -> die (Printf.sprintf "Invalid type paramter host: %i" i) __LOC__
+ in
+ let c = mk_class current_module path pos pos in
+ mk_type_param c host None None
+ )
+
+ method read_type_parameters_data (a : typed_type_param array) =
+ Array.iter (fun ttp ->
+ let meta = self#read_metadata in
+ let constraints = self#read_types in
+ let def = self#read_option (fun () -> self#read_type_instance) in
+ let c = ttp.ttp_class in
+ ttp.ttp_default <- def;
+ ttp.ttp_constraints <- Some (Lazy.from_val constraints);
+ c.cl_meta <- meta;
+ ) a
+
+ (* Fields *)
+
+ method read_field_kind = match read_byte ch with
+ | 0 -> Method MethNormal
+ | 1 -> Method MethInline
+ | 2 -> Method MethDynamic
+ | 3 -> Method MethMacro
+ | 10 -> Var {v_read = AccNormal;v_write = AccNormal}
+ | 11 -> Var {v_read = AccNormal;v_write = AccNo}
+ | 12 -> Var {v_read = AccNormal;v_write = AccNever}
+ | 13 -> Var {v_read = AccNormal;v_write = AccCtor}
+ | 14 -> Var {v_read = AccNormal;v_write = AccCall}
+ | 20 -> Var {v_read = AccInline;v_write = AccNever}
+ | 30 -> Var {v_read = AccCall;v_write = AccNormal}
+ | 31 -> Var {v_read = AccCall;v_write = AccNo}
+ | 32 -> Var {v_read = AccCall;v_write = AccNever}
+ | 33 -> Var {v_read = AccCall;v_write = AccCtor}
+ | 34 -> Var {v_read = AccCall;v_write = AccCall}
+ | 100 ->
+ let f = function
+ | 0 -> AccNormal
+ | 1 -> AccNo
+ | 2 -> AccNever
+ | 3 -> AccCtor
+ | 4 -> AccCall
+ | 5 -> AccInline
+ | 6 ->
+ let s = self#read_string in
+ let so = self#read_option (fun () -> self#read_string) in
+ AccRequire(s,so)
+ | i ->
+ error (Printf.sprintf "Bad accessor kind: %i" i)
+ in
+ let r = f (read_byte ch) in
+ let w = f (read_byte ch) in
+ Var {v_read = r;v_write = w}
+ | i ->
+ error (Printf.sprintf "Bad field kind: %i" i)
+
+ method read_var_kind =
+ match read_byte ch with
+ | 0 -> VUser TVOLocalVariable
+ | 1 -> VUser TVOArgument
+ | 2 -> VUser TVOForVariable
+ | 3 -> VUser TVOPatternVariable
+ | 4 -> VUser TVOCatchVariable
+ | 5 -> VUser TVOLocalFunction
+ | 6 -> VGenerated
+ | 7 -> VInlined
+ | 8 -> VInlinedConstructorVariable
+ | 9 -> VExtractorVariable
+ | 10 -> VAbstractThis
+ | _ -> assert false
+
+ method read_var =
+ let id = read_uleb128 ch in
+ let name = self#read_string in
+ let kind = self#read_var_kind in
+ let flags = read_uleb128 ch in
+ let meta = self#read_metadata in
+ let pos = self#read_pos in
+ let v = {
+ v_id = api#get_var_id id;
+ v_name = name;
+ v_type = t_dynamic;
+ v_kind = kind;
+ v_meta = meta;
+ v_pos = pos;
+ v_extra = None;
+ v_flags = flags;
+ } in
+ v
+
+ method read_texpr fctx =
+
+ let declare_local () =
+ let v = fctx.vars.(read_uleb128 ch) in
+ v.v_extra <- self#read_option (fun () ->
+ let params = self#read_list (fun () ->
+ let i = read_uleb128 ch in
+ local_type_parameters.(i)
+ ) in
+ let vexpr = self#read_option (fun () -> self#read_texpr fctx) in
+ {
+ v_params = params;
+ v_expr = vexpr;
+ };
+ );
+ v.v_type <- self#read_type_instance;
+ v
+ in
+ let update_pmin () =
+ fctx.pos := {!(fctx.pos) with pmin = read_leb128 ch};
+ in
+ let update_pmax () =
+ fctx.pos := {!(fctx.pos) with pmax = read_leb128 ch};
+ in
+ let update_pminmax () =
+ let pmin = read_leb128 ch in
+ let pmax = read_leb128 ch in
+ fctx.pos := {!(fctx.pos) with pmin; pmax};
+ in
+ let update_p () =
+ fctx.pos := self#read_pos;
+ in
+ let read_relpos () =
+ begin match read_byte ch with
+ | 0 ->
+ ()
+ | 1 ->
+ update_pmin ()
+ | 2 ->
+ update_pmax ()
+ | 3 ->
+ update_pminmax ()
+ | 4 ->
+ update_p ()
+ | _ ->
+ assert false
+ end;
+ !(fctx.pos)
+ in
+ let rec loop () =
+ let loop2 () =
+ match read_byte ch with
+ (* values 0-19 *)
+ | 0 -> TConst TNull,None
+ | 1 -> TConst TThis,fctx.tthis
+ | 2 -> TConst TSuper,None
+ | 3 -> TConst (TBool false),(Some api#basic_types.tbool)
+ | 4 -> TConst (TBool true),(Some api#basic_types.tbool)
+ | 5 -> TConst (TInt self#read_i32),(Some api#basic_types.tint)
+ | 6 -> TConst (TFloat self#read_string),(Some api#basic_types.tfloat)
+ | 7 -> TConst (TString self#read_string),(Some api#basic_types.tstring)
+ | 13 -> TConst (TBool false),None
+ | 14 -> TConst (TBool true),None
+ | 15 -> TConst (TInt self#read_i32),None
+ | 16 -> TConst (TFloat self#read_string),None
+ | 17 -> TConst (TString self#read_string),None
+
+ (* vars 20-29 *)
+ | 20 ->
+ TLocal (fctx.vars.(read_uleb128 ch)),None
+ | 21 ->
+ let v = declare_local () in
+ TVar (v,None),(Some api#basic_types.tvoid)
+ | 22 ->
+ let v = declare_local () in
+ let e = loop () in
+ TVar (v, Some e),(Some api#basic_types.tvoid)
+
+ (* blocks 30-49 *)
+ | 30 ->
+ TBlock [],None
+ | 31 | 32 | 33 | 34 | 35 as i ->
+ let l = i - 30 in
+ let el = List.init l (fun _ -> loop ()) in
+ TBlock el,None
+ | 36 ->
+ let l = read_byte ch in
+ let el = List.init l (fun _ -> loop ()) in
+ TBlock el,None
+ | 39 ->
+ let el = self#read_list loop in
+ TBlock el,None
+
+ (* function 50-59 *)
+ | 50 ->
+ let read_tfunction_arg () =
+ let v = declare_local () in
+ let cto = self#read_option loop in
+ (v,cto)
+ in
+ let args = self#read_list read_tfunction_arg in
+ let r = self#read_type_instance in
+ let e = loop () in
+ TFunction {
+ tf_args = args;
+ tf_type = r;
+ tf_expr = e;
+ },None
+ (* texpr compounds 60-79 *)
+ | 60 ->
+ let e1 = loop () in
+ let e2 = loop () in
+ TArray (e1,e2),None
+ | 61 ->
+ let e = loop () in
+ TParenthesis e,Some e.etype
+ | 62 ->
+ TArrayDecl (loop_el()),None
+ | 63 ->
+ let fl = self#read_list (fun () ->
+ let name = self#read_string in
+ let p = self#read_pos in
+ let qs = match read_byte ch with
+ | 0 -> NoQuotes
+ | 1 -> DoubleQuotes
+ | _ -> assert false
+ in
+ let e = loop () in
+ ((name,p,qs),e)
+ ) in
+ TObjectDecl fl,None
+ | 65 ->
+ let m = self#read_metadata_entry in
+ let e1 = loop () in
+ TMeta (m,e1),None
+
+ (* calls 70 - 79 *)
+ | 70 ->
+ let e1 = loop () in
+ TCall(e1,[]),None
+ | 71 | 72 | 73 | 74 as i ->
+ let e1 = loop () in
+ let el = List.init (i - 70) (fun _ -> loop ()) in
+ TCall(e1,el),None
+ | 79 ->
+ let e1 = loop () in
+ let el = self#read_list loop in
+ TCall(e1,el),None
+
+ (* branching 80-89 *)
+ | 80 ->
+ let e1 = loop () in
+ let e2 = loop () in
+ TIf(e1,e2,None),(Some api#basic_types.tvoid)
+ | 81 ->
+ let e1 = loop () in
+ let e2 = loop () in
+ let e3 = loop () in
+ TIf(e1,e2,Some e3),None
+ | 82 ->
+ let subject = loop () in
+ let cases = self#read_list (fun () ->
+ let patterns = loop_el() in
+ let ec = loop () in
+ { case_patterns = patterns; case_expr = ec}
+ ) in
+ let def = self#read_option (fun () -> loop ()) in
+ TSwitch {
+ switch_subject = subject;
+ switch_cases = cases;
+ switch_default = def;
+ switch_exhaustive = true;
+ },None
+ | 83 ->
+ let e1 = loop () in
+ let catches = self#read_list (fun () ->
+ let v = declare_local () in
+ let e = loop () in
+ (v,e)
+ ) in
+ TTry(e1,catches),None
+ | 84 ->
+ let e1 = loop () in
+ let e2 = loop () in
+ TWhile(e1,e2,NormalWhile),(Some api#basic_types.tvoid)
+ | 85 ->
+ let e1 = loop () in
+ let e2 = loop () in
+ TWhile(e1,e2,DoWhile),(Some api#basic_types.tvoid)
+ | 86 ->
+ let v = declare_local () in
+ let e1 = loop () in
+ let e2 = loop () in
+ TFor(v,e1,e2),(Some api#basic_types.tvoid)
+
+ (* control flow 90-99 *)
+ | 90 ->
+ TReturn None,None
+ | 91 ->
+ TReturn (Some (loop ())),None
+ | 92 ->
+ TContinue,None
+ | 93 ->
+ TBreak,None
+ | 94 ->
+ TThrow (loop ()),None
+
+ (* access 100-119 *)
+ | 100 ->
+ TEnumIndex (loop ()),(Some api#basic_types.tint)
+ | 101 ->
+ let e1 = loop () in
+ let ef = self#read_enum_field_ref in
+ let i = read_uleb128 ch in
+ TEnumParameter(e1,ef,i),None
+ | 102 ->
+ let e1 = loop () in
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ let cf = self#read_field_ref in
+ TField(e1,FInstance(c,tl,cf)),None
+ | 103 ->
+ let e1 = loop () in
+ let c = self#read_class_ref in
+ let cf = self#read_field_ref in
+ TField(e1,FStatic(c,cf)),None
+ | 104 ->
+ let e1 = loop () in
+ let cf = self#read_anon_field_ref in
+ TField(e1,FAnon(cf)),None
+ | 105 ->
+ let e1 = loop () in
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ let cf = self#read_field_ref in
+ TField(e1,FClosure(Some(c,tl),cf)),None
+ | 106 ->
+ let e1 = loop () in
+ let cf = self#read_anon_field_ref in
+ TField(e1,FClosure(None,cf)),None
+ | 107 ->
+ let e1 = loop () in
+ let en = self#read_enum_ref in
+ let ef = self#read_enum_field_ref in
+ TField(e1,FEnum(en,ef)),None
+ | 108 ->
+ let e1 = loop () in
+ let s = self#read_string in
+ TField(e1,FDynamic s),None
+
+ | 110 ->
+ let p = read_relpos () in
+ let c = self#read_class_ref in
+ let cf = self#read_field_ref in
+ let e1 = Texpr.Builder.make_static_this c p in
+ TField(e1,FStatic(c,cf)),None
+ | 111 ->
+ let p = read_relpos () in
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ let cf = self#read_field_ref in
+ let ethis = mk (TConst TThis) (Option.get fctx.tthis) p in
+ TField(ethis,FInstance(c,tl,cf)),None
+
+ (* module types 120-139 *)
+ | 120 ->
+ let c = self#read_class_ref in
+ TTypeExpr (TClassDecl c),(Some c.cl_type)
+ | 121 ->
+ let en = self#read_enum_ref in
+ TTypeExpr (TEnumDecl en),(Some en.e_type)
+ | 122 ->
+ TTypeExpr (TAbstractDecl self#read_abstract_ref),None
+ | 123 ->
+ TTypeExpr (TTypeDecl self#read_typedef_ref),None
+ | 124 ->
+ TCast(loop (),None),None
+ | 125 ->
+ let e1 = loop () in
+ let (pack,mname,tname) = self#read_full_path in
+ let mt = self#resolve_type pack mname tname in
+ TCast(e1,Some mt),None
+ | 126 ->
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ let el = loop_el() in
+ TNew(c,tl,el),None
+ | 127 ->
+ let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
+ let tl = self#read_types in
+ let el = loop_el() in
+ TNew(ttp.ttp_class,tl,el),None
+ | 128 ->
+ let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
+ TTypeExpr (TClassDecl ttp.ttp_class),None
+
+ (* unops 140-159 *)
+ | i when i >= 140 && i < 160 ->
+ let (op,flag) = self#get_unop (i - 140) in
+ let e = loop () in
+ TUnop(op,flag,e),None
+
+ (* binops 160-219 *)
+ | i when i >= 160 && i < 220 ->
+ let op = self#get_binop (i - 160) in
+ let e1 = loop () in
+ let e2 = loop () in
+ TBinop(op,e1,e2),None
+ (* rest 250-254 *)
+ | 250 ->
+ TIdent (self#read_string),None
+
+ | i ->
+ die (Printf.sprintf " [ERROR] Unhandled texpr %d at:" i) __LOC__
+ in
+ let e,t = loop2 () in
+ let t = match t with
+ | None -> fctx.t_pool.(read_uleb128 ch)
+ | Some t -> t
+ in
+ let p = read_relpos () in
+ let e = {
+ eexpr = e;
+ etype = t;
+ epos = p;
+ } in
+ e
+ and loop_el () =
+ self#read_list loop
+ in
+ loop()
+
+ method read_class_field_forward =
+ let name = self#read_string in
+ let pos,name_pos = self#read_pos_pair in
+ let overloads = self#read_list (fun () -> self#read_class_field_forward) in
+ { null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos; cf_overloads = overloads }
+
+ method start_texpr =
+ begin match read_byte ch with
+ | 0 ->
+ ()
+ | 1 ->
+ let a = self#read_type_parameters_forward in
+ local_type_parameters <- a;
+ self#read_type_parameters_data a;
+ | i ->
+ die "" __LOC__
+ end;
+ let tthis = self#read_option (fun () -> self#read_type_instance) in
+ let l = read_uleb128 ch in
+ let ts = Array.init l (fun _ ->
+ self#read_type_instance
+ ) in
+ let l = read_uleb128 ch in
+ let vars = Array.init l (fun _ ->
+ self#read_var
+ ) in
+ create_field_reader_context self#read_pos ts vars tthis
+
+ method read_field_type_parameters =
+ let num_params = read_uleb128 ch in
+ begin match read_byte ch with
+ | 0 ->
+ ()
+ | 1 ->
+ let a = self#read_type_parameters_forward in
+ field_type_parameters <- a;
+ self#read_type_parameters_data a;
+ field_type_parameter_offset <- 0; (* num_params is added below *)
+ | i ->
+ die "" __LOC__
+ end;
+ let params = List.init num_params (fun offset ->
+ field_type_parameters.(field_type_parameter_offset + offset)
+ ) in
+ field_type_parameter_offset <- field_type_parameter_offset + num_params;
+ params
+
+ method read_expression (fctx : field_reader_context) =
+ let e = self#read_texpr fctx in
+ let e_unopt = self#read_option (fun () -> self#read_texpr fctx) in
+ e,e_unopt
+
+ val class_field_infos = ClassFieldInfos.create ()
+
+ method read_class_field_data (cf : tclass_field) : unit =
+ let params = self#read_field_type_parameters in
+
+ let t = self#read_type_instance in
+
+ let flags = read_uleb128 ch in
+
+ let doc = self#read_option (fun () -> self#read_documentation) in
+ cf.cf_meta <- self#read_metadata;
+ let kind = self#read_field_kind in
+
+ let expr,expr_unoptimized = match read_byte ch with
+ | 0 ->
+ None,None
+ | 1 ->
+ let fctx = self#start_texpr in
+ let e,e_unopt = self#read_expression fctx in
+ (Some e,e_unopt)
+ | 2 ->
+ (* store type parameter info for EXD *)
+ let info = ClassFieldInfo.create field_type_parameters in
+ ClassFieldInfos.set class_field_infos info cf;
+ None,None
+ | _ ->
+ die "" __LOC__
+ in
+
+ cf.cf_type <- t;
+ cf.cf_doc <- doc;
+ cf.cf_kind <- kind;
+ cf.cf_expr <- expr;
+ cf.cf_expr_unoptimized <- expr_unoptimized;
+ cf.cf_params <- params;
+ cf.cf_flags <- flags
+
+ method read_class_field_and_overloads_data (cf : tclass_field) =
+ let rec loop depth cfl = match cfl with
+ | cf :: cfl ->
+ assert (depth > 0);
+ self#read_class_field_data cf;
+ loop (depth - 1) cfl
+ | [] ->
+ assert (depth = 0)
+ in
+ loop (read_uleb128 ch) (cf :: cf.cf_overloads);
+
+ method select_class_type_parameters (c: tclass) =
+ match c.cl_kind with
+ | KAbstractImpl a ->
+ type_type_parameters <- Array.of_list a.a_params
+ | _ ->
+ type_type_parameters <- Array.of_list c.cl_params
+
+ method read_class_fields (c : tclass) =
+ self#select_class_type_parameters c;
+ let _ = self#read_option (fun f ->
+ let cf = Option.get c.cl_constructor in
+ self#read_class_field_and_overloads_data cf
+ ) in
+ let _ = self#read_option (fun f ->
+ let cf = Option.get c.cl_init in
+ self#read_class_field_and_overloads_data cf
+ ) in
+ let rec loop ref_kind num cfl = match cfl with
+ | cf :: cfl ->
+ assert (num > 0);
+ self#read_class_field_and_overloads_data cf;
+ loop ref_kind (num - 1) cfl
+ | [] ->
+ assert (num = 0)
+ in
+ loop CfrMember (read_uleb128 ch) c.cl_ordered_fields;
+ loop CfrStatic (read_uleb128 ch) c.cl_ordered_statics;
+ (match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
+
+ method read_enum_fields (e : tenum) =
+ type_type_parameters <- Array.of_list e.e_params;
+ ignore(self#read_list (fun () ->
+ let name = self#read_string in
+ let ef = PMap.find name e.e_constrs in
+ ef.ef_params <- self#read_field_type_parameters;
+ ef.ef_type <- self#read_type_instance;
+ ef.ef_doc <- self#read_option (fun () -> self#read_documentation);
+ ef.ef_meta <- self#read_metadata;
+ ))
+
+ (* Module types *)
+
+ method read_common_module_type (infos : tinfos) =
+ infos.mt_private <- self#read_bool;
+ infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
+ infos.mt_meta <- self#read_metadata;
+ let params = Array.of_list infos.mt_params in
+ type_type_parameters <- params;
+ self#read_type_parameters_data params;
+ infos.mt_params <- Array.to_list type_type_parameters;
+ infos.mt_using <- self#read_list (fun () ->
+ let c = self#read_class_ref in
+ let p = self#read_pos in
+ (c,p)
+ )
+
+ method read_class_kind = match read_byte ch with
+ | 0 -> KNormal
+ | 1 -> die "" __LOC__
+ | 2 -> KExpr self#read_expr
+ | 3 -> KGeneric
+ | 4 ->
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ KGenericInstance(c,tl)
+ | 5 -> KMacroType
+ | 6 -> KGenericBuild (self#read_list (fun () -> self#read_cfield))
+ | 7 -> KAbstractImpl self#read_abstract_ref
+ | 8 -> KModuleFields current_module
+ | i ->
+ error (Printf.sprintf "Invalid class kind id: %i" i)
+
+ method read_class (c : tclass) =
+ self#read_common_module_type (Obj.magic c);
+ c.cl_kind <- self#read_class_kind;
+ let read_relation () =
+ let c = self#read_class_ref in
+ let tl = self#read_types in
+ (c,tl)
+ in
+ c.cl_super <- self#read_option read_relation;
+ c.cl_implements <- self#read_list read_relation;
+ c.cl_dynamic <- self#read_option (fun () -> self#read_type_instance);
+ c.cl_array_access <- self#read_option (fun () -> self#read_type_instance);
+
+ method read_abstract (a : tabstract) =
+ self#read_common_module_type (Obj.magic a);
+ a.a_impl <- self#read_option (fun () -> self#read_class_ref);
+ begin match read_byte ch with
+ | 0 ->
+ a.a_this <- TAbstract(a,extract_param_types a.a_params)
+ | _ ->
+ a.a_this <- self#read_type_instance;
+ end;
+ a.a_from <- self#read_list (fun () -> self#read_type_instance);
+ a.a_to <- self#read_list (fun () -> self#read_type_instance);
+ a.a_enum <- self#read_bool;
+
+ method read_abstract_fields (a : tabstract) =
+ a.a_array <- self#read_list (fun () -> self#read_field_ref);
+ a.a_read <- self#read_option (fun () -> self#read_field_ref);
+ a.a_write <- self#read_option (fun () -> self#read_field_ref);
+ a.a_call <- self#read_option (fun () -> self#read_field_ref);
+
+ a.a_ops <- self#read_list (fun () ->
+ let i = read_byte ch in
+ let op = self#get_binop i in
+ let cf = self#read_field_ref in
+ (op, cf)
+ );
+
+ a.a_unops <- self#read_list (fun () ->
+ let i = read_byte ch in
+ let (op, flag) = self#get_unop i in
+ let cf = self#read_field_ref in
+ (op, flag, cf)
+ );
+
+ a.a_from_field <- self#read_list (fun () ->
+ let cf = self#read_field_ref in
+ let t = match cf.cf_type with
+ | TFun((_,_,t) :: _, _) -> t
+ | _ -> die "" __LOC__
+ in
+ (t,cf)
+ );
+
+ a.a_to_field <- self#read_list (fun () ->
+ let cf = self#read_field_ref in
+ let t = match cf.cf_type with
+ | TFun(_, t) -> t
+ | _ -> die "" __LOC__
+ in
+ (t,cf)
+ );
+
+ method read_enum (e : tenum) =
+ self#read_common_module_type (Obj.magic e);
+ e.e_extern <- self#read_bool;
+ e.e_names <- self#read_list (fun () -> self#read_string);
+
+ method read_typedef (td : tdef) =
+ self#read_common_module_type (Obj.magic td);
+ let t = self#read_type_instance in
+ match td.t_type with
+ | TMono r ->
+ (match r.tm_type with
+ | None -> Monomorph.bind r t;
+ | Some t' -> die (Printf.sprintf "typedef %s is already initialized to %s, but new init to %s was attempted" (s_type_path td.t_path) (s_type_kind t') (s_type_kind t)) __LOC__)
+ | _ ->
+ die "" __LOC__
+
+ (* Chunks *)
+
+ method read_string_pool =
+ let l = read_uleb128 ch in
+ Array.init l (fun i ->
+ self#read_raw_string;
+ );
+
+ method read_efr =
+ let l = read_uleb128 ch in
+ let a = Array.init l (fun i ->
+ let en = self#read_enum_ref in
+ let name = self#read_string in
+ PMap.find name en.e_constrs
+ ) in
+ enum_fields <- a
+
+ method read_afr =
+ let l = read_uleb128 ch in
+ let a = Array.init l (fun _ -> self#read_class_field_forward) in
+ anon_fields <- a
+
+ method read_cfr =
+ let l = read_uleb128 ch in
+ let a = Array.init l (fun i ->
+ let c = self#read_class_ref in
+ let kind = match read_byte ch with
+ | 0 -> CfrStatic
+ | 1 -> CfrMember
+ | 2 -> CfrConstructor
+ | 3 -> CfrInit
+ | _ -> die "" __LOC__
+ in
+ let cf = match kind with
+ | CfrStatic ->
+ let name = self#read_string in
+ begin try
+ PMap.find name c.cl_statics
+ with Not_found ->
+ raise (HxbFailure (Printf.sprintf "Could not read static field %s on %s while hxbing %s" name (s_type_path c.cl_path) (s_type_path current_module.m_path)))
+ end;
+ | CfrMember ->
+ let name = self#read_string in
+ begin try
+ PMap.find name c.cl_fields
+ with Not_found ->
+ raise (HxbFailure (Printf.sprintf "Could not read instance field %s on %s while hxbing %s" name (s_type_path c.cl_path) (s_type_path current_module.m_path)))
+ end
+ | CfrConstructor ->
+ Option.get c.cl_constructor
+ | CfrInit ->
+ Option.get c.cl_init
+ in
+ let pick_overload cf depth =
+ let rec loop depth cfl = match cfl with
+ | cf :: cfl ->
+ if depth = 0 then
+ cf
+ else
+ loop (depth - 1) cfl
+ | [] ->
+ raise (HxbFailure (Printf.sprintf "Bad overload depth for %s on %s: %i" cf.cf_name (s_type_path c.cl_path) depth))
+ in
+ let cfl = cf :: cf.cf_overloads in
+ loop depth cfl
+ in
+ let depth = read_uleb128 ch in
+ if depth = 0 then
+ cf
+ else
+ pick_overload cf depth;
+ ) in
+ class_fields <- a
+
+ method read_cfd =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let c = classes.(i) in
+ self#read_class_fields c;
+ done
+
+ method read_exd =
+ ignore(self#read_list (fun () ->
+ let c = self#read_class_ref in
+ self#read_list (fun () ->
+ let cf = self#read_field_ref in
+ let length = read_uleb128 ch in
+ let bytes = read_bytes ch length in
+ let ch_cf = BytesWithPosition.create bytes in
+ let read_expressions () =
+ self#select_class_type_parameters c;
+ field_type_parameters <- (ClassFieldInfos.get class_field_infos cf).type_parameters;
+ ClassFieldInfos.unset class_field_infos cf;
+ field_type_parameter_offset <- 0;
+ let old = ch in
+ ch <- ch_cf;
+ let fctx = self#start_texpr in
+ let e,e_unopt = self#read_expression fctx in
+ ch <- old;
+ cf.cf_expr <- Some e;
+ cf.cf_expr_unoptimized <- e_unopt;
+ in
+ if api#read_expression_eagerly cf then
+ read_expressions ()
+ else begin
+ let t = cf.cf_type in
+ let r = ref (lazy_available t) in
+ r := lazy_wait (fun() ->
+ cf.cf_type <- t;
+ r := lazy_available t;
+ read_expressions ();
+ t
+ );
+ cf.cf_type <- TLazy r
+ end
+ )
+ ))
+
+ method read_afd =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let a = abstracts.(i) in
+ self#read_abstract_fields a;
+ done
+
+ method read_cld =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let c = classes.(i) in
+ self#read_class c;
+ done
+
+ method read_abd =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let a = abstracts.(i) in
+ self#read_abstract a;
+ done
+
+ method read_end =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let en = enums.(i) in
+ self#read_enum en;
+ done
+
+ method read_efd =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let e = enums.(i) in
+ self#read_enum_fields e;
+ Type.unify (TType(enum_module_type e,[])) e.e_type
+ done
+
+ method read_anon an =
+ let read_fields () =
+ let rec loop acc i =
+ if i = 0 then
+ acc
+ else begin
+ let cf = self#read_anon_field_ref in
+ loop (PMap.add cf.cf_name cf acc) (i - 1)
+ end
+ in
+ an.a_fields <- loop PMap.empty (read_uleb128 ch)
+ in
+
+ begin match read_byte ch with
+ | 0 ->
+ an.a_status := Closed;
+ read_fields ()
+ | 1 ->
+ an.a_status := Const;
+ read_fields ()
+ | 2 ->
+ an.a_status := Extend self#read_types;
+ read_fields ()
+ | _ -> assert false
+ end;
+
+ an
+
+ method read_tdd =
+ let l = read_uleb128 ch in
+ for i = 0 to l - 1 do
+ let t = typedefs.(i) in
+ self#read_typedef t;
+ done
+
+ method read_clr =
+ let l = read_uleb128 ch in
+ classes <- (Array.init l (fun i ->
+ let (pack,mname,tname) = self#read_full_path in
+ match self#resolve_type pack mname tname with
+ | TClassDecl c ->
+ c
+ | _ ->
+ error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname)))
+ ))
+
+ method read_abr =
+ let l = read_uleb128 ch in
+ abstracts <- (Array.init l (fun i ->
+ let (pack,mname,tname) = self#read_full_path in
+ match self#resolve_type pack mname tname with
+ | TAbstractDecl a ->
+ a
+ | _ ->
+ error ("Unexpected type where abstract was expected: " ^ (s_type_path (pack,tname)))
+ ))
+
+ method read_enr =
+ let l = read_uleb128 ch in
+ enums <- (Array.init l (fun i ->
+ let (pack,mname,tname) = self#read_full_path in
+ match self#resolve_type pack mname tname with
+ | TEnumDecl en ->
+ en
+ | _ ->
+ error ("Unexpected type where enum was expected: " ^ (s_type_path (pack,tname)))
+ ))
+
+ method read_tdr =
+ let l = read_uleb128 ch in
+ typedefs <- (Array.init l (fun i ->
+ let (pack,mname,tname) = self#read_full_path in
+ match self#resolve_type pack mname tname with
+ | TTypeDecl tpd ->
+ tpd
+ | _ ->
+ error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname)))
+ ))
+
+ method read_mdr =
+ let length = read_uleb128 ch in
+ for _ = 0 to length - 1 do
+ let path = self#read_path in
+ ignore(api#resolve_module path)
+ done
+
+ method read_mtf =
+ self#read_list (fun () ->
+ let kind = read_byte ch in
+ let path = self#read_path in
+ let pos,name_pos = self#read_pos_pair in
+ let params = self#read_type_parameters_forward in
+ let mt = match kind with
+ | 0 ->
+ let c = mk_class current_module path pos name_pos in
+ c.cl_params <- Array.to_list params;
+ c.cl_flags <- read_uleb128 ch;
+
+ let read_field () =
+ self#read_class_field_forward;
+ in
+
+ c.cl_constructor <- self#read_option read_field;
+ c.cl_init <- self#read_option read_field;
+ let read_fields i =
+ let rec loop acc_l acc_pm i =
+ if i = 0 then
+ acc_l,acc_pm
+ else begin
+ let cf = self#read_class_field_forward in
+ loop (cf :: acc_l) (PMap.add cf.cf_name cf acc_pm) (i - 1)
+ end
+ in
+ loop [] PMap.empty i
+ in
+ let num_fields = read_uleb128 ch in
+ let num_statics = read_uleb128 ch in
+ let l,pm = read_fields num_fields in
+ c.cl_ordered_fields <- l;
+ c.cl_fields <- pm;
+ let l,pm = read_fields num_statics in
+ c.cl_ordered_statics <- l;
+ c.cl_statics <- pm;
+
+ TClassDecl c
+ | 1 ->
+ let en = mk_enum current_module path pos name_pos in
+ en.e_params <- Array.to_list params;
+
+ let read_field () =
+ let name = self#read_string in
+ let pos,name_pos = self#read_pos_pair in
+ let index = read_byte ch in
+
+ { null_enum_field with
+ ef_name = name;
+ ef_pos = pos;
+ ef_name_pos = name_pos;
+ ef_index = index;
+ }
+ in
+ let rec loop acc i =
+ if i = 0 then
+ acc
+ else begin
+ let ef = read_field () in
+ loop (PMap.add ef.ef_name ef acc) (i - 1)
+ end
+ in
+ en.e_constrs <- loop PMap.empty (read_uleb128 ch);
+ TEnumDecl en
+ | 2 ->
+ let td = mk_typedef current_module path pos name_pos (mk_mono()) in
+ td.t_params <- Array.to_list params;
+ typedefs <- Array.append typedefs (Array.make 1 td);
+ TTypeDecl td
+ | 3 ->
+ let a = mk_abstract current_module path pos name_pos in
+ a.a_params <- Array.to_list params;
+ abstracts <- Array.append abstracts (Array.make 1 a);
+ TAbstractDecl a
+ | _ ->
+ error ("Invalid type kind: " ^ (string_of_int kind));
+ in
+ mt
+ )
+
+ method read_mdf =
+ let path = self#read_path in
+ let file = self#read_string in
+
+ let l = read_uleb128 ch in
+ anons <- Array.init l (fun _ -> { a_fields = PMap.empty; a_status = ref Closed });
+ tmonos <- Array.init (read_uleb128 ch) (fun _ -> mk_mono());
+ api#make_module path file
+
+ method private read_chunk_prefix =
+ let name = Bytes.unsafe_to_string (read_bytes ch 3) in
+ let size = Int32.to_int self#read_i32 in
+ (name,size)
+
+ method private read_chunk_data' (kind : chunk_kind) =
+ match kind with
+ | STR ->
+ string_pool <- self#read_string_pool;
+ | DOC ->
+ doc_pool <- self#read_string_pool;
+ | MDF ->
+ current_module <- self#read_mdf;
+ | MTF ->
+ current_module.m_types <- self#read_mtf;
+ api#add_module current_module;
+ | MDR ->
+ self#read_mdr;
+ | CLR ->
+ self#read_clr;
+ | ENR ->
+ self#read_enr;
+ | ABR ->
+ self#read_abr;
+ | TDR ->
+ self#read_tdr;
+ | AFR ->
+ self#read_afr;
+ | CLD ->
+ self#read_cld;
+ | END ->
+ self#read_end;
+ | ABD ->
+ self#read_abd;
+ | TDD ->
+ self#read_tdd;
+ | EOT ->
+ ()
+ | EFR ->
+ self#read_efr;
+ | CFR ->
+ self#read_cfr;
+ | CFD ->
+ self#read_cfd;
+ | EFD ->
+ self#read_efd;
+ | AFD ->
+ self#read_afd;
+ | EOF ->
+ ()
+ | EXD ->
+ self#read_exd;
+ | EOM ->
+ incr stats.modules_fully_restored;
+
+ method private read_chunk_data kind =
+ let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in
+ let id = ["hxb";"read";string_of_chunk_kind kind;path] in
+ let close = Timer.timer id in
+ self#read_chunk_data' kind;
+ close()
+
+ method read_chunks (new_api : hxb_reader_api) (chunks : cached_chunks) =
+ fst (self#read_chunks_until new_api chunks EOM)
+
+ method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk =
+ api <- new_api;
+ let rec loop = function
+ | (kind,data) :: chunks ->
+ ch <- BytesWithPosition.create data;
+ self#read_chunk_data kind;
+ if kind = end_chunk then chunks else loop chunks
+ | [] -> die "" __LOC__
+ in
+ let remaining = loop chunks in
+ (current_module, remaining)
+
+ method read (new_api : hxb_reader_api) (bytes : bytes) =
+ api <- new_api;
+ ch <- BytesWithPosition.create bytes;
+ if (Bytes.to_string (read_bytes ch 3)) <> "hxb" then
+ raise (HxbFailure "magic");
+ let version = read_byte ch in
+ if version <> hxb_version then
+ raise (HxbFailure (Printf.sprintf "version mismatch: hxb version %i, reader version %i" version hxb_version));
+ (fun end_chunk ->
+ let rec loop () =
+ let (name,size) = self#read_chunk_prefix in
+ let kind = chunk_kind_of_string name in
+ self#read_chunk_data kind;
+ if kind <> end_chunk then begin
+ loop()
+ end
+ in
+ loop();
+ current_module
+ )
+end
diff --git a/src/compiler/hxb/hxbReaderApi.ml b/src/compiler/hxb/hxbReaderApi.ml
new file mode 100644
index 00000000000..98fa6d8e943
--- /dev/null
+++ b/src/compiler/hxb/hxbReaderApi.ml
@@ -0,0 +1,12 @@
+open Globals
+open Type
+
+class virtual hxb_reader_api = object(self)
+ method virtual make_module : path -> string -> module_def
+ method virtual add_module : module_def -> unit
+ method virtual resolve_type : string list -> string -> string -> module_type
+ method virtual resolve_module : path -> module_def
+ method virtual basic_types : basic_types
+ method virtual get_var_id : int -> int
+ method virtual read_expression_eagerly : tclass_field -> bool
+end
diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml
new file mode 100644
index 00000000000..cc2d1c1065c
--- /dev/null
+++ b/src/compiler/hxb/hxbWriter.ml
@@ -0,0 +1,2264 @@
+open Globals
+open Ast
+open Type
+open HxbData
+open Tanon_identification
+
+let rec binop_index op = match op with
+ | OpAdd -> 0
+ | OpMult -> 1
+ | OpDiv -> 2
+ | OpSub -> 3
+ | OpAssign -> 4
+ | OpEq -> 5
+ | OpNotEq -> 6
+ | OpGt -> 7
+ | OpGte -> 8
+ | OpLt -> 9
+ | OpLte -> 10
+ | OpAnd -> 11
+ | OpOr -> 12
+ | OpXor -> 13
+ | OpBoolAnd -> 14
+ | OpBoolOr -> 15
+ | OpShl -> 16
+ | OpShr -> 17
+ | OpUShr -> 18
+ | OpMod -> 19
+ | OpInterval -> 20
+ | OpArrow -> 21
+ | OpIn -> 22
+ | OpNullCoal -> 23
+ | OpAssignOp op -> 30 + binop_index op
+
+let unop_index op flag = match op,flag with
+ | Increment,Prefix -> 0
+ | Decrement,Prefix -> 1
+ | Not,Prefix -> 2
+ | Neg,Prefix -> 3
+ | NegBits,Prefix -> 4
+ | Spread,Prefix -> 5
+ | Increment,Postfix -> 6
+ | Decrement,Postfix -> 7
+ | Not,Postfix -> 8
+ | Neg,Postfix -> 9
+ | NegBits,Postfix -> 10
+ | Spread,Postfix -> 11
+
+module StringHashtbl = Hashtbl.Make(struct
+ type t = string
+
+ let equal =
+ String.equal
+
+ let hash s =
+ (* What's the best here? *)
+ Hashtbl.hash s
+end)
+
+module StringPool = struct
+ type t = {
+ lut : int StringHashtbl.t;
+ items : string DynArray.t;
+ mutable closed : bool;
+ }
+
+ let create () = {
+ lut = StringHashtbl.create 16;
+ items = DynArray.create ();
+ closed = false;
+ }
+
+ let add sp s =
+ assert (not sp.closed);
+ let index = DynArray.length sp.items in
+ StringHashtbl.add sp.lut s index;
+ DynArray.add sp.items s;
+ index
+
+ let get sp s =
+ StringHashtbl.find sp.lut s
+
+ let get_or_add sp s =
+ try
+ get sp s
+ with Not_found ->
+ add sp s
+
+ let finalize sp =
+ assert (not sp.closed);
+ sp.closed <- true;
+ DynArray.to_list sp.items,DynArray.length sp.items
+end
+
+module Pool = struct
+ type ('key,'value) t = {
+ lut : ('key,int) Hashtbl.t;
+ items : 'value DynArray.t;
+ mutable closed : bool;
+ }
+
+ let create () = {
+ lut = Hashtbl.create 0;
+ items = DynArray.create ();
+ closed = false;
+ }
+
+ let add pool (key : 'key) (value : 'value) =
+ assert (not pool.closed);
+ let index = DynArray.length pool.items in
+ DynArray.add pool.items value;
+ Hashtbl.add pool.lut key index;
+ index
+
+ let get pool (key : 'key) =
+ Hashtbl.find pool.lut key
+
+ let extract pool (key : 'key) =
+ DynArray.get pool.items (get pool key)
+
+ let has pool (key : 'key) =
+ Hashtbl.mem pool.lut key
+
+ let get_or_add pool (key : 'key) (value : 'value) =
+ try
+ get pool key
+ with Not_found ->
+ add pool key value
+
+ let is_empty pool =
+ DynArray.length pool.items = 0
+
+ let advance pool dummy =
+ DynArray.add pool.items dummy
+
+ let finalize pool =
+ assert (not pool.closed);
+ pool.closed <- true;
+ pool.items
+end
+
+module IdentityPool = struct
+ type ('key,'value) t = {
+ items : ('key * 'value) DynArray.t;
+ mutable closed : bool;
+ }
+
+ let create () = {
+ items = DynArray.create ();
+ closed = false;
+ }
+
+ let add pool (key : 'key) (value : 'value) =
+ assert (not pool.closed);
+ let index = DynArray.length pool.items in
+ DynArray.add pool.items (key,value);
+ index
+
+ let get pool (key : 'key) =
+ DynArray.index_of (fun (key',_) -> key == key') pool.items
+
+ let get_or_add pool (key : 'key) (value : 'value) =
+ try
+ get pool key
+ with Not_found ->
+ add pool key value
+
+ let to_list pool =
+ DynArray.to_list pool.items
+
+ let finalize pool =
+ assert (not pool.closed);
+ pool.closed <- true;
+ pool.items
+
+ let length pool = DynArray.length pool.items
+end
+
+module HashedIdentityPool = struct
+ type ('hkey,'key,'value) t = {
+ lut : ('hkey,('key * int)) Hashtbl.t;
+ items : ('key * 'value) DynArray.t;
+ mutable closed : bool;
+ }
+
+ let create () = {
+ lut = Hashtbl.create 16;
+ items = DynArray.create ();
+ closed = false;
+ }
+
+ let add pool (hkey : 'hkey) (key : 'key) (value : 'value) =
+ assert (not pool.closed);
+ let index = DynArray.length pool.items in
+ DynArray.add pool.items (key,value);
+ Hashtbl.add pool.lut hkey (key,index);
+ index
+
+ let get pool (hkey : 'hkey) (key : 'key) =
+ let l = Hashtbl.find_all pool.lut hkey in
+ List.assq key l
+
+ let finalize pool =
+ assert (not pool.closed);
+ pool.closed <- true;
+ pool.items
+end
+
+module SimnBuffer = struct
+ type t = {
+ buffer_size : int;
+ mutable buffer : bytes;
+ mutable buffers : bytes Queue.t;
+ mutable offset : int;
+ }
+
+ let create buffer_size = {
+ buffer = Bytes.create buffer_size;
+ buffers = Queue.create ();
+ offset = 0;
+ buffer_size = buffer_size;
+ }
+
+ let reset sb =
+ sb.buffer <- Bytes.create sb.buffer_size;
+ sb.buffers <- Queue.create ();
+ sb.offset <- 0
+
+ let promote_buffer sb =
+ Queue.add sb.buffer sb.buffers;
+ sb.buffer <- Bytes.create sb.buffer_size;
+ sb.offset <- 0
+
+ let add_u8 sb i =
+ if sb.offset = sb.buffer_size then begin
+ (* Current buffer is full, promote it. *)
+ promote_buffer sb;
+ Bytes.unsafe_set sb.buffer 0 i;
+ sb.offset <- 1;
+ end else begin
+ (* There's room, put it in. *)
+ Bytes.unsafe_set sb.buffer sb.offset i;
+ sb.offset <- sb.offset + 1
+ end
+
+ let add_bytes sb bytes =
+ let rec loop offset left =
+ let space = sb.buffer_size - sb.offset in
+ if left > space then begin
+ (* We need more than we have. Blit as much as we can, promote buffer, recurse. *)
+ Bytes.unsafe_blit bytes offset sb.buffer sb.offset space;
+ promote_buffer sb;
+ loop (offset + space) (left - space)
+ end else begin
+ (* It fits, blit it. *)
+ Bytes.unsafe_blit bytes offset sb.buffer sb.offset left;
+ sb.offset <- sb.offset + left;
+ end
+ in
+ loop 0 (Bytes.length bytes)
+
+ let contents sb =
+ let size = sb.offset + sb.buffer_size * Queue.length sb.buffers in
+ let out = Bytes.create size in
+ let offset = ref 0 in
+ (* We know that all sb.buffers are of sb.buffer_size length, so blit them together. *)
+ Queue.iter (fun bytes ->
+ Bytes.unsafe_blit bytes 0 out !offset sb.buffer_size;
+ offset := !offset + sb.buffer_size;
+ ) sb.buffers;
+ (* Append our current buffer until sb.offset *)
+ Bytes.unsafe_blit sb.buffer 0 out !offset sb.offset;
+ out
+end
+
+module Chunk = struct
+ type t = {
+ kind : chunk_kind;
+ cp : StringPool.t;
+ ch : SimnBuffer.t;
+ }
+
+ let create kind cp initial_size = {
+ kind;
+ cp;
+ ch = SimnBuffer.create initial_size;
+ }
+
+ let reset chunk =
+ SimnBuffer.reset chunk.ch
+
+ let write_u8 io v =
+ SimnBuffer.add_u8 io.ch (Char.unsafe_chr v)
+
+ let write_i32 io v =
+ let base = Int32.to_int v in
+ let big = Int32.to_int (Int32.shift_right_logical v 24) in
+ write_u8 io base;
+ write_u8 io (base lsr 8);
+ write_u8 io (base lsr 16);
+ write_u8 io big
+
+ let write_i64 io v =
+ write_i32 io (Int64.to_int32 v);
+ write_i32 io (Int64.to_int32 (Int64.shift_right_logical v 32))
+
+ let write_f64 io v =
+ write_i64 io (Int64.bits_of_float v)
+
+ let write_bytes io b =
+ SimnBuffer.add_bytes io.ch b
+
+ let write_ui16 io i =
+ write_u8 io i;
+ write_u8 io (i lsr 8)
+
+ let get_bytes io =
+ SimnBuffer.contents io.ch
+
+ let rec write_uleb128 io v =
+ let b = v land 0x7F in
+ let rest = v lsr 7 in
+ if rest = 0 then
+ write_u8 io b
+ else begin
+ write_u8 io (b lor 0x80);
+ write_uleb128 io rest
+ end
+
+ let rec write_leb128 io v =
+ let b = v land 0x7F in
+ let rest = v asr 7 in
+ if (rest = 0 && (b land 0x40 = 0)) || (rest = -1 && (b land 0x40 = 0x40)) then
+ write_u8 io b
+ else begin
+ write_u8 io (b lor 0x80);
+ write_leb128 io rest
+ end
+
+ let write_bytes_length_prefixed io b =
+ write_uleb128 io (Bytes.length b);
+ write_bytes io b
+
+ let write_bool io b =
+ write_u8 io (if b then 1 else 0)
+
+ let export : 'a . t -> 'a IO.output -> unit = fun io chex ->
+ let bytes = get_bytes io in
+ let length = Bytes.length bytes in
+ write_chunk_prefix io.kind length chex;
+ IO.nwrite chex bytes
+
+ let write_string chunk s =
+ write_uleb128 chunk (StringPool.get_or_add chunk.cp s)
+
+ let write_list : 'b . t -> 'b list -> ('b -> unit) -> unit = fun chunk l f ->
+ write_uleb128 chunk (List.length l);
+ List.iter f l
+
+ let write_dynarray chunk d f =
+ write_uleb128 chunk (DynArray.length d);
+ DynArray.iter f d
+
+ let write_option : 'b . t -> 'b option -> ('b -> unit) -> unit = fun chunk v f -> match v with
+ | None ->
+ write_u8 chunk 0
+ | Some v ->
+ write_u8 chunk 1;
+ f v
+
+ let export_data chunk_from chunk_to =
+ let bytes = get_bytes chunk_from in
+ write_bytes chunk_to bytes
+end
+
+module PosWriter = struct
+ type t = {
+ mutable p_file : string;
+ mutable p_min : int;
+ mutable p_max : int;
+ }
+
+ let do_write_pos (chunk : Chunk.t) (p : pos) =
+ Chunk.write_string chunk p.pfile;
+ Chunk.write_leb128 chunk p.pmin;
+ Chunk.write_leb128 chunk p.pmax
+
+ let create chunk p =
+ do_write_pos chunk p;
+ {
+ p_file = p.pfile;
+ p_min = p.pmin;
+ p_max = p.pmax;
+ }
+
+ let write_pos pw (chunk : Chunk.t) (write_equal : bool) (offset : int) (p : pos) =
+ if p.pfile != pw.p_file then begin
+ (* File changed, write full pos *)
+ Chunk.write_u8 chunk (4 + offset);
+ do_write_pos chunk p;
+ pw.p_file <- p.pfile;
+ pw.p_min <- p.pmin;
+ pw.p_max <- p.pmax;
+ end else if p.pmin <> pw.p_min then begin
+ if p.pmax <> pw.p_max then begin
+ (* pmin and pmax changed *)
+ Chunk.write_u8 chunk (3 + offset);
+ Chunk.write_leb128 chunk p.pmin;
+ Chunk.write_leb128 chunk p.pmax;
+ pw.p_min <- p.pmin;
+ pw.p_max <- p.pmax;
+ end else begin
+ (* pmin changed *)
+ Chunk.write_u8 chunk (1 + offset);
+ Chunk.write_leb128 chunk p.pmin;
+ pw.p_min <- p.pmin;
+ end
+ end else if p.pmax <> pw.p_max then begin
+ (* pmax changed *)
+ Chunk.write_u8 chunk (2 + offset);
+ Chunk.write_leb128 chunk p.pmax;
+ pw.p_max <- p.pmax;
+ end else begin
+ if write_equal then
+ Chunk.write_u8 chunk offset;
+ end
+end
+
+type field_writer_context = {
+ t_pool : StringPool.t;
+ pos_writer : PosWriter.t;
+ mutable texpr_this : texpr option;
+ vars : (tvar * int) DynArray.t;
+}
+
+let create_field_writer_context pos_writer = {
+ t_pool = StringPool.create ();
+ pos_writer = pos_writer;
+ texpr_this = None;
+ vars = DynArray.create ();
+}
+
+type hxb_writer = {
+ config : HxbWriterConfig.writer_target_config;
+ warn : Warning.warning -> string -> Globals.pos -> unit;
+ anon_id : Type.t Tanon_identification.tanon_identification;
+ mutable current_module : module_def;
+ chunks : Chunk.t DynArray.t;
+ cp : StringPool.t;
+ docs : StringPool.t;
+ mutable chunk : Chunk.t;
+
+ classes : (path,tclass) Pool.t;
+ enums : (path,tenum) Pool.t;
+ typedefs : (path,tdef) Pool.t;
+ abstracts : (path,tabstract) Pool.t;
+ anons : (path,tanon) Pool.t;
+ anon_fields : (string,tclass_field,unit) HashedIdentityPool.t;
+ tmonos : (tmono,unit) IdentityPool.t;
+
+ own_classes : (path,tclass) Pool.t;
+ own_enums : (path,tenum) Pool.t;
+ own_typedefs : (path,tdef) Pool.t;
+ own_abstracts : (path,tabstract) Pool.t;
+ type_param_lut : (path,(string,typed_type_param) Pool.t) Pool.t;
+ class_fields : (string,tclass_field,(tclass * class_field_ref_kind * int)) HashedIdentityPool.t;
+ enum_fields : ((path * string),(tenum * tenum_field)) Pool.t;
+ mutable type_type_parameters : (string,typed_type_param) Pool.t;
+ mutable field_type_parameters : (typed_type_param,unit) IdentityPool.t;
+ mutable local_type_parameters : (typed_type_param,unit) IdentityPool.t;
+ mutable field_stack : unit list;
+ unbound_ttp : (typed_type_param,unit) IdentityPool.t;
+ t_instance_chunk : Chunk.t;
+}
+
+module HxbWriter = struct
+ let in_nested_scope writer = match writer.field_stack with
+ | [] -> false (* can happen for cl_init and in EXD *)
+ | [_] -> false
+ | _ -> true
+
+ (* Chunks *)
+
+ let start_chunk writer (kind : chunk_kind) =
+ let initial_size = match kind with
+ | EOT | EOF | EOM -> 0
+ | MDF -> 16
+ | MTF | MDR | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64
+ | AFR | CLD | TDD | EFD -> 128
+ | STR | DOC -> 256
+ | CFD | EXD -> 512
+ in
+ let new_chunk = Chunk.create kind writer.cp initial_size in
+ DynArray.add writer.chunks new_chunk;
+ writer.chunk <- new_chunk
+
+ let start_temporary_chunk : 'a . hxb_writer -> int -> (Chunk.t -> 'a) -> 'a = fun writer initial_size ->
+ let new_chunk = Chunk.create EOM (* TODO: something else? *) writer.cp initial_size in
+ let old_chunk = writer.chunk in
+ writer.chunk <- new_chunk;
+ (fun f ->
+ writer.chunk <- old_chunk;
+ f new_chunk
+ )
+
+ let write_inlined_list : 'a . hxb_writer -> int -> int -> (int -> unit) -> (unit -> unit) -> ('a -> unit) -> 'a list -> unit
+ = fun writer offset max f_byte f_first f_elt l ->
+ let length = List.length l in
+ if length > max then begin
+ f_byte (offset + 9);
+ f_first ();
+ Chunk.write_list writer.chunk l f_elt
+ end else begin
+ f_byte (offset + length);
+ f_first();
+ List.iter (fun elt ->
+ f_elt elt
+ ) l
+ end
+
+ (* Basic compounds *)
+
+ let write_path writer (path : path) =
+ Chunk.write_list writer.chunk (fst path) (Chunk.write_string writer.chunk);
+ Chunk.write_string writer.chunk (snd path)
+
+ let write_full_path writer (pack : string list) (mname : string) (tname : string) =
+ Chunk.write_list writer.chunk pack (Chunk.write_string writer.chunk);
+ if mname = "" || tname = "" then
+ die (Printf.sprintf "write_full_path: pack = %s, mname = %s, tname = %s" (String.concat "." pack) mname tname) __LOC__;
+ Chunk.write_string writer.chunk mname;
+ Chunk.write_string writer.chunk tname
+
+ let maybe_write_documentation writer (doc : doc_block option) =
+ match doc with
+ | Some doc when writer.config.generate_docs ->
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_option writer.chunk doc.doc_own (fun s ->
+ Chunk.write_uleb128 writer.chunk (StringPool.get_or_add writer.docs s)
+ );
+ Chunk.write_list writer.chunk doc.doc_inherited (fun s ->
+ Chunk.write_uleb128 writer.chunk (StringPool.get_or_add writer.docs s)
+ )
+ | _ ->
+ Chunk.write_u8 writer.chunk 0
+
+ let write_pos writer (p : pos) =
+ Chunk.write_string writer.chunk p.pfile;
+ Chunk.write_leb128 writer.chunk p.pmin;
+ Chunk.write_leb128 writer.chunk p.pmax
+
+ let write_pos_pair writer (p1 : pos) (p2 : pos) =
+ (* Write second position offset relative to first position's pmin, which is often within 1 byte range. *)
+ Chunk.write_string writer.chunk p1.pfile;
+ Chunk.write_leb128 writer.chunk p1.pmin;
+ Chunk.write_leb128 writer.chunk p1.pmax;
+ Chunk.write_leb128 writer.chunk (p2.pmin - p1.pmin);
+ Chunk.write_leb128 writer.chunk (p2.pmax - p1.pmin)
+
+ let rec write_metadata_entry writer ((meta,el,p) : metadata_entry) =
+ Chunk.write_string writer.chunk (Meta.to_string meta);
+ write_pos writer p;
+ Chunk.write_list writer.chunk el (write_expr writer)
+
+ and write_metadata writer ml =
+ Chunk.write_list writer.chunk ml (write_metadata_entry writer)
+
+ (* expr *)
+
+ and write_object_field_key writer (n,p,qs) =
+ Chunk.write_string writer.chunk n;
+ write_pos writer p;
+ begin match qs with
+ | NoQuotes -> Chunk.write_u8 writer.chunk 0
+ | DoubleQuotes -> Chunk.write_u8 writer.chunk 1
+ end
+
+ and write_type_path writer tp =
+ Chunk.write_list writer.chunk tp.tpackage (Chunk.write_string writer.chunk);
+ Chunk.write_string writer.chunk tp.tname;
+ Chunk.write_list writer.chunk tp.tparams (write_type_param_or_const writer);
+ Chunk.write_option writer.chunk tp.tsub (Chunk.write_string writer.chunk)
+
+ and write_placed_type_path writer ptp =
+ write_type_path writer ptp.path;
+ write_pos_pair writer ptp.pos_full ptp.pos_path
+
+ and write_type_param_or_const writer = function
+ | TPType th ->
+ Chunk.write_u8 writer.chunk 0;
+ write_type_hint writer th
+ | TPExpr e ->
+ Chunk.write_u8 writer.chunk 1;
+ write_expr writer e
+
+ and write_complex_type writer = function
+ | CTPath tp ->
+ Chunk.write_u8 writer.chunk 0;
+ write_placed_type_path writer tp
+ | CTFunction(thl,th) ->
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_list writer.chunk thl (write_type_hint writer);
+ write_type_hint writer th
+ | CTAnonymous cffl ->
+ Chunk.write_u8 writer.chunk 2;
+ Chunk.write_list writer.chunk cffl (write_cfield writer);
+ | CTParent th ->
+ Chunk.write_u8 writer.chunk 3;
+ write_type_hint writer th
+ | CTExtend(ptp,cffl) ->
+ Chunk.write_u8 writer.chunk 4;
+ Chunk.write_list writer.chunk ptp (write_placed_type_path writer);
+ Chunk.write_list writer.chunk cffl (write_cfield writer);
+ | CTOptional th ->
+ Chunk.write_u8 writer.chunk 5;
+ write_type_hint writer th
+ | CTNamed(pn,th) ->
+ Chunk.write_u8 writer.chunk 6;
+ write_placed_name writer pn;
+ write_type_hint writer th
+ | CTIntersection(thl) ->
+ Chunk.write_u8 writer.chunk 7;
+ Chunk.write_list writer.chunk thl (write_type_hint writer)
+
+ and write_type_hint writer (ct,p) =
+ write_complex_type writer ct;
+ write_pos writer p
+
+ and write_type_param writer tp =
+ write_placed_name writer tp.tp_name;
+ Chunk.write_list writer.chunk tp.tp_params (write_type_param writer);
+ Chunk.write_option writer.chunk tp.tp_constraints (write_type_hint writer);
+ Chunk.write_option writer.chunk tp.tp_default (write_type_hint writer);
+ Chunk.write_list writer.chunk tp.tp_meta (write_metadata_entry writer)
+
+ and write_func_arg writer (pn,b,meta,tho,eo) =
+ write_placed_name writer pn;
+ Chunk.write_bool writer.chunk b;
+ write_metadata writer meta;
+ Chunk.write_option writer.chunk tho (write_type_hint writer);
+ Chunk.write_option writer.chunk eo (write_expr writer);
+
+ and write_func writer f =
+ Chunk.write_list writer.chunk f.f_params (write_type_param writer);
+ Chunk.write_list writer.chunk f.f_args (write_func_arg writer);
+ Chunk.write_option writer.chunk f.f_type (write_type_hint writer);
+ Chunk.write_option writer.chunk f.f_expr (write_expr writer)
+
+ and write_placed_name writer (s,p) =
+ Chunk.write_string writer.chunk s;
+ write_pos writer p
+
+ and write_access writer ac =
+ let i = match ac with
+ | APublic -> 0
+ | APrivate -> 1
+ | AStatic -> 2
+ | AOverride -> 3
+ | ADynamic -> 4
+ | AInline -> 5
+ | AMacro -> 6
+ | AFinal -> 7
+ | AExtern -> 8
+ | AAbstract -> 9
+ | AOverload -> 10
+ | AEnum -> 11
+ in
+ Chunk.write_u8 writer.chunk i
+
+ and write_placed_access writer (ac,p) =
+ write_access writer ac;
+ write_pos writer p
+
+ and write_cfield_kind writer = function
+ | FVar(tho,eo) ->
+ Chunk.write_u8 writer.chunk 0;
+ Chunk.write_option writer.chunk tho (write_type_hint writer);
+ Chunk.write_option writer.chunk eo (write_expr writer);
+ | FFun f ->
+ Chunk.write_u8 writer.chunk 1;
+ write_func writer f;
+ | FProp(pn1,pn2,tho,eo) ->
+ Chunk.write_u8 writer.chunk 2;
+ write_placed_name writer pn1;
+ write_placed_name writer pn2;
+ Chunk.write_option writer.chunk tho (write_type_hint writer);
+ Chunk.write_option writer.chunk eo (write_expr writer)
+
+ and write_cfield writer cff =
+ write_placed_name writer cff.cff_name;
+ maybe_write_documentation writer cff.cff_doc;
+ write_pos writer cff.cff_pos;
+ write_metadata writer cff.cff_meta;
+ Chunk.write_list writer.chunk cff.cff_access (write_placed_access writer);
+ write_cfield_kind writer cff.cff_kind
+
+ and write_expr writer (e,p) =
+ write_pos writer p;
+ match e with
+ | EConst (Int (s, suffix)) ->
+ Chunk.write_u8 writer.chunk 0;
+ Chunk.write_string writer.chunk s;
+ Chunk.write_option writer.chunk suffix (Chunk.write_string writer.chunk);
+ | EConst (Float (s, suffix)) ->
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_string writer.chunk s;
+ Chunk.write_option writer.chunk suffix (Chunk.write_string writer.chunk);
+ | EConst (String (s,qs)) ->
+ Chunk.write_u8 writer.chunk 2;
+ Chunk.write_string writer.chunk s;
+ begin match qs with
+ | SDoubleQuotes -> Chunk.write_u8 writer.chunk 0;
+ | SSingleQuotes -> Chunk.write_u8 writer.chunk 1;
+ end
+ | EConst (Ident s) ->
+ Chunk.write_u8 writer.chunk 3;
+ Chunk.write_string writer.chunk s;
+ | EConst (Regexp(s1,s2)) ->
+ Chunk.write_u8 writer.chunk 4;
+ Chunk.write_string writer.chunk s1;
+ Chunk.write_string writer.chunk s2;
+ | EArray(e1,e2) ->
+ Chunk.write_u8 writer.chunk 5;
+ write_expr writer e1;
+ write_expr writer e2;
+ | EBinop(op,e1,e2) ->
+ Chunk.write_u8 writer.chunk 6;
+ Chunk.write_u8 writer.chunk (binop_index op);
+ write_expr writer e1;
+ write_expr writer e2;
+ | EField(e1,s,kind) ->
+ Chunk.write_u8 writer.chunk 7;
+ write_expr writer e1;
+ Chunk.write_string writer.chunk s;
+ begin match kind with
+ | EFNormal -> Chunk.write_u8 writer.chunk 0;
+ | EFSafe -> Chunk.write_u8 writer.chunk 1;
+ end
+ | EParenthesis e1 ->
+ Chunk.write_u8 writer.chunk 8;
+ write_expr writer e1;
+ | EObjectDecl fl ->
+ Chunk.write_u8 writer.chunk 9;
+ let write_field (k,e1) =
+ write_object_field_key writer k;
+ write_expr writer e1
+ in
+ Chunk.write_list writer.chunk fl write_field;
+ | EArrayDecl el ->
+ Chunk.write_u8 writer.chunk 10;
+ Chunk.write_list writer.chunk el (write_expr writer);
+ | ECall(e1,el) ->
+ Chunk.write_u8 writer.chunk 11;
+ write_expr writer e1;
+ Chunk.write_list writer.chunk el (write_expr writer)
+ | ENew(ptp,el) ->
+ Chunk.write_u8 writer.chunk 12;
+ write_placed_type_path writer ptp;
+ Chunk.write_list writer.chunk el (write_expr writer);
+ | EUnop(op,flag,e1) ->
+ Chunk.write_u8 writer.chunk 13;
+ Chunk.write_u8 writer.chunk (unop_index op flag);
+ write_expr writer e1;
+ | EVars vl ->
+ Chunk.write_u8 writer.chunk 14;
+ let write_var v =
+ write_placed_name writer v.ev_name;
+ Chunk.write_bool writer.chunk v.ev_final;
+ Chunk.write_bool writer.chunk v.ev_static;
+ Chunk.write_option writer.chunk v.ev_type (write_type_hint writer);
+ Chunk.write_option writer.chunk v.ev_expr (write_expr writer);
+ write_metadata writer v.ev_meta;
+ in
+ Chunk.write_list writer.chunk vl write_var
+ | EFunction(fk,f) ->
+ Chunk.write_u8 writer.chunk 15;
+ begin match fk with
+ | FKAnonymous -> Chunk.write_u8 writer.chunk 0;
+ | FKNamed (pn,inline) ->
+ Chunk.write_u8 writer.chunk 1;
+ write_placed_name writer pn;
+ Chunk.write_bool writer.chunk inline;
+ | FKArrow -> Chunk.write_u8 writer.chunk 2;
+ end;
+ write_func writer f;
+ | EBlock el ->
+ Chunk.write_u8 writer.chunk 16;
+ Chunk.write_list writer.chunk el (write_expr writer)
+ | EFor(e1,e2) ->
+ Chunk.write_u8 writer.chunk 17;
+ write_expr writer e1;
+ write_expr writer e2;
+ | EIf(e1,e2,None) ->
+ Chunk.write_u8 writer.chunk 18;
+ write_expr writer e1;
+ write_expr writer e2;
+ | EIf(e1,e2,Some e3) ->
+ Chunk.write_u8 writer.chunk 19;
+ write_expr writer e1;
+ write_expr writer e2;
+ write_expr writer e3;
+ | EWhile(e1,e2,NormalWhile) ->
+ Chunk.write_u8 writer.chunk 20;
+ write_expr writer e1;
+ write_expr writer e2;
+ | EWhile(e1,e2,DoWhile) ->
+ Chunk.write_u8 writer.chunk 21;
+ write_expr writer e1;
+ write_expr writer e2;
+ | ESwitch(e1,cases,def) ->
+ Chunk.write_u8 writer.chunk 22;
+ write_expr writer e1;
+ let write_case (el,eg,eo,p) =
+ Chunk.write_list writer.chunk el (write_expr writer);
+ Chunk.write_option writer.chunk eg (write_expr writer);
+ Chunk.write_option writer.chunk eo (write_expr writer);
+ write_pos writer p;
+ in
+ Chunk.write_list writer.chunk cases write_case;
+ let write_default (eo,p) =
+ Chunk.write_option writer.chunk eo (write_expr writer);
+ write_pos writer p
+ in
+ Chunk.write_option writer.chunk def write_default;
+ | ETry(e1,catches) ->
+ Chunk.write_u8 writer.chunk 23;
+ write_expr writer e1;
+ let write_catch (pn,th,e,p) =
+ write_placed_name writer pn;
+ Chunk.write_option writer.chunk th (write_type_hint writer);
+ write_expr writer e;
+ write_pos writer p;
+ in
+ Chunk.write_list writer.chunk catches write_catch;
+ | EReturn None ->
+ Chunk.write_u8 writer.chunk 24;
+ | EReturn (Some e1) ->
+ Chunk.write_u8 writer.chunk 25;
+ write_expr writer e1;
+ | EBreak ->
+ Chunk.write_u8 writer.chunk 26;
+ | EContinue ->
+ Chunk.write_u8 writer.chunk 27;
+ | EUntyped e1 ->
+ Chunk.write_u8 writer.chunk 28;
+ write_expr writer e1;
+ | EThrow e1 ->
+ Chunk.write_u8 writer.chunk 29;
+ write_expr writer e1;
+ | ECast(e1,None) ->
+ Chunk.write_u8 writer.chunk 30;
+ write_expr writer e1;
+ | ECast(e1,Some th) ->
+ Chunk.write_u8 writer.chunk 31;
+ write_expr writer e1;
+ write_type_hint writer th;
+ | EIs(e1,th) ->
+ Chunk.write_u8 writer.chunk 32;
+ write_expr writer e1;
+ write_type_hint writer th;
+ | EDisplay(e1,dk) ->
+ Chunk.write_u8 writer.chunk 33;
+ write_expr writer e1;
+ begin match dk with
+ | DKCall -> Chunk.write_u8 writer.chunk 0;
+ | DKDot -> Chunk.write_u8 writer.chunk 1;
+ | DKStructure -> Chunk.write_u8 writer.chunk 2;
+ | DKMarked -> Chunk.write_u8 writer.chunk 3;
+ | DKPattern b ->
+ Chunk.write_u8 writer.chunk 4;
+ Chunk.write_bool writer.chunk b;
+ end
+ | ETernary(e1,e2,e3) ->
+ Chunk.write_u8 writer.chunk 34;
+ write_expr writer e1;
+ write_expr writer e2;
+ write_expr writer e3;
+ | ECheckType(e1,th) ->
+ Chunk.write_u8 writer.chunk 35;
+ write_expr writer e1;
+ write_type_hint writer th;
+ | EMeta(m,e1) ->
+ Chunk.write_u8 writer.chunk 36;
+ write_metadata_entry writer m;
+ write_expr writer e1
+
+ (* References *)
+
+ let write_class_ref writer (c : tclass) =
+ let i = Pool.get_or_add writer.classes c.cl_path c in
+ Chunk.write_uleb128 writer.chunk i
+
+ let write_enum_ref writer (en : tenum) =
+ let i = Pool.get_or_add writer.enums en.e_path en in
+ Chunk.write_uleb128 writer.chunk i
+
+ let write_typedef_ref writer (td : tdef) =
+ let i = Pool.get_or_add writer.typedefs td.t_path td in
+ Chunk.write_uleb128 writer.chunk i
+
+ let write_abstract_ref writer (a : tabstract) =
+ let i = Pool.get_or_add writer.abstracts a.a_path a in
+ Chunk.write_uleb128 writer.chunk i
+
+ let write_tmono_ref writer (mono : tmono) =
+ let index = IdentityPool.get_or_add writer.tmonos mono () in
+ Chunk.write_uleb128 writer.chunk index
+
+ let write_field_ref writer (c : tclass) (kind : class_field_ref_kind) (cf : tclass_field) =
+ let index = try
+ HashedIdentityPool.get writer.class_fields cf.cf_name cf
+ with Not_found ->
+ let find_overload c cf_base =
+ let rec loop depth cfl = match cfl with
+ | cf' :: cfl ->
+ if cf' == cf then
+ Some(c,depth)
+ else
+ loop (depth + 1) cfl
+ | [] ->
+ None
+ in
+ let cfl = cf_base :: cf_base.cf_overloads in
+ loop 0 cfl
+ in
+ let find_overload c =
+ try
+ find_overload c (find_field c cf.cf_name kind)
+ with Not_found ->
+ None
+ in
+ let r = match kind with
+ | CfrStatic | CfrConstructor ->
+ find_overload c;
+ | CfrInit ->
+ Some(c,0)
+ | CfrMember ->
+ (* For member overloads we need to find the correct class, which is a mess. *)
+ let rec loop c = match find_overload c with
+ | Some _ as r ->
+ r
+ | None ->
+ if has_class_flag c CInterface then
+ let rec loopi l = match l with
+ | [] ->
+ None
+ | (c,_) :: l ->
+ match loop c with
+ | Some _ as r ->
+ r
+ | None ->
+ loopi l
+ in
+ loopi c.cl_implements
+ else match c.cl_super with
+ | Some(c,_) ->
+ loop c
+ | None ->
+ None
+ in
+ loop c;
+ in
+ let c,depth = match r with
+ | None ->
+ print_endline (Printf.sprintf "Could not resolve %s overload for %s on %s" (s_class_field_ref_kind kind) cf.cf_name (s_type_path c.cl_path));
+ c,0
+ | Some(c,depth) ->
+ c,depth
+ in
+ HashedIdentityPool.add writer.class_fields cf.cf_name cf (c,kind,depth)
+ in
+ Chunk.write_uleb128 writer.chunk index
+
+ let write_enum_field_ref writer (en : tenum) (ef : tenum_field) =
+ let key = (en.e_path,ef.ef_name) in
+ try
+ Chunk.write_uleb128 writer.chunk (Pool.get writer.enum_fields key)
+ with Not_found ->
+ ignore(Pool.get_or_add writer.enums en.e_path en);
+ Chunk.write_uleb128 writer.chunk (Pool.add writer.enum_fields key (en,ef))
+
+ let write_var_kind writer vk =
+ let b = match vk with
+ | VUser TVOLocalVariable -> 0
+ | VUser TVOArgument -> 1
+ | VUser TVOForVariable -> 2
+ | VUser TVOPatternVariable -> 3
+ | VUser TVOCatchVariable -> 4
+ | VUser TVOLocalFunction -> 5
+ | VGenerated -> 6
+ | VInlined -> 7
+ | VInlinedConstructorVariable -> 8
+ | VExtractorVariable -> 9
+ | VAbstractThis -> 10
+ in
+ Chunk.write_u8 writer.chunk b
+
+ let write_var writer fctx v =
+ Chunk.write_uleb128 writer.chunk v.v_id;
+ Chunk.write_string writer.chunk v.v_name;
+ write_var_kind writer v.v_kind;
+ Chunk.write_uleb128 writer.chunk v.v_flags;
+ write_metadata writer v.v_meta;
+ write_pos writer v.v_pos
+
+ let rec write_anon writer (an : tanon) (ttp : type_params) =
+ let write_fields () =
+ let restore = start_temporary_chunk writer 256 in
+ let i = ref 0 in
+ PMap.iter (fun _ cf ->
+ write_anon_field_ref writer cf;
+ incr i;
+ ) an.a_fields;
+ let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
+ Chunk.write_uleb128 writer.chunk !i;
+ Chunk.write_bytes writer.chunk bytes;
+ in
+ begin match !(an.a_status) with
+ | Closed ->
+ Chunk.write_u8 writer.chunk 0;
+ write_fields ()
+ | Const ->
+ Chunk.write_u8 writer.chunk 1;
+ write_fields ()
+ | Extend tl ->
+ Chunk.write_u8 writer.chunk 2;
+ write_types writer tl;
+ write_fields ()
+ | ClassStatics _ ->
+ assert false
+ | EnumStatics _ ->
+ assert false
+ | AbstractStatics _ ->
+ assert false
+ end
+
+ and write_anon_ref writer (an : tanon) (ttp : type_params) =
+ let pfm = Option.get (writer.anon_id#identify_anon ~strict:true an) in
+ try
+ let index = Pool.get writer.anons pfm.pfm_path in
+ Chunk.write_u8 writer.chunk 0;
+ Chunk.write_uleb128 writer.chunk index
+ with Not_found ->
+ let index = Pool.add writer.anons pfm.pfm_path an in
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_uleb128 writer.chunk index;
+ write_anon writer an ttp
+
+ and write_anon_field_ref writer cf =
+ try
+ let index = HashedIdentityPool.get writer.anon_fields cf.cf_name cf in
+ Chunk.write_u8 writer.chunk 0;
+ Chunk.write_uleb128 writer.chunk index
+ with Not_found ->
+ let index = HashedIdentityPool.add writer.anon_fields cf.cf_name cf () in
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_uleb128 writer.chunk index;
+ ignore(write_class_field_and_overloads_data writer true cf)
+
+ (* Type instances *)
+
+ and write_type_parameter_ref writer (ttp : typed_type_param) =
+ begin try
+ begin match ttp.ttp_host with
+ | TPHType ->
+ let i = Pool.get writer.type_type_parameters ttp.ttp_name in
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_uleb128 writer.chunk i
+ | TPHMethod | TPHEnumConstructor | TPHAnonField | TPHConstructor ->
+ let i = IdentityPool.get writer.field_type_parameters ttp in
+ Chunk.write_u8 writer.chunk 2;
+ Chunk.write_uleb128 writer.chunk i;
+ | TPHLocal ->
+ let index = IdentityPool.get writer.local_type_parameters ttp in
+ Chunk.write_u8 writer.chunk 3;
+ Chunk.write_uleb128 writer.chunk index;
+ end with Not_found ->
+ (try ignore(IdentityPool.get writer.unbound_ttp ttp) with Not_found -> begin
+ ignore(IdentityPool.add writer.unbound_ttp ttp ());
+ let p = { null_pos with pfile = (Path.UniqueKey.lazy_path writer.current_module.m_extra.m_file) } in
+ let msg = Printf.sprintf "Unbound type parameter %s" (s_type_path ttp.ttp_class.cl_path) in
+ writer.warn WUnboundTypeParameter msg p
+ end);
+ Chunk.write_u8 writer.chunk 4; (* TDynamic None *)
+ end
+
+ (*
+ simple references:
+ 0 - mono
+ 1 -> type ttp
+ 2 -> field ttp
+ 3 -> local ttp
+ 4 -> Dynamic
+
+ special references:
+ 10 - class statics
+ 11 - enum statics
+ 12 - abstract statics
+ 13 - KExpr
+
+ void functions:
+ 20: () -> Void
+ 21: (A) -> Void
+ 22: (A, B) -> Void
+ 23: (A, B, C) -> Void
+ 24: (A, B, C) -> Void
+ 29: (?) -> Void
+
+ non-void functions:
+ 30: () -> T
+ 31: (A) -> T
+ 32: (A, B) -> T
+ 33: (A, B, C) -> T
+ 34: (A, B, C, D) -> T
+ 39: (?) -> T
+
+ class:
+ 40: C
+ 41: C
+ 42: C
+ 49: C
+
+ enum:
+ 50: E
+ 51: E
+ 52: E
+ 59: E
+
+ typedef:
+ 60: T
+ 61: T
+ 62: T
+ 69: T
+
+ abstract:
+ 70: A
+ 71: A
+ 72: A
+ 79: A
+
+ anons:
+ 80: {}
+ 81: any anon
+ 89: Dynamic
+
+ concrete types:
+ 100: Void
+ 101: Int
+ 102: Float
+ 103: Bool
+ 104: String
+ *)
+ and write_type_instance writer t =
+ let write_function_arg (n,o,t) =
+ Chunk.write_string writer.chunk n;
+ Chunk.write_bool writer.chunk o;
+ write_type_instance writer t;
+ in
+ let write_inlined_list offset max f_first f_elt l =
+ write_inlined_list writer offset max (Chunk.write_u8 writer.chunk) f_first f_elt l
+ in
+ match t with
+ | TAbstract ({a_path = ([],"Void")},[]) ->
+ Chunk.write_u8 writer.chunk 100;
+ | TAbstract ({a_path = ([],"Int")},[]) ->
+ Chunk.write_u8 writer.chunk 101;
+ | TAbstract ({a_path = ([],"Float")},[]) ->
+ Chunk.write_u8 writer.chunk 102;
+ | TAbstract ({a_path = ([],"Bool")},[]) ->
+ Chunk.write_u8 writer.chunk 103;
+ | TInst ({cl_path = ([],"String")},[]) ->
+ Chunk.write_u8 writer.chunk 104;
+ | TMono r ->
+ Monomorph.close r;
+ begin match r.tm_type with
+ | None ->
+ Chunk.write_u8 writer.chunk 0;
+ write_tmono_ref writer r;
+ | Some t ->
+ (* Don't write bound monomorphs, write underlying type directly *)
+ write_type_instance writer t
+ end
+ | TLazy f ->
+ write_type_instance writer (lazy_type f)
+ | TInst({cl_kind = KTypeParameter ttp},[]) ->
+ write_type_parameter_ref writer ttp;
+ | TInst({cl_kind = KExpr e},[]) ->
+ Chunk.write_u8 writer.chunk 13;
+ write_expr writer e;
+ | TInst(c,[]) ->
+ Chunk.write_u8 writer.chunk 40;
+ write_class_ref writer c;
+ | TEnum(en,[]) ->
+ Chunk.write_u8 writer.chunk 50;
+ write_enum_ref writer en;
+ | TType(td,[]) ->
+ let default () =
+ Chunk.write_u8 writer.chunk 60;
+ write_typedef_ref writer td;
+ in
+ begin match td.t_type with
+ | TAnon an ->
+ begin match !(an.a_status) with
+ | ClassStatics c ->
+ Chunk.write_u8 writer.chunk 10;
+ write_class_ref writer c
+ | EnumStatics en ->
+ Chunk.write_u8 writer.chunk 11;
+ write_enum_ref writer en;
+ | AbstractStatics a ->
+ Chunk.write_u8 writer.chunk 12;
+ write_abstract_ref writer a
+ | _ ->
+ default()
+ end
+ | _ ->
+ default()
+ end;
+ | TAbstract(a,[]) ->
+ Chunk.write_u8 writer.chunk 70;
+ write_abstract_ref writer a;
+ | TDynamic None ->
+ Chunk.write_u8 writer.chunk 4;
+ | TFun([],t) when ExtType.is_void (follow_lazy_and_mono t) ->
+ Chunk.write_u8 writer.chunk 20;
+ | TFun(args,t) when ExtType.is_void (follow_lazy_and_mono t) ->
+ write_inlined_list 20 4 (fun () -> ()) write_function_arg args;
+ | TFun(args,t) ->
+ write_inlined_list 30 4 (fun () -> ()) write_function_arg args;
+ write_type_instance writer t;
+ | TInst(c,tl) ->
+ write_inlined_list 40 2 (fun () -> write_class_ref writer c) (write_type_instance writer) tl;
+ | TEnum(en,tl) ->
+ write_inlined_list 50 2 (fun () -> write_enum_ref writer en) (write_type_instance writer) tl;
+ | TType(td,tl) ->
+ write_inlined_list 60 2 (fun () -> write_typedef_ref writer td) (write_type_instance writer) tl;
+ | TAbstract(a,tl) ->
+ write_inlined_list 70 2 (fun () -> write_abstract_ref writer a) (write_type_instance writer) tl;
+ | TAnon an when PMap.is_empty an.a_fields ->
+ Chunk.write_u8 writer.chunk 80;
+ | TAnon an ->
+ Chunk.write_u8 writer.chunk 81;
+ write_anon_ref writer an []
+ | TDynamic (Some t) ->
+ Chunk.write_u8 writer.chunk 89;
+ write_type_instance writer t
+
+ and write_types writer tl =
+ Chunk.write_list writer.chunk tl (write_type_instance writer)
+
+ (* texpr *)
+
+ and write_texpr_type_instance writer (fctx : field_writer_context) (t: Type.t) =
+ let old_chunk = writer.chunk in
+ writer.chunk <- writer.t_instance_chunk;
+ Chunk.reset writer.chunk;
+ write_type_instance writer t;
+ let t_bytes = Chunk.get_bytes writer.chunk in
+ writer.chunk <- old_chunk;
+ let index = StringPool.get_or_add fctx.t_pool (Bytes.unsafe_to_string t_bytes) in
+ Chunk.write_uleb128 writer.chunk index
+
+ and write_texpr writer (fctx : field_writer_context) (e : texpr) =
+ let declare_var v =
+ let index = if has_var_flag v VHxb then begin
+ (* Duplicate var declaration! Can happen when writing both cf_expr and cf_expr_unoptimized,
+ although it arguably shouldn't. In this case we don't add the var again and instead write
+ out the existing ID.*)
+ v.v_id
+ end else begin
+ let index = DynArray.length fctx.vars in
+ DynArray.add fctx.vars (v,v.v_id);
+ (* Store local index in v_id so we find it easily for all the TLocal expressions.
+ This is set back by the var writer in start_texpr. *)
+ v.v_id <- index;
+ add_var_flag v VHxb;
+ index;
+ end in
+ Chunk.write_uleb128 writer.chunk index;
+ Chunk.write_option writer.chunk v.v_extra (fun ve ->
+ Chunk.write_list writer.chunk ve.v_params (fun ttp ->
+ let index = IdentityPool.add writer.local_type_parameters ttp () in
+ Chunk.write_uleb128 writer.chunk index
+ );
+ Chunk.write_option writer.chunk ve.v_expr (write_texpr writer fctx);
+ );
+ write_type_instance writer v.v_type;
+ in
+ let rec loop e =
+ let write_type = match e.eexpr with
+ (* values 0-19 *)
+ | TConst ct ->
+ begin match ct with
+ | TNull ->
+ Chunk.write_u8 writer.chunk 0;
+ true
+ | TThis ->
+ fctx.texpr_this <- Some e;
+ Chunk.write_u8 writer.chunk 1;
+ false;
+ | TSuper ->
+ Chunk.write_u8 writer.chunk 2;
+ true;
+ | TBool false when (ExtType.is_bool (follow_lazy_and_mono e.etype)) ->
+ Chunk.write_u8 writer.chunk 3;
+ false;
+ | TBool true when (ExtType.is_bool (follow_lazy_and_mono e.etype)) ->
+ Chunk.write_u8 writer.chunk 4;
+ false;
+ | TInt i32 when (ExtType.is_int (follow_lazy_and_mono e.etype)) ->
+ Chunk.write_u8 writer.chunk 5;
+ Chunk.write_i32 writer.chunk i32;
+ false;
+ | TFloat f when (ExtType.is_float (follow_lazy_and_mono e.etype)) ->
+ Chunk.write_u8 writer.chunk 6;
+ Chunk.write_string writer.chunk f;
+ false;
+ | TString s when (ExtType.is_string (follow_lazy_and_mono e.etype)) ->
+ Chunk.write_u8 writer.chunk 7;
+ Chunk.write_string writer.chunk s;
+ false
+ | TBool false ->
+ Chunk.write_u8 writer.chunk 13;
+ true;
+ | TBool true ->
+ Chunk.write_u8 writer.chunk 14;
+ true;
+ | TInt i32 ->
+ Chunk.write_u8 writer.chunk 15;
+ Chunk.write_i32 writer.chunk i32;
+ true;
+ | TFloat f ->
+ Chunk.write_u8 writer.chunk 16;
+ Chunk.write_string writer.chunk f;
+ true;
+ | TString s ->
+ Chunk.write_u8 writer.chunk 17;
+ Chunk.write_string writer.chunk s;
+ true;
+ end
+ (* vars 20-29 *)
+ | TLocal v ->
+ Chunk.write_u8 writer.chunk 20;
+ Chunk.write_uleb128 writer.chunk v.v_id;
+ true; (* I think there are cases where v_type != etype *)
+ | TVar(v,None) ->
+ Chunk.write_u8 writer.chunk 21;
+ declare_var v;
+ false;
+ | TVar(v,Some e1) ->
+ Chunk.write_u8 writer.chunk 22;
+ declare_var v;
+ loop e1;
+ false;
+ (* blocks 30-49 *)
+ | TBlock [] ->
+ Chunk.write_u8 writer.chunk 30;
+ true;
+ | TBlock el ->
+ let restore = start_temporary_chunk writer 256 in
+ let i = ref 0 in
+ List.iter (fun e ->
+ incr i;
+ loop e;
+ ) el;
+ let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
+ let l = !i in
+ begin match l with
+ | 1 -> Chunk.write_u8 writer.chunk 31;
+ | 2 -> Chunk.write_u8 writer.chunk 32;
+ | 3 -> Chunk.write_u8 writer.chunk 33;
+ | 4 -> Chunk.write_u8 writer.chunk 34;
+ | 5 -> Chunk.write_u8 writer.chunk 35;
+ | _ ->
+ if l <= 0xFF then begin
+ Chunk.write_u8 writer.chunk 36;
+ Chunk.write_u8 writer.chunk l;
+ end else begin
+ Chunk.write_u8 writer.chunk 39;
+ Chunk.write_uleb128 writer.chunk l;
+ end;
+ end;
+ Chunk.write_bytes writer.chunk bytes;
+ true;
+ (* function 50-59 *)
+ | TFunction tf ->
+ Chunk.write_u8 writer.chunk 50;
+ Chunk.write_list writer.chunk tf.tf_args (fun (v,eo) ->
+ declare_var v;
+ Chunk.write_option writer.chunk eo loop;
+ );
+ write_type_instance writer tf.tf_type;
+ loop tf.tf_expr;
+ true;
+ (* texpr compounds 60-79 *)
+ | TArray(e1,e2) ->
+ Chunk.write_u8 writer.chunk 60;
+ loop e1;
+ loop e2;
+ true;
+ | TParenthesis e1 ->
+ Chunk.write_u8 writer.chunk 61;
+ loop e1;
+ false; (* surely this is always the nested type *)
+ | TArrayDecl el ->
+ Chunk.write_u8 writer.chunk 62;
+ loop_el el;
+ true;
+ | TObjectDecl fl ->
+ Chunk.write_u8 writer.chunk 63;
+ Chunk.write_list writer.chunk fl (fun ((name,p,qs),e) ->
+ Chunk.write_string writer.chunk name;
+ write_pos writer p;
+ begin match qs with
+ | NoQuotes -> Chunk.write_u8 writer.chunk 0;
+ | DoubleQuotes -> Chunk.write_u8 writer.chunk 1;
+ end;
+ loop e
+ );
+ true;
+ | TCall(e1,el) ->
+ write_inlined_list writer 70 4 (Chunk.write_u8 writer.chunk) (fun () -> loop e1) loop el;
+ true;
+ | TMeta(m,e1) ->
+ Chunk.write_u8 writer.chunk 65;
+ write_metadata_entry writer m;
+ loop e1;
+ true;
+ (* branching 80-89 *)
+ | TIf(e1,e2,None) ->
+ Chunk.write_u8 writer.chunk 80;
+ loop e1;
+ loop e2;
+ false;
+ | TIf(e1,e2,Some e3) ->
+ Chunk.write_u8 writer.chunk 81;
+ loop e1;
+ loop e2;
+ loop e3;
+ true;
+ | TSwitch s ->
+ Chunk.write_u8 writer.chunk 82;
+ loop s.switch_subject;
+ Chunk.write_list writer.chunk s.switch_cases (fun c ->
+ loop_el c.case_patterns;
+ loop c.case_expr;
+ );
+ Chunk.write_option writer.chunk s.switch_default loop;
+ true;
+ | TTry(e1,catches) ->
+ Chunk.write_u8 writer.chunk 83;
+ loop e1;
+ Chunk.write_list writer.chunk catches (fun (v,e) ->
+ declare_var v;
+ loop e
+ );
+ true;
+ | TWhile(e1,e2,flag) ->
+ Chunk.write_u8 writer.chunk (if flag = NormalWhile then 84 else 85);
+ loop e1;
+ loop e2;
+ false;
+ | TFor(v,e1,e2) ->
+ Chunk.write_u8 writer.chunk 86;
+ declare_var v;
+ loop e1;
+ loop e2;
+ false;
+ (* control flow 90-99 *)
+ | TReturn None ->
+ Chunk.write_u8 writer.chunk 90;
+ true;
+ | TReturn (Some e1) ->
+ Chunk.write_u8 writer.chunk 91;
+ loop e1;
+ true;
+ | TContinue ->
+ Chunk.write_u8 writer.chunk 92;
+ true;
+ | TBreak ->
+ Chunk.write_u8 writer.chunk 93;
+ true;
+ | TThrow e1 ->
+ Chunk.write_u8 writer.chunk 94;
+ loop e1;
+ true;
+ (* access 100-119 *)
+ | TEnumIndex e1 ->
+ Chunk.write_u8 writer.chunk 100;
+ loop e1;
+ false;
+ | TEnumParameter(e1,ef,i) ->
+ Chunk.write_u8 writer.chunk 101;
+ loop e1;
+ let en = match follow ef.ef_type with
+ | TFun(_,tr) ->
+ begin match follow tr with
+ | TEnum(en,_) -> en
+ | _ -> die "" __LOC__
+ end
+ | _ ->
+ die "" __LOC__
+ in
+ write_enum_field_ref writer en ef;
+ Chunk.write_uleb128 writer.chunk i;
+ true;
+ | TField({eexpr = TConst TThis; epos = p1},FInstance(c,tl,cf)) when fctx.texpr_this <> None ->
+ Chunk.write_u8 writer.chunk 111;
+ PosWriter.write_pos fctx.pos_writer writer.chunk true 0 p1;
+ write_class_ref writer c;
+ write_types writer tl;
+ write_field_ref writer c CfrMember cf;
+ true;
+ | TField(e1,FInstance(c,tl,cf)) ->
+ Chunk.write_u8 writer.chunk 102;
+ loop e1;
+ write_class_ref writer c;
+ write_types writer tl;
+ write_field_ref writer c CfrMember cf;
+ true;
+ | TField({eexpr = TTypeExpr (TClassDecl c'); epos = p1},FStatic(c,cf)) when c == c' ->
+ Chunk.write_u8 writer.chunk 110;
+ PosWriter.write_pos fctx.pos_writer writer.chunk true 0 p1;
+ write_class_ref writer c;
+ write_field_ref writer c CfrStatic cf;
+ true;
+ | TField(e1,FStatic(c,cf)) ->
+ Chunk.write_u8 writer.chunk 103;
+ loop e1;
+ write_class_ref writer c;
+ write_field_ref writer c CfrStatic cf;
+ true;
+ | TField(e1,FAnon cf) ->
+ Chunk.write_u8 writer.chunk 104;
+ loop e1;
+ write_anon_field_ref writer cf;
+ true;
+ | TField(e1,FClosure(Some(c,tl),cf)) ->
+ Chunk.write_u8 writer.chunk 105;
+ loop e1;
+ write_class_ref writer c;
+ write_types writer tl;
+ write_field_ref writer c CfrMember cf;
+ true;
+ | TField(e1,FClosure(None,cf)) ->
+ Chunk.write_u8 writer.chunk 106;
+ loop e1;
+ write_anon_field_ref writer cf;
+ true;
+ | TField(e1,FEnum(en,ef)) ->
+ Chunk.write_u8 writer.chunk 107;
+ loop e1;
+ write_enum_ref writer en;
+ write_enum_field_ref writer en ef;
+ true;
+ | TField(e1,FDynamic s) ->
+ Chunk.write_u8 writer.chunk 108;
+ loop e1;
+ Chunk.write_string writer.chunk s;
+ true;
+ (* module types 120-139 *)
+ | TTypeExpr (TClassDecl ({cl_kind = KTypeParameter ttp})) ->
+ Chunk.write_u8 writer.chunk 128;
+ write_type_parameter_ref writer ttp;
+ true;
+ | TTypeExpr (TClassDecl c) ->
+ Chunk.write_u8 writer.chunk 120;
+ write_class_ref writer c;
+ false;
+ | TTypeExpr (TEnumDecl en) ->
+ Chunk.write_u8 writer.chunk 121;
+ write_enum_ref writer en;
+ false;
+ | TTypeExpr (TAbstractDecl a) ->
+ Chunk.write_u8 writer.chunk 122;
+ write_abstract_ref writer a;
+ true;
+ | TTypeExpr (TTypeDecl td) ->
+ Chunk.write_u8 writer.chunk 123;
+ write_typedef_ref writer td;
+ true;
+ | TCast(e1,None) ->
+ Chunk.write_u8 writer.chunk 124;
+ loop e1;
+ true;
+ | TCast(e1,Some md) ->
+ Chunk.write_u8 writer.chunk 125;
+ loop e1;
+ let infos = t_infos md in
+ let m = infos.mt_module in
+ write_full_path writer (fst m.m_path) (snd m.m_path) (snd infos.mt_path);
+ true;
+ | TNew(({cl_kind = KTypeParameter ttp}),tl,el) ->
+ Chunk.write_u8 writer.chunk 127;
+ write_type_parameter_ref writer ttp;
+ write_types writer tl;
+ loop_el el;
+ true;
+ | TNew(c,tl,el) ->
+ Chunk.write_u8 writer.chunk 126;
+ write_class_ref writer c;
+ write_types writer tl;
+ loop_el el;
+ true;
+ (* unops 140-159 *)
+ | TUnop(op,flag,e1) ->
+ Chunk.write_u8 writer.chunk (140 + unop_index op flag);
+ loop e1;
+ true;
+ (* binops 160-219 *)
+ | TBinop(op,e1,e2) ->
+ Chunk.write_u8 writer.chunk (160 + binop_index op);
+ loop e1;
+ loop e2;
+ true;
+ (* rest 250-254 *)
+ | TIdent s ->
+ Chunk.write_u8 writer.chunk 250;
+ Chunk.write_string writer.chunk s;
+ true;
+ in
+ if write_type then
+ write_texpr_type_instance writer fctx e.etype;
+ PosWriter.write_pos fctx.pos_writer writer.chunk true 0 e.epos;
+
+ and loop_el el =
+ Chunk.write_list writer.chunk el loop
+ in
+ loop e
+
+ and write_type_parameters_forward writer (ttps : typed_type_param list) =
+ let write_type_parameter_forward ttp =
+ write_path writer ttp.ttp_class.cl_path;
+ write_pos writer ttp.ttp_class.cl_name_pos;
+ let i = match ttp.ttp_host with
+ | TPHType -> 0
+ | TPHConstructor -> 1
+ | TPHMethod -> 2
+ | TPHEnumConstructor -> 3
+ | TPHAnonField -> 4
+ | TPHLocal -> 5
+ in
+ Chunk.write_u8 writer.chunk i
+ in
+ Chunk.write_list writer.chunk ttps write_type_parameter_forward
+
+ and write_type_parameters_data writer (ttps : typed_type_param list) =
+ let write_type_parameter_data ttp =
+ let c = ttp.ttp_class in
+ write_metadata writer c.cl_meta;
+ write_types writer (get_constraints ttp);
+ Chunk.write_option writer.chunk ttp.ttp_default (write_type_instance writer)
+ in
+ List.iter write_type_parameter_data ttps
+
+ and write_type_parameters writer (ttps : typed_type_param list) =
+ write_type_parameters_forward writer ttps;
+ write_type_parameters_data writer ttps;
+
+ (* Fields *)
+
+ and write_field_kind writer = function
+ | Method MethNormal -> Chunk.write_u8 writer.chunk 0;
+ | Method MethInline -> Chunk.write_u8 writer.chunk 1;
+ | Method MethDynamic -> Chunk.write_u8 writer.chunk 2;
+ | Method MethMacro -> Chunk.write_u8 writer.chunk 3;
+ (* normal read *)
+ | Var {v_read = AccNormal; v_write = AccNormal } -> Chunk.write_u8 writer.chunk 10
+ | Var {v_read = AccNormal; v_write = AccNo } -> Chunk.write_u8 writer.chunk 11
+ | Var {v_read = AccNormal; v_write = AccNever } -> Chunk.write_u8 writer.chunk 12
+ | Var {v_read = AccNormal; v_write = AccCtor } -> Chunk.write_u8 writer.chunk 13
+ | Var {v_read = AccNormal; v_write = AccCall } -> Chunk.write_u8 writer.chunk 14
+ (* inline read *)
+ | Var {v_read = AccInline; v_write = AccNever } -> Chunk.write_u8 writer.chunk 20
+ (* getter read *)
+ | Var {v_read = AccCall; v_write = AccNormal } -> Chunk.write_u8 writer.chunk 30
+ | Var {v_read = AccCall; v_write = AccNo } -> Chunk.write_u8 writer.chunk 31
+ | Var {v_read = AccCall; v_write = AccNever } -> Chunk.write_u8 writer.chunk 32
+ | Var {v_read = AccCall; v_write = AccCtor } -> Chunk.write_u8 writer.chunk 33
+ | Var {v_read = AccCall; v_write = AccCall } -> Chunk.write_u8 writer.chunk 34
+ (* weird/overlooked combinations *)
+ | Var {v_read = r;v_write = w } ->
+ Chunk.write_u8 writer.chunk 100;
+ let f = function
+ | AccNormal -> Chunk.write_u8 writer.chunk 0
+ | AccNo -> Chunk.write_u8 writer.chunk 1
+ | AccNever -> Chunk.write_u8 writer.chunk 2
+ | AccCtor -> Chunk.write_u8 writer.chunk 3
+ | AccCall -> Chunk.write_u8 writer.chunk 4
+ | AccInline -> Chunk.write_u8 writer.chunk 5
+ | AccRequire(s,so) ->
+ Chunk.write_u8 writer.chunk 6;
+ Chunk.write_string writer.chunk s;
+ Chunk.write_option writer.chunk so (Chunk.write_string writer.chunk)
+ in
+ f r;
+ f w
+
+ and open_field_scope writer (params : type_params) =
+ writer.field_stack <- () :: writer.field_stack;
+ let nested = in_nested_scope writer in
+ let old_field_params = writer.field_type_parameters in
+ let old_local_params = writer.local_type_parameters in
+ if not nested then begin
+ writer.local_type_parameters <- IdentityPool.create ();
+ writer.field_type_parameters <- IdentityPool.create ();
+ end;
+ List.iter (fun ttp ->
+ ignore(IdentityPool.add writer.field_type_parameters ttp ());
+ ) params;
+ (fun () ->
+ writer.field_type_parameters <- old_field_params;
+ writer.local_type_parameters <- old_local_params;
+ writer.field_stack <- List.tl writer.field_stack
+ )
+
+ and write_class_field_forward writer cf =
+ Chunk.write_string writer.chunk cf.cf_name;
+ write_pos_pair writer cf.cf_pos cf.cf_name_pos;
+ Chunk.write_list writer.chunk cf.cf_overloads (fun cf ->
+ write_class_field_forward writer cf;
+ );
+
+ and start_texpr writer (p: pos) =
+ let restore = start_temporary_chunk writer 512 in
+ let fctx = create_field_writer_context (PosWriter.create writer.chunk p) in
+ fctx,(fun () ->
+ restore(fun new_chunk ->
+ let restore = start_temporary_chunk writer 512 in
+ if in_nested_scope writer then
+ Chunk.write_u8 writer.chunk 0
+ else begin
+ Chunk.write_u8 writer.chunk 1;
+ let ltp = List.map fst (IdentityPool.to_list writer.local_type_parameters) in
+ write_type_parameters writer ltp
+ end;
+ Chunk.write_option writer.chunk fctx.texpr_this (fun e -> write_type_instance writer e.etype);
+ let items,length = StringPool.finalize fctx.t_pool in
+ Chunk.write_uleb128 writer.chunk length;
+ List.iter (fun bytes ->
+ Chunk.write_bytes writer.chunk (Bytes.unsafe_of_string bytes)
+ ) items;
+ Chunk.write_uleb128 writer.chunk (DynArray.length fctx.vars);
+ DynArray.iter (fun (v,v_id) ->
+ v.v_id <- v_id;
+ remove_var_flag v VHxb;
+ write_var writer fctx v;
+ ) fctx.vars;
+ restore(fun newer_chunk -> newer_chunk,new_chunk)
+ )
+ )
+
+ and commit_field_type_parameters writer (params : type_params) =
+ Chunk.write_uleb128 writer.chunk (List.length params);
+ if in_nested_scope writer then
+ Chunk.write_u8 writer.chunk 0
+ else begin
+ Chunk.write_u8 writer.chunk 1;
+ let ftp = List.map fst (IdentityPool.to_list writer.field_type_parameters) in
+ write_type_parameters writer ftp
+ end
+
+ and write_class_field_data writer (write_expr_immediately : bool) (cf : tclass_field) =
+ let restore = start_temporary_chunk writer 512 in
+ write_type_instance writer cf.cf_type;
+ Chunk.write_uleb128 writer.chunk cf.cf_flags;
+ maybe_write_documentation writer cf.cf_doc;
+ write_metadata writer cf.cf_meta;
+ write_field_kind writer cf.cf_kind;
+ let expr_chunk = match cf.cf_expr with
+ | None ->
+ Chunk.write_u8 writer.chunk 0;
+ None
+ | Some e when not write_expr_immediately ->
+ Chunk.write_u8 writer.chunk 2;
+ let fctx,close = start_texpr writer e.epos in
+ write_texpr writer fctx e;
+ Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
+ let expr_chunk = close() in
+ Some expr_chunk
+ | Some e ->
+ Chunk.write_u8 writer.chunk 1;
+ let fctx,close = start_texpr writer e.epos in
+ write_texpr writer fctx e;
+ Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
+ let expr_pre_chunk,expr_chunk = close() in
+ Chunk.export_data expr_pre_chunk writer.chunk;
+ Chunk.export_data expr_chunk writer.chunk;
+ None
+ in
+ restore (fun new_chunk ->
+ commit_field_type_parameters writer cf.cf_params;
+ Chunk.export_data new_chunk writer.chunk
+ );
+ expr_chunk
+
+ and write_class_field_and_overloads_data writer (write_expr_immediately : bool) (cf : tclass_field) =
+ let cfl = cf :: cf.cf_overloads in
+ Chunk.write_uleb128 writer.chunk (List.length cfl);
+ ExtList.List.filter_map (fun cf ->
+ let close = open_field_scope writer cf.cf_params in
+ let expr_chunk = write_class_field_data writer write_expr_immediately cf in
+ close();
+ Option.map (fun expr_chunk -> (cf,expr_chunk)) expr_chunk
+ ) cfl
+
+ (* Module types *)
+
+ let select_type writer (path : path) =
+ writer.type_type_parameters <- Pool.extract writer.type_param_lut path
+
+ let write_common_module_type writer (infos : tinfos) : unit =
+ Chunk.write_bool writer.chunk infos.mt_private;
+ maybe_write_documentation writer infos.mt_doc;
+ write_metadata writer infos.mt_meta;
+ write_type_parameters_data writer infos.mt_params;
+ Chunk.write_list writer.chunk infos.mt_using (fun (c,p) ->
+ write_class_ref writer c;
+ write_pos writer p;
+ )
+
+ let write_class_kind writer = function
+ | KNormal ->
+ Chunk.write_u8 writer.chunk 0
+ | KTypeParameter ttp ->
+ die "" __LOC__
+ | KExpr e ->
+ Chunk.write_u8 writer.chunk 2;
+ write_expr writer e;
+ | KGeneric ->
+ Chunk.write_u8 writer.chunk 3;
+ | KGenericInstance(c,tl) ->
+ Chunk.write_u8 writer.chunk 4;
+ write_class_ref writer c;
+ write_types writer tl
+ | KMacroType ->
+ Chunk.write_u8 writer.chunk 5;
+ | KGenericBuild l ->
+ Chunk.write_u8 writer.chunk 6;
+ Chunk.write_list writer.chunk l (write_cfield writer);
+ | KAbstractImpl a ->
+ Chunk.write_u8 writer.chunk 7;
+ write_abstract_ref writer a;
+ | KModuleFields md ->
+ Chunk.write_u8 writer.chunk 8
+
+ let write_class writer (c : tclass) =
+ begin match c.cl_kind with
+ | KAbstractImpl a ->
+ select_type writer a.a_path
+ | _ ->
+ select_type writer c.cl_path;
+ end;
+ write_common_module_type writer (Obj.magic c);
+ write_class_kind writer c.cl_kind;
+ Chunk.write_option writer.chunk c.cl_super (fun (c,tl) ->
+ write_class_ref writer c;
+ write_types writer tl
+ );
+ Chunk.write_list writer.chunk c.cl_implements (fun (c,tl) ->
+ write_class_ref writer c;
+ write_types writer tl
+ );
+ Chunk.write_option writer.chunk c.cl_dynamic (write_type_instance writer);
+ Chunk.write_option writer.chunk c.cl_array_access (write_type_instance writer)
+
+ let write_abstract writer (a : tabstract) =
+ begin try
+ select_type writer a.a_path
+ with Not_found ->
+ prerr_endline ("Could not select abstract " ^ (s_type_path a.a_path));
+ end;
+ write_common_module_type writer (Obj.magic a);
+ Chunk.write_option writer.chunk a.a_impl (write_class_ref writer);
+ if Meta.has Meta.CoreType a.a_meta then
+ Chunk.write_u8 writer.chunk 0
+ else begin
+ Chunk.write_u8 writer.chunk 1;
+ write_type_instance writer a.a_this;
+ end;
+ Chunk.write_list writer.chunk a.a_from (write_type_instance writer);
+ Chunk.write_list writer.chunk a.a_to (write_type_instance writer);
+ Chunk.write_bool writer.chunk a.a_enum
+
+ let write_abstract_fields writer (a : tabstract) =
+ let c = match a.a_impl with
+ | None ->
+ null_class
+ | Some c ->
+ c
+ in
+
+ Chunk.write_list writer.chunk a.a_array (write_field_ref writer c CfrStatic);
+ Chunk.write_option writer.chunk a.a_read (write_field_ref writer c CfrStatic );
+ Chunk.write_option writer.chunk a.a_write (write_field_ref writer c CfrStatic);
+ Chunk.write_option writer.chunk a.a_call (write_field_ref writer c CfrStatic);
+
+ Chunk.write_list writer.chunk a.a_ops (fun (op, cf) ->
+ Chunk.write_u8 writer.chunk (binop_index op);
+ write_field_ref writer c CfrStatic cf
+ );
+
+ Chunk.write_list writer.chunk a.a_unops (fun (op, flag, cf) ->
+ Chunk.write_u8 writer.chunk (unop_index op flag);
+ write_field_ref writer c CfrStatic cf
+ );
+
+ Chunk.write_list writer.chunk a.a_from_field (fun (t,cf) ->
+ write_field_ref writer c CfrStatic cf;
+ );
+
+ Chunk.write_list writer.chunk a.a_to_field (fun (t,cf) ->
+ write_field_ref writer c CfrStatic cf;
+ )
+
+ let write_enum writer (e : tenum) =
+ select_type writer e.e_path;
+ write_common_module_type writer (Obj.magic e);
+ Chunk.write_bool writer.chunk e.e_extern;
+ Chunk.write_list writer.chunk e.e_names (Chunk.write_string writer.chunk)
+
+ let write_typedef writer (td : tdef) =
+ select_type writer td.t_path;
+ write_common_module_type writer (Obj.magic td);
+ write_type_instance writer td.t_type
+
+ (* Module *)
+
+ let forward_declare_type writer (mt : module_type) =
+ let name = ref "" in
+ let i = match mt with
+ | TClassDecl c ->
+ ignore(Pool.add writer.classes c.cl_path c);
+ ignore(Pool.add writer.own_classes c.cl_path c);
+ name := snd c.cl_path;
+ 0
+ | TEnumDecl e ->
+ ignore(Pool.add writer.enums e.e_path e);
+ ignore(Pool.add writer.own_enums e.e_path e);
+ name := snd e.e_path;
+ 1
+ | TTypeDecl t ->
+ ignore(Pool.add writer.typedefs t.t_path t);
+ ignore(Pool.add writer.own_typedefs t.t_path t);
+ name := snd t.t_path;
+ 2
+ | TAbstractDecl a ->
+ ignore(Pool.add writer.abstracts a.a_path a);
+ ignore(Pool.add writer.own_abstracts a.a_path a);
+ name := snd a.a_path;
+ 3
+ in
+
+ let infos = t_infos mt in
+ Chunk.write_u8 writer.chunk i;
+ write_path writer (fst infos.mt_path, !name);
+ write_pos_pair writer infos.mt_pos infos.mt_name_pos;
+ write_type_parameters_forward writer infos.mt_params;
+ let params = Pool.create () in
+ writer.type_type_parameters <- params;
+ ignore(Pool.add writer.type_param_lut infos.mt_path params);
+ List.iter (fun ttp ->
+ ignore(Pool.add writer.type_type_parameters ttp.ttp_name ttp)
+ ) infos.mt_params;
+
+ (* Forward declare fields *)
+ match mt with
+ | TClassDecl c ->
+ Chunk.write_uleb128 writer.chunk c.cl_flags;
+ Chunk.write_option writer.chunk c.cl_constructor (write_class_field_forward writer);
+ Chunk.write_option writer.chunk c.cl_init (write_class_field_forward writer);
+
+ (* Write in reverse order so reader can read tail-recursively without List.rev *)
+ let write_fields cfl =
+ let i = ref 0 in
+ let rec loop cfl = match cfl with
+ | [] ->
+ ()
+ | cf :: cfl ->
+ loop cfl;
+ write_class_field_forward writer cf;
+ incr i;
+ in
+ let restore = start_temporary_chunk writer 256 in
+ loop cfl;
+ let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
+ !i,bytes
+ in
+ let num_fields,field_bytes = write_fields c.cl_ordered_fields in
+ let num_statics,static_bytes = write_fields c.cl_ordered_statics in
+ Chunk.write_uleb128 writer.chunk num_fields;
+ Chunk.write_uleb128 writer.chunk num_statics;
+ Chunk.write_bytes writer.chunk field_bytes;
+ Chunk.write_bytes writer.chunk static_bytes;
+
+ | TEnumDecl e ->
+ Chunk.write_list writer.chunk (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
+ Chunk.write_string writer.chunk s;
+ write_pos_pair writer ef.ef_pos ef.ef_name_pos;
+ Chunk.write_u8 writer.chunk ef.ef_index
+ );
+ | TAbstractDecl a ->
+ ()
+ | TTypeDecl t ->
+ ()
+
+ let write_module writer (m : module_def) =
+ writer.current_module <- m;
+
+ start_chunk writer MTF;
+ Chunk.write_list writer.chunk m.m_types (forward_declare_type writer);
+
+ let items = Pool.finalize writer.own_abstracts in
+ if DynArray.length items > 0 then begin
+ start_chunk writer ABD;
+ Chunk.write_dynarray writer.chunk items (write_abstract writer);
+ start_chunk writer AFD;
+ Chunk.write_dynarray writer.chunk items (write_abstract_fields writer);
+ end;
+ let items = Pool.finalize writer.own_classes in
+ if DynArray.length items > 0 then begin
+ start_chunk writer CLD;
+ Chunk.write_dynarray writer.chunk items (write_class writer);
+ start_chunk writer CFD;
+ let expr_chunks = DynArray.create () in
+ Chunk.write_dynarray writer.chunk items (fun c ->
+ begin match c.cl_kind with
+ | KAbstractImpl a ->
+ select_type writer a.a_path
+ | _ ->
+ select_type writer c.cl_path;
+ end;
+
+ let c_expr_chunks = DynArray.create () in
+ let write_field ref_kind cf =
+ let l = write_class_field_and_overloads_data writer false cf in
+ List.iter (fun (cf,e) ->
+ DynArray.add c_expr_chunks (cf,ref_kind,e);
+ ) l
+ in
+
+ Chunk.write_option writer.chunk c.cl_constructor (write_field CfrConstructor);
+ Chunk.write_option writer.chunk c.cl_init (write_field CfrInit);
+ Chunk.write_list writer.chunk c.cl_ordered_fields (write_field CfrMember);
+ Chunk.write_list writer.chunk c.cl_ordered_statics (write_field CfrStatic);
+ if DynArray.length c_expr_chunks > 0 then
+ DynArray.add expr_chunks (c,c_expr_chunks)
+ );
+ if DynArray.length expr_chunks > 0 then begin
+ start_chunk writer EXD;
+ Chunk.write_dynarray writer.chunk expr_chunks (fun (c,l) ->
+ write_class_ref writer c;
+ Chunk.write_dynarray writer.chunk l (fun (cf,ref_kind,(e_pre,e)) ->
+ write_field_ref writer c ref_kind cf;
+ let bytes_pre = Chunk.get_bytes e_pre in
+ let bytes_e = Chunk.get_bytes e in
+ Chunk.write_uleb128 writer.chunk (Bytes.length bytes_pre + Bytes.length bytes_e);
+ Chunk.write_bytes writer.chunk bytes_pre;
+ Chunk.write_bytes writer.chunk bytes_e;
+ )
+ )
+ end
+ end;
+ let items = Pool.finalize writer.own_enums in
+ if DynArray.length items > 0 then begin
+ start_chunk writer END;
+ Chunk.write_dynarray writer.chunk items (write_enum writer);
+ start_chunk writer EFD;
+ Chunk.write_dynarray writer.chunk items (fun e ->
+ Chunk.write_list writer.chunk (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
+ select_type writer e.e_path;
+ let close = open_field_scope writer ef.ef_params in
+ Chunk.write_string writer.chunk s;
+ let restore = start_temporary_chunk writer 32 in
+ write_type_instance writer ef.ef_type;
+ let t_bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
+ commit_field_type_parameters writer ef.ef_params;
+ Chunk.write_bytes writer.chunk t_bytes;
+ maybe_write_documentation writer ef.ef_doc;
+ write_metadata writer ef.ef_meta;
+ close();
+ );
+ )
+ end;
+ let items = Pool.finalize writer.own_typedefs in
+ if DynArray.length items > 0 then begin
+ start_chunk writer TDD;
+ Chunk.write_dynarray writer.chunk items (write_typedef writer);
+ end;
+
+ let items = HashedIdentityPool.finalize writer.class_fields in
+ if DynArray.length items > 0 then begin
+ start_chunk writer CFR;
+ Chunk.write_uleb128 writer.chunk (DynArray.length items);
+ DynArray.iter (fun (cf,(c,kind,depth)) ->
+ write_class_ref writer c;
+ begin match kind with
+ | CfrStatic ->
+ Chunk.write_u8 writer.chunk 0;
+ Chunk.write_string writer.chunk cf.cf_name
+ | CfrMember ->
+ Chunk.write_u8 writer.chunk 1;
+ Chunk.write_string writer.chunk cf.cf_name
+ | CfrConstructor ->
+ Chunk.write_u8 writer.chunk 2;
+ | CfrInit ->
+ Chunk.write_u8 writer.chunk 3;
+ end;
+ Chunk.write_uleb128 writer.chunk depth
+ ) items;
+ end;
+
+ let items = Pool.finalize writer.enum_fields in
+ if DynArray.length items > 0 then begin
+ start_chunk writer EFR;
+ Chunk.write_uleb128 writer.chunk (DynArray.length items);
+ DynArray.iter (fun (en,ef) ->
+ write_enum_ref writer en;
+ Chunk.write_string writer.chunk ef.ef_name;
+ ) items;
+ end;
+
+ let items = HashedIdentityPool.finalize writer.anon_fields in
+ if DynArray.length items > 0 then begin
+ start_chunk writer AFR;
+ Chunk.write_uleb128 writer.chunk (DynArray.length items);
+ DynArray.iter (fun (cf,_) ->
+ write_class_field_forward writer cf
+ ) items;
+ end;
+
+ let items = Pool.finalize writer.classes in
+ if DynArray.length items > 0 then begin
+ start_chunk writer CLR;
+ Chunk.write_dynarray writer.chunk items (fun c ->
+ let m = c.cl_module in
+ write_full_path writer (fst m.m_path) (snd m.m_path) (snd c.cl_path);
+ )
+ end;
+ let items = Pool.finalize writer.abstracts in
+ if DynArray.length items > 0 then begin
+ start_chunk writer ABR;
+ Chunk.write_dynarray writer.chunk items (fun a ->
+ let m = a.a_module in
+ write_full_path writer (fst m.m_path) (snd m.m_path) (snd a.a_path);
+ )
+ end;
+ let items = Pool.finalize writer.enums in
+ if DynArray.length items > 0 then begin
+ start_chunk writer ENR;
+ Chunk.write_dynarray writer.chunk items (fun en ->
+ let m = en.e_module in
+ write_full_path writer (fst m.m_path) (snd m.m_path) (snd en.e_path);
+ )
+ end;
+ let items = Pool.finalize writer.typedefs in
+ if DynArray.length items > 0 then begin
+ start_chunk writer TDR;
+ Chunk.write_dynarray writer.chunk items (fun td ->
+ let m = td.t_module in
+ write_full_path writer (fst m.m_path) (snd m.m_path) (snd td.t_path);
+ )
+ end;
+
+ start_chunk writer MDF;
+ write_path writer m.m_path;
+ Chunk.write_string writer.chunk (Path.UniqueKey.lazy_path m.m_extra.m_file);
+ Chunk.write_uleb128 writer.chunk (DynArray.length (Pool.finalize writer.anons));
+ Chunk.write_uleb128 writer.chunk (DynArray.length (IdentityPool.finalize writer.tmonos));
+
+ begin
+ let deps = DynArray.create () in
+ PMap.iter (fun _ mdep ->
+ match mdep.md_kind with
+ | MCode | MExtern when mdep.md_sign = m.m_extra.m_sign ->
+ DynArray.add deps mdep.md_path;
+ | _ ->
+ ()
+ ) m.m_extra.m_deps;
+ if DynArray.length deps > 0 then begin
+ start_chunk writer MDR;
+ Chunk.write_uleb128 writer.chunk (DynArray.length deps);
+ DynArray.iter (fun path ->
+ write_path writer path
+ ) deps
+ end
+ end;
+
+ start_chunk writer EOT;
+ start_chunk writer EOF;
+ start_chunk writer EOM;
+
+ let finalize_string_pool kind items length =
+ start_chunk writer kind;
+ Chunk.write_uleb128 writer.chunk length;
+ List.iter (fun s ->
+ let b = Bytes.unsafe_of_string s in
+ Chunk.write_bytes_length_prefixed writer.chunk b;
+ ) items
+ in
+ begin
+ let items,length = StringPool.finalize writer.cp in
+ finalize_string_pool STR items length
+ end;
+ begin
+ let items,length = StringPool.finalize writer.docs in
+ if length > 0 then
+ finalize_string_pool DOC items length
+ end
+
+ let get_sorted_chunks writer =
+ let l = DynArray.to_list writer.chunks in
+ let l = List.sort (fun chunk1 chunk2 ->
+ (Obj.magic chunk1.Chunk.kind - (Obj.magic chunk2.kind))
+ ) l in
+ l
+end
+
+let create config warn anon_id =
+ let cp = StringPool.create () in
+ {
+ config;
+ warn;
+ anon_id;
+ current_module = null_module;
+ chunks = DynArray.create ();
+ cp = cp;
+ docs = StringPool.create ();
+ chunk = Obj.magic ();
+ classes = Pool.create ();
+ enums = Pool.create ();
+ typedefs = Pool.create ();
+ abstracts = Pool.create ();
+ anons = Pool.create ();
+ anon_fields = HashedIdentityPool.create ();
+ tmonos = IdentityPool.create ();
+ own_classes = Pool.create ();
+ own_abstracts = Pool.create ();
+ own_enums = Pool.create ();
+ own_typedefs = Pool.create ();
+ type_param_lut = Pool.create ();
+ class_fields = HashedIdentityPool.create ();
+ enum_fields = Pool.create ();
+ type_type_parameters = Pool.create ();
+ field_type_parameters = IdentityPool.create ();
+ local_type_parameters = IdentityPool.create ();
+ field_stack = [];
+ unbound_ttp = IdentityPool.create ();
+ t_instance_chunk = Chunk.create EOM cp 32;
+ }
+
+let write_module writer m =
+ HxbWriter.write_module writer m
+
+let get_chunks writer =
+ List.map (fun chunk ->
+ (chunk.Chunk.kind,Chunk.get_bytes chunk)
+ ) (HxbWriter.get_sorted_chunks writer)
+
+let export : 'a . hxb_writer -> 'a IO.output -> unit = fun writer ch ->
+ write_header ch;
+ let l = HxbWriter.get_sorted_chunks writer in
+ List.iter (fun io ->
+ Chunk.export io ch
+ ) l
diff --git a/src/compiler/hxb/hxbWriterConfig.ml b/src/compiler/hxb/hxbWriterConfig.ml
new file mode 100644
index 00000000000..ee5932d9afc
--- /dev/null
+++ b/src/compiler/hxb/hxbWriterConfig.ml
@@ -0,0 +1,118 @@
+open Globals
+open Json.Reader
+
+type writer_target_config = {
+ mutable generate : bool;
+ mutable exclude : string list list;
+ mutable include' : string list list;
+ mutable hxb_version : int;
+ mutable generate_docs : bool;
+}
+
+type t = {
+ mutable archive_path : string;
+ target_config : writer_target_config;
+ macro_config : writer_target_config;
+}
+
+let create_target_config () = {
+ generate = true;
+ exclude = [];
+ include'= [];
+ hxb_version = HxbData.hxb_version;
+ generate_docs = true;
+}
+
+let create () = {
+ archive_path = "";
+ target_config = create_target_config ();
+ macro_config = create_target_config ()
+}
+let error s =
+ Error.raise_typing_error s null_pos
+
+module WriterConfigReader (API : DataReaderApi.DataReaderApi) = struct
+ let read_target_config config fl =
+ List.iter (fun (s,data) -> match s with
+ | "generate" ->
+ config.generate <- API.read_bool data;
+ | "exclude" ->
+ API.read_optional data (fun data ->
+ let l = API.read_array data in
+ config.exclude <- List.map (fun data -> ExtString.String.nsplit (API.read_string data) ".") l
+ )
+ | "include" ->
+ API.read_optional data (fun data ->
+ let l = API.read_array data in
+ config.include'<- List.map (fun data -> ExtString.String.nsplit (API.read_string data) ".") l
+ )
+ | "hxbVersion" ->
+ config.hxb_version <- API.read_int data
+ | "generateDocumentation" ->
+ config.generate_docs <- API.read_bool data
+ | s ->
+ error (Printf.sprintf "Unknown key for target config: %s" s)
+ ) fl
+
+ let read_writer_config config data =
+ let read data =
+ let fl = API.read_object data in
+ List.iter (fun (s,data) ->
+ match s with
+ | "archivePath" ->
+ config.archive_path <- API.read_string data;
+ | "targetConfig" ->
+ API.read_optional data (fun data -> read_target_config config.target_config (API.read_object data))
+ | "macroConfig" ->
+ API.read_optional data (fun data -> read_target_config config.macro_config (API.read_object data))
+ | s ->
+ error (Printf.sprintf "Unknown key for writer config: %s" s)
+ ) fl
+ in
+ API.read_optional data read
+end
+
+module WriterConfigReaderJson = WriterConfigReader(JsonDataApi.JsonReaderApi)
+
+module WriterConfigWriter (API : DataWriterApi.DataWriterApi) = struct
+ let write_target_config config =
+ API.write_object [
+ "generate",API.write_bool config.generate;
+ "exclude",API.write_array (List.map (fun sl -> API.write_string (String.concat "." sl)) config.exclude);
+ "include",API.write_array (List.map (fun sl -> API.write_string (String.concat "." sl)) config.include');
+ "hxbVersion",API.write_int config.hxb_version;
+ "generateDocumentation",API.write_bool config.generate_docs;
+ ]
+
+ let write_writer_config config =
+ API.write_object [
+ "archivePath",API.write_string config.archive_path;
+ "targetConfig",write_target_config config.target_config;
+ "macroConfig",write_target_config config.macro_config;
+ ]
+end
+
+let process_json config json =
+ WriterConfigReaderJson.read_writer_config config json
+
+let parse config input =
+ let lexbuf = Sedlexing.Utf8.from_string input in
+ let json = read_json lexbuf in
+ process_json config json
+
+let process_argument file =
+ let config = create () in
+ begin match Path.file_extension file with
+ | "json" ->
+ let file = try
+ open_in file
+ with exc ->
+ error (Printf.sprintf "Could not open file %s: %s" file (Printexc.to_string exc))
+ in
+ let data = Std.input_all file in
+ close_in file;
+ parse config data;
+ | _ ->
+ config.archive_path <- file;
+ end;
+ Some config
\ No newline at end of file
diff --git a/src/compiler/messageReporting.ml b/src/compiler/messageReporting.ml
index 8bd6e986367..d12d8d01232 100644
--- a/src/compiler/messageReporting.ml
+++ b/src/compiler/messageReporting.ml
@@ -54,13 +54,13 @@ let resolve_source file l1 p1 l2 p2 =
List.rev !lines
let resolve_file ctx f =
- let ext = Common.extension f in
- let second_ext = Common.extension (Common.remove_extension f) in
- let platform_ext = "." ^ (platform_name_macro ctx) in
- if platform_ext = second_ext then
- (Common.remove_extension (Common.remove_extension f)) ^ ext
- else
- f
+ let ext = StringHelper.extension f in
+ let second_ext = StringHelper.extension (StringHelper.remove_extension f) in
+ let platform_ext = "." ^ (platform_name_macro ctx) in
+ if platform_ext = second_ext then
+ (StringHelper.remove_extension (StringHelper.remove_extension f)) ^ ext
+ else
+ f
let error_printer file line = Printf.sprintf "%s:%d:" file line
@@ -183,6 +183,7 @@ let compiler_pretty_message_string com ectx cm =
(* Error source *)
if display_source then out := List.fold_left (fun out (l, line) ->
let nb_len = String.length (string_of_int l) in
+ let gutter = gutter_len - nb_len - 1 in
(* Replace tabs with 1 space to avoid column misalignments *)
let line = String.concat " " (ExtString.String.nsplit line "\t") in
@@ -190,7 +191,7 @@ let compiler_pretty_message_string com ectx cm =
out ^ Printf.sprintf "%s%s | %s\n"
(* left-padded line number *)
- (String.make (gutter_len-nb_len-1) ' ')
+ (if gutter < 1 then "" else String.make gutter ' ')
(if l = 0 then "-" else Printf.sprintf "%d" l)
(* Source code at that line *)
(
@@ -308,6 +309,15 @@ let get_max_line max_lines messages =
else max_lines
) max_lines messages
+let display_source_at com p =
+ let absolute_positions = Define.defined com.defines Define.MessageAbsolutePositions in
+ let ectx = create_error_context absolute_positions in
+ let msg = make_compiler_message "" p 0 MessageKind.DKCompilerMessage MessageSeverity.Information in
+ ectx.max_lines <- get_max_line ectx.max_lines [msg];
+ match compiler_pretty_message_string com ectx msg with
+ | None -> ()
+ | Some s -> prerr_endline s
+
exception ConfigError of string
let get_formatter com def default =
diff --git a/src/compiler/retyper.ml b/src/compiler/retyper.ml
deleted file mode 100644
index e5f313e98b6..00000000000
--- a/src/compiler/retyper.ml
+++ /dev/null
@@ -1,277 +0,0 @@
-open Globals
-open Ast
-open Typecore
-open Type
-open TypeloadModule
-open TypeloadFields
-
-exception Fail of string
-
-type retyping_context = {
- typer : typer;
- print_stack : string list;
-}
-
-let fail rctx s =
- let stack = String.concat " " (List.rev rctx.print_stack) in
- raise (Fail (Printf.sprintf "%s: %s" stack s))
-
-let disable_typeloading rctx ctx f =
- let old = ctx.g.load_only_cached_modules in
- ctx.g.load_only_cached_modules <- true;
- try
- Std.finally (fun () -> ctx.g.load_only_cached_modules <- old) f ()
- with (Error.Error { err_message = Module_not_found path }) ->
- fail rctx (Printf.sprintf "Could not load [Module %s]" (s_type_path path))
-
-let pair_type th t = match th with
- | None ->
- TExprToExpr.convert_type t,null_pos
- | Some t ->
- t
-
-let pair_class_field rctx ctx cctx fctx cf cff p =
- match cff.cff_kind with
- | FFun fd ->
- let targs,tret = match follow cf.cf_type with
- | TFun(args,ret) ->
- args,ret
- | _ ->
- fail rctx "Type change"
- in
- let args = try
- List.map2 (fun (name,opt,meta,th,eo) (_,_,t) ->
- (name,opt,meta,Some (pair_type th t),eo)
- ) fd.f_args targs
- with Invalid_argument _ ->
- fail rctx "Type change"
- in
- let ret = pair_type fd.f_type tret in
- let fd = {
- fd with
- f_args = args;
- f_type = Some ret
- } in
- let load_args_ret () =
- setup_args_ret ctx cctx fctx (fst cff.cff_name) fd p
- in
- let args,ret = disable_typeloading rctx ctx load_args_ret in
- let t = TFun(args#for_type,ret) in
- (fun () ->
- (* This is the only part that should actually modify anything. *)
- cf.cf_type <- t;
- TypeBinding.bind_method ctx cctx fctx cf t args ret fd.f_expr (match fd.f_expr with Some e -> snd e | None -> cff.cff_pos);
- if ctx.com.display.dms_full_typing then
- remove_class_field_flag cf CfPostProcessed;
- )
- | FVar(th,eo) | FProp(_,_,th,eo) ->
- let th = Some (pair_type th cf.cf_type) in
- let t = disable_typeloading rctx ctx (fun () -> load_variable_type_hint ctx fctx eo (pos cff.cff_name) th) in
- (fun () ->
- cf.cf_type <- t;
- TypeBinding.bind_var ctx cctx fctx cf eo;
- if ctx.com.display.dms_full_typing then
- remove_class_field_flag cf CfPostProcessed;
- )
-
-let pair_classes rctx c d p =
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Class %s]" (s_type_path c.cl_path)) :: rctx.print_stack
- } in
- c.cl_restore();
- (* TODO: What do we do with build macros? *)
- let cctx = create_class_context c p in
- let ctx = create_typer_context_for_class rctx.typer cctx p in
- let _ =
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Relations]") :: rctx.print_stack
- } in
- let has_extends = ref false in
- let implements = ref c.cl_implements in
- List.iter (function
- | HExtends ptp ->
- has_extends := true;
- begin match c.cl_super with
- | None ->
- fail rctx (Printf.sprintf "parent %s appeared" (Ast.Printer.s_complex_type_path "" ptp))
- | Some(c,tl) ->
- let th = pair_type (Some(CTPath ptp,ptp.pos_full)) (TInst(c,tl)) in
- ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false th))
- end
- | HImplements ptp ->
- begin match !implements with
- | (c,tl) :: rest ->
- (* TODO: I think this should somehow check if it's actually the same interface. There could be cases
- where the order changes or something like that... Maybe we can compare the loaded type.
- However, this doesn't matter until we start retyping invalidated modules.
- *)
- implements := rest;
- let th = pair_type (Some(CTPath ptp,ptp.pos_full)) (TInst(c,tl)) in
- ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false th));
- | [] ->
- fail rctx (Printf.sprintf "interface %s appeared" (Ast.Printer.s_complex_type_path "" ptp))
- end
- | _ ->
- ()
- ) d.d_flags;
- (* TODO: There are probably cases where the compiler generates a cl_super even though it's not in syntax *)
- if not !has_extends then begin match c.cl_super with
- | None -> ()
- | Some(c,_) -> fail rctx (Printf.sprintf "parent %s disappeared" (s_type_path c.cl_path))
- end;
- begin match !implements with
- | (c,_) :: _ -> fail rctx (Printf.sprintf "interface %s disappeared" (s_type_path c.cl_path))
- | [] -> ()
- end
- in
- let fl = List.map (fun cff ->
- let name = fst cff.cff_name in
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Field %s]" name) :: rctx.print_stack
- } in
- let display_modifier = Typeload.check_field_access ctx cff in
- let fctx = create_field_context ctx cctx cff ctx.is_display_file display_modifier in
- let cf = match fctx.field_kind with
- | FKConstructor ->
- begin match c.cl_constructor with
- | None ->
- fail rctx "Constructor not found"
- | Some cf ->
- cf
- end
- | FKNormal ->
- begin try
- PMap.find name (if fctx.is_static then c.cl_statics else c.cl_fields)
- with Not_found ->
- fail rctx "Field not found"
- end
- | FKInit ->
- fail rctx "TODO"
- in
- pair_class_field rctx ctx cctx fctx cf cff p
- ) d.d_data in
- fl @ [fun () -> TypeloadFields.finalize_class ctx cctx]
-
-let pair_enums ctx rctx en d =
- let ctx = { ctx with type_params = en.e_params } in
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Enum %s]" (s_type_path en.e_path)) :: rctx.print_stack
- } in
- List.iter (fun eff ->
- let name = fst eff.ec_name in
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Field %s]" name) :: rctx.print_stack
- } in
- let ef = try
- PMap.find name en.e_constrs
- with Not_found ->
- fail rctx "Field not found"
- in
- let th = pair_type eff.ec_type ef.ef_type in
- ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false th))
- ) d.d_data;
- []
-
-let pair_typedefs ctx rctx td d =
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Typedef %s]" (s_type_path td.t_path)) :: rctx.print_stack
- } in
- let ctx = { ctx with type_params = td.t_params } in
- ignore (disable_typeloading rctx ctx (fun () -> Typeload.load_complex_type ctx false d.d_data));
- []
-
-let pair_abstracts ctx rctx a d p =
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Abstract %s]" (s_type_path a.a_path)) :: rctx.print_stack
- } in
- match a.a_impl with
- | Some c ->
- c.cl_restore();
- let cctx = create_class_context c p in
- let ctx = create_typer_context_for_class rctx.typer cctx p in
- let fl = List.map (fun cff ->
- let cff = TypeloadFields.transform_abstract_field2 ctx a cff in
- let name = fst cff.cff_name in
- let rctx = {rctx with
- print_stack = (Printf.sprintf "[Field %s]" name) :: rctx.print_stack
- } in
- let display_modifier = Typeload.check_field_access ctx cff in
- let fctx = create_field_context ctx cctx cff ctx.is_display_file display_modifier in
- let cf = try
- PMap.find name c.cl_statics
- with Not_found ->
- fail rctx "Field not found"
- in
- pair_class_field rctx ctx cctx fctx cf cff p
- ) d.d_data in
- fl @ [fun () -> TypeloadFields.finalize_class ctx cctx]
- | None ->
- (* ?*)
- []
-
-let attempt_retyping ctx m p =
- let com = ctx.com in
- let file,_,_,decls = TypeloadParse.parse_module' com m.m_path p in
- let ctx = create_typer_context_for_module ctx m in
- let rctx = {
- typer = ctx;
- print_stack = [Printf.sprintf "[Module %s]" (s_type_path m.m_path)];
- } in
- (* log rctx 0 (Printf.sprintf "Retyping module %s" (s_type_path m.m_path)); *)
- let find_type name = try
- List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types
- with Not_found ->
- fail rctx (Printf.sprintf "Type %s not found" name)
- in
- let rec loop acc decls = match decls with
- | [] ->
- List.rev acc
- | (d,p) :: decls ->
- begin match d with
- | EImport (path,mode) ->
- ImportHandling.init_import ctx path mode p;
- ImportHandling.commit_import ctx path mode p;
- loop acc decls
- | EUsing path ->
- ImportHandling.init_using ctx path p;
- loop acc decls
- | EClass c ->
- let mt = find_type (fst c.d_name) in
- loop ((d,mt) :: acc) decls
- | EEnum en ->
- let mt = find_type (fst en.d_name) in
- loop ((d,mt) :: acc) decls
- | ETypedef td ->
- let mt = find_type (fst td.d_name) in
- loop ((d,mt) :: acc) decls
- | EAbstract a ->
- let mt = find_type (fst a.d_name) in
- loop ((d,mt) :: acc) decls
- | _ ->
- loop acc decls
- end;
- in
- try
- m.m_extra.m_cache_state <- MSUnknown;
- let pairs = loop [] decls in
- let fl = List.map (fun (d,mt) -> match d,mt with
- | EClass d,TClassDecl c ->
- pair_classes rctx c d p
- | EEnum d,TEnumDecl en ->
- pair_enums ctx rctx en d
- | ETypedef d,TTypeDecl td ->
- pair_typedefs ctx rctx td d
- | EAbstract d,TAbstractDecl a ->
- pair_abstracts ctx rctx a d p
- | _ ->
- fail rctx "?"
- ) pairs in
- (* If we get here we know that the everything is ok. *)
- List.iter (fun fl ->
- List.iter (fun f -> f()) fl
- ) fl;
- m.m_extra.m_cache_state <- MSGood;
- m.m_extra.m_time <- Common.file_time file;
- None
- with Fail s ->
- Some s
diff --git a/src/compiler/server.ml b/src/compiler/server.ml
index ac6fc9aca88..e664d8691a7 100644
--- a/src/compiler/server.ml
+++ b/src/compiler/server.ml
@@ -3,11 +3,13 @@ open Common
open CompilationCache
open Timer
open Type
+open Typecore
open DisplayProcessingGlobals
open Ipaddr
open Json
open CompilationContext
open MessageReporting
+open HxbData
exception Dirty of module_skip_reason
exception ServerError of string
@@ -41,9 +43,10 @@ let check_display_flush ctx f_otherwise = match ctx.com.json_out with
let current_stdin = ref None
-let parse_file cs com file p =
+let parse_file cs com (rfile : ClassPaths.resolved_file) p =
let cc = CommonCache.get_cache com in
- let ffile = Path.get_full_path file
+ let file = rfile.file in
+ let ffile = Path.get_full_path rfile.file
and fkey = com.file_keys#get file in
let is_display_file = DisplayPosition.display_position#is_in_file (com.file_keys#get ffile) in
match is_display_file, !current_stdin with
@@ -57,7 +60,7 @@ let parse_file cs com file p =
if cfile.c_time <> ftime then raise Not_found;
Parser.ParseSuccess((cfile.c_package,cfile.c_decls),false,cfile.c_pdi)
with Not_found ->
- let parse_result = TypeloadParse.parse_file com file p in
+ let parse_result = TypeloadParse.parse_file com rfile p in
let info,is_unusual = match parse_result with
| ParseError(_,_,_) -> "not cached, has parse error",true
| ParseSuccess(data,is_display_file,pdi) ->
@@ -65,7 +68,7 @@ let parse_file cs com file p =
if pdi.pd_errors <> [] then
"not cached, is display file with parse errors",true
else if com.display.dms_per_file then begin
- cc#cache_file fkey ffile ftime data pdi;
+ cc#cache_file fkey rfile ftime data pdi;
"cached, is intact display file",true
end else
"not cached, is display file",true
@@ -76,7 +79,7 @@ let parse_file cs com file p =
let ident = Hashtbl.find Parser.special_identifier_files fkey in
Printf.sprintf "not cached, using \"%s\" define" ident,true
with Not_found ->
- cc#cache_file fkey ffile ftime data pdi;
+ cc#cache_file fkey (ClassPaths.create_resolved_file ffile rfile.class_path) ftime data pdi;
"cached",false
end
in
@@ -124,7 +127,7 @@ module Communication = struct
let create_pipe sctx write =
let rec self = {
write_out = (fun s ->
- write ("\x01" ^ String.concat "\n\x01" (ExtString.String.nsplit s "\n") ^ "\n")
+ write ("\x01" ^ String.concat "\x01" (ExtString.String.nsplit s "\n") ^ "\n")
);
write_err = (fun s ->
write s
@@ -208,8 +211,9 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
with Unix.Unix_error _ ->
()
in
- List.iter add_dir com.class_path;
- List.iter add_dir (Path.find_directories (platform_name com.platform) true com.class_path);
+ let class_path_strings = com.class_paths#as_string_list in
+ List.iter add_dir class_path_strings;
+ List.iter add_dir (Path.find_directories (platform_name com.platform) true class_path_strings);
ServerMessage.found_directories com "" !dirs;
cs#add_directories sign !dirs
) :: sctx.delays;
@@ -225,27 +229,27 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
(* Checks if module [m] can be reused from the cache and returns None in that case. Otherwise, returns
[Some m'] where [m'] is the module responsible for [m] not being reusable. *)
-let check_module sctx ctx m p =
+let check_module sctx ctx m_path m_extra p =
let com = ctx.Typecore.com in
let cc = CommonCache.get_cache com in
- let content_changed m file =
+ let content_changed m_path file =
let fkey = ctx.com.file_keys#get file in
try
let cfile = cc#find_file fkey in
(* We must use the module path here because the file path is absolute and would cause
positions in the parsed declarations to differ. *)
- let new_data = TypeloadParse.parse_module ctx m.m_path p in
+ let new_data = TypeloadParse.parse_module ctx m_path p in
cfile.c_decls <> snd new_data
with Not_found ->
true
in
- let check_module_shadowing paths m =
+ let check_module_shadowing paths m_path m_extra =
List.iter (fun dir ->
- let file = (dir.c_path ^ (snd m.m_path)) ^ ".hx" in
+ let file = (dir.c_path ^ (snd m_path)) ^ ".hx" in
if Sys.file_exists file then begin
let time = file_time file in
- if time > m.m_extra.m_time then begin
- ServerMessage.module_path_changed com "" (m,time,file);
+ if time > m_extra.m_time then begin
+ ServerMessage.module_path_changed com "" (m_path,m_extra,time,file);
raise (Dirty (Shadowed file))
end
end
@@ -253,33 +257,33 @@ let check_module sctx ctx m p =
in
let start_mark = sctx.compilation_step in
let unknown_state_modules = ref [] in
- let rec check m =
+ let rec check m_path m_extra =
let check_module_path () =
let directories = get_changed_directories sctx ctx in
- match m.m_extra.m_kind with
+ match m_extra.m_kind with
| MFake | MImport -> () (* don't get classpath *)
| MExtern ->
(* if we have a file then this will override our extern type *)
- check_module_shadowing directories m;
+ check_module_shadowing directories m_path m_extra;
let rec loop = function
| [] ->
- if sctx.verbose then print_endline ("No library file was found for " ^ s_type_path m.m_path); (* TODO *)
+ if sctx.verbose then print_endline ("No library file was found for " ^ s_type_path m_path); (* TODO *)
raise (Dirty LibraryChanged)
| (file,load) :: l ->
- match load m.m_path p with
+ match load m_path p with
| None ->
loop l
| Some _ ->
- if com.file_keys#get file <> (Path.UniqueKey.lazy_key m.m_extra.m_file) then begin
- if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path); (* TODO *)
+ if com.file_keys#get file <> (Path.UniqueKey.lazy_key m_extra.m_file) then begin
+ if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m_path); (* TODO *)
raise (Dirty LibraryChanged)
end
in
loop com.load_extern_type
| MCode ->
- check_module_shadowing directories m
+ check_module_shadowing directories m_path m_extra
| MMacro when com.is_macro_context ->
- check_module_shadowing directories m
+ check_module_shadowing directories m_path m_extra
| MMacro ->
(*
Creating another context while the previous one is incomplete means we have an infinite loop in the compiler.
@@ -292,36 +296,45 @@ let check_module sctx ctx m p =
^ "Probably caused by shadowing a module of the standard library. "
^ "Make sure shadowed module does not pull macro context."));
let mctx = MacroContext.get_macro_context ctx in
- check_module_shadowing (get_changed_directories sctx mctx) m
+ check_module_shadowing (get_changed_directories sctx mctx) m_path m_extra
in
- let has_policy policy = List.mem policy m.m_extra.m_check_policy || match policy with
+ let has_policy policy = List.mem policy m_extra.m_check_policy || match policy with
| NoCheckShadowing | NoCheckFileTimeModification when !ServerConfig.do_not_check_modules && !Parser.display_mode <> DMNone -> true
| _ -> false
in
let check_file () =
- let file = Path.UniqueKey.lazy_path m.m_extra.m_file in
- if file_time file <> m.m_extra.m_time then begin
- if has_policy CheckFileContentModification && not (content_changed m file) then begin
+ let file = Path.UniqueKey.lazy_path m_extra.m_file in
+ if file_time file <> m_extra.m_time then begin
+ if has_policy CheckFileContentModification && not (content_changed m_path file) then begin
ServerMessage.unchanged_content com "" file;
end else begin
- ServerMessage.not_cached com "" m;
- if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m.m_extra.m_file);
+ ServerMessage.not_cached com "" m_path;
+ if m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m_extra.m_file);
raise (Dirty (FileChanged file))
end
end
in
+ let find_module_extra sign mpath =
+ (com.cs#get_context sign)#find_module_extra mpath
+ in
let check_dependencies () =
- PMap.iter (fun _ (sign,mpath) ->
- let m2 = (com.cs#get_context sign)#find_module mpath in
- match check m2 with
+ PMap.iter (fun _ mdep ->
+ let sign = mdep.md_sign in
+ let mpath = mdep.md_path in
+ let m2_extra = try
+ find_module_extra sign mpath
+ with Not_found ->
+ die (Printf.sprintf "Could not find dependency %s of %s in the cache" (s_type_path mpath) (s_type_path m_path)) __LOC__;
+ in
+ match check mpath m2_extra with
| None -> ()
- | Some reason -> raise (Dirty (DependencyDirty(m2.m_path,reason)))
- ) m.m_extra.m_deps;
+ | Some reason -> raise (Dirty (DependencyDirty(mpath,reason)))
+ ) m_extra.m_deps;
in
let check () =
try
if not (has_policy NoCheckShadowing) then check_module_path();
- if not (has_policy NoCheckFileTimeModification) || Path.file_extension (Path.UniqueKey.lazy_path m.m_extra.m_file) <> "hx" then check_file();
+ if not (has_policy NoCheckFileTimeModification) || Path.file_extension (Path.UniqueKey.lazy_path m_extra.m_file) <> "hx" then check_file();
if not (has_policy NoCheckDependencies) then check_dependencies();
None
with
@@ -329,15 +342,15 @@ let check_module sctx ctx m p =
Some reason
in
(* If the module mark matches our compilation mark, we are done *)
- if m.m_extra.m_checked = start_mark then begin match m.m_extra.m_cache_state with
+ if m_extra.m_checked = start_mark then begin match m_extra.m_cache_state with
| MSGood | MSUnknown ->
None
| MSBad reason ->
Some reason
end else begin
(* Otherwise, set to current compilation mark for recursion *)
- m.m_extra.m_checked <- start_mark;
- let dirty = match m.m_extra.m_cache_state with
+ m_extra.m_checked <- start_mark;
+ let dirty = match m_extra.m_cache_state with
| MSBad reason ->
(* If we are already dirty, stick to it. *)
Some reason
@@ -346,55 +359,110 @@ let check_module sctx ctx m p =
die "" __LOC__
| MSGood ->
(* Otherwise, run the checks *)
- m.m_extra.m_cache_state <- MSUnknown;
+ m_extra.m_cache_state <- MSUnknown;
check ()
in
- let dirty = match dirty with
- | Some (DependencyDirty _) when has_policy Retype ->
- let result = Retyper.attempt_retyping ctx m p in
- begin match result with
- | None ->
- ServerMessage.retyper_ok com "" m;
- None
- | Some reason ->
- ServerMessage.retyper_fail com "" m reason;
- dirty
- end
- | _ ->
- dirty
- in
(* Update the module now. It will use this dirty status for the remainder of this compilation. *)
begin match dirty with
| Some reason ->
(* Update the state if we're dirty. *)
- m.m_extra.m_cache_state <- MSBad reason;
+ m_extra.m_cache_state <- MSBad reason;
| None ->
(* We cannot update if we're clean because at this point it might just be an assumption.
Instead We add the module to a list which is updated at the end of handling this subgraph. *)
- unknown_state_modules := m :: !unknown_state_modules;
+ unknown_state_modules := m_extra :: !unknown_state_modules;
end;
dirty
end
in
- let state = check m in
+ let state = check m_path m_extra in
begin match state with
| None ->
(* If the entire subgraph is clean, we can set all modules to good state *)
- List.iter (fun m -> m.m_extra.m_cache_state <- MSGood) !unknown_state_modules;
+ List.iter (fun m_extra -> m_extra.m_cache_state <- MSGood) !unknown_state_modules;
| Some _ ->
(* Otherwise, unknown state module may or may not be dirty. We didn't check everything eagerly, so we have
to make sure that the module is checked again if it appears in a different check. This is achieved by
setting m_checked to a lower value and assuming Good state again. *)
- List.iter (fun m -> match m.m_extra.m_cache_state with
+ List.iter (fun m_extra -> match m_extra.m_cache_state with
| MSUnknown ->
- m.m_extra.m_checked <- start_mark - 1;
- m.m_extra.m_cache_state <- MSGood;
+ m_extra.m_checked <- start_mark - 1;
+ m_extra.m_cache_state <- MSGood;
| MSGood | MSBad _ ->
()
) !unknown_state_modules
end;
state
+class hxb_reader_api_server
+ (ctx : Typecore.typer)
+ (cc : context_cache)
+= object(self)
+
+ method make_module (path : path) (file : string) =
+ let mc = cc#get_hxb_module path in
+ {
+ m_id = mc.mc_id;
+ m_path = path;
+ m_types = [];
+ m_statics = None;
+ m_extra = mc.mc_extra
+ }
+
+ method add_module (m : module_def) =
+ ctx.com.module_lut#add m.m_path m
+
+ method resolve_type (pack : string list) (mname : string) (tname : string) =
+ let path = (pack,mname) in
+ let m = self#resolve_module path in
+ List.find (fun t -> snd (t_path t) = tname) m.m_types
+
+ method resolve_module (path : path) =
+ match self#find_module path with
+ | GoodModule m ->
+ m
+ | BinaryModule mc ->
+ let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats in
+ let f_next chunks until =
+ let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in
+ let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until in
+ t_hxb();
+ r
+ in
+ let m,chunks = f_next mc.mc_chunks EOF in
+
+ (* We try to avoid reading expressions as much as possible, so we only do this for
+ our current display file if we're in display mode. *)
+ let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file) in
+ if is_display_file || ctx.com.display.dms_full_typing then ignore(f_next chunks EOM);
+ m
+ | BadModule reason ->
+ die (Printf.sprintf "Unexpected BadModule %s" (s_type_path path)) __LOC__
+ | NoModule ->
+ die (Printf.sprintf "Unexpected NoModule %s" (s_type_path path)) __LOC__
+
+ method find_module (m_path : path) =
+ try
+ GoodModule (ctx.com.module_lut#find m_path)
+ with Not_found -> try
+ let mc = cc#get_hxb_module m_path in
+ begin match mc.mc_extra.m_cache_state with
+ | MSBad reason -> BadModule reason
+ | _ -> BinaryModule mc
+ end
+ with Not_found ->
+ NoModule
+
+ method basic_types =
+ ctx.com.basic
+
+ method get_var_id (i : int) =
+ i
+
+ method read_expression_eagerly (cf : tclass_field) =
+ ctx.com.display.dms_full_typing
+end
+
let handle_cache_bound_objects com cbol =
DynArray.iter (function
| Resource(name,data) ->
@@ -407,25 +475,44 @@ let handle_cache_bound_objects com cbol =
(* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation
context. *)
-let add_modules sctx ctx m p =
+let rec add_modules sctx ctx (m : module_def) (from_binary : bool) (p : pos) =
let com = ctx.Typecore.com in
+ let own_sign = CommonCache.get_cache_sign com in
let rec add_modules tabs m0 m =
if m.m_extra.m_added < ctx.com.compilation_step then begin
+ m.m_extra.m_added <- ctx.com.compilation_step;
(match m0.m_extra.m_kind, m.m_extra.m_kind with
| MCode, MMacro | MMacro, MCode ->
(* this was just a dependency to check : do not add to the context *)
handle_cache_bound_objects com m.m_extra.m_cache_bound_objects;
| _ ->
- m.m_extra.m_added <- ctx.com.compilation_step;
ServerMessage.reusing com tabs m;
List.iter (fun t ->
(t_infos t).mt_restore()
) m.m_types;
- TypeloadModule.ModuleLevel.add_module ctx m p;
+ (* The main module gets added when reading hxb already, so let's not add it again. Note that we
+ can't set its m_added ahead of time because we want the rest of the logic here to run. *)
+ if not from_binary || m != m then
+ com.module_lut#add m.m_path m;
handle_cache_bound_objects com m.m_extra.m_cache_bound_objects;
- PMap.iter (fun _ (sign,mpath) ->
- let m2 = (com.cs#get_context sign)#find_module mpath in
- add_modules (tabs ^ " ") m0 m2
+ PMap.iter (fun _ mdep ->
+ let mpath = mdep.md_path in
+ if mdep.md_sign = own_sign then begin
+ let m2 = try
+ com.module_lut#find mpath
+ with Not_found ->
+ match type_module sctx ctx mpath p with
+ | GoodModule m ->
+ m
+ | BinaryModule mc ->
+ failwith (Printf.sprintf "Unexpectedly found unresolved binary module %s as a dependency of %s" (s_type_path mpath) (s_type_path m0.m_path))
+ | NoModule ->
+ failwith (Printf.sprintf "Unexpectedly could not find module %s as a dependency of %s" (s_type_path mpath) (s_type_path m0.m_path))
+ | BadModule reason ->
+ failwith (Printf.sprintf "Unexpected bad module %s (%s) as a dependency of %s" (s_type_path mpath) (Printer.s_module_skip_reason reason) (s_type_path m0.m_path))
+ in
+ add_modules (tabs ^ " ") m0 m2
+ end
) m.m_extra.m_deps
)
end
@@ -434,29 +521,83 @@ let add_modules sctx ctx m p =
(* Looks up the module referred to by [mpath] in the cache. If it exists, a check is made to
determine if it's still valid. If this function returns None, the module is re-typed. *)
-let type_module sctx (ctx:Typecore.typer) mpath p =
+and type_module sctx (ctx:Typecore.typer) mpath p =
let t = Timer.timer ["server";"module cache"] in
let com = ctx.Typecore.com in
let cc = CommonCache.get_cache com in
- try
- let m = cc#find_module mpath in
- let tcheck = Timer.timer ["server";"module cache";"check"] in
- begin match check_module sctx ctx m p with
- | None -> ()
- | Some reason ->
- ServerMessage.skipping_dep com "" (m,(Printer.s_module_skip_reason reason));
- tcheck();
- raise Not_found;
- end;
- tcheck();
+ let skip m_path reason =
+ ServerMessage.skipping_dep com "" (m_path,(Printer.s_module_skip_reason reason));
+ BadModule reason
+ in
+ let add_modules from_binary m =
let tadd = Timer.timer ["server";"module cache";"add modules"] in
- add_modules sctx ctx m p;
+ add_modules sctx ctx m from_binary p;
tadd();
- t();
- Some m
- with Not_found ->
- t();
- None
+ GoodModule m
+ in
+ let check_module sctx ctx m_path m_extra p =
+ let tcheck = Timer.timer ["server";"module cache";"check"] in
+ let r = check_module sctx ctx mpath m_extra p in
+ tcheck();
+ r
+ in
+ let find_module_in_cache ctx cc m_path p =
+ try
+ let m = cc#find_module m_path in
+ begin match m.m_extra.m_cache_state with
+ | MSBad reason -> BadModule reason
+ | _ -> GoodModule m
+ end;
+ with Not_found -> try
+ let mc = cc#get_hxb_module m_path in
+ begin match mc.mc_extra.m_cache_state with
+ | MSBad reason -> BadModule reason
+ | _ -> BinaryModule mc
+ end
+ with Not_found ->
+ NoModule
+ in
+ (* Should not raise anything! *)
+ let m = match find_module_in_cache ctx cc mpath p with
+ | GoodModule m ->
+ (* "Good" here is an assumption, it only means that the module wasn't explicitly invalidated
+ in the cache. The true cache state will be known after check_module. *)
+ begin match check_module sctx ctx mpath m.m_extra p with
+ | None ->
+ add_modules false m;
+ | Some reason ->
+ skip m.m_path reason
+ end
+ | BinaryModule mc ->
+ (* Similarly, we only know that a binary module wasn't explicitly tainted. Decode it only after
+ checking dependencies. This means that the actual decoding never has any reason to fail. *)
+ begin match check_module sctx ctx mpath mc.mc_extra p with
+ | None ->
+ let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats in
+ let api = (new hxb_reader_api_server ctx cc :> HxbReaderApi.hxb_reader_api) in
+ let f_next chunks until =
+ let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in
+ let r = reader#read_chunks_until api chunks until in
+ t_hxb();
+ r
+ in
+ let m,chunks = f_next mc.mc_chunks EOF in
+ (* We try to avoid reading expressions as much as possible, so we only do this for
+ our current display file if we're in display mode. *)
+ let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file) in
+ if is_display_file || ctx.com.display.dms_full_typing then ignore(f_next chunks EOM);
+ add_modules true m;
+ | Some reason ->
+ skip mpath reason
+ end
+ | BadModule reason ->
+ (* A BadModule state here means that the module is already invalidated in the cache, e.g. from server/invalidate. *)
+ skip mpath reason
+ | NoModule as mr ->
+ mr
+ in
+ t();
+ m
let before_anything sctx ctx =
ensure_macro_setup sctx
@@ -468,21 +609,25 @@ let after_target_init sctx ctx =
ServerMessage.defines com "";
ServerMessage.signature com "" sign;
ServerMessage.display_position com "" (DisplayPosition.display_position#get);
+ let class_path_strings = com.class_paths#as_string_list in
try
- if (Hashtbl.find sctx.class_paths sign) <> com.class_path then begin
+ if (Hashtbl.find sctx.class_paths sign) <> class_path_strings then begin
ServerMessage.class_paths_changed com "";
- Hashtbl.replace sctx.class_paths sign com.class_path;
+ Hashtbl.replace sctx.class_paths sign class_path_strings;
cs#clear_directories sign;
(cs#get_context sign)#set_initialized false;
end;
with Not_found ->
- Hashtbl.add sctx.class_paths sign com.class_path;
+ Hashtbl.add sctx.class_paths sign class_path_strings;
()
-let after_compilation sctx ctx =
- if not (has_error ctx) then
+let after_save sctx ctx =
+ if ctx.comm.is_server && not (has_error ctx) then
maybe_cache_context sctx ctx.com
+let after_compilation sctx ctx =
+ ()
+
let mk_length_prefixed_communication allow_nonblock chin chout =
let sin = Unix.descr_of_in_channel chin in
let chin = IO.input_channel chin in
@@ -615,7 +760,6 @@ let do_connect ip port args =
let enable_cache_mode sctx =
TypeloadModule.type_module_hook := type_module sctx;
- MacroContext.macro_enable_cache := true;
ServerCompilationContext.ensure_macro_setup sctx;
TypeloadParse.parse_hook := parse_file sctx.cs
@@ -632,6 +776,7 @@ let rec process sctx comm args =
callbacks = {
before_anything = before_anything sctx;
after_target_init = after_target_init sctx;
+ after_save = after_save sctx;
after_compilation = after_compilation sctx;
};
init_wait_socket = init_wait_socket;
@@ -778,8 +923,19 @@ and init_wait_socket ip port =
end
in
let read = fun _ -> (let s = read_loop 0 in Unix.clear_nonblock sin; Some s) in
- let write s = ssend sin (Bytes.unsafe_of_string s) in
- let close() = Unix.close sin in
+ let closed = ref false in
+ let close() =
+ if not !closed then begin
+ try Unix.close sin with Unix.Unix_error _ -> trace "Error while closing socket.";
+ closed := true;
+ end
+ in
+ let write s =
+ if not !closed then
+ match Unix.getsockopt_error sin with
+ | Some _ -> close()
+ | None -> ssend sin (Bytes.unsafe_of_string s);
+ in
false, read, write, close
) in
accept
diff --git a/src/compiler/serverCompilationContext.ml b/src/compiler/serverCompilationContext.ml
index d0c87099acd..393d2fa2d84 100644
--- a/src/compiler/serverCompilationContext.ml
+++ b/src/compiler/serverCompilationContext.ml
@@ -1,4 +1,3 @@
-open Globals
open Common
open Timer
open CompilationCache
@@ -46,7 +45,6 @@ let reset sctx =
Hashtbl.clear sctx.changed_directories;
sctx.was_compilation <- false;
Parser.reset_state();
- return_partial_type := false;
measure_times := false;
Hashtbl.clear DeprecationCheck.warned_positions;
close_times();
@@ -59,7 +57,9 @@ let reset sctx =
let maybe_cache_context sctx com =
if com.display.dms_full_typing && com.display.dms_populate_cache then begin
+ let t = Timer.timer ["server";"cache context"] in
CommonCache.cache_context sctx.cs com;
+ t();
ServerMessage.cached_modules com "" (List.length com.modules);
end
diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml
index 18a3faeeefa..e82930c08bc 100644
--- a/src/compiler/serverMessage.ml
+++ b/src/compiler/serverMessage.ml
@@ -75,12 +75,12 @@ let found_directories com tabs dirs =
let changed_directories com tabs dirs =
if config.print_changed_directories then print_endline (Printf.sprintf "%schanged directories: [%s]" (sign_string com) (String.concat ", " (List.map (fun dir -> "\"" ^ dir.c_path ^ "\"") dirs)))
-let module_path_changed com tabs (m,time,file) =
+let module_path_changed com tabs (m_path,m_extra,time,file) =
if config.print_module_path_changed then print_endline (Printf.sprintf "%smodule path might have changed: %s\n\twas: %2.0f %s\n\tnow: %2.0f %s"
- (sign_string com) (s_type_path m.m_path) m.m_extra.m_time (Path.UniqueKey.lazy_path m.m_extra.m_file) time file)
+ (sign_string com) (s_type_path m_path) m_extra.m_time (Path.UniqueKey.lazy_path m_extra.m_file) time file)
-let not_cached com tabs m =
- if config.print_not_cached then print_endline (Printf.sprintf "%s%s not cached (%s)" (sign_string com) (s_type_path m.m_path) "modified")
+let not_cached com tabs m_path =
+ if config.print_not_cached then print_endline (Printf.sprintf "%s%s not cached (%s)" (sign_string com) (s_type_path m_path) "modified")
let parsed com tabs (ffile,info) =
if config.print_parsed then print_endline (Printf.sprintf "%sparsed %s (%s)" (sign_string com) ffile info)
@@ -100,8 +100,8 @@ let retyper_fail com tabs m reason =
print_endline (Printf.sprintf "%s%s%s" (sign_string com) (tabs ^ " ") reason);
end
-let skipping_dep com tabs (m,reason) =
- if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path m.m_path) reason)
+let skipping_dep com tabs (mpath,reason) =
+ if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path mpath) reason)
let unchanged_content com tabs file =
if config.print_unchanged_content then print_endline (Printf.sprintf "%s%s changed time not but content, reusing" (sign_string com) file)
diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml
index 52402ebf80d..45fd13b2de6 100644
--- a/src/context/abstractCast.ml
+++ b/src/context/abstractCast.ml
@@ -12,12 +12,12 @@ let rec make_static_call ctx c cf a pl args t p =
match args with
| [e] ->
let e,f = push_this ctx e in
- ctx.with_type_stack <- (WithType.with_type t) :: ctx.with_type_stack;
+ ctx.e.with_type_stack <- (WithType.with_type t) :: ctx.e.with_type_stack;
let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name [e] p with
| MSuccess e -> type_expr ctx e (WithType.with_type t)
| _ -> type_expr ctx (EConst (Ident "null"),p) WithType.value
in
- ctx.with_type_stack <- List.tl ctx.with_type_stack;
+ ctx.e.with_type_stack <- List.tl ctx.e.with_type_stack;
let e = try cast_or_unify_raise ctx t e p with Error { err_message = Unify _ } -> raise Not_found in
f();
e
@@ -40,7 +40,7 @@ and do_check_cast ctx uctx tleft eright p =
raise_error_msg (Unify l) eright.epos)
| _ -> ()
end;
- if cf == ctx.curfield || rec_stack_memq cf cast_stack then raise_typing_error "Recursive implicit cast" p;
+ if cf == ctx.f.curfield || rec_stack_memq cf cast_stack then raise_typing_error "Recursive implicit cast" p;
rec_stack_loop cast_stack cf f ()
in
let make (a,tl,(tcf,cf)) =
@@ -119,7 +119,7 @@ and cast_or_unify ctx tleft eright p =
eright
let prepare_array_access_field ctx a pl cf p =
- let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in
+ let monos = List.map (fun _ -> spawn_monomorph ctx.e p) cf.cf_params in
let map t = apply_params a.a_params pl (apply_params cf.cf_params monos t) in
let check_constraints () =
List.iter2 (fun m ttp -> match get_constraints ttp with
diff --git a/src/context/common.ml b/src/context/common.ml
index 6ef4eb14314..2ca0d16757d 100644
--- a/src/context/common.ml
+++ b/src/context/common.ml
@@ -27,7 +27,6 @@ open Warning
type package_rule =
| Forbidden
- | Directory of string
| Remap of string
type pos = Globals.pos
@@ -334,6 +333,18 @@ class module_lut = object(self)
method get_type_lut = type_lut
end
+class virtual abstract_hxb_lib = object(self)
+ method virtual load : unit
+ method virtual get_bytes : string -> path -> bytes option
+ method virtual close : unit
+ 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;
@@ -343,17 +354,16 @@ 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;
mutable foptimize : bool;
mutable platform : platform;
mutable config : platform_config;
- mutable std_path : string list;
- mutable class_path : string list;
- mutable main_class : path option;
+ empty_class_path : ClassPath.class_path;
+ class_paths : ClassPaths.class_paths;
+ main : context_main;
mutable package_rules : (string,package_rule) PMap.t;
mutable report_mode : report_mode;
(* communication *)
@@ -379,12 +389,10 @@ type context = {
mutable global_metadata : (string list * metadata_entry * (bool * bool * bool)) list;
shared : shared_context;
display_information : display_information;
- file_lookup_cache : (string,string option) lookup;
file_keys : file_keys;
mutable file_contents : (Path.UniqueKey.t * string option) list;
- readdir_cache : (string * string,(string array) option) lookup;
parser_cache : (string,(type_def * pos) list) lookup;
- module_to_file : (path,string) lookup;
+ module_to_file : (path,ClassPaths.resolved_file) lookup;
cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) lookup;
stored_typed_exprs : (int, texpr) lookup;
overload_cache : ((path * string),(Type.t * tclass_field) list) lookup;
@@ -396,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;
functional_interface_lut : (path,(tclass * tclass_field)) lookup;
@@ -405,6 +412,7 @@ type context = {
mutable neko_lib_paths : string list;
mutable include_files : (string * string) list;
mutable native_libs : native_libraries;
+ mutable hxb_libs : abstract_hxb_lib list;
mutable net_std : string list;
net_path_map : (path,string list * string list * string) Hashtbl.t;
mutable c_args : string list;
@@ -412,6 +420,8 @@ type context = {
(* misc *)
mutable basic : basic_types;
memory_marker : float array;
+ hxb_reader_stats : HxbReader.hxb_reader_stats;
+ mutable hxb_writer_config : HxbWriterConfig.t option;
}
let enter_stage com stage =
@@ -800,7 +810,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;
@@ -811,9 +820,12 @@ let create compilation_step cs version args display_mode =
print = (fun s -> print_string s; flush stdout);
run_command = Sys.command;
run_command_args = (fun s args -> com.run_command (Printf.sprintf "%s %s" s (String.concat " " args)));
- std_path = [];
- class_path = [];
- main_class = None;
+ empty_class_path = new ClassPath.directory_class_path "" User;
+ class_paths = new ClassPaths.class_paths;
+ main = {
+ main_class = None;
+ main_expr = None;
+ };
package_rules = PMap.empty;
file = "";
types = [];
@@ -822,11 +834,11 @@ 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 = [];
native_libs = create_native_libs();
+ hxb_libs = [];
net_path_map = Hashtbl.create 0;
c_args = [];
neko_lib_paths = [];
@@ -858,10 +870,8 @@ let create compilation_step cs version args display_mode =
tarray = (fun _ -> die "Could not locate class Array (was it redefined?)" __LOC__);
};
std = null_class;
- file_lookup_cache = new hashtbl_lookup;
file_keys = new file_keys;
file_contents = [];
- readdir_cache = new hashtbl_lookup;
module_to_file = new hashtbl_lookup;
stored_typed_exprs = new hashtbl_lookup;
cached_macros = new hashtbl_lookup;
@@ -873,6 +883,8 @@ let create compilation_step cs version args display_mode =
report_mode = RMNone;
is_macro_context = false;
functional_interface_lut = new Lookup.hashtbl_lookup;
+ hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
+ hxb_writer_config = None;
} in
com
@@ -880,6 +892,8 @@ let is_diagnostics com = match com.report_mode with
| RMLegacyDiagnostics _ | RMDiagnostics _ -> true
| _ -> false
+let is_compilation com = com.display.dms_kind = DMNone && not (is_diagnostics com)
+
let disable_report_mode com =
let old = com.report_mode in
com.report_mode <- RMNone;
@@ -893,12 +907,16 @@ let clone com is_macro_context =
{ com with
cache = None;
basic = { t with
+ tvoid = mk_mono();
tint = mk_mono();
tfloat = mk_mono();
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 = {
@@ -912,14 +930,15 @@ let clone com is_macro_context =
};
native_libs = create_native_libs();
is_macro_context = is_macro_context;
- file_lookup_cache = new hashtbl_lookup;
- readdir_cache = new hashtbl_lookup;
parser_cache = new hashtbl_lookup;
module_to_file = new hashtbl_lookup;
overload_cache = new hashtbl_lookup;
module_lut = new module_lut;
+ hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
std = null_class;
functional_interface_lut = new Lookup.hashtbl_lookup;
+ empty_class_path = new ClassPath.directory_class_path "" User;
+ class_paths = new ClassPaths.class_paths;
}
let file_time file = Extc.filetime file
@@ -1040,9 +1059,15 @@ let rec has_feature com f =
(match List.find (fun t -> t_path t = path && not (Meta.has Meta.RealPath (t_infos t).mt_meta)) com.types with
| t when field = "*" ->
not (has_dce com) ||
- (match t with TAbstractDecl a -> Meta.has Meta.ValueUsed a.a_meta | _ -> Meta.has Meta.Used (t_infos t).mt_meta)
+ begin match t with
+ | TClassDecl c ->
+ has_class_flag c CUsed;
+ | TAbstractDecl a ->
+ Meta.has Meta.ValueUsed a.a_meta
+ | _ -> Meta.has Meta.Used (t_infos t).mt_meta
+ end;
| TClassDecl c when (has_class_flag c CExtern) && (com.platform <> Js || cl <> "Array" && cl <> "Math") ->
- not (has_dce com) || Meta.has Meta.Used (try PMap.find field c.cl_statics with Not_found -> PMap.find field c.cl_fields).cf_meta
+ 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
| TClassDecl c ->
PMap.exists field c.cl_statics || PMap.exists field c.cl_fields
| _ ->
@@ -1065,104 +1090,8 @@ let platform_name_macro com =
if defined com Define.Macro then "macro"
else platform_name com.platform
-let remove_extension file =
- try String.sub file 0 (String.rindex file '.')
- with Not_found -> file
-
-let extension file =
- try
- let dot_pos = String.rindex file '.' in
- String.sub file dot_pos (String.length file - dot_pos)
- with Not_found -> file
-
-let cache_directory ctx class_path dir f_dir =
- let platform_ext = "." ^ (platform_name_macro ctx)
- and is_loading_core_api = defined ctx Define.CoreApi in
- let dir_listing =
- try Some (Sys.readdir dir);
- with Sys_error _ -> None
- in
- ctx.readdir_cache#add (class_path,dir) dir_listing;
- (*
- This function is invoked for each file in the `dir`.
- Each file is checked if it's specific for current platform
- (e.g. ends with `.js.hx` while compiling for JS).
- If it's not platform-specific:
- Check the lookup cache and if the file is not there store full file path in the cache.
- If the file is platform-specific:
- Store the full file path in the lookup cache probably replacing the cached path to a
- non-platform-specific file.
- *)
- let prepare_file file_own_name =
- let relative_to_classpath = if f_dir = "." then file_own_name else f_dir ^ "/" ^ file_own_name in
- (* `representation` is how the file is referenced to. E.g. when it's deduced from a module path. *)
- let is_platform_specific,representation =
- (* Platform specific file extensions are not allowed for loading @:coreApi types. *)
- if is_loading_core_api then
- false,relative_to_classpath
- else begin
- let ext = extension relative_to_classpath in
- let second_ext = extension (remove_extension relative_to_classpath) in
- (* The file contains double extension and the secondary one matches current platform *)
- if platform_ext = second_ext then
- true,(remove_extension (remove_extension relative_to_classpath)) ^ ext
- else
- false,relative_to_classpath
- end
- in
- (*
- Store current full path for `representation` if
- - we're loading @:coreApi
- - or this is a platform-specific file for `representation`
- - this `representation` was never found before
- *)
- if is_loading_core_api || is_platform_specific || not (ctx.file_lookup_cache#mem representation) then begin
- let full_path = if dir = "." then file_own_name else dir ^ "/" ^ file_own_name in
- ctx.file_lookup_cache#add representation (Some full_path);
- end
- in
- Option.may (Array.iter prepare_file) dir_listing
-
-let find_file ctx ?(class_path=ctx.class_path) f =
- try
- match ctx.file_lookup_cache#find f with
- | None -> raise Exit
- | Some f -> f
- with
- | Exit ->
- raise Not_found
- | Not_found when Path.is_absolute_path f ->
- ctx.file_lookup_cache#add f (Some f);
- f
- | Not_found ->
- let f_dir = Filename.dirname f in
- let rec loop had_empty = function
- | [] when had_empty -> raise Not_found
- | [] -> loop true [""]
- | p :: l ->
- let file = p ^ f in
- let dir = Filename.dirname file in
- (* If we have seen the directory before, we can assume that the file isn't in there because the else case
- below would have added it to `file_lookup_cache`, which we check before we get here. *)
- if ctx.readdir_cache#mem (p,dir) then
- loop (had_empty || p = "") l
- else begin
- cache_directory ctx p dir f_dir;
- (* Caching might have located the file we're looking for, so check the lookup cache again. *)
- try
- begin match ctx.file_lookup_cache#find f with
- | Some f -> f
- | None -> raise Not_found
- end
- with Not_found ->
- loop (had_empty || p = "") l
- end
- in
- let r = try Some (loop false class_path) with Not_found -> None in
- ctx.file_lookup_cache#add f r;
- match r with
- | None -> raise Not_found
- | Some f -> f
+let find_file ctx f =
+ (ctx.class_paths#find_file f).file
(* let find_file ctx f =
let timer = Timer.timer ["find_file"] in
@@ -1291,7 +1220,7 @@ let adapt_defines_to_macro_context defines =
defines_signature = None
} in
Define.define macro_defines Define.Macro;
- Define.raw_define macro_defines (platform_name !Globals.macro_platform);
+ Define.raw_define macro_defines (platform_name Eval);
macro_defines
let adapt_defines_to_display_context defines =
@@ -1311,6 +1240,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
diff --git a/src/context/commonCache.ml b/src/context/commonCache.ml
index 08be299978b..d2c7db7796c 100644
--- a/src/context/commonCache.ml
+++ b/src/context/commonCache.ml
@@ -26,7 +26,15 @@ end
let handle_native_lib com lib =
com.native_libs.all_libs <- lib#get_file_path :: com.native_libs.all_libs;
- com.load_extern_type <- com.load_extern_type @ [lib#get_file_path,lib#build];
+ let build path =
+ (* The first build has to load, afterwards we install a direct lib#build call. *)
+ lib#load;
+ com.load_extern_type <- List.map (fun (name,f) ->
+ name,if name = lib#get_file_path then lib#build else f
+ ) com.load_extern_type;
+ lib#build path;
+ in
+ com.load_extern_type <- com.load_extern_type @ [lib#get_file_path,build];
if not (Define.raw_defined com.defines "haxe.noNativeLibsCache") then begin
let cs = com.cs in
let init () =
@@ -54,7 +62,7 @@ let handle_native_lib com lib =
name,if name = lib#get_file_path then build else f
) com.load_extern_type
| None ->
- lib#load
+ ()
)
end else
(* Offline mode, just read library as usual. *)
@@ -69,24 +77,40 @@ let get_cache com = match com.Common.cache with
| Some cache ->
cache
+let get_cache_sign com = match com.Common.cache with
+ | None -> Define.get_signature com.defines
+ | Some cache -> cache#get_sign
+
let rec cache_context cs com =
let cc = get_cache com in
let sign = Define.get_signature com.defines in
+ let anon_identification = new Tanon_identification.tanon_identification in
+ let config = match com.hxb_writer_config with
+ | None ->
+ HxbWriterConfig.create_target_config ()
+ | Some config ->
+ if com.is_macro_context then config.macro_config else config.target_config
+ in
let cache_module m =
(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heueristic. *)
- let cc = if m.m_extra.m_sign == sign then cc else cs#get_context m.m_extra.m_sign in
- cc#cache_module m.m_path m;
+ let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in
+ let warn w s p = com.warning w com.warning_options s p in
+ cc#cache_module config warn anon_identification m.m_path m;
in
List.iter cache_module com.modules;
- match com.get_macros() with
- | None -> ()
- | Some com -> cache_context cs com
+ begin match com.get_macros() with
+ | None -> ()
+ | Some com -> cache_context cs com
+ end;
+ if Define.raw_defined com.defines "hxb.stats" then begin
+ HxbReader.dump_stats (platform_name com.platform) com.hxb_reader_stats;
+ end
let maybe_add_context_sign cs com desc =
let sign = Define.get_signature com.defines in
- ignore(cs#add_info sign desc com.platform com.class_path com.defines)
+ ignore(cs#add_info sign desc com.platform com.class_paths com.defines)
let lock_signature com name =
let cs = com.cs in
maybe_add_context_sign cs com name;
- com.cache <- Some (get_cache com)
\ No newline at end of file
+ com.cache <- Some (get_cache com)
diff --git a/src/context/display/deprecationCheck.ml b/src/context/display/deprecationCheck.ml
index 947da06e055..148e20294ae 100644
--- a/src/context/display/deprecationCheck.ml
+++ b/src/context/display/deprecationCheck.ml
@@ -107,7 +107,7 @@ let run com =
| TClassDecl c when not (Meta.has Meta.Deprecated c.cl_meta) ->
let dctx = {dctx with class_meta = c.cl_meta; curmod = c.cl_module} in
(match c.cl_constructor with None -> () | Some cf -> run_on_field dctx cf);
- (match c.cl_init with None -> () | Some e -> run_on_expr dctx e);
+ (match TClass.get_cl_init c with None -> () | Some e -> run_on_expr dctx e);
List.iter (run_on_field dctx) c.cl_ordered_statics;
List.iter (run_on_field dctx) c.cl_ordered_fields;
| _ ->
diff --git a/src/context/display/diagnostics.ml b/src/context/display/diagnostics.ml
index 5a01397dda9..ceae6d3ffe1 100644
--- a/src/context/display/diagnostics.ml
+++ b/src/context/display/diagnostics.ml
@@ -121,7 +121,7 @@ let collect_diagnostics dctx com =
ParserEntry.is_true (ParserEntry.eval defines e)
in
Hashtbl.iter (fun file_key cfile ->
- if DisplayPosition.display_position#is_in_file (com.file_keys#get cfile.c_file_path) then begin
+ if DisplayPosition.display_position#is_in_file (com.file_keys#get cfile.c_file_path.file) then begin
let dead_blocks = cfile.c_pdi.pd_dead_blocks in
let dead_blocks = List.filter (fun (_,e) -> not (is_true display_defines e)) dead_blocks in
try
diff --git a/src/context/display/displayEmitter.ml b/src/context/display/displayEmitter.ml
index e77bdd333c3..58b50c7d25f 100644
--- a/src/context/display/displayEmitter.ml
+++ b/src/context/display/displayEmitter.ml
@@ -54,9 +54,9 @@ let rec display_type ctx t p =
try
display_module_type ctx (module_type_of_type t) p
with Exit ->
- match follow t,follow !t_dynamic_def with
+ match follow t,follow ctx.g.t_dynamic_def with
| _,TDynamic _ -> () (* sanity check in case it's still t_dynamic *)
- | TDynamic _,_ -> display_type ctx !t_dynamic_def p
+ | TDynamic _,_ -> display_type ctx ctx.g.t_dynamic_def p
| _ ->
match dm.dms_kind with
| DMHover ->
@@ -71,20 +71,20 @@ let check_display_type ctx t ptp =
ctx.g.type_hints <- (ctx.m.curmod.m_extra.m_display,ptp.pos_full,t) :: ctx.g.type_hints;
in
let maybe_display_type () =
- if ctx.is_display_file && display_position#enclosed_in ptp.pos_full then
+ if ctx.m.is_display_file && display_position#enclosed_in ptp.pos_full then
display_type ctx t ptp.pos_path
in
add_type_hint();
maybe_display_type()
-let raise_position_of_type t =
+let raise_position_of_type ctx t =
let mt =
let rec follow_null t =
match t with
| TMono r -> (match r.tm_type with None -> raise_positions [null_pos] | Some t -> follow_null t)
| TLazy f -> follow_null (lazy_type f)
| TAbstract({a_path = [],"Null"},[t]) -> follow_null t
- | TDynamic _ -> !t_dynamic_def
+ | TDynamic _ -> ctx.g.t_dynamic_def
| _ -> t
in
try
@@ -96,7 +96,7 @@ let raise_position_of_type t =
let display_variable ctx v p = match ctx.com.display.dms_kind with
| DMDefinition -> raise_positions [v.v_pos]
- | DMTypeDefinition -> raise_position_of_type v.v_type
+ | DMTypeDefinition -> raise_position_of_type ctx v.v_type
| DMUsage _ -> ReferencePosition.set (v.v_name,v.v_pos,SKVariable v)
| DMHover ->
let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta v.v_meta) v.v_type in
@@ -105,7 +105,7 @@ let display_variable ctx v p = match ctx.com.display.dms_kind with
let display_field ctx origin scope cf p = match ctx.com.display.dms_kind with
| DMDefinition -> raise_positions [cf.cf_name_pos]
- | DMTypeDefinition -> raise_position_of_type cf.cf_type
+ | DMTypeDefinition -> raise_position_of_type ctx cf.cf_type
| DMUsage _ | DMImplementation ->
let name,kind = match cf.cf_name,origin with
| "new",(Self (TClassDecl c) | Parent(TClassDecl c)) ->
@@ -136,7 +136,7 @@ let maybe_display_field ctx origin scope cf p =
let display_enum_field ctx en ef p = match ctx.com.display.dms_kind with
| DMDefinition -> raise_positions [ef.ef_name_pos]
- | DMTypeDefinition -> raise_position_of_type ef.ef_type
+ | DMTypeDefinition -> raise_position_of_type ctx ef.ef_type
| DMUsage _ -> ReferencePosition.set (ef.ef_name,ef.ef_name_pos,SKEnumField ef)
| DMHover ->
let ct = CompletionType.from_type (get_import_status ctx) ef.ef_type in
diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml
index 929ea7b4d62..234cf6d460f 100644
--- a/src/context/display/displayFields.ml
+++ b/src/context/display/displayFields.ml
@@ -39,9 +39,9 @@ let collect_static_extensions ctx items e p =
let opt_type t =
match t with
| TLazy f ->
- return_partial_type := true;
+ ctx.g.return_partial_type <- true;
let t = lazy_type f in
- return_partial_type := false;
+ ctx.g.return_partial_type <- false;
t
| _ ->
t
@@ -49,7 +49,7 @@ let collect_static_extensions ctx items e p =
let rec dup t = Type.map dup t in
let handle_field c f acc =
let f = { f with cf_type = opt_type f.cf_type } in
- let monos = List.map (fun _ -> spawn_monomorph ctx p) f.cf_params in
+ let monos = List.map (fun _ -> spawn_monomorph ctx.e p) f.cf_params in
let map = apply_params f.cf_params monos in
match follow (map f.cf_type) with
| TFun((_,_,TType({t_path=["haxe";"macro"], "ExprOf"}, [t])) :: args, ret)
@@ -112,7 +112,7 @@ let collect ctx e_ast e dk with_type p =
let opt_args args ret = TFun(List.map(fun (n,o,t) -> n,true,t) args,ret) in
let should_access c cf stat =
if Meta.has Meta.NoCompletion cf.cf_meta then false
- else if c != ctx.curclass && not (has_class_field_flag cf CfPublic) && String.length cf.cf_name > 4 then begin match String.sub cf.cf_name 0 4 with
+ else if c != ctx.c.curclass && not (has_class_field_flag cf CfPublic) && String.length cf.cf_name > 4 then begin match String.sub cf.cf_name 0 4 with
| "get_" | "set_" -> false
| _ -> can_access ctx c cf stat
end else
@@ -250,50 +250,51 @@ let collect ctx e_ast e dk with_type p =
end
| _ -> items
in
- (* Anon own fields *)
- PMap.foldi (fun name cf acc ->
- if is_new_item acc name then begin
- let allow_static_abstract_access c cf =
+ 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
+ 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
- ) an.a_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
@@ -401,9 +402,9 @@ let handle_missing_field_raise ctx tthis i mode with_type pfield =
display.module_diagnostics <- MissingFields diag :: display.module_diagnostics
let handle_missing_ident ctx i mode with_type p =
- match ctx.curfun with
+ match ctx.e.curfun with
| FunStatic ->
- let e_self = Texpr.Builder.make_static_this ctx.curclass p in
+ let e_self = Texpr.Builder.make_static_this ctx.c.curclass p in
begin try
handle_missing_field_raise ctx e_self.etype i mode with_type p
with Exit ->
@@ -411,7 +412,7 @@ let handle_missing_ident ctx i mode with_type p =
end
| _ ->
begin try
- handle_missing_field_raise ctx ctx.tthis i mode with_type p
+ handle_missing_field_raise ctx ctx.c.tthis i mode with_type p
with Exit ->
()
end
diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml
index 772fb15662b..0cd7f68c41f 100644
--- a/src/context/display/displayJson.ml
+++ b/src/context/display/displayJson.ml
@@ -104,6 +104,55 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
end
end
+class hxb_reader_api_com
+ ~(headers_only : bool)
+ (com : Common.context)
+ (cc : CompilationCache.context_cache)
+= object(self)
+ method make_module (path : path) (file : string) =
+ let mc = cc#get_hxb_module path in
+ {
+ m_id = mc.mc_id;
+ m_path = path;
+ m_types = [];
+ m_statics = None;
+ m_extra = mc.mc_extra
+ }
+
+ method add_module (m : module_def) =
+ com.module_lut#add m.m_path m;
+
+ method resolve_type (pack : string list) (mname : string) (tname : string) =
+ let path = (pack,mname) in
+ let m = self#find_module path in
+ List.find (fun t -> snd (t_path t) = tname) m.m_types
+
+ method resolve_module (path : path) =
+ self#find_module path
+
+ method find_module (m_path : path) =
+ try
+ com.module_lut#find m_path
+ with Not_found -> try
+ cc#find_module m_path
+ with Not_found ->
+ let mc = cc#get_hxb_module m_path in
+ let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats in
+ fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if headers_only then MTF else EOM))
+
+ method basic_types =
+ com.basic
+
+ method get_var_id (i : int) =
+ i
+
+ method read_expression_eagerly (cf : tclass_field) =
+ false
+end
+
+let find_module ~(headers_only : bool) com cc path =
+ (new hxb_reader_api_com ~headers_only com cc)#find_module path
+
type handler_context = {
com : Common.context;
jsonrpc : jsonrpc_handler;
@@ -280,9 +329,10 @@ let handler =
"server/modules", (fun hctx ->
let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
let cc = hctx.display#get_cs#get_context sign in
+ let open HxbData in
let l = Hashtbl.fold (fun _ m acc ->
- if m.m_extra.m_kind <> MFake then jstring (s_type_path m.m_path) :: acc else acc
- ) cc#get_modules [] in
+ if m.mc_extra.m_kind <> MFake then jstring (s_type_path m.mc_path) :: acc else acc
+ ) cc#get_hxb [] in
hctx.send_result (jarray l)
);
"server/module", (fun hctx ->
@@ -291,11 +341,11 @@ let handler =
let cs = hctx.display#get_cs in
let cc = cs#get_context sign in
let m = try
- cc#find_module path
+ find_module ~headers_only:true hctx.com cc path
with Not_found ->
hctx.send_error [jstring "No such module"]
in
- hctx.send_result (generate_module cs cc m)
+ hctx.send_result (generate_module (cc#get_hxb) (find_module ~headers_only:true hctx.com cc) m)
);
"server/type", (fun hctx ->
let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
@@ -303,7 +353,7 @@ let handler =
let typeName = hctx.jsonrpc#get_string_param "typeName" in
let cc = hctx.display#get_cs#get_context sign in
let m = try
- cc#find_module path
+ find_module ~headers_only:true hctx.com cc path
with Not_found ->
hctx.send_error [jstring "No such module"]
in
@@ -355,7 +405,7 @@ let handler =
let key = hctx.com.file_keys#get file in
let cs = hctx.display#get_cs in
List.iter (fun cc ->
- Hashtbl.replace cc#get_removed_files key file
+ Hashtbl.replace cc#get_removed_files key (ClassPaths.create_resolved_file file hctx.com.empty_class_path)
) cs#get_contexts;
hctx.send_result (jstring file);
);
@@ -366,7 +416,7 @@ let handler =
let files = List.sort (fun (file1,_) (file2,_) -> compare file1 file2) files in
let files = List.map (fun (fkey,cfile) ->
jobject [
- "file",jstring cfile.c_file_path;
+ "file",jstring cfile.c_file_path.file;
"time",jfloat cfile.c_time;
"pack",jstring (String.concat "." cfile.c_package);
"moduleName",jopt jstring cfile.c_module_name;
diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml
index 83f719fcea9..87940cfa93a 100644
--- a/src/context/display/displayPath.ml
+++ b/src/context/display/displayPath.ml
@@ -26,14 +26,14 @@ module TypePathHandler = struct
| x :: l ->
(try
match PMap.find x com.package_rules with
- | Directory d -> d :: l
| Remap s -> s :: l
| _ -> p
with
Not_found -> p)
| _ -> p
) in
- List.iter (fun path ->
+ com.class_paths#iter (fun path ->
+ let path = path#path in
let dir = path ^ String.concat "/" p in
let r = (try Sys.readdir dir with _ -> [||]) in
Array.iter (fun f ->
@@ -47,7 +47,6 @@ module TypePathHandler = struct
match PMap.find f com.package_rules with
| Forbidden -> ()
| Remap f -> packages := f :: !packages
- | Directory _ -> raise Not_found
with Not_found ->
packages := f :: !packages
else
@@ -61,7 +60,7 @@ module TypePathHandler = struct
if String.length c < 2 || String.sub c (String.length c - 2) 2 <> "__" then classes := c :: !classes;
end;
) r;
- ) com.class_path;
+ );
let process_lib lib =
List.iter (fun (path,name) ->
if path = p then classes := name :: !classes else
@@ -166,7 +165,6 @@ let resolve_position_by_path ctx path p =
let p = (t_infos mt).mt_pos in
raise_positions [p]
-
let handle_path_display ctx path p =
let class_field c name =
ignore(c.cl_build());
diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml
index f5241cdb35c..777ba93ef24 100644
--- a/src/context/display/displayTexpr.ml
+++ b/src/context/display/displayTexpr.ml
@@ -87,7 +87,7 @@ let check_display_class ctx decls c =
List.iter check_field c.cl_ordered_statics;
| _ ->
let sc = find_class_by_position decls c.cl_name_pos in
- ignore(Typeload.type_type_params ctx TPHType c.cl_path (fun() -> c.cl_params) null_pos sc.d_params);
+ ignore(Typeload.type_type_params ctx TPHType c.cl_path null_pos sc.d_params);
List.iter (function
| (HExtends ptp | HImplements ptp) when display_position#enclosed_in ptp.pos_full ->
ignore(Typeload.load_instance ~allow_display:true ctx ptp ParamNormal)
@@ -101,7 +101,7 @@ let check_display_class ctx decls c =
let check_display_enum ctx decls en =
let se = find_enum_by_position decls en.e_name_pos in
- ignore(Typeload.type_type_params ctx TPHType en.e_path (fun() -> en.e_params) null_pos se.d_params);
+ ignore(Typeload.type_type_params ctx TPHType en.e_path null_pos se.d_params);
PMap.iter (fun _ ef ->
if display_position#enclosed_in ef.ef_pos then begin
let sef = find_enum_field_by_position se ef.ef_name_pos in
@@ -111,12 +111,12 @@ let check_display_enum ctx decls en =
let check_display_typedef ctx decls td =
let st = find_typedef_by_position decls td.t_name_pos in
- ignore(Typeload.type_type_params ctx TPHType td.t_path (fun() -> td.t_params) null_pos st.d_params);
+ ignore(Typeload.type_type_params ctx TPHType td.t_path null_pos st.d_params);
ignore(Typeload.load_complex_type ctx true st.d_data)
let check_display_abstract ctx decls a =
let sa = find_abstract_by_position decls a.a_name_pos in
- ignore(Typeload.type_type_params ctx TPHType a.a_path (fun() -> a.a_params) null_pos sa.d_params);
+ ignore(Typeload.type_type_params ctx TPHType a.a_path null_pos sa.d_params);
List.iter (function
| (AbOver(ct,p) | AbFrom(ct,p) | AbTo(ct,p)) when display_position#enclosed_in p ->
ignore(Typeload.load_complex_type ctx true (ct,p))
@@ -140,8 +140,8 @@ let check_display_module ctx decls m =
| (EImport _ | EUsing _),_ -> true
| _ -> false
) decls in
- let imports = TypeloadModule.ModuleLevel.handle_import_hx ctx m imports null_pos in
- let ctx = TypeloadModule.type_types_into_module ctx m imports null_pos in
+ let imports = TypeloadModule.ModuleLevel.handle_import_hx ctx.com ctx.g m imports null_pos in
+ let ctx = TypeloadModule.type_types_into_module ctx.com ctx.g m imports null_pos in
List.iter (fun md ->
let infos = t_infos md in
if display_position#enclosed_in infos.mt_name_pos then
@@ -170,10 +170,21 @@ let check_display_file ctx cs =
TypeloadParse.PdiHandler.handle_pdi ctx.com cfile.c_pdi;
(* We have to go through type_module_hook because one of the module's dependencies could be
invalid (issue #8991). *)
- begin match !TypeloadModule.type_module_hook ctx path null_pos with
- | None -> raise Not_found
- | Some m -> check_display_module ctx cfile.c_decls m
- end
+ let m = try
+ ctx.com.module_lut#find path
+ with Not_found ->
+ begin match !TypeloadModule.type_module_hook ctx path null_pos with
+ | NoModule | BadModule _ -> raise Not_found
+ | BinaryModule mc ->
+ let api = (new TypeloadModule.hxb_reader_api_typeload ctx TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in
+ let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats in
+ let m = reader#read_chunks api mc.mc_chunks in
+ m
+ | GoodModule m ->
+ m
+ end
+ in
+ check_display_module ctx cfile.c_decls m
with Not_found ->
let fkey = DisplayPosition.display_position#get_file_key in
(* force parsing again : if the completion point have been changed *)
diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml
index a7c07716429..facb253d13b 100644
--- a/src/context/display/displayToplevel.ml
+++ b/src/context/display/displayToplevel.ml
@@ -74,7 +74,6 @@ class explore_class_path_task com checked recursive f_pack f_module dir pack = o
begin try
begin match PMap.find file com.package_rules with
| Forbidden | Remap _ -> ()
- | _ -> raise Not_found
end
with Not_found ->
f_pack (List.rev pack,file);
@@ -112,8 +111,12 @@ let explore_class_paths com timer class_paths recursive f_pack f_module =
let cs = com.cs in
let t = Timer.timer (timer @ ["class path exploration"]) in
let checked = Hashtbl.create 0 in
- let tasks = List.map (fun dir ->
- new explore_class_path_task com checked recursive f_pack f_module dir []
+ let tasks = ExtList.List.filter_map (fun path ->
+ match path#get_directory_path with
+ | Some path ->
+ Some (new explore_class_path_task com checked recursive f_pack f_module path [])
+ | None ->
+ None
) class_paths in
let task = new arbitrary_task ["explore"] 50 (fun () ->
List.iter (fun task -> task#run) tasks
@@ -122,10 +125,10 @@ let explore_class_paths com timer class_paths recursive f_pack f_module =
t()
let read_class_paths com timer =
- explore_class_paths com timer (List.filter ((<>) "") com.class_path) true (fun _ -> ()) (fun file path ->
+ explore_class_paths com timer (com.class_paths#filter (fun cp -> cp#path <> "")) true (fun _ -> ()) (fun file path ->
(* Don't parse the display file as that would maybe overwrite the content from stdin with the file contents. *)
if not (DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then begin
- let file,_,pack,_ = Display.parse_module' com path Globals.null_pos in
+ let rfile,_,pack,_ = Display.parse_module' com path Globals.null_pos in
if pack <> fst path then begin
let file_key = com.file_keys#get file in
(CommonCache.get_cache com)#remove_file_for_real file_key
@@ -222,9 +225,9 @@ let is_pack_visible pack =
not (List.exists (fun s -> String.length s > 0 && s.[0] = '_') pack)
let collect ctx tk with_type sort =
- let t = Timer.timer ["display";"toplevel"] in
+ let t = Timer.timer ["display";"toplevel collect"] in
let cctx = CollectionContext.create ctx in
- let curpack = fst ctx.curclass.cl_path in
+ let curpack = fst ctx.c.curclass.cl_path in
(* Note: This checks for the explicit `ServerConfig.legacy_completion` setting instead of using
`is_legacy_completion com` because the latter is always false for the old protocol, yet we have
tests which assume advanced completion even in the old protocol. This means that we can only
@@ -295,10 +298,12 @@ let collect ctx tk with_type sort =
| TKType | TKOverride -> ()
| TKExpr p | TKPattern p | TKField p ->
(* locals *)
+ let t = Timer.timer ["display";"toplevel collect";"locals"] in
PMap.iter (fun _ v ->
if not (is_gen_local v) then
add (make_ci_local v (tpair ~values:(get_value_meta v.v_meta) v.v_type)) (Some v.v_name)
- ) ctx.locals;
+ ) ctx.f.locals;
+ t();
let add_field scope origin cf =
let origin,cf = match origin with
@@ -323,23 +328,25 @@ let collect ctx tk with_type sort =
let maybe_add_field scope origin cf =
if not (Meta.has Meta.NoCompletion cf.cf_meta) then add_field scope origin cf
in
+
+ let t = Timer.timer ["display";"toplevel collect";"fields"] in
(* member fields *)
- if ctx.curfun <> FunStatic then begin
- let all_fields = Type.TClass.get_all_fields ctx.curclass (extract_param_types ctx.curclass.cl_params) in
+ if ctx.e.curfun <> FunStatic then begin
+ let all_fields = Type.TClass.get_all_fields ctx.c.curclass (extract_param_types ctx.c.curclass.cl_params) in
PMap.iter (fun _ (c,cf) ->
- let origin = if c == ctx.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in
+ let origin = if c == ctx.c.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in
maybe_add_field CFSMember origin cf
) all_fields;
(* TODO: local using? *)
end;
(* statics *)
- begin match ctx.curclass.cl_kind with
+ begin match ctx.c.curclass.cl_kind with
| KAbstractImpl ({a_impl = Some c} as a) ->
let origin = Self (TAbstractDecl a) in
List.iter (fun cf ->
if has_class_field_flag cf CfImpl then begin
- if ctx.curfun = FunStatic then ()
+ if ctx.e.curfun = FunStatic then ()
else begin
let cf = prepare_using_field cf in
maybe_add_field CFSMember origin cf
@@ -348,13 +355,15 @@ let collect ctx tk with_type sort =
maybe_add_field CFSStatic origin cf
) c.cl_ordered_statics
| _ ->
- List.iter (maybe_add_field CFSStatic (Self (TClassDecl ctx.curclass))) ctx.curclass.cl_ordered_statics
+ List.iter (maybe_add_field CFSStatic (Self (TClassDecl ctx.c.curclass))) ctx.c.curclass.cl_ordered_statics
end;
+ t();
+ let t = Timer.timer ["display";"toplevel collect";"enum ctors"] in
(* enum constructors *)
let rec enum_ctors t =
match t with
- | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.curclass != c ->
+ | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.c.curclass != c ->
add_path cctx a.a_path;
List.iter (fun cf ->
let ccf = CompletionClassField.make cf CFSMember (Self (decl_of_class c)) true in
@@ -385,7 +394,9 @@ let collect ctx tk with_type sort =
(try enum_ctors (module_type_of_type (follow t)) with Exit -> ())
| _ -> ()
end;
+ t();
+ let t = Timer.timer ["display";"toplevel collect";"globals"] in
(* imported globals *)
PMap.iter (fun name (mt,s,_) ->
try
@@ -415,21 +426,23 @@ let collect ctx tk with_type sort =
with Not_found ->
()
) ctx.m.import_resolution#extract_field_imports;
+ t();
+ let t = Timer.timer ["display";"toplevel collect";"rest"] in
(* literals *)
add (make_ci_literal "null" (tpair t_dynamic)) (Some "null");
add (make_ci_literal "true" (tpair ctx.com.basic.tbool)) (Some "true");
add (make_ci_literal "false" (tpair ctx.com.basic.tbool)) (Some "false");
- begin match ctx.curfun with
+ begin match ctx.e.curfun with
| FunMember | FunConstructor | FunMemberClassLocal ->
- let t = TInst(ctx.curclass,extract_param_types ctx.curclass.cl_params) in
+ let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
add (make_ci_literal "this" (tpair t)) (Some "this");
- begin match ctx.curclass.cl_super with
+ begin match ctx.c.curclass.cl_super with
| Some(c,tl) -> add (make_ci_literal "super" (tpair (TInst(c,tl)))) (Some "super")
| None -> ()
end
| FunMemberAbstract ->
- let t = TInst(ctx.curclass,extract_param_types ctx.curclass.cl_params) in
+ let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
add (make_ci_literal "abstract" (tpair t)) (Some "abstract");
| _ ->
()
@@ -445,7 +458,8 @@ let collect ctx tk with_type sort =
(* builtins *)
add (make_ci_literal "trace" (tpair (TFun(["value",false,t_dynamic],ctx.com.basic.tvoid)))) (Some "trace")
- end
+ end;
+ t()
end;
(* type params *)
@@ -459,6 +473,7 @@ let collect ctx tk with_type sort =
(* module imports *)
List.iter add_type (List.rev_map fst ctx.m.import_resolution#extract_type_imports); (* reverse! *)
+ let t_syntax = Timer.timer ["display";"toplevel collect";"syntax"] in
(* types from files *)
let cs = ctx.com.cs in
(* online: iter context files *)
@@ -476,7 +491,7 @@ let collect ctx tk with_type sort =
| s :: sl -> add_package (List.rev sl,s)
in
List.iter (fun ((file_key,cfile),_) ->
- let module_name = CompilationCache.get_module_name_of_cfile cfile.c_file_path cfile in
+ let module_name = CompilationCache.get_module_name_of_cfile cfile.c_file_path.file cfile in
let dot_path = s_type_path (cfile.c_package,module_name) in
(* In legacy mode we only show toplevel types. *)
if is_legacy_completion && cfile.c_package <> [] then begin
@@ -491,6 +506,9 @@ let collect ctx tk with_type sort =
if process_decls cfile.c_package module_name cfile.c_decls then check_package cfile.c_package;
end
) files;
+ t_syntax();
+
+ let t_native_lib = Timer.timer ["display";"toplevel collect";"native lib"] in
List.iter (fun file ->
match cs#get_native_lib file with
| Some lib ->
@@ -500,13 +518,19 @@ let collect ctx tk with_type sort =
| None ->
()
) ctx.com.native_libs.all_libs;
+ t_native_lib();
+ let t_packages = Timer.timer ["display";"toplevel collect";"packages"] in
(* packages *)
Hashtbl.iter (fun path _ ->
let full_pack = fst path @ [snd path] in
if is_pack_visible full_pack then add (make_ci_package path []) (Some (snd path))
) packages;
+ t_packages();
+
+ t();
+ let t = Timer.timer ["display";"toplevel sorting"] in
(* sorting *)
let l = DynArray.to_list cctx.items in
let l = if is_legacy_completion then
diff --git a/src/context/display/importHandling.ml b/src/context/display/importHandling.ml
index 1986d5b8976..69a9e9f16c3 100644
--- a/src/context/display/importHandling.ml
+++ b/src/context/display/importHandling.ml
@@ -113,7 +113,7 @@ let init_import ctx path mode p =
let check_alias mt name pname =
if not (name.[0] >= 'A' && name.[0] <= 'Z') then
raise_typing_error "Type aliases must start with an uppercase letter" pname;
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in pname then
+ if ctx.m.is_display_file && DisplayPosition.display_position#enclosed_in pname then
DisplayEmitter.display_alias ctx name (type_of_module_type mt) pname;
in
let add_static_init t name s =
@@ -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
diff --git a/src/context/display/syntaxExplorer.ml b/src/context/display/syntaxExplorer.ml
index 471f65101a0..bc6c1328cc3 100644
--- a/src/context/display/syntaxExplorer.ml
+++ b/src/context/display/syntaxExplorer.ml
@@ -167,7 +167,7 @@ let explore_uncached_modules tctx cs symbols =
let modules = cc#get_modules in
let t = Timer.timer ["display";"references";"candidates"] in
let acc = Hashtbl.fold (fun file_key cfile acc ->
- let module_name = get_module_name_of_cfile cfile.c_file_path cfile in
+ let module_name = get_module_name_of_cfile cfile.c_file_path.file cfile in
if Hashtbl.mem modules (cfile.c_package,module_name) then
acc
else try
diff --git a/src/context/feature.ml b/src/context/feature.ml
deleted file mode 100644
index 647d03da10b..00000000000
--- a/src/context/feature.ml
+++ /dev/null
@@ -1,11 +0,0 @@
-open Ast
-open Type
-open Error
-
-let rec check_if_feature = function
- | [] -> []
- | (Meta.IfFeature,el,_) :: _ -> List.map (fun (e,p) -> match e with EConst (String(s,_)) -> s | _ -> raise_typing_error "String expected" p) el
- | _ :: l -> check_if_feature l
-
-let set_feature m cf_ref s =
- m.m_extra.m_if_feature <- (s, cf_ref) :: m.m_extra.m_if_feature
diff --git a/src/context/memory.ml b/src/context/memory.ml
index 58eab29cdc5..c0613b9db62 100644
--- a/src/context/memory.ml
+++ b/src/context/memory.ml
@@ -38,9 +38,10 @@ let rec scan_module_deps cs m h =
()
else begin
Hashtbl.add h m.m_id m;
- PMap.iter (fun _ (sign,mpath) ->
- let m = (cs#get_context sign)#find_module mpath in
- scan_module_deps cs m h) m.m_extra.m_deps
+ PMap.iter (fun _ mdep ->
+ let m = (cs#get_context mdep.md_sign)#find_module mdep.md_path in
+ scan_module_deps cs m h
+ ) m.m_extra.m_deps
end
let module_sign key md =
@@ -168,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
@@ -274,9 +278,9 @@ let display_memory com =
());
if verbose then begin
print (Printf.sprintf " %d total deps" (List.length deps));
- PMap.iter (fun _ (sign,mpath) ->
- let md = (com.cs#get_context sign)#find_module mpath in
- print (Printf.sprintf " dep %s%s" (s_type_path mpath) (module_sign key md));
+ PMap.iter (fun _ mdep ->
+ let md = (com.cs#get_context mdep.md_sign)#find_module mdep.md_path in
+ print (Printf.sprintf " dep %s%s" (s_type_path mdep.md_path) (module_sign key md));
) m.m_extra.m_deps;
end;
flush stdout
diff --git a/src/context/nativeLibraryHandler.ml b/src/context/nativeLibraryHandler.ml
index 75e010635a5..88c42cc8e63 100644
--- a/src/context/nativeLibraryHandler.ml
+++ b/src/context/nativeLibraryHandler.ml
@@ -17,7 +17,6 @@
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*)
-open Globals
open Common
open CompilationContext
@@ -49,3 +48,9 @@ let add_native_lib com lib =
| _ -> failwith ("unsupported file@`std` format: " ^ file)
in
Dotnet.add_net_lib com file is_std is_extern
+ | HxbLib ->
+ let hxb_lib = HxbLib.create_hxb_lib com file in
+ com.hxb_libs <- hxb_lib :: com.hxb_libs;
+ (fun () ->
+ hxb_lib#load
+ )
\ No newline at end of file
diff --git a/src/context/typecore.ml b/src/context/typecore.ml
index 9641dd3f524..478392e9376 100644
--- a/src/context/typecore.ml
+++ b/src/context/typecore.ml
@@ -60,6 +60,12 @@ type typer_pass =
| PForce (* usually ensure that lazy have been evaluated *)
| PFinal (* not used, only mark for finalize *)
+let all_typer_passes = [
+ PBuildModule;PBuildClass;PConnectField;PTypeField;PCheckConstraint;PForce;PFinal
+]
+
+let all_typer_passes_length = List.length all_typer_passes
+
type typer_module = {
curmod : module_def;
import_resolution : resolution_list;
@@ -67,11 +73,13 @@ type typer_module = {
mutable enum_with_type : module_type option;
mutable module_using : (tclass * pos) list;
mutable import_statements : import list;
+ mutable is_display_file : bool;
}
-type delay = {
- delay_pass : typer_pass;
- delay_functions : (unit -> unit) list;
+type typer_class = {
+ mutable curclass : tclass; (* TODO: should not be mutable *)
+ mutable tthis : t;
+ mutable get_build_infos : unit -> (module_type * t list * class_field list) option;
}
type build_kind =
@@ -93,21 +101,29 @@ type macro_result =
| MError
| MMacroInMacro
+type typer_pass_tasks = {
+ mutable tasks : (unit -> unit) list;
+}
+
type typer_globals = {
- mutable delayed : delay list;
+ mutable delayed : typer_pass_tasks Array.t;
+ mutable delayed_min_index : int;
mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
doinline : bool;
retain_meta : bool;
mutable core_api : typer option;
mutable macros : ((unit -> unit) * typer) option;
mutable std_types : module_def;
- type_patches : (path, (string * bool, type_patch) Hashtbl.t * type_patch) Hashtbl.t;
mutable module_check_policies : (string list * module_check_policy list * bool) list;
mutable global_using : (tclass * pos) list;
(* Indicates that Typer.create() finished building this instance *)
mutable complete : bool;
mutable type_hints : (module_def_display * pos * t) list;
mutable load_only_cached_modules : bool;
+ mutable return_partial_type : bool;
+ mutable build_count : int;
+ mutable t_dynamic_def : Type.t;
+ mutable delayed_display : DisplayTypes.display_exception_kind option;
(* api *)
do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> macro_result;
do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field);
@@ -118,43 +134,45 @@ type typer_globals = {
do_load_core_class : typer -> tclass -> tclass;
}
+(* typer_expr holds information that is specific to a (function) expresssion, whereas typer_field
+ is shared by local TFunctions. *)
+and typer_expr = {
+ mutable ret : t;
+ mutable curfun : current_fun;
+ mutable opened : anon_status ref list;
+ mutable monomorphs : monomorphs;
+ mutable in_function : bool;
+ mutable in_loop : bool;
+ mutable bypass_accessor : int;
+ mutable with_type_stack : WithType.t list;
+ mutable call_argument_stack : expr list list;
+ mutable macro_depth : int;
+}
+
+and typer_field = {
+ mutable curfield : tclass_field;
+ mutable locals : (string, tvar) PMap.t;
+ mutable vthis : tvar option;
+ mutable untyped : bool;
+ mutable meta : metadata;
+ mutable in_display : bool;
+ mutable in_call_args : bool;
+ mutable in_overload_call_args : bool;
+}
+
and typer = {
(* shared *)
com : context;
t : basic_types;
g : typer_globals;
- mutable bypass_accessor : int;
- mutable meta : metadata;
- mutable with_type_stack : WithType.t list;
- mutable call_argument_stack : expr list list;
- (* variable *)
- mutable pass : typer_pass;
- (* per-module *)
mutable m : typer_module;
- mutable is_display_file : bool;
- (* per-class *)
- mutable curclass : tclass;
- mutable tthis : t;
+ c : typer_class;
+ f : typer_field;
+ mutable e : typer_expr;
+ mutable pass : typer_pass;
mutable type_params : type_params;
- mutable get_build_infos : unit -> (module_type * t list * class_field list) option;
- (* per-function *)
mutable allow_inline : bool;
mutable allow_transform : bool;
- mutable curfield : tclass_field;
- mutable untyped : bool;
- mutable in_function : bool;
- mutable in_loop : bool;
- mutable in_display : 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 vthis : tvar option;
- mutable in_call_args : bool;
- mutable in_overload_call_args : bool;
- mutable delayed_display : DisplayTypes.display_exception_kind option;
- mutable monomorphs : monomorphs;
(* events *)
memory_marker : float array;
}
@@ -163,6 +181,106 @@ and monomorphs = {
mutable perfunction : (tmono * pos) list;
}
+module TyperManager = struct
+ let create com g m c f e pass params = {
+ com = com;
+ g = g;
+ t = com.basic;
+ m = m;
+ c = c;
+ f = f;
+ e = e;
+ pass = pass;
+ allow_inline = true;
+ allow_transform = true;
+ type_params = params;
+ memory_marker = memory_marker;
+ }
+
+ let create_ctx_c c =
+ {
+ curclass = c;
+ tthis = (match c.cl_kind with
+ | KAbstractImpl a ->
+ (match a.a_this with
+ | TMono r when r.tm_type = None -> TAbstract (a,extract_param_types c.cl_params)
+ | t -> t)
+ | _ ->
+ TInst (c,extract_param_types c.cl_params)
+ );
+ get_build_infos = (fun () -> None);
+ }
+
+ let create_ctx_f cf =
+ {
+ locals = PMap.empty;
+ curfield = cf;
+ vthis = None;
+ untyped = false;
+ meta = [];
+ in_display = false;
+ in_overload_call_args = false;
+ in_call_args = false;
+ }
+
+ let create_ctx_e () =
+ {
+ ret = t_dynamic;
+ curfun = FunStatic;
+ opened = [];
+ in_function = false;
+ monomorphs = {
+ perfunction = [];
+ };
+ in_loop = false;
+ bypass_accessor = 0;
+ with_type_stack = [];
+ call_argument_stack = [];
+ macro_depth = 0;
+ }
+
+ let create_for_module com g m =
+ let c = create_ctx_c null_class in
+ let f = create_ctx_f null_field in
+ let e = create_ctx_e () in
+ create com g m c f e PBuildModule []
+
+ let clone_for_class ctx c =
+ let c = create_ctx_c c in
+ let f = create_ctx_f null_field in
+ let e = create_ctx_e () in
+ let params = match c.curclass.cl_kind with KAbstractImpl a -> a.a_params | _ -> c.curclass.cl_params in
+ create ctx.com ctx.g ctx.m c f e PBuildClass params
+
+ let clone_for_enum ctx en =
+ let c = create_ctx_c null_class in
+ let f = create_ctx_f null_field in
+ let e = create_ctx_e () in
+ create ctx.com ctx.g ctx.m c f e PBuildModule en.e_params
+
+ let clone_for_typedef ctx td =
+ let c = create_ctx_c null_class in
+ let f = create_ctx_f null_field in
+ let e = create_ctx_e () in
+ create ctx.com ctx.g ctx.m c f e PBuildModule td.t_params
+
+ let clone_for_abstract ctx a =
+ let c = create_ctx_c null_class in
+ let f = create_ctx_f null_field in
+ let e = create_ctx_e () in
+ create ctx.com ctx.g ctx.m c f e PBuildModule a.a_params
+
+ let clone_for_field ctx cf params =
+ let f = create_ctx_f cf in
+ let e = create_ctx_e () in
+ create ctx.com ctx.g ctx.m ctx.c f e PBuildClass params
+
+ let clone_for_enum_field ctx params =
+ let f = create_ctx_f null_field in
+ let e = create_ctx_e () in
+ create ctx.com ctx.g ctx.m ctx.c f e PBuildClass params
+end
+
type field_host =
| FHStatic of tclass
| FHInstance of tclass * tparams
@@ -201,6 +319,12 @@ type dot_path_part = {
pos : pos
}
+type find_module_result =
+ | GoodModule of module_def
+ | BadModule of module_skip_reason
+ | BinaryModule of HxbData.module_cache
+ | NoModule
+
let make_build_info kind path params extern apply = {
build_kind = kind;
build_path = path;
@@ -215,8 +339,6 @@ exception WithTypeError of error
let memory_marker = [|Unix.time()|]
-let locate_macro_error = ref true
-
let make_call_ref : (typer -> texpr -> texpr list -> t -> ?force_inline:bool -> pos -> texpr) ref = ref (fun _ _ _ _ ?force_inline:bool _ -> die "" __LOC__)
let type_expr_ref : (?mode:access_mode -> typer -> expr -> WithType.t -> texpr) ref = ref (fun ?(mode=MGet) _ _ _ -> die "" __LOC__)
let type_block_ref : (typer -> expr list -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ -> die "" __LOC__)
@@ -238,7 +360,7 @@ let pass_name = function
| PFinal -> "final"
let warning ?(depth=0) ctx w msg p =
- let options = (Warning.from_meta ctx.curclass.cl_meta) @ (Warning.from_meta ctx.curfield.cf_meta) in
+ let options = (Warning.from_meta ctx.c.curclass.cl_meta) @ (Warning.from_meta ctx.f.curfield.cf_meta) in
match Warning.get_mode w options with
| WMEnable ->
module_warning ctx.com ctx.m.curmod w options msg p
@@ -265,7 +387,7 @@ let make_static_field_access c cf t p =
mk (TField (ethis,(FStatic (c,cf)))) t p
let make_static_call ctx c cf map args t p =
- let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in
+ let monos = List.map (fun _ -> spawn_monomorph ctx.e p) cf.cf_params in
let map t = map (apply_params cf.cf_params monos t) in
let ef = make_static_field_access c cf (map cf.cf_type) p in
make_call ctx ef args (map t) p
@@ -274,17 +396,17 @@ let raise_with_type_error ?(depth = 0) msg p =
raise (WithTypeError (make_error ~depth (Custom msg) p))
let raise_or_display ctx l p =
- if ctx.untyped then ()
- else if ctx.in_call_args then raise (WithTypeError (make_error (Unify l) p))
+ if ctx.f.untyped then ()
+ else if ctx.f.in_call_args then raise (WithTypeError (make_error (Unify l) p))
else display_error_ext ctx.com (make_error (Unify l) p)
let raise_or_display_error ctx err =
- if ctx.untyped then ()
- else if ctx.in_call_args then raise (WithTypeError err)
+ if ctx.f.untyped then ()
+ else if ctx.f.in_call_args then raise (WithTypeError err)
else display_error_ext ctx.com err
let raise_or_display_message ctx msg p =
- if ctx.in_call_args then raise_with_type_error msg p
+ if ctx.f.in_call_args then raise_with_type_error msg p
else display_error ctx.com msg p
let unify ctx t1 t2 p =
@@ -305,8 +427,8 @@ let unify_raise_custom uctx t1 t2 p =
let unify_raise = unify_raise_custom default_unification_context
let save_locals ctx =
- let locals = ctx.locals in
- (fun() -> ctx.locals <- locals)
+ let locals = ctx.f.locals in
+ (fun() -> ctx.f.locals <- locals)
let add_local ctx k n t p =
let v = alloc_var k n t p in
@@ -314,9 +436,9 @@ let add_local ctx k n t p =
match k with
| VUser _ ->
begin try
- let v' = PMap.find n ctx.locals in
+ let v' = PMap.find n ctx.f.locals in
(* ignore std lib *)
- if not (List.exists (ExtLib.String.starts_with p.pfile) ctx.com.std_path) then begin
+ if not (List.exists (fun path -> ExtLib.String.starts_with p.pfile (path#path)) ctx.com.class_paths#get_std_paths) then begin
warning ctx WVarShadow "This variable shadows a previously declared variable" p;
warning ~depth:1 ctx WVarShadow (compl_msg "Previous variable was here") v'.v_pos
end
@@ -326,7 +448,7 @@ let add_local ctx k n t p =
| _ ->
()
end;
- ctx.locals <- PMap.add n v ctx.locals;
+ ctx.f.locals <- PMap.add n v ctx.f.locals;
v
let display_identifier_error ctx ?prepend_msg msg p =
@@ -394,36 +516,19 @@ let is_gen_local v = match v.v_kind with
| _ ->
false
-let make_delay pass fl = {
- delay_pass = pass;
- delay_functions = fl;
-}
-
let delay ctx p f =
- let rec loop = function
- | [] ->
- [make_delay p [f]]
- | delay :: rest ->
- if delay.delay_pass = p then
- (make_delay p (f :: delay.delay_functions)) :: rest
- else if delay.delay_pass < p then
- delay :: loop rest
- else
- (make_delay p [f]) :: delay :: rest
- in
- ctx.g.delayed <- loop ctx.g.delayed
+ let p = Obj.magic p in
+ let tasks = ctx.g.delayed.(p) in
+ tasks.tasks <- f :: tasks.tasks;
+ if p < ctx.g.delayed_min_index then
+ ctx.g.delayed_min_index <- p
let delay_late ctx p f =
- let rec loop = function
- | [] ->
- [make_delay p [f]]
- | delay :: rest ->
- if delay.delay_pass <= p then
- delay :: loop rest
- else
- (make_delay p [f]) :: delay :: rest
- in
- ctx.g.delayed <- loop ctx.g.delayed
+ let p = Obj.magic p in
+ let tasks = ctx.g.delayed.(p) in
+ tasks.tasks <- tasks.tasks @ [f];
+ if p < ctx.g.delayed_min_index then
+ ctx.g.delayed_min_index <- p
let delay_if_mono ctx p t f = match follow t with
| TMono _ ->
@@ -432,17 +537,24 @@ let delay_if_mono ctx p t f = match follow t with
f()
let rec flush_pass ctx p where =
- match ctx.g.delayed with
- | delay :: rest when delay.delay_pass <= p ->
- (match delay.delay_functions with
- | [] ->
- ctx.g.delayed <- rest;
- | f :: l ->
- ctx.g.delayed <- (make_delay delay.delay_pass l) :: rest;
- f());
- flush_pass ctx p where
- | _ ->
- ()
+ let rec loop i =
+ if i > (Obj.magic p) then
+ ()
+ else begin
+ let tasks = ctx.g.delayed.(i) in
+ match tasks.tasks with
+ | f :: l ->
+ tasks.tasks <- l;
+ f();
+ flush_pass ctx p where
+ | [] ->
+ (* Done with this pass (for now), update min index to next one *)
+ let i = i + 1 in
+ ctx.g.delayed_min_index <- i;
+ loop i
+ end
+ in
+ loop ctx.g.delayed_min_index
let make_pass ctx f = f
@@ -505,11 +617,21 @@ let is_forced_inline c cf =
let needs_inline ctx c cf =
cf.cf_kind = Method MethInline && ctx.allow_inline && (ctx.g.doinline || is_forced_inline c cf)
+let clone_type_parameter map path ttp =
+ let c = ttp.ttp_class in
+ let c = {c with cl_path = path} in
+ let def = Option.map map ttp.ttp_default in
+ let constraints = match ttp.ttp_constraints with
+ | None -> None
+ | Some constraints -> Some (lazy (List.map map (Lazy.force constraints)))
+ in
+ mk_type_param c ttp.ttp_host def constraints
+
(** checks if we can access to a given class field using current context *)
let can_access ctx c cf stat =
if (has_class_field_flag cf CfPublic) then
true
- else if c == ctx.curclass then
+ else if c == ctx.c.curclass then
true
else match ctx.m.curmod.m_statics with
| Some c' when c == c' ->
@@ -562,24 +684,24 @@ let can_access ctx c cf stat =
in
loop c.cl_meta || loop f.cf_meta
in
- let module_path = ctx.curclass.cl_module.m_path in
+ let module_path = ctx.c.curclass.cl_module.m_path in
let cur_paths = ref [fst module_path @ [snd module_path], false] in
let rec loop c is_current_path =
- cur_paths := (make_path c ctx.curfield, is_current_path) :: !cur_paths;
+ cur_paths := (make_path c ctx.f.curfield, is_current_path) :: !cur_paths;
begin match c.cl_super with
| Some (csup,_) -> loop csup false
| None -> ()
end;
List.iter (fun (c,_) -> loop c false) c.cl_implements;
in
- loop ctx.curclass true;
+ loop ctx.c.curclass true;
let is_constr = cf.cf_name = "new" in
let rec loop c =
try
- has Meta.Access ctx.curclass ctx.curfield ((make_path c cf), true)
+ has Meta.Access ctx.c.curclass ctx.f.curfield ((make_path c cf), true)
|| (
(* if our common ancestor declare/override the field, then we can access it *)
- let allowed f = extends ctx.curclass c || (List.exists (has Meta.Allow c f) !cur_paths) in
+ let allowed f = extends ctx.c.curclass c || (List.exists (has Meta.Allow c f) !cur_paths) in
if is_constr then (
match c.cl_constructor with
| Some cf ->
@@ -602,10 +724,10 @@ let can_access ctx c cf stat =
| KTypeParameter ttp ->
List.exists (fun t -> match follow t with TInst(c,_) -> loop c | _ -> false) (get_constraints ttp)
| _ -> false)
- || (Meta.has Meta.PrivateAccess ctx.meta)
+ || (Meta.has Meta.PrivateAccess ctx.f.meta)
let check_field_access ctx c f stat p =
- if not ctx.untyped && not (can_access ctx c f stat) then
+ if not ctx.f.untyped && not (can_access ctx c f stat) then
display_error ctx.com ("Cannot access private field " ^ f.cf_name) p
(** removes the first argument of the class field's function type and all its overloads *)
@@ -682,29 +804,18 @@ let safe_mono_close ctx m p =
raise_or_display ctx l p
let relative_path ctx file =
- let slashes path = String.concat "/" (ExtString.String.nsplit path "\\") in
- let fpath = slashes (Path.get_full_path file) in
- let fpath_lower = String.lowercase_ascii fpath in
- let flen = String.length fpath_lower in
- let rec loop = function
- | [] -> file
- | path :: l ->
- let spath = String.lowercase_ascii (slashes path) in
- let slen = String.length spath in
- if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then String.sub fpath slen (flen - slen) else loop l
- in
- loop ctx.com.Common.class_path
+ ctx.com.class_paths#relative_path file
let mk_infos ctx p params =
let file = if ctx.com.is_macro_context then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in
(EObjectDecl (
(("fileName",null_pos,NoQuotes) , (EConst (String(file,SDoubleQuotes)) , p)) ::
(("lineNumber",null_pos,NoQuotes) , (EConst (Int (string_of_int (Lexer.get_error_line p), None)),p)) ::
- (("className",null_pos,NoQuotes) , (EConst (String (s_type_path ctx.curclass.cl_path,SDoubleQuotes)),p)) ::
- if ctx.curfield.cf_name = "" then
+ (("className",null_pos,NoQuotes) , (EConst (String (s_type_path ctx.c.curclass.cl_path,SDoubleQuotes)),p)) ::
+ if ctx.f.curfield.cf_name = "" then
params
else
- (("methodName",null_pos,NoQuotes), (EConst (String (ctx.curfield.cf_name,SDoubleQuotes)),p)) :: params
+ (("methodName",null_pos,NoQuotes), (EConst (String (ctx.f.curfield.cf_name,SDoubleQuotes)),p)) :: params
) ,p)
let rec is_pos_infos = function
@@ -751,8 +862,8 @@ let push_this ctx e = match e.eexpr with
let create_deprecation_context ctx = {
(DeprecationCheck.create_context ctx.com) with
- class_meta = ctx.curclass.cl_meta;
- field_meta = ctx.curfield.cf_meta;
+ class_meta = ctx.c.curclass.cl_meta;
+ field_meta = ctx.f.curfield.cf_meta;
curmod = ctx.m.curmod;
}
@@ -798,14 +909,14 @@ let debug com (path : string list) str =
end
let init_class_done ctx =
- let path = fst ctx.curclass.cl_path @ [snd ctx.curclass.cl_path] in
- debug ctx.com path ("init_class_done " ^ s_type_path ctx.curclass.cl_path);
+ let path = fst ctx.c.curclass.cl_path @ [snd ctx.c.curclass.cl_path] in
+ debug ctx.com path ("init_class_done " ^ s_type_path ctx.c.curclass.cl_path);
init_class_done ctx
let ctx_pos ctx =
let inf = fst ctx.m.curmod.m_path @ [snd 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 = (match snd ctx.c.curclass.cl_path with "" -> inf | n when n = snd ctx.m.curmod.m_path -> inf | n -> inf @ [n]) in
+ let inf = (match ctx.f.curfield.cf_name with "" -> inf | n -> inf @ [n]) in
inf
let pass_infos ctx p =
diff --git a/src/core/classPath.ml b/src/core/classPath.ml
new file mode 100644
index 00000000000..2ad8ebb88b4
--- /dev/null
+++ b/src/core/classPath.ml
@@ -0,0 +1,62 @@
+type class_path_scope =
+ | Std
+ | StdTarget
+ | Lib
+ | User
+
+type file_kind =
+ | FFile
+
+class virtual class_path (path : string) (scope : class_path_scope) (file_kind : file_kind) = object(self)
+ method path = path;
+ method scope = scope;
+ method file_kind = file_kind;
+
+ method virtual clone : class_path
+ method virtual clear_cache : unit
+ method virtual get_directory_path : string option
+ method virtual get_uncached_dir_listing : string -> (string * string array) option
+ method virtual dump : unit
+
+ method is_std_path = match scope with
+ | Std -> true
+ | _ -> false
+
+ method scope_string = match scope with
+ | Std -> "Std"
+ | StdTarget -> "StdTarget"
+ | Lib -> "Lib"
+ | User -> "User"
+end
+
+class directory_class_path (path : string) (scope : class_path_scope) = object(self)
+ inherit class_path path scope FFile
+
+ val readdir_cache = new Lookup.hashtbl_lookup
+
+ method clear_cache =
+ readdir_cache#clear
+
+ method get_directory_path =
+ Some path
+
+ method clone =
+ new directory_class_path path scope
+
+ method get_uncached_dir_listing (f : string) =
+ let file = path ^ f in
+ let dir = Filename.dirname file in
+ if readdir_cache#mem dir then
+ None
+ else begin
+ let dir_listing =
+ try Some (dir,Sys.readdir dir);
+ with Sys_error _ -> None
+ in
+ readdir_cache#add dir dir_listing;
+ dir_listing
+ end
+
+ method dump =
+ print_endline (Printf.sprintf " dir %-9s: %s" (self#scope_string) path)
+end
\ No newline at end of file
diff --git a/src/core/classPaths.ml b/src/core/classPaths.ml
new file mode 100644
index 00000000000..f7710aa1fad
--- /dev/null
+++ b/src/core/classPaths.ml
@@ -0,0 +1,181 @@
+open StringHelper
+open ClassPath
+
+type resolved_file = {
+ file : string;
+ class_path : class_path;
+}
+
+let create_resolved_file file class_path = {
+ file;
+ class_path;
+}
+
+(* We need to clean-up absolute ("") vs. cwd ("."). *)
+let absolute_class_path = new directory_class_path "" User
+
+class class_paths = object(self)
+ val mutable l = []
+ val file_lookup_cache = new Lookup.hashtbl_lookup;
+ val mutable platform_ext = ""
+ val mutable is_loading_core_api = false
+
+ method lock_context (platform_name : string) (core_api : bool) : unit =
+ platform_ext <- "." ^ platform_name;
+ is_loading_core_api <- core_api;
+ self#clear_cache
+
+ method as_string_list =
+ List.map (fun cp -> cp#path) l
+
+ method add (cp : class_path) =
+ l <- cp :: l;
+ self#clear_cache
+
+ method push (cp : class_path) =
+ l <- l @ [cp];
+ self#clear_cache
+
+ method find (f : class_path -> bool) =
+ List.find f l
+
+ method iter (f : class_path -> unit) =
+ List.iter f l
+
+ method exists (f : class_path -> bool) =
+ List.exists f l
+
+ method filter (f : class_path -> bool) =
+ List.filter f l
+
+ method modify (f : class_path -> class_path list) (cpl : class_path list) =
+ let rec loop acc l = match l with
+ | [] ->
+ List.rev acc
+ | cp :: l ->
+ let cpl = f cp in
+ loop (cpl @ acc) l
+ in
+ l <- loop [] cpl;
+ self#clear_cache
+
+ method modify_inplace (f : class_path -> class_path list) =
+ self#modify f l
+
+ method get_std_paths =
+ self#filter (fun cp -> cp#is_std_path)
+
+ method as_list =
+ l
+
+ method clear_cache =
+ file_lookup_cache#clear;
+ List.iter (fun cp -> cp#clear_cache) l
+
+ method cache_directory (cp : class_path) (dir : string) (f_search : string) (dir_listing : string array) =
+ (*
+ This function is invoked for each file in the `dir`.
+ Each file is checked if it's specific for current platform
+ (e.g. ends with `.js.hx` while compiling for JS).
+ If it's not platform-specific:
+ Check the lookup cache and if the file is not there store full file path in the cache.
+ If the file is platform-specific:
+ Store the full file path in the lookup cache probably replacing the cached path to a
+ non-platform-specific file.
+ *)
+ let found = ref None in
+ let f_dir = Filename.dirname f_search in
+ let prepare_file file_own_name =
+ let relative_to_classpath = if f_dir = "." then file_own_name else f_dir ^ "/" ^ file_own_name in
+ (* `representation` is how the file is referenced to. E.g. when it's deduced from a module path. *)
+ let is_platform_specific,representation =
+ (* Platform specific file extensions are not allowed for loading @:coreApi types. *)
+ if is_loading_core_api then
+ false,relative_to_classpath
+ else begin
+ let ext = extension relative_to_classpath in
+ let second_ext = extension (remove_extension relative_to_classpath) in
+ (* The file contains double extension and the secondary one matches current platform *)
+ if platform_ext = second_ext then
+ true,(remove_extension (remove_extension relative_to_classpath)) ^ ext
+ else
+ false,relative_to_classpath
+ end
+ in
+ (*
+ Store current full path for `representation` if
+ - we're loading @:coreApi
+ - or this is a platform-specific file for `representation`
+ - this `representation` was never found before
+ *)
+ if is_loading_core_api || is_platform_specific || not (file_lookup_cache#mem representation) then begin
+ let full_path = if dir = "." then file_own_name else dir ^ "/" ^ file_own_name in
+ let full_path = Some(create_resolved_file full_path cp) in
+ file_lookup_cache#add representation full_path;
+ if representation = f_search then found := full_path
+ end
+ in
+ Array.iter prepare_file dir_listing;
+ !found
+
+ method find_file_noraise (f : string) =
+ try
+ match file_lookup_cache#find f with
+ | None ->
+ None
+ | Some f ->
+ Some f
+ with
+ | Not_found when Path.is_absolute_path f ->
+ let r = if Sys.file_exists f then
+ Some (create_resolved_file f absolute_class_path)
+ else
+ None
+ in
+ file_lookup_cache#add f r;
+ r
+ | Not_found ->
+ let rec loop = function
+ | [] ->
+ None
+ | cp :: l ->
+ begin match cp#get_uncached_dir_listing f with
+ | None ->
+ loop l
+ | Some(dir,dir_listing) ->
+ match self#cache_directory cp dir f dir_listing with
+ | Some f ->
+ Some f
+ | None ->
+ loop l
+ end
+ in
+ let r = loop l in
+ file_lookup_cache#add f r;
+ r
+
+ method find_file (f : string) =
+ match self#find_file_noraise f with
+ | None -> raise Not_found
+ | Some f -> f
+
+ method relative_path file =
+ let slashes path = String.concat "/" (ExtString.String.nsplit path "\\") in
+ let fpath = slashes (Path.get_full_path file) in
+ let fpath_lower = String.lowercase_ascii fpath in
+ let flen = String.length fpath_lower in
+ let rec loop = function
+ | [] ->
+ file
+ | path :: l ->
+ let path = path#path in
+ let spath = String.lowercase_ascii (slashes path) in
+ let slen = String.length spath in
+ if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then String.sub fpath slen (flen - slen) else loop l
+ in
+ loop l
+
+ method dump =
+ print_endline (Printf.sprintf "Class paths for %s%s:" platform_ext (if is_loading_core_api then " (coreApi)" else ""));
+ List.iter (fun cp -> cp#dump) l
+end
diff --git a/src/core/data/dataReaderApi.ml b/src/core/data/dataReaderApi.ml
new file mode 100644
index 00000000000..b8539ab9ce4
--- /dev/null
+++ b/src/core/data/dataReaderApi.ml
@@ -0,0 +1,17 @@
+module type DataReaderApi = sig
+ type data
+
+ val read_optional : data -> (data -> unit) -> unit
+
+ val read_object : data -> (string * data) list
+
+ val read_array : data -> data list
+
+ val read_string : data -> string
+
+ val read_bool : data -> bool
+
+ val read_int : data -> int
+
+ val data_to_string : data -> string
+end
\ No newline at end of file
diff --git a/src/core/data/dataWriterApi.ml b/src/core/data/dataWriterApi.ml
new file mode 100644
index 00000000000..bf04eafd274
--- /dev/null
+++ b/src/core/data/dataWriterApi.ml
@@ -0,0 +1,15 @@
+module type DataWriterApi = sig
+ type data
+
+ val write_optional : data option -> data
+
+ val write_object : (string * data) list -> data
+
+ val write_array : data list -> data
+
+ val write_string : string -> data
+
+ val write_bool : bool -> data
+
+ val write_int : int -> data
+end
\ No newline at end of file
diff --git a/src/core/data/jsonDataApi.ml b/src/core/data/jsonDataApi.ml
new file mode 100644
index 00000000000..d3620db2aa8
--- /dev/null
+++ b/src/core/data/jsonDataApi.ml
@@ -0,0 +1,48 @@
+open Json
+
+let error s =
+ (* TODO: should this raise something else? *)
+ Error.raise_typing_error s Globals.null_pos
+
+module JsonReaderApi = struct
+ type data = Json.t
+
+ let read_optional json f = match json with
+ | JNull ->
+ ()
+ | _ ->
+ f json
+
+ let read_object json = match json with
+ | JObject fl ->
+ fl
+ | _ ->
+ error (Printf.sprintf "Expected JObject, found %s" (string_of_json json))
+
+ let read_array json = match json with
+ | JArray l ->
+ l
+ | _ ->
+ error (Printf.sprintf "Expected JArray, found %s" (string_of_json json))
+
+ let read_string json = match json with
+ | JString s ->
+ s
+ | _ ->
+ error (Printf.sprintf "Expected JString, found %s" (string_of_json json))
+
+ let read_int json = match json with
+ | JInt i ->
+ i
+ | _ ->
+ error (Printf.sprintf "Expected JInt, found %s" (string_of_json json))
+
+ let read_bool json = match json with
+ | JBool b ->
+ b
+ | _ ->
+ error (Printf.sprintf "Expected JBool, found %s" (string_of_json json))
+
+ let data_to_string json =
+ string_of_json json
+end
\ No newline at end of file
diff --git a/src/core/define.ml b/src/core/define.ml
index e646586728f..d71055df6d4 100644
--- a/src/core/define.ml
+++ b/src/core/define.ml
@@ -152,7 +152,7 @@ let get_signature def =
Parser.parse_macro_ident as well (issue #5682).
Note that we should removed flags like use_rtti_doc here.
*)
- | "display" | "use_rtti_doc" | "macro_times" | "display_details" | "no_copt" | "display_stdin"
+ | "display" | "use_rtti_doc" | "macro_times" | "display_details" | "no_copt" | "display_stdin" | "hxb.stats"
| "message.reporting" | "message.log_file" | "message.log_format" | "message.no_color"
| "dump" | "dump_dependencies" | "dump_ignore_var_ids" -> acc
| _ -> (k ^ "=" ^ v) :: acc
diff --git a/src/core/ds/ring.ml b/src/core/ds/ring.ml
index a98e7a59529..4ec861f727d 100644
--- a/src/core/ds/ring.ml
+++ b/src/core/ds/ring.ml
@@ -39,6 +39,21 @@ let fold r acc f =
in
loop 0 acc
+let find r f =
+ let len = Array.length r.values in
+ let rec loop i =
+ if i = len then
+ raise Not_found
+ else begin
+ let v = r.values.(i) in
+ if f v then
+ v
+ else
+ loop (i + 1)
+ end
+ in
+ loop 0
+
let is_filled r =
r.num_filled >= Array.length r.values
diff --git a/src/core/globals.ml b/src/core/globals.ml
index e7a834787cb..a7574572d0a 100644
--- a/src/core/globals.ml
+++ b/src/core/globals.ml
@@ -68,10 +68,6 @@ let trace_call_stack ?(n:int = 5) () =
Option.may (fun loc -> print_endline (Printf.sprintf " called from %s" (loc_to_string loc))) loc;
done
-let macro_platform = ref Neko
-
-let return_partial_type = ref false
-
let is_windows = Sys.os_type = "Win32" || Sys.os_type = "Cygwin"
let max_custom_target_len = 16
diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml
index a6b1b9d529e..72b3d4fa951 100644
--- a/src/core/json/genjson.ml
+++ b/src/core/json/genjson.ml
@@ -215,9 +215,7 @@ let rec generate_type ctx t =
| Some t -> loop t
end
| TLazy f ->
- (* return_partial_type := true; *)
let t = lazy_type f in
- (* return_partial_type := false; *)
loop t
| TDynamic None -> "TDynamic", Some jnull
| TDynamic (Some t) -> "TDynamic",Some (generate_type ctx t)
@@ -623,7 +621,7 @@ let generate_class ctx c =
"fields",jlist (generate_class_field ctx CFSMember) c.cl_ordered_fields;
"statics",jlist (generate_class_field ctx CFSStatic) c.cl_ordered_statics;
"constructor",jopt (generate_class_field ctx CFSConstructor) c.cl_constructor;
- "init",jopt (generate_texpr ctx) c.cl_init;
+ "init",jopt (generate_texpr ctx) (TClass.get_cl_init c);
"overrides",jlist (classfield_ref ctx) (List.filter (fun cf -> has_class_field_flag cf CfOverride) c.cl_ordered_fields);
"isExtern",jbool (has_class_flag c CExtern);
"isFinal",jbool (has_class_flag c CFinal);
@@ -703,7 +701,7 @@ let generate_module_type ctx mt =
(* module *)
-let generate_module cs cc m =
+let generate_module modules find_module m =
jobject [
"id",jint m.m_id;
"path",generate_module_path m.m_path;
@@ -714,19 +712,19 @@ let generate_module cs cc m =
| MSGood -> "Good"
| MSBad reason -> Printer.s_module_skip_reason reason
| MSUnknown -> "Unknown");
- "dependencies",jarray (PMap.fold (fun (sign,mpath) acc ->
+ "dependencies",jarray (PMap.fold (fun mdep acc ->
(jobject [
- "path",jstring (s_type_path mpath);
- "sign",jstring (Digest.to_hex ((cs#get_context sign)#find_module mpath).m_extra.m_sign);
+ "path",jstring (s_type_path mdep.md_path);
+ "sign",jstring (Digest.to_hex (find_module mdep.md_path).m_extra.m_sign);
]) :: acc
) m.m_extra.m_deps []);
- "dependents",jarray (List.map (fun m -> (jobject [
- "path",jstring (s_type_path m.m_path);
- "sign",jstring (Digest.to_hex m.m_extra.m_sign);
- ])) (Hashtbl.fold (fun _ m' acc ->
- if PMap.mem m.m_id m'.m_extra.m_deps then m' :: acc
+ "dependents",jarray (List.map (fun (path, sign) -> (jobject [
+ "path",jstring (s_type_path path);
+ "sign",jstring (Digest.to_hex sign);
+ ])) (Hashtbl.fold (fun _ (m':HxbData.module_cache) acc ->
+ if PMap.mem m.m_id m'.mc_extra.m_deps then (m'.mc_path, m'.mc_extra.m_sign) :: acc
else acc
- ) cc#get_modules []));
+ ) modules []));
]
let create_context ?jsonrpc gm = {
diff --git a/src/core/stringHelper.ml b/src/core/stringHelper.ml
index ab6c57df5cd..824e8e1aa99 100644
--- a/src/core/stringHelper.ml
+++ b/src/core/stringHelper.ml
@@ -57,4 +57,15 @@ let escape_res_name name allowed =
else if List.mem chr allowed then
Char.escaped chr
else
- "-x" ^ (string_of_int (Char.code chr))) name
\ No newline at end of file
+ "-x" ^ (string_of_int (Char.code chr))) name
+
+let remove_extension file =
+ try String.sub file 0 (String.rindex file '.')
+ with Not_found -> file
+
+let extension file =
+ try
+ let dot_pos = String.rindex file '.' in
+ String.sub file dot_pos (String.length file - dot_pos)
+ with Not_found ->
+ file
\ No newline at end of file
diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml
index 247970f5428..1c0a68c65e1 100644
--- a/src/core/tFunctions.ml
+++ b/src/core/tFunctions.ml
@@ -58,9 +58,9 @@ let has_var_flag v (flag : flag_tvar) =
(* ======= General utility ======= *)
-let alloc_var =
+let alloc_var' =
let uid = ref 0 in
- (fun kind n t p ->
+ uid,(fun kind n t p ->
incr uid;
{
v_kind = kind;
@@ -74,6 +74,10 @@ let alloc_var =
}
)
+let alloc_var =
+ let _,alloc_var = alloc_var' in
+ alloc_var
+
let alloc_mid =
let mid = ref 0 in
(fun() -> incr mid; !mid)
@@ -97,18 +101,32 @@ let mk_anon ?fields status =
let fields = match fields with Some fields -> fields | None -> PMap.empty in
TAnon { a_fields = fields; a_status = status; }
-(* We use this for display purposes because otherwise we never see the Dynamic type that
- is defined in StdTypes.hx. This is set each time a typer is created, but this is fine
- because Dynamic is the same in all contexts. If this ever changes we'll have to review
- how we handle this. *)
-let t_dynamic_def = ref t_dynamic
-
let tfun pl r = TFun (List.map (fun t -> "",false,t) pl,r)
let fun_args l = List.map (fun (a,c,t) -> a, c <> None, t) l
-let mk_class m path pos name_pos =
+let mk_typedef m path pos name_pos t =
{
+ t_path = path;
+ t_module = m;
+ t_pos = pos;
+ t_name_pos = name_pos;
+ t_private = false;
+ t_doc = None;
+ t_meta = [];
+ t_params = [];
+ t_using = [];
+ t_type = t;
+ t_restore = (fun () -> ());
+ }
+
+let class_module_type c =
+ let path = ([],"Class<" ^ (s_type_path c.cl_path) ^ ">") in
+ let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in
+ { (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true}
+
+let mk_class m path pos name_pos =
+ let c = {
cl_path = path;
cl_module = m;
cl_pos = pos;
@@ -118,6 +136,7 @@ let mk_class m path pos name_pos =
cl_private = false;
cl_kind = KNormal;
cl_flags = 0;
+ cl_type = t_dynamic;
cl_params = [];
cl_using = [];
cl_super = None;
@@ -133,22 +152,9 @@ let mk_class m path pos name_pos =
cl_build = (fun() -> Built);
cl_restore = (fun() -> ());
cl_descendants = [];
- }
-
-let mk_typedef m path pos name_pos t =
- {
- t_path = path;
- t_module = m;
- t_pos = pos;
- t_name_pos = name_pos;
- t_private = false;
- t_doc = None;
- t_meta = [];
- t_params = [];
- t_using = [];
- t_type = t;
- t_restore = (fun () -> ());
- }
+ } in
+ c.cl_type <- TType(class_module_type c,[]);
+ c
let module_extra file sign time kind added policy =
{
@@ -167,7 +173,6 @@ let module_extra file sign time kind added policy =
m_deps = PMap.empty;
m_kind = kind;
m_cache_bound_objects = DynArray.create ();
- m_if_feature = [];
m_features = Hashtbl.create 0;
m_check_policy = policy;
}
@@ -206,6 +211,8 @@ let find_field c name kind =
PMap.find name c.cl_statics
| CfrMember ->
PMap.find name c.cl_fields
+ | CfrInit ->
+ begin match c.cl_init with Some cf -> cf | None -> raise Not_found end
let null_module = {
m_id = alloc_mid();
@@ -283,8 +290,8 @@ let null_abstract = {
}
let add_dependency ?(skip_postprocess=false) m mdep =
- if m != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin
- m.m_extra.m_deps <- PMap.add mdep.m_id (mdep.m_extra.m_sign, mdep.m_path) m.m_extra.m_deps;
+ if m != null_module && mdep != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin
+ m.m_extra.m_deps <- PMap.add mdep.m_id ({md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind}) m.m_extra.m_deps;
(* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *)
if not skip_postprocess then m.m_extra.m_processed <- 0
end
@@ -715,14 +722,17 @@ let lookup_param n l =
in
loop l
-let mk_type_param c host def constraints = {
- ttp_name = snd c.cl_path;
- ttp_type = TInst(c,[]);
- ttp_class = c;
- ttp_host = host;
- ttp_constraints = constraints;
- ttp_default = def;
-}
+let mk_type_param c host def constraints =
+ let ttp = {
+ ttp_name = snd c.cl_path;
+ ttp_type = TInst(c,[]);
+ ttp_class = c;
+ ttp_host = host;
+ ttp_constraints = constraints;
+ ttp_default = def;
+ } in
+ c.cl_kind <- KTypeParameter ttp;
+ ttp
let type_of_module_type = function
| TClassDecl c -> TInst (c,extract_param_types c.cl_params)
@@ -940,14 +950,9 @@ let var_extra params e = {
v_expr = e;
}
-let class_module_type c =
- let path = ([],"Class<" ^ (s_type_path c.cl_path) ^ ">") in
- let t = mk_anon ~fields:c.cl_statics (ref (ClassStatics c)) in
- { (mk_typedef c.cl_module path c.cl_pos null_pos t) with t_private = true}
-
-let enum_module_type en fields =
+let enum_module_type en =
let path = ([], "Enum<" ^ (s_type_path en.e_path) ^ ">") in
- let t = mk_anon ~fields (ref (EnumStatics en)) in
+ let t = mk_anon (ref (EnumStatics en)) in
{(mk_typedef en.e_module path en.e_pos null_pos t) with t_private = true}
let abstract_module_type a tl =
@@ -963,4 +968,4 @@ let class_field_of_enum_field ef = {
);
cf_doc = ef.ef_doc;
cf_params = ef.ef_params;
-}
\ No newline at end of file
+}
diff --git a/src/core/tOther.ml b/src/core/tOther.ml
index 71bad6921ee..db5c5bc6fff 100644
--- a/src/core/tOther.ml
+++ b/src/core/tOther.ml
@@ -412,6 +412,30 @@ module TClass = struct
in
let apply = apply_params c.cl_params tl in
loop apply c
+
+
+ let get_cl_init c = match c.cl_init with
+ | Some {cf_expr = Some e} -> Some e
+ | _ -> None
+
+ let modify_cl_init c e append = match c.cl_init with
+ | Some cf ->
+ begin match cf.cf_expr with
+ | Some e' when append ->
+ cf.cf_expr <- Some (concat e' e)
+ | _ ->
+ cf.cf_expr <- Some e
+ end
+ | None ->
+ let cf = mk_field "__init__" t_dynamic null_pos null_pos in
+ cf.cf_expr <- Some e;
+ c.cl_init <- Some cf
+
+ let add_cl_init c e =
+ modify_cl_init c e true
+
+ let set_cl_init c e =
+ modify_cl_init c e false
end
let s_class_path c =
diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml
index 5ac61c1d827..954de7e1104 100644
--- a/src/core/tPrinting.ml
+++ b/src/core/tPrinting.ml
@@ -413,6 +413,7 @@ let s_class_field_ref_kind = function
| CfrStatic -> "CfrStatic"
| CfrMember -> "CfrMember"
| CfrConstructor -> "CfrConstructor"
+ | CfrInit -> "CfrInit"
module Printer = struct
@@ -506,7 +507,7 @@ module Printer = struct
"cl_super",s_opt (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_super;
"cl_implements",s_list ", " (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_implements;
"cl_array_access",s_opt s_type c.cl_array_access;
- "cl_init",s_opt (s_expr_ast true "" s_type) c.cl_init;
+ "cl_init",s_opt (s_expr_ast true "" s_type) (TOther.TClass.get_cl_init c);
"cl_constructor",s_opt (s_tclass_field (tabs ^ "\t")) c.cl_constructor;
"cl_ordered_fields",s_list "\n\t" (s_tclass_field (tabs ^ "\t")) c.cl_ordered_fields;
"cl_ordered_statics",s_list "\n\t" (s_tclass_field (tabs ^ "\t")) c.cl_ordered_statics;
@@ -640,11 +641,10 @@ module Printer = struct
"m_cache_state",s_module_cache_state me.m_cache_state;
"m_added",string_of_int me.m_added;
"m_checked",string_of_int me.m_checked;
- "m_deps",s_pmap string_of_int (fun (_,m) -> snd m) me.m_deps;
+ "m_deps",s_pmap string_of_int (fun mdep -> snd mdep.md_path) me.m_deps;
"m_processed",string_of_int me.m_processed;
"m_kind",s_module_kind me.m_kind;
"m_binded_res",""; (* TODO *)
- "m_if_feature",""; (* TODO *)
"m_features",""; (* TODO *)
]
diff --git a/src/core/tType.ml b/src/core/tType.ml
index 2ae0c85886b..205d4415e91 100644
--- a/src/core/tType.ml
+++ b/src/core/tType.ml
@@ -30,7 +30,6 @@ type module_check_policy =
| CheckFileContentModification
| NoCheckDependencies
| NoCheckShadowing
- | Retype
type module_tainting_reason =
| CheckDisplayFile
@@ -289,6 +288,7 @@ and tclass = {
mutable cl_using : (tclass * pos) list;
mutable cl_restore : unit -> unit;
(* do not insert any fields above *)
+ mutable cl_type : t;
mutable cl_kind : tclass_kind;
mutable cl_flags : int;
mutable cl_super : (tclass * tparams) option;
@@ -300,7 +300,7 @@ and tclass = {
mutable cl_dynamic : t option;
mutable cl_array_access : t option;
mutable cl_constructor : tclass_field option;
- mutable cl_init : texpr option;
+ mutable cl_init : tclass_field option;
mutable cl_build : unit -> build_state;
(*
@@ -401,6 +401,12 @@ and module_def_display = {
mutable m_import_positions : (pos,bool ref) PMap.t;
}
+and module_dep = {
+ md_sign : Digest.t;
+ md_kind : module_kind;
+ md_path : path;
+}
+
and module_def_extra = {
m_file : Path.UniqueKey.lazy_t;
m_sign : Digest.t;
@@ -411,10 +417,9 @@ and module_def_extra = {
mutable m_added : int;
mutable m_checked : int;
mutable m_processed : int;
- mutable m_deps : (int,(Digest.t (* sign *) * path)) PMap.t;
+ mutable m_deps : (int,module_dep) PMap.t;
mutable m_kind : module_kind;
mutable m_cache_bound_objects : cache_bound_object DynArray.t;
- mutable m_if_feature : (string * class_field_ref) list;
mutable m_features : (string,bool) Hashtbl.t;
}
@@ -422,6 +427,7 @@ and class_field_ref_kind =
| CfrStatic
| CfrMember
| CfrConstructor
+ | CfrInit
and class_field_ref = {
cfr_sign : string;
@@ -443,6 +449,9 @@ and build_state =
| Building of tclass list
| BuildMacro of (unit -> unit) list ref
+
+exception Type_exception of t
+
type basic_types = {
mutable tvoid : t;
mutable tint : t;
@@ -464,6 +473,7 @@ type flag_tclass =
| CInterface
| CAbstract
| CFunctionalInterface
+ | CUsed (* Marker for DCE *)
type flag_tclass_field =
| CfPublic
@@ -479,10 +489,12 @@ type flag_tclass_field =
| CfGeneric
| CfDefault (* Interface field with default implementation (only valid on Java) *)
| CfPostProcessed (* Marker to indicate the field has been post-processed *)
+ | CfUsed (* Marker for DCE *)
+ | CfMaybeUsed (* Marker for DCE *)
(* Order has to match declaration for printing*)
let flag_tclass_field_names = [
- "CfPublic";"CfStatic";"CfExtern";"CfFinal";"CfModifiesThis";"CfOverride";"CfAbstract";"CfOverload";"CfImpl";"CfEnum";"CfGeneric";"CfDefault";"CfPostProcessed"
+ "CfPublic";"CfStatic";"CfExtern";"CfFinal";"CfModifiesThis";"CfOverride";"CfAbstract";"CfOverload";"CfImpl";"CfEnum";"CfGeneric";"CfDefault";"CfPostProcessed";"CfUsed";"CfMaybeUsed"
]
type flag_tvar =
@@ -493,6 +505,7 @@ type flag_tvar =
| VCaught
| VStatic
| VUsedByTyper (* Set if the typer looked up this variable *)
+ | VHxb (* Flag used by hxb *)
let flag_tvar_names = [
"VCaptured";"VFinal";"VAnalyzed";"VAssigned";"VCaught";"VStatic";"VUsedByTyper"
diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml
index 5206c21a23a..7be40f10d73 100644
--- a/src/core/tUnification.ml
+++ b/src/core/tUnification.ml
@@ -29,13 +29,16 @@ type eq_kind =
| EqRightDynamic
| EqBothDynamic
| EqDoNotFollowNull (* like EqStrict, but does not follow Null *)
+ | EqStricter
type unification_context = {
- allow_transitive_cast : bool;
- allow_abstract_cast : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *)
- allow_dynamic_to_cast : bool; (* allows a cast from dynamic to non-dynamic *)
- equality_kind : eq_kind;
- equality_underlying : bool;
+ allow_transitive_cast : bool;
+ allow_abstract_cast : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *)
+ allow_dynamic_to_cast : bool; (* allows a cast from dynamic to non-dynamic *)
+ allow_arg_name_mismatch : bool;
+ equality_kind : eq_kind;
+ equality_underlying : bool;
+ strict_field_kind : bool;
}
type unify_min_result =
@@ -54,11 +57,13 @@ let unify_ref : (unification_context -> t -> t -> unit) ref = ref (fun _ _ _ ->
let unify_min_ref : (unification_context -> t -> t list -> unify_min_result) ref = ref (fun _ _ _ -> assert false)
let default_unification_context = {
- allow_transitive_cast = true;
- allow_abstract_cast = true;
- allow_dynamic_to_cast = true;
- equality_kind = EqStrict;
- equality_underlying = false;
+ allow_transitive_cast = true;
+ allow_abstract_cast = true;
+ allow_dynamic_to_cast = true;
+ allow_arg_name_mismatch = true;
+ equality_kind = EqStrict;
+ equality_underlying = false;
+ strict_field_kind = false;
}
(* Unify like targets (e.g. Java) probably would. *)
@@ -68,6 +73,8 @@ let native_unification_context = {
allow_dynamic_to_cast = false;
equality_kind = EqStrict;
equality_underlying = false;
+ allow_arg_name_mismatch = true;
+ strict_field_kind = false;
}
module Monomorph = struct
@@ -239,25 +246,40 @@ module Monomorph = struct
and close m = match m.tm_type with
| Some _ ->
()
- | None -> match classify_down_constraints m with
+ | None ->
+ let get_recursion t =
+ let rec loop t = match t with
+ | TMono m2 when m == m2 ->
+ raise (Type_exception t)
+ | _ ->
+ TFunctions.iter loop t
+ in
+ try
+ loop t;
+ None
+ with Type_exception t ->
+ Some t
+ in
+ (* TODO: we never do anything with monos, I think *)
+ let monos,constraints = classify_down_constraints' m in
+ match constraints with
| CUnknown ->
()
| CTypes [(t,_)] ->
- do_bind m t;
- ()
+ (* TODO: silently not binding doesn't seem correct, but it's likely better than infinite recursion *)
+ if get_recursion t = None then do_bind m t;
| CTypes _ | CMixed _ ->
()
| CStructural(fields,_) ->
let check_recursion cf =
- let rec loop t = match t with
- | TMono m2 when m == m2 ->
- let pctx = print_context() in
- let s = Printf.sprintf "%s appears in { %s: %s }" (s_type pctx t) cf.cf_name (s_type pctx cf.cf_type) in
- raise (Unify_error [Unify_custom "Recursive type";Unify_custom s]);
- | _ ->
- TFunctions.map loop t
- in
- ignore(loop cf.cf_type);
+ begin match get_recursion cf.cf_type with
+ | Some t ->
+ let pctx = print_context() in
+ let s = Printf.sprintf "%s appears in { %s: %s }" (s_type pctx t) cf.cf_name (s_type pctx cf.cf_type) in
+ raise (Unify_error [Unify_custom "Recursive type";Unify_custom s]);
+ | None ->
+ ()
+ end
in
(* We found a bunch of fields but no type, create a merged structure type and bind to that *)
PMap.iter (fun _ cf -> check_recursion cf) fields;
@@ -347,6 +369,13 @@ let fast_eq_check type_param_check a b =
c1 == c2 && List.for_all2 type_param_check l1 l2
| TAbstract (a1,l1), TAbstract (a2,l2) ->
a1 == a2 && List.for_all2 type_param_check l1 l2
+ | TAnon an1,TAnon an2 ->
+ begin match !(an1.a_status),!(an2.a_status) with
+ | ClassStatics c, ClassStatics c2 -> c == c2
+ | EnumStatics e, EnumStatics e2 -> e == e2
+ | AbstractStatics a, AbstractStatics a2 -> a == a2
+ | _ -> false
+ end
| _ , _ ->
false
@@ -395,9 +424,6 @@ let rec shallow_eq a b =
loop (List.sort sort_compare fields1) (List.sort sort_compare fields2)
in
(match !(a2.a_status), !(a1.a_status) with
- | ClassStatics c, ClassStatics c2 -> c == c2
- | EnumStatics e, EnumStatics e2 -> e == e2
- | AbstractStatics a, AbstractStatics a2 -> a == a2
| Extend tl1, Extend tl2 -> fields_eq() && List.for_all2 shallow_eq tl1 tl2
| Closed, Closed -> fields_eq()
| Const, Const -> fields_eq()
@@ -432,15 +458,20 @@ let direct_access = function
| AccNo | AccNever | AccNormal | AccInline | AccRequire _ | AccCtor -> true
| AccCall -> false
-let unify_kind k1 k2 =
+let unify_kind ~(strict:bool) k1 k2 =
k1 = k2 || match k1, k2 with
| Var v1, Var v2 -> unify_access v1.v_read v2.v_read && unify_access v1.v_write v2.v_write
- | Var v, Method m ->
+ | Method m1, Method m2 ->
+ (match m1,m2 with
+ | MethInline, MethNormal
+ | MethDynamic, MethNormal -> true
+ | _ -> false)
+ | Var v, Method m when not strict ->
(match v.v_read, v.v_write, m with
| AccNormal, _, MethNormal -> true
| AccNormal, AccNormal, MethDynamic -> true
| _ -> false)
- | Method m, Var v ->
+ | Method m, Var v when not strict ->
(match m with
| MethDynamic -> direct_access v.v_read && direct_access v.v_write
| MethMacro -> false
@@ -448,11 +479,7 @@ let unify_kind k1 k2 =
match v.v_read,v.v_write with
| AccNormal,(AccNo | AccNever) -> true
| _ -> false)
- | Method m1, Method m2 ->
- match m1,m2 with
- | MethInline, MethNormal
- | MethDynamic, MethNormal -> true
- | _ -> false
+ | _ -> false
type 'a rec_stack = {
mutable rec_stack : 'a list;
@@ -494,7 +521,12 @@ let rec_stack_default stack value fcheck frun def =
let rec type_eq uctx a b =
let param = uctx.equality_kind in
+ let can_follow_null = match param with
+ | EqStricter | EqDoNotFollowNull -> false
+ | _ -> true
+ in
let can_follow t = match param with
+ | EqStricter -> false
| EqCoreType -> false
| EqDoNotFollowNull -> not (is_explicit_null t)
| _ -> true
@@ -510,11 +542,11 @@ let rec type_eq uctx a b =
| _ , TLazy f -> type_eq uctx a (lazy_type f)
| TMono t , _ ->
(match t.tm_type with
- | None -> if param = EqCoreType || not (link t a b) then error [cannot_unify a b]
+ | None -> if param = EqCoreType || param = EqStricter || not (link t a b) then error [cannot_unify a b]
| Some t -> type_eq uctx t b)
| _ , TMono t ->
(match t.tm_type with
- | None -> if param = EqCoreType || not (link t b a) then error [cannot_unify a b]
+ | None -> if param = EqCoreType || param = EqStricter || not (link t b a) then error [cannot_unify a b]
| Some t -> type_eq uctx a t)
| TDynamic None, TDynamic None ->
()
@@ -526,9 +558,9 @@ let rec type_eq uctx a b =
()
| TAbstract ({a_path=[],"Null"},[t1]),TAbstract ({a_path=[],"Null"},[t2]) ->
type_eq uctx t1 t2
- | TAbstract ({a_path=[],"Null"},[t]),_ when param <> EqDoNotFollowNull ->
+ | TAbstract ({a_path=[],"Null"},[t]),_ when can_follow_null ->
type_eq uctx t b
- | _,TAbstract ({a_path=[],"Null"},[t]) when param <> EqDoNotFollowNull ->
+ | _,TAbstract ({a_path=[],"Null"},[t]) when can_follow_null ->
type_eq uctx a t
| TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 ->
type_eq_params uctx a b tl1 tl2
@@ -550,9 +582,10 @@ let rec type_eq uctx a b =
let i = ref 0 in
(try
type_eq uctx r1 r2;
- List.iter2 (fun (n,o1,t1) (_,o2,t2) ->
+ List.iter2 (fun (n1,o1,t1) (n2,o2,t2) ->
incr i;
- if o1 <> o2 then error [Not_matching_optional n];
+ if not uctx.allow_arg_name_mismatch && n1 <> n2 then error [Unify_custom (Printf.sprintf "Arg name mismatch: %s should be %s" n2 n1)];
+ if o1 <> o2 then error [Not_matching_optional n1];
type_eq uctx t1 t2
) l1 l2
with
@@ -574,19 +607,27 @@ let rec type_eq uctx a b =
| AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
| _ -> ()
);
+ let fields = match !(a1.a_status) with
+ | ClassStatics c -> c.cl_statics
+ | _ -> a1.a_fields
+ in
PMap.iter (fun n f1 ->
try
let f2 = PMap.find n a2.a_fields in
- if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
+ let kind_should_match = match param with
+ | EqStrict | EqCoreType | EqDoNotFollowNull | EqStricter -> true
+ | _ -> false
+ in
+ if f1.cf_kind <> f2.cf_kind && (kind_should_match || not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
let a = f1.cf_type and b = f2.cf_type in
(try type_eq uctx a b with Unify_error l -> error (invalid_field n :: l));
if (has_class_field_flag f1 CfPublic) != (has_class_field_flag f2 CfPublic) then error [invalid_visibility n];
with
Not_found ->
error [has_no_field b n];
- ) a1.a_fields;
+ ) fields;
PMap.iter (fun n f2 ->
- if not (PMap.mem n a1.a_fields) then begin
+ if not (PMap.mem n fields) then begin
error [has_no_field a n];
end;
) a2.a_fields;
@@ -615,7 +656,7 @@ let type_iseq uctx a b =
let type_iseq_strict a b =
try
- type_eq {default_unification_context with equality_kind = EqDoNotFollowNull} a b;
+ type_eq {default_unification_context with equality_kind = EqStricter} a b;
true
with Unify_error _ ->
false
@@ -645,11 +686,11 @@ let rec unify (uctx : unification_context) a b =
| _ , TLazy f -> unify uctx a (lazy_type f)
| TMono t , _ ->
(match t.tm_type with
- | None -> if not (link t a b) then error [cannot_unify a b]
+ | None -> if uctx.equality_kind = EqStricter || not (link t a b) then error [cannot_unify a b]
| Some t -> unify uctx t b)
| _ , TMono t ->
(match t.tm_type with
- | None -> if not (link t b a) then error [cannot_unify a b]
+ | None -> if uctx.equality_kind = EqStricter || not (link t b a) then error [cannot_unify a b]
| Some t -> unify uctx a t)
| TType (t,tl) , _ ->
rec_stack unify_stack (a,b)
@@ -754,7 +795,7 @@ let rec unify (uctx : unification_context) a b =
in
let _, ft, f1 = (try raw_class_field make_type c tl n with Not_found -> error [has_no_field a n]) in
let ft = apply_params c.cl_params tl ft in
- if not (unify_kind f1.cf_kind f2.cf_kind) then error [invalid_kind n f1.cf_kind f2.cf_kind];
+ if not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind) then error [invalid_kind n f1.cf_kind f2.cf_kind];
if (has_class_field_flag f2 CfPublic) && not (has_class_field_flag f1 CfPublic) then error [invalid_visibility n];
(match f2.cf_kind with
@@ -789,15 +830,14 @@ let rec unify (uctx : unification_context) a b =
then error [Missing_overload (f1, f2o.cf_type)]
) f2.cf_overloads;
(* we mark the field as :?used because it might be used through the structure *)
- if not (Meta.has Meta.MaybeUsed f1.cf_meta) then begin
- f1.cf_meta <- (Meta.MaybeUsed,[],f1.cf_pos) :: f1.cf_meta;
+ if not (has_class_field_flag f1 CfMaybeUsed) then begin
+ add_class_field_flag f1 CfMaybeUsed;
match f2.cf_kind with
| Var vk ->
let check name =
try
let _,_,cf = raw_class_field make_type c tl name in
- if not (Meta.has Meta.MaybeUsed cf.cf_meta) then
- cf.cf_meta <- (Meta.MaybeUsed,[],f1.cf_pos) :: cf.cf_meta
+ add_class_field_flag cf CfMaybeUsed
with Not_found ->
()
in
@@ -871,7 +911,7 @@ let rec unify (uctx : unification_context) a b =
error [cannot_unify a b]
end
| _ , TDynamic None ->
- ()
+ if uctx.equality_kind = EqStricter then error [cannot_unify a b]
| _ , TDynamic (Some t1) ->
begin match a with
| TAnon an ->
@@ -906,39 +946,57 @@ let rec unify (uctx : unification_context) a b =
error [cannot_unify a b]
and unify_anons uctx a b a1 a2 =
- (try
- PMap.iter (fun n f2 ->
+ let unify_field a1_fields f2 =
+ let n = f2.cf_name in
+ let f1 = PMap.find n a1_fields in
+ if not (unify_kind ~strict:uctx.strict_field_kind f1.cf_kind f2.cf_kind) then
+ error [invalid_kind n f1.cf_kind f2.cf_kind];
+ if (has_class_field_flag f2 CfPublic) && not (has_class_field_flag f1 CfPublic) then
+ error [invalid_visibility n];
try
- let f1 = PMap.find n a1.a_fields in
- if not (unify_kind f1.cf_kind f2.cf_kind) then
- error [invalid_kind n f1.cf_kind f2.cf_kind];
- if (has_class_field_flag f2 CfPublic) && not (has_class_field_flag f1 CfPublic) then error [invalid_visibility n];
- try
- let f1_type =
- if fast_eq f1.cf_type f2.cf_type then f1.cf_type
- else field_type f1
- in
- unify_with_access uctx f1 f1_type f2;
- (match !(a1.a_status) with
- | ClassStatics c when not (Meta.has Meta.MaybeUsed f1.cf_meta) -> f1.cf_meta <- (Meta.MaybeUsed,[],f1.cf_pos) :: f1.cf_meta
- | _ -> ());
- with
- Unify_error l -> error (invalid_field n :: l)
- with
- Not_found ->
- match !(a1.a_status) with
- | Const when Meta.has Meta.Optional f2.cf_meta ->
- a1.a_fields <- PMap.add f2.cf_name f2 a1.a_fields
- | _ ->
- error [has_no_field a n];
- ) a2.a_fields;
- (match !(a2.a_status) with
- | ClassStatics c -> (match !(a1.a_status) with ClassStatics c2 when c == c2 -> () | _ -> error [])
- | EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error [])
- | AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error [])
- | Const | Extend _ | Closed -> ())
- with
- Unify_error l -> error (cannot_unify a b :: l))
+ let f1_type =
+ if fast_eq f1.cf_type f2.cf_type then f1.cf_type
+ else field_type f1
+ in
+ unify_with_access uctx f1 f1_type f2;
+ f1
+ with Unify_error l ->
+ error (invalid_field n :: l)
+ in
+ let unify_fields a1_fields f_good f_bad =
+ try
+ PMap.iter (fun _ f2 ->
+ try
+ f_good (unify_field a1_fields f2)
+ with Not_found ->
+ if not (f_bad f2) then
+ error [has_no_field a f2.cf_name]
+ ) a2.a_fields
+ with Unify_error l ->
+ error (cannot_unify a b :: l)
+ in
+ begin match !(a1.a_status),!(a2.a_status) with
+ | ClassStatics c1,ClassStatics c2 when c1 == c2 ->
+ ()
+ | EnumStatics en1,EnumStatics en2 when en1 == en2 ->
+ ()
+ | AbstractStatics a1,AbstractStatics a2 when a1 == a2 ->
+ ()
+ | Const,_ ->
+ unify_fields a1.a_fields (fun _ -> ()) (fun f2 ->
+ if Meta.has Meta.Optional f2.cf_meta then begin
+ a1.a_fields <- PMap.add f2.cf_name f2 a1.a_fields;
+ true
+ end else
+ false
+ )
+ | ClassStatics c1,_ ->
+ unify_fields c1.cl_statics (fun f1 ->
+ add_class_field_flag f1 CfMaybeUsed
+ ) (fun _ -> false)
+ | _ ->
+ unify_fields a1.a_fields (fun _ -> ()) (fun _ -> false)
+ end
and does_func_unify f =
try f(); true with Unify_error _ -> false
diff --git a/src/core/texpr.ml b/src/core/texpr.ml
index 8cb6b3061bb..e089d306197 100644
--- a/src/core/texpr.ml
+++ b/src/core/texpr.ml
@@ -486,12 +486,12 @@ let foldmap f acc e =
(* Collection of functions that return expressions *)
module Builder = struct
let make_static_this c p =
- mk (TTypeExpr (TClassDecl c)) (TType(TFunctions.class_module_type c,[])) p
+ mk (TTypeExpr (TClassDecl c)) c.cl_type p
let make_typeexpr mt pos =
let t =
match resolve_typedef mt with
- | TClassDecl c -> TType(class_module_type c,[])
+ | TClassDecl c -> c.cl_type
| TEnumDecl e -> e.e_type
| TAbstractDecl a -> TType(abstract_module_type a [],[])
| _ -> die "" __LOC__
diff --git a/src/core/timer.ml b/src/core/timer.ml
index 436736c71ab..778abc49232 100644
--- a/src/core/timer.ml
+++ b/src/core/timer.ml
@@ -212,4 +212,4 @@ class timer (id : string list) = object(self)
method nest (name : string) =
new timer (id @ [name])
-end
\ No newline at end of file
+end
diff --git a/src/core/zip_output.ml b/src/core/zip_output.ml
new file mode 100644
index 00000000000..c2bf513d49d
--- /dev/null
+++ b/src/core/zip_output.ml
@@ -0,0 +1,18 @@
+class virtual any_output = object(self)
+ method virtual add_entry : string -> string -> unit
+ method virtual close : unit
+end
+
+class zip_output
+ (zip_path : string)
+ (compression_level : int)
+= object(self)
+ inherit any_output
+ val zip = Zip.open_out zip_path
+
+ method add_entry (content : string) (name : string) =
+ Zip.add_entry ~level:compression_level content zip name
+
+ method close =
+ Zip.close_out zip
+end
\ No newline at end of file
diff --git a/src/dune b/src/dune
index 2694c524a0c..311908ad0d9 100644
--- a/src/dune
+++ b/src/dune
@@ -17,7 +17,7 @@
(library
(name haxe)
(libraries
- extc extproc extlib_leftovers ilib javalib mbedtls neko objsize pcre2 camlp-streams swflib ttflib ziplib
+ extc extproc extlib_leftovers ilib javalib mbedtls neko objsize pcre2 camlp-streams swflib ziplib
json
unix ipaddr str bigarray threads dynlink
xml-light extlib sha terminal_size
diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml
index 08347da7ebc..1429260aa60 100644
--- a/src/filters/exceptions.ml
+++ b/src/filters/exceptions.ml
@@ -39,7 +39,7 @@ let haxe_exception_static_call ctx method_name args p =
| TFun(_,t) -> t
| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
in
- add_dependency ctx.typer.curclass.cl_module ctx.haxe_exception_class.cl_module;
+ add_dependency ctx.typer.c.curclass.cl_module ctx.haxe_exception_class.cl_module;
make_static_call ctx.typer ctx.haxe_exception_class method_field (fun t -> t) args return_type p
(**
@@ -73,7 +73,7 @@ let std_is ctx e t p =
| TFun(_,t) -> t
| _ -> raise_typing_error ("Std.isOfType is not a function and cannot be called") p
in
- let type_expr = { eexpr = TTypeExpr(module_type_of_type t); etype = t; epos = p } in
+ let type_expr = TyperBase.type_module_type ctx.typer (module_type_of_type t) p in
make_static_call ctx.typer std_cls isOfType_field (fun t -> t) [e; type_expr] return_type p
(**
@@ -605,7 +605,7 @@ let insert_save_stacks tctx =
in
let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
begin
- add_dependency tctx.curclass.cl_module native_stack_trace_cls.cl_module;
+ add_dependency tctx.c.curclass.cl_module native_stack_trace_cls.cl_module;
make_static_call tctx native_stack_trace_cls method_field (fun t -> t) [catch_local] return_type catch_var.v_pos
end
else
diff --git a/src/filters/filters.ml b/src/filters/filters.ml
index 0006bd51ca2..e2d12215832 100644
--- a/src/filters/filters.ml
+++ b/src/filters/filters.ml
@@ -545,7 +545,7 @@ let destruction tctx detail_times main locals =
check_private_path com;
Naming.apply_native_paths;
add_rtti com;
- (match com.platform with | Java | Cs -> (fun _ -> ()) | _ -> (fun mt -> AddFieldInits.add_field_inits tctx.curclass.cl_path locals com mt));
+ (match com.platform with | Java | Cs -> (fun _ -> ()) | _ -> (fun mt -> AddFieldInits.add_field_inits tctx.c.curclass.cl_path locals com mt));
(match com.platform with Hl -> (fun _ -> ()) | _ -> add_meta_field com);
check_void_field;
(match com.platform with | Cpp -> promote_first_interface_to_super | _ -> (fun _ -> ()));
@@ -560,7 +560,7 @@ let destruction tctx detail_times main locals =
List.iter (fun t ->
begin match t with
| TClassDecl c ->
- tctx.curclass <- c
+ tctx.c.curclass <- c
| _ ->
()
end;
@@ -666,15 +666,14 @@ let save_class_state com t =
let csr = Option.map (mk_field_restore) c.cl_constructor in
let ofr = List.map (mk_field_restore) c.cl_ordered_fields in
let osr = List.map (mk_field_restore) c.cl_ordered_statics in
- let init = c.cl_init in
- Option.may save_vars init;
+ let init = Option.map mk_field_restore c.cl_init in
c.cl_restore <- (fun() ->
c.cl_super <- sup;
c.cl_implements <- impl;
c.cl_meta <- meta;
if ext then add_class_flag c CExtern else remove_class_flag c CExtern;
c.cl_path <- path;
- c.cl_init <- init;
+ c.cl_init <- Option.map restore_field init;
c.cl_ordered_fields <- List.map restore_field ofr;
c.cl_ordered_statics <- List.map restore_field osr;
c.cl_fields <- mk_pmap c.cl_ordered_fields;
@@ -812,7 +811,7 @@ let run tctx main before_destruction =
"RenameVars",(match com.platform with
| Eval -> (fun e -> e)
| Java when defined com Jvm -> (fun e -> e)
- | _ -> (fun e -> RenameVars.run tctx.curclass.cl_path locals e));
+ | _ -> (fun e -> RenameVars.run tctx.c.curclass.cl_path locals e));
"mark_switch_break_loops",mark_switch_break_loops;
] in
List.iter (run_expression_filters tctx detail_times filters) new_types;
diff --git a/src/filters/filtersCommon.ml b/src/filters/filtersCommon.ml
index 0905404f2f4..7468f4425fc 100644
--- a/src/filters/filtersCommon.ml
+++ b/src/filters/filtersCommon.ml
@@ -63,11 +63,11 @@ let run_expression_filters ?(ignore_processed_status=false) ctx detail_times fil
match t with
| TClassDecl c when is_removable_class c -> ()
| TClassDecl c ->
- ctx.curclass <- c;
- ctx.m <- TypeloadModule.make_curmod ctx c.cl_module;
+ ctx.c.curclass <- c;
+ ctx.m <- TypeloadModule.make_curmod ctx.com ctx.g c.cl_module;
let rec process_field f =
if ignore_processed_status || not (has_class_field_flag f CfPostProcessed) then begin
- ctx.curfield <- f;
+ ctx.f.curfield <- f;
(match f.cf_expr with
| Some e when not (is_removable_field com f) ->
let identifier = Printf.sprintf "%s.%s" (s_type_path c.cl_path) f.cf_name in
@@ -81,11 +81,11 @@ let run_expression_filters ?(ignore_processed_status=false) ctx detail_times fil
(match c.cl_constructor with
| None -> ()
| Some f -> process_field f);
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e ->
let identifier = Printf.sprintf "%s.__init__" (s_type_path c.cl_path) in
- c.cl_init <- Some (run (Some identifier) e));
+ TClass.set_cl_init c (run (Some identifier) e))
| TEnumDecl _ -> ()
| TTypeDecl _ -> ()
| TAbstractDecl _ -> ()
diff --git a/src/filters/localStatic.ml b/src/filters/localStatic.ml
index b6d9c1d7d5f..e2560ae6c5b 100644
--- a/src/filters/localStatic.ml
+++ b/src/filters/localStatic.ml
@@ -10,8 +10,8 @@ type lscontext = {
}
let promote_local_static lsctx run v eo =
- let name = Printf.sprintf "%s_%s" lsctx.ctx.curfield.cf_name v.v_name in
- let c = lsctx.ctx.curclass in
+ let name = Printf.sprintf "%s_%s" lsctx.ctx.f.curfield.cf_name v.v_name in
+ let c = lsctx.ctx.c.curclass in
begin try
let cf = PMap.find name c.cl_statics in
display_error lsctx.ctx.com (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name) v.v_pos;
@@ -56,7 +56,7 @@ let run ctx e =
lut = Hashtbl.create 0;
added_fields = [];
} in
- let c = ctx.curclass in
+ let c = ctx.c.curclass in
let rec run e = match e.eexpr with
| TBlock el ->
let el = ExtList.List.filter_map (fun e -> match e.eexpr with
diff --git a/src/filters/tre.ml b/src/filters/tre.ml
index dce3b8f4392..1bbf18bfffe 100644
--- a/src/filters/tre.ml
+++ b/src/filters/tre.ml
@@ -206,19 +206,19 @@ let run ctx =
match e.eexpr with
| TFunction fn ->
let is_tre_eligible =
- match ctx.curfield.cf_kind with
+ match ctx.f.curfield.cf_kind with
| Method MethDynamic -> false
| Method MethInline -> true
| Method MethNormal ->
- PMap.mem ctx.curfield.cf_name ctx.curclass.cl_statics
+ PMap.mem ctx.f.curfield.cf_name ctx.c.curclass.cl_statics
| _ ->
- has_class_field_flag ctx.curfield CfFinal
+ has_class_field_flag ctx.f.curfield CfFinal
in
let is_recursive_call callee args =
- is_tre_eligible && is_recursive_method_call ctx.curclass ctx.curfield callee args
+ is_tre_eligible && is_recursive_method_call ctx.c.curclass ctx.f.curfield callee args
in
if has_tail_recursion is_recursive_call false true fn.tf_expr then
- (* print_endline ("TRE: " ^ ctx.curfield.cf_pos.pfile ^ ": " ^ ctx.curfield.cf_name); *)
+ (* print_endline ("TRE: " ^ ctx.f.curfield.cf_pos.pfile ^ ": " ^ ctx.f.curfield.cf_name); *)
let fn = transform_function ctx is_recursive_call fn in
{ e with eexpr = TFunction fn }
else
diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml
index 4d034be9ad0..05fcb19cf10 100644
--- a/src/generators/gencpp.ml
+++ b/src/generators/gencpp.ml
@@ -1322,17 +1322,7 @@ exception PathFound of string;;
let strip_file ctx file = (match Common.defined ctx Common.Define.AbsolutePath with
| true -> file
- | false -> let flen = String.length file in
- (* Not quite right - should probably test is file exists *)
- try
- List.iter (fun path ->
- let plen = String.length path in
- if (flen>plen && path=(String.sub file 0 plen ))
- then raise (PathFound (String.sub file plen (flen-plen)) ) )
- (ctx.class_path @ ctx.std_path);
- file;
- with PathFound tail ->
- tail)
+ | false -> ctx.class_paths#relative_path file)
;;
let with_debug ctx metadata run =
@@ -5013,7 +5003,7 @@ let find_referenced_types_flags ctx obj field_name super_deps constructor_deps h
(* Body of main function *)
(match obj with
| TClassDecl class_def -> visit_class class_def;
- (match class_def.cl_init with Some expression -> visit_params expression | _ -> ())
+ (match TClass.get_cl_init class_def with Some expression -> visit_params expression | _ -> ())
| TEnumDecl enum_def -> visit_enum enum_def
| TTypeDecl _ | TAbstractDecl _ -> (* These are expanded *) ());
@@ -5465,7 +5455,7 @@ let rec find_next_super_iteration ctx class_def =
;;
let has_init_field class_def =
- match class_def.cl_init with
+ match TClass.get_cl_init class_def with
| Some _ -> true
| _ -> false;;
@@ -5543,7 +5533,7 @@ let has_compare_field class_def =
let has_boot_field class_def =
- match class_def.cl_init with
+ match TClass.get_cl_init class_def with
| None -> List.exists has_field_init (List.filter should_implement_field class_def.cl_ordered_statics)
| _ -> true
;;
@@ -6104,7 +6094,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta
end;
end;
- (match class_def.cl_init with
+ (match TClass.get_cl_init class_def with
| Some expression ->
let ctx = file_context baseCtx cpp_file debug false in
output_cpp ("void " ^ class_name^ "::__init__()");
@@ -8389,7 +8379,7 @@ let generate_script_class common_ctx script class_def =
script#write ((string_of_int ( (List.length ordered_fields) +
(List.length ordered_statics) +
(match class_def.cl_constructor with Some _ -> 1 | _ -> 0 ) +
- (match class_def.cl_init with Some _ -> 1 | _ -> 0 ) ) )
+ (match TClass.get_cl_init class_def with Some _ -> 1 | _ -> 0 ) ) )
^ "\n");
let generate_field isStatic field =
@@ -8422,7 +8412,7 @@ let generate_script_class common_ctx script class_def =
(match class_def.cl_constructor with
| Some field -> generate_field true field
| _ -> () );
- (match class_def.cl_init with
+ (match TClass.get_cl_init class_def with
| Some expression -> script#voidFunc true false "__init__" expression
| _ -> () );
@@ -8488,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
@@ -8600,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
@@ -8663,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
@@ -8679,7 +8669,10 @@ let generate_source ctx =
| "true" | "sys" | "dce" | "cpp" | "debug" -> ();
| _ -> cmd := !cmd @ [Printf.sprintf "-D%s=\"%s\"" name (escape_command value)];
) common_ctx.defines.values;
- List.iter (fun path -> cmd := !cmd @ [Printf.sprintf "-I%s" (escape_command path)]) common_ctx.class_path;
+ common_ctx.class_paths#iter (fun path ->
+ let path = path#path in
+ cmd := !cmd @ [Printf.sprintf "-I%s" (escape_command path)]
+ );
common_ctx.print ("haxelib " ^ (String.concat " " !cmd) ^ "\n");
if common_ctx.run_command_args "haxelib" !cmd <> 0 then failwith "Build failed";
Sys.chdir old_dir;
diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml
index e20b13400ba..a30f749df1c 100644
--- a/src/generators/gencs.ml
+++ b/src/generators/gencs.ml
@@ -2702,7 +2702,7 @@ let generate con =
end_block w
) main_expr;
- (match cl.cl_init with
+ (match TClass.get_cl_init cl with
| None -> ()
| Some init ->
let needs_block,write_expr =
@@ -2957,7 +2957,7 @@ let generate con =
let super_map (cl,tl) = (cl, List.map run_follow_gen tl) in
List.iter (function
| TClassDecl cl ->
- let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics in
+ let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics @ (Option.map_default (fun cf -> [cf]) [] cl.cl_init) in
List.iter (fun cf ->
cf.cf_type <- run_follow_gen cf.cf_type;
cf.cf_expr <- Option.map type_map cf.cf_expr;
@@ -2971,7 +2971,6 @@ let generate con =
) all_fields;
cl.cl_dynamic <- Option.map run_follow_gen cl.cl_dynamic;
cl.cl_array_access <- Option.map run_follow_gen cl.cl_array_access;
- cl.cl_init <- Option.map type_map cl.cl_init;
cl.cl_super <- Option.map super_map cl.cl_super;
cl.cl_implements <- List.map super_map cl.cl_implements
| _ -> ()
@@ -3483,10 +3482,7 @@ let generate con =
mk_nativearray_decl gen basic.tint (List.map (fun (i,s) -> { eexpr = TConst(TInt (i)); etype = basic.tint; epos = c.cl_pos }) all) c.cl_pos;
mk_nativearray_decl gen basic.tstring (List.map (fun (i,s) -> { eexpr = TConst(TString (s)); etype = basic.tstring; epos = c.cl_pos }) all) c.cl_pos;
]); etype = basic.tvoid; epos = c.cl_pos } in
- match c.cl_init with
- | None -> c.cl_init <- Some expr
- | Some e ->
- c.cl_init <- Some { eexpr = TBlock([expr;e]); etype = basic.tvoid; epos = e.epos }
+ TClass.add_cl_init c expr
end
with | Not_found -> ())
| _ -> ()) gen.gtypes;
diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml
index b00adbdf181..e3ba1481b68 100644
--- a/src/generators/genhl.ml
+++ b/src/generators/genhl.ml
@@ -329,11 +329,12 @@ let make_debug ctx arr =
| false -> try
(* lookup relative path *)
let len = String.length p.pfile in
- let base = List.find (fun path ->
+ let base = ctx.com.class_paths#find (fun path ->
+ let path = path#path in
let l = String.length path in
len > l && String.sub p.pfile 0 l = path
- ) ctx.com.Common.class_path in
- let l = String.length base in
+ ) in
+ let l = String.length base#path in
String.sub p.pfile l (len - l)
with Not_found ->
p.pfile
@@ -3695,7 +3696,7 @@ let generate_static_init ctx types main =
(* init class statics *)
let init_exprs = ref [] in
List.iter (fun t ->
- (match t with TClassDecl { cl_init = Some e } -> init_exprs := e :: !init_exprs | _ -> ());
+ (match t with TClassDecl { cl_init = Some {cf_expr = Some e} } -> init_exprs := e :: !init_exprs | _ -> ());
match t with
| TClassDecl c when not (has_class_flag c CExtern) ->
List.iter (fun f ->
@@ -4186,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);
diff --git a/src/generators/genhxold.ml b/src/generators/genhxold.ml
index df7667fb2dd..5f8660319f6 100644
--- a/src/generators/genhxold.ml
+++ b/src/generators/genhxold.ml
@@ -144,7 +144,7 @@ let generate_type com t =
let print_meta ml =
List.iter (fun (m,pl,_) ->
match m with
- | Meta.DefParam | Meta.CoreApi | Meta.Used | Meta.MaybeUsed | Meta.FlatEnum | Meta.Value | Meta.DirectlyUsed | Meta.Enum -> ()
+ | Meta.DefParam | Meta.CoreApi | Meta.Used | Meta.FlatEnum | Meta.Value | Meta.DirectlyUsed | Meta.Enum -> ()
| _ ->
match pl with
| [] -> p "@%s " (Meta.to_string m)
diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml
index 806777b26e1..1c50d324315 100644
--- a/src/generators/genjava.ml
+++ b/src/generators/genjava.ml
@@ -2201,7 +2201,7 @@ let generate con =
newline w
| _ -> ());
- (match cl.cl_init with
+ (match TClass.get_cl_init cl with
| None -> ()
| Some init ->
write w "static";
@@ -2298,14 +2298,13 @@ let generate con =
let super_map (cl,tl) = (cl, List.map run_follow_gen tl) in
List.iter (function
| TClassDecl cl ->
- let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics in
+ let all_fields = (Option.map_default (fun cf -> [cf]) [] cl.cl_constructor) @ cl.cl_ordered_fields @ cl.cl_ordered_statics @ (Option.map_default (fun cf -> [cf]) [] cl.cl_init)in
List.iter (fun cf ->
cf.cf_type <- run_follow_gen cf.cf_type;
cf.cf_expr <- Option.map type_map cf.cf_expr
) all_fields;
cl.cl_dynamic <- Option.map run_follow_gen cl.cl_dynamic;
cl.cl_array_access <- Option.map run_follow_gen cl.cl_array_access;
- cl.cl_init <- Option.map type_map cl.cl_init;
cl.cl_super <- Option.map super_map cl.cl_super;
cl.cl_implements <- List.map super_map cl.cl_implements
| _ -> ()
diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml
index 53fe22012f3..05eae361308 100644
--- a/src/generators/genjs.ml
+++ b/src/generators/genjs.ml
@@ -1623,7 +1623,7 @@ let need_to_generate_interface ctx cl_iface =
let generate_type ctx = function
| TClassDecl c ->
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e ->
ctx.inits <- e :: ctx.inits);
@@ -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
diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml
index 4e8f2810a85..bff57f5889e 100644
--- a/src/generators/genjvm.ml
+++ b/src/generators/genjvm.ml
@@ -50,16 +50,11 @@ let get_construction_mode c cf =
if Meta.has Meta.HxGen cf.cf_meta then ConstructInitPlusNew
else ConstructInit
-class virtual jvm_output = object(self)
- method virtual add_entry : string -> string -> unit
- method virtual close : unit
-end
-
(* Haxe *)
type generation_context = {
com : Common.context;
- out : jvm_output;
+ out : Zip_output.any_output;
t_runtime_exception : Type.t;
entry_point : (tclass * texpr) option;
t_exception : Type.t;
@@ -110,24 +105,10 @@ let run_timed gctx detail name f =
sub#run_finally f (fun () -> gctx.timer <- old)
end
-class jar_output
- (jar_path : string)
- (compression_level : int)
-= object(self)
- inherit jvm_output
- val jar = Zip.open_out jar_path
-
- method add_entry (content : string) (name : string) =
- Zip.add_entry ~level:compression_level content jar name
-
- method close =
- Zip.close_out jar
-end
-
class file_output
(base_path : string)
= object(self)
- inherit jvm_output
+ inherit Zip_output.any_output
method add_entry (content : string) (name : string) =
let path = base_path ^ name in
@@ -1718,7 +1699,7 @@ class texpr_to_jvm
info.super_call_fields <- tl;
hd
| _ ->
- Error.raise_typing_error "Something went wrong" e1.epos
+ Error.raise_typing_error "Could not find field information for super call, please report this" e1.epos
in
let kind = get_construction_mode c cf in
begin match kind with
@@ -2435,6 +2416,7 @@ class tclass_to_jvm gctx c = object(self)
let jsig_empty = method_sig [haxe_empty_constructor_sig] None in
let jm_empty_ctor = jc#spawn_method "" jsig_empty [MPublic;MSynthetic] in
let _,load,_ = jm_empty_ctor#add_local "_" haxe_empty_constructor_sig VarArgument in
+ jm_empty_ctor#finalize_arguments;
jm_empty_ctor#load_this;
if c.cl_constructor = None then begin
let handler = new texpr_to_jvm gctx None jc jm_empty_ctor None in
@@ -2475,6 +2457,7 @@ class tclass_to_jvm gctx c = object(self)
let _,load,_ = jm#add_local n (jsignature_of_type gctx t) VarArgument in
load();
) tl;
+ jm#finalize_arguments;
jm#call_super_ctor cmode jm#get_jsig;
DynArray.iter (fun e ->
handler#texpr RVoid e;
@@ -2575,10 +2558,7 @@ class tclass_to_jvm gctx c = object(self)
let p = null_pos in
let efield = Texpr.Builder.make_static_field c cf p in
let eop = mk (TBinop(OpAssign,efield,e)) cf.cf_type p in
- begin match c.cl_init with
- | None -> c.cl_init <- Some eop
- | Some e -> c.cl_init <- Some (concat e eop)
- end
+ TClass.add_cl_init c eop
in
begin match cf.cf_expr with
| None ->
@@ -2594,7 +2574,15 @@ class tclass_to_jvm gctx c = object(self)
let ethis = mk (TConst TThis) (TInst(c,tl)) null_pos in
let efield = mk (TField(ethis,FInstance(c,tl,cf))) cf.cf_type null_pos in
let eop = mk (TBinop(OpAssign,efield,e)) cf.cf_type null_pos in
- DynArray.add (match cf.cf_kind with Method MethDynamic -> delayed_field_inits | _ -> field_inits) eop;
+ begin match cf.cf_kind with
+ | Method MethDynamic ->
+ let enull = Texpr.Builder.make_null efield.etype null_pos in
+ let echeck = Texpr.Builder.binop OpEq efield enull gctx.com.basic.tbool null_pos in
+ let eif = mk (TIf(echeck,eop,None)) gctx.com.basic.tvoid null_pos in
+ DynArray.add delayed_field_inits eif
+ | _ ->
+ DynArray.add field_inits eop
+ end
| Some e ->
match e.eexpr with
| TConst ct ->
@@ -2661,7 +2649,7 @@ class tclass_to_jvm gctx c = object(self)
| Some cf,None -> field MConstructor cf
| None,_ -> ()
end;
- begin match c.cl_init with
+ begin match TClass.get_cl_init c with
| None ->
()
| Some e ->
@@ -3058,7 +3046,7 @@ let generate jvm_flag com =
in
if compression_level < 0 || compression_level > 9 then failwith "Invalid value for -D jvm.compression-level: Must be >=0 and <= 9";
let create_jar path =
- new jar_output path compression_level
+ new Zip_output.zip_output path compression_level
in
let out_dir,out = if jvm_flag then begin
match path.file_name with
@@ -3082,7 +3070,7 @@ let generate jvm_flag com =
let jar_path = Printf.sprintf "%s%s.jar" jar_dir jar_name in
jar_dir,create_jar jar_path
end in
- let anon_identification = new tanon_identification haxe_dynamic_object_path in
+ let anon_identification = new tanon_identification in
let dynamic_level = try
int_of_string (Define.defined_value com.defines Define.JvmDynamicLevel)
with _ ->
diff --git a/src/generators/genlua.ml b/src/generators/genlua.ml
index 4297cab5ed3..176185edbcf 100644
--- a/src/generators/genlua.ml
+++ b/src/generators/genlua.ml
@@ -1840,7 +1840,7 @@ let generate_require ctx path meta =
let generate_type ctx = function
| TClassDecl c ->
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e ->
ctx.inits <- e :: ctx.inits);
@@ -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";
diff --git a/src/generators/genneko.ml b/src/generators/genneko.ml
index 3830fc0ac3e..ce081ea0f7b 100644
--- a/src/generators/genneko.ml
+++ b/src/generators/genneko.ml
@@ -57,11 +57,12 @@ let pos ctx p =
| false -> try
(* lookup relative path *)
let len = String.length p.pfile in
- let base = List.find (fun path ->
+ let base = ctx.com.class_paths#find (fun path ->
+ let path = path#path in
let l = String.length path in
len > l && String.sub p.pfile 0 l = path
- ) ctx.com.Common.class_path in
- let l = String.length base in
+ ) in
+ let l = String.length base#path in
String.sub p.pfile l (len - l)
with Not_found -> p.pfile
@@ -554,7 +555,7 @@ let gen_enum ctx e =
let gen_type ctx t acc =
match t with
| TClassDecl c ->
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e -> ctx.inits <- (c,e) :: ctx.inits);
if (has_class_flag c CExtern) then
@@ -779,7 +780,7 @@ let generate com =
{ psource = ""; 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
diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml
index bd8fc426304..c36622206ff 100644
--- a/src/generators/genphp7.ml
+++ b/src/generators/genphp7.ml
@@ -959,7 +959,7 @@ class class_wrapper (cls) =
if (has_class_flag cls CInterface) then
false
else
- match cls.cl_init with
+ match TClass.get_cl_init cls with
| Some _ -> true
| None ->
List.exists
@@ -978,7 +978,7 @@ class class_wrapper (cls) =
Returns expression of a user-defined static __init__ method
@see http://old.haxe.org/doc/advanced/magic#initialization-magic
*)
- method! get_magic_init = cls.cl_init
+ method! get_magic_init = TClass.get_cl_init cls
(**
Returns hx source file name where this type was declared
*)
@@ -994,7 +994,7 @@ class class_wrapper (cls) =
if not (has_class_flag cls CExtern) then
None
else
- match cls.cl_init with
+ match TClass.get_cl_init cls with
| None -> None
| Some body ->
let path =
@@ -1009,8 +1009,8 @@ class class_wrapper (cls) =
cl_ordered_fields = [];
cl_ordered_statics = [];
cl_constructor = None;
- cl_init = Some body
} in
+ TClass.set_cl_init additional_cls body;
remove_class_flag additional_cls CExtern;
Some (TClassDecl additional_cls)
end
@@ -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
diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml
index d836c37695c..1a59a94fb3e 100644
--- a/src/generators/genpy.ml
+++ b/src/generators/genpy.ml
@@ -2001,7 +2001,7 @@ module Generator = struct
!has_static_methods || !has_empty_static_vars
let gen_class_init ctx c =
- match c.cl_init with
+ match TClass.get_cl_init c with
| None ->
()
| Some e ->
@@ -2410,7 +2410,7 @@ module Generator = struct
List.iter (fun f -> f()) (List.rev ctx.class_inits)
let gen_main ctx =
- match ctx.com.main with
+ match ctx.com.main.main_expr with
| None ->
()
| Some e ->
diff --git a/src/generators/genshared.ml b/src/generators/genshared.ml
index 0fb9d79226b..9aa67cea7b3 100644
--- a/src/generators/genshared.ml
+++ b/src/generators/genshared.ml
@@ -128,14 +128,15 @@ object(self)
| None -> die "" __LOC__
| Some(c,_) -> c,cf
in
- let rec promote_this_before_super c cf = match self#get_field_info cf.cf_meta with
- | None -> failwith "Something went wrong"
+ let rec promote_this_before_super c cf p = match self#get_field_info cf.cf_meta with
+ | None ->
+ Error.raise_typing_error (Printf.sprintf "Could not determine field information for %s in a this-before-super case, please report this" cf.cf_name) p
| Some info ->
if not info.has_this_before_super then begin
make_haxe cf;
(* print_endline (Printf.sprintf "promoted this_before_super to %s.new : %s" (s_type_path c.cl_path) (s_type (print_context()) cf.cf_type)); *)
info.has_this_before_super <- true;
- List.iter (fun (c,cf) -> promote_this_before_super c cf) info.super_call_fields
+ List.iter (fun (c,cf) -> promote_this_before_super c cf p) info.super_call_fields
end
in
let rec loop e =
@@ -153,7 +154,7 @@ object(self)
(* print_endline (Printf.sprintf "inferred this_before_super on %s.new : %s" (s_type_path c.cl_path) (s_type (print_context()) cf.cf_type)); *)
end;
let c,cf = find_super_ctor el in
- if !this_before_super then promote_this_before_super c cf;
+ if !this_before_super then promote_this_before_super c cf e.epos;
DynArray.add super_call_fields (c,cf);
| _ ->
Type.iter loop e
@@ -301,7 +302,7 @@ class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : '
try
let path_inner,is_extern = try Hashtbl.find interface_rewrites pfm.pfm_path with Not_found -> path_inner,false in
if self#implements_recursively c path_inner then raise (Unify_error [Unify_custom "already implemented"]);
- anon_identification#unify tc pfm;
+ anon_identification#unify ~strict:false tc pfm;
let ci = self#make_interface_class pfm path_inner is_extern in
c.cl_implements <- (ci,[]) :: c.cl_implements;
(* print_endline (Printf.sprintf "%s IMPLEMENTS %s" (s_type_path c.cl_path) (s_type_path path_inner)); *)
diff --git a/src/generators/genswf.ml b/src/generators/genswf.ml
index c6b4f60765a..20b29992e84 100644
--- a/src/generators/genswf.ml
+++ b/src/generators/genswf.ml
@@ -142,7 +142,7 @@ let build_dependencies t =
add_field f;
if c.cl_path <> (["flash"],"Boot") then add_path (["flash"],"Boot") DKExpr;
);
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e -> add_expr e);
(match c.cl_super with
@@ -222,8 +222,6 @@ let detect_format data p =
| _ ->
abort "Unknown file format" p
-open TTFData
-
let build_swf9 com file swc =
let boot_name = if swc <> None || Common.defined com Define.HaxeBoot then "haxe" else "boot_" ^ (String.sub (Digest.to_hex (Digest.string (Filename.basename file))) 0 4) in
let code = Genswf9.generate com boot_name in
@@ -269,59 +267,6 @@ let build_swf9 com file swc =
| TClassDecl c ->
let rec loop = function
| [] -> acc
- | (Meta.Font,(EConst (String(file,_)),p) :: args,_) :: l ->
- let file = try Common.find_file com file with Not_found -> file in
- let ch = try open_in_bin file with _ -> abort "File not found" p in
- let ttf = try TTFParser.parse ch with e -> abort ("Error while parsing font " ^ file ^ " : " ^ Printexc.to_string e) p in
- close_in ch;
- let get_string e = match fst e with
- | EConst (String(s,_)) -> s
- | _ -> raise Not_found
- in
- let ttf_config = {
- ttfc_range_str = "";
- ttfc_font_name = None;
- ttfc_font_weight = TFWRegular;
- ttfc_font_posture = TFPNormal;
- } in
- begin match args with
- | (EConst (String(str,_)),_) :: _ -> ttf_config.ttfc_range_str <- str;
- | _ -> ()
- end;
- begin match args with
- | _ :: [e] ->
- begin match fst e with
- | EObjectDecl fl ->
- (try ttf_config.ttfc_font_name <- Some(get_string (Expr.field_assoc "fontName" fl)) with Not_found -> ());
- (try ttf_config.ttfc_font_weight <- (
- match get_string (Expr.field_assoc "fontWeight" fl) with
- | "regular" -> TFWRegular
- | "bold" -> TFWBold
- | _ -> abort "Invalid fontWeight value. Must be `regular` or `bold`." p
- ) with Not_found -> ());
- (try ttf_config.ttfc_font_posture <- (
- match get_string (Expr.field_assoc "fontStyle" fl) with
- | "normal" -> TFPNormal
- | "italic" -> TFPItalic
- | _ -> abort "Invalid fontStyle value. Must be `normal` or `italic`." p
- ) with Not_found -> ());
- | _ ->
- ()
- end
- | _ ->
- ()
- end;
- let ttf_swf = TTFSwfWriter.to_swf ttf ttf_config in
- let ch = IO.output_string () in
- let b = IO.output_bits ch in
- TTFSwfWriter.write_font2 ch b ttf_swf;
- let data = IO.close_out ch in
- incr cid;
- classes := { f9_cid = Some !cid; f9_classname = s_type_path c.cl_path } :: !classes;
- tag (TFont3 {
- cd_id = !cid;
- cd_data = data;
- }) :: loop l
| (Meta.Bitmap,[EConst (String(file,_)),p],_) :: l ->
let data = load_file_data file p in
incr cid;
diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml
index 4ea67eddb7c..6495c7a7456 100644
--- a/src/generators/genswf9.ml
+++ b/src/generators/genswf9.ml
@@ -1982,7 +1982,7 @@ let generate_extern_inits ctx =
List.iter (fun t ->
match t with
| TClassDecl c when (has_class_flag c CExtern) ->
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e -> gen_expr ctx false e);
| _ -> ()
@@ -2007,7 +2007,7 @@ let generate_inits ctx =
j()
| _ -> ()
) ctx.com.types;
- (match ctx.com.main with
+ (match ctx.com.main.main_expr with
| None -> ()
| Some e -> gen_expr ctx false e);
write ctx HRetVoid;
@@ -2035,7 +2035,7 @@ let generate_class_init ctx c hc =
if not (has_class_flag c CInterface) then write ctx HPopScope;
write ctx (HInitProp (type_path ctx c.cl_path));
if ctx.swc && c.cl_path = ctx.boot then generate_extern_inits ctx;
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e ->
gen_expr ctx false e;
@@ -2888,7 +2888,7 @@ let generate com boot_name =
try_scope_reg = None;
for_call = false;
} in
- let types = if ctx.swc && com.main_class = None then
+ let types = if ctx.swc && com.main.main_class = None then
(*
make sure that both Boot and RealBoot are the first two classes in the SWC
this way initializing RealBoot will also run externs __init__ blocks before
diff --git a/src/generators/jvm/jvmFunctions.ml b/src/generators/jvm/jvmFunctions.ml
index c92837b1164..3aab6ba086f 100644
--- a/src/generators/jvm/jvmFunctions.ml
+++ b/src/generators/jvm/jvmFunctions.ml
@@ -178,7 +178,7 @@ class typed_functions = object(self)
jm#finalize_arguments;
load();
jm#get_code#arraylength array_sig;
- let cases = ExtList.List.init max_arity (fun i ->
+ let cases = ExtList.List.init (max_arity + 1) (fun i ->
[Int32.of_int i],(fun () ->
jm#load_this;
let args = ExtList.List.init i (fun index ->
diff --git a/src/macro/eval/evalDataApi.ml b/src/macro/eval/evalDataApi.ml
new file mode 100644
index 00000000000..3814ab8827e
--- /dev/null
+++ b/src/macro/eval/evalDataApi.ml
@@ -0,0 +1,61 @@
+open EvalValue
+open EvalContext
+
+module EvalReaderApi = struct
+ open EvalDecode
+
+ type data = value
+
+ let read_optional v f = match v with
+ | VNull ->
+ ()
+ | _ ->
+ f v
+
+ let read_object v =
+ List.map (fun (i,v) ->
+ EvalHash.rev_hash i,v
+ ) (object_fields (decode_object v))
+
+ let read_array v =
+ EvalArray.to_list (decode_varray v)
+
+ let read_string v =
+ decode_string v
+
+ let read_int v =
+ decode_int v
+
+ let read_bool v =
+ decode_bool v
+
+ let data_to_string v =
+ (EvalPrinting.s_value 0 v).sstring
+end
+
+module EvalWriterApi = struct
+ open EvalEncode
+
+ type data = value
+
+ let write_optional vo = match vo with
+ | None -> vnull
+ | Some v -> v
+
+ let write_object fl =
+ encode_obj (List.map (fun (s,v) ->
+ EvalHash.hash s,v
+ ) fl)
+
+ let write_array vl =
+ encode_array vl
+
+ let write_string s =
+ encode_string s
+
+ let write_bool b =
+ vbool b
+
+ let write_int i =
+ vint i
+end
\ No newline at end of file
diff --git a/src/macro/eval/evalEmitter.ml b/src/macro/eval/evalEmitter.ml
index 56de9326e61..7663674aac7 100644
--- a/src/macro/eval/evalEmitter.ml
+++ b/src/macro/eval/evalEmitter.ml
@@ -754,8 +754,8 @@ let process_arguments fl vl env =
loop fl []
| [],[] ->
()
- | _ ->
- exc_string "Something went wrong"
+ | l1,l2 ->
+ exc_string (Printf.sprintf "Bad number of arguments: %i vs. %i" (List.length l1) (List.length l2))
in
loop fl vl
[@@inline]
diff --git a/src/macro/eval/evalExceptions.ml b/src/macro/eval/evalExceptions.ml
index f1c146d98d6..b3954e20692 100644
--- a/src/macro/eval/evalExceptions.ml
+++ b/src/macro/eval/evalExceptions.ml
@@ -137,7 +137,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
in
(Error.Custom (value_string v1), v2)
end else
- Error.raise_typing_error "Something went wrong" null_pos
+ Error.raise_typing_error (Printf.sprintf "Unexpected value where haxe.macro.Error was expected: %s" (s_value 0 v).sstring) null_pos
) (EvalArray.to_list sub)
| _ -> []
in
@@ -165,8 +165,8 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
| [] -> Error.raise_msg s.sstring p
| _ -> Error.raise_error (Error.make_error ~sub:(List.map (fun (msg,p) -> Error.make_error msg p) stack) (Error.Custom s.sstring) p)
);
- | _ ->
- Error.raise_typing_error "Something went wrong" null_pos
+ | v ->
+ Error.raise_typing_error (Printf.sprintf "Invalid exception value where string was expected: %s" (s_value 0 v).sstring) null_pos
end else begin
(* Careful: We have to get the message before resetting the context because toString() might access it. *)
let stack = match eval_stack with
diff --git a/src/macro/eval/evalJit.ml b/src/macro/eval/evalJit.ml
index d2c21a539a1..89c428641ce 100644
--- a/src/macro/eval/evalJit.ml
+++ b/src/macro/eval/evalJit.ml
@@ -235,7 +235,7 @@ and jit_expr jit return e =
List.iter (fun var -> ignore(get_capture_slot jit var)) jit_closure.captures_outside_scope;
let captures = ExtList.List.filter_map (fun (i,vid,declared) ->
if declared then None
- else Some (i,fst (try Hashtbl.find jit.captures vid with Not_found -> Error.raise_typing_error "Something went wrong" e.epos))
+ else Some (i,fst (try Hashtbl.find jit.captures vid with Not_found -> Error.raise_typing_error (Printf.sprintf "Could not find capture variable %i" vid) e.epos))
) captures in
let mapping = Array.of_list captures in
emit_closure ctx mapping eci hasret exec fl
diff --git a/src/macro/eval/evalMain.ml b/src/macro/eval/evalMain.ml
index a69afdef6a6..6393c2436ad 100644
--- a/src/macro/eval/evalMain.ml
+++ b/src/macro/eval/evalMain.ml
@@ -379,8 +379,7 @@ let setup get_api =
let api = get_api (fun() -> (get_ctx()).curapi.get_com()) (fun() -> (get_ctx()).curapi) in
List.iter (fun (n,v) ->
Hashtbl.replace GlobalState.macro_lib n v
- ) api;
- Globals.macro_platform := Globals.Eval
+ ) api
let do_reuse ctx api =
ctx.curapi <- api;
diff --git a/src/macro/eval/evalPrototype.ml b/src/macro/eval/evalPrototype.ml
index 5984a44abbe..e7f8119cbad 100644
--- a/src/macro/eval/evalPrototype.ml
+++ b/src/macro/eval/evalPrototype.ml
@@ -211,7 +211,7 @@ let create_static_prototype ctx mt =
| _ ->
()
) fields;
- begin match c.cl_init with
+ begin match TClass.get_cl_init c with
| None -> ()
| Some e -> DynArray.add delays (false,(fun _ -> ignore(eval_expr ctx (EKMethod(key,key___init__)) e)))
end;
diff --git a/src/macro/eval/EvalStackTrace.ml b/src/macro/eval/evalStackTrace.ml
similarity index 100%
rename from src/macro/eval/EvalStackTrace.ml
rename to src/macro/eval/evalStackTrace.ml
diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml
index 7cdb911bb58..97b42b32310 100644
--- a/src/macro/eval/evalStdLib.ml
+++ b/src/macro/eval/evalStdLib.ml
@@ -2569,7 +2569,7 @@ module StdSys = struct
open Common
let args = vfun0 (fun () ->
- encode_array (List.map create_unknown ((get_ctx()).curapi.MacroApi.get_com()).sys_args)
+ encode_array (List.map create_unknown ((get_ctx()).curapi.MacroApi.get_com()).args)
)
let _command = vfun1 (fun cmd ->
@@ -2632,7 +2632,7 @@ module StdSys = struct
let programPath = vfun0 (fun () ->
let ctx = get_ctx() in
let com = ctx.curapi.get_com() in
- match com.main_class with
+ match com.main.main_class with
| None -> vnull
| Some p ->
match ctx.curapi.get_type (s_type_path p) with
diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml
index deb6553c1dd..155ed8c08ce 100644
--- a/src/macro/macroApi.ml
+++ b/src/macro/macroApi.ml
@@ -38,8 +38,6 @@ type 'value compiler_api = {
resolve_complex_type : Ast.type_hint -> Ast.type_hint;
store_typed_expr : Type.texpr -> Ast.expr;
allow_package : string -> unit;
- type_patch : string -> string -> bool -> string option -> unit;
- meta_patch : string -> string -> string option -> bool -> pos -> unit;
set_js_generator : (Genjs.ctx -> unit) -> unit;
get_local_type : unit -> t option;
get_expected_type : unit -> t option;
@@ -53,7 +51,6 @@ type 'value compiler_api = {
define_module : string -> 'value list -> ((string * Globals.pos) list * Ast.import_mode) list -> Ast.type_path list -> unit;
module_dependency : string -> string -> unit;
current_module : unit -> module_def;
- use_cache : unit -> bool;
format_string : string -> Globals.pos -> Ast.expr;
cast_or_unify : Type.t -> texpr -> Globals.pos -> bool;
add_global_metadata : string -> string -> (bool * bool * bool) -> pos -> unit;
@@ -71,6 +68,8 @@ type 'value compiler_api = {
with_imports : 'a . import list -> placed_name list list -> (unit -> 'a) -> 'a;
with_options : 'a . compiler_options -> (unit -> 'a) -> 'a;
exc_string : 'a . string -> 'a;
+ get_hxb_writer_config : unit -> 'value;
+ set_hxb_writer_config : 'value -> unit;
}
@@ -516,7 +515,6 @@ and encode_exceptions_config ec =
and encode_package_rule pr =
let tag, pl = match pr with
| Forbidden -> 0, []
- | Directory (path) -> 1, [encode_string path]
| Remap (path) -> 2, [encode_string path]
in
encode_enum ~pos:None IPackageRule tag pl
@@ -1171,7 +1169,7 @@ and encode_tclass c =
"fields", encode_ref c.cl_ordered_fields (encode_and_map_array encode_cfield) (fun() -> "class fields");
"statics", encode_ref c.cl_ordered_statics (encode_and_map_array encode_cfield) (fun() -> "class fields");
"constructor", (match c.cl_constructor with None -> vnull | Some cf -> encode_cfref cf);
- "init", (match c.cl_init with None -> vnull | Some e -> encode_texpr e);
+ "init", (match TClass.get_cl_init c with None -> vnull | Some e -> encode_texpr e);
"overrides", (encode_array (List.map encode_cfref (List.filter (fun cf -> has_class_field_flag cf CfOverride) c.cl_ordered_fields)))
]
@@ -1847,7 +1845,7 @@ let macro_api ccom get_api =
vnull
);
"class_path", vfun0 (fun() ->
- encode_array (List.map encode_string (ccom()).class_path);
+ encode_array (List.map encode_string (ccom()).class_paths#as_string_list);
);
"resolve_path", vfun1 (fun file ->
let file = decode_string file in
@@ -1953,14 +1951,6 @@ let macro_api ccom get_api =
(get_api()).allow_package (decode_string s);
vnull
);
- "type_patch", vfun4 (fun t f s v ->
- (get_api()).type_patch (decode_string t) (decode_string f) (decode_bool s) (opt decode_string v);
- vnull
- );
- "meta_patch", vfun4 (fun m t f s ->
- (get_api()).meta_patch (decode_string m) (decode_string t) (opt decode_string f) (decode_bool s) (get_api_call_pos ());
- vnull
- );
"add_global_metadata_impl", vfun5 (fun s1 s2 b1 b2 b3 ->
(get_api()).add_global_metadata (decode_string s1) (decode_string s2) (decode_bool b1,decode_bool b2,decode_bool b3) (get_api_call_pos());
vnull
@@ -2023,7 +2013,7 @@ let macro_api ccom get_api =
let api = encode_obj [
"outputFile", encode_string com.file;
"types", encode_array (List.map (fun t -> encode_type (type_of_module_type t)) com.types);
- "main", (match com.main with None -> vnull | Some e -> encode_texpr e);
+ "main", (match com.main.main_expr with None -> vnull | Some e -> encode_texpr e);
"generateValue", vfun1 (fun v ->
let e = decode_texpr v in
let str = Genjs.gen_single_expr js_ctx e false in
@@ -2070,8 +2060,7 @@ let macro_api ccom get_api =
);
"flush_disk_cache", vfun0 (fun () ->
let com = (get_api()).get_com() in
- com.file_lookup_cache#clear;
- com.readdir_cache#clear;
+ com.class_paths#clear_cache;
vnull
);
"get_pos_infos", vfun1 (fun p ->
@@ -2170,15 +2159,15 @@ let macro_api ccom get_api =
"add_class_path", vfun1 (fun cp ->
let com = ccom() in
let cp = decode_string cp in
- let cp = Path.add_trailing_slash cp in
- com.class_path <- cp :: com.class_path;
+ let path = Path.add_trailing_slash cp in
+ let cp = new ClassPath.directory_class_path path User in
+ com.class_paths#add cp;
(match com.get_macros() with
| Some(mcom) ->
- mcom.class_path <- cp :: mcom.class_path;
+ mcom.class_paths#add cp#clone;
| None ->
());
- com.file_lookup_cache#clear;
- com.readdir_cache#clear;
+ com.class_paths#clear_cache;
vnull
);
"add_native_lib", vfun1 (fun file ->
@@ -2255,8 +2244,8 @@ let macro_api ccom get_api =
"foptimize", vbool com.foptimize;
"platform", encode_platform com.platform;
"platformConfig", encode_platform_config com.config;
- "stdPath", encode_array (List.map encode_string com.std_path);
- "mainClass", (match com.main_class with None -> vnull | Some path -> encode_path path);
+ "stdPath", encode_array (List.map (fun path -> encode_string path#path) com.class_paths#get_std_paths);
+ "mainClass", (match com.main.main_class with None -> vnull | Some path -> encode_path path);
"packageRules", encode_string_map encode_package_rule com.package_rules;
]
);
@@ -2265,7 +2254,7 @@ let macro_api ccom get_api =
vnull
);
"get_main_expr", vfun0 (fun() ->
- match (ccom()).main with None -> vnull | Some e -> encode_texpr e
+ match (ccom()).main.main_expr with None -> vnull | Some e -> encode_texpr e
);
"get_module_types", vfun0 (fun() ->
encode_array (List.map encode_module_type (ccom()).types)
@@ -2408,5 +2397,12 @@ let macro_api ccom get_api =
vbool false
end
);
+ "get_hxb_writer_config", vfun0 (fun () ->
+ (get_api()).get_hxb_writer_config ()
+ );
+ "set_hxb_writer_config", vfun1 (fun v ->
+ (get_api()).set_hxb_writer_config v;
+ vnull
+ )
]
end
diff --git a/src/optimization/analyzer.ml b/src/optimization/analyzer.ml
index b170c828374..1664f0e4698 100644
--- a/src/optimization/analyzer.ml
+++ b/src/optimization/analyzer.ml
@@ -1126,7 +1126,7 @@ module Run = struct
| None -> ()
| Some f -> process_field false f;
end;
- begin match c.cl_init with
+ begin match TClass.get_cl_init c with
| None ->
()
| Some e ->
@@ -1138,7 +1138,7 @@ module Run = struct
| TFunction tf -> tf.tf_expr
| _ -> die "" __LOC__
in
- c.cl_init <- Some e
+ TClass.set_cl_init c e
end
let run_on_type com config t =
diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml
index 03d3ba6a4c9..6d122f3fc82 100644
--- a/src/optimization/dce.ml
+++ b/src/optimization/dce.ml
@@ -40,7 +40,7 @@ type dce = {
mutable marked_maybe_fields : tclass_field list;
mutable t_stack : t list;
mutable ts_stack : t list;
- mutable features : (string, class_field_ref list) Hashtbl.t;
+ mutable features : (string, class_field_ref list ref) Hashtbl.t;
}
let push_class dce c =
@@ -121,7 +121,8 @@ let mk_keep_meta pos =
*)
let rec keep_field dce cf c kind =
let is_static = kind = CfrStatic in
- Meta.has_one_of (Meta.Used :: keep_metas) cf.cf_meta
+ Meta.has_one_of keep_metas cf.cf_meta
+ || has_class_field_flag cf CfUsed
|| cf.cf_name = "__init__"
|| has_class_field_flag cf CfExtern
|| (not is_static && overrides_extern_field cf c)
@@ -153,7 +154,7 @@ let rec check_feature dce s =
List.iter (fun cfr ->
let (c, cf) = resolve_class_field_ref dce.com cfr in
mark_field dce c cf cfr.cfr_kind
- ) l;
+ ) !l;
Hashtbl.remove dce.features s;
with Not_found ->
()
@@ -166,8 +167,8 @@ and check_and_add_feature dce s =
(* mark a field as kept *)
and mark_field dce c cf kind =
let add c' cf =
- if not (Meta.has Meta.Used cf.cf_meta) then begin
- cf.cf_meta <- (mk_used_meta cf.cf_pos) :: cf.cf_meta;
+ if not (has_class_field_flag cf CfUsed) then begin
+ add_class_field_flag cf CfUsed;
dce.added_fields <- (c',cf,kind) :: dce.added_fields;
dce.marked_fields <- cf :: dce.marked_fields;
check_feature dce (Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name);
@@ -185,6 +186,11 @@ and mark_field dce c cf kind =
| None -> ()
in
loop c
+ | CfrInit ->
+ begin match c.cl_init with
+ | Some cf -> add c cf
+ | None -> ()
+ end
| CfrStatic | CfrMember ->
let stat = kind = CfrStatic in
if not (PMap.mem cf.cf_name (if stat then c.cl_statics else c.cl_fields)) then begin
@@ -202,20 +208,20 @@ let rec update_marked_class_fields dce c =
let pop = push_class dce c in
(* mark all :?used fields as surely :used now *)
List.iter (fun cf ->
- if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf CfrStatic
+ if has_class_field_flag cf CfMaybeUsed then mark_field dce c cf CfrStatic
) c.cl_ordered_statics;
List.iter (fun cf ->
- if Meta.has Meta.MaybeUsed cf.cf_meta then mark_field dce c cf CfrMember
+ if has_class_field_flag cf CfMaybeUsed then mark_field dce c cf CfrMember
) c.cl_ordered_fields;
(* we always have to keep super classes and implemented interfaces *)
- (match c.cl_init with None -> () | Some init -> dce.follow_expr dce init);
+ (match TClass.get_cl_init c with None -> () | Some init -> dce.follow_expr dce init);
List.iter (fun (c,_) -> mark_class dce c) c.cl_implements;
(match c.cl_super with None -> () | Some (csup,pl) -> mark_class dce csup);
pop()
(* mark a class as kept. If the class has fields marked as @:?keep, make sure to keep them *)
-and mark_class dce c = if not (Meta.has Meta.Used c.cl_meta) then begin
- c.cl_meta <- (mk_used_meta c.cl_pos) :: c.cl_meta;
+and mark_class dce c = if not (has_class_flag c CUsed) then begin
+ add_class_flag c CUsed;
check_feature dce (Printf.sprintf "%s.*" (s_type_path c.cl_path));
update_marked_class_fields dce c;
end
@@ -238,8 +244,8 @@ and mark_t dce p t =
dce.t_stack <- t :: dce.t_stack;
begin match follow t with
| TInst({cl_kind = KTypeParameter ttp} as c,pl) ->
- if not (Meta.has Meta.Used c.cl_meta) then begin
- c.cl_meta <- (mk_used_meta c.cl_pos) :: c.cl_meta;
+ if not (has_class_flag c CUsed) then begin
+ add_class_flag c CUsed;
List.iter (mark_t dce p) (get_constraints ttp);
end;
List.iter (mark_t dce p) pl
@@ -288,10 +294,10 @@ let mark_dependent_fields dce csup n kind =
let cf = PMap.find n (if stat then c.cl_statics else c.cl_fields) in
(* if it's clear that the class is kept, the field has to be kept as well. This is also true for
extern interfaces because we cannot remove fields from them *)
- if Meta.has Meta.Used c.cl_meta || ((has_class_flag csup CInterface) && (has_class_flag csup CExtern)) then mark_field dce c cf kind
+ if has_class_flag c CUsed || ((has_class_flag csup CInterface) && (has_class_flag csup CExtern)) then mark_field dce c cf kind
(* otherwise it might be kept if the class is kept later, so mark it as :?used *)
- else if not (Meta.has Meta.MaybeUsed cf.cf_meta) then begin
- cf.cf_meta <- (Meta.MaybeUsed,[],cf.cf_pos) :: cf.cf_meta;
+ else if not (has_class_field_flag cf CfMaybeUsed) then begin
+ add_class_field_flag cf CfMaybeUsed;
dce.marked_maybe_fields <- cf :: dce.marked_maybe_fields;
end
with Not_found ->
@@ -685,7 +691,7 @@ and expr dce e =
let fix_accessors com =
List.iter (fun mt -> match mt with
(* filter empty abstract implementation classes (issue #1885). *)
- | TClassDecl({cl_kind = KAbstractImpl _} as c) when c.cl_ordered_statics = [] && c.cl_ordered_fields = [] && not (Meta.has Meta.Used c.cl_meta) ->
+ | TClassDecl({cl_kind = KAbstractImpl _} as c) when c.cl_ordered_statics = [] && c.cl_ordered_fields = [] && not (has_class_flag c CUsed) ->
add_class_flag c CExtern;
| TClassDecl({cl_kind = KAbstractImpl a} as c) when a.a_enum ->
let is_runtime_field cf =
@@ -716,16 +722,44 @@ let fix_accessors com =
| _ -> ()
) com.types
+let extract_if_feature meta =
+ let rec loop = function
+ | [] ->
+ []
+ | (Meta.IfFeature,el,_) :: _ ->
+ List.map (fun (e,p) -> match e with
+ | EConst (String(s,_)) -> s
+ | _ -> Error.raise_typing_error "String expected" p
+ ) el
+ | _ :: l ->
+ loop l
+ in
+ loop meta
+
let collect_entry_points dce com =
+ let delayed = ref [] in
+ let check_feature cf_ref meta =
+ List.iter (fun s ->
+ try
+ let l = Hashtbl.find dce.features s in
+ l := cf_ref :: !l
+ with Not_found ->
+ Hashtbl.add dce.features s (ref [cf_ref])
+ ) meta;
+ in
List.iter (fun t ->
- let mt = t_infos t in
- mt.mt_meta <- Meta.remove Meta.Used mt.mt_meta;
match t with
| TClassDecl c ->
+ remove_class_flag c CUsed;
+ let cl_if_feature = extract_if_feature c.cl_meta in
let keep_class = keep_whole_class dce c && (not (has_class_flag c CExtern) || (has_class_flag c CInterface)) in
let is_struct = dce.com.platform = Hl && Meta.has Meta.Struct c.cl_meta in
let loop kind cf =
- if keep_class || is_struct || keep_field dce cf c kind then mark_field dce c cf kind
+ let cf_ref = mk_class_field_ref c cf kind com.is_macro_context in
+ let cf_if_feature = extract_if_feature cf.cf_meta in
+ check_feature cf_ref (cl_if_feature @ cf_if_feature);
+ (* Have to delay mark_field so that we see all @:ifFeature *)
+ if keep_class || is_struct || keep_field dce cf c kind then delayed := (fun () -> mark_field dce c cf kind) :: !delayed
in
List.iter (loop CfrStatic) c.cl_ordered_statics;
List.iter (loop CfrMember) c.cl_ordered_fields;
@@ -734,21 +768,22 @@ let collect_entry_points dce com =
| None -> ()
end;
begin match c.cl_init with
- | Some e when keep_class || Meta.has Meta.KeepInit c.cl_meta ->
- (* create a fake field to deal with our internal logic (issue #3286) *)
- let cf = mk_field "__init__" e.etype e.epos null_pos in
- cf.cf_expr <- Some e;
- loop CfrStatic cf
+ | Some cf when keep_class || Meta.has Meta.KeepInit c.cl_meta ->
+ loop CfrInit cf
| _ ->
()
end;
| TEnumDecl en when keep_whole_enum dce en ->
- let pop = push_class dce {null_class with cl_module = en.e_module} in
- mark_enum dce en;
- pop()
+ en.e_meta <- Meta.remove Meta.Used en.e_meta;
+ delayed := (fun () ->
+ let pop = push_class dce {null_class with cl_module = en.e_module} in
+ mark_enum dce en;
+ pop()
+ ) :: !delayed;
| _ ->
()
) com.types;
+ List.iter (fun f -> f()) !delayed;
if dce.debug then begin
List.iter (fun (c,cf,_) -> match cf.cf_expr with
| None -> ()
@@ -840,8 +875,8 @@ let sweep dce com =
let inef cf = is_physical_field cf in
let has_non_extern_fields = List.exists inef c.cl_ordered_fields || List.exists inef c.cl_ordered_statics in
(* we keep a class if it was used or has a used field *)
- if Meta.has Meta.Used c.cl_meta || has_non_extern_fields then loop (mt :: acc) l else begin
- (match c.cl_init with
+ if has_class_flag c CUsed || has_non_extern_fields then loop (mt :: acc) l else begin
+ (match TClass.get_cl_init c with
| Some f when Meta.has Meta.KeepInit c.cl_meta ->
(* it means that we only need the __init__ block *)
add_class_flag c CExtern;
@@ -868,7 +903,7 @@ let run com main mode =
com = com;
full = full;
dependent_types = Hashtbl.create 0;
- std_dirs = if full then [] else List.map Path.get_full_path com.std_path;
+ std_dirs = if full then [] else List.map (fun path -> Path.get_full_path path#path) com.class_paths#get_std_paths;
debug = Common.defined com Define.DceDebug;
added_fields = [];
follow_expr = expr;
@@ -879,12 +914,6 @@ let run com main mode =
features = Hashtbl.create 0;
curclass = null_class;
} in
- List.iter (fun m ->
- List.iter (fun (s,v) ->
- if Hashtbl.mem dce.features s then Hashtbl.replace dce.features s (v :: Hashtbl.find dce.features s)
- else Hashtbl.add dce.features s [v]
- ) m.m_extra.m_if_feature;
- ) com.modules;
(* first step: get all entry points, which is the main method and all class methods which are marked with @:keep *)
collect_entry_points dce com;
@@ -928,5 +957,4 @@ let run com main mode =
) com.types;
(* cleanup added fields metadata - compatibility with compilation server *)
- List.iter (fun cf -> cf.cf_meta <- Meta.remove Meta.Used cf.cf_meta) dce.marked_fields;
- List.iter (fun cf -> cf.cf_meta <- Meta.remove Meta.MaybeUsed cf.cf_meta) dce.marked_maybe_fields
+ List.iter (fun cf -> remove_class_field_flag cf CfUsed) dce.marked_fields
diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml
index a9709f37040..6b77604dd7d 100644
--- a/src/optimization/inline.ml
+++ b/src/optimization/inline.ml
@@ -546,7 +546,7 @@ class inline_state ctx ethis params cf f p = object(self)
in
let e = (if PMap.is_empty subst then e else inline_params false false e) in
let init = match vars with [] -> None | l -> Some l in
- let md = ctx.curclass.cl_module.m_extra.m_display in
+ let md = ctx.c.curclass.cl_module.m_extra.m_display in
md.m_inline_calls <- (cf.cf_name_pos,{p with pmax = p.pmin + String.length cf.cf_name}) :: md.m_inline_calls;
let wrap e =
(* we can't mute the type of the expression because it is not correct to do so *)
@@ -866,7 +866,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f
in
let tl = arg_types params f.tf_args in
let e = state#finalize e tl tret has_params map_type p in
- if Meta.has (Meta.Custom ":inlineDebug") ctx.meta then begin
+ if Meta.has (Meta.Custom ":inlineDebug") ctx.f.meta then begin
let se t = s_expr_ast true t (s_type (print_context())) in
print_endline (Printf.sprintf "Inline %s:\n\tArgs: %s\n\tExpr: %s\n\tResult: %s"
cf.cf_name
diff --git a/src/optimization/inlineConstructors.ml b/src/optimization/inlineConstructors.ml
index 461ae859b9e..1fb7f8c71e5 100644
--- a/src/optimization/inlineConstructors.ml
+++ b/src/optimization/inlineConstructors.ml
@@ -111,7 +111,7 @@ and inline_object_field =
inline_expression_handled
Defines what will happen to the expression being analized by analyze_aliases
*)
-and inline_expression_handled =
+and inline_expression_handled =
| IEHCaptured (* The expression will be assigned to a variable *)
| IEHIgnored (* The result of the expression will not be used *)
| IEHNotHandled (* Cases that are not handled (usually leads to cancelling inlining *)
@@ -728,7 +728,7 @@ let inline_constructors ctx original_e =
original_e
end else begin
let el,_ = final_map e in
- let cf = ctx.curfield in
+ let cf = ctx.f.curfield in
if !included_untyped && not (Meta.has Meta.HasUntyped cf.cf_meta) then cf.cf_meta <- (Meta.HasUntyped,[],e.epos) :: cf.cf_meta;
let e = make_expr_for_rev_list el e.etype e.epos in
let rec get_pretty_name iv = match iv.iv_kind with
diff --git a/src/optimization/optimizer.ml b/src/optimization/optimizer.ml
index 73f1dd6ea78..d51c8e246ca 100644
--- a/src/optimization/optimizer.ml
+++ b/src/optimization/optimizer.ml
@@ -384,7 +384,7 @@ let reduce_expression ctx e =
if ctx.com.foptimize then
(* We go through rec_stack_default here so that the current field is on inline_stack. This prevents self-recursive
inlining (#7569). *)
- rec_stack_default inline_stack ctx.curfield (fun cf' -> cf' == ctx.curfield) (fun () -> reduce_loop ctx e) e
+ rec_stack_default inline_stack ctx.f.curfield (fun cf' -> cf' == ctx.f.curfield) (fun () -> reduce_loop ctx e) e
else
e
diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml
index 9beeb73bc08..623c0fe4ed6 100644
--- a/src/typing/callUnification.ml
+++ b/src/typing/callUnification.ml
@@ -144,7 +144,7 @@ let unify_call_args ctx el args r callp inline force_inline in_overload =
| (e,p) :: el, [] ->
begin match List.rev !skipped with
| [] ->
- if ctx.is_display_file && not (Diagnostics.error_in_diagnostics_run ctx.com p) then begin
+ if ctx.m.is_display_file && not (Diagnostics.error_in_diagnostics_run ctx.com p) then begin
ignore(type_expr ctx (e,p) WithType.value);
ignore(loop el [])
end;
@@ -168,13 +168,13 @@ let unify_call_args ctx el args r callp inline force_inline in_overload =
end
in
let restore =
- let in_call_args = ctx.in_call_args in
- let in_overload_call_args = ctx.in_overload_call_args in
- ctx.in_call_args <- true;
- ctx.in_overload_call_args <- in_overload;
+ let in_call_args = ctx.f.in_call_args in
+ let in_overload_call_args = ctx.f.in_overload_call_args in
+ ctx.f.in_call_args <- true;
+ ctx.f.in_overload_call_args <- in_overload;
(fun () ->
- ctx.in_call_args <- in_call_args;
- ctx.in_overload_call_args <- in_overload_call_args;
+ ctx.f.in_call_args <- in_call_args;
+ ctx.f.in_overload_call_args <- in_overload_call_args;
)
in
let el = try loop el args with exc -> restore(); raise exc; in
@@ -241,14 +241,14 @@ let unify_field_call ctx fa el_typed el p inline =
else if fa.fa_field.cf_overloads <> [] then OverloadMeta
else OverloadNone
in
- (* Delayed display handling works like this: If ctx.in_overload_call_args is set (via attempt_calls calling unify_call_args' below),
- the code which normally raises eager Display exceptions (in typerDisplay.ml handle_display) instead stores them in ctx.delayed_display.
+ (* Delayed display handling works like this: If ctx.e.in_overload_call_args is set (via attempt_calls calling unify_call_args' below),
+ the code which normally raises eager Display exceptions (in typerDisplay.ml handle_display) instead stores them in ctx.g.delayed_display.
The overload handling here extracts them and associates the exception with the field call candidates. Afterwards, normal overload resolution
can take place and only then the display callback is actually committed.
*)
- let extract_delayed_display () = match ctx.delayed_display with
+ let extract_delayed_display () = match ctx.g.delayed_display with
| Some f ->
- ctx.delayed_display <- None;
+ ctx.g.delayed_display <- None;
Some f
| None ->
None
@@ -328,11 +328,11 @@ let unify_field_call ctx fa el_typed el p inline =
| cf :: candidates ->
let known_monos = List.map (fun (m,_) ->
m,m.tm_type,m.tm_down_constraints
- ) ctx.monomorphs.perfunction in
- let current_monos = ctx.monomorphs.perfunction in
+ ) ctx.e.monomorphs.perfunction in
+ let current_monos = ctx.e.monomorphs.perfunction in
begin try
let candidate = attempt_call cf true in
- ctx.monomorphs.perfunction <- current_monos;
+ ctx.e.monomorphs.perfunction <- current_monos;
if overload_kind = OverloadProper then begin
let candidates,failures = loop candidates in
candidate :: candidates,failures
@@ -343,7 +343,7 @@ let unify_field_call ctx fa el_typed el p inline =
if t != m.tm_type then m.tm_type <- t;
if constr != m.tm_down_constraints then m.tm_down_constraints <- constr;
) known_monos;
- ctx.monomorphs.perfunction <- current_monos;
+ ctx.e.monomorphs.perfunction <- current_monos;
check_unknown_ident err;
let candidates,failures = loop candidates in
candidates,(cf,err,extract_delayed_display()) :: failures
@@ -362,7 +362,7 @@ let unify_field_call ctx fa el_typed el p inline =
in
(* There's always a chance that we never even came across the EDisplay in an argument, so let's look for it (issue #11422). *)
let check_display_args () =
- if ctx.is_display_file then begin
+ if ctx.m.is_display_file then begin
let rec loop el = match el with
| [] ->
()
@@ -465,9 +465,9 @@ object(self)
end
method private macro_call (ethis : texpr) (cf : tclass_field) (el : expr list) =
- if ctx.macro_depth > 300 then raise_typing_error "Stack overflow" p;
- ctx.macro_depth <- ctx.macro_depth + 1;
- ctx.with_type_stack <- with_type :: ctx.with_type_stack;
+ if ctx.e.macro_depth > 300 then raise_typing_error "Stack overflow" p;
+ ctx.e.macro_depth <- ctx.e.macro_depth + 1;
+ ctx.e.with_type_stack <- with_type :: ctx.e.with_type_stack;
let ethis_f = ref (fun () -> ()) in
let macro_in_macro () =
(fun () ->
@@ -506,16 +506,14 @@ object(self)
loop c
| _ -> die "" __LOC__))
in
- ctx.macro_depth <- ctx.macro_depth - 1;
- ctx.with_type_stack <- List.tl ctx.with_type_stack;
+ ctx.e.macro_depth <- ctx.e.macro_depth - 1;
+ ctx.e.with_type_stack <- List.tl ctx.e.with_type_stack;
let old = ctx.com.error_ext in
ctx.com.error_ext <- (fun err ->
let ep = err.err_pos in
(* display additional info in the case the error is not part of our original call *)
if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin
- locate_macro_error := false;
old (if (ep = null_pos) then { err with err_pos = p } else err);
- locate_macro_error := true;
(* TODO add as sub for above error *)
if ep <> null_pos then old (make_error ~depth:(err.err_depth+1) (Custom (compl_msg "Called from macro here")) p);
end else
@@ -540,7 +538,7 @@ object(self)
let el = el_typed @ List.map (fun e -> type_expr ctx e WithType.value) el in
let t = if t == t_dynamic then
t_dynamic
- else if ctx.untyped then
+ else if ctx.f.untyped then
mk_mono()
else
raise_typing_error (s_type (print_context()) e.etype ^ " cannot be called") e.epos
diff --git a/src/typing/calls.ml b/src/typing/calls.ml
index 2839847ec4a..7a4e275aec7 100644
--- a/src/typing/calls.ml
+++ b/src/typing/calls.ml
@@ -51,8 +51,8 @@ let make_call ctx e params t ?(force_inline=false) p =
end;
let config = Inline.inline_config cl f params t in
ignore(follow f.cf_type); (* force evaluation *)
- (match cl, ctx.curclass.cl_kind, params with
- | Some c, KAbstractImpl _, { eexpr = TLocal { v_meta = v_meta } } :: _ when c == ctx.curclass ->
+ (match cl, ctx.c.curclass.cl_kind, params with
+ | Some c, KAbstractImpl _, { eexpr = TLocal { v_meta = v_meta } } :: _ when c == ctx.c.curclass ->
if
f.cf_name <> "_new"
&& has_meta Meta.This v_meta
@@ -60,7 +60,7 @@ let make_call ctx e params t ?(force_inline=false) p =
then
if assign_to_this_is_allowed ctx then
(* Current method needs to infer CfModifiesThis flag, since we are calling a method, which modifies `this` *)
- add_class_field_flag ctx.curfield CfModifiesThis
+ add_class_field_flag ctx.f.curfield CfModifiesThis
else
raise_typing_error ("Abstract 'this' value can only be modified inside an inline function. '" ^ f.cf_name ^ "' modifies 'this'") p;
| _ -> ()
@@ -206,7 +206,7 @@ let rec acc_get ctx g =
| AKAccess _ -> die "" __LOC__
| AKResolve(sea,name) ->
(dispatcher sea.se_access.fa_pos)#resolve_call sea name
- | AKUsingAccessor sea | AKUsingField sea when ctx.in_display ->
+ | AKUsingAccessor sea | AKUsingField sea when ctx.f.in_display ->
(* Generate a TField node so we can easily match it for position/usage completion (issue #1968) *)
let e_field = FieldAccess.get_field_expr sea.se_access FGet in
let id,_ = store_typed_expr ctx.com sea.se_this e_field.epos in
@@ -220,7 +220,7 @@ let rec acc_get ctx g =
begin match fa.fa_field.cf_kind with
| Method MethMacro ->
(* If we are in display mode, we're probably hovering a macro call subject. Just generate a normal field. *)
- if ctx.in_display then
+ if ctx.f.in_display then
FieldAccess.get_field_expr fa FRead
else
raise_typing_error "Invalid macro access" fa.fa_pos
@@ -328,9 +328,9 @@ let call_to_string ctx ?(resume=false) e =
else
let gen_to_string e =
(* Ignore visibility of the toString field. *)
- ctx.meta <- (Meta.PrivateAccess,[],e.epos) :: ctx.meta;
+ ctx.f.meta <- (Meta.PrivateAccess,[],e.epos) :: ctx.f.meta;
let acc = type_field (TypeFieldConfig.create resume) ctx e "toString" e.epos (MCall []) (WithType.with_type ctx.t.tstring) in
- ctx.meta <- List.tl ctx.meta;
+ ctx.f.meta <- List.tl ctx.f.meta;
build_call ctx acc [] (WithType.with_type ctx.t.tstring) e.epos
in
if ctx.com.config.pf_static && not (is_nullable e.etype) then
@@ -359,7 +359,7 @@ let type_bind ctx (e : texpr) (args,ret) params p =
let vexpr v = mk (TLocal v) v.v_type p in
let acount = ref 0 in
let alloc_name n =
- if n = "" && not ctx.is_display_file then begin
+ if n = "" && not ctx.m.is_display_file then begin
incr acount;
"a" ^ string_of_int !acount;
end else
@@ -368,16 +368,10 @@ let type_bind ctx (e : texpr) (args,ret) params p =
let rec loop args params given_args missing_args ordered_args = match args, params with
| [], [] -> given_args,missing_args,ordered_args
| [], _ -> raise_typing_error "Too many callback arguments" p
- | (n,o,t) :: args , [] when o ->
- let a = if is_pos_infos t then
- let infos = mk_infos ctx p [] in
- ordered_args @ [type_expr ctx infos (WithType.with_argument t n)]
- else if ctx.com.config.pf_pad_nulls && ctx.allow_transform then
- (ordered_args @ [(mk (TConst TNull) t_dynamic p)])
- else
- ordered_args
- in
- loop args [] given_args missing_args a
+ | [n,o,t] , [] when o && is_pos_infos t ->
+ let infos = mk_infos ctx p [] in
+ let ordered_args = ordered_args @ [type_expr ctx infos (WithType.with_argument t n)] in
+ given_args,missing_args,ordered_args
| (n,o,t) :: _ , (EConst(Ident "_"),p) :: _ when not ctx.com.config.pf_can_skip_non_nullable_argument && o && not (is_nullable t) ->
raise_typing_error "Usage of _ is not supported for optional non-nullable arguments" p
| (n,o,t) :: args , ([] as params)
@@ -474,12 +468,12 @@ let array_access ctx e1 e2 mode p =
let skip_abstract = fast_eq et at in
loop ~skip_abstract at
| _, _ ->
- let pt = spawn_monomorph ctx p in
+ let pt = spawn_monomorph ctx.e p in
let t = ctx.t.tarray pt in
begin try
unify_raise et t p
with Error { err_message = Unify _ } ->
- if not ctx.untyped then begin
+ if not ctx.f.untyped then begin
let msg = if !has_abstract_array_access then
"No @:arrayAccess function accepts an argument of " ^ (s_type (print_context()) e2.etype)
else
diff --git a/src/typing/fields.ml b/src/typing/fields.ml
index 5ed4aba0f2e..ed16c63b862 100644
--- a/src/typing/fields.ml
+++ b/src/typing/fields.ml
@@ -77,7 +77,7 @@ let no_abstract_constructor c p =
let check_constructor_access ctx c f p =
if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx.com (error_msg (No_constructor (TClassDecl c))) p;
- if not (can_access ctx c f true || extends ctx.curclass c) && not ctx.untyped then display_error ctx.com (Printf.sprintf "Cannot access private constructor of %s" (s_class_path c)) p
+ if not (can_access ctx c f true || extends ctx.c.curclass c) && not ctx.f.untyped then display_error ctx.com (Printf.sprintf "Cannot access private constructor of %s" (s_class_path c)) p
let check_no_closure_meta ctx cf fa mode p =
match mode with
@@ -109,12 +109,12 @@ let field_access ctx mode f fh e pfield =
let pfull = punion e.epos pfield in
let is_set = match mode with MSet _ -> true | _ -> false in
check_no_closure_meta ctx f fh mode pfield;
- let bypass_accessor = if ctx.bypass_accessor > 0 then (ctx.bypass_accessor <- ctx.bypass_accessor - 1; true) else false in
+ let bypass_accessor () = if ctx.e.bypass_accessor > 0 then (ctx.e.bypass_accessor <- ctx.e.bypass_accessor - 1; true) else false in
let make_access inline = FieldAccess.create e f fh (inline && ctx.allow_inline) pfull in
match f.cf_kind with
| Method m ->
let normal () = AKField(make_access false) in
- if is_set && m <> MethDynamic && not ctx.untyped then raise_typing_error "Cannot rebind this method : please use 'dynamic' before method declaration" pfield;
+ if is_set && m <> MethDynamic && not ctx.f.untyped then raise_typing_error "Cannot rebind this method : please use 'dynamic' before method declaration" pfield;
let maybe_check_visibility c static =
(* For overloads we have to resolve the actual field before we can check accessibility. *)
begin match mode with
@@ -191,34 +191,32 @@ let field_access ctx mode f fh e pfield =
AKNo((normal false),pfield)
in
match (match mode with MGet | MCall _ -> v.v_read | MSet _ -> v.v_write) with
- | AccNo when not (Meta.has Meta.PrivateAccess ctx.meta) ->
+ | AccNo when not (Meta.has Meta.PrivateAccess ctx.f.meta) ->
(match follow e.etype with
- | TInst (c,_) when extends ctx.curclass c || can_access ctx c { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } false ->
+ | TInst (c,_) when extends ctx.c.curclass c || can_access ctx c { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } false ->
normal false
| TAnon a ->
(match !(a.a_status) with
- | ClassStatics c2 when ctx.curclass == c2 || can_access ctx c2 { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } true -> normal false
- | _ -> if ctx.untyped then normal false else normal_failure())
+ | ClassStatics c2 when ctx.c.curclass == c2 || can_access ctx c2 { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } true -> normal false
+ | _ -> if ctx.f.untyped then normal false else normal_failure())
| _ ->
- if ctx.untyped then normal false else normal_failure())
+ if ctx.f.untyped then normal false else normal_failure())
| AccNormal | AccNo ->
normal false
- | AccCall when (not ctx.allow_transform) || (ctx.in_display && DisplayPosition.display_position#enclosed_in pfull) ->
+ | AccCall when (not ctx.allow_transform) || (ctx.f.in_display && DisplayPosition.display_position#enclosed_in pfull) ->
normal false
| AccCall ->
let m = (match mode with MSet _ -> "set_" | _ -> "get_") ^ f.cf_name in
let bypass_accessor =
- bypass_accessor
- ||
(
- m = ctx.curfield.cf_name
+ m = ctx.f.curfield.cf_name
&&
match e.eexpr with
| TConst TThis -> true
- | TLocal v -> Option.map_default (fun vthis -> v == vthis) false ctx.vthis
- | TTypeExpr (TClassDecl c) when c == ctx.curclass -> true
+ | TLocal v -> Option.map_default (fun vthis -> v == vthis) false ctx.f.vthis
+ | TTypeExpr (TClassDecl c) when c == ctx.c.curclass -> true
| _ -> false
- )
+ ) || bypass_accessor ()
in
if bypass_accessor then (
(match e.eexpr with TLocal _ when Common.defined ctx.com Define.Haxe3Compat -> warning ctx WTemp "Field set has changed here in Haxe 4: call setter explicitly to keep Haxe 3.x behaviour" pfield | _ -> ());
@@ -236,15 +234,15 @@ let field_access ctx mode f fh e pfield =
AKAccessor (make_access false)
end
| AccNever ->
- if ctx.untyped then normal false else normal_failure()
+ if ctx.f.untyped then normal false else normal_failure()
| AccInline ->
normal true
| AccCtor ->
let is_child_of_abstract c =
- has_class_flag c CAbstract && extends ctx.curclass c
+ has_class_flag c CAbstract && extends ctx.c.curclass c
in
- (match ctx.curfun, fh with
- | FunConstructor, FHInstance(c,_) when c == ctx.curclass || is_child_of_abstract c -> normal false
+ (match ctx.e.curfun, fh with
+ | FunConstructor, FHInstance(c,_) when c == ctx.c.curclass || is_child_of_abstract c -> normal false
| _ -> normal_failure()
)
| AccRequire (r,msg) ->
@@ -272,7 +270,13 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
| None -> raise Not_found
in
let type_field_by_et f e t =
- f { e with etype = t } (follow_without_type t)
+ let e = match ctx.com.platform with
+ | Cs ->
+ {e with etype = t}
+ | _ ->
+ mk (TCast(e,None)) t e.epos
+ in
+ f e (follow_without_type t)
in
let type_field_by_e f e =
f e (follow_without_type e.etype)
@@ -329,29 +333,33 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
type_field_by_interfaces e c
)
| TAnon a ->
- (try
- let f = PMap.find i a.a_fields in
- if has_class_field_flag f CfImpl && not (has_class_field_flag f CfEnum) then display_error ctx.com "Cannot access non-static abstract field statically" pfield;
- match !(a.a_status) with
+ begin match !(a.a_status) with
+ | ClassStatics c ->
+ begin try
+ let cf = PMap.find i c.cl_statics in
+ if has_class_field_flag cf CfImpl && not (has_class_field_flag cf CfEnum) then display_error ctx.com "Cannot access non-static abstract field statically" pfield;
+ field_access cf (FHStatic c)
+ with Not_found ->
+ begin match c.cl_kind with
+ | KAbstractImpl a ->
+ type_field_by_forward_static (fun() ->
+ let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in
+ let et = type_module_type ctx mt p in
+ type_field_by_e type_field_by_type et
+ ) a
+ | _ ->
+ raise Not_found
+ end
+ end
| EnumStatics en ->
- let c = try PMap.find f.cf_name en.e_constrs with Not_found -> die "" __LOC__ in
+ let c = PMap.find i en.e_constrs in
let fmode = FEnum (en,c) in
let t = enum_field_type ctx en c p in
AKExpr (mk (TField (e,fmode)) t p)
- | ClassStatics c ->
- field_access f (FHStatic c)
| _ ->
- field_access f FHAnon
- with Not_found ->
- match !(a.a_status) with
- | ClassStatics { cl_kind = KAbstractImpl a } ->
- type_field_by_forward_static (fun() ->
- let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in
- let et = type_module_type ctx mt p in
- type_field_by_e type_field_by_type et
- ) a
- | _ -> raise Not_found
- )
+ let cf = PMap.find i a.a_fields in
+ field_access cf FHAnon
+ end;
| TMono r ->
let mk_field () = {
(mk_field i (mk_mono()) p null_pos) with
@@ -374,8 +382,8 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
| CTypes tl ->
type_field_by_list (fun (t,_) -> type_field_by_et type_field_by_type e t) tl
| CUnknown ->
- if not (List.exists (fun (m,_) -> m == r) ctx.monomorphs.perfunction) && not (ctx.untyped && ctx.com.platform = Neko) then
- ctx.monomorphs.perfunction <- (r,p) :: ctx.monomorphs.perfunction;
+ if not (List.exists (fun (m,_) -> m == r) ctx.e.monomorphs.perfunction) && not (ctx.f.untyped && ctx.com.platform = Neko) then
+ ctx.e.monomorphs.perfunction <- (r,p) :: ctx.e.monomorphs.perfunction;
let f = mk_field() in
Monomorph.add_down_constraint r (MField f);
Monomorph.add_down_constraint r MOpenStructure;
@@ -418,9 +426,9 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
check cfl
| cf :: cfl ->
(* We always want to reset monomorphs here because they will be handled again when making the actual call. *)
- let current_monos = ctx.monomorphs.perfunction in
+ let current_monos = ctx.e.monomorphs.perfunction in
let check () =
- ctx.monomorphs.perfunction <- current_monos;
+ ctx.e.monomorphs.perfunction <- current_monos;
check cfl
in
try
@@ -433,7 +441,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
else begin
let e = unify_static_extension ctx e t0 p in
ImportHandling.mark_import_position ctx pc;
- ctx.monomorphs.perfunction <- current_monos;
+ ctx.e.monomorphs.perfunction <- current_monos;
AKUsingField (make_static_extension_access c cf e false p)
end
| _ ->
@@ -564,7 +572,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
with Not_found -> try
type_field_by_module e t
with Not_found when not (TypeFieldConfig.do_resume cfg) ->
- if not ctx.untyped then begin
+ if not ctx.f.untyped then begin
let has_special_field a =
List.exists (fun (_,cf) -> cf.cf_name = i) a.a_ops
|| List.exists (fun (_,_,cf) -> cf.cf_name = i) a.a_unops
@@ -586,7 +594,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
with Exit ->
display_error ctx.com (StringError.string_error i (string_source tthis) (s_type (print_context()) tthis ^ " has no field " ^ i)) pfield
end;
- AKExpr (mk (TField (e,FDynamic i)) (spawn_monomorph ctx p) p)
+ AKExpr (mk (TField (e,FDynamic i)) (spawn_monomorph ctx.e p) p)
let type_field_default_cfg = type_field TypeFieldConfig.default
diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml
index 8f27c9de0df..61953a43f75 100644
--- a/src/typing/finalization.ml
+++ b/src/typing/finalization.ml
@@ -9,7 +9,7 @@ open Typecore
(* FINALIZATION *)
let get_main ctx types =
- match ctx.com.main_class with
+ match ctx.com.main.main_class with
| None -> None
| Some path ->
let p = null_pos in
@@ -179,7 +179,7 @@ let sort_types com (modules : module_lut) =
and walk_class p c =
(match c.cl_super with None -> () | Some (c,_) -> loop_class p c);
List.iter (fun (c,_) -> loop_class p c) c.cl_implements;
- (match c.cl_init with
+ (match TClass.get_cl_init c with
| None -> ()
| Some e -> walk_expr p e);
PMap.iter (fun _ f ->
diff --git a/src/typing/forLoop.ml b/src/typing/forLoop.ml
index 65b67979cd5..6bb73631c7a 100644
--- a/src/typing/forLoop.ml
+++ b/src/typing/forLoop.ml
@@ -458,9 +458,9 @@ type iteration_kind =
| IKKeyValue of iteration_ident * iteration_ident
let type_for_loop ctx handle_display ik e1 e2 p =
- let old_loop = ctx.in_loop in
+ let old_loop = ctx.e.in_loop in
let old_locals = save_locals ctx in
- ctx.in_loop <- true;
+ ctx.e.in_loop <- true;
let e2 = Expr.ensure_block e2 in
let check_display (i,pi,dko) = match dko with
| None -> ()
@@ -472,7 +472,7 @@ let type_for_loop ctx handle_display ik e1 e2 p =
let i = add_local_with_origin ctx TVOForVariable i iterator.it_type pi in
let e2 = type_expr ctx e2 NoValue in
check_display (i,pi,dko);
- ctx.in_loop <- old_loop;
+ ctx.e.in_loop <- old_loop;
old_locals();
begin try
IterationKind.to_texpr ctx i iterator e2 p
@@ -509,7 +509,7 @@ let type_for_loop ctx handle_display ik e1 e2 p =
mk (TVar(vtmp,Some e1)) ctx.t.tvoid e1.epos;
mk (TWhile(ehasnext,ebody,NormalWhile)) ctx.t.tvoid p;
]) ctx.t.tvoid p in
- ctx.in_loop <- old_loop;
+ ctx.e.in_loop <- old_loop;
old_locals();
e
diff --git a/src/typing/functionArguments.ml b/src/typing/functionArguments.ml
index 4baf7402020..cba9c2add66 100644
--- a/src/typing/functionArguments.ml
+++ b/src/typing/functionArguments.ml
@@ -131,9 +131,9 @@ object(self)
in
loop (abstract_this <> None) syntax with_default
- (* Brings arguments into context by adding them to `ctx.locals`. *)
- method bring_into_context =
+ (* Brings arguments into context by adding them to `ctx.f.locals`. *)
+ method bring_into_context ctx =
List.iter (fun (v,_) ->
- ctx.locals <- PMap.add v.v_name v ctx.locals
+ ctx.f.locals <- PMap.add v.v_name v ctx.f.locals
) self#for_expr
end
diff --git a/src/typing/generic.ml b/src/typing/generic.ml
index 2c34510de40..30e59364c07 100644
--- a/src/typing/generic.ml
+++ b/src/typing/generic.ml
@@ -26,7 +26,7 @@ let make_generic ctx ps pt debug p =
begin match c.cl_kind with
| KExpr e ->
let name = ident_safe (Ast.Printer.s_expr e) in
- let e = type_expr {ctx with locals = PMap.empty} e WithType.value in
+ let e = type_expr {ctx with f = {ctx.f with locals = PMap.empty}} e WithType.value in
name,(t,Some e)
| _ ->
((ident_safe (s_type_path_underscore c.cl_path)) ^ (loop_tl top tl),(t,None))
@@ -231,6 +231,10 @@ let build_instances ctx t p =
in
loop t
+let clone_type_parameter gctx mg path ttp =
+ let ttp = clone_type_parameter (generic_substitute_type gctx) path ttp in
+ ttp.ttp_class.cl_module <- mg;
+ ttp
let build_generic_class ctx c p tl =
let pack = fst c.cl_path in
@@ -309,14 +313,7 @@ let build_generic_class ctx c p tl =
set_type_parameter_dependencies mg tl;
let build_field cf_old =
let params = List.map (fun ttp ->
- let c = {ttp.ttp_class with cl_module = mg} in
- let def = Option.map (generic_substitute_type gctx) ttp.ttp_default in
- let constraints = match ttp.ttp_constraints with
- | None -> None
- | Some constraints -> Some (lazy (List.map (generic_substitute_type gctx) (Lazy.force constraints)))
- in
- let ttp' = mk_type_param c ttp.ttp_host def constraints in
- c.cl_kind <- KTypeParameter ttp';
+ let ttp' = clone_type_parameter gctx mg ([cf_old.cf_name],ttp.ttp_name) ttp in
(ttp.ttp_type,ttp')
) cf_old.cf_params in
let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) params in
@@ -357,7 +354,7 @@ let build_generic_class ctx c p tl =
if gctx.generic_debug then print_endline (Printf.sprintf "[GENERIC] %s" (Printer.s_tclass_field " " cf_new));
t
in
- let t = spawn_monomorph ctx p in
+ let t = spawn_monomorph ctx.e p in
let r = make_lazy ctx t (fun r ->
let t0 = f() in
unify_raise t0 t p;
@@ -367,7 +364,7 @@ let build_generic_class ctx c p tl =
cf_new.cf_type <- TLazy r;
cf_new
in
- if c.cl_init <> None then raise_typing_error "This class can't be generic" p;
+ if TClass.get_cl_init c <> None then raise_typing_error "This class can't be generic" p;
List.iter (fun cf -> match cf.cf_kind with
| Method MethMacro when not ctx.com.is_macro_context -> ()
| _ -> raise_typing_error "A generic class can't have static fields" cf.cf_pos
@@ -409,6 +406,17 @@ let build_generic_class ctx c p tl =
TInst (cg,[])
end
+let extract_type_parameters tl =
+ let params = DynArray.create () in
+ let rec loop t = match follow t with
+ | TInst({cl_kind = KTypeParameter ttp},[]) ->
+ DynArray.add params ttp;
+ | _ ->
+ TFunctions.iter loop t
+ in
+ List.iter loop tl;
+ DynArray.to_list params
+
let type_generic_function ctx fa fcc with_type p =
let c,stat = match fa.fa_host with
| FHInstance(c,tl) -> c,false
@@ -432,8 +440,18 @@ let type_generic_function ctx fa fcc with_type p =
) monos;
let el = fcc.fc_args in
let gctx = make_generic ctx cf.cf_params monos (Meta.has (Meta.Custom ":debug.generic") cf.cf_meta) p in
- let fc_type = build_instances ctx fcc.fc_type p in
let name = cf.cf_name ^ "_" ^ gctx.name in
+ let params = extract_type_parameters monos in
+ let clones = List.map (fun ttp ->
+ let name_path = if (fst ttp.ttp_class.cl_path) = [cf.cf_name] then ([name],ttp.ttp_name) else ttp.ttp_class.cl_path in
+ clone_type_parameter gctx c.cl_module name_path ttp
+ ) params in
+ let param_subst = List.map2 (fun ttp ttp' ->
+ (ttp.ttp_type,ttp')
+ ) params clones in
+ let param_subst = List.map (fun (t,ttp) -> t,(ttp.ttp_type,None)) param_subst in
+ let gctx = {gctx with subst = param_subst @ gctx.subst} in
+ let fc_type = build_instances ctx (generic_substitute_type gctx fcc.fc_type) p in
let unify_existing_field tcf pcf = try
unify_raise tcf fc_type p
with Error ({ err_message = Unify _; err_depth = depth } as err) ->
@@ -484,7 +502,12 @@ let type_generic_function ctx fa fcc with_type p =
);
cf2.cf_kind <- cf.cf_kind;
if not (has_class_field_flag cf CfPublic) then remove_class_field_flag cf2 CfPublic;
- cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: cf.cf_meta
+ let meta = List.filter (fun (meta,_,_) -> match meta with
+ | Meta.Generic -> false
+ | _ -> true
+ ) cf.cf_meta in
+ cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: meta;
+ cf2.cf_params <- clones
in
let mk_cf2 name =
mk_field ~static:stat name fc_type cf.cf_pos cf.cf_name_pos
diff --git a/src/typing/instanceBuilder.ml b/src/typing/instanceBuilder.ml
index a600016d352..5d86ee883b9 100644
--- a/src/typing/instanceBuilder.ml
+++ b/src/typing/instanceBuilder.ml
@@ -14,8 +14,8 @@ let get_macro_path ctx e args p =
let path = match e with
| (EConst(Ident i)),_ ->
let path = try
- if not (PMap.mem i ctx.curclass.cl_statics) then raise Not_found;
- ctx.curclass.cl_path
+ if not (PMap.mem i ctx.c.curclass.cl_statics) then raise Not_found;
+ ctx.c.curclass.cl_path
with Not_found -> try
(t_infos (let path,_,_ = PMap.find i (ctx.m.import_resolution#extract_field_imports) in path)).mt_path
with Not_found ->
@@ -37,12 +37,12 @@ let build_macro_type ctx pl p =
| _ ->
raise_typing_error "MacroType requires a single expression call parameter" p
) in
- let old = ctx.ret in
+ let old = ctx.e.ret in
let t = (match ctx.g.do_macro ctx MMacroType path field args p with
- | MError | MMacroInMacro -> spawn_monomorph ctx p
- | MSuccess _ -> ctx.ret
+ | MError | MMacroInMacro -> spawn_monomorph ctx.e p
+ | MSuccess _ -> ctx.e.ret
) in
- ctx.ret <- old;
+ ctx.e.ret <- old;
t
let build_macro_build ctx c pl cfl p =
@@ -55,14 +55,14 @@ let build_macro_build ctx c pl cfl p =
| _,[ECall(e,args),_],_ -> get_macro_path ctx e args p
| _ -> raise_typing_error "genericBuild requires a single expression call parameter" p
in
- let old = ctx.ret,ctx.get_build_infos in
- ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
+ let old = ctx.e.ret,ctx.c.get_build_infos in
+ ctx.c.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl));
let t = (match ctx.g.do_macro ctx MMacroType path field args p with
- | MError | MMacroInMacro -> spawn_monomorph ctx p
- | MSuccess _ -> ctx.ret
+ | MError | MMacroInMacro -> spawn_monomorph ctx.e p
+ | MSuccess _ -> ctx.e.ret
) in
- ctx.ret <- fst old;
- ctx.get_build_infos <- snd old;
+ ctx.e.ret <- fst old;
+ ctx.c.get_build_infos <- snd old;
t
(* -------------------------------------------------------------------------- *)
@@ -73,7 +73,7 @@ let get_build_info ctx mtype p =
| TClassDecl c ->
if ctx.pass > PBuildClass then ignore(c.cl_build());
let build f s tl =
- let t = spawn_monomorph ctx p in
+ let t = spawn_monomorph ctx.e p in
let r = make_lazy ctx t (fun r ->
let tf = f tl in
unify_raise tf t p;
diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml
index d5df49e80bb..b17f1a2b103 100644
--- a/src/typing/macroContext.ml
+++ b/src/typing/macroContext.ml
@@ -34,7 +34,10 @@ module Interp = struct
include BuiltApi
end
-let macro_enable_cache = ref false
+
+module HxbWriterConfigReaderEval = HxbWriterConfig.WriterConfigReader(EvalDataApi.EvalReaderApi)
+module HxbWriterConfigWriterEval = HxbWriterConfig.WriterConfigWriter(EvalDataApi.EvalWriterApi)
+
let macro_interp_cache = ref None
let safe_decode com v expected t p f =
@@ -48,35 +51,13 @@ let safe_decode com v expected t p f =
close_out ch;
raise_typing_error (Printf.sprintf "Expected %s but got %s (see %s.txt for details)" expected (Interp.value_string v) (String.concat "/" path)) p
-let get_type_patch ctx t sub =
- let new_patch() =
- { tp_type = None; tp_remove = false; tp_meta = [] }
- in
- let path = Ast.parse_path t in
- let h, tp = (try
- Hashtbl.find ctx.g.type_patches path
- with Not_found ->
- let h = Hashtbl.create 0 in
- let tp = new_patch() in
- Hashtbl.add ctx.g.type_patches path (h,tp);
- h, tp
- ) in
- match sub with
- | None -> tp
- | Some k ->
- try
- Hashtbl.find h k
- with Not_found ->
- let tp = new_patch() in
- Hashtbl.add h k tp;
- tp
let macro_timer com l =
Timer.timer (if Common.defined com Define.MacroTimes then ("macro" :: l) else ["macro"])
let typing_timer ctx need_type f =
let t = Timer.timer ["typing"] in
- let old = ctx.com.error_ext and oldp = ctx.pass and oldlocals = ctx.locals in
+ let old = ctx.com.error_ext and oldp = ctx.pass and oldlocals = ctx.f.locals in
let restore_report_mode = disable_report_mode ctx.com in
(*
disable resumable errors... unless we are in display mode (we want to reach point of completion)
@@ -91,7 +72,7 @@ let typing_timer ctx need_type f =
t();
ctx.com.error_ext <- old;
ctx.pass <- oldp;
- ctx.locals <- oldlocals;
+ ctx.f.locals <- oldlocals;
restore_report_mode ();
in
try
@@ -219,12 +200,6 @@ let make_macro_com_api com mcom p =
snd (Typecore.store_typed_expr com te p)
);
allow_package = (fun v -> Common.allow_package com v);
- type_patch = (fun t f s v ->
- Interp.exc_string "unsupported"
- );
- meta_patch = (fun m t f s p ->
- Interp.exc_string "unsupported"
- );
set_js_generator = (fun gen ->
com.js_gen <- Some (fun() ->
Path.mkdir_from_path com.file;
@@ -270,9 +245,6 @@ let make_macro_com_api com mcom p =
current_module = (fun() ->
null_module
);
- use_cache = (fun() ->
- !macro_enable_cache
- );
format_string = (fun s p ->
FormatString.format_string com.defines s p (fun e p -> (e,p))
);
@@ -309,6 +281,28 @@ let make_macro_com_api com mcom p =
com.warning ~depth w [] msg p
);
exc_string = Interp.exc_string;
+ get_hxb_writer_config = (fun () ->
+ match com.hxb_writer_config with
+ | Some config ->
+ HxbWriterConfigWriterEval.write_writer_config config
+ | None ->
+ VNull
+ );
+ set_hxb_writer_config = (fun v ->
+ if v == VNull then
+ com.hxb_writer_config <- None
+ else begin
+ let config = match com.hxb_writer_config with
+ | Some config ->
+ config
+ | None ->
+ let config = HxbWriterConfig.create () in
+ com.hxb_writer_config <- Some config;
+ config
+ in
+ HxbWriterConfigReaderEval.read_writer_config config v
+ end
+ );
}
let make_macro_api ctx mctx p =
@@ -412,26 +406,8 @@ let make_macro_api ctx mctx p =
MacroApi.flush_context = (fun f ->
typing_timer ctx true f
);
- MacroApi.type_patch = (fun t f s v ->
- typing_timer ctx false (fun() ->
- let v = (match v with None -> None | Some s ->
- match ParserEntry.parse_string Grammar.parse_complex_type ctx.com.defines s null_pos raise_typing_error false with
- | ParseSuccess((ct,_),_,_) -> Some ct
- | ParseError(_,(msg,p),_) -> Parser.error msg p (* p is null_pos, but we don't have anything else here... *)
- ) in
- let tp = get_type_patch ctx t (Some (f,s)) in
- match v with
- | None -> tp.tp_remove <- true
- | Some t -> tp.tp_type <- Some t
- );
- );
- MacroApi.meta_patch = (fun m t f s p ->
- let ml = parse_metadata m p in
- let tp = get_type_patch ctx t (match f with None -> None | Some f -> Some (f,s)) in
- tp.tp_meta <- tp.tp_meta @ (List.map (fun (m,el,_) -> (m,el,p)) ml);
- );
MacroApi.get_local_type = (fun() ->
- match ctx.get_build_infos() with
+ match ctx.c.get_build_infos() with
| Some (mt,tl,_) ->
Some (match mt with
| TClassDecl c -> TInst (c,tl)
@@ -440,23 +416,23 @@ let make_macro_api ctx mctx p =
| TAbstractDecl a -> TAbstract(a,tl)
)
| _ ->
- if ctx.curclass == null_class then
+ if ctx.c.curclass == null_class then
None
else
- Some (TInst (ctx.curclass,[]))
+ Some (TInst (ctx.c.curclass,[]))
);
MacroApi.get_expected_type = (fun() ->
- match ctx.with_type_stack with
+ match ctx.e.with_type_stack with
| (WithType.WithType(t,_)) :: _ -> Some t
| _ -> None
);
MacroApi.get_call_arguments = (fun() ->
- match ctx.call_argument_stack with
+ match ctx.e.call_argument_stack with
| [] -> None
| el :: _ -> Some el
);
MacroApi.get_local_method = (fun() ->
- ctx.curfield.cf_name;
+ ctx.f.curfield.cf_name;
);
MacroApi.get_local_using = (fun() ->
List.map fst ctx.m.module_using;
@@ -465,10 +441,10 @@ let make_macro_api ctx mctx p =
ctx.m.import_statements;
);
MacroApi.get_local_vars = (fun () ->
- ctx.locals;
+ ctx.f.locals;
);
MacroApi.get_build_fields = (fun() ->
- match ctx.get_build_infos() with
+ match ctx.c.get_build_infos() with
| None -> Interp.vnull
| Some (_,_,fields) -> Interp.encode_array (List.map Interp.encode_field fields)
);
@@ -515,7 +491,7 @@ let make_macro_api ctx mctx p =
let mpath = Ast.parse_path m in
begin try
let m = ctx.com.module_lut#find mpath in
- ignore(TypeloadModule.type_types_into_module ctx m types pos)
+ ignore(TypeloadModule.type_types_into_module ctx.com ctx.g m types pos)
with Not_found ->
let mnew = TypeloadModule.type_module ctx mpath (Path.UniqueKey.lazy_path ctx.m.curmod.m_extra.m_file) types pos in
mnew.m_extra.m_kind <- MFake;
@@ -610,9 +586,7 @@ 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
- macro_interp_cache := Some mint;
- end
+ macro_interp_cache := Some mint
and flush_macro_context mint mctx =
let t = macro_timer mctx.com ["flush"] in
@@ -662,9 +636,8 @@ and flush_macro_context mint mctx =
let type_filters = [
FiltersCommon.remove_generic_base;
Exceptions.patch_constructors mctx;
- (fun mt -> AddFieldInits.add_field_inits mctx.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt);
+ (fun mt -> AddFieldInits.add_field_inits mctx.c.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt);
minimal_restore;
- Naming.apply_native_paths
] in
let ready = fun t ->
FiltersCommon.apply_filters_once mctx expr_filters t;
@@ -709,19 +682,29 @@ let create_macro_context com =
let com2 = Common.clone com true in
com.get_macros <- (fun() -> Some com2);
com2.package_rules <- PMap.empty;
- com2.main_class <- None;
(* Inherit most display settings, but require normal typing. *)
com2.display <- {com.display with dms_kind = DMNone; dms_full_typing = true; dms_force_macro_typing = true; dms_inline = true; };
- com2.class_path <- List.filter (fun s -> not (ExtString.String.exists s "/_std/")) com2.class_path;
- let name = platform_name !Globals.macro_platform in
- com2.class_path <- List.map (fun p -> p ^ name ^ "/_std/") com2.std_path @ com2.class_path;
+ com2.class_paths#lock_context "macro" false;
+ let name = platform_name Eval in
+ let eval_std = ref None in
+ com2.class_paths#modify (fun cp -> match cp#scope with
+ | StdTarget ->
+ []
+ | Std ->
+ eval_std := Some (new ClassPath.directory_class_path (cp#path ^ name ^ "/_std/") StdTarget);
+ [cp#clone]
+ | _ ->
+ [cp#clone]
+ ) com.class_paths#as_list;
+ (* Eval _std must be in front so we don't look into hxnodejs or something. *)
+ com2.class_paths#add (Option.get !eval_std);
let defines = adapt_defines_to_macro_context com2.defines; in
com2.defines.values <- defines.values;
com2.defines.defines_signature <- None;
- com2.platform <- !Globals.macro_platform;
+ com2.platform <- Eval;
Common.init_platform com2;
let mctx = !create_context_ref com2 None in
- mctx.is_display_file <- false;
+ mctx.m.is_display_file <- false;
CommonCache.lock_signature com2 "get_macro_context";
mctx
@@ -751,6 +734,7 @@ let load_macro_module mctx com cpath display p =
enum_with_type = None;
module_using = [];
import_statements = [];
+ is_display_file = (com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key mloaded.m_extra.m_file));
};
mloaded,(fun () -> mctx.com.display <- old)
@@ -792,6 +776,7 @@ let load_macro'' com mctx display cpath f p =
enum_with_type = None;
module_using = [];
import_statements = [];
+ is_display_file = false;
};
t();
meth
@@ -973,7 +958,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
| MBuild ->
"Array",(fun () ->
let fields = if v = Interp.vnull then
- (match ctx.get_build_infos() with
+ (match ctx.c.get_build_infos() with
| None -> die "" __LOC__
| Some (_,_,fields) -> fields)
else
@@ -984,14 +969,14 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
| MMacroType ->
"ComplexType",(fun () ->
let t = if v = Interp.vnull then
- spawn_monomorph ctx p
+ spawn_monomorph ctx.e p
else try
let ct = Interp.decode_ctype v in
Typeload.load_complex_type ctx false ct;
with MacroApi.Invalid_expr | EvalContext.RunTimeException _ ->
Interp.decode_type v
in
- ctx.ret <- t;
+ ctx.e.ret <- t;
MSuccess (EBlock [],p)
)
in
@@ -1005,7 +990,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p =
e
let call_macro mctx args margs call p =
- mctx.curclass <- null_class;
+ mctx.c.curclass <- null_class;
let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in
call (List.map (fun e -> try Interp.make_const e with Exit -> raise_typing_error "Argument should be a constant" e.epos) el)
@@ -1066,7 +1051,7 @@ let interpret ctx =
let mctx = get_macro_context ctx in
let mctx = Interp.create ctx.com (make_macro_api ctx mctx null_pos) false in
Interp.add_types mctx ctx.com.types (fun t -> ());
- match ctx.com.main with
+ match ctx.com.main.main_expr with
| None -> ()
| Some e -> ignore(Interp.eval_expr mctx e)
diff --git a/src/typing/matcher.ml b/src/typing/matcher.ml
index 2149921be3c..7aa11c7c265 100644
--- a/src/typing/matcher.ml
+++ b/src/typing/matcher.ml
@@ -26,7 +26,7 @@ module Match = struct
open Typecore
let match_expr ctx e cases def with_type postfix_match p =
- let match_debug = Meta.has (Meta.Custom ":matchDebug") ctx.curfield.cf_meta in
+ let match_debug = Meta.has (Meta.Custom ":matchDebug") ctx.f.curfield.cf_meta in
let rec loop e = match fst e with
| EArrayDecl el when (match el with [(EFor _ | EWhile _),_] -> false | _ -> true) ->
let el = List.map (fun e -> type_expr ctx e WithType.value) el in
diff --git a/src/typing/matcher/case.ml b/src/typing/matcher/case.ml
index 1afd9be3af4..c03ca512e22 100644
--- a/src/typing/matcher/case.ml
+++ b/src/typing/matcher/case.ml
@@ -29,13 +29,13 @@ let make ctx t el eg eo_ast with_type postfix_match p =
let t_old = v.v_type in
v.v_type <- map v.v_type;
(v,t_old) :: acc
- ) ctx.locals [] in
- let old_ret = ctx.ret in
- ctx.ret <- map ctx.ret;
+ ) ctx.f.locals [] in
+ let old_ret = ctx.e.ret in
+ ctx.e.ret <- map ctx.e.ret;
let pctx = {
ctx = ctx;
current_locals = PMap.empty;
- ctx_locals = ctx.locals;
+ ctx_locals = ctx.f.locals;
or_locals = None;
in_reification = false;
is_postfix_match = postfix_match;
@@ -63,7 +63,7 @@ let make ctx t el eg eo_ast with_type postfix_match p =
let e = type_expr ctx e with_type in
Some e
in
- ctx.ret <- old_ret;
+ ctx.e.ret <- old_ret;
List.iter (fun (v,t) -> v.v_type <- t) old_types;
save();
{
diff --git a/src/typing/matcher/exprToPattern.ml b/src/typing/matcher/exprToPattern.ml
index 3d6446cb0f3..3db86b92e1a 100644
--- a/src/typing/matcher/exprToPattern.ml
+++ b/src/typing/matcher/exprToPattern.ml
@@ -63,7 +63,7 @@ let get_general_module_type ctx mt p =
let unify_type_pattern ctx mt t p =
let tcl = get_general_module_type ctx mt p in
match tcl with
- | TAbstract(a,_) -> unify ctx (TAbstract(a,[spawn_monomorph ctx p])) t p
+ | TAbstract(a,_) -> unify ctx (TAbstract(a,[spawn_monomorph ctx.e p])) t p
| _ -> die "" __LOC__
let rec make pctx toplevel t e =
@@ -93,7 +93,7 @@ let rec make pctx toplevel t e =
let v = alloc_var (VUser TVOPatternVariable) name t p in
if final then add_var_flag v VFinal;
pctx.current_locals <- PMap.add name (v,p) pctx.current_locals;
- ctx.locals <- PMap.add name v ctx.locals;
+ ctx.f.locals <- PMap.add name v ctx.f.locals;
v
in
let con_enum en ef p =
@@ -166,18 +166,18 @@ let rec make pctx toplevel t e =
)
in
let try_typing e =
- let old = ctx.untyped in
- ctx.untyped <- true;
+ let old = ctx.f.untyped in
+ ctx.f.untyped <- true;
let restore = catch_errors () in
let e = try
type_expr ctx e (WithType.with_type t)
with exc ->
restore();
- ctx.untyped <- old;
+ ctx.f.untyped <- old;
raise exc
in
restore();
- ctx.untyped <- old;
+ ctx.f.untyped <- old;
let pat = check_expr e in
begin match pat with
| PatConstructor((ConTypeExpr mt,_),_) -> unify_type_pattern ctx mt t e.epos;
@@ -405,7 +405,7 @@ let rec make pctx toplevel t e =
loop None e1
| EBinop(OpArrow,e1,e2) ->
let restore = save_locals ctx in
- ctx.locals <- pctx.ctx_locals;
+ ctx.f.locals <- pctx.ctx_locals;
let v = add_local false "_" null_pos in
(* Tricky stuff: Extractor expressions are like normal expressions, so we don't want to deal with GADT-applied types here.
Let's unapply, then reapply after we're done with the extractor (#5952). *)
@@ -422,12 +422,12 @@ let rec make pctx toplevel t e =
(* Special case for completion on a pattern local: We don't want to add the local to the context
while displaying (#7319) *)
| EDisplay((EConst (Ident _),_ as e),dk) when pctx.ctx.com.display.dms_kind = DMDefault ->
- let locals = ctx.locals in
+ let locals = ctx.f.locals in
let pat = loop e in
- let locals' = ctx.locals in
- ctx.locals <- locals;
+ let locals' = ctx.f.locals in
+ ctx.f.locals <- locals;
ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) MGet (WithType.with_type t));
- ctx.locals <- locals';
+ ctx.f.locals <- locals';
pat
(* For signature completion, we don't want to recurse into the inner pattern because there's probably
a EDisplay(_,DMMarked) in there. We can handle display immediately because inner patterns should not
diff --git a/src/typing/matcher/texprConverter.ml b/src/typing/matcher/texprConverter.ml
index 87f92657803..dfe269d63f9 100644
--- a/src/typing/matcher/texprConverter.ml
+++ b/src/typing/matcher/texprConverter.ml
@@ -25,7 +25,7 @@ let constructor_to_texpr ctx con =
| ConArray i -> make_int ctx.com.basic i p
| ConTypeExpr mt -> TyperBase.type_module_type ctx mt p
| ConStatic(c,cf) -> make_static_field c cf p
- | ConFields _ -> raise_typing_error "Something went wrong" p
+ | ConFields _ -> raise_typing_error "Unexpected matching on ConFields, please report this" p
let s_subject v_lookup s e =
let rec loop top s e = match e.eexpr with
diff --git a/src/typing/nullSafety.ml b/src/typing/nullSafety.ml
index b0683bce6d7..63d9d0f1f78 100644
--- a/src/typing/nullSafety.ml
+++ b/src/typing/nullSafety.ml
@@ -1513,7 +1513,7 @@ class class_checker cls immediate_execution report =
self#check_accessors is_static f
end in
if is_safe_class then
- Option.may ((self#get_checker (safety_mode cls_meta))#check_root_expr) cls.cl_init;
+ Option.may ((self#get_checker (safety_mode cls_meta))#check_root_expr) (TClass.get_cl_init cls);
Option.may (check_field false) cls.cl_constructor;
List.iter (check_field false) cls.cl_ordered_fields;
List.iter (check_field true) cls.cl_ordered_statics;
diff --git a/src/typing/operators.ml b/src/typing/operators.ml
index ba188a434f2..8cc4ecd776c 100644
--- a/src/typing/operators.ml
+++ b/src/typing/operators.ml
@@ -94,7 +94,7 @@ let check_assign ctx e =
raise_typing_error "Cannot assign to final" e.epos
| TLocal {v_extra = None} | TArray _ | TField _ | TIdent _ ->
()
- | TConst TThis | TTypeExpr _ when ctx.untyped ->
+ | TConst TThis | TTypeExpr _ when ctx.f.untyped ->
()
| _ ->
if not (Common.ignore_error ctx.com) then
diff --git a/src/typing/tanon_identification.ml b/src/typing/tanon_identification.ml
index 4a57293cf93..dfbb9922763 100644
--- a/src/typing/tanon_identification.ml
+++ b/src/typing/tanon_identification.ml
@@ -1,21 +1,22 @@
open Globals
open Type
-let rec replace_mono t =
- match t with
- | TMono t ->
- (match t.tm_type with
- | None -> Monomorph.bind t t_dynamic
- | Some _ -> ())
- | TEnum (_,p) | TInst (_,p) | TType (_,p) | TAbstract (_,p) ->
- List.iter replace_mono p
- | TFun (args,ret) ->
- List.iter (fun (_,_,t) -> replace_mono t) args;
- replace_mono ret
- | TAnon _
- | TDynamic _ -> ()
- | TLazy f ->
- replace_mono (lazy_type f)
+let replace_mono tmono_as_tdynamic t =
+ let visited_anons = ref [] in
+ let rec loop t =
+ match t with
+ | TMono ({ tm_type = None }) ->
+ if tmono_as_tdynamic then t_dynamic else t
+ | TAnon an ->
+ if not (List.memq an !visited_anons) then begin
+ visited_anons := an :: !visited_anons;
+ TFunctions.map loop t
+ end else
+ t
+ | _ ->
+ TFunctions.map loop t
+ in
+ loop t
type 'a path_field_mapping = {
pfm_path : path;
@@ -39,7 +40,7 @@ let pfm_of_typedef td = match follow td.t_type with
| _ ->
die "" __LOC__
-class ['a] tanon_identification (empty_path : string list * string) =
+class ['a] tanon_identification =
let is_normal_anon an = match !(an.a_status) with
| Closed | Const -> true
| _ -> false
@@ -59,7 +60,17 @@ object(self)
DynArray.add (DynArray.get pfm_by_arity pfm.pfm_arity) pfm;
Hashtbl.replace pfms path pfm
- method unify (tc : Type.t) (pfm : 'a path_field_mapping) =
+ method unify ~(strict:bool) (tc : Type.t) (pfm : 'a path_field_mapping) =
+ let uctx = if strict then {
+ allow_transitive_cast = false;
+ allow_abstract_cast = false;
+ allow_dynamic_to_cast = false;
+ allow_arg_name_mismatch = false;
+ equality_kind = EqStricter;
+ equality_underlying = false;
+ strict_field_kind = true;
+ } else {default_unification_context with equality_kind = EqDoNotFollowNull} in
+
let check () =
let pair_up fields =
PMap.fold (fun cf acc ->
@@ -73,7 +84,7 @@ object(self)
let monos = List.map (fun _ -> mk_mono()) pfm.pfm_params in
let map = apply_params pfm.pfm_params monos in
List.iter (fun (cf,cf') ->
- if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]);
+ if not (unify_kind ~strict:uctx.strict_field_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]);
Type.unify (apply_params c.cl_params tl (monomorphs cf'.cf_params cf'.cf_type)) (map (monomorphs cf.cf_params cf.cf_type))
) pairs;
monos
@@ -83,9 +94,10 @@ object(self)
let monos = List.map (fun _ -> mk_mono()) pfm.pfm_params in
let map = apply_params pfm.pfm_params monos in
List.iter (fun (cf,cf') ->
- if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]);
+ if strict && (Meta.has Meta.Optional cf.cf_meta) != (Meta.has Meta.Optional cf'.cf_meta) then raise (Unify_error [Unify_custom "optional mismatch"]);
+ if not (unify_kind ~strict:uctx.strict_field_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]);
fields := PMap.remove cf.cf_name !fields;
- Type.type_eq EqDoNotFollowNull cf'.cf_type (map (monomorphs cf.cf_params cf.cf_type))
+ type_eq_custom uctx cf'.cf_type (map (monomorphs cf.cf_params cf.cf_type))
) pairs;
if not (PMap.is_empty !fields) then raise (Unify_error [Unify_custom "not enough fields"]);
monos
@@ -105,17 +117,18 @@ object(self)
with Not_found ->
raise (Unify_error [])
- method find_compatible (arity : int) (tc : Type.t) =
+ method find_compatible ~(strict : bool) (arity : int) (tc : Type.t) =
if arity >= DynArray.length pfm_by_arity then
raise Not_found;
let d = DynArray.get pfm_by_arity arity in
let l = DynArray.length d in
+
let rec loop i =
if i >= l then
raise Not_found;
let pfm = DynArray.unsafe_get d i in
try
- self#unify tc pfm;
+ self#unify ~strict tc pfm;
pfm
with Unify_error _ ->
loop (i + 1)
@@ -135,7 +148,7 @@ object(self)
in
loop td.t_type
- method identity_anon (an : tanon) =
+ method identify_anon ?(strict:bool = false) (an : tanon) =
let make_pfm path = {
pfm_path = path;
pfm_params = [];
@@ -146,19 +159,20 @@ object(self)
match !(an.a_status) with
| ClassStatics {cl_path = path} | EnumStatics {e_path = path} | AbstractStatics {a_path = path} ->
begin try
- Some (Hashtbl.find pfms path)
+ Some (Hashtbl.find pfms path)
with Not_found ->
let pfm = make_pfm path in
self#add_pfm path pfm;
Some pfm
end
| _ ->
- let arity = PMap.fold (fun cf i ->
- replace_mono cf.cf_type;
- i + 1
- ) an.a_fields 0 in
- begin try
- Some (self#find_compatible arity (TAnon an))
+ let arity,fields = PMap.fold (fun cf (i,acc) ->
+ let t = replace_mono (not strict) cf.cf_type in
+ (i + 1),(PMap.add cf.cf_name {cf with cf_type = t} acc)
+ ) an.a_fields (0,PMap.empty) in
+ let an = { a_fields = fields; a_status = an.a_status; } in
+ try
+ Some (self#find_compatible ~strict arity (TAnon an))
with Not_found ->
let id = num in
num <- num + 1;
@@ -172,9 +186,8 @@ object(self)
} in
self#add_pfm path pfm;
Some pfm
- end
- method identify (accept_anons : bool) (t : Type.t) =
+ method identify ?(strict:bool = false) (accept_anons : bool) (t : Type.t) =
match t with
| TType(td,tl) ->
begin try
@@ -191,7 +204,7 @@ object(self)
| TLazy f ->
self#identify accept_anons (lazy_type f)
| TAnon an when accept_anons && not (PMap.is_empty an.a_fields) ->
- self#identity_anon an
+ self#identify_anon ~strict an
| _ ->
None
-end
\ No newline at end of file
+end
diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml
index 21cbe64efb9..7bc27105321 100644
--- a/src/typing/typeload.ml
+++ b/src/typing/typeload.ml
@@ -33,8 +33,6 @@ open Typecore
open Error
open Globals
-let build_count = ref 0
-
let type_function_params_ref = ref (fun _ _ _ _ _ -> die "" __LOC__)
let check_field_access ctx cff =
@@ -231,11 +229,6 @@ let load_type_def ctx p t =
let timer = Timer.timer ["typing";"load_type_def"] in
Std.finally timer (load_type_def ctx p) t *)
-let resolve_position_by_path ctx path p =
- let mt = load_type_def ctx p path in
- let p = (t_infos mt).mt_pos in
- raise_positions [p]
-
let generate_args_meta com cls_opt add_meta args =
let values = List.fold_left (fun acc ((name,p),_,_,_,eo) -> match eo with Some e -> ((name,p,NoQuotes),e) :: acc | _ -> acc) [] args in
(match values with
@@ -282,11 +275,11 @@ let check_param_constraints ctx t map ttp p =
unify_raise t ti p
with Error ({ err_message = Unify l } as err) ->
let fail() =
- if not ctx.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path ttp.ttp_class.cl_path) :: l)) }
+ if not ctx.f.untyped then display_error_ext ctx.com { err with err_message = (Unify (Constraint_failure (s_type_path ttp.ttp_class.cl_path) :: l)) }
in
match follow t with
| TInst({cl_kind = KExpr e},_) ->
- let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in
+ let e = type_expr {ctx with f = {ctx.f with locals = PMap.empty}} e (WithType.with_type ti) in
begin try unify_raise e.etype ti p
with Error { err_message = Unify _ } -> fail() end
| _ ->
@@ -451,7 +444,7 @@ and load_instance ctx ?(allow_display=false) ptp get_params =
let t = load_instance' ctx ptp get_params in
if allow_display then DisplayEmitter.check_display_type ctx t ptp;
t
- with Error { err_message = Module_not_found path } when ctx.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in ptp.pos_path ->
+ with Error { err_message = Module_not_found path } when ctx.e.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in ptp.pos_path ->
let s = s_type_path path in
DisplayToplevel.collect_and_raise ctx TKType NoValue CRTypeHint (s,ptp.pos_full) ptp.pos_path
@@ -461,7 +454,7 @@ and load_instance ctx ?(allow_display=false) ptp get_params =
and load_complex_type' ctx allow_display (t,p) =
match t with
| CTParent t -> load_complex_type ctx allow_display t
- | CTPath { path = {tpackage = ["$"]; tname = "_hx_mono" }} -> spawn_monomorph ctx p
+ | CTPath { path = {tpackage = ["$"]; tname = "_hx_mono" }} -> spawn_monomorph ctx.e p
| CTPath ptp -> load_instance ~allow_display ctx ptp ParamNormal
| CTOptional _ -> raise_typing_error "Optional type not allowed here" p
| CTNamed _ -> raise_typing_error "Named type not allowed here" p
@@ -612,7 +605,7 @@ and load_complex_type' ctx allow_display (t,p) =
} in
if !final then add_class_field_flag cf CfFinal;
init_meta_overloads ctx None cf;
- if ctx.is_display_file then begin
+ if ctx.m.is_display_file then begin
DisplayEmitter.check_display_metadata ctx cf.cf_meta;
if DisplayPosition.display_position#enclosed_in cf.cf_name_pos then displayed_field := Some cf;
end;
@@ -710,7 +703,7 @@ let t_iterator ctx p =
match load_qualified_type_def ctx [] "StdTypes" "Iterator" p with
| TTypeDecl t ->
add_dependency ctx.m.curmod t.t_module;
- let pt = spawn_monomorph ctx p in
+ let pt = spawn_monomorph ctx.e p in
apply_typedef t [pt], pt
| _ ->
die "" __LOC__
@@ -720,7 +713,7 @@ let t_iterator ctx p =
*)
let load_type_hint ?(opt=false) ctx pcur t =
let t = match t with
- | None -> spawn_monomorph ctx pcur
+ | None -> spawn_monomorph ctx.e pcur
| Some (t,p) -> load_complex_type ctx true (t,p)
in
if opt then ctx.t.tnull t else t
@@ -728,42 +721,52 @@ let load_type_hint ?(opt=false) ctx pcur t =
(* ---------------------------------------------------------------------- *)
(* PASS 1 & 2 : Module and Class Structure *)
-let rec type_type_param ctx host path get_params p tp =
+let rec type_type_param ctx host path p tp =
let n = fst tp.tp_name in
let c = mk_class ctx.m.curmod (fst path @ [snd path],n) (pos tp.tp_name) (pos tp.tp_name) in
- c.cl_params <- type_type_params ctx host c.cl_path get_params p tp.tp_params;
+ c.cl_params <- type_type_params ctx host c.cl_path p tp.tp_params;
c.cl_meta <- tp.Ast.tp_meta;
if host = TPHEnumConstructor then c.cl_meta <- (Meta.EnumConstructorParam,[],null_pos) :: c.cl_meta;
- let t = TInst (c,extract_param_types c.cl_params) in
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos tp.tp_name) then
- DisplayEmitter.display_type ctx t (pos tp.tp_name);
- let default = match tp.tp_default with
- | None ->
- None
- | Some ct ->
- let r = make_lazy ctx t (fun r ->
- let t = load_complex_type ctx true ct in
- begin match host with
- | TPHType ->
- ()
- | TPHConstructor
- | TPHMethod
- | TPHEnumConstructor
- | TPHAnonField
- | TPHLocal ->
- display_error ctx.com "Default type parameters are only supported on types" (pos ct)
- end;
- t
- ) "default" in
- Some (TLazy r)
- in
- let ttp = match tp.tp_constraints with
+ let ttp = mk_type_param c host None None in
+ if ctx.m.is_display_file && DisplayPosition.display_position#enclosed_in (pos tp.tp_name) then
+ DisplayEmitter.display_type ctx ttp.ttp_type (pos tp.tp_name);
+ ttp
+
+and type_type_params ctx host path p tpl =
+ let names = ref [] in
+ let param_pairs = List.map (fun tp ->
+ if List.exists (fun name -> name = fst tp.tp_name) !names then display_error ctx.com ("Duplicate type parameter name: " ^ fst tp.tp_name) (pos tp.tp_name);
+ names := (fst tp.tp_name) :: !names;
+ tp,type_type_param ctx host path p tp
+ ) tpl in
+ let params = List.map snd param_pairs in
+ let ctx = { ctx with type_params = params @ ctx.type_params } in
+ List.iter (fun (tp,ttp) ->
+ begin match tp.tp_default with
+ | None ->
+ ()
+ | Some ct ->
+ let r = make_lazy ctx ttp.ttp_type (fun r ->
+ let t = load_complex_type ctx true ct in
+ begin match host with
+ | TPHType ->
+ ()
+ | TPHConstructor
+ | TPHMethod
+ | TPHEnumConstructor
+ | TPHAnonField
+ | TPHLocal ->
+ display_error ctx.com "Default type parameters are only supported on types" (pos ct)
+ end;
+ t
+ ) "default" in
+ ttp.ttp_default <- Some (TLazy r)
+ end;
+ match tp.tp_constraints with
| None ->
- mk_type_param c host default None
+ ()
| Some th ->
- let current_type_params = ctx.type_params in
let constraints = lazy (
- let ctx = { ctx with type_params = get_params() @ current_type_params } in
let rec loop th = match fst th with
| CTIntersection tl -> List.map (load_complex_type ctx true) tl
| CTParent ct -> loop ct
@@ -773,7 +776,7 @@ let rec type_type_param ctx host path get_params p tp =
(* check against direct recursion *)
let rec loop t =
match follow t with
- | TInst (c2,_) when c == c2 ->
+ | TInst (c2,_) when ttp.ttp_class == c2 ->
raise_typing_error "Recursive constraint parameter is not allowed" p
| TInst ({ cl_kind = KTypeParameter ttp },_) ->
List.iter loop (get_constraints ttp)
@@ -784,18 +787,9 @@ let rec type_type_param ctx host path get_params p tp =
constr
) in
delay ctx PConnectField (fun () -> ignore (Lazy.force constraints));
- mk_type_param c host default (Some constraints)
- in
- c.cl_kind <- KTypeParameter ttp;
- ttp
-
-and type_type_params ctx host path get_params p tpl =
- let names = ref [] in
- List.map (fun tp ->
- if List.exists (fun name -> name = fst tp.tp_name) !names then display_error ctx.com ("Duplicate type parameter name: " ^ fst tp.tp_name) (pos tp.tp_name);
- names := (fst tp.tp_name) :: !names;
- type_type_param ctx host path get_params p tp
- ) tpl
+ ttp.ttp_constraints <- Some constraints;
+ ) param_pairs;
+ params
let load_core_class ctx c =
let ctx2 = (match ctx.g.core_api with
@@ -806,7 +800,13 @@ let load_core_class ctx c =
Common.define com2 Define.Sys;
Define.raw_define_value com2.defines "target.threaded" "true"; (* hack because we check this in sys.thread classes *)
if ctx.com.is_macro_context then Common.define com2 Define.Macro;
- com2.class_path <- ctx.com.std_path;
+ com2.class_paths#lock_context (platform_name_macro ctx.com) true;
+ com2.class_paths#modify (fun cp -> match cp#scope with
+ | Std ->
+ [cp#clone]
+ | _ ->
+ []
+ ) ctx.com.class_paths#as_list;
if com2.display.dms_check_core_api then com2.display <- {com2.display with dms_check_core_api = false};
CommonCache.lock_signature com2 "load_core_class";
let ctx2 = !create_context_ref com2 ctx.g.macros in
diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml
index faaabe9ff12..6532c9e99f3 100644
--- a/src/typing/typeloadCheck.ml
+++ b/src/typing/typeloadCheck.ml
@@ -39,11 +39,11 @@ let is_generic_parameter ctx c =
(* first check field parameters, then class parameters *)
let name = snd c.cl_path in
try
- ignore(lookup_param name ctx.curfield.cf_params);
- has_class_field_flag ctx.curfield CfGeneric
+ ignore(lookup_param name ctx.f.curfield.cf_params);
+ has_class_field_flag ctx.f.curfield CfGeneric
with Not_found -> try
ignore(lookup_param name ctx.type_params);
- (match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false);
+ (match ctx.c.curclass.cl_kind with | KGeneric -> true | _ -> false);
with Not_found ->
false
@@ -287,7 +287,7 @@ let class_field_no_interf c i =
let rec return_flow ctx e =
let error() =
- display_error ctx.com (Printf.sprintf "Missing return: %s" (s_type (print_context()) ctx.ret)) e.epos; raise Exit
+ display_error ctx.com (Printf.sprintf "Missing return: %s" (s_type (print_context()) ctx.e.ret)) e.epos; raise Exit
in
let return_flow = return_flow ctx in
match e.eexpr with
@@ -332,7 +332,7 @@ let check_global_metadata ctx meta f_add mpath tpath so =
let add = ((field_mode && to_fields) || (not field_mode && to_types)) && (match_path recursive sl1 sl2) in
if add then f_add m
) ctx.com.global_metadata;
- if ctx.is_display_file then delay ctx PCheckConstraint (fun () -> DisplayEmitter.check_display_metadata ctx meta)
+ if ctx.m.is_display_file then delay ctx PCheckConstraint (fun () -> DisplayEmitter.check_display_metadata ctx meta)
module Inheritance = struct
let is_basic_class_path path = match path with
@@ -394,7 +394,7 @@ module Inheritance = struct
in
if (has_class_field_flag f CfPublic) && not (has_class_field_flag f2 CfPublic) && not (Meta.has Meta.CompilerGenerated f.cf_meta) then
display_error ctx.com ("Field " ^ f.cf_name ^ " should be public as requested by " ^ s_type_path intf.cl_path) p
- else if not (unify_kind f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then
+ else if not (unify_kind ~strict:false f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then
display_error ctx.com ("Field " ^ f.cf_name ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p
else try
let map1 = TClass.get_map_function intf params in
@@ -510,7 +510,6 @@ module Inheritance = struct
let set_heritance ctx c herits p =
let is_lib = Meta.has Meta.LibType c.cl_meta in
- let ctx = { ctx with curclass = c; type_params = c.cl_params; } in
let old_meta = c.cl_meta in
let process_meta csup =
List.iter (fun m ->
@@ -638,7 +637,7 @@ let check_final_vars ctx e =
| _ ->
()
in
- loop ctx.curclass;
+ loop ctx.c.curclass;
if Hashtbl.length final_vars > 0 then begin
let rec find_inits e = match e.eexpr with
| TBinop(OpAssign,{eexpr = TField({eexpr = TConst TThis},fa)},e2) ->
@@ -649,7 +648,7 @@ let check_final_vars ctx e =
in
find_inits e;
if Hashtbl.length final_vars > 0 then
- display_error ctx.com "Some final fields are uninitialized in this class" ctx.curclass.cl_name_pos;
+ display_error ctx.com "Some final fields are uninitialized in this class" ctx.c.curclass.cl_name_pos;
DynArray.iter (fun (c,cf) ->
if Hashtbl.mem final_vars cf.cf_name then
display_error ~depth:1 ctx.com "Uninitialized field" cf.cf_name_pos
diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml
index 9693d4919ee..a8b1c1e430e 100644
--- a/src/typing/typeloadFields.ml
+++ b/src/typing/typeloadFields.ml
@@ -31,7 +31,7 @@ open Common
open Error
type class_init_ctx = {
- tclass : tclass; (* I don't trust ctx.curclass because it's mutable. *)
+ tclass : tclass; (* I don't trust ctx.c.curclass because it's mutable. *)
is_lib : bool;
is_native : bool;
is_core_api : bool;
@@ -44,11 +44,6 @@ type class_init_ctx = {
mutable uninitialized_final : tclass_field list;
}
-type field_kind =
- | FKNormal
- | FKConstructor
- | FKInit
-
type field_init_ctx = {
is_inline : bool;
is_final : bool;
@@ -63,7 +58,7 @@ type field_init_ctx = {
is_display_field : bool;
is_field_debug : bool;
is_generic : bool;
- field_kind : field_kind;
+ field_kind : class_field_ref_kind;
display_modifier : placed_access option;
mutable do_bind : bool;
(* If true, cf_expr = None makes a difference in the logic. We insert a dummy expression in
@@ -117,11 +112,6 @@ let dump_class_context cctx =
"force_constructor",string_of_bool cctx.force_constructor;
]
-let s_field_kind = function
- | FKNormal -> "FKNormal"
- | FKConstructor -> "FKConstructor"
- | FKInit -> "FKInit"
-
let dump_field_context fctx =
Printer.s_record_fields "" [
"is_inline",string_of_bool fctx.is_inline;
@@ -131,7 +121,7 @@ let dump_field_context fctx =
"is_abstract_member",string_of_bool fctx.is_abstract_member;
"is_display_field",string_of_bool fctx.is_display_field;
"is_field_debug",string_of_bool fctx.is_field_debug;
- "field_kind",s_field_kind fctx.field_kind;
+ "field_kind",s_class_field_ref_kind fctx.field_kind;
"do_bind",string_of_bool fctx.do_bind;
"expr_presence_matters",string_of_bool fctx.expr_presence_matters;
]
@@ -292,75 +282,6 @@ let transform_abstract_field com this_t a_t a f =
| _ ->
f
-let patch_class ctx c fields =
- let path = match c.cl_kind with
- | KAbstractImpl a -> a.a_path
- | _ -> c.cl_path
- in
- let h = (try Some (Hashtbl.find ctx.g.type_patches path) with Not_found -> None) in
- match h with
- | None -> fields
- | Some (h,hcl) ->
- c.cl_meta <- c.cl_meta @ hcl.tp_meta;
- let patch_getter t fn =
- { fn with f_type = t }
- in
- let patch_setter t fn =
- match fn.f_args with
- | [(name,opt,meta,_,expr)] ->
- { fn with f_args = [(name,opt,meta,t,expr)]; f_type = t }
- | _ -> fn
- in
- let rec loop acc accessor_acc = function
- | [] -> acc, accessor_acc
- | f :: l ->
- (* patch arguments types *)
- (match f.cff_kind with
- | FFun ff ->
- let param (((n,pn),opt,m,_,e) as p) =
- try
- let t2 = (try Hashtbl.find h (("$" ^ (fst f.cff_name) ^ "__" ^ n),false) with Not_found -> Hashtbl.find h (("$" ^ n),false)) in
- (n,pn), opt, m, (match t2.tp_type with None -> None | Some t -> Some (t,null_pos)), e
- with Not_found ->
- p
- in
- f.cff_kind <- FFun { ff with f_args = List.map param ff.f_args }
- | _ -> ());
- (* other patches *)
- match (try Some (Hashtbl.find h (fst f.cff_name,List.mem_assoc AStatic f.cff_access)) with Not_found -> None) with
- | None -> loop (f :: acc) accessor_acc l
- | Some { tp_remove = true } -> loop acc accessor_acc l
- | Some p ->
- f.cff_meta <- f.cff_meta @ p.tp_meta;
- let accessor_acc =
- match p.tp_type with
- | None -> accessor_acc
- | Some t ->
- match f.cff_kind with
- | FVar (_,e) ->
- f.cff_kind <- FVar (Some (t,null_pos),e); accessor_acc
- | FProp (get,set,_,eo) ->
- let typehint = Some (t,null_pos) in
- let accessor_acc = if fst get = "get" then ("get_" ^ fst f.cff_name, patch_getter typehint) :: accessor_acc else accessor_acc in
- let accessor_acc = if fst set = "set" then ("set_" ^ fst f.cff_name, patch_setter typehint) :: accessor_acc else accessor_acc in
- f.cff_kind <- FProp (get,set,typehint,eo); accessor_acc
- | FFun fn ->
- f.cff_kind <- FFun { fn with f_type = Some (t,null_pos) }; accessor_acc
- in
- loop (f :: acc) accessor_acc l
- in
- let fields, accessor_patches = loop [] [] fields in
- List.iter (fun (accessor_name, patch) ->
- try
- let f_accessor = List.find (fun f -> fst f.cff_name = accessor_name) fields in
- match f_accessor.cff_kind with
- | FFun fn -> f_accessor.cff_kind <- FFun (patch fn)
- | _ -> ()
- with Not_found ->
- ()
- ) accessor_patches;
- List.rev fields
-
let lazy_display_type ctx f =
f ()
@@ -476,10 +397,10 @@ let build_module_def ctx mt meta fvars fbuild =
raise_typing_error "Invalid macro path" p
in
if ctx.com.is_macro_context then raise_typing_error "You cannot use @:build inside a macro : make sure that your type is not used in macro" p;
- let old = ctx.get_build_infos in
- ctx.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars()));
- let r = try ctx.g.do_macro ctx MBuild cpath meth el p with e -> ctx.get_build_infos <- old; raise e in
- ctx.get_build_infos <- old;
+ let old = ctx.c.get_build_infos in
+ ctx.c.get_build_infos <- (fun() -> Some (mt, extract_param_types (t_infos mt).mt_params, fvars()));
+ let r = try ctx.g.do_macro ctx MBuild cpath meth el p with e -> ctx.c.get_build_infos <- old; raise e in
+ ctx.c.get_build_infos <- old;
(match r with
| MError | MMacroInMacro -> raise_typing_error "Build failure" p
| MSuccess e -> fbuild e)
@@ -560,24 +481,11 @@ let create_class_context c p =
cctx
let create_typer_context_for_class ctx cctx p =
- locate_macro_error := true;
incr stats.s_classes_built;
let c = cctx.tclass in
if cctx.is_lib && not (has_class_flag c CExtern) then ctx.com.error "@:libType can only be used in extern classes" c.cl_pos;
if Meta.has Meta.Macro c.cl_meta then display_error ctx.com "Macro classes are no longer allowed in haxe 3" c.cl_pos;
- let ctx = {
- ctx with
- curclass = c;
- type_params = c.cl_params;
- pass = PBuildClass;
- tthis = (match cctx.abstract with
- | Some a ->
- (match a.a_this with
- | TMono r when r.tm_type = None -> TAbstract (a,extract_param_types c.cl_params)
- | t -> t)
- | None -> TInst (c,extract_param_types c.cl_params));
- } in
- ctx
+ TyperManager.clone_for_class ctx c
let create_field_context ctx cctx cff is_display_file display_modifier =
let is_static = List.mem_assoc AStatic cff.cff_access in
@@ -603,9 +511,9 @@ let create_field_context ctx cctx cff is_display_file display_modifier =
let overload = try Some (List.assoc AOverload cff.cff_access) with Not_found -> None in
let is_macro = List.mem_assoc AMacro cff.cff_access in
let field_kind = match fst cff.cff_name with
- | "new" -> FKConstructor
- | "__init__" when is_static -> FKInit
- | _ -> FKNormal
+ | "new" -> CfrConstructor
+ | "__init__" when is_static -> CfrInit
+ | _ -> if is_static then CfrStatic else CfrMember
in
let default = try
let (_,_,p) = Meta.get Meta.JavaDefault cff.cff_meta in
@@ -630,7 +538,7 @@ let create_field_context ctx cctx cff is_display_file display_modifier =
is_abstract_member = is_abstract_member;
is_generic = Meta.has Meta.Generic cff.cff_meta;
field_kind = field_kind;
- do_bind = (((not ((has_class_flag c CExtern) || !is_extern) || is_inline) && not is_abstract && not (has_class_flag c CInterface)) || field_kind = FKInit);
+ do_bind = (((not ((has_class_flag c CExtern) || !is_extern) || is_inline) && not is_abstract && not (has_class_flag c CInterface)) || field_kind = CfrInit);
expr_presence_matters = false;
had_error = false;
} in
@@ -638,16 +546,10 @@ let create_field_context ctx cctx cff is_display_file display_modifier =
fctx
let create_typer_context_for_field ctx cctx fctx cff =
- DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
- let ctx = {
- ctx with
- pass = PBuildClass; (* will be set later to PTypeExpr *)
- locals = PMap.empty;
- opened = [];
- monomorphs = {
- perfunction = [];
- };
- } in
+ DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.c.curclass.cl_meta cff.cff_meta (fst cff.cff_name) cff.cff_meta (snd cff.cff_name);
+ let params = if fctx.is_static && not fctx.is_abstract_member && not (Meta.has Meta.LibType cctx.tclass.cl_meta) (* TODO: remove this *) then [] else ctx.type_params in
+ let ctx = TyperManager.clone_for_field ctx null_field params in
+
let c = cctx.tclass in
if (fctx.is_abstract && not (has_meta Meta.LibType c.cl_meta)) then begin
if fctx.is_static then
@@ -705,7 +607,7 @@ let transform_field (ctx,cctx) c f fields p =
f
let type_var_field ctx t e stat do_display p =
- if stat then ctx.curfun <- FunStatic else ctx.curfun <- FunMember;
+ if stat then ctx.e.curfun <- FunStatic else ctx.e.curfun <- FunMember;
let e = if do_display then Display.preprocess_expr ctx.com e else e in
let e = type_expr ctx e (WithType.with_type t) in
let e = AbstractCast.cast_or_unify ctx t e p in
@@ -747,7 +649,7 @@ let check_field_display ctx fctx c cf =
| _ ->
(if fctx.is_static then
CFSStatic
- else if fctx.field_kind = FKConstructor then
+ else if fctx.field_kind = CfrConstructor then
CFSConstructor
else
CFSMember), cf;
@@ -858,8 +760,8 @@ module TypeBinding = struct
in
let r = make_lazy ~force:false ctx t (fun r ->
(* type constant init fields (issue #1956) *)
- if not !return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin
- enter_field_typing_pass ctx ("bind_var_expression",fst ctx.curclass.cl_path @ [snd ctx.curclass.cl_path;ctx.curfield.cf_name]);
+ if not ctx.g.return_partial_type || (match fst e with EConst _ -> true | _ -> false) then begin
+ enter_field_typing_pass ctx ("bind_var_expression",fst ctx.c.curclass.cl_path @ [snd ctx.c.curclass.cl_path;ctx.f.curfield.cf_name]);
if (Meta.has (Meta.Custom ":debug.typing") (c.cl_meta @ cf.cf_meta)) then ctx.com.print (Printf.sprintf "Typing field %s.%s\n" (s_type_path c.cl_path) cf.cf_name);
let e = type_var_field ctx t e fctx.is_static fctx.is_display_field p in
let maybe_run_analyzer e = match e.eexpr with
@@ -889,7 +791,7 @@ module TypeBinding = struct
| TConst TThis ->
display_error ctx.com "Cannot access this or other member field in variable initialization" e.epos;
raise Exit
- | TLocal v when (match ctx.vthis with Some v2 -> v == v2 | None -> false) ->
+ | TLocal v when (match ctx.f.vthis with Some v2 -> v == v2 | None -> false) ->
display_error ctx.com "Cannot access this or other member field in variable initialization" e.epos;
raise Exit
| _ ->
@@ -941,7 +843,7 @@ module TypeBinding = struct
| Some _ ->
if fctx.is_abstract_member then FunMemberAbstract else FunStatic
| None ->
- if fctx.field_kind = FKConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember
+ if fctx.field_kind = CfrConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember
) in
begin match ctx.com.platform with
| Java when is_java_native_function ctx cf.cf_meta cf.cf_pos ->
@@ -952,7 +854,7 @@ module TypeBinding = struct
| _ ->
if Meta.has Meta.DisplayOverride cf.cf_meta then DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier;
let f_check = match fctx.field_kind with
- | FKNormal when not fctx.is_static ->
+ | CfrMember ->
begin match TypeloadCheck.check_overriding ctx c cf with
| NothingToDo ->
(fun () -> ())
@@ -977,17 +879,17 @@ module TypeBinding = struct
tf_type = ret;
tf_expr = e;
} in
- if fctx.field_kind = FKInit then
+ if fctx.field_kind = CfrInit then
(match e.eexpr with
| TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> ()
- | _ -> c.cl_init <- Some e);
+ | _ -> TClass.set_cl_init c e);
cf.cf_expr <- Some (mk (TFunction tf) t p);
cf.cf_type <- t;
check_field_display ctx fctx c cf;
end;
in
let maybe_bind r =
- if not !return_partial_type then bind r;
+ if not ctx.g.return_partial_type then bind r;
t
in
let r = make_lazy ~force:false ctx t maybe_bind "type_fun" in
@@ -1040,7 +942,7 @@ let create_variable (ctx,cctx,fctx) c f t eo p =
add_class_field_flag cf CfImpl;
end;
if is_abstract_enum_field then add_class_field_flag cf CfEnum;
- ctx.curfield <- cf;
+ ctx.f.curfield <- cf;
TypeBinding.bind_var ctx cctx fctx cf eo;
cf
@@ -1269,7 +1171,7 @@ let setup_args_ret ctx cctx fctx name fd p =
else
def()
in
- let ret = if fctx.field_kind = FKConstructor then
+ let ret = if fctx.field_kind = CfrConstructor then
ctx.t.tvoid
else begin
let def () =
@@ -1283,7 +1185,7 @@ let setup_args_ret ctx cctx fctx name fd p =
| _ ->
None
in
- let is_extern = fctx.is_extern || has_class_flag ctx.curclass CExtern in
+ let is_extern = fctx.is_extern || has_class_flag ctx.c.curclass CExtern in
let type_arg i opt cto p =
let def () =
type_opt (ctx,cctx,fctx) p cto
@@ -1340,17 +1242,17 @@ let create_method (ctx,cctx,fctx) c f fd p =
}
end in
begin match (has_class_flag c CInterface),fctx.field_kind with
- | true,FKConstructor ->
+ | true,CfrConstructor ->
raise_typing_error "An interface cannot have a constructor" p;
| true,_ ->
if not fctx.is_static && fd.f_expr <> None then unexpected_expression ctx.com fctx ("An interface method cannot have a body") p;
if fctx.is_inline && (has_class_flag c CInterface) then invalid_modifier ctx.com fctx "inline" "method of interface" p;
- | false,FKConstructor ->
+ | false,CfrConstructor ->
if fctx.is_static then invalid_modifier ctx.com fctx "static" "constructor" p;
begin match fd.f_type with
| None -> ()
| Some (CTPath ({ path = {tpackage = []; tname = "Void" } as tp}),p) ->
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in p then
+ if ctx.m.is_display_file && DisplayPosition.display_position#enclosed_in p then
ignore(load_instance ~allow_display:true ctx (make_ptp tp p) ParamNormal);
| _ -> raise_typing_error "A class constructor can't have a return type" p;
end
@@ -1367,7 +1269,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
let is_override = Option.is_some fctx.override in
if (is_override && fctx.is_static) then invalid_modifier_combination fctx ctx.com fctx "override" "static" p;
- ctx.type_params <- if fctx.is_static && not fctx.is_abstract_member then params else params @ ctx.type_params;
+ ctx.type_params <- params @ ctx.type_params;
let args,ret = setup_args_ret ctx cctx fctx (fst f.cff_name) fd p in
let t = TFun (args#for_type,ret) in
let cf = {
@@ -1380,7 +1282,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
if fctx.is_final then add_class_field_flag cf CfFinal;
if fctx.is_extern then add_class_field_flag cf CfExtern;
if fctx.is_abstract then begin
- if fctx.field_kind = FKConstructor then begin
+ if fctx.field_kind = CfrConstructor then begin
let p =
try List.assoc AAbstract f.cff_access
with Not_found -> p
@@ -1395,7 +1297,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
| Some p ->
begin match ctx.com.platform with
| Java ->
- if not (has_class_flag ctx.curclass CExtern) || not (has_class_flag c CInterface) then invalid_modifier_only ctx.com fctx "default" "on extern interfaces" p;
+ if not (has_class_flag ctx.c.curclass CExtern) || not (has_class_flag c CInterface) then invalid_modifier_only ctx.com fctx "default" "on extern interfaces" p;
add_class_field_flag cf CfDefault;
| _ ->
invalid_modifier_only ctx.com fctx "default" "on the Java target" p
@@ -1407,7 +1309,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
| Some p ->
if ctx.com.config.pf_overload then
add_class_field_flag cf CfOverload
- else if fctx.field_kind = FKConstructor then
+ else if fctx.field_kind = CfrConstructor then
invalid_modifier ctx.com fctx "overload" "constructor" p
else begin
add_class_field_flag cf CfOverload;
@@ -1437,7 +1339,7 @@ let create_method (ctx,cctx,fctx) c f fd p =
()
end;
init_meta_overloads ctx (Some c) cf;
- ctx.curfield <- cf;
+ ctx.f.curfield <- cf;
if fctx.do_bind then
TypeBinding.bind_method ctx cctx fctx cf t args ret fd.f_expr (match fd.f_expr with Some e -> snd e | None -> f.cff_pos)
else begin
@@ -1595,7 +1497,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p =
cf.cf_kind <- Var { v_read = get; v_write = set };
if fctx.is_extern then add_class_field_flag cf CfExtern;
if List.mem_assoc AEnum f.cff_access then add_class_field_flag cf CfEnum;
- ctx.curfield <- cf;
+ ctx.f.curfield <- cf;
TypeBinding.bind_var ctx cctx fctx cf eo;
cf
@@ -1643,10 +1545,6 @@ let init_field (ctx,cctx,fctx) f =
);
| None -> ()
end;
- begin match cctx.abstract with
- | Some a when fctx.is_abstract_member -> ctx.type_params <- a.a_params;
- | _ -> ()
- end;
let cf =
match f.cff_kind with
| FVar (t,e) ->
@@ -1707,7 +1605,7 @@ let check_overloads ctx c =
List.iter check_field c.cl_ordered_statics;
Option.may check_field c.cl_constructor
-let finalize_class ctx cctx =
+let finalize_class cctx =
(* push delays in reverse order so they will be run in correct order *)
List.iter (fun (ctx,r) ->
init_class_done ctx;
@@ -1741,19 +1639,17 @@ let check_functional_interface ctx c =
add_class_flag c CFunctionalInterface;
ctx.com.functional_interface_lut#add c.cl_path (c,cf)
-let init_class ctx c p herits fields =
- let cctx = create_class_context c p in
- let ctx = create_typer_context_for_class ctx cctx p in
+let init_class ctx_c cctx c p herits fields =
+ let com = ctx_c.com in
if cctx.is_class_debug then print_endline ("Created class context: " ^ dump_class_context cctx);
- let fields = patch_class ctx c fields in
- let fields = build_fields (ctx,cctx) c fields in
- if cctx.is_core_api && ctx.com.display.dms_check_core_api then delay ctx PForce (fun() -> init_core_api ctx c);
+ let fields = build_fields (ctx_c,cctx) c fields in
+ if cctx.is_core_api && com.display.dms_check_core_api then delay ctx_c PForce (fun() -> init_core_api ctx_c c);
if not cctx.is_lib then begin
- delay ctx PForce (fun() -> check_overloads ctx c);
+ delay ctx_c PForce (fun() -> check_overloads ctx_c c);
begin match c.cl_super with
| Some(csup,tl) ->
if (has_class_flag csup CAbstract) && not (has_class_flag c CAbstract) then
- delay ctx PForce (fun () -> TypeloadCheck.Inheritance.check_abstract_class ctx c csup tl);
+ delay ctx_c PForce (fun () -> TypeloadCheck.Inheritance.check_abstract_class ctx_c c csup tl);
| None ->
()
end
@@ -1774,7 +1670,7 @@ let init_class ctx c p herits fields =
| EBinop ((OpEq|OpNotEq|OpGt|OpGte|OpLt|OpLte) as op,(EConst (Ident s),_),(EConst ((Int (_,_) | Float (_,_) | String _) as c),_)) -> s ^ s_binop op ^ s_constant c
| _ -> ""
in
- if not (ParserEntry.is_true (ParserEntry.eval ctx.com.defines e)) then
+ if not (ParserEntry.is_true (ParserEntry.eval com.defines e)) then
Some (sc,(match List.rev l with (EConst (String(msg,_)),_) :: _ -> Some msg | _ -> None))
else
loop l
@@ -1783,43 +1679,32 @@ let init_class ctx c p herits fields =
| _ :: l ->
check_require l
in
- let cl_if_feature = Feature.check_if_feature c.cl_meta in
let cl_req = check_require c.cl_meta in
let has_init = ref false in
List.iter (fun f ->
let p = f.cff_pos in
+ let display_modifier = Typeload.check_field_access ctx_c f in
+ let fctx = create_field_context ctx_c cctx f ctx_c.m.is_display_file display_modifier in
+ let ctx = create_typer_context_for_field ctx_c cctx fctx f in
try
- let display_modifier = Typeload.check_field_access ctx f in
- let fctx = create_field_context ctx cctx f ctx.is_display_file display_modifier in
- let ctx = create_typer_context_for_field ctx cctx fctx f in
if fctx.is_field_debug then print_endline ("Created field context: " ^ dump_field_context fctx);
let cf = init_field (ctx,cctx,fctx) f in
- if fctx.field_kind = FKInit then begin
+ if fctx.field_kind = CfrInit then begin
if !has_init then
display_error ctx.com ("Duplicate class field declaration : " ^ (s_type_path c.cl_path) ^ "." ^ cf.cf_name) cf.cf_name_pos
else
has_init := true
end;
if fctx.is_field_debug then print_endline ("Created field: " ^ Printer.s_tclass_field "" cf);
- if fctx.is_static && (has_class_flag c CInterface) && fctx.field_kind <> FKInit && not cctx.is_lib && not ((has_class_flag c CExtern)) then
+ if fctx.is_static && (has_class_flag c CInterface) && fctx.field_kind <> CfrInit && not cctx.is_lib && not ((has_class_flag c CExtern)) then
raise_typing_error "You can only declare static fields in extern interfaces" p;
- let set_feature s =
- let ref_kind = match fctx.field_kind with
- | FKConstructor -> CfrConstructor
- | _ -> if fctx.is_static then CfrStatic else CfrMember
- in
- let cf_ref = mk_class_field_ref c cf ref_kind fctx.is_macro in
- Feature.set_feature ctx.m.curmod cf_ref s;
- in
- List.iter set_feature cl_if_feature;
- List.iter set_feature (Feature.check_if_feature cf.cf_meta);
let req = check_require f.cff_meta in
- let req = (match req with None -> if fctx.is_static || fctx.field_kind = FKConstructor then cl_req else None | _ -> req) in
+ let req = (match req with None -> if fctx.is_static || fctx.field_kind = CfrConstructor then cl_req else None | _ -> req) in
(match req with
| None -> ()
| Some r -> cf.cf_kind <- Var { v_read = AccRequire (fst r, snd r); v_write = AccRequire (fst r, snd r) });
begin match fctx.field_kind with
- | FKConstructor ->
+ | CfrConstructor ->
begin match c.cl_super with
| Some ({ cl_constructor = Some ctor_sup } as c, _) when not (has_class_flag c CExtern) && has_class_field_flag ctor_sup CfFinal ->
ctx.com.error "Cannot override final constructor" cf.cf_pos
@@ -1836,9 +1721,9 @@ let init_class ctx c p herits fields =
| Some ctor ->
display_error ctx.com "Duplicate constructor" p
end
- | FKInit ->
+ | CfrInit ->
()
- | FKNormal ->
+ | CfrStatic | CfrMember ->
let dup = if fctx.is_static then PMap.exists cf.cf_name c.cl_fields || has_field cf.cf_name c.cl_super else PMap.exists cf.cf_name c.cl_statics in
if not cctx.is_native && not (has_class_flag c CExtern) && dup then raise_typing_error ("Same field name can't be used for both static and instance : " ^ cf.cf_name) p;
if fctx.override <> None then
@@ -1867,7 +1752,7 @@ let init_class ctx c p herits fields =
with Error ({ err_message = Custom _; err_pos = p2 } as err) when p = p2 ->
display_error_ext ctx.com err
) fields;
- begin match cctx.abstract with
+ begin match cctx.abstract with
| Some a ->
a.a_to_field <- List.rev a.a_to_field;
a.a_from_field <- List.rev a.a_from_field;
@@ -1875,10 +1760,16 @@ let init_class ctx c p herits fields =
a.a_unops <- List.rev a.a_unops;
a.a_array <- List.rev a.a_array;
| None ->
- if (has_class_flag c CFunctionalInterface) && ctx.com.platform = Java then check_functional_interface ctx c;
+ if (has_class_flag c CFunctionalInterface) && com.platform = Java then check_functional_interface ctx_c c;
end;
c.cl_ordered_statics <- List.rev c.cl_ordered_statics;
c.cl_ordered_fields <- List.rev c.cl_ordered_fields;
+ delay ctx_c PConnectField (fun () -> match follow c.cl_type with
+ | TAnon an ->
+ an.a_fields <- c.cl_statics
+ | _ ->
+ die "" __LOC__
+ );
(*
make sure a default contructor with same access as super one will be added to the class structure at some point.
*)
@@ -1891,28 +1782,28 @@ let init_class ctx c p herits fields =
in
if has_struct_init then
if (has_class_flag c CInterface) then
- display_error ctx.com "@:structInit is not allowed on interfaces" struct_init_pos
+ display_error com "@:structInit is not allowed on interfaces" struct_init_pos
else
- ensure_struct_init_constructor ctx c fields p;
+ ensure_struct_init_constructor ctx_c c fields p;
begin match cctx.uninitialized_final with
| cf :: cfl when c.cl_constructor = None && not (has_class_flag c CAbstract) ->
- if Diagnostics.error_in_diagnostics_run ctx.com cf.cf_name_pos then begin
+ if Diagnostics.error_in_diagnostics_run com cf.cf_name_pos then begin
let diag = {
mf_pos = c.cl_name_pos;
mf_on = TClassDecl c;
mf_fields = [];
mf_cause = FinalFields (cf :: cfl);
} in
- let display = ctx.com.display_information in
+ let display = com.display_information in
display.module_diagnostics <- MissingFields diag :: display.module_diagnostics
end else begin
- display_error ctx.com "This class has uninitialized final vars, which requires a constructor" p;
- display_error ctx.com "Example of an uninitialized final var" cf.cf_name_pos;
+ display_error com "This class has uninitialized final vars, which requires a constructor" p;
+ display_error com "Example of an uninitialized final var" cf.cf_name_pos;
end
| _ ->
()
end;
if not has_struct_init then
(* add_constructor does not deal with overloads correctly *)
- if not ctx.com.config.pf_overload then TypeloadFunction.add_constructor ctx c cctx.force_constructor p;
- finalize_class ctx cctx
+ if not com.config.pf_overload then TypeloadFunction.add_constructor ctx_c c cctx.force_constructor p;
+ finalize_class cctx
diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml
index 48f106c30cf..d3dff29cd54 100644
--- a/src/typing/typeloadFunction.ml
+++ b/src/typing/typeloadFunction.ml
@@ -28,34 +28,25 @@ open Error
open FunctionArguments
let save_field_state ctx =
- let old_ret = ctx.ret in
- let old_fun = ctx.curfun in
- let old_opened = ctx.opened in
- let old_monos = ctx.monomorphs.perfunction in
- let old_in_function = ctx.in_function in
- let locals = ctx.locals in
+ let old_e = ctx.e in
+ ctx.e <- TyperManager.create_ctx_e ();
+ let locals = ctx.f.locals in
(fun () ->
- ctx.locals <- locals;
- ctx.ret <- old_ret;
- ctx.curfun <- old_fun;
- ctx.opened <- old_opened;
- ctx.monomorphs.perfunction <- old_monos;
- ctx.in_function <- old_in_function;
+ ctx.f.locals <- locals;
+ ctx.e <- old_e;
)
let type_function_params ctx fd host fname p =
- let params = ref [] in
- params := Typeload.type_type_params ctx host ([],fname) (fun() -> !params) p fd.f_params;
- !params
+ Typeload.type_type_params ctx host ([],fname) p fd.f_params
let type_function ctx (args : function_arguments) ret fmode e do_display p =
- ctx.in_function <- true;
- ctx.curfun <- fmode;
- ctx.ret <- ret;
- ctx.opened <- [];
- ctx.monomorphs.perfunction <- [];
- enter_field_typing_pass ctx ("type_function",fst ctx.curclass.cl_path @ [snd ctx.curclass.cl_path;ctx.curfield.cf_name]);
- args#bring_into_context;
+ ctx.e.in_function <- true;
+ ctx.e.curfun <- fmode;
+ ctx.e.ret <- ret;
+ ctx.e.opened <- [];
+ ctx.e.monomorphs.perfunction <- [];
+ enter_field_typing_pass ctx ("type_function",fst ctx.c.curclass.cl_path @ [snd ctx.c.curclass.cl_path;ctx.f.curfield.cf_name]);
+ args#bring_into_context ctx;
let e = match e with
| None ->
if ignore_error ctx.com then
@@ -65,18 +56,18 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p =
*)
EBlock [],p
else
- if fmode = FunMember && has_class_flag ctx.curclass CAbstract then
+ if fmode = FunMember && has_class_flag ctx.c.curclass CAbstract then
raise_typing_error "Function body or abstract modifier required" p
else
raise_typing_error "Function body required" p
| Some e -> e
in
- let is_position_debug = Meta.has (Meta.Custom ":debug.position") ctx.curfield.cf_meta in
+ let is_position_debug = Meta.has (Meta.Custom ":debug.position") ctx.f.curfield.cf_meta in
let e = if not do_display then begin
if is_position_debug then print_endline ("syntax:\n" ^ (Expr.dump_with_pos e));
type_expr ctx e NoValue
end else begin
- let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.curfield.cf_meta in
+ let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.f.curfield.cf_meta in
if is_display_debug then print_endline ("before processing:\n" ^ (Expr.dump_with_pos e));
let e = if !Parser.had_resume then e else Display.preprocess_expr ctx.com e in
if is_display_debug then print_endline ("after processing:\n" ^ (Expr.dump_with_pos e));
@@ -112,7 +103,7 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p =
| _ -> Type.iter loop e
in
let has_super_constr() =
- match ctx.curclass.cl_super with
+ match ctx.c.curclass.cl_super with
| None ->
None
| Some (csup,tl) ->
@@ -143,9 +134,9 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p =
| None ->
e
end in
- let e = match ctx.curfun, ctx.vthis with
+ let e = match ctx.e.curfun, ctx.f.vthis with
| (FunMember|FunConstructor), Some v ->
- let ev = mk (TVar (v,Some (mk (TConst TThis) ctx.tthis p))) ctx.t.tvoid p in
+ let ev = mk (TVar (v,Some (mk (TConst TThis) ctx.c.tthis p))) ctx.t.tvoid p in
(match e.eexpr with
| TBlock l ->
if ctx.com.config.pf_this_before_super then
@@ -170,8 +161,8 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p =
| _ -> mk (TBlock [ev;e]) e.etype p)
| _ -> e
in
- List.iter (fun r -> r := Closed) ctx.opened;
- List.iter (fun (m,p) -> safe_mono_close ctx m p) ctx.monomorphs.perfunction;
+ List.iter (fun r -> r := Closed) ctx.e.opened;
+ List.iter (fun (m,p) -> safe_mono_close ctx m p) ctx.e.monomorphs.perfunction;
if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e));
e
@@ -179,7 +170,7 @@ let type_function ctx args ret fmode e do_display p =
let save = save_field_state ctx in
Std.finally save (type_function ctx args ret fmode e do_display) p
-let add_constructor ctx c force_constructor p =
+let add_constructor ctx_c c force_constructor p =
if c.cl_constructor <> None then () else
let constructor = try Some (Type.get_constructor_class c (extract_param_types c.cl_params)) with Not_found -> None in
match constructor with
@@ -188,12 +179,9 @@ let add_constructor ctx c force_constructor p =
cf.cf_kind <- cfsup.cf_kind;
cf.cf_params <- cfsup.cf_params;
cf.cf_meta <- List.filter (fun (m,_,_) -> m = Meta.CompilerGenerated) cfsup.cf_meta;
- let t = spawn_monomorph ctx p in
- let r = make_lazy ctx t (fun r ->
- let ctx = { ctx with
- curfield = cf;
- pass = PConnectField;
- } in
+ let t = spawn_monomorph ctx_c.e p in
+ let r = make_lazy ctx_c t (fun r ->
+ let ctx = TyperManager.clone_for_field ctx_c cf cf.cf_params in
ignore (follow cfsup.cf_type); (* make sure it's typed *)
List.iter (fun cf -> ignore (follow cf.cf_type)) cf.cf_overloads;
let map_arg (v,def) =
@@ -244,9 +232,9 @@ let add_constructor ctx c force_constructor p =
| _ when force_constructor ->
let constr = mk (TFunction {
tf_args = [];
- tf_type = ctx.t.tvoid;
- tf_expr = mk (TBlock []) ctx.t.tvoid p;
- }) (tfun [] ctx.t.tvoid) p in
+ tf_type = ctx_c.t.tvoid;
+ tf_expr = mk (TBlock []) ctx_c.t.tvoid p;
+ }) (tfun [] ctx_c.t.tvoid) p in
let cf = mk_field "new" constr.etype p null_pos in
cf.cf_expr <- Some constr;
cf.cf_type <- constr.etype;
diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml
index 761f1030437..4800ebb2589 100644
--- a/src/typing/typeloadModule.ml
+++ b/src/typing/typeloadModule.ml
@@ -44,30 +44,30 @@ let field_of_static_definition d p =
}
module ModuleLevel = struct
- let make_module ctx mpath file loadp =
+ let make_module com g mpath file loadp =
let m = {
m_id = alloc_mid();
m_path = mpath;
m_types = [];
m_statics = None;
- m_extra = module_extra (Path.get_full_path file) (Define.get_signature ctx.com.defines) (file_time file) (if ctx.com.is_macro_context then MMacro else MCode) ctx.com.compilation_step (get_policy ctx.g mpath);
+ m_extra = module_extra (Path.get_full_path file) (Define.get_signature com.defines) (file_time file) (if com.is_macro_context then MMacro else MCode) com.compilation_step (get_policy g mpath);
} in
m
- let add_module ctx m p =
- ctx.com.module_lut#add m.m_path m
+ let add_module com m p =
+ com.module_lut#add m.m_path m
(*
Build module structure : should be atomic - no type loading is possible
*)
- let create_module_types ctx m tdecls loadp =
- let com = ctx.com in
+ let create_module_types ctx_m m tdecls loadp =
+ let com = ctx_m.com in
let decls = ref [] in
let statics = ref [] in
let check_name name meta also_statics p =
- DeprecationCheck.check_is com ctx.m.curmod meta [] name meta p;
+ DeprecationCheck.check_is com ctx_m.m.curmod meta [] name meta p;
let error prev_pos =
- display_error ctx.com ("Name " ^ name ^ " is already defined in this module") p;
+ display_error com ("Name " ^ name ^ " is already defined in this module") p;
raise_typing_error ~depth:1 (compl_msg "Previous declaration here") prev_pos;
in
List.iter (fun (t2,(_,p2)) ->
@@ -87,7 +87,7 @@ module ModuleLevel = struct
let p = snd decl in
let check_type_name type_name meta =
let module_name = snd m.m_path in
- if type_name <> module_name && not (Meta.has Meta.Native meta) then Typecore.check_uppercase_identifier_name ctx type_name "type" p;
+ if type_name <> module_name && not (Meta.has Meta.Native meta) then Typecore.check_uppercase_identifier_name ctx_m type_name "type" p;
in
let acc = (match fst decl with
| EImport _ | EUsing _ ->
@@ -119,8 +119,8 @@ module ModuleLevel = struct
) d.d_flags;
if not (has_class_flag c CExtern) then check_type_name name d.d_meta;
if has_class_flag c CAbstract then begin
- if has_class_flag c CInterface then display_error ctx.com "An interface may not be abstract" c.cl_name_pos;
- if has_class_flag c CFinal then display_error ctx.com "An abstract class may not be final" c.cl_name_pos;
+ if has_class_flag c CInterface then display_error com "An interface may not be abstract" c.cl_name_pos;
+ if has_class_flag c CFinal then display_error com "An abstract class may not be final" c.cl_name_pos;
end;
decls := (TClassDecl c, decl) :: !decls;
acc
@@ -152,7 +152,7 @@ module ModuleLevel = struct
t_meta = d.d_meta;
} in
(* failsafe in case the typedef is not initialized (see #3933) *)
- delay ctx PBuildModule (fun () ->
+ delay ctx_m PBuildModule (fun () ->
match t.t_type with
| TMono r -> (match r.tm_type with None -> Monomorph.bind r com.basic.tvoid | _ -> ())
| _ -> ()
@@ -195,7 +195,7 @@ module ModuleLevel = struct
| None -> ()
| Some p ->
let options = Warning.from_meta d.d_meta in
- module_warning ctx.com ctx.m.curmod WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p
+ module_warning com ctx_m.m.curmod WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p
end;
decls := (TAbstractDecl a, decl) :: !decls;
match d.d_data with
@@ -219,12 +219,6 @@ module ModuleLevel = struct
let acc = make_decl acc (EClass { d_name = (fst d.d_name) ^ "_Impl_",snd d.d_name; d_flags = [HPrivate]; d_data = fields; d_doc = None; d_params = []; d_meta = !meta },p) in
(match !decls with
| (TClassDecl c,_) :: _ ->
- List.iter (fun m -> match m with
- | ((Meta.Using | Meta.Build | Meta.CoreApi | Meta.Allow | Meta.Access | Meta.Enum | Meta.Dce | Meta.Native | Meta.HlNative | Meta.JsRequire | Meta.PythonImport | Meta.Expose | Meta.Deprecated | Meta.PhpGlobal | Meta.PublicFields),_,_) ->
- c.cl_meta <- m :: c.cl_meta;
- | _ ->
- ()
- ) a.a_meta;
a.a_impl <- Some c;
c.cl_kind <- KAbstractImpl a;
add_class_flag c CFinal;
@@ -267,8 +261,7 @@ module ModuleLevel = struct
let decls = List.rev !decls in
decls, List.rev tdecls
- let handle_import_hx ctx m decls p =
- let com = ctx.com in
+ let handle_import_hx com g m decls p =
let path_split = match List.rev (Path.get_path_parts (Path.UniqueKey.lazy_path m.m_extra.m_file)) with
| [] -> []
| _ :: l -> l
@@ -283,7 +276,7 @@ module ModuleLevel = struct
let make_import_module path r =
com.parser_cache#add path r;
(* We use the file path as module name to make it unique. This may or may not be a good idea... *)
- let m_import = make_module ctx ([],path) path p in
+ let m_import = make_module com g ([],path) path p in
m_import.m_extra.m_kind <- MImport;
m_import
in
@@ -295,13 +288,13 @@ module ModuleLevel = struct
r
with Not_found ->
if Sys.file_exists path then begin
- let _,r = match !TypeloadParse.parse_hook com path p with
+ let _,r = match !TypeloadParse.parse_hook com (ClassPaths.create_resolved_file path com.empty_class_path) p with
| ParseSuccess(data,_,_) -> data
| ParseError(_,(msg,p),_) -> Parser.error msg p
in
List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> raise_typing_error "Only import and using is allowed in import.hx files" p) r;
let m_import = make_import_module path r in
- add_module ctx m_import p;
+ add_module com m_import p;
add_dependency m m_import;
r
end else begin
@@ -314,13 +307,13 @@ module ModuleLevel = struct
decls @ acc
) decls candidates
- let init_type_params ctx decls =
+ let init_type_params ctx_m decls =
(* here is an additional PASS 1 phase, which define the type parameters for all module types.
Constraints are handled lazily (no other type is loaded) because they might be recursive anyway *)
List.iter (fun d ->
match d with
| (TClassDecl c, (EClass d, p)) ->
- c.cl_params <- type_type_params ctx TPHType c.cl_path (fun() -> c.cl_params) p d.d_params;
+ c.cl_params <- type_type_params ctx_m TPHType c.cl_path p d.d_params;
if Meta.has Meta.Generic c.cl_meta && c.cl_params <> [] then c.cl_kind <- KGeneric;
if Meta.has Meta.FunctionalInterface c.cl_meta then begin
if not (has_class_flag c CInterface) then
@@ -329,32 +322,30 @@ module ModuleLevel = struct
add_class_flag c CFunctionalInterface
end;
if Meta.has Meta.GenericBuild c.cl_meta then begin
- if ctx.com.is_macro_context then raise_typing_error "@:genericBuild cannot be used in macros" c.cl_pos;
+ if ctx_m.com.is_macro_context then raise_typing_error "@:genericBuild cannot be used in macros" c.cl_pos;
c.cl_kind <- KGenericBuild d.d_data;
end;
if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType;
| (TEnumDecl e, (EEnum d, p)) ->
- e.e_params <- type_type_params ctx TPHType e.e_path (fun() -> e.e_params) p d.d_params;
+ e.e_params <- type_type_params ctx_m TPHType e.e_path p d.d_params;
| (TTypeDecl t, (ETypedef d, p)) ->
- t.t_params <- type_type_params ctx TPHType t.t_path (fun() -> t.t_params) p d.d_params;
+ t.t_params <- type_type_params ctx_m TPHType t.t_path p d.d_params;
| (TAbstractDecl a, (EAbstract d, p)) ->
- a.a_params <- type_type_params ctx TPHType a.a_path (fun() -> a.a_params) p d.d_params;
+ a.a_params <- type_type_params ctx_m TPHType a.a_path p d.d_params;
| _ ->
die "" __LOC__
) decls
end
module TypeLevel = struct
- let load_enum_field ctx e et is_flat index c =
+ let load_enum_field ctx_en e et is_flat index c =
let p = c.ec_pos in
- let params = ref [] in
- params := type_type_params ctx TPHEnumConstructor ([],fst c.ec_name) (fun() -> !params) c.ec_pos c.ec_params;
- let params = !params in
- let ctx = { ctx with type_params = params @ ctx.type_params } in
+ let params = type_type_params ctx_en TPHEnumConstructor ([],fst c.ec_name) c.ec_pos c.ec_params in
+ let ctx_ef = TyperManager.clone_for_enum_field ctx_en (params @ ctx_en.type_params) in
let rt = (match c.ec_type with
| None -> et
| Some (t,pt) ->
- let t = load_complex_type ctx true (t,pt) in
+ let t = load_complex_type ctx_ef true (t,pt) in
(match follow t with
| TEnum (te,_) when te == e ->
()
@@ -371,7 +362,7 @@ module TypeLevel = struct
(match t with CTPath({path = {tpackage=[];tname="Void"}}) -> raise_typing_error "Arguments of type Void are not allowed in enum constructors" tp | _ -> ());
if PMap.mem s (!pnames) then raise_typing_error ("Duplicate argument `" ^ s ^ "` in enum constructor " ^ fst c.ec_name) p;
pnames := PMap.add s () (!pnames);
- s, opt, load_type_hint ~opt ctx p (Some (t,tp))
+ s, opt, load_type_hint ~opt ctx_ef p (Some (t,tp))
) l, rt)
) in
let f = {
@@ -384,45 +375,46 @@ module TypeLevel = struct
ef_params = params;
ef_meta = c.ec_meta;
} in
- DeprecationCheck.check_is ctx.com ctx.m.curmod e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos;
- let cf = class_field_of_enum_field f in
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in f.ef_name_pos then
- DisplayEmitter.display_enum_field ctx e f p;
- f,cf
-
- let init_class ctx c d p =
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
- DisplayEmitter.display_module_type ctx (match c.cl_kind with KAbstractImpl a -> TAbstractDecl a | _ -> TClassDecl c) (pos d.d_name);
- TypeloadCheck.check_global_metadata ctx c.cl_meta (fun m -> c.cl_meta <- m :: c.cl_meta) c.cl_module.m_path c.cl_path None;
+ DeprecationCheck.check_is ctx_ef.com ctx_ef.m.curmod e.e_meta f.ef_meta f.ef_name f.ef_meta f.ef_name_pos;
+ if ctx_ef.m.is_display_file && DisplayPosition.display_position#enclosed_in f.ef_name_pos then
+ DisplayEmitter.display_enum_field ctx_ef e f p;
+ f
+
+ let init_class ctx_m c d p =
+ if ctx_m.m.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
+ DisplayEmitter.display_module_type ctx_m (match c.cl_kind with KAbstractImpl a -> TAbstractDecl a | _ -> TClassDecl c) (pos d.d_name);
+ TypeloadCheck.check_global_metadata ctx_m c.cl_meta (fun m -> c.cl_meta <- m :: c.cl_meta) c.cl_module.m_path c.cl_path None;
let herits = d.d_flags in
List.iter (fun (m,_,p) ->
if m = Meta.Final then begin
add_class_flag c CFinal;
end
) d.d_meta;
- let prev_build_count = ref (!build_count - 1) in
+ let prev_build_count = ref (ctx_m.g.build_count - 1) in
let build() =
c.cl_build <- (fun()-> Building [c]);
- let fl = TypeloadCheck.Inheritance.set_heritance ctx c herits p in
+ let cctx = TypeloadFields.create_class_context c p in
+ let ctx_c = TypeloadFields.create_typer_context_for_class ctx_m cctx p in
+ let fl = TypeloadCheck.Inheritance.set_heritance ctx_c c herits p in
let rec build() =
c.cl_build <- (fun()-> Building [c]);
try
List.iter (fun f -> f()) fl;
- TypeloadFields.init_class ctx c p d.d_flags d.d_data;
+ TypeloadFields.init_class ctx_c cctx c p d.d_flags d.d_data;
c.cl_build <- (fun()-> Built);
- incr build_count;
+ ctx_c.g.build_count <- ctx_c.g.build_count + 1;
List.iter (fun tp -> ignore(follow tp.ttp_type)) c.cl_params;
Built;
with TypeloadCheck.Build_canceled state ->
- c.cl_build <- make_pass ctx build;
+ c.cl_build <- make_pass ctx_c build;
let rebuild() =
- delay_late ctx PBuildClass (fun() -> ignore(c.cl_build()));
+ delay_late ctx_c PBuildClass (fun() -> ignore(c.cl_build()));
in
(match state with
| Built -> die "" __LOC__
| Building cl ->
- if !build_count = !prev_build_count then raise_typing_error ("Loop in class building prevent compiler termination (" ^ String.concat "," (List.map (fun c -> s_type_path c.cl_path) cl) ^ ")") c.cl_pos;
- prev_build_count := !build_count;
+ if ctx_c.g.build_count = !prev_build_count then raise_typing_error ("Loop in class building prevent compiler termination (" ^ String.concat "," (List.map (fun c -> s_type_path c.cl_path) cl) ^ ")") c.cl_pos;
+ prev_build_count := ctx_c.g.build_count;
rebuild();
Building (c :: cl)
| BuildMacro f ->
@@ -434,18 +426,16 @@ module TypeLevel = struct
in
build()
in
- ctx.curclass <- c;
- c.cl_build <- make_pass ctx build;
- ctx.curclass <- null_class;
- delay ctx PBuildClass (fun() -> ignore(c.cl_build()));
+ c.cl_build <- make_pass ctx_m build;
+ delay ctx_m PBuildClass (fun() -> ignore(c.cl_build()));
if Meta.has Meta.InheritDoc c.cl_meta then
- delay ctx PConnectField (fun() -> InheritDoc.build_class_doc ctx c);
- if (ctx.com.platform = Java || ctx.com.platform = Cs) && not (has_class_flag c CExtern) then
- delay ctx PTypeField (fun () ->
- let metas = StrictMeta.check_strict_meta ctx c.cl_meta in
+ delay ctx_m PConnectField (fun() -> InheritDoc.build_class_doc ctx_m c);
+ if (ctx_m.com.platform = Java || ctx_m.com.platform = Cs) && not (has_class_flag c CExtern) then
+ delay ctx_m PTypeField (fun () ->
+ let metas = StrictMeta.check_strict_meta ctx_m c.cl_meta in
if metas <> [] then c.cl_meta <- metas @ c.cl_meta;
let rec run_field cf =
- let metas = StrictMeta.check_strict_meta ctx cf.cf_meta in
+ let metas = StrictMeta.check_strict_meta ctx_m cf.cf_meta in
if metas <> [] then cf.cf_meta <- metas @ cf.cf_meta;
List.iter run_field cf.cf_overloads
in
@@ -456,17 +446,11 @@ module TypeLevel = struct
| _ -> ()
)
- let init_enum ctx e d p =
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
- DisplayEmitter.display_module_type ctx (TEnumDecl e) (pos d.d_name);
- let ctx = { ctx with type_params = e.e_params } in
- let h = (try Some (Hashtbl.find ctx.g.type_patches e.e_path) with Not_found -> None) in
- TypeloadCheck.check_global_metadata ctx e.e_meta (fun m -> e.e_meta <- m :: e.e_meta) e.e_module.m_path e.e_path None;
- (match h with
- | None -> ()
- | Some (h,hcl) ->
- Hashtbl.iter (fun _ _ -> raise_typing_error "Field type patch not supported for enums" e.e_pos) h;
- e.e_meta <- e.e_meta @ hcl.tp_meta);
+ let init_enum ctx_m e d p =
+ if ctx_m.m.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
+ DisplayEmitter.display_module_type ctx_m (TEnumDecl e) (pos d.d_name);
+ let ctx_en = TyperManager.clone_for_enum ctx_m e in
+ TypeloadCheck.check_global_metadata ctx_en e.e_meta (fun m -> e.e_meta <- m :: e.e_meta) e.e_module.m_path e.e_path None;
let constructs = ref d.d_data in
let get_constructs() =
List.map (fun c ->
@@ -482,7 +466,7 @@ module TypeLevel = struct
}
) (!constructs)
in
- TypeloadFields.build_module_def ctx (TEnumDecl e) e.e_meta get_constructs (fun (e,p) ->
+ TypeloadFields.build_module_def ctx_en (TEnumDecl e) e.e_meta get_constructs (fun (e,p) ->
match e with
| EVars [{ ev_type = Some (CTAnonymous fields,p); ev_expr = None }] ->
constructs := List.map (fun f ->
@@ -510,39 +494,37 @@ module TypeLevel = struct
let names = ref [] in
let index = ref 0 in
let is_flat = ref true in
- let fields = ref PMap.empty in
List.iter (fun c ->
if PMap.mem (fst c.ec_name) e.e_constrs then raise_typing_error ("Duplicate constructor " ^ fst c.ec_name) (pos c.ec_name);
- let f,cf = load_enum_field ctx e et is_flat index c in
+ let f = load_enum_field ctx_en e et is_flat index c in
e.e_constrs <- PMap.add f.ef_name f e.e_constrs;
- fields := PMap.add cf.cf_name cf !fields;
incr index;
names := (fst c.ec_name) :: !names;
if Meta.has Meta.InheritDoc f.ef_meta then
- delay ctx PConnectField (fun() -> InheritDoc.build_enum_field_doc ctx f);
+ delay ctx_en PConnectField (fun() -> InheritDoc.build_enum_field_doc ctx_en f);
) (!constructs);
e.e_names <- List.rev !names;
e.e_extern <- e.e_extern;
- unify ctx (TType(enum_module_type e !fields,[])) e.e_type p;
+ unify ctx_en (TType(enum_module_type e,[])) e.e_type p;
if !is_flat then e.e_meta <- (Meta.FlatEnum,[],null_pos) :: e.e_meta;
if Meta.has Meta.InheritDoc e.e_meta then
- delay ctx PConnectField (fun() -> InheritDoc.build_enum_doc ctx e);
- if (ctx.com.platform = Java || ctx.com.platform = Cs) && not e.e_extern then
- delay ctx PTypeField (fun () ->
- let metas = StrictMeta.check_strict_meta ctx e.e_meta in
+ delay ctx_en PConnectField (fun() -> InheritDoc.build_enum_doc ctx_en e);
+ if (ctx_en.com.platform = Java || ctx_en.com.platform = Cs) && not e.e_extern then
+ delay ctx_en PTypeField (fun () ->
+ let metas = StrictMeta.check_strict_meta ctx_en e.e_meta in
e.e_meta <- metas @ e.e_meta;
PMap.iter (fun _ ef ->
- let metas = StrictMeta.check_strict_meta ctx ef.ef_meta in
+ let metas = StrictMeta.check_strict_meta ctx_en ef.ef_meta in
if metas <> [] then ef.ef_meta <- metas @ ef.ef_meta
) e.e_constrs
)
- let init_typedef ctx t d p =
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
- DisplayEmitter.display_module_type ctx (TTypeDecl t) (pos d.d_name);
- TypeloadCheck.check_global_metadata ctx t.t_meta (fun m -> t.t_meta <- m :: t.t_meta) t.t_module.m_path t.t_path None;
- let ctx = { ctx with type_params = t.t_params } in
- let tt = load_complex_type ctx true d.d_data in
+ let init_typedef ctx_m t d p =
+ if ctx_m.m.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
+ DisplayEmitter.display_module_type ctx_m (TTypeDecl t) (pos d.d_name);
+ TypeloadCheck.check_global_metadata ctx_m t.t_meta (fun m -> t.t_meta <- m :: t.t_meta) t.t_module.m_path t.t_path None;
+ let ctx_td = TyperManager.clone_for_typedef ctx_m t in
+ let tt = load_complex_type ctx_td true d.d_data in
let tt = (match fst d.d_data with
| CTExtend _ -> tt
| CTPath { path = {tpackage = ["haxe";"macro"]; tname = "MacroType" }} ->
@@ -568,7 +550,7 @@ module TypeLevel = struct
| _ ->
()
in
- let r = make_lazy ctx tt (fun r ->
+ let r = make_lazy ctx_td tt (fun r ->
check_rec tt;
tt
) "typedef_rec_check" in
@@ -581,25 +563,33 @@ module TypeLevel = struct
| None -> Monomorph.bind r tt;
| Some t' -> die (Printf.sprintf "typedef %s is already initialized to %s, but new init to %s was attempted" (s_type_path t.t_path) (s_type_kind t') (s_type_kind tt)) __LOC__);
| _ -> die "" __LOC__);
- TypeloadFields.build_module_def ctx (TTypeDecl t) t.t_meta (fun _ -> []) (fun _ -> ());
- if ctx.com.platform = Cs && t.t_meta <> [] then
- delay ctx PTypeField (fun () ->
- let metas = StrictMeta.check_strict_meta ctx t.t_meta in
+ TypeloadFields.build_module_def ctx_td (TTypeDecl t) t.t_meta (fun _ -> []) (fun _ -> ());
+ if ctx_td.com.platform = Cs && t.t_meta <> [] then
+ delay ctx_td PTypeField (fun () ->
+ let metas = StrictMeta.check_strict_meta ctx_td t.t_meta in
if metas <> [] then t.t_meta <- metas @ t.t_meta;
)
- let init_abstract ctx a d p =
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
- DisplayEmitter.display_module_type ctx (TAbstractDecl a) (pos d.d_name);
- TypeloadCheck.check_global_metadata ctx a.a_meta (fun m -> a.a_meta <- m :: a.a_meta) a.a_module.m_path a.a_path None;
- let ctx = { ctx with type_params = a.a_params } in
+ let init_abstract ctx_m a d p =
+ if ctx_m.m.is_display_file && DisplayPosition.display_position#enclosed_in (pos d.d_name) then
+ DisplayEmitter.display_module_type ctx_m (TAbstractDecl a) (pos d.d_name);
+ TypeloadCheck.check_global_metadata ctx_m a.a_meta (fun m -> a.a_meta <- m :: a.a_meta) a.a_module.m_path a.a_path None;
+ Option.may (fun c ->
+ List.iter (fun m -> match m with
+ | ((Meta.Using | Meta.Build | Meta.CoreApi | Meta.Allow | Meta.Access | Meta.Enum | Meta.Dce | Meta.Native | Meta.HlNative | Meta.JsRequire | Meta.PythonImport | Meta.Expose | Meta.Deprecated | Meta.PhpGlobal | Meta.PublicFields),_,_) ->
+ c.cl_meta <- m :: c.cl_meta;
+ | _ ->
+ ()
+ ) a.a_meta;
+ ) a.a_impl;
+ let ctx_a = TyperManager.clone_for_abstract ctx_m a in
let is_type = ref false in
let load_type t from =
let _, pos = t in
- let t = load_complex_type ctx true t in
+ let t = load_complex_type ctx_a true t in
let t = if not (Meta.has Meta.CoreType a.a_meta) then begin
if !is_type then begin
- let r = make_lazy ctx t (fun r ->
+ let r = make_lazy ctx_a t (fun r ->
(try (if from then Type.unify t a.a_this else Type.unify a.a_this t) with Unify_error _ -> raise_typing_error "You can only declare from/to with compatible types" pos);
t
) "constraint" in
@@ -619,8 +609,8 @@ module TypeLevel = struct
| AbOver t ->
if a.a_impl = None then raise_typing_error "Abstracts with underlying type must have an implementation" a.a_pos;
if Meta.has Meta.CoreType a.a_meta then raise_typing_error "@:coreType abstracts cannot have an underlying type" p;
- let at = load_complex_type ctx true t in
- delay ctx PForce (fun () ->
+ let at = load_complex_type ctx_a true t in
+ delay ctx_a PForce (fun () ->
let rec loop stack t =
match follow t with
| TAbstract(a,_) when not (Meta.has Meta.CoreType a.a_meta) ->
@@ -647,54 +637,55 @@ module TypeLevel = struct
raise_typing_error "Abstract is missing underlying type declaration" a.a_pos
end;
if Meta.has Meta.InheritDoc a.a_meta then
- delay ctx PConnectField (fun() -> InheritDoc.build_abstract_doc ctx a)
+ delay ctx_a PConnectField (fun() -> InheritDoc.build_abstract_doc ctx_a a)
(*
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 list that will be evaluated the first time we evaluate
an expression into the context
*)
- let init_module_type ctx (decl,p) =
+ let init_module_type ctx_m (decl,p) =
+ let com = ctx_m.com in
let get_type name =
- try List.find (fun t -> snd (t_infos t).mt_path = name) ctx.m.curmod.m_types with Not_found -> die "" __LOC__
+ try List.find (fun t -> snd (t_infos t).mt_path = name) ctx_m.m.curmod.m_types with Not_found -> die "" __LOC__
in
let check_path_display path p =
- if DisplayPosition.display_position#is_in_file (ctx.com.file_keys#get p.pfile) then DisplayPath.handle_path_display ctx path p
+ if DisplayPosition.display_position#is_in_file (com.file_keys#get p.pfile) then DisplayPath.handle_path_display ctx_m path p
in
match decl with
| EImport (path,mode) ->
begin try
check_path_display path p;
- ImportHandling.init_import ctx path mode p;
- ImportHandling.commit_import ctx path mode p;
+ ImportHandling.init_import ctx_m path mode p;
+ ImportHandling.commit_import ctx_m path mode p;
with Error err ->
- display_error_ext ctx.com err
+ display_error_ext com err
end
| EUsing path ->
check_path_display path p;
- ImportHandling.init_using ctx path p
+ ImportHandling.init_using ctx_m path p
| EClass d ->
let c = (match get_type (fst d.d_name) with TClassDecl c -> c | _ -> die "" __LOC__) in
- init_class ctx c d p
+ init_class ctx_m c d p
| EEnum d ->
let e = (match get_type (fst d.d_name) with TEnumDecl e -> e | _ -> die "" __LOC__) in
- init_enum ctx e d p
+ init_enum ctx_m e d p
| ETypedef d ->
let t = (match get_type (fst d.d_name) with TTypeDecl t -> t | _ -> die "" __LOC__) in
- init_typedef ctx t d p
+ init_typedef ctx_m t d p
| EAbstract d ->
let a = (match get_type (fst d.d_name) with TAbstractDecl a -> a | _ -> die "" __LOC__) in
- init_abstract ctx a d p
+ init_abstract ctx_m a d p
| EStatic _ ->
(* nothing to do here as module fields are collected into a special EClass *)
()
end
-let make_curmod ctx m =
+let make_curmod com g m =
let rl = new resolution_list ["import";s_type_path m.m_path] in
List.iter (fun mt ->
rl#add (module_type_resolution mt None null_pos))
- (List.rev ctx.g.std_types.m_types);
+ (List.rev g.std_types.m_types);
{
curmod = m;
import_resolution = rl;
@@ -702,104 +693,142 @@ let make_curmod ctx m =
enum_with_type = None;
module_using = [];
import_statements = [];
- }
-
-let create_typer_context_for_module ctx m = {
- com = ctx.com;
- g = ctx.g;
- t = ctx.com.basic;
- m = make_curmod ctx m;
- is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file));
- bypass_accessor = 0;
- meta = [];
- with_type_stack = [];
- call_argument_stack = [];
- pass = PBuildModule;
- get_build_infos = (fun() -> None);
- macro_depth = 0;
- curclass = null_class;
- allow_inline = true;
- allow_transform = true;
- curfield = null_field;
- tthis = mk_mono();
- ret = mk_mono();
- locals = PMap.empty;
- type_params = [];
- curfun = FunStatic;
- untyped = false;
- in_display = false;
- in_function = false;
- in_loop = false;
- opened = [];
- in_call_args = false;
- in_overload_call_args = false;
- delayed_display = None;
- monomorphs = {
- perfunction = [];
- };
- vthis = None;
- memory_marker = Typecore.memory_marker;
+ is_display_file = (com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file));
}
(*
Creates a module context for [m] and types [tdecls] using it.
*)
-let type_types_into_module ctx m tdecls p =
- let ctx = create_typer_context_for_module ctx m in
- let decls,tdecls = ModuleLevel.create_module_types ctx m tdecls p in
+let type_types_into_module com g m tdecls p =
+ let ctx_m = TyperManager.create_for_module com g (make_curmod com g m) in
+ let decls,tdecls = ModuleLevel.create_module_types ctx_m m tdecls p in
let types = List.map fst decls in
(* During the initial module_lut#add in type_module, m has no m_types yet by design.
We manually add them here. This and module_lut#add itself should be the only places
in the compiler that call add_module_type. *)
- List.iter (fun mt -> ctx.com.module_lut#add_module_type m mt) types;
+ List.iter (fun mt -> ctx_m.com.module_lut#add_module_type m mt) types;
m.m_types <- m.m_types @ types;
(* define the per-module context for the next pass *)
- if ctx.g.std_types != null_module then begin
- add_dependency m ctx.g.std_types;
+ if ctx_m.g.std_types != null_module then begin
+ add_dependency m ctx_m.g.std_types;
(* this will ensure both String and (indirectly) Array which are basic types which might be referenced *)
- ignore(load_instance ctx (make_ptp (mk_type_path (["std"],"String")) null_pos) ParamNormal)
+ ignore(load_instance ctx_m (make_ptp (mk_type_path (["std"],"String")) null_pos) ParamNormal)
end;
- ModuleLevel.init_type_params ctx decls;
+ ModuleLevel.init_type_params ctx_m decls;
(* setup module types *)
- List.iter (TypeLevel.init_module_type ctx) tdecls;
+ List.iter (TypeLevel.init_module_type ctx_m) tdecls;
(* Make sure that we actually init the context at some point (issue #9012) *)
- delay ctx PConnectField (fun () -> ctx.m.import_resolution#resolve_lazies);
- ctx
+ delay ctx_m PConnectField (fun () -> ctx_m.m.import_resolution#resolve_lazies);
+ ctx_m
(*
Creates a new module and types [tdecls] into it.
*)
-let type_module ctx mpath file ?(dont_check_path=false) ?(is_extern=false) tdecls p =
- let m = ModuleLevel.make_module ctx mpath file p in
- ctx.com.module_lut#add m.m_path m;
- let tdecls = ModuleLevel.handle_import_hx ctx m tdecls p in
- let ctx = type_types_into_module ctx m tdecls p in
- if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Typecore.check_module_path ctx m.m_path p;
+let type_module ctx_from mpath file ?(dont_check_path=false) ?(is_extern=false) tdecls p =
+ let m = ModuleLevel.make_module ctx_from.com ctx_from.g mpath file p in
+ ctx_from.com.module_lut#add m.m_path m;
+ let tdecls = ModuleLevel.handle_import_hx ctx_from.com ctx_from.g m tdecls p in
+ let ctx_m = type_types_into_module ctx_from.com ctx_from.g m tdecls p in
+ if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Typecore.check_module_path ctx_m m.m_path p;
m
(* let type_module ctx mpath file ?(is_extern=false) tdecls p =
let timer = Timer.timer ["typing";"type_module"] in
Std.finally timer (type_module ctx mpath file ~is_extern tdecls) p *)
-let type_module_hook = ref (fun _ _ _ -> None)
+let type_module_hook = ref (fun _ _ _ -> NoModule)
+
+class hxb_reader_api_typeload
+ (ctx : typer)
+ (load_module : typer -> path -> pos -> module_def)
+ (p : pos)
+= object(self)
+ method make_module (path : path) (file : string) =
+ let m = ModuleLevel.make_module ctx.com ctx.g path file p in
+ m.m_extra.m_processed <- 1;
+ m
+
+ method add_module (m : module_def) =
+ ctx.com.module_lut#add m.m_path m
+
+ method resolve_type (pack : string list) (mname : string) (tname : string) =
+ let m = load_module ctx (pack,mname) p in
+ List.find (fun t -> snd (t_path t) = tname) m.m_types
+
+ method resolve_module (path : path) =
+ load_module ctx path p
+
+ method basic_types =
+ ctx.com.basic
+
+ method get_var_id (i : int) =
+ (* The v_id in .hxb has no relation to this context, make a new one. *)
+ let uid = fst alloc_var' in
+ incr uid;
+ !uid
+
+ method read_expression_eagerly (cf : tclass_field) =
+ ctx.com.is_macro_context || match cf.cf_kind with
+ | Var _ ->
+ true
+ | Method _ ->
+ delay ctx PTypeField (fun () -> ignore(follow cf.cf_type));
+ false
+end
+
+let rec load_hxb_module ctx path p =
+ let read file bytes =
+ try
+ let api = (new hxb_reader_api_typeload ctx load_module' p :> HxbReaderApi.hxb_reader_api) in
+ let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats in
+ let read = reader#read api bytes in
+ let m = read EOT in
+ delay ctx PConnectField (fun () ->
+ ignore(read EOM);
+ );
+ m
+ with e ->
+ Printf.eprintf "\x1b[30;41mError loading %s from %s\x1b[0m\n" (snd path) file;
+ let msg = Printexc.to_string e and stack = Printexc.get_backtrace () in
+ Printf.eprintf " => %s\n%s\n" msg stack;
+ raise e
+ in
+ let target = Common.platform_name_macro ctx.com in
+ let rec loop l = match l with
+ | hxb_lib :: l ->
+ begin match hxb_lib#get_bytes target path with
+ | Some bytes ->
+ read hxb_lib#get_file_path bytes
+ | None ->
+ loop l
+ end
+ | [] ->
+ raise Not_found
+ in
+ loop ctx.com.hxb_libs
-let load_module' ctx g m p =
+and load_module' ctx m p =
try
(* Check current context *)
ctx.com.module_lut#find m
with Not_found ->
(* Check cache *)
match !type_module_hook ctx m p with
- | Some m ->
+ | GoodModule m ->
m
- | None ->
+ | BinaryModule _ ->
+ die "" __LOC__ (* The server builds those *)
+ | NoModule | BadModule _ -> try
+ load_hxb_module ctx m p
+ with Not_found ->
let raise_not_found () = raise_error_msg (Module_not_found m) p in
if ctx.com.module_nonexistent_lut#mem m then raise_not_found();
if ctx.g.load_only_cached_modules then raise_not_found();
let is_extern = ref false in
let file, decls = try
(* Try parsing *)
- TypeloadParse.parse_module ctx m p
+ let rfile,decls = TypeloadParse.parse_module ctx m p in
+ rfile.file,decls
with Not_found ->
(* Nothing to parse, try loading extern type *)
let rec loop = function
@@ -815,13 +844,10 @@ let load_module' ctx g m p =
loop ctx.com.load_extern_type
in
let is_extern = !is_extern in
- try
- type_module ctx m file ~is_extern decls p
- with Forbid_package (inf,pl,pf) when p <> null_pos ->
- raise (Forbid_package (inf,p::pl,pf))
+ type_module ctx m file ~is_extern decls p
let load_module ctx m p =
- let m2 = load_module' ctx ctx.g m p in
+ let m2 = load_module' ctx m p in
add_dependency ~skip_postprocess:true ctx.m.curmod m2;
if ctx.pass = PTypeField then flush_pass ctx PConnectField ("load_module",fst m @ [snd m]);
m2
diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml
index 481c451236d..eef20a8e975 100644
--- a/src/typing/typeloadParse.ml
+++ b/src/typing/typeloadParse.ml
@@ -58,8 +58,8 @@ let parse_file_from_lexbuf com file p lexbuf =
let parse_file_from_string com file p string =
parse_file_from_lexbuf com file p (Sedlexing.Utf8.from_string string)
-let parse_file com file p =
- let file_key = com.file_keys#get file in
+let parse_file com rfile p =
+ let file_key = com.file_keys#get rfile.ClassPaths.file in
let contents = match com.file_contents with
| [] when (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file file_key ->
let s = Std.input_all stdin in
@@ -73,48 +73,48 @@ let parse_file com file p =
match contents with
| Some s ->
- parse_file_from_string com file p s
+ parse_file_from_string com rfile.file p s
| _ ->
- let ch = try open_in_bin file with _ -> raise_typing_error ("Could not open " ^ file) p in
- Std.finally (fun() -> close_in ch) (parse_file_from_lexbuf com file p) (Sedlexing.Utf8.from_channel ch)
+ match rfile.class_path#file_kind with
+ | FFile ->
+ let file = rfile.file in
+ let ch = try open_in_bin file with _ -> raise_typing_error ("Could not open " ^ file) p in
+ Std.finally (fun() -> close_in ch) (parse_file_from_lexbuf com file p) (Sedlexing.Utf8.from_channel ch)
let parse_hook = ref parse_file
let resolve_module_file com m remap p =
let forbid = ref false in
- let compose_path no_rename =
+ let compose_path =
(match m with
| [] , name -> name
| x :: l , name ->
let x = (try
match PMap.find x com.package_rules with
| Forbidden -> forbid := true; x
- | Directory d -> if no_rename then x else d
| Remap d -> remap := d :: l; d
with Not_found -> x
) in
String.concat "/" (x :: l) ^ "/" ^ name
) ^ ".hx"
in
- let file = try
- Common.find_file com (compose_path false)
- with Not_found ->
- Common.find_file com (compose_path true)
- in
- let file = (match ExtString.String.lowercase (snd m) with
- | "con" | "aux" | "prn" | "nul" | "com1" | "com2" | "com3" | "lpt1" | "lpt2" | "lpt3" when Sys.os_type = "Win32" ->
- (* these names are reserved by the OS - old DOS legacy, such files cannot be easily created but are reported as visible *)
- if (try (Unix.stat file).Unix.st_size with _ -> 0) > 0 then file else raise Not_found
- | _ -> file
- ) in
+ let rfile = com.class_paths#find_file compose_path in
+ begin match rfile.class_path#file_kind with
+ | FFile -> (match ExtString.String.lowercase (snd m) with
+ | "con" | "aux" | "prn" | "nul" | "com1" | "com2" | "com3" | "lpt1" | "lpt2" | "lpt3" when Sys.os_type = "Win32" ->
+ (* these names are reserved by the OS - old DOS legacy, such files cannot be easily created but are reported as visible *)
+ if (try (Unix.stat rfile.file).Unix.st_size with _ -> 0) > 0 then () else raise Not_found
+ | _ ->
+ ())
+ end;
(* if we try to load a std.xxxx class and resolve a real std file, the package name is not valid, ignore *)
(match fst m with
| "std" :: _ ->
- let file_key = com.file_keys#get file in
- if List.exists (fun path -> Path.UniqueKey.starts_with file_key (com.file_keys#get path)) com.std_path then raise Not_found;
+ let file_key = com.file_keys#get rfile.file in
+ if List.exists (fun path -> Path.UniqueKey.starts_with file_key (com.file_keys#get path#path)) com.class_paths#get_std_paths then raise Not_found;
| _ -> ());
if !forbid then begin
- let parse_result = (!parse_hook) com file p in
+ let parse_result = (!parse_hook) com rfile p in
let rec loop decls = match decls with
| ((EImport _,_) | (EUsing _,_)) :: decls -> loop decls
| (EClass d,_) :: _ -> d.d_meta
@@ -133,15 +133,15 @@ let resolve_module_file com m remap p =
raise (Forbid_package ((x,m,p),[],platform_name_macro com));
end;
end;
- file
+ rfile
let resolve_module_file com m remap p =
try
com.module_to_file#find m
with Not_found ->
- let file = resolve_module_file com m remap p in
- com.module_to_file#add m file;
- file
+ let rfile = resolve_module_file com m remap p in
+ com.module_to_file#add m rfile;
+ rfile
(* let resolve_module_file com m remap p =
let timer = Timer.timer ["typing";"resolve_module_file"] in
@@ -292,20 +292,20 @@ let parse_module_file com file p =
let parse_module' com m p =
let remap = ref (fst m) in
- let file = resolve_module_file com m remap p in
- let pack,decls = parse_module_file com file p in
- file,remap,pack,decls
+ let rfile = resolve_module_file com m remap p in
+ let pack,decls = parse_module_file com rfile p in
+ rfile,remap,pack,decls
let parse_module ctx m p =
- let file,remap,pack,decls = parse_module' ctx.com m p in
+ let rfile,remap,pack,decls = parse_module' ctx.com m p in
if pack <> !remap then begin
let spack m = if m = [] then "`package;`" else "`package " ^ (String.concat "." m) ^ ";`" in
if p == null_pos then
display_error ctx.com ("Invalid commandline class : " ^ s_type_path m ^ " should be " ^ s_type_path (pack,snd m)) p
else
- display_error ctx.com (spack pack ^ " in " ^ file ^ " should be " ^ spack (fst m)) {p with pmax = p.pmin}
+ display_error ctx.com (spack pack ^ " in " ^ rfile.file ^ " should be " ^ spack (fst m)) {p with pmax = p.pmin}
end;
- file, if !remap <> fst m then
+ rfile, if !remap <> fst m then
(* build typedefs to redirect to real package *)
List.rev (List.fold_left (fun acc (t,p) ->
let build f d =
diff --git a/src/typing/typer.ml b/src/typing/typer.ml
index 6fad5ed24a5..13aca40a8de 100644
--- a/src/typing/typer.ml
+++ b/src/typing/typer.ml
@@ -40,7 +40,7 @@ let mono_or_dynamic ctx with_type p = match with_type with
| WithType.NoValue ->
t_dynamic
| Value _ | WithType _ ->
- spawn_monomorph ctx p
+ spawn_monomorph ctx.e p
let get_iterator_param t =
match follow t with
@@ -144,7 +144,7 @@ let maybe_type_against_enum ctx f with_type iscall p =
let rec unify_min_raise ctx (el:texpr list) : t =
let basic = ctx.com.basic in
match el with
- | [] -> spawn_monomorph ctx null_pos
+ | [] -> spawn_monomorph ctx.e null_pos
| [e] -> e.etype
| _ ->
let rec chk_null e = is_null e.etype || is_explicit_null e.etype ||
@@ -172,7 +172,7 @@ let rec unify_min_raise ctx (el:texpr list) : t =
with Unify_error _ ->
true, t
in
- let has_error, t = loop (spawn_monomorph ctx null_pos) el in
+ let has_error, t = loop (spawn_monomorph ctx.e null_pos) el in
if not has_error then
t
else try
@@ -263,7 +263,7 @@ let rec unify_min_raise ctx (el:texpr list) : t =
let unify_min ctx el =
try unify_min_raise ctx el
with Error ({ err_message = Unify l } as err) ->
- if not ctx.untyped then display_error_ext ctx.com err;
+ if not ctx.f.untyped then display_error_ext ctx.com err;
(List.hd el).etype
let unify_min_for_type_source ctx el src =
@@ -350,8 +350,8 @@ let rec type_ident_raise ctx i p mode with_type =
let acc = AKExpr(get_this ctx p) in
begin match mode with
| MSet _ ->
- add_class_field_flag ctx.curfield CfModifiesThis;
- begin match ctx.curclass.cl_kind with
+ add_class_field_flag ctx.f.curfield CfModifiesThis;
+ begin match ctx.c.curclass.cl_kind with
| KAbstractImpl _ ->
if not (assign_to_this_is_allowed ctx) then
raise_typing_error "Abstract 'this' value can only be modified inside an inline function" p;
@@ -360,7 +360,7 @@ let rec type_ident_raise ctx i p mode with_type =
AKNo(acc,p)
end
| MCall _ ->
- begin match ctx.curclass.cl_kind with
+ begin match ctx.c.curclass.cl_kind with
| KAbstractImpl _ ->
acc
| _ ->
@@ -370,7 +370,7 @@ let rec type_ident_raise ctx i p mode with_type =
acc
end;
| "abstract" ->
- begin match mode, ctx.curclass.cl_kind with
+ begin match mode, ctx.c.curclass.cl_kind with
| MSet _, KAbstractImpl ab -> raise_typing_error "Property 'abstract' is read-only" p;
| (MGet, KAbstractImpl ab)
| (MCall _, KAbstractImpl ab) ->
@@ -382,11 +382,11 @@ let rec type_ident_raise ctx i p mode with_type =
raise_typing_error "Property 'abstract' is reserved and only available in abstracts" p
end
| "super" ->
- let t = (match ctx.curclass.cl_super with
+ let t = (match ctx.c.curclass.cl_super with
| None -> raise_typing_error "Current class does not have a superclass" p
| Some (c,params) -> TInst(c,params)
) in
- (match ctx.curfun with
+ (match ctx.e.curfun with
| FunMember | FunConstructor -> ()
| FunMemberAbstract -> raise_typing_error "Cannot access super inside an abstract function" p
| FunStatic -> raise_typing_error "Cannot access super inside a static function" p;
@@ -396,9 +396,9 @@ let rec type_ident_raise ctx i p mode with_type =
let acc =
(* Hack for #10787 *)
if ctx.com.platform = Cs then
- AKExpr (null (spawn_monomorph ctx p) p)
+ AKExpr (null (spawn_monomorph ctx.e p) p)
else begin
- let tnull () = ctx.t.tnull (spawn_monomorph ctx p) in
+ let tnull () = ctx.t.tnull (spawn_monomorph ctx.e p) in
let t = match with_type with
| WithType.WithType(t,_) ->
begin match follow t with
@@ -421,7 +421,7 @@ let rec type_ident_raise ctx i p mode with_type =
if mode = MGet then acc else AKNo(acc,p)
| _ ->
try
- let v = PMap.find i ctx.locals in
+ let v = PMap.find i ctx.f.locals in
add_var_flag v VUsedByTyper;
(match v.v_extra with
| Some ve ->
@@ -447,25 +447,25 @@ let rec type_ident_raise ctx i p mode with_type =
AKExpr (mk (TLocal v) v.v_type p))
with Not_found -> try
(* member variable lookup *)
- if ctx.curfun = FunStatic then raise Not_found;
- let c , t , f = class_field ctx ctx.curclass (extract_param_types ctx.curclass.cl_params) i p in
+ if ctx.e.curfun = FunStatic then raise Not_found;
+ let c , t , f = class_field ctx ctx.c.curclass (extract_param_types ctx.c.curclass.cl_params) i p in
field_access ctx mode f (match c with None -> FHAnon | Some (c,tl) -> FHInstance (c,tl)) (get_this ctx p) p
with Not_found -> try
(* static variable lookup *)
- let f = PMap.find i ctx.curclass.cl_statics in
+ let f = PMap.find i ctx.c.curclass.cl_statics in
let is_impl = has_class_field_flag f CfImpl in
let is_enum = has_class_field_flag f CfEnum in
- if is_impl && not (has_class_field_flag ctx.curfield CfImpl) && not is_enum then
+ if is_impl && not (has_class_field_flag ctx.f.curfield CfImpl) && not is_enum then
raise_typing_error (Printf.sprintf "Cannot access non-static field %s from static method" f.cf_name) p;
- let e,fa = match ctx.curclass.cl_kind with
+ let e,fa = match ctx.c.curclass.cl_kind with
| KAbstractImpl a when is_impl && not is_enum ->
let tl = extract_param_types a.a_params in
let e = get_this ctx p in
let e = {e with etype = TAbstract(a,tl)} in
- e,FHAbstract(a,tl,ctx.curclass)
+ e,FHAbstract(a,tl,ctx.c.curclass)
| _ ->
- let e = type_module_type ctx (TClassDecl ctx.curclass) p in
- e,FHStatic ctx.curclass
+ let e = type_module_type ctx (TClassDecl ctx.c.curclass) p in
+ e,FHStatic ctx.c.curclass
in
field_access ctx mode f fa e p
with Not_found -> try
@@ -500,20 +500,20 @@ and type_ident ctx i p mode with_type =
end else
raise Not_found
with Not_found ->
- if ctx.untyped then begin
+ if ctx.f.untyped then begin
if i = "__this__" then
- AKExpr (mk (TConst TThis) ctx.tthis p)
+ AKExpr (mk (TConst TThis) ctx.c.tthis p)
else
let t = mk_mono() in
AKExpr ((mk (TIdent i)) t p)
end else begin
- if ctx.curfun = FunStatic && PMap.mem i ctx.curclass.cl_fields then raise_typing_error ("Cannot access " ^ i ^ " in static function") p;
+ if ctx.e.curfun = FunStatic && PMap.mem i ctx.c.curclass.cl_fields then raise_typing_error ("Cannot access " ^ i ^ " in static function") p;
if !resolved_to_type_parameter then begin
display_error ctx.com ("Only @:const type parameters on @:generic classes can be used as value") p;
AKExpr (mk (TConst TNull) t_dynamic p)
end else begin
let err = Unknown_ident i in
- if ctx.in_display then begin
+ if ctx.f.in_display then begin
raise_error_msg err p
end;
if Diagnostics.error_in_diagnostics_run ctx.com p then begin
@@ -584,7 +584,7 @@ and handle_efield ctx e p0 mode with_type =
end
with Not_found ->
(* if there was no module name part, last guess is that we're trying to get package completion *)
- if ctx.in_display then begin
+ if ctx.f.in_display then begin
let sl = List.map (fun part -> part.name) path in
if is_legacy_completion ctx.com then
raise (Parser.TypePath (sl,None,false,p))
@@ -707,15 +707,15 @@ and type_vars ctx vl p =
let vl = List.map (fun ev ->
let n = fst ev.ev_name
and pv = snd ev.ev_name in
- DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.curclass.cl_meta ctx.curfield.cf_meta n ev.ev_meta pv;
+ DeprecationCheck.check_is ctx.com ctx.m.curmod ctx.c.curclass.cl_meta ctx.f.curfield.cf_meta n ev.ev_meta pv;
try
let t = Typeload.load_type_hint ctx p ev.ev_type in
let e = (match ev.ev_expr with
| None -> None
| Some e ->
- let old_in_loop = ctx.in_loop in
- if ev.ev_static then ctx.in_loop <- false;
- let e = Std.finally (fun () -> ctx.in_loop <- old_in_loop) (type_expr ctx e) (WithType.with_type t) in
+ let old_in_loop = ctx.e.in_loop in
+ if ev.ev_static then ctx.e.in_loop <- false;
+ let e = Std.finally (fun () -> ctx.e.in_loop <- old_in_loop) (type_expr ctx e) (WithType.with_type t) in
let e = AbstractCast.cast_or_unify ctx t e p in
Some e
) in
@@ -728,7 +728,7 @@ and type_vars ctx vl p =
DisplayEmitter.check_display_metadata ctx v.v_meta;
if ev.ev_final then add_var_flag v VFinal;
if ev.ev_static then add_var_flag v VStatic;
- if ctx.in_display && DisplayPosition.display_position#enclosed_in pv then
+ if ctx.f.in_display && DisplayPosition.display_position#enclosed_in pv then
DisplayEmitter.display_variable ctx v pv;
v,e
with
@@ -751,7 +751,7 @@ and type_vars ctx vl p =
and format_string ctx s p =
FormatString.format_string ctx.com.defines s p (fun enext p ->
- if ctx.in_display && DisplayPosition.display_position#enclosed_in p then
+ if ctx.f.in_display && DisplayPosition.display_position#enclosed_in p then
Display.preprocess_expr ctx.com (enext,p)
else
enext,p
@@ -823,7 +823,7 @@ and type_object_decl ctx fl with_type p =
| None ->
let cf = PMap.find n field_map in
if (has_class_field_flag cf CfFinal) then is_final := true;
- if ctx.in_display && DisplayPosition.display_position#enclosed_in pn then DisplayEmitter.display_field ctx Unknown CFSMember cf pn;
+ if ctx.f.in_display && DisplayPosition.display_position#enclosed_in pn then DisplayEmitter.display_field ctx Unknown CFSMember cf pn;
cf.cf_type
in
let e = type_expr ctx e (WithType.with_structure_field t n) in
@@ -844,7 +844,7 @@ and type_object_decl ctx fl with_type p =
((n,pn,qs),e)
) fl in
let t = mk_anon ~fields:!fields (ref Const) in
- if not ctx.untyped then begin
+ if not ctx.f.untyped then begin
(match PMap.foldi (fun n cf acc -> if not (Meta.has Meta.Optional cf.cf_meta) && not (PMap.mem n !fields) then n :: acc else acc) field_map [] with
| [] -> ()
| [n] -> raise_or_display ctx [Unify_custom ("Object requires field " ^ n)] p
@@ -867,7 +867,7 @@ and type_object_decl ctx fl with_type p =
let e = type_expr ctx e (WithType.named_structure_field f) in
(match follow e.etype with TAbstract({a_path=[],"Void"},_) -> raise_typing_error "Fields of type Void are not allowed in structures" e.epos | _ -> ());
let cf = mk_field f e.etype (punion pf e.epos) pf in
- if ctx.in_display && DisplayPosition.display_position#enclosed_in pf then DisplayEmitter.display_field ctx Unknown CFSMember cf pf;
+ if ctx.f.in_display && DisplayPosition.display_position#enclosed_in pf then DisplayEmitter.display_field ctx Unknown CFSMember cf pf;
(((f,pf,qs),e) :: l, if is_valid then begin
if starts_with f '$' then raise_typing_error "Field names starting with a dollar are not allowed" p;
PMap.add f cf acc
@@ -875,7 +875,7 @@ and type_object_decl ctx fl with_type p =
in
let fields , types = List.fold_left loop ([],PMap.empty) fl in
let x = ref Const in
- ctx.opened <- x :: ctx.opened;
+ ctx.e.opened <- x :: ctx.e.opened;
mk (TObjectDecl (List.rev fields)) (mk_anon ~fields:types x) p
in
(match a with
@@ -1017,11 +1017,11 @@ and type_new ctx ptp el with_type force_inline p =
tl_or_monos info.build_params
in
let restore =
- ctx.call_argument_stack <- el :: ctx.call_argument_stack;
- ctx.with_type_stack <- with_type :: ctx.with_type_stack;
+ ctx.e.call_argument_stack <- el :: ctx.e.call_argument_stack;
+ ctx.e.with_type_stack <- with_type :: ctx.e.with_type_stack;
(fun () ->
- ctx.with_type_stack <- List.tl ctx.with_type_stack;
- ctx.call_argument_stack <- List.tl ctx.call_argument_stack
+ ctx.e.with_type_stack <- List.tl ctx.e.with_type_stack;
+ ctx.e.call_argument_stack <- List.tl ctx.e.call_argument_stack
)
in
let t = try
@@ -1122,12 +1122,12 @@ and type_try ctx e1 catches with_type p =
check_unreachable acc1 t2 (pos e_ast);
let locals = save_locals ctx in
let v = add_local_with_origin ctx TVOCatchVariable v t pv in
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in pv then
+ if ctx.m.is_display_file && DisplayPosition.display_position#enclosed_in pv then
DisplayEmitter.display_variable ctx v pv;
let e = type_expr ctx e_ast with_type in
(* If the catch position is the display position it means we get completion on the catch keyword or some
punctuation. Otherwise we wouldn't reach this point. *)
- if ctx.is_display_file && DisplayPosition.display_position#enclosed_in pc then ignore(TyperDisplay.display_expr ctx e_ast e DKMarked MGet with_type pc);
+ if ctx.m.is_display_file && DisplayPosition.display_position#enclosed_in pc then ignore(TyperDisplay.display_expr ctx e_ast e DKMarked MGet with_type pc);
v.v_type <- t2;
locals();
((v,e) :: acc1),(e :: acc2)
@@ -1153,11 +1153,11 @@ and type_map_declaration ctx e1 el with_type p =
| TInst({cl_path=["haxe";"ds"],"IntMap"},[tv]) -> ctx.t.tint,tv,true
| TInst({cl_path=["haxe";"ds"],"StringMap"},[tv]) -> ctx.t.tstring,tv,true
| TInst({cl_path=["haxe";"ds"],("ObjectMap" | "EnumValueMap")},[tk;tv]) -> tk,tv,true
- | _ -> spawn_monomorph ctx p,spawn_monomorph ctx p,false
+ | _ -> spawn_monomorph ctx.e p,spawn_monomorph ctx.e p,false
in
match with_type with
| WithType.WithType(t,_) -> get_map_params t
- | _ -> (spawn_monomorph ctx p,spawn_monomorph ctx p,false)
+ | _ -> (spawn_monomorph ctx.e p,spawn_monomorph ctx.e p,false)
in
let keys = Hashtbl.create 0 in
let check_key e_key =
@@ -1227,12 +1227,12 @@ and type_local_function ctx kind f with_type p =
| None -> None,p
| Some (v,pn) -> Some v,pn
) in
- let old_tp,old_in_loop = ctx.type_params,ctx.in_loop in
+ let old_tp,old_in_loop = ctx.type_params,ctx.e.in_loop in
ctx.type_params <- params @ ctx.type_params;
- if not inline then ctx.in_loop <- false;
+ if not inline then ctx.e.in_loop <- false;
let rt = Typeload.load_type_hint ctx p f.f_type in
let type_arg _ opt t p = Typeload.load_type_hint ~opt ctx p t in
- let args = new FunctionArguments.function_arguments ctx type_arg false ctx.in_display None f.f_args in
+ let args = new FunctionArguments.function_arguments ctx type_arg false ctx.f.in_display None f.f_args in
let targs = args#for_type in
let maybe_unify_arg t1 t2 =
match follow t1 with
@@ -1330,15 +1330,15 @@ and type_local_function ctx kind f with_type p =
if params <> [] then v.v_extra <- Some (var_extra params None);
Some v
) in
- let curfun = match ctx.curfun with
+ let curfun = match ctx.e.curfun with
| FunStatic -> FunStatic
| FunMemberAbstract
| FunMemberAbstractLocal -> FunMemberAbstractLocal
| _ -> FunMemberClassLocal
in
- let e = TypeloadFunction.type_function ctx args rt curfun f.f_expr ctx.in_display p in
+ let e = TypeloadFunction.type_function ctx args rt curfun f.f_expr ctx.f.in_display p in
ctx.type_params <- old_tp;
- ctx.in_loop <- old_in_loop;
+ ctx.e.in_loop <- old_in_loop;
let tf = {
tf_args = args#for_expr;
tf_type = rt;
@@ -1351,7 +1351,7 @@ and type_local_function ctx kind f with_type p =
Typeload.generate_args_meta ctx.com None (fun m -> v.v_meta <- m :: v.v_meta) f.f_args;
let open LocalUsage in
if params <> [] || inline then v.v_extra <- Some (var_extra params (if inline then Some e else None));
- if ctx.in_display && DisplayPosition.display_position#enclosed_in v.v_pos then
+ if ctx.f.in_display && DisplayPosition.display_position#enclosed_in v.v_pos then
DisplayEmitter.display_variable ctx v v.v_pos;
let rec loop = function
| LocalUsage.Block f | LocalUsage.Loop f | LocalUsage.Function f -> f loop
@@ -1369,7 +1369,7 @@ and type_local_function ctx kind f with_type p =
(mk (TVar (v,Some (mk (TConst TNull) ft p))) ctx.t.tvoid p) ::
(mk (TBinop (OpAssign,mk (TLocal v) ft p,e)) ft p) ::
exprs
- end else if inline && not ctx.is_display_file then
+ end else if inline && not ctx.m.is_display_file then
(mk (TBlock []) ctx.t.tvoid p) :: exprs (* do not add variable since it will be inlined *)
else
(mk (TVar (v,Some e)) ctx.t.tvoid p) :: exprs
@@ -1428,7 +1428,7 @@ and type_array_decl ctx el with_type p =
let t = try
unify_min_raise ctx el
with Error ({ err_message = Unify _ } as err) ->
- if !allow_array_dynamic || ctx.untyped || ignore_error ctx.com then
+ if !allow_array_dynamic || ctx.f.untyped || ignore_error ctx.com then
t_dynamic
else begin
display_error ctx.com "Arrays of mixed types are only allowed if the type is forced to Array" err.err_pos;
@@ -1444,7 +1444,7 @@ and type_array_decl ctx el with_type p =
mk (TArrayDecl el) (ctx.t.tarray t) p)
and type_array_comprehension ctx e with_type p =
- let v = gen_local ctx (spawn_monomorph ctx p) p in
+ let v = gen_local ctx (spawn_monomorph ctx.e p) p in
let ev = mk (TLocal v) v.v_type p in
let e_ref = snd (store_typed_expr ctx.com ev p) in
let et = ref (EConst(Ident "null"),p) in
@@ -1480,14 +1480,14 @@ and type_array_comprehension ctx e with_type p =
]) v.v_type p
and type_return ?(implicit=false) ctx e with_type p =
- let is_abstract_ctor = ctx.curfun = FunMemberAbstract && ctx.curfield.cf_name = "_new" in
+ let is_abstract_ctor = ctx.e.curfun = FunMemberAbstract && ctx.f.curfield.cf_name = "_new" in
match e with
| None when is_abstract_ctor ->
- let e_cast = mk (TCast(get_this ctx p,None)) ctx.ret p in
+ let e_cast = mk (TCast(get_this ctx p,None)) ctx.e.ret p in
mk (TReturn (Some e_cast)) (mono_or_dynamic ctx with_type p) p
| None ->
let v = ctx.t.tvoid in
- unify ctx v ctx.ret p;
+ unify ctx v ctx.e.ret p;
let expect_void = match with_type with
| WithType.WithType(t,_) -> ExtType.is_void (follow t)
| WithType.Value (Some ImplicitReturn) -> true
@@ -1502,16 +1502,16 @@ and type_return ?(implicit=false) ctx e with_type p =
end;
try
let with_expected_type =
- if ExtType.is_void (follow ctx.ret) then WithType.no_value
- else if implicit then WithType.of_implicit_return ctx.ret
- else WithType.with_type ctx.ret
+ if ExtType.is_void (follow ctx.e.ret) then WithType.no_value
+ else if implicit then WithType.of_implicit_return ctx.e.ret
+ else WithType.with_type ctx.e.ret
in
let e = type_expr ctx e with_expected_type in
- match follow ctx.ret with
+ match follow ctx.e.ret with
| TAbstract({a_path=[],"Void"},_) when implicit ->
e
| _ ->
- let e = AbstractCast.cast_or_unify ctx ctx.ret e p in
+ let e = AbstractCast.cast_or_unify ctx ctx.e.ret e p in
match follow e.etype with
| TAbstract({a_path=[],"Void"},_) ->
begin match (Texpr.skip e).eexpr with
@@ -1592,9 +1592,9 @@ and type_if ctx e e1 e2 with_type is_ternary p =
make_if_then_else ctx e e1 e2 with_type p
and type_meta ?(mode=MGet) ctx m e1 with_type p =
- if ctx.is_display_file then DisplayEmitter.check_display_metadata ctx [m];
- let old = ctx.meta in
- ctx.meta <- m :: ctx.meta;
+ if ctx.m.is_display_file then DisplayEmitter.check_display_metadata ctx [m];
+ let old = ctx.f.meta in
+ ctx.f.meta <- m :: ctx.f.meta;
let e () = type_expr ~mode ctx e1 with_type in
let e = match m with
| (Meta.ToString,_,_) ->
@@ -1617,7 +1617,7 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
| (Meta.StoredTypedExpr,_,_) ->
type_stored_expr ctx e1
| (Meta.NoPrivateAccess,_,_) ->
- ctx.meta <- List.filter (fun(m,_,_) -> m <> Meta.PrivateAccess) ctx.meta;
+ ctx.f.meta <- List.filter (fun(m,_,_) -> m <> Meta.PrivateAccess) ctx.f.meta;
e()
| (Meta.Fixed,_,_) when ctx.com.platform=Cpp ->
let e = e() in
@@ -1626,10 +1626,10 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
let e = e() in
{e with eexpr = TMeta(m,e)}
| (Meta.BypassAccessor,_,p) ->
- let old_counter = ctx.bypass_accessor in
- ctx.bypass_accessor <- old_counter + 1;
+ let old_counter = ctx.e.bypass_accessor in
+ ctx.e.bypass_accessor <- old_counter + 1;
let e = e () in
- (if ctx.bypass_accessor > old_counter then display_error ctx.com "Field access expression expected after @:bypassAccessor metadata" p);
+ (if ctx.e.bypass_accessor > old_counter then display_error ctx.com "Field access expression expected after @:bypassAccessor metadata" p);
e
| (Meta.Inline,_,pinline) ->
begin match fst e1 with
@@ -1670,7 +1670,7 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p =
else
e()
in
- ctx.meta <- old;
+ ctx.f.meta <- old;
e
and type_call_target ctx e el with_type p_inline =
@@ -1775,8 +1775,8 @@ and type_call_builtin ctx e el mode with_type p =
| (EDisplay((EConst (Ident "super"),_ as e1),dk),_),_ ->
TyperDisplay.handle_display ctx (ECall(e1,el),p) dk mode with_type
| (EConst (Ident "super"),sp) , el ->
- if ctx.curfun <> FunConstructor then raise_typing_error "Cannot call super constructor outside class constructor" p;
- let el, t = (match ctx.curclass.cl_super with
+ if ctx.e.curfun <> FunConstructor then raise_typing_error "Cannot call super constructor outside class constructor" p;
+ let el, t = (match ctx.c.curclass.cl_super with
| None -> raise_typing_error "Current class does not have a super" p
| Some (c,params) ->
let fa = FieldAccess.get_constructor_access c params p in
@@ -1801,7 +1801,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
| EField(_,n,_) when starts_with n '$' ->
raise_typing_error "Field names starting with $ are not allowed" p
| EConst (Ident s) ->
- if s = "super" && with_type <> WithType.NoValue && not ctx.in_display then raise_typing_error "Cannot use super as value" p;
+ if s = "super" && with_type <> WithType.NoValue && not ctx.f.in_display then raise_typing_error "Cannot use super as value" p;
let e = maybe_type_against_enum ctx (fun () -> type_ident ctx s p mode with_type) with_type false p in
acc_get ctx e
| EField _
@@ -1924,18 +1924,18 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
| EIf (e,e1,e2) ->
type_if ctx e e1 e2 with_type false p
| EWhile (cond,e,NormalWhile) ->
- let old_loop = ctx.in_loop in
+ let old_loop = ctx.e.in_loop in
let cond = type_expr ctx cond WithType.value in
let cond = AbstractCast.cast_or_unify ctx ctx.t.tbool cond p in
- ctx.in_loop <- true;
+ ctx.e.in_loop <- true;
let e = type_expr ctx (Expr.ensure_block e) WithType.NoValue in
- ctx.in_loop <- old_loop;
+ ctx.e.in_loop <- old_loop;
mk (TWhile (cond,e,NormalWhile)) ctx.t.tvoid p
| EWhile (cond,e,DoWhile) ->
- let old_loop = ctx.in_loop in
- ctx.in_loop <- true;
+ let old_loop = ctx.e.in_loop in
+ ctx.e.in_loop <- true;
let e = type_expr ctx (Expr.ensure_block e) WithType.NoValue in
- ctx.in_loop <- old_loop;
+ ctx.e.in_loop <- old_loop;
let cond = type_expr ctx cond WithType.value in
let cond = AbstractCast.cast_or_unify ctx ctx.t.tbool cond cond.epos in
mk (TWhile (cond,e,DoWhile)) ctx.t.tvoid p
@@ -1944,7 +1944,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
let e = Matcher.Match.match_expr ctx e1 cases def with_type false p in
wrap e
| EReturn e ->
- if not ctx.in_function then begin
+ if not ctx.e.in_function then begin
display_error ctx.com "Return outside function" p;
match e with
| None ->
@@ -1957,10 +1957,10 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
end else
type_return ctx e with_type p
| EBreak ->
- if not ctx.in_loop then display_error ctx.com "Break outside loop" p;
+ if not ctx.e.in_loop then display_error ctx.com "Break outside loop" p;
mk TBreak (mono_or_dynamic ctx with_type p) p
| EContinue ->
- if not ctx.in_loop then display_error ctx.com "Continue outside loop" p;
+ if not ctx.e.in_loop then display_error ctx.com "Continue outside loop" p;
mk TContinue (mono_or_dynamic ctx with_type p) p
| ETry (e1,[]) ->
type_expr ctx e1 with_type
@@ -1981,11 +1981,11 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
| EFunction (kind,f) ->
type_local_function ctx kind f with_type p
| EUntyped e ->
- let old = ctx.untyped in
- ctx.untyped <- true;
- if not (Meta.has Meta.HasUntyped ctx.curfield.cf_meta) then ctx.curfield.cf_meta <- (Meta.HasUntyped,[],p) :: ctx.curfield.cf_meta;
+ let old = ctx.f.untyped in
+ ctx.f.untyped <- true;
+ if not (Meta.has Meta.HasUntyped ctx.f.curfield.cf_meta) then ctx.f.curfield.cf_meta <- (Meta.HasUntyped,[],p) :: ctx.f.curfield.cf_meta;
let e = type_expr ctx e with_type in
- ctx.untyped <- old;
+ ctx.f.untyped <- old;
{
eexpr = e.eexpr;
etype = mk_mono();
@@ -1993,7 +1993,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
}
| ECast (e,None) ->
let e = type_expr ctx e WithType.value in
- mk (TCast (e,None)) (spawn_monomorph ctx p) p
+ mk (TCast (e,None)) (spawn_monomorph ctx.e p) p
| ECast (e, Some t) ->
type_cast ctx e t p
| EDisplay (e,dk) ->
@@ -2011,7 +2011,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
if tp.path.tparams <> [] then display_error ctx.com "Type parameters are not supported for the `is` operator" p_t;
let e = type_expr ctx e WithType.value in
let mt = Typeload.load_type_def ctx p_t tp.path in
- if ctx.in_display && DisplayPosition.display_position#enclosed_in p_t then
+ if ctx.f.in_display && DisplayPosition.display_position#enclosed_in p_t then
DisplayEmitter.display_module_type ctx mt p_t;
let e_t = type_module_type ctx mt p_t in
Texpr.Builder.resolve_and_make_static_call ctx.com.std "isOfType" [e;e_t] p
diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml
index 48542971600..829ad9fa104 100644
--- a/src/typing/typerBase.ml
+++ b/src/typing/typerBase.ml
@@ -149,31 +149,31 @@ let is_lower_ident s p =
with Invalid_argument msg -> raise_typing_error msg p
let get_this ctx p =
- match ctx.curfun with
+ match ctx.e.curfun with
| FunStatic ->
raise_typing_error "Cannot access this from a static function" p
| FunMemberClassLocal | FunMemberAbstractLocal ->
- let v = match ctx.vthis with
+ let v = match ctx.f.vthis with
| None ->
- let v = if ctx.curfun = FunMemberAbstractLocal then begin
- let v = PMap.find "this" ctx.locals in
+ let v = if ctx.e.curfun = FunMemberAbstractLocal then begin
+ let v = PMap.find "this" ctx.f.locals in
add_var_flag v VUsedByTyper;
v
end else
- add_local ctx VGenerated (Printf.sprintf "%sthis" gen_local_prefix) ctx.tthis p
+ add_local ctx VGenerated (Printf.sprintf "%sthis" gen_local_prefix) ctx.c.tthis p
in
- ctx.vthis <- Some v;
+ ctx.f.vthis <- Some v;
v
| Some v ->
- ctx.locals <- PMap.add v.v_name v ctx.locals;
+ ctx.f.locals <- PMap.add v.v_name v ctx.f.locals;
v
in
- mk (TLocal v) ctx.tthis p
+ mk (TLocal v) ctx.c.tthis p
| FunMemberAbstract ->
- let v = (try PMap.find "this" ctx.locals with Not_found -> raise_typing_error "Cannot reference this abstract here" p) in
+ let v = (try PMap.find "this" ctx.f.locals with Not_found -> raise_typing_error "Cannot reference this abstract here" p) in
mk (TLocal v) v.v_type p
| FunConstructor | FunMember ->
- mk (TConst TThis) ctx.tthis p
+ mk (TConst TThis) ctx.c.tthis p
let get_stored_typed_expr ctx id =
let e = ctx.com.stored_typed_exprs#find id in
@@ -184,11 +184,11 @@ let type_stored_expr ctx e1 =
get_stored_typed_expr ctx id
let assign_to_this_is_allowed ctx =
- match ctx.curclass.cl_kind with
+ match ctx.c.curclass.cl_kind with
| KAbstractImpl _ ->
- (match ctx.curfield.cf_kind with
+ (match ctx.f.curfield.cf_kind with
| Method MethInline -> true
- | Method _ when ctx.curfield.cf_name = "_new" -> true
+ | Method _ when ctx.f.curfield.cf_name = "_new" -> true
| _ -> false
)
| _ -> false
@@ -207,12 +207,11 @@ let type_module_type ctx t p =
in
loop mt None
| TClassDecl c ->
- let t_tmp = class_module_type c in
- mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p
+ mk (TTypeExpr (TClassDecl c)) c.cl_type p
| TEnumDecl e ->
mk (TTypeExpr (TEnumDecl e)) e.e_type p
| TTypeDecl s ->
- let t = apply_typedef s (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) in
+ let t = apply_typedef s (List.map (fun _ -> spawn_monomorph ctx.e p) s.t_params) in
DeprecationCheck.check_typedef (create_deprecation_context ctx) s p;
(match follow t with
| TEnum (e,params) ->
@@ -335,7 +334,7 @@ let get_abstract_froms ctx a pl =
let l = List.map (apply_params a.a_params pl) a.a_from in
List.fold_left (fun acc (t,f) ->
(* We never want to use the @:from we're currently in because that's recursive (see #10604) *)
- if f == ctx.curfield then
+ if f == ctx.f.curfield then
acc
else if (AbstractFromConfig.update_config_from_meta (AbstractFromConfig.make ()) f.cf_meta).ignored_by_inference then
acc
diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml
index d22316512af..9470e8bae60 100644
--- a/src/typing/typerDisplay.ml
+++ b/src/typing/typerDisplay.ml
@@ -178,7 +178,7 @@ let raise_toplevel ctx dk with_type (subject,psubject) =
DisplayToplevel.collect_and_raise ctx (match dk with DKPattern _ -> TKPattern psubject | _ -> TKExpr psubject) with_type (CRToplevel expected_type) (subject,psubject) psubject
let display_dollar_type ctx p make_type =
- let mono = spawn_monomorph ctx p in
+ let mono = spawn_monomorph ctx.e p in
let doc = doc_from_string "Outputs type of argument as a warning and uses argument as value" in
let arg = ["expression",false,mono] in
begin match ctx.com.display.dms_kind with
@@ -194,7 +194,7 @@ let display_dollar_type ctx p make_type =
end
let rec handle_signature_display ctx e_ast with_type =
- ctx.in_display <- true;
+ ctx.f.in_display <- true;
let p = pos e_ast in
let handle_call tl el p0 =
let rec follow_with_callable (t,doc,values) = match follow t with
@@ -340,7 +340,7 @@ let rec handle_signature_display ctx e_ast with_type =
| _ -> raise_typing_error "Call expected" p
and display_expr ctx e_ast e dk mode with_type p =
- let get_super_constructor () = match ctx.curclass.cl_super with
+ let get_super_constructor () = match ctx.c.curclass.cl_super with
| None -> raise_typing_error "Current class does not have a super" p
| Some (c,params) ->
let fa = get_constructor_access c params p in
@@ -419,7 +419,7 @@ and display_expr ctx e_ast e dk mode with_type p =
()
end
| TConst TSuper ->
- begin match ctx.curclass.cl_super with
+ begin match ctx.c.curclass.cl_super with
| None -> ()
| Some (c,_) -> Display.ReferencePosition.set (snd c.cl_path,c.cl_name_pos,SKClass c);
end
@@ -476,7 +476,7 @@ and display_expr ctx e_ast e dk mode with_type p =
[]
end
| TConst TSuper ->
- begin match ctx.curclass.cl_super with
+ begin match ctx.c.curclass.cl_super with
| None -> []
| Some (c,_) -> [c.cl_name_pos]
end
@@ -490,7 +490,7 @@ and display_expr ctx e_ast e dk mode with_type p =
let pl = loop e in
raise_positions pl
| DMTypeDefinition ->
- raise_position_of_type e.etype
+ raise_position_of_type ctx e.etype
| DMDefault when not (!Parser.had_resume)->
let display_fields e_ast e1 so =
let l = match so with None -> 0 | Some s -> String.length s in
@@ -541,9 +541,9 @@ and display_expr ctx e_ast e dk mode with_type p =
raise_fields fields (CRField(item,e.epos,iterator,keyValueIterator)) (make_subject None (DisplayPosition.display_position#with_pos p))
let handle_display ctx e_ast dk mode with_type =
- let old = ctx.in_display,ctx.in_call_args in
- ctx.in_display <- true;
- ctx.in_call_args <- false;
+ let old = ctx.f.in_display,ctx.f.in_call_args in
+ ctx.f.in_display <- true;
+ ctx.f.in_call_args <- false;
let tpair t =
let ct = CompletionType.from_type (get_import_status ctx) t in
(t,ct)
@@ -595,10 +595,10 @@ let handle_display ctx e_ast dk mode with_type =
begin match mt.has_constructor with
| Yes -> true
| YesButPrivate ->
- if (Meta.has Meta.PrivateAccess ctx.meta) then true
+ if (Meta.has Meta.PrivateAccess ctx.f.meta) then true
else
begin
- match ctx.curclass.cl_kind with
+ match ctx.c.curclass.cl_kind with
| KAbstractImpl { a_path = (pack, name) } -> pack = mt.pack && name = mt.name
| _ -> false
end
@@ -610,7 +610,7 @@ let handle_display ctx e_ast dk mode with_type =
| Some(c,_) -> loop c
| None -> false
in
- loop ctx.curclass
+ loop ctx.c.curclass
end
| No -> false
| Maybe ->
@@ -640,7 +640,7 @@ let handle_display ctx e_ast dk mode with_type =
| (EField(_,"new",_),_), TFunction { tf_expr = { eexpr = TReturn (Some ({ eexpr = TNew _ } as e1))} } -> e1
| _ -> e
in
- let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.curfield.cf_meta in
+ let is_display_debug = Meta.has (Meta.Custom ":debug.display") ctx.f.curfield.cf_meta in
if is_display_debug then begin
print_endline (Printf.sprintf "expected type: %s" (WithType.to_string with_type));
print_endline (Printf.sprintf "typed expr:\n%s" (s_expr_ast true "" (s_type (print_context())) e));
@@ -657,14 +657,14 @@ let handle_display ctx e_ast dk mode with_type =
if is_display_debug then begin
print_endline (Printf.sprintf "cast expr:\n%s" (s_expr_ast true "" (s_type (print_context())) e));
end;
- ctx.in_display <- fst old;
- ctx.in_call_args <- snd old;
+ ctx.f.in_display <- fst old;
+ ctx.f.in_call_args <- snd old;
let f () = display_expr ctx e_ast e dk mode with_type p in
- if ctx.in_overload_call_args then begin
+ if ctx.f.in_overload_call_args then begin
try
f()
with DisplayException de ->
- ctx.delayed_display <- Some de;
+ ctx.g.delayed_display <- Some de;
e
end else
f()
diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml
index 2d7369ab281..d3ce2454564 100644
--- a/src/typing/typerEntry.ml
+++ b/src/typing/typerEntry.ml
@@ -13,9 +13,9 @@ let create com macros =
g = {
core_api = None;
macros = macros;
- type_patches = Hashtbl.create 0;
module_check_policies = [];
- delayed = [];
+ delayed = Array.init all_typer_passes_length (fun _ -> { tasks = []});
+ delayed_min_index = 0;
debug_delayed = [];
doinline = com.display.dms_inline && not (Common.defined com Define.NoInline);
retain_meta = Common.defined com Define.RetainUntypedMeta;
@@ -24,6 +24,9 @@ let create com macros =
complete = false;
type_hints = [];
load_only_cached_modules = false;
+ return_partial_type = false;
+ build_count = 0;
+ t_dynamic_def = t_dynamic;
do_macro = MacroContext.type_macro;
do_load_macro = MacroContext.load_macro';
do_load_module = TypeloadModule.load_module;
@@ -31,6 +34,7 @@ let create com macros =
get_build_info = InstanceBuilder.get_build_info;
do_format_string = format_string;
do_load_core_class = Typeload.load_core_class;
+ delayed_display = None;
};
m = {
curmod = null_module;
@@ -39,36 +43,19 @@ let create com macros =
enum_with_type = None;
module_using = [];
import_statements = [];
+ is_display_file = false;
};
- is_display_file = false;
- bypass_accessor = 0;
- meta = [];
- with_type_stack = [];
- call_argument_stack = [];
+ c = {
+ curclass = null_class;
+ tthis = t_dynamic;
+ get_build_infos = (fun() -> None);
+ };
+ f = TyperManager.create_ctx_f null_field;
+ e = TyperManager.create_ctx_e ();
pass = PBuildModule;
- macro_depth = 0;
- untyped = false;
- curfun = FunStatic;
- in_function = false;
- in_loop = false;
- in_display = false;
allow_inline = true;
allow_transform = true;
- get_build_infos = (fun() -> None);
- ret = mk_mono();
- locals = PMap.empty;
type_params = [];
- curclass = null_class;
- curfield = null_field;
- tthis = mk_mono();
- opened = [];
- vthis = None;
- in_call_args = false;
- in_overload_call_args = false;
- delayed_display = None;
- monomorphs = {
- perfunction = [];
- };
memory_marker = Typecore.memory_marker;
} in
ctx.g.std_types <- (try
@@ -89,7 +76,10 @@ let create com macros =
match t with
| TAbstractDecl a ->
(match snd a.a_path with
- | "Void" -> ctx.t.tvoid <- TAbstract (a,[]);
+ | "Void" ->
+ let t = TAbstract (a,[]) in
+ Type.unify t ctx.t.tvoid;
+ ctx.t.tvoid <- t;
| "Float" ->
let t = (TAbstract (a,[])) in
Type.unify t ctx.t.tfloat;
@@ -103,7 +93,7 @@ let create com macros =
Type.unify t ctx.t.tbool;
ctx.t.tbool <- t
| "Dynamic" ->
- t_dynamic_def := TAbstract(a,extract_param_types a.a_params);
+ ctx.g.t_dynamic_def <- TAbstract(a,extract_param_types a.a_params);
| "Null" ->
let mk_null t =
try
diff --git a/std/haxe/Log.hx b/std/haxe/Log.hx
index a0f4cd78fdd..08d8b7fcead 100644
--- a/std/haxe/Log.hx
+++ b/std/haxe/Log.hx
@@ -30,7 +30,7 @@ class Log {
/**
Format the output of `trace` before printing it.
**/
- public static function formatOutput(v:Dynamic, infos:PosInfos):String {
+ public static function formatOutput(v:Dynamic, infos:Null):String {
var str = Std.string(v);
if (infos == null)
return str;
diff --git a/std/haxe/ValueException.hx b/std/haxe/ValueException.hx
index 7cabec1b455..ec01892d8c3 100644
--- a/std/haxe/ValueException.hx
+++ b/std/haxe/ValueException.hx
@@ -18,7 +18,7 @@ class ValueException extends Exception {
/**
Thrown value.
**/
- public var value(default,null):Any;
+ public var value(default, null):Any;
public function new(value:Any, ?previous:Exception, ?native:Any):Void {
super(#if js js.Syntax.code('String({0})', value) #else Std.string(value) #end, previous, native);
@@ -35,4 +35,4 @@ class ValueException extends Exception {
override function unwrap():Any {
return value;
}
-}
\ No newline at end of file
+}
diff --git a/std/haxe/display/Display.hx b/std/haxe/display/Display.hx
index e6e03498e85..3de828f3d6f 100644
--- a/std/haxe/display/Display.hx
+++ b/std/haxe/display/Display.hx
@@ -98,7 +98,6 @@ class DisplayMethods {
TODO:
- finish completion
- - diagnostics
- codeLens
- workspaceSymbols ("project/symbol"?)
*/
diff --git a/std/haxe/display/Server.hx b/std/haxe/display/Server.hx
index 44ce700587e..0c20e60baf1 100644
--- a/std/haxe/display/Server.hx
+++ b/std/haxe/display/Server.hx
@@ -99,7 +99,7 @@ typedef JsonModule = {
final types:Array;
final file:String;
final sign:String;
- final dirty:Null;
+ final cacheState:Null;
final dependencies:Array;
final dependents:Array;
}
@@ -139,6 +139,9 @@ typedef HaxeContextMemoryResult = {
final syntaxCache:{
final size:Int;
};
+ final binaryCache:{
+ final size:Int;
+ };
final ?leaks:Array<{
final path:String;
final leaks:Array<{
diff --git a/std/haxe/hxb/WriterConfig.hx b/std/haxe/hxb/WriterConfig.hx
new file mode 100644
index 00000000000..7796dfdf228
--- /dev/null
+++ b/std/haxe/hxb/WriterConfig.hx
@@ -0,0 +1,51 @@
+package haxe.hxb;
+
+typedef WriterTargetConfig = {
+ /**
+ If `false`, this target is ignored by the writer.
+ **/
+ var ?generate:Null;
+
+ /**
+ Dot paths of modules or packages to be exluded from the archive.
+ **/
+ var ?exclude:Null>;
+
+ /**
+ Dot paths of modules or packages to be included in the archive. This takes priority
+ over exclude. By default, all modules that aren't explicitly excluded are
+ included.
+ **/
+ var ?include:Null>;
+
+ /**
+ The hxb version to target. By default, the version of the Haxe compiler itself
+ is targeted. See https://github.com/HaxeFoundation/haxe/issues/11505
+ **/
+ var ?hxbVersion:Null;
+
+ /**
+ If false, no documentation
+ **/
+ var ?generateDocumentation:Null;
+}
+
+typedef WriterConfig = {
+ /**
+ The file path for the archive. Occurrences of `$target` are replaced
+ by the name of the current target (js, hl, etc.).
+ **/
+ var archivePath:String;
+
+ /**
+ The configuration for the current target context. If it is `null`, all data
+ for the target context is generated.
+ **/
+ var ?targetConfig:Null;
+
+ /**
+ The configuration for the macro context. If it is `null`, all data for the
+ macro context is generated.
+ **/
+ var ?macroConfig:Null;
+}
diff --git a/std/haxe/macro/CompilationServer.hx b/std/haxe/macro/CompilationServer.hx
index 0cb50731bed..dbefb7ecdcf 100644
--- a/std/haxe/macro/CompilationServer.hx
+++ b/std/haxe/macro/CompilationServer.hx
@@ -52,10 +52,6 @@ enum abstract ModuleCheckPolicy(Int) {
of the current module file.
**/
var NoCheckShadowing = 3;
- /**
- Retype the module's contents if its file is invalidated. This is currently experimental.
- **/
- var Retype = 4;
}
enum abstract ContextOptions(Int) {
diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx
index a2d581985d0..854082e4e31 100644
--- a/std/haxe/macro/Compiler.hx
+++ b/std/haxe/macro/Compiler.hx
@@ -24,6 +24,7 @@ package haxe.macro;
import haxe.display.Display;
import haxe.macro.Expr;
+import haxe.hxb.WriterConfig;
/**
All these methods can be called for compiler configuration macros.
@@ -76,64 +77,9 @@ class Compiler {
}
#if (!neko && !eval)
- private static function typePatch(cl:String, f:String, stat:Bool, t:String) {}
-
- private static function metaPatch(meta:String, cl:String, f:String, stat:Bool) {}
-
private static function addGlobalMetadataImpl(pathFilter:String, meta:String, recursive:Bool, toTypes:Bool, toFields:Bool) {}
#end
- /**
- Removes a (static) field from a given class by name.
- An error is thrown when `className` or `field` is invalid.
- **/
- @:deprecated
- public static function removeField(className:String, field:String, ?isStatic:Bool) {
- if (!path.match(className))
- throw "Invalid " + className;
- if (!ident.match(field))
- throw "Invalid " + field;
- #if (neko || eval)
- Context.onAfterInitMacros(() -> load("type_patch", 4)(className, field, isStatic == true, null));
- #else
- typePatch(className, field, isStatic == true, null);
- #end
- }
-
- /**
- Set the type of a (static) field at a given class by name.
- An error is thrown when `className` or `field` is invalid.
- **/
- @:deprecated
- public static function setFieldType(className:String, field:String, type:String, ?isStatic:Bool) {
- if (!path.match(className))
- throw "Invalid " + className;
- if (!ident.match((field.charAt(0) == "$") ? field.substr(1) : field))
- throw "Invalid " + field;
- #if (neko || eval)
- Context.onAfterInitMacros(() -> load("type_patch", 4)(className, field, isStatic == true, type));
- #else
- typePatch(className, field, isStatic == true, type);
- #end
- }
-
- /**
- Add metadata to a (static) field or class by name.
- An error is thrown when `className` or `field` is invalid.
- **/
- @:deprecated
- public static function addMetadata(meta:String, className:String, ?field:String, ?isStatic:Bool) {
- if (!path.match(className))
- throw "Invalid " + className;
- if (field != null && !ident.match(field))
- throw "Invalid " + field;
- #if (neko || eval)
- Context.onAfterInitMacros(() -> load("meta_patch", 4)(meta, className, field, isStatic == true));
- #else
- metaPatch(meta, className, field, isStatic == true);
- #end
- }
-
/**
Add a class path where ".hx" source files or packages (sub-directories) can be found.
@@ -373,61 +319,6 @@ class Compiler {
});
}
- /**
- Load a type patch file that can modify the field types within declared classes and enums.
- **/
- public static function patchTypes(file:String):Void {
- var file = Context.resolvePath(file);
- var f = sys.io.File.read(file, true);
- try {
- while (true) {
- var r = StringTools.trim(f.readLine());
- if (r == "" || r.substr(0, 2) == "//")
- continue;
- if (StringTools.endsWith(r, ";"))
- r = r.substr(0, -1);
- if (r.charAt(0) == "-") {
- r = r.substr(1);
- var isStatic = StringTools.startsWith(r, "static ");
- if (isStatic)
- r = r.substr(7);
- var p = r.split(".");
- var field = p.pop();
- removeField(p.join("."), field, isStatic);
- continue;
- }
- if (r.charAt(0) == "@") {
- var rp = r.split(" ");
- var type = rp.pop();
- var isStatic = rp[rp.length - 1] == "static";
- if (isStatic)
- rp.pop();
- var meta = rp.join(" ");
- var p = type.split(".");
- var field = if (p.length > 1 && p[p.length - 2].charAt(0) >= "a") null else p.pop();
- addMetadata(meta, p.join("."), field, isStatic);
- continue;
- }
- if (StringTools.startsWith(r, "enum ")) {
- define("enumAbstract:" + r.substr(5));
- continue;
- }
- var rp = r.split(" : ");
- if (rp.length > 1) {
- r = rp.shift();
- var isStatic = StringTools.startsWith(r, "static ");
- if (isStatic)
- r = r.substr(7);
- var p = r.split(".");
- var field = p.pop();
- setFieldType(p.join("."), field, rp.join(" : "), isStatic);
- continue;
- }
- throw "Invalid type patch " + r;
- }
- } catch (e:haxe.io.Eof) {}
- }
-
/**
Marks types or packages to be kept by DCE.
@@ -486,6 +377,12 @@ class Compiler {
#end
}
+ @:deprecated
+ public static function addMetadata(meta:String, className:String, ?field:String, ?isStatic:Bool) {
+ var pathFilter = field == null ? className : '$className.$field';
+ addGlobalMetadata(pathFilter, meta, false, field == null, field != null);
+ }
+
/**
Reference a json file describing user-defined metadata
See https://github.com/HaxeFoundation/haxe/blob/development/src-json/meta.json
@@ -576,6 +473,40 @@ class Compiler {
}
}
#end
+
+ /**
+ Gets the current hxb writer configuration, if any.
+ **/
+ static public function getHxbWriterConfiguration():Null {
+ #if macro
+ return load("get_hxb_writer_config", 0)();
+ #else
+ return null;
+ #end
+ }
+
+ /**
+ Sets the hxb writer configuration to `config`. If no hxb writer configuration
+ exists, it is created.
+
+ The intended usage is
+
+ ```
+ var config = Compiler.getHxbWriterConfiguration();
+ config.archivePath = "newPath.zip";
+ // Other changes
+ Compiler.setHxbWriterConfiguration(config);
+ ```
+
+ If `config` is `null`, hxb writing is disabled.
+
+ @see haxe.hxb.WriterConfig
+ **/
+ static public function setHxbWriterConfiguration(config:Null) {
+ #if macro
+ load("set_hxb_writer_config", 1)(config);
+ #end
+ }
}
enum abstract IncludePosition(String) from String to String {
diff --git a/std/haxe/macro/Printer.hx b/std/haxe/macro/Printer.hx
index bf43c742be0..bce266f7239 100644
--- a/std/haxe/macro/Printer.hx
+++ b/std/haxe/macro/Printer.hx
@@ -200,7 +200,7 @@ class Printer {
return (tpd.meta != null && tpd.meta.length > 0 ? tpd.meta.map(printMetadata).join(" ") + " " : "")
+ tpd.name
+ (tpd.params != null && tpd.params.length > 0 ? "<" + tpd.params.map(printTypeParamDecl).join(", ") + ">" : "")
- + (tpd.constraints != null && tpd.constraints.length > 0 ? ":(" + tpd.constraints.map(printComplexType).join(", ") + ")" : "")
+ + (tpd.constraints != null && tpd.constraints.length > 0 ? ":(" + tpd.constraints.map(printComplexType).join(" & ") + ")" : "")
+ (tpd.defaultType != null ? "=" + printComplexType(tpd.defaultType) : "");
public function printFunctionArg(arg:FunctionArg)
diff --git a/std/jvm/_std/haxe/ds/IntMap.hx b/std/jvm/_std/haxe/ds/IntMap.hx
new file mode 100644
index 00000000000..9ae196cb388
--- /dev/null
+++ b/std/jvm/_std/haxe/ds/IntMap.hx
@@ -0,0 +1,91 @@
+/*
+ * Copyright (C)2005-2019 Haxe Foundation
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+ * DEALINGS IN THE SOFTWARE.
+ */
+
+package haxe.ds;
+
+@:coreApi
+class IntMap implements haxe.Constraints.IMap {
+ var hashMap:java.util.HashMap;
+
+ @:overload
+ public function new():Void {
+ hashMap = new java.util.HashMap();
+ }
+
+ @:overload
+ function new(hashMap:java.util.HashMap):Void {
+ this.hashMap = hashMap;
+ }
+
+ public function set(key:Int, value:T):Void {
+ hashMap.put(key, value);
+ }
+
+ public function get(key:Int):Null {
+ return hashMap.get(key);
+ }
+
+ public function exists(key:Int):Bool {
+ return hashMap.containsKey(key);
+ }
+
+ public function remove(key:Int):Bool {
+ var has = exists(key);
+ hashMap.remove(key);
+ return has;
+ }
+
+ public inline function keys():Iterator {
+ return hashMap.keySet().iterator();
+ }
+
+ @:runtime public inline function keyValueIterator():KeyValueIterator {
+ return new haxe.iterators.MapKeyValueIterator(this);
+ }
+
+ public inline function iterator():Iterator {
+ return hashMap.values().iterator();
+ }
+
+ public function copy():IntMap {
+ return new IntMap(hashMap.clone());
+ }
+
+ public function toString():String {
+ var s = new StringBuf();
+ s.add("[");
+ var it = keys();
+ for (i in it) {
+ s.add(Std.string(i));
+ s.add(" => ");
+ s.add(Std.string(get(i)));
+ if (it.hasNext())
+ s.add(", ");
+ }
+ s.add("]");
+ return s.toString();
+ }
+
+ public function clear():Void {
+ hashMap.clear();
+ }
+}
diff --git a/tests/Brewfile b/tests/Brewfile
index 2e592102571..ac7f3f61b01 100644
--- a/tests/Brewfile
+++ b/tests/Brewfile
@@ -1,7 +1,6 @@
-brew "ocaml"
-brew "camlp5"
brew "opam"
brew "ninja"
-brew "awscli"
brew "cmake"
-brew "pkg-config"
\ No newline at end of file
+brew "pkg-config"
+brew "libunistring"
+brew "cpanminus"
\ No newline at end of file
diff --git a/tests/display/src/BaseDisplayTestContext.hx b/tests/display/src/BaseDisplayTestContext.hx
new file mode 100644
index 00000000000..803d8707d1f
--- /dev/null
+++ b/tests/display/src/BaseDisplayTestContext.hx
@@ -0,0 +1,56 @@
+import haxe.io.Bytes;
+
+using StringTools;
+
+import Types;
+
+class BaseDisplayTestContext {
+ static var haxeServer = haxeserver.HaxeServerSync.launch("haxe", []);
+
+ var markers:Map;
+ var fieldName:String;
+
+ public final source:File;
+
+ public function new(path:String, fieldName:String, source:String, markers:Map) {
+ this.fieldName = fieldName;
+ this.source = new File(path, source);
+ this.markers = markers;
+ }
+
+ public function pos(id:Int):Position {
+ var r = markers[id];
+ if (r == null)
+ throw "No such marker: " + id;
+ return new Position(r);
+ }
+
+ public function range(pos1:Int, pos2:Int) {
+ return normalizePath(source.formatRange(pos(pos1), pos(pos2)));
+ }
+
+ public function hasErrorMessage(f:()->Void, message:String) {
+ return try {
+ f();
+ false;
+ } catch (exc:HaxeInvocationException) {
+ return exc.message.indexOf(message) != -1;
+ }
+ }
+
+ static public function runHaxe(args:Array, ?stdin:String) {
+ return haxeServer.rawRequest(args, stdin == null ? null : Bytes.ofString(stdin));
+ }
+
+ static function normalizePath(p:String):String {
+ if (!haxe.io.Path.isAbsolute(p)) {
+ p = Sys.getCwd() + p;
+ }
+ if (Sys.systemName() == "Windows") {
+ // on windows, haxe returns paths with backslashes, drive letter uppercased
+ p = p.substr(0, 1).toUpperCase() + p.substr(1);
+ p = p.replace("/", "\\");
+ }
+ return p;
+ }
+}
diff --git a/tests/display/src/DisplayPrinter.hx b/tests/display/src/DisplayPrinter.hx
new file mode 100644
index 00000000000..138f0014e77
--- /dev/null
+++ b/tests/display/src/DisplayPrinter.hx
@@ -0,0 +1,159 @@
+import haxe.display.Display;
+import haxe.display.JsonModuleTypes;
+
+using Lambda;
+
+class DisplayPrinter {
+ var indent = "";
+ public function new() {}
+
+ public function printPath(path:JsonTypePath) {
+ final qualified = !(path.moduleName == "StdTypes" && path.pack.length == 0);
+ final isSubType = path.moduleName != path.typeName;
+ final isToplevelType = path.pack.length == 0 && !isSubType;
+
+ if (isToplevelType && path.importStatus == Shadowed) {
+ path.pack.push("std");
+ }
+
+ function printFullPath() {
+ var printedPath = if (isSubType) path.typeName else path.moduleName;
+ if (path.pack.length > 0) {
+ printedPath = path.pack.join(".") + "." + printedPath;
+ }
+ return printedPath;
+ }
+
+ return if (qualified) printFullPath() else path.typeName;
+ }
+
+ public function printPathWithParams(path:JsonTypePathWithParams) {
+ final s = printPath(path.path);
+ if (path.params.length == 0) {
+ return s;
+ } else {
+ var sparams = path.params.map(printType).join(", ");
+ return '$s<$sparams>';
+ }
+ }
+
+ public function printType(t:JsonType) {
+ return switch t.kind {
+ case TMono: "Unknown<0>";
+ case TInst | TEnum | TType | TAbstract: printPathWithParams(t.args);
+ case TDynamic:
+ if (t.args == null) {
+ "Dynamic";
+ } else {
+ final s = printTypeRec(t.args);
+ 'Dynamic<$s>';
+ }
+ case TAnonymous:
+ final fields = t.args.fields;
+ final s = [
+ for (field in fields) {
+ var prefix = if (hasMeta(field.meta, ":optional")) "?" else "";
+ '$prefix${field.name} : ${printTypeRec(field.type)}';
+ }
+ ].join(", ");
+ s == '' ? '{ }' : '{ $s }';
+ case TFun:
+ var hasNamed = false;
+ function printFunctionArgument(arg:JsonFunctionArgument) {
+ if (arg.name != "") {
+ hasNamed = true;
+ }
+ return this.printFunctionArgument(arg);
+ }
+ final args = t.args.args.map(printFunctionArgument);
+ var r = printTypeRec(t.args.ret);
+ if (t.args.ret.kind == TFun) r = '($r)';
+ switch args.length {
+ case 0: '() -> $r';
+ case 1 if (hasNamed): '(${args[0]}) -> $r';
+ case 1: '${args[0]} -> $r';
+ case _: '(${args.join(", ")}) -> $r';
+ }
+ }
+ }
+
+ function printTypeRec(t:JsonType) {
+ final old = indent;
+ indent += " ";
+ final t = printType(t);
+ indent = old;
+ return t;
+ }
+
+ public function printFunctionArgument(arg:JsonFunctionArgument):String {
+ final nullRemoval = removeNulls(arg.t);
+ final concreteType = if (!arg.opt) arg.t else nullRemoval.type;
+
+ var argument = (if (arg.opt && arg.value == null) "?" else "") + arg.name;
+ if (concreteType.kind != TMono || arg.name == "") {
+ var hint = printTypeRec(concreteType);
+ if (concreteType.kind == TFun) hint = '($hint)';
+ argument += (arg.name == "" ? "" : " : ") + hint;
+ }
+ if (arg.value != null) {
+ argument += " = " + arg.value.string;
+ }
+ return argument;
+ }
+
+ public function printSignatureFunctionArgument(arg:JsonFunctionArgument):String {
+ final nullRemoval = removeNulls(arg.t);
+ final concreteType = if (!arg.opt) arg.t else nullRemoval.type;
+
+ var argument = (if (arg.opt && arg.value == null) "?" else "") + arg.name;
+ var hint = printTypeRec(concreteType);
+ if (concreteType.kind == TFun) hint = '($hint)';
+ argument += ":" + hint;
+ if (arg.value != null) {
+ argument += " = " + arg.value.string;
+ }
+ return argument;
+ }
+
+ public function printCallArguments(signature:JsonFunctionSignature, printFunctionArgument:JsonFunctionArgument->String) {
+ return "(" + signature.args.map(printFunctionArgument).join(", ") + ")";
+ }
+
+ function removeNulls(type:JsonType, nullable:Bool = false):{type:JsonType, nullable:Bool} {
+ switch type.kind {
+ case TAbstract:
+ final path:JsonTypePathWithParams = type.args;
+ if (getDotPath(type) == "StdTypes.Null") {
+ if (path.params != null && path.params[0] != null) {
+ return removeNulls(path.params[0], true);
+ }
+ }
+ case _:
+ }
+ return {type: type, nullable: nullable};
+ }
+
+ inline function isVoid(type:JsonType) {
+ return getDotPath(type) == "StdTypes.Void";
+ }
+
+ function getDotPath(type:JsonType):Null {
+ final path = getTypePath(type);
+ if (path == null) {
+ return null;
+ }
+ return printPath(path.path);
+ }
+
+ function getTypePath(type:JsonType):Null {
+ return switch type.kind {
+ case null: null;
+ case TInst | TEnum | TType | TAbstract: type.args;
+ case _: null;
+ }
+ }
+
+ function hasMeta(?meta:JsonMetadata, name:String) {
+ return meta != null && meta.exists(meta -> meta.name == cast name);
+ }
+}
diff --git a/tests/display/src/DisplayTestCase.hx b/tests/display/src/DisplayTestCase.hx
index 09778be759a..eae90d247f9 100644
--- a/tests/display/src/DisplayTestCase.hx
+++ b/tests/display/src/DisplayTestCase.hx
@@ -1,114 +1,5 @@
-import haxe.display.Position.Range;
-import utest.Assert;
-import Types;
-
-using Lambda;
-
-@:autoBuild(Macro.buildTestCase())
-class DisplayTestCase implements utest.ITest {
- var ctx:DisplayTestContext;
-
- public function new() {}
-
- // api
- inline function pos(name)
- return ctx.pos(name);
-
- inline function fields(pos)
- return ctx.fields(pos);
-
- inline function toplevel(pos)
- return ctx.toplevel(pos);
-
- inline function type(pos)
- return ctx.type(pos);
-
- inline function position(pos)
- return ctx.position(pos);
-
- inline function usage(pos)
- return ctx.usage(pos);
-
- inline function range(pos1, pos2)
- return ctx.range(pos1, pos2);
-
- inline function signature(pos1)
- return ctx.signature(pos1);
-
- inline function doc(pos1)
- return ctx.doc(pos1);
-
- inline function metadataDoc(pos1)
- return ctx.metadataDoc(pos1);
-
- inline function diagnostics()
- return ctx.diagnostics();
-
- inline function noCompletionPoint(f)
- return ctx.hasErrorMessage(f, "No completion point");
-
- inline function typeNotFound(f, typeName)
- return ctx.hasErrorMessage(f, "Type not found : " + typeName);
-
- function assert(v:Bool)
- Assert.isTrue(v);
-
- function eq(expected:T, actual:T, ?pos:haxe.PosInfos) {
- Assert.equals(expected, actual, pos);
- }
-
- function arrayEq(expected:Array, actual:Array, ?pos:haxe.PosInfos) {
- Assert.same(expected, actual, pos);
- }
-
- function arrayCheck(expected:Array, actual:Array, f:T->String, ?pos:haxe.PosInfos) {
- var expected = [for (expected in expected) f(expected) => expected];
- for (actual in actual) {
- var key = f(actual);
- Assert.isTrue(expected.exists(key), "Result not part of expected Array: " + Std.string(actual), pos);
- expected.remove(key);
- }
-
- for (expected in expected) {
- Assert.fail("Expected result was not part of actual Array: " + Std.string(expected), pos);
- return;
- }
- }
-
- function hasField(a:Array, name:String, type:String, ?kind:String):Bool {
- return a.exists(function(t) return t.type == type && t.name == name && (kind == null || t.kind == kind));
- }
-
- function hasToplevel(a:Array, kind:String, name:String, ?type:String = null):Bool {
- return a.exists(function(t) return t.kind == kind && t.name == name && (type == null || t.type == type));
- }
-
- function hasPath(a:Array, name:String):Bool {
- return a.exists(function(t) return t.name == name);
- }
-
- function diagnosticsRange(start:Position, end:Position):Range {
- var range = ctx.source.findRange(start, end);
- // this is probably correct...?
- range.start.character--;
- range.end.character--;
- return range;
- }
-
- function sigEq(arg:Int, params:Array>, sig:SignatureHelp, ?pos:haxe.PosInfos) {
- eq(arg, sig.activeParameter, pos);
- eq(params.length, sig.signatures.length, pos);
- for (i in 0...params.length) {
- var sigInf = sig.signatures[i];
- var args = params[i];
- eq(sigInf.parameters.length, args.length, pos);
- for (i in 0...args.length) {
- eq(sigInf.parameters[i].label, args[i], pos);
- }
- }
- }
-
- function report(message, pos:haxe.PosInfos) {
- Assert.fail(message, pos);
- }
-}
+#if (display.protocol == "jsonrpc")
+typedef DisplayTestCase = RpcDisplayTestCase;
+#else
+typedef DisplayTestCase = XmlDisplayTestCase;
+#end
diff --git a/tests/display/src/DisplayTestContext.hx b/tests/display/src/DisplayTestContext.hx
index 8694a115be9..feacb1f4527 100644
--- a/tests/display/src/DisplayTestContext.hx
+++ b/tests/display/src/DisplayTestContext.hx
@@ -1,209 +1,5 @@
-import haxe.io.Bytes;
-import haxe.io.BytesBuffer;
-
-using StringTools;
-
-import Types;
-
-class HaxeInvocationException {
- public var message:String;
- public var fieldName:String;
- public var arguments:Array;
- public var source:String;
-
- public function new(message:String, fieldName:String, arguments:Array, source:String) {
- this.message = message;
- this.fieldName = fieldName;
- this.arguments = arguments;
- this.source = source;
- }
-
- public function toString() {
- return 'HaxeInvocationException($message, $fieldName, $arguments, $source])';
- }
-}
-
-class DisplayTestContext {
- static var haxeServer = haxeserver.HaxeServerSync.launch("haxe", []);
-
- var markers:Map;
- var fieldName:String;
-
- public final source:File;
-
- public function new(path:String, fieldName:String, source:String, markers:Map) {
- this.fieldName = fieldName;
- this.source = new File(path, source);
- this.markers = markers;
- }
-
- public function pos(id:Int):Position {
- var r = markers[id];
- if (r == null)
- throw "No such marker: " + id;
- return new Position(r);
- }
-
- public function range(pos1:Int, pos2:Int) {
- return normalizePath(source.formatRange(pos(pos1), pos(pos2)));
- }
-
- public function fields(pos:Position):Array {
- return extractFields(callHaxe('$pos'));
- }
-
- public function signatures(pos:Position):Array {
- return extractSignatures(callHaxe('$pos'));
- }
-
- public function toplevel(pos:Position):Array {
- return extractToplevel(callHaxe('$pos@toplevel'));
- }
-
- public function type(pos:Position):String {
- return extractType(callHaxe('$pos@type'));
- }
-
- public function positions(pos:Position):Array {
- return extractPositions(callHaxe('$pos@position'));
- }
-
- public function position(pos:Position):String {
- return positions(pos)[0];
- }
-
- public function usage(pos:Position):Array {
- return extractPositions(callHaxe('$pos@usage'));
- }
-
- public function documentSymbols():Array {
- return haxe.Json.parse(callHaxe("0@module-symbols"))[0].symbols;
- }
-
- public function signature(pos:Position):SignatureHelp {
- return haxe.Json.parse(callHaxe('$pos@signature'));
- }
-
- public function doc(pos:Position):String {
- return extractDoc(callHaxe('$pos@type'));
- }
-
- public function metadataDoc(pos:Position):String {
- return extractMetadata(callHaxe('$pos@type'));
- }
-
- public function diagnostics():Array> {
- var result = haxe.Json.parse(callHaxe('0@diagnostics'))[0];
- return if (result == null) [] else result.diagnostics;
- }
-
- public function hasErrorMessage(f:()->Void, message:String) {
- return try {
- f();
- false;
- } catch (exc:HaxeInvocationException) {
- return exc.message.indexOf(message) != -1;
- }
- }
-
- function callHaxe(displayPart:String) {
- var args = ["--display", source.path + "@" + displayPart];
- var result = runHaxe(args, source.content);
- if (result.hasError || result.stderr == "") {
- throw new HaxeInvocationException(result.stderr, fieldName, args, source.content);
- }
- return result.stderr;
- }
-
- static public function runHaxe(args:Array, ?stdin:String) {
- return haxeServer.rawRequest(args, stdin == null ? null : Bytes.ofString(stdin));
- }
-
- static function extractType(result:String) {
- var xml = Xml.parse(result);
- xml = xml.firstElement();
- if (xml.nodeName != "type") {
- return null;
- }
- return StringTools.trim(xml.firstChild().nodeValue);
- }
-
- static function extractSignatures(result:String) {
- var xml = Xml.parse('$result');
- xml = xml.firstElement();
- var ret = [];
- for (xml in xml.elementsNamed("type")) {
- ret.push(StringTools.trim(xml.firstChild().nodeValue));
- }
- return ret;
- }
-
- static function extractPositions(result:String) {
- var xml = Xml.parse(result);
- xml = xml.firstElement();
- if (xml.nodeName != "list") {
- return null;
- }
- var ret = [];
- for (xml in xml.elementsNamed("pos")) {
- ret.push(normalizePath(xml.firstChild().nodeValue.trim()));
- }
- return ret;
- }
-
- static function extractToplevel(result:String) {
- var xml = Xml.parse(result);
- xml = xml.firstElement();
- if (xml.nodeName != "il") {
- return null;
- }
- var ret = [];
- for (xml in xml.elementsNamed("i")) {
- ret.push({kind: xml.get("k"), type: xml.get("t"), name: xml.firstChild().nodeValue});
- }
- return ret;
- }
-
- static function extractFields(result:String) {
- var xml = Xml.parse(result);
- xml = xml.firstElement();
- if (xml.nodeName != "list") {
- return null;
- }
- var ret = [];
- for (xml in xml.elementsNamed("i")) {
- ret.push({name: xml.get("n"), type: xml.firstElement().firstChild().nodeValue, kind: xml.get("k")});
- }
- return ret;
- }
-
- static function extractDoc(result:String) {
- var xml = Xml.parse(result);
- xml = xml.firstElement();
- if (xml.nodeName != "type") {
- return null;
- }
- return StringTools.trim(xml.get('d'));
- }
-
- static function extractMetadata(result:String) {
- var xml = Xml.parse(result);
- xml = xml.firstElement();
- if (xml.nodeName != "metadata") {
- return null;
- }
- return xml.firstChild().nodeValue;
- }
-
- static function normalizePath(p:String):String {
- if (!haxe.io.Path.isAbsolute(p)) {
- p = Sys.getCwd() + p;
- }
- if (Sys.systemName() == "Windows") {
- // on windows, haxe returns paths with backslashes, drive letter uppercased
- p = p.substr(0, 1).toUpperCase() + p.substr(1);
- p = p.replace("/", "\\");
- }
- return p;
- }
-}
+#if (display.protocol == "jsonrpc")
+typedef DisplayTestContext = RpcDisplayTestContext;
+#else
+typedef DisplayTestContext = XmlDisplayTestContext;
+#end
diff --git a/tests/display/src/HaxeInvocationException.hx b/tests/display/src/HaxeInvocationException.hx
new file mode 100644
index 00000000000..02b1abf4d1b
--- /dev/null
+++ b/tests/display/src/HaxeInvocationException.hx
@@ -0,0 +1,18 @@
+class HaxeInvocationException {
+ public var message:String;
+ public var fieldName:String;
+ public var arguments:Array;
+ public var source:String;
+
+ public function new(message:String, fieldName:String, arguments:Array, source:String) {
+ this.message = message;
+ this.fieldName = fieldName;
+ this.arguments = arguments;
+ this.source = source;
+ }
+
+ public function toString() {
+ return 'HaxeInvocationException($message, $fieldName, $arguments, $source])';
+ }
+}
+
diff --git a/tests/display/src/Main.hx b/tests/display/src/Main.hx
index 3ad65be92c2..87388a2fb4c 100644
--- a/tests/display/src/Main.hx
+++ b/tests/display/src/Main.hx
@@ -11,9 +11,9 @@ class Main {
report.displayHeader = AlwaysShowHeader;
report.displaySuccessResults = NeverShowSuccessResults;
- var haxeServer = @:privateAccess DisplayTestContext.haxeServer;
+ var haxeServer = @:privateAccess BaseDisplayTestContext.haxeServer;
haxeServer.setDefaultRequestArguments(["-cp", "src", "-cp", "src-shared", "--no-output"]);
- DisplayTestContext.runHaxe([]);
+ BaseDisplayTestContext.runHaxe([]);
runner.run();
haxeServer.close();
}
diff --git a/tests/display/src/RpcDisplayTestCase.hx b/tests/display/src/RpcDisplayTestCase.hx
new file mode 100644
index 00000000000..75a2010ab7a
--- /dev/null
+++ b/tests/display/src/RpcDisplayTestCase.hx
@@ -0,0 +1,180 @@
+import haxe.display.Display;
+import haxe.display.Position.Range;
+import utest.Assert;
+import Types;
+
+using Lambda;
+
+@:autoBuild(Macro.buildTestCase())
+class RpcDisplayTestCase implements utest.ITest {
+ var ctx:RpcDisplayTestContext;
+
+ public function new() {}
+
+ // api
+ inline function pos(name)
+ return ctx.pos(name);
+
+ inline function fields(pos)
+ return ctx.fields(pos);
+
+ inline function toplevel(pos)
+ return ctx.toplevel(pos);
+
+ inline function type(pos)
+ return ctx.type(pos);
+
+ inline function position(pos)
+ return ctx.position(pos);
+
+ inline function usage(pos)
+ return ctx.usage(pos);
+
+ inline function range(pos1, pos2)
+ return ctx.range(pos1, pos2);
+
+ inline function signature(pos1)
+ return ctx.signature(pos1);
+
+ inline function doc(pos1)
+ return ctx.doc(pos1);
+
+ inline function metadataDoc(pos1)
+ return ctx.metadataDoc(pos1);
+
+ inline function diagnostics()
+ return ctx.diagnostics();
+
+ inline function noCompletionPoint(f)
+ return ctx.hasErrorMessage(f, "No completion point");
+
+ inline function typeNotFound(f, typeName)
+ return ctx.hasErrorMessage(f, "Type not found : " + typeName);
+
+ function assert(v:Bool)
+ Assert.isTrue(v);
+
+ function eq(expected:T, actual:T, ?pos:haxe.PosInfos) {
+ Assert.equals(expected, actual, pos);
+ }
+
+ function arrayEq(expected:Array, actual:Array, ?pos:haxe.PosInfos) {
+ Assert.same(expected, actual, pos);
+ }
+
+ function arrayCheck(expected:Array, actual:Array, f:T->String, ?pos:haxe.PosInfos) {
+ var expected = [for (expected in expected) f(expected) => expected];
+ for (actual in actual) {
+ var key = f(actual);
+ Assert.isTrue(expected.exists(key), "Result not part of expected Array: " + Std.string(actual), pos);
+ expected.remove(key);
+ }
+
+ for (expected in expected) {
+ Assert.fail("Expected result was not part of actual Array: " + Std.string(expected), pos);
+ return;
+ }
+ }
+
+ function hasField(a:Array>, name:String, type:String, ?kind:String):Bool {
+ return a.exists(t -> isField(t, name, type, kind));
+ }
+
+ function isField(t:DisplayItem, name:String, ?type:String, ?kind:String):Bool {
+ return switch (t.kind) {
+ case ClassField:
+ var f = t.args.field;
+ if (f.name != name) return false;
+
+ // Oh dear...
+ switch [kind, f.kind.kind] {
+ case [null, _]:
+ case ["static", _]: if (f.scope != Static) return false;
+ case ["member", _]: if (f.scope != Member) return false;
+ case ["method", FMethod]:
+ case ["var", FVar]:
+ case _: return false;
+ }
+
+ if (type == null || f.type.args.path.typeName == type) return true;
+ return type == ctx.displayPrinter.printType(f.type);
+ case EnumField:
+ if (kind != null && kind != "enum") return false;
+ t.args.field.name == name;
+ case EnumAbstractField:
+ if (kind != null && kind != "var") return false;
+ t.args.field.name == name;
+ case Module:
+ if (kind != null && kind != "type") return false;
+ t.args.path.moduleName == name;
+ case Type:
+ if (kind != null && kind != "type") return false;
+ t.args.path.typeName == name;
+ case TypeParameter:
+ if (kind != null && kind != "type") return false;
+ t.args.name == name;
+ case Package:
+ if (kind != null && kind != "package") return false;
+ t.args.path.pack[0] == name;
+ case Local:
+ if (kind != null && kind != "local") return false;
+ t.args.name == name;
+ case Literal:
+ if (kind != null && kind != "literal") return false;
+ t.args.name == name;
+ case Keyword:
+ if (kind != null && kind != "keyword") return false;
+ t.args.name == name;
+ case Metadata:
+ if (kind != null && kind != "metadata") return false;
+ t.args.name == name;
+ case _:
+ false;
+ }
+ }
+
+ function hasToplevel(a:Array>, kind:String, name:String, ?type:String = null):Bool {
+ return a.exists(t -> isToplevel(t, name, type, kind));
+ }
+
+ function isToplevel(t:DisplayItem, name:String, ?type:String = null, ?kind:String = null):Bool {
+ return isField(t, name, type, kind);
+ }
+
+ function hasPath(a:Array>, name:String):Bool {
+ return a.exists(function(t) {
+ return switch (t.kind) {
+ case ClassField: t.args.field.name == name;
+ case Type: t.args.path.typeName == name;
+ case Module: t.args.path.moduleName == name;
+ case Metadata: t.args.name == name;
+ case _: false;
+ }
+ });
+ }
+
+ function diagnosticsRange(start:Position, end:Position):Range {
+ var range = ctx.source.findRange(start, end);
+ // this is probably correct...?
+ range.start.character--;
+ range.end.character--;
+ return range;
+ }
+
+ function sigEq(arg:Int, params:Array>, sig:SignatureHelp, ?pos:haxe.PosInfos) {
+ eq(arg, sig.activeParameter, pos);
+ eq(params.length, sig.signatures.length, pos);
+ for (i in 0...params.length) {
+ var sigInf = sig.signatures[i];
+ var args = params[i];
+ eq(sigInf.parameters.length, args.length, pos);
+ for (i in 0...args.length) {
+ eq(sigInf.parameters[i].label, args[i], pos);
+ }
+ }
+ }
+
+ function report(message, pos:haxe.PosInfos) {
+ Assert.fail(message, pos);
+ }
+}
diff --git a/tests/display/src/RpcDisplayTestContext.hx b/tests/display/src/RpcDisplayTestContext.hx
new file mode 100644
index 00000000000..bc766ea0a8f
--- /dev/null
+++ b/tests/display/src/RpcDisplayTestContext.hx
@@ -0,0 +1,165 @@
+import haxe.Json;
+import haxe.display.Display;
+import haxe.display.FsPath;
+import haxe.display.Position;
+import haxe.display.Protocol;
+
+using StringTools;
+
+import Types;
+
+class RpcDisplayTestContext extends BaseDisplayTestContext {
+ public var displayPrinter(default,null):DisplayPrinter;
+
+ public function new(path:String, fieldName:String, source:String, markers:Map) {
+ super(path, fieldName, source, markers);
+ displayPrinter = new DisplayPrinter();
+ }
+
+ public function fields(pos:Position):Array> {
+ return extractFields(callDisplay(DisplayMethods.Completion, {
+ file: new FsPath(source.path),
+ offset: pos,
+ wasAutoTriggered: false
+ }));
+ }
+
+ public function toplevel(pos:Position):Array> {
+ return fields(pos);
+ }
+
+ public function type(pos:Position):String {
+ return extractType(callDisplay(DisplayMethods.Hover, {
+ file: new FsPath(source.path),
+ offset: pos,
+ }).result);
+ }
+
+ public function positions(pos:Position):Array {
+ return extractPositions(callDisplay(DisplayMethods.GotoDefinition, {
+ file: new FsPath(source.path),
+ offset: pos,
+ }).result);
+ }
+
+ public function position(pos:Position):String {
+ return positions(pos)[0];
+ }
+
+ public function usage(pos:Position):Array {
+ return extractPositions(callDisplay(DisplayMethods.FindReferences, {
+ file: new FsPath(source.path),
+ offset: pos,
+ }).result);
+ }
+
+ // TODO: migrate module-symbols to json rpc and update here
+ public function documentSymbols():Array {
+ return Json.parse(callHaxe("0@module-symbols"))[0].symbols;
+ }
+
+ public function signature(pos:Position):SignatureHelp {
+ var res = callDisplay(DisplayMethods.SignatureHelp, {
+ file: new FsPath(source.path),
+ offset: pos,
+ wasAutoTriggered: false
+ }).result;
+
+ return {
+ signatures: res.signatures.map(s -> {
+ label: displayPrinter.printCallArguments(s, displayPrinter.printSignatureFunctionArgument) + ':' + displayPrinter.printType(s.ret),
+ documentation: s.documentation,
+ parameters: s.args.map(a -> {
+ label: displayPrinter.printSignatureFunctionArgument(a),
+ documentation: null
+ })
+ }),
+ activeParameter: res.activeParameter,
+ activeSignature: res.activeSignature
+ };
+ }
+
+ public function doc(pos:Position):String {
+ return extractDoc(callDisplay(DisplayMethods.Hover, {
+ file: new FsPath(source.path),
+ offset: pos,
+ }).result);
+ }
+
+ public function metadataDoc(pos:Position):String {
+ return extractMetadata(callDisplay(DisplayMethods.Hover, {
+ file: new FsPath(source.path),
+ offset: pos,
+ }).result);
+ }
+
+ public function diagnostics():Array> {
+ var result = callDisplay(DisplayMethods.Diagnostics, {
+ file: new FsPath(source.path),
+ }).result;
+ return if (result == null || result.length == 0) [] else cast result[0].diagnostics;
+ }
+
+ // Can be removed once module-symbols is migrated to json rpc
+ function callHaxe(displayPart:String) {
+ var args = ["--display", source.path + "@" + displayPart];
+ var result = BaseDisplayTestContext.runHaxe(args, source.content);
+ if (result.hasError || result.stderr == "") {
+ throw new HaxeInvocationException(result.stderr, fieldName, args, source.content);
+ }
+ return result.stderr;
+ }
+
+ function callDisplay(method:HaxeRequestMethod, methodArgs:TParams):TResponse {
+ var methodArgs = {method: method, id: 1, params: methodArgs};
+ var args = ['--display', Json.stringify(methodArgs)];
+
+ var result = BaseDisplayTestContext.runHaxe(args, source.content);
+ if (result.hasError || result.stderr == "") {
+ throw new HaxeInvocationException(result.stderr, fieldName, args, source.content);
+ }
+ var json = Json.parse(result.stderr);
+ if (json.result != null) {
+ return json.result;
+ } else {
+ throw new HaxeInvocationException(json.error.data.join("\n"), fieldName, args, source.content);
+ }
+ }
+
+ function extractType(result:HoverDisplayItemOccurence) {
+ return displayPrinter.printType(result.item.type);
+ }
+
+ static function extractPositions(result:Array) {
+ return result.map(r -> formatRange(r.file, r.range));
+ }
+
+ static function extractFields(result:CompletionResult) {
+ return result.result.items;
+ }
+
+ static function formatRange(path:FsPath, range:Range):String {
+ // Offset difference with legacy display
+ var offset = 1;
+
+ var start = range.start;
+ var end = range.end;
+ var pos = if (start.line == end.line) {
+ if (start.character == end.character)
+ 'character ${start.character + offset}';
+ else
+ 'characters ${start.character + offset}-${end.character + offset}';
+ } else {
+ 'lines ${start.line + 1}-${end.line + 1}';
+ }
+ return '$path:${start.line + 1}: $pos';
+ }
+
+ function extractDoc(result:HoverDisplayItemOccurence) {
+ return StringTools.trim(result.item.args.field.doc);
+ }
+
+ function extractMetadata(result:HoverDisplayItemOccurence) {
+ return result.item.args.doc;
+ }
+}
diff --git a/tests/display/src/XmlDisplayTestCase.hx b/tests/display/src/XmlDisplayTestCase.hx
new file mode 100644
index 00000000000..b2efba30f6f
--- /dev/null
+++ b/tests/display/src/XmlDisplayTestCase.hx
@@ -0,0 +1,122 @@
+import haxe.display.Position.Range;
+import utest.Assert;
+import Types;
+
+using Lambda;
+
+@:autoBuild(Macro.buildTestCase())
+class XmlDisplayTestCase implements utest.ITest {
+ var ctx:XmlDisplayTestContext;
+
+ public function new() {}
+
+ // api
+ inline function pos(name)
+ return ctx.pos(name);
+
+ inline function fields(pos)
+ return ctx.fields(pos);
+
+ inline function toplevel(pos)
+ return ctx.toplevel(pos);
+
+ inline function type(pos)
+ return ctx.type(pos);
+
+ inline function position(pos)
+ return ctx.position(pos);
+
+ inline function usage(pos)
+ return ctx.usage(pos);
+
+ inline function range(pos1, pos2)
+ return ctx.range(pos1, pos2);
+
+ inline function signature(pos1)
+ return ctx.signature(pos1);
+
+ inline function doc(pos1)
+ return ctx.doc(pos1);
+
+ inline function metadataDoc(pos1)
+ return ctx.metadataDoc(pos1);
+
+ inline function diagnostics()
+ return ctx.diagnostics();
+
+ inline function noCompletionPoint(f)
+ return ctx.hasErrorMessage(f, "No completion point");
+
+ inline function typeNotFound(f, typeName)
+ return ctx.hasErrorMessage(f, "Type not found : " + typeName);
+
+ function assert(v:Bool)
+ Assert.isTrue(v);
+
+ function eq(expected:T, actual:T, ?pos:haxe.PosInfos) {
+ Assert.equals(expected, actual, pos);
+ }
+
+ function arrayEq(expected:Array, actual:Array, ?pos:haxe.PosInfos) {
+ Assert.same(expected, actual, pos);
+ }
+
+ function arrayCheck(expected:Array, actual:Array, f:T->String, ?pos:haxe.PosInfos) {
+ var expected = [for (expected in expected) f(expected) => expected];
+ for (actual in actual) {
+ var key = f(actual);
+ Assert.isTrue(expected.exists(key), "Result not part of expected Array: " + Std.string(actual), pos);
+ expected.remove(key);
+ }
+
+ for (expected in expected) {
+ Assert.fail("Expected result was not part of actual Array: " + Std.string(expected), pos);
+ return;
+ }
+ }
+
+ function hasField(a:Array, name:String, type:String, ?kind:String):Bool {
+ return a.exists(t -> isField(t, name, type, kind));
+ }
+
+ function isField(t:FieldElement, name:String, ?type:String, ?kind:String):Bool {
+ return (type == null || t.type == type) && t.name == name && (kind == null || t.kind == kind);
+ }
+
+ function hasToplevel(a:Array, kind:String, name:String, ?type:String = null):Bool {
+ return a.exists(t -> isToplevel(t, name, type, kind));
+ }
+
+ function isToplevel(t:ToplevelElement, name:String, ?type:String = null, ?kind:String = null):Bool {
+ return (kind == null || t.kind == kind) && t.name == name && (type == null || t.type == type);
+ }
+
+ function hasPath(a:Array, name:String):Bool {
+ return a.exists(function(t) return t.name == name);
+ }
+
+ function diagnosticsRange(start:Position, end:Position):Range {
+ var range = ctx.source.findRange(start, end);
+ // this is probably correct...?
+ range.start.character--;
+ range.end.character--;
+ return range;
+ }
+
+ function sigEq(arg:Int, params:Array>, sig:SignatureHelp, ?pos:haxe.PosInfos) {
+ eq(arg, sig.activeParameter, pos);
+ eq(params.length, sig.signatures.length, pos);
+ for (i in 0...params.length) {
+ var sigInf = sig.signatures[i];
+ var args = params[i];
+ eq(sigInf.parameters.length, args.length, pos);
+ for (i in 0...args.length) {
+ eq(sigInf.parameters[i].label, args[i], pos);
+ }
+ }
+ }
+
+ function report(message, pos:haxe.PosInfos) {
+ Assert.fail(message, pos);
+ }
+}
diff --git a/tests/display/src/XmlDisplayTestContext.hx b/tests/display/src/XmlDisplayTestContext.hx
new file mode 100644
index 00000000000..815a1831ec5
--- /dev/null
+++ b/tests/display/src/XmlDisplayTestContext.hx
@@ -0,0 +1,135 @@
+import haxe.Json;
+import haxe.display.Display;
+import haxe.display.Protocol;
+
+import BaseDisplayTestContext.normalizePath;
+
+using StringTools;
+
+import Types;
+
+class XmlDisplayTestContext extends BaseDisplayTestContext {
+ public function new(path:String, fieldName:String, source:String, markers:Map) {
+ super(path, fieldName, source, markers);
+ }
+
+ public function fields(pos:Position):Array {
+ return extractFields(callHaxe('$pos'));
+ }
+
+ public function toplevel(pos:Position):Array {
+ return extractToplevel(callHaxe('$pos@toplevel'));
+ }
+
+ public function type(pos:Position):String {
+ return extractType(callHaxe('$pos@type'));
+ }
+
+ public function positions(pos:Position):Array {
+ return extractPositions(callHaxe('$pos@position'));
+ }
+
+ public function position(pos:Position):String {
+ return positions(pos)[0];
+ }
+
+ public function usage(pos:Position):Array {
+ return extractPositions(callHaxe('$pos@usage'));
+ }
+
+ public function documentSymbols():Array {
+ return Json.parse(callHaxe("0@module-symbols"))[0].symbols;
+ }
+
+ public function signature(pos:Position):SignatureHelp {
+ return Json.parse(callHaxe('$pos@signature'));
+ }
+
+ public function doc(pos:Position):String {
+ return extractDoc(callHaxe('$pos@type'));
+ }
+
+ public function metadataDoc(pos:Position):String {
+ return extractMetadata(callHaxe('$pos@type'));
+ }
+
+ public function diagnostics():Array> {
+ var result = Json.parse(callHaxe('0@diagnostics'))[0];
+ return if (result == null) [] else result.diagnostics;
+ }
+
+ function callHaxe(displayPart:String) {
+ var args = ["--display", source.path + "@" + displayPart];
+ var result = BaseDisplayTestContext.runHaxe(args, source.content);
+ if (result.hasError || result.stderr == "") {
+ throw new HaxeInvocationException(result.stderr, fieldName, args, source.content);
+ }
+ return result.stderr;
+ }
+
+ static function extractType(result:String) {
+ var xml = Xml.parse(result);
+ xml = xml.firstElement();
+ if (xml.nodeName != "type") {
+ return null;
+ }
+ return StringTools.trim(xml.firstChild().nodeValue);
+ }
+
+ static function extractPositions(result:String) {
+ var xml = Xml.parse(result);
+ xml = xml.firstElement();
+ if (xml.nodeName != "list") {
+ return null;
+ }
+ var ret = [];
+ for (xml in xml.elementsNamed("pos")) {
+ ret.push(normalizePath(xml.firstChild().nodeValue.trim()));
+ }
+ return ret;
+ }
+
+ static function extractToplevel(result:String) {
+ var xml = Xml.parse(result);
+ xml = xml.firstElement();
+ if (xml.nodeName != "il") {
+ return null;
+ }
+ var ret = [];
+ for (xml in xml.elementsNamed("i")) {
+ ret.push({kind: xml.get("k"), type: xml.get("t"), name: xml.firstChild().nodeValue});
+ }
+ return ret;
+ }
+
+ static function extractFields(result:String) {
+ var xml = Xml.parse(result);
+ xml = xml.firstElement();
+ if (xml.nodeName != "list") {
+ return null;
+ }
+ var ret = [];
+ for (xml in xml.elementsNamed("i")) {
+ ret.push({name: xml.get("n"), type: xml.firstElement().firstChild().nodeValue, kind: xml.get("k")});
+ }
+ return ret;
+ }
+
+ static function extractDoc(result:String) {
+ var xml = Xml.parse(result);
+ xml = xml.firstElement();
+ if (xml.nodeName != "type") {
+ return null;
+ }
+ return StringTools.trim(xml.get('d'));
+ }
+
+ static function extractMetadata(result:String) {
+ var xml = Xml.parse(result);
+ xml = xml.firstElement();
+ if (xml.nodeName != "metadata") {
+ return null;
+ }
+ return xml.firstChild().nodeValue;
+ }
+}
diff --git a/tests/display/src/cases/Completion.hx b/tests/display/src/cases/Completion.hx
index d098925f7c6..e1e8c20ad21 100644
--- a/tests/display/src/cases/Completion.hx
+++ b/tests/display/src/cases/Completion.hx
@@ -37,6 +37,8 @@ class Completion extends DisplayTestCase {
**/
@:funcCode function testHaxeUnitPort4() {
eq(true, hasPath(fields(pos(1)), "Expr"));
+ BaseDisplayTestContext.runHaxe(['haxe.macro.Expr']);
+ eq(true, hasPath(fields(pos(1)), "Expr"));
}
/**
@@ -44,6 +46,17 @@ class Completion extends DisplayTestCase {
**/
@:funcCode function testHaxeUnitPort5() {
eq(true, hasPath(fields(pos(1)), "ExprDef"));
+ BaseDisplayTestContext.runHaxe(['haxe.macro.Expr']);
+ eq(true, hasPath(fields(pos(1)), "ExprDef"));
+ }
+
+ /**
+ haxe.Json.{-1-}
+ **/
+ @:funcCode function testStaticField() {
+ eq(true, hasPath(fields(pos(1)), "stringify"));
+ BaseDisplayTestContext.runHaxe(['haxe.Json']);
+ eq(true, hasPath(fields(pos(1)), "stringify"));
}
/**
diff --git a/tests/display/src/cases/Issue11515.hx b/tests/display/src/cases/Issue11515.hx
new file mode 100644
index 00000000000..975dbaec825
--- /dev/null
+++ b/tests/display/src/cases/Issue11515.hx
@@ -0,0 +1,27 @@
+package cases;
+
+class Issue11515 extends DisplayTestCase {
+ /**
+ import haxe.ds.Option;
+
+ class Main {
+ static function main () {
+ Option.{-1-}
+ }
+ }
+ **/
+ function testImport() {
+ eq(true, hasField(fields(pos(1)), "None", "haxe.ds.Option"));
+ }
+
+ /**
+ class Main {
+ static function main () {
+ haxe.ds.Option.{-1-}
+ }
+ }
+ **/
+ function testFully() {
+ eq(true, hasField(fields(pos(1)), "None", "haxe.ds.Option"));
+ }
+}
diff --git a/tests/display/src/cases/Issue6068.hx b/tests/display/src/cases/Issue6068.hx
index a5c330fbc7a..e008070e2c2 100644
--- a/tests/display/src/cases/Issue6068.hx
+++ b/tests/display/src/cases/Issue6068.hx
@@ -20,7 +20,7 @@ class Issue6068 extends DisplayTestCase {
var result = try {
fn();
false;
- } catch (e:DisplayTestContext.HaxeInvocationException) {
+ } catch (e:HaxeInvocationException) {
e.message.indexOf("Not a callable type") != -1;
}
assert(result);
diff --git a/tests/display/src/cases/Issue7055.hx b/tests/display/src/cases/Issue7055.hx
index 2ae4171be67..6ceb9baad02 100644
--- a/tests/display/src/cases/Issue7055.hx
+++ b/tests/display/src/cases/Issue7055.hx
@@ -23,7 +23,7 @@ class Issue7055 extends DisplayTestCase {
var results = toplevel(pos(1));
var i = 0;
function nextIs(name, ?pos) {
- eq(results[i++].name, name, pos);
+ eq(true, isToplevel(results[i++], name), pos);
}
nextIs("Some");
nextIs("Random");
diff --git a/tests/display/src/cases/Issue7059.hx b/tests/display/src/cases/Issue7059.hx
index d3de59cc7ac..b0ca00d3cc0 100644
--- a/tests/display/src/cases/Issue7059.hx
+++ b/tests/display/src/cases/Issue7059.hx
@@ -11,6 +11,6 @@ class Issue7059 extends DisplayTestCase {
}
**/
function test() {
- eq(true, toplevel(pos(1)).exists(el -> el.name == "trace"));
+ eq(true, hasToplevel(toplevel(pos(1)), "literal", "trace"));
}
}
diff --git a/tests/display/src/cases/Issue7066.hx b/tests/display/src/cases/Issue7066.hx
index b20eb674196..422df627f5c 100644
--- a/tests/display/src/cases/Issue7066.hx
+++ b/tests/display/src/cases/Issue7066.hx
@@ -20,8 +20,6 @@ class Issue7066 extends DisplayTestCase {
function test() {
var results = fields(pos(1));
eq(1, results.length);
- eq("fieldB", results[0].name);
- eq("var", results[0].kind);
- eq("Null", results[0].type);
+ eq(true, isField(results[0], "fieldB", "Null", "var"));
}
}
diff --git a/tests/display/src/cases/Issue7068.hx b/tests/display/src/cases/Issue7068.hx
index 921d175224f..ba3f78df85f 100644
--- a/tests/display/src/cases/Issue7068.hx
+++ b/tests/display/src/cases/Issue7068.hx
@@ -13,7 +13,7 @@ class Issue7068 extends DisplayTestCase {
}
**/
function test() {
- eq("Bar", toplevel(pos(1))[0].name);
+ eq(true, isToplevel(toplevel(pos(1))[0], "Bar"));
}
/**
@@ -28,6 +28,6 @@ class Issue7068 extends DisplayTestCase {
}
**/
function test2() {
- eq("Bar", toplevel(pos(1))[0].name);
+ eq(true, isToplevel(toplevel(pos(1))[0], "Bar"));
}
}
diff --git a/tests/display/src/cases/Issue7069.hx b/tests/display/src/cases/Issue7069.hx
index 9d287db8020..8c6cb51e714 100644
--- a/tests/display/src/cases/Issue7069.hx
+++ b/tests/display/src/cases/Issue7069.hx
@@ -17,10 +17,10 @@ class Issue7069 extends DisplayTestCase {
**/
function test() {
var results = toplevel(pos(1));
- eq("i", results[0].name);
- eq("blockLocal", results[1].name);
- eq("local", results[2].name);
- eq("argument", results[3].name);
- eq("field", results[4].name);
+ eq(true, isToplevel(results[0], "i"));
+ eq(true, isToplevel(results[1], "blockLocal"));
+ eq(true, isToplevel(results[2], "local"));
+ eq(true, isToplevel(results[3], "argument"));
+ eq(true, isToplevel(results[4], "field"));
}
}
diff --git a/tests/display/src/cases/Issue7071.hx b/tests/display/src/cases/Issue7071.hx
index bca9515d217..99cccbbcfa5 100644
--- a/tests/display/src/cases/Issue7071.hx
+++ b/tests/display/src/cases/Issue7071.hx
@@ -13,7 +13,7 @@ class Issue7071 extends DisplayTestCase {
}
**/
function test() {
- eq("bar", toplevel(pos(1))[0].name);
- eq("bar", toplevel(pos(2))[0].name);
+ eq(true, isToplevel(toplevel(pos(1))[0], "bar"));
+ eq(true, isToplevel(toplevel(pos(2))[0], "bar"));
}
}
diff --git a/tests/display/src/cases/Issue7084.hx b/tests/display/src/cases/Issue7084.hx
index 1c15d95e9ed..d4a7a78c428 100644
--- a/tests/display/src/cases/Issue7084.hx
+++ b/tests/display/src/cases/Issue7084.hx
@@ -29,6 +29,6 @@ class Issue7084 extends DisplayTestCase {
}
**/
function test2() {
- eq("Value", fields(pos(1))[0].name);
+ eq(true, isField(fields(pos(1))[0], "Value"));
}
}
diff --git a/tests/display/src/cases/Issue7136.hx b/tests/display/src/cases/Issue7136.hx
index c6ac6201cc5..22161d604f1 100644
--- a/tests/display/src/cases/Issue7136.hx
+++ b/tests/display/src/cases/Issue7136.hx
@@ -18,8 +18,7 @@ class Issue7136 extends DisplayTestCase {
function test() {
var fields = fields(pos(1));
eq(2, fields.length);
- eq("x", fields[0].name);
- eq("y", fields[1].name);
- eq("String", fields[1].type);
+ eq(true, isToplevel(fields[0], "x"));
+ eq(true, isToplevel(fields[1], "y", "String"));
}
}
diff --git a/tests/display/src/cases/Issue7326.hx b/tests/display/src/cases/Issue7326.hx
index 358dd2be53d..6b05cf1daba 100644
--- a/tests/display/src/cases/Issue7326.hx
+++ b/tests/display/src/cases/Issue7326.hx
@@ -16,7 +16,6 @@ class Issue7326 extends DisplayTestCase {
}
**/
function test() {
- // sigEq(0, [["v:Int"]], signature(pos(1)));
sigEq(0, [["v:Int"]], signature(pos(1)));
sigEq(0, [["v:Unknown<0>"]], signature(pos(2)));
}
diff --git a/tests/display/src/cases/Issue7864.hx b/tests/display/src/cases/Issue7864.hx
index 016dac8cdc6..94dbaa14d98 100644
--- a/tests/display/src/cases/Issue7864.hx
+++ b/tests/display/src/cases/Issue7864.hx
@@ -12,7 +12,7 @@ class Issue7864 extends DisplayTestCase {
class Test {}
**/
function test() {
- eq(true, hasField(fields(pos(1)), "@:enum", "", "metadata"));
- eq(true, hasField(fields(pos(2)), "@:enum", "", "metadata"));
+ eq(true, hasField(fields(pos(1)), "@:enum", null, "metadata"));
+ eq(true, hasField(fields(pos(2)), "@:enum", null, "metadata"));
}
}
diff --git a/tests/display/src/cases/Issue7911.hx b/tests/display/src/cases/Issue7911.hx
index 7bd8f775063..560a8509678 100644
--- a/tests/display/src/cases/Issue7911.hx
+++ b/tests/display/src/cases/Issue7911.hx
@@ -5,6 +5,8 @@ class Issue7911 extends DisplayTestCase {
import misc.issue7911.{-1-}
**/
function test() {
- arrayEq([{name: "Test", type: "", kind: "type"}], fields(pos(1)));
+ var fields = fields(pos(1));
+ eq(1, fields.length);
+ eq(true, isField(fields[0], "Test", null, "type"));
}
}
diff --git a/tests/display/src/cases/Issue9133.hx b/tests/display/src/cases/Issue9133.hx
index d0b7c8bcdc7..8a559e91060 100644
--- a/tests/display/src/cases/Issue9133.hx
+++ b/tests/display/src/cases/Issue9133.hx
@@ -16,8 +16,8 @@ class Issue9133 extends DisplayTestCase {
**/
function test1() {
var fields = toplevel(pos(1));
- var i1 = fields.findIndex(item -> item.kind == "local" && item.name == "i");
- var i2 = fields.findIndex(item -> item.kind == "local" && item.name == "s");
+ var i1 = fields.findIndex(item -> isToplevel(item, "i", null, "local"));
+ var i2 = fields.findIndex(item -> isToplevel(item, "s", null, "local"));
Assert.isTrue(i1 < i2);
Assert.isTrue(i1 != -1);
}
@@ -37,8 +37,8 @@ class Issue9133 extends DisplayTestCase {
// causes a `Duplicate key` error. See https://github.com/HaxeFoundation/haxe/issues/9144
// for more context.
var fields = toplevel(pos(1));
- var i1 = fields.findIndex(item -> item.kind == "local" && item.name == "i");
- var i2 = fields.findIndex(item -> item.kind == "local" && item.name == "s");
+ var i1 = fields.findIndex(item -> isToplevel(item, "i", null, "local"));
+ var i2 = fields.findIndex(item -> isToplevel(item, "s", null, "local"));
Assert.isTrue(i1 < i2);
Assert.isTrue(i1 != -1);
}
@@ -51,7 +51,7 @@ class Issue9133 extends DisplayTestCase {
**/
function test3() {
var fields = toplevel(pos(1));
- var i1 = fields.findIndex(item -> item.kind == "local" && item.name == "i");
+ var i1 = fields.findIndex(item -> isToplevel(item, "i", null, "local"));
Assert.isTrue(i1 != -1);
}
}
diff --git a/tests/display/src/cases/Toplevel.hx b/tests/display/src/cases/Toplevel.hx
index 86ef42ab40d..8587fc80f10 100644
--- a/tests/display/src/cases/Toplevel.hx
+++ b/tests/display/src/cases/Toplevel.hx
@@ -167,6 +167,7 @@ class Toplevel extends DisplayTestCase {
eq(true, hasToplevel(toplevel(pos(2)), "type", "FieldT2"));
}
+ #if (!display.protocol || display.protocol == "xml")
/**
import cases.Toplevel.E.a;
@@ -186,10 +187,11 @@ class Toplevel extends DisplayTestCase {
**/
function testDuplicates() {
var toplevels = toplevel(pos(1));
- toplevels = toplevels.filter(function(t) return t.name == "a");
+ toplevels = toplevels.filter(t -> isToplevel(t, "a"));
eq(1, toplevels.length);
- eq("local", toplevels[0].kind);
+ eq(true, isToplevel(toplevels[0], "a", null, "local"));
}
+ #end
/**
class Main {
diff --git a/tests/misc/es6/Test.hx b/tests/misc/es6/Test.hx
index 4fec1638c16..7592383dc77 100644
--- a/tests/misc/es6/Test.hx
+++ b/tests/misc/es6/Test.hx
@@ -32,7 +32,7 @@ class F extends E {
}
extern class ExtNoCtor {
- static function __init__():Void haxe.macro.Compiler.includeFile("./extern.js", "top");
+ static function __init__():Void haxe.macro.Compiler.includeFile("./extern.js");
}
class Base extends ExtNoCtor {
diff --git a/tests/misc/java/projects/Issue10280/Main.hx b/tests/misc/java/projects/Issue10280/Main.hx
index 14bcefb7483..bf2044f98e2 100644
--- a/tests/misc/java/projects/Issue10280/Main.hx
+++ b/tests/misc/java/projects/Issue10280/Main.hx
@@ -29,12 +29,11 @@ class OldClass {
public function new() {}
}
);
-
- Compiler.exclude('OldClass');
-
defined = true;
});
+ Context.onGenerate(_ -> Compiler.exclude('OldClass'));
+
return null;
}
}
\ No newline at end of file
diff --git a/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr
index 60cf3bac680..71888302865 100644
--- a/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr
+++ b/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr
@@ -1,3 +1,3 @@
(unknown) : Uncaught exception Could not read file define.jsno
-$$normPath(::std::)/haxe/macro/Compiler.hx:505: characters 11-39 : Called from here
+$$normPath(::std::)/haxe/macro/Compiler.hx:401: characters 11-39 : Called from here
(unknown) : Called from here
diff --git a/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr
index ced31cb8f78..9f77e04b2fb 100644
--- a/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr
+++ b/tests/misc/projects/Issue10844/user-defined-meta-json-fail.hxml.stderr
@@ -1,3 +1,3 @@
(unknown) : Uncaught exception Could not read file meta.jsno
-$$normPath(::std::)/haxe/macro/Compiler.hx:494: characters 11-39 : Called from here
+$$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 : Called from here
(unknown) : Called from here
diff --git a/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr
index 9a4f93d7093..5a81672cb2a 100644
--- a/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr
+++ b/tests/misc/projects/Issue10844/user-defined-meta-json-indent-fail.hxml.stderr
@@ -1,3 +1,3 @@
(unknown) : Uncaught exception Could not read file meta.jsno
- $$normPath(::std::)/haxe/macro/Compiler.hx:494: characters 11-39 : Called from here
+ $$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 : Called from here
(unknown) : Called from here
diff --git a/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml b/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml
deleted file mode 100644
index 68353040073..00000000000
--- a/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml
+++ /dev/null
@@ -1,4 +0,0 @@
-user-defined-meta-json-fail.hxml
--D message.reporting=pretty
--D message.no-color
-
diff --git a/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr
deleted file mode 100644
index 2160c2c1753..00000000000
--- a/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr
+++ /dev/null
@@ -1,12 +0,0 @@
-[ERROR] --macro haxe.macro.Compiler.registerMetadataDescriptionFile('meta.jsno', 'myapp')
-
- | Uncaught exception Could not read file meta.jsno
-
- -> $$normPath(::std::)/haxe/macro/Compiler.hx:494: characters 11-39
-
- 494 | var f = sys.io.File.getContent(path);
- | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
- | Called from here
-
- | Called from here
-
diff --git a/tests/misc/projects/Issue11087/Main.hx b/tests/misc/projects/Issue11087/Main.hx
new file mode 100644
index 00000000000..dcec6730897
--- /dev/null
+++ b/tests/misc/projects/Issue11087/Main.hx
@@ -0,0 +1,9 @@
+macro function test() {
+ trace(Sys.args());
+ return macro null;
+}
+
+function main() {
+ test();
+ trace(Sys.args());
+}
diff --git a/tests/misc/projects/Issue11087/compile-interp.hxml b/tests/misc/projects/Issue11087/compile-interp.hxml
new file mode 100644
index 00000000000..b30a755894b
--- /dev/null
+++ b/tests/misc/projects/Issue11087/compile-interp.hxml
@@ -0,0 +1,2 @@
+--main Main
+--interp
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11087/compile-interp.hxml.stdout b/tests/misc/projects/Issue11087/compile-interp.hxml.stdout
new file mode 100644
index 00000000000..7364ee81c61
--- /dev/null
+++ b/tests/misc/projects/Issue11087/compile-interp.hxml.stdout
@@ -0,0 +1,2 @@
+Main.hx:2: [--main,Main,--interp]
+Main.hx:8: []
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11087/compile.hxml b/tests/misc/projects/Issue11087/compile.hxml
new file mode 100644
index 00000000000..7c1904b0e34
--- /dev/null
+++ b/tests/misc/projects/Issue11087/compile.hxml
@@ -0,0 +1,2 @@
+--run Main
+arg
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11087/compile.hxml.stdout b/tests/misc/projects/Issue11087/compile.hxml.stdout
new file mode 100644
index 00000000000..9a331ddd62d
--- /dev/null
+++ b/tests/misc/projects/Issue11087/compile.hxml.stdout
@@ -0,0 +1,2 @@
+Main.hx:2: [-x,Main]
+Main.hx:8: [arg]
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11481/Main.hx b/tests/misc/projects/Issue11481/Main.hx
new file mode 100644
index 00000000000..4d95c5f0be2
--- /dev/null
+++ b/tests/misc/projects/Issue11481/Main.hx
@@ -0,0 +1,3 @@
+function main() {
+ trace(pack.OldClass);
+}
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11481/compile.hxml b/tests/misc/projects/Issue11481/compile.hxml
new file mode 100644
index 00000000000..5f82c470c12
--- /dev/null
+++ b/tests/misc/projects/Issue11481/compile.hxml
@@ -0,0 +1,2 @@
+-m Main
+--interp
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11481/compile.hxml.stdout b/tests/misc/projects/Issue11481/compile.hxml.stdout
new file mode 100644
index 00000000000..a4310c6c4f8
--- /dev/null
+++ b/tests/misc/projects/Issue11481/compile.hxml.stdout
@@ -0,0 +1 @@
+Main.hx:2: Class
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11481/pack/OldClass.hx b/tests/misc/projects/Issue11481/pack/OldClass.hx
new file mode 100644
index 00000000000..163b567c747
--- /dev/null
+++ b/tests/misc/projects/Issue11481/pack/OldClass.hx
@@ -0,0 +1,12 @@
+package pack;
+
+@:native("NewClass")
+class OldClass {
+ macro static function f2() {
+ return null;
+ }
+
+ macro static function f1() {
+ return null;
+ }
+}
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11528/Main.hx b/tests/misc/projects/Issue11528/Main.hx
new file mode 100644
index 00000000000..3b2ba84e22a
--- /dev/null
+++ b/tests/misc/projects/Issue11528/Main.hx
@@ -0,0 +1,9 @@
+class MyClass {
+ public static var Null = new MyClass();
+
+ public function new() {}
+}
+
+function main() {
+ trace(MyClass.Null);
+}
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11528/compile-fail.hxml b/tests/misc/projects/Issue11528/compile-fail.hxml
new file mode 100644
index 00000000000..fab0aeecc3d
--- /dev/null
+++ b/tests/misc/projects/Issue11528/compile-fail.hxml
@@ -0,0 +1 @@
+--main Main
\ No newline at end of file
diff --git a/tests/misc/projects/Issue11528/compile-fail.hxml.stderr b/tests/misc/projects/Issue11528/compile-fail.hxml.stderr
new file mode 100644
index 00000000000..35bce2d0f9d
--- /dev/null
+++ b/tests/misc/projects/Issue11528/compile-fail.hxml.stderr
@@ -0,0 +1 @@
+Main.hx:2: characters 39-40 : Type not found : T
\ No newline at end of file
diff --git a/tests/misc/projects/Issue3500/Main.hx b/tests/misc/projects/Issue3500/Main.hx
index 4b9e8577129..ba8e6f064b3 100644
--- a/tests/misc/projects/Issue3500/Main.hx
+++ b/tests/misc/projects/Issue3500/Main.hx
@@ -9,7 +9,7 @@ class Main {
var t = haxe.macro.Context.getType("A");
switch (t) {
case TAbstract(a, _):
- var hasTestMeta = Lambda.exists(a.get().impl.get().meta.get(), function(m) return m.name == ":test");
+ var hasTestMeta = Lambda.exists(a.get().meta.get(), function(m) return m.name == ":test");
if (!hasTestMeta) {
fail("Abstract implementation class has no @:test metadata");
}
diff --git a/tests/misc/projects/Issue4660/Include.hx b/tests/misc/projects/Issue4660/Include.hx
index f738186b431..90825a58f7e 100644
--- a/tests/misc/projects/Issue4660/Include.hx
+++ b/tests/misc/projects/Issue4660/Include.hx
@@ -1,5 +1,5 @@
class Include {
static function use() {
- haxe.macro.Compiler.includeFile("include.js", Top);
+ haxe.macro.Compiler.includeFile("include.js");
}
}
diff --git a/tests/misc/projects/Issue5039/compile2-fail.hxml.stderr b/tests/misc/projects/Issue5039/compile2-fail.hxml.stderr
index 2572b4b4397..1f8ea81c743 100644
--- a/tests/misc/projects/Issue5039/compile2-fail.hxml.stderr
+++ b/tests/misc/projects/Issue5039/compile2-fail.hxml.stderr
@@ -1 +1,3 @@
+Main2.hx:4: characters 37-53 : Field access expression expected after @:bypassAccessor metadata
+Main2.hx:4: characters 20-36 : Field access expression expected after @:bypassAccessor metadata
Main2.hx:4: characters 3-19 : Field access expression expected after @:bypassAccessor metadata
diff --git a/tests/misc/projects/Issue8567/compile.hxml b/tests/misc/projects/Issue8567/compile.hxml
deleted file mode 100644
index eb9ce292099..00000000000
--- a/tests/misc/projects/Issue8567/compile.hxml
+++ /dev/null
@@ -1,3 +0,0 @@
--cp src
--main Main
---macro patchTypes("src/test.txt")
\ No newline at end of file
diff --git a/tests/misc/projects/Issue8567/src/Main.hx b/tests/misc/projects/Issue8567/src/Main.hx
deleted file mode 100644
index 17c7d3e7b5d..00000000000
--- a/tests/misc/projects/Issue8567/src/Main.hx
+++ /dev/null
@@ -1,4 +0,0 @@
-class Main {
- static function main() {
- }
-}
diff --git a/tests/misc/projects/Issue8567/src/test.txt b/tests/misc/projects/Issue8567/src/test.txt
deleted file mode 100644
index e69de29bb2d..00000000000
diff --git a/tests/misc/src/Main.hx b/tests/misc/src/Main.hx
index 4f387cc95d1..006fcfad174 100644
--- a/tests/misc/src/Main.hx
+++ b/tests/misc/src/Main.hx
@@ -157,6 +157,9 @@ class Main {
// Reorder fields from expected too
expected = haxe.Json.stringify(haxe.Json.parse(expected));
} catch (_) {}
+ } else {
+ content = hideStdPositions(content);
+ expected = hideStdPositions(expected);
}
if (content != expected) {
@@ -178,6 +181,14 @@ class Main {
return true;
}
+ static function hideStdPositions(content:String):String {
+ var regex = new EReg(getStd() + '([a-z/]+\\.hx):[0-9]+:( characters? [0-9]+(-[0-9]+)( :)?)', 'i');
+
+ return content.split("\n")
+ .map(line -> regex.replace(line, "$1:???:"))
+ .join("\n");
+ }
+
static macro function getStd() {
var std = Compiler.getConfiguration().stdPath;
return macro $v{std.shift()};
diff --git a/tests/optimization/src/TestInlineConstructors.hx b/tests/optimization/src/TestInlineConstructors.hx
index 9bd64113c59..5f67a63c083 100644
--- a/tests/optimization/src/TestInlineConstructors.hx
+++ b/tests/optimization/src/TestInlineConstructors.hx
@@ -44,6 +44,19 @@ class NestedInlineClass {
}
}
+class P {
+ public var x:Float;
+
+ public inline function new(x = 0)
+ this.x = x;
+}
+
+@:forward
+abstract PA(P) to P {
+ public inline function new(x)
+ this = new P(x);
+}
+
class TestInlineConstructors extends TestBase {
@:js('return [1,2,3,3];')
static function testArrayInlining() {
@@ -147,4 +160,10 @@ class TestInlineConstructors extends TestBase {
try { a; } catch(_) { a; };
return a.a;
}
+
+ @:js('return [5];')
+ static function testForwardAbstract() {
+ var p2 = {v: new PA(5)};
+ return [p2.v.x];
+ }
}
diff --git a/tests/runci/targets/Hl.hx b/tests/runci/targets/Hl.hx
index 7bf6f207ae8..07ff7999687 100644
--- a/tests/runci/targets/Hl.hx
+++ b/tests/runci/targets/Hl.hx
@@ -39,7 +39,6 @@ class Hl {
case "Mac":
runNetworkCommand("brew", ["update", '--preinstall']);
runNetworkCommand("brew", ["bundle", '--file=${hlSrc}/Brewfile']);
- runNetworkCommand("brew", ["link", "mbedtls@2", "--force"]);
case "Windows":
//pass
}
diff --git a/tests/runci/targets/Jvm.hx b/tests/runci/targets/Jvm.hx
index f9b9b32dbbe..f471cab845e 100644
--- a/tests/runci/targets/Jvm.hx
+++ b/tests/runci/targets/Jvm.hx
@@ -10,12 +10,20 @@ class Jvm {
deleteDirectoryRecursively("bin/jvm");
Java.getJavaDependencies();
+ runCommand("haxe", ["compile-java-native.hxml"]);
+
for (level in 0...3) {
final args = args.concat(["-D", "jvm.dynamic-level=" + level]);
- runCommand("haxe", ["compile-jvm.hxml"].concat(args));
+ runCommand("haxe", ["compile-jvm-only.hxml", "--hxb", "bin/hxb/jvm.zip"].concat(args));
+ runCommand("java", ["-jar", "bin/unit.jar"]);
+
+ runCommand("haxe", ["compile-jvm-only.hxml", "--hxb-lib", "bin/hxb/jvm.zip"].concat(args));
+ runCommand("java", ["-jar", "bin/unit.jar"]);
+
+ runCommand("haxe", ["compile-jvm-only.hxml","-dce","no"].concat(args));
runCommand("java", ["-jar", "bin/unit.jar"]);
- runCommand("haxe", ["compile-jvm.hxml","-dce","no"].concat(args));
+ runCommand("haxe", ["compile-jvm-only.hxml", "--hxb-lib", "bin/hxb/jvm.zip"].concat(args));
runCommand("java", ["-jar", "bin/unit.jar"]);
}
diff --git a/tests/runci/targets/Macro.hx b/tests/runci/targets/Macro.hx
index c0eab03ec8c..56aa686efd8 100644
--- a/tests/runci/targets/Macro.hx
+++ b/tests/runci/targets/Macro.hx
@@ -5,11 +5,13 @@ import runci.Config.*;
class Macro {
static public function run(args:Array) {
- runCommand("haxe", ["compile-macro.hxml"].concat(args));
+ runCommand("haxe", ["compile-macro.hxml", "--hxb", "bin/hxb/eval.zip"].concat(args));
+ runCommand("haxe", ["compile-macro.hxml", "--hxb-lib", "bin/hxb/eval.zip"].concat(args));
changeDirectory(displayDir);
haxelibInstallGit("Simn", "haxeserver");
- runCommand("haxe", ["build.hxml"]);
+ runCommand("haxe", ["build.hxml", "-D", "display.protocol=xml"]);
+ runCommand("haxe", ["build.hxml", "-D", "display.protocol=jsonrpc"]);
changeDirectory(sourcemapsDir);
runCommand("haxe", ["run.hxml"]);
diff --git a/tests/server/src/Main.hx b/tests/server/src/Main.hx
index 77aa51ba3a0..e35a4cafcbe 100644
--- a/tests/server/src/Main.hx
+++ b/tests/server/src/Main.hx
@@ -13,4 +13,4 @@ class Main {
report.displaySuccessResults = NeverShowSuccessResults;
runner.run();
}
-}
+}
\ No newline at end of file
diff --git a/tests/server/src/TestCase.hx b/tests/server/src/TestCase.hx
index 621dd1702bf..0d4b9d3a283 100644
--- a/tests/server/src/TestCase.hx
+++ b/tests/server/src/TestCase.hx
@@ -120,7 +120,12 @@ class TestCase implements ITest {
errorMessages = [];
server.rawRequest(args, null, function(result) {
handleResult(result);
- callback(Json.parse(result.stderr).result.result);
+ var json = Json.parse(result.stderr);
+ if (json.result != null) {
+ callback(json.result.result);
+ } else {
+ sendErrorMessage('Error: ' + json.error);
+ }
done();
}, function(msg) {
sendErrorMessage(msg);
diff --git a/tests/server/src/cases/RetyperTests.hx b/tests/server/src/cases/RetyperTests.hx
deleted file mode 100644
index 8a4db7a7140..00000000000
--- a/tests/server/src/cases/RetyperTests.hx
+++ /dev/null
@@ -1,203 +0,0 @@
-package cases;
-
-import haxe.display.FsPath;
-import haxe.display.Server;
-import utest.Assert;
-
-using StringTools;
-using Lambda;
-
-class RetyperTests extends TestCase {
- static function getBaseArgs(moduleName:String) {
- return [
- moduleName + ".hx",
- "--no-output",
- "-js",
- "no.js",
- "--macro",
- "haxe.macro.CompilationServer.setModuleCheckPolicy(['" + moduleName + "'], [Retype], false)"
- ];
- }
-
- function testNonSignature() {
- vfs.putContent("WithDependency.hx", getTemplate("WithDependency.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('retyped WithDependency'));
- }
-
- function testSignature() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependency.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testSignatureInferredArg() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredArg.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testSignatureInferredRet() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredRet.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testSignatureVariable() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyVariable.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testSignatureInferredVariable() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredVariable.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testSignatureProperty() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyProperty.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testSignatureInferredProperty() {
- vfs.putContent("WithSignatureDependency.hx", getTemplate("retyper/WithSignatureDependencyInferredProperty.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module WithSignatureDependency] [Class WithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-
- function testMutual() {
- vfs.putContent("WithMutualDependency.hx", getTemplate("retyper/WithMutualDependency.hx"));
- vfs.putContent("MutualDependency.hx", getTemplate("retyper/MutualDependency.hx"));
- var args = getBaseArgs("WithMutualDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("MutualDependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('retyped WithMutualDependency'));
- }
-
- function testParent() {
- vfs.putContent("WithParentDependency.hx", getTemplate("retyper/WithParentDependency.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("WithParentDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithParentDependency'));
- Assert.isTrue(hasMessage('[Module WithParentDependency] [Class WithParentDependency] [Relations]: Could not load [Module Dependency]'));
- }
-
- function testInterface() {
- vfs.putContent("WithInterfaceDependency.hx", getTemplate("retyper/WithInterfaceDependency.hx"));
- vfs.putContent("InterfaceDependency.hx", getTemplate("retyper/InterfaceDependency.hx"));
- var args = getBaseArgs("WithInterfaceDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("InterfaceDependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping WithInterfaceDependency'));
- Assert.isTrue(hasMessage('[Module WithInterfaceDependency] [Class WithInterfaceDependency] [Relations]: Could not load [Module InterfaceDependency]'));
- }
-
- function testIndependentEnum() {
- vfs.putContent("IndependentEnum.hx", getTemplate("retyper/IndependentEnum.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("IndependentEnum");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('retyped IndependentEnum'));
- }
-
- function testDependentEnum() {
- vfs.putContent("DependentEnum.hx", getTemplate("retyper/DependentEnum.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("DependentEnum");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping DependentEnum'));
- Assert.isTrue(hasMessage('[Module DependentEnum] [Enum DependentEnum] [Field Constructor]: Could not load [Module Dependency]'));
- }
-
- function testIndependentTypedef() {
- vfs.putContent("IndependentTypedef.hx", getTemplate("retyper/IndependentTypedef.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("IndependentTypedef");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('retyped IndependentTypedef'));
- }
-
- function testDependentTypedef() {
- vfs.putContent("DependentTypedef.hx", getTemplate("retyper/DependentTypedef.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("DependentTypedef");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping DependentTypedef'));
- Assert.isTrue(hasMessage('[Module DependentTypedef] [Typedef DependentTypedef]: Could not load [Module Dependency]'));
- }
-
- function testAbstractNonSignature() {
- vfs.putContent("AbstractWithDependency.hx", getTemplate("retyper/AbstractWithDependency.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("AbstractWithDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('retyped AbstractWithDependency'));
- }
-
- function testAbstractSignature() {
- vfs.putContent("AbstractWithSignatureDependency.hx", getTemplate("retyper/AbstractWithSignatureDependency.hx"));
- vfs.putContent("Dependency.hx", getTemplate("Dependency.hx"));
- var args = getBaseArgs("AbstractWithSignatureDependency");
- runHaxe(args);
- runHaxeJson([], ServerMethods.Invalidate, {file: new FsPath("Dependency.hx")});
- runHaxe(args);
- Assert.isTrue(hasMessage('failed retyping AbstractWithSignatureDependency'));
- Assert.isTrue(hasMessage('[Module AbstractWithSignatureDependency] [Abstract AbstractWithSignatureDependency] [Field test]: Could not load [Module Dependency]'));
- }
-}
diff --git a/tests/server/src/cases/ServerTests.hx b/tests/server/src/cases/ServerTests.hx
index 130861863c5..9833e8ee929 100644
--- a/tests/server/src/cases/ServerTests.hx
+++ b/tests/server/src/cases/ServerTests.hx
@@ -130,7 +130,7 @@ class ServerTests extends TestCase {
runHaxe(args2);
runHaxe(args);
- assertSkipping("HelloWorld", Tainted("check_display_file"));
+ assertSkipping("HelloWorld", Tainted("server/invalidate"));
}
function testMutuallyDependent() {
diff --git a/tests/server/src/cases/display/issues/Issue8194.hx b/tests/server/src/cases/display/issues/Issue8194.hx
index 4f9a4c9fa65..3b25ebad19a 100644
--- a/tests/server/src/cases/display/issues/Issue8194.hx
+++ b/tests/server/src/cases/display/issues/Issue8194.hx
@@ -17,7 +17,7 @@ class Issue8194 extends DisplayTestCase {
offset: offset(1),
wasAutoTriggered: true
});
- var result = parseCompletion();
- Assert.equals(null, result.result);
+ var error = haxe.Json.parse(lastResult.stderr).error;
+ Assert.equals("No completion point", error.data[0]);
}
-}
\ No newline at end of file
+}
diff --git a/tests/server/src/cases/issues/Issue11480.hx b/tests/server/src/cases/issues/Issue11480.hx
new file mode 100644
index 00000000000..72dbf6e5494
--- /dev/null
+++ b/tests/server/src/cases/issues/Issue11480.hx
@@ -0,0 +1,26 @@
+package cases.issues;
+
+import haxe.io.Path;
+
+class Issue11480 extends TestCase {
+ function test(_) {
+ vfs.putContent("Main.hx", "function main() {}");
+ var args = [
+ "-main",
+ "Main",
+ "-hl",
+ "bin/out.hl",
+ "-D",
+ "no-compilation"
+ ];
+ runHaxe(args);
+ assertSuccess();
+
+ var std = Path.removeTrailingSlashes(utils.macro.BuildHub.getStd());
+ runHaxeJsonCb(args, DisplayMethods.Hover, {file: new FsPath('${std}/StdTypes.hx'), offset: 0}, (res) -> {
+ // If we don't use the cb version, assertSuccess() below will pass even when request fails..
+ Assert.isNull(res);
+ });
+ assertSuccess();
+ }
+}
diff --git a/tests/server/src/cases/issues/Issue11516.hx b/tests/server/src/cases/issues/Issue11516.hx
new file mode 100644
index 00000000000..b37db566a83
--- /dev/null
+++ b/tests/server/src/cases/issues/Issue11516.hx
@@ -0,0 +1,12 @@
+package cases.issues;
+
+class Issue11516 extends TestCase {
+ function testClass(_) {
+ vfs.putContent("Importson.hx", getTemplate("issues/Issue11516/Importson.hx"));
+ var args = ["Importson", "--interp"];
+ runHaxe(args);
+ runHaxeJsonCb(args, DisplayMethods.Diagnostics, {file: new FsPath("Importson.hx")}, res -> {
+ Assert.equals(0, res.length);
+ });
+ }
+}
diff --git a/tests/server/src/utils/macro/BuildHub.hx b/tests/server/src/utils/macro/BuildHub.hx
new file mode 100644
index 00000000000..55ea3707c16
--- /dev/null
+++ b/tests/server/src/utils/macro/BuildHub.hx
@@ -0,0 +1,7 @@
+package utils.macro;
+
+class BuildHub {
+ macro static public function build();
+ macro static public function getStd();
+}
+
diff --git a/tests/server/src/utils/macro/BuildHub.macro.hx b/tests/server/src/utils/macro/BuildHub.macro.hx
index 47729c879b0..e426c2e8155 100644
--- a/tests/server/src/utils/macro/BuildHub.macro.hx
+++ b/tests/server/src/utils/macro/BuildHub.macro.hx
@@ -19,6 +19,11 @@ class BuildHub {
return TestBuilder.build(fields);
}
+ macro static public function getStd() {
+ var std = haxe.macro.Compiler.getConfiguration().stdPath;
+ return macro $v{std.shift()};
+ }
+
static function isDisplayTest(cls:ClassType):Bool {
if(cls.pack.length == 0 && cls.name == "DisplayTestCase") {
return true;
diff --git a/tests/server/src/utils/macro/TestBuilder.macro.hx b/tests/server/src/utils/macro/TestBuilder.macro.hx
index d28724d2179..383c8fe70fa 100644
--- a/tests/server/src/utils/macro/TestBuilder.macro.hx
+++ b/tests/server/src/utils/macro/TestBuilder.macro.hx
@@ -111,7 +111,10 @@ class TestBuilder {
case EBlock(el):
var posInfos = Context.getPosInfos(f.expr.pos);
var pos = Context.makePosition({min: posInfos.max, max: posInfos.max, file: posInfos.file});
- el.push(macro @:pos(pos) $i{asyncName}.done());
+ el.push(macro @:pos(pos) {
+ if ($i{asyncName}.timedOut) Assert.fail("timeout");
+ else $i{asyncName}.done();
+ });
f.expr = macro {
$i{asyncName}.setTimeout(20000);
${transformHaxeCalls(asyncName, el)};
diff --git a/tests/server/test/templates/issues/Issue11516/Importson.hx b/tests/server/test/templates/issues/Issue11516/Importson.hx
new file mode 100644
index 00000000000..fecef6175dd
--- /dev/null
+++ b/tests/server/test/templates/issues/Issue11516/Importson.hx
@@ -0,0 +1,7 @@
+import haxe.Json as Son;
+
+class Importson {
+ static function main() {
+ Son.parse(null);
+ }
+}
diff --git a/tests/server/test/templates/retyper/AbstractWithDependency.hx b/tests/server/test/templates/retyper/AbstractWithDependency.hx
deleted file mode 100644
index 98672a38bef..00000000000
--- a/tests/server/test/templates/retyper/AbstractWithDependency.hx
+++ /dev/null
@@ -1,5 +0,0 @@
-abstract AbstractWithDependency(String) {
- public static function notMain() {
- trace(Dependency.get());
- }
-}
diff --git a/tests/server/test/templates/retyper/AbstractWithSignatureDependency.hx b/tests/server/test/templates/retyper/AbstractWithSignatureDependency.hx
deleted file mode 100644
index 44665fce269..00000000000
--- a/tests/server/test/templates/retyper/AbstractWithSignatureDependency.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-abstract AbstractWithSignatureDependency(String) {
- public static function test(d:Dependency) {}
-}
diff --git a/tests/server/test/templates/retyper/DependentEnum.hx b/tests/server/test/templates/retyper/DependentEnum.hx
deleted file mode 100644
index d2ae45b2c62..00000000000
--- a/tests/server/test/templates/retyper/DependentEnum.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-enum DependentEnum {
- Constructor(s:Dependency);
-}
diff --git a/tests/server/test/templates/retyper/DependentTypedef.hx b/tests/server/test/templates/retyper/DependentTypedef.hx
deleted file mode 100644
index 430926ec51d..00000000000
--- a/tests/server/test/templates/retyper/DependentTypedef.hx
+++ /dev/null
@@ -1 +0,0 @@
-typedef DependentTypedef = Dependency;
diff --git a/tests/server/test/templates/retyper/IndependentEnum.hx b/tests/server/test/templates/retyper/IndependentEnum.hx
deleted file mode 100644
index 7bac0b72a09..00000000000
--- a/tests/server/test/templates/retyper/IndependentEnum.hx
+++ /dev/null
@@ -1,9 +0,0 @@
-enum IndependentEnum {
- Constructor(s:String);
-}
-
-class MakeDependency {
- static function f() {
- Dependency.get();
- }
-}
diff --git a/tests/server/test/templates/retyper/IndependentTypedef.hx b/tests/server/test/templates/retyper/IndependentTypedef.hx
deleted file mode 100644
index f79493af894..00000000000
--- a/tests/server/test/templates/retyper/IndependentTypedef.hx
+++ /dev/null
@@ -1,7 +0,0 @@
-typedef IndependentTypedef = String;
-
-class MakeDependency {
- static function f() {
- Dependency.get();
- }
-}
diff --git a/tests/server/test/templates/retyper/InterfaceDependency.hx b/tests/server/test/templates/retyper/InterfaceDependency.hx
deleted file mode 100644
index 41f14634ac1..00000000000
--- a/tests/server/test/templates/retyper/InterfaceDependency.hx
+++ /dev/null
@@ -1 +0,0 @@
-interface InterfaceDependency {}
diff --git a/tests/server/test/templates/retyper/MutualDependency.hx b/tests/server/test/templates/retyper/MutualDependency.hx
deleted file mode 100644
index 31ec3dac92b..00000000000
--- a/tests/server/test/templates/retyper/MutualDependency.hx
+++ /dev/null
@@ -1,5 +0,0 @@
-class MutualDependency {
- static public function get() {
- return WithMutualDependency.value;
- }
-}
diff --git a/tests/server/test/templates/retyper/WithInterfaceDependency.hx b/tests/server/test/templates/retyper/WithInterfaceDependency.hx
deleted file mode 100644
index 6de758476a8..00000000000
--- a/tests/server/test/templates/retyper/WithInterfaceDependency.hx
+++ /dev/null
@@ -1 +0,0 @@
-class WithInterfaceDependency implements InterfaceDependency {}
diff --git a/tests/server/test/templates/retyper/WithMutualDependency.hx b/tests/server/test/templates/retyper/WithMutualDependency.hx
deleted file mode 100644
index 8f42bbcf31f..00000000000
--- a/tests/server/test/templates/retyper/WithMutualDependency.hx
+++ /dev/null
@@ -1,7 +0,0 @@
-class WithMutualDependency {
- static public var value = "Hello World";
-
- public static function main() {
- trace(MutualDependency.get());
- }
-}
diff --git a/tests/server/test/templates/retyper/WithParentDependency.hx b/tests/server/test/templates/retyper/WithParentDependency.hx
deleted file mode 100644
index 07d6d8fdb6a..00000000000
--- a/tests/server/test/templates/retyper/WithParentDependency.hx
+++ /dev/null
@@ -1 +0,0 @@
-class WithParentDependency extends Dependency {}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependency.hx b/tests/server/test/templates/retyper/WithSignatureDependency.hx
deleted file mode 100644
index 4fab1e39ad8..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependency.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-class WithSignatureDependency {
- public static function test(d:Dependency) {}
-}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependencyInferredArg.hx b/tests/server/test/templates/retyper/WithSignatureDependencyInferredArg.hx
deleted file mode 100644
index 0d71cf928d0..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependencyInferredArg.hx
+++ /dev/null
@@ -1,5 +0,0 @@
-class WithSignatureDependency {
- public static function test(d) {
- d = new Dependency();
- }
-}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependencyInferredProperty.hx b/tests/server/test/templates/retyper/WithSignatureDependencyInferredProperty.hx
deleted file mode 100644
index ca47aa5f6f6..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependencyInferredProperty.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-class WithSignatureDependency {
- public static var test(default, null) = new Dependency();
-}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependencyInferredRet.hx b/tests/server/test/templates/retyper/WithSignatureDependencyInferredRet.hx
deleted file mode 100644
index 1e1bbde3a59..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependencyInferredRet.hx
+++ /dev/null
@@ -1,5 +0,0 @@
-class WithSignatureDependency {
- public static function test() {
- return new Dependency();
- }
-}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependencyInferredVariable.hx b/tests/server/test/templates/retyper/WithSignatureDependencyInferredVariable.hx
deleted file mode 100644
index 8c3e7c8ca3e..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependencyInferredVariable.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-class WithSignatureDependency {
- public static var test = new Dependency();
-}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependencyProperty.hx b/tests/server/test/templates/retyper/WithSignatureDependencyProperty.hx
deleted file mode 100644
index 49e17954312..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependencyProperty.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-class WithSignatureDependency {
- public static var test(default, null):Dependency;
-}
diff --git a/tests/server/test/templates/retyper/WithSignatureDependencyVariable.hx b/tests/server/test/templates/retyper/WithSignatureDependencyVariable.hx
deleted file mode 100644
index f2e5fa60a64..00000000000
--- a/tests/server/test/templates/retyper/WithSignatureDependencyVariable.hx
+++ /dev/null
@@ -1,3 +0,0 @@
-class WithSignatureDependency {
- public static var test:Dependency;
-}
diff --git a/tests/unit/.vscode/settings.json b/tests/unit/.vscode/settings.json
index 1bd9f6fda38..2465d13c053 100644
--- a/tests/unit/.vscode/settings.json
+++ b/tests/unit/.vscode/settings.json
@@ -11,7 +11,7 @@
"editor.formatOnPaste": true
},
"editor.codeActionsOnSave": {
- "source.sortImports": true
+ "source.sortImports": "explicit"
},
"haxe.displayServer": {
"arguments": ["-v"]
diff --git a/tests/unit/compile-hxb-interp-roundtrip.hxml b/tests/unit/compile-hxb-interp-roundtrip.hxml
new file mode 100644
index 00000000000..d0d342269ef
--- /dev/null
+++ b/tests/unit/compile-hxb-interp-roundtrip.hxml
@@ -0,0 +1,7 @@
+compile-macro.hxml
+--hxb bin/hxb/eval.zip
+
+--next
+
+compile-macro.hxml
+--hxb-lib bin/hxb/eval.zip
\ No newline at end of file
diff --git a/tests/unit/compile-hxb-jvm-roundtrip.hxml b/tests/unit/compile-hxb-jvm-roundtrip.hxml
new file mode 100644
index 00000000000..121de138f11
--- /dev/null
+++ b/tests/unit/compile-hxb-jvm-roundtrip.hxml
@@ -0,0 +1,7 @@
+compile-jvm-only.hxml
+--hxb hxb-config/jvm.json
+
+--next
+
+compile-jvm-only.hxml
+--hxb-lib bin/hxb/unit.java.zip
\ No newline at end of file
diff --git a/tests/unit/compile-java-native.hxml b/tests/unit/compile-java-native.hxml
new file mode 100644
index 00000000000..f4c033c82d9
--- /dev/null
+++ b/tests/unit/compile-java-native.hxml
@@ -0,0 +1,2 @@
+#java native build
+-cmd "haxelib run hxjava native_java/hxjava_build.txt --out native_java/native"
\ No newline at end of file
diff --git a/tests/unit/compile-java.hxml b/tests/unit/compile-java.hxml
index 96b73c4a015..33e92d21898 100644
--- a/tests/unit/compile-java.hxml
+++ b/tests/unit/compile-java.hxml
@@ -1,5 +1,4 @@
-#java native build
--cmd "haxelib run hxjava native_java/hxjava_build.txt --out native_java/native"
+compile-java-native.hxml
--next
diff --git a/tests/unit/compile-jvm.hxml b/tests/unit/compile-jvm.hxml
index b373274d804..94d3ae9abc7 100644
--- a/tests/unit/compile-jvm.hxml
+++ b/tests/unit/compile-jvm.hxml
@@ -1,5 +1,4 @@
-#java native build
--cmd "haxelib run hxjava native_java/hxjava_build.txt --out native_java/native"
+compile-java-native.hxml
--next
diff --git a/tests/unit/hxb-config/jvm.json b/tests/unit/hxb-config/jvm.json
new file mode 100644
index 00000000000..61707a6ea6a
--- /dev/null
+++ b/tests/unit/hxb-config/jvm.json
@@ -0,0 +1,10 @@
+{
+ "archivePath": "bin/hxb/unit.$target.zip",
+ "targetConfig": {
+ "exclude": ["unit.TestMainNow"],
+ "generateDocumentation": false
+ },
+ "macroConfig": {
+ "generateDocumentation": false
+ }
+}
\ No newline at end of file
diff --git a/tests/unit/src/unit/TestMain.hx b/tests/unit/src/unit/TestMain.hx
index 2fa17c82da7..044bfd3f0ee 100644
--- a/tests/unit/src/unit/TestMain.hx
+++ b/tests/unit/src/unit/TestMain.hx
@@ -31,9 +31,7 @@ function main() {
cs.system.threading.Thread.CurrentThread.CurrentCulture = new cs.system.globalization.CultureInfo('tr-TR');
cs.Lib.applyCultureChanges();
#end
- #if !macro
- trace("Generated at: " + HelperMacros.getCompilationDate());
- #end
+ TestMainNow.printNow();
trace("START");
#if flash
var tf:flash.text.TextField = untyped flash.Boot.getTrace();
diff --git a/tests/unit/src/unit/TestMainNow.hx b/tests/unit/src/unit/TestMainNow.hx
new file mode 100644
index 00000000000..fa44d5fdf31
--- /dev/null
+++ b/tests/unit/src/unit/TestMainNow.hx
@@ -0,0 +1,9 @@
+package unit;
+
+class TestMainNow {
+ static public function printNow() {
+ #if !macro
+ trace("Generated at: " + HelperMacros.getCompilationDate());
+ #end
+ }
+}
diff --git a/tests/unit/src/unit/TestMisc.hx b/tests/unit/src/unit/TestMisc.hx
index 9759b2b8ec8..dc023ba45ac 100644
--- a/tests/unit/src/unit/TestMisc.hx
+++ b/tests/unit/src/unit/TestMisc.hx
@@ -1,9 +1,9 @@
package unit;
+
import unit.MyClass;
class MyDynamicClass {
-
- var v : Int;
+ var v:Int;
public function new(v) {
this.v = v;
@@ -13,74 +13,74 @@ class MyDynamicClass {
return v;
}
- public dynamic function add(x,y) {
+ public dynamic function add(x, y) {
return v + x + y;
}
- public inline function iadd(x,y) {
+ public inline function iadd(x, y) {
return v + x + y;
}
static var Z = 10;
- public dynamic static function staticDynamic(x,y) {
+ public dynamic static function staticDynamic(x, y) {
return Z + x + y;
}
- @:isVar public static var W(get, set) : Int = 55;
- static function get_W() return W + 2;
- static function set_W(v) { W = v; return v; }
+ @:isVar public static var W(get, set):Int = 55;
+
+ static function get_W()
+ return W + 2;
+ static function set_W(v) {
+ W = v;
+ return v;
+ }
}
class MyDynamicSubClass extends MyDynamicClass {
-
- override function add(x,y) {
+ override function add(x, y) {
return (v + x + y) * 2;
}
-
}
class MyDynamicSubClass2 extends MyDynamicClass {
-
- override dynamic function add(x,y) {
+ override dynamic function add(x, y) {
return (v + x + y) * 2;
}
-
}
class MyOtherDynamicClass extends MyDynamicClass {
-
public function new(v) {
- add = function(x,y) return x + y + 10;
+ add = function(x, y) return x + y + 10;
super(v);
}
-
}
interface IDefArgs {
- public function get( x : Int = 5 ) : Int;
+ public function get(x:Int = 5):Int;
}
class BaseDefArgs {
- public function get( x = 3 ) {
+ public function get(x = 3) {
return x;
}
}
class ExtDefArgs extends BaseDefArgs implements IDefArgs {
- public function new() {
- }
- override function get( x = 7 ) {
+ public function new() {}
+
+ override function get(x = 7) {
return x;
}
}
class BaseConstrOpt {
- public var s : String;
- public var i : Int;
- public var b : Bool;
- public function new( s = "test", i = -5, b = true ) {
+ public var s:String;
+ public var i:Int;
+ public var b:Bool;
+
+ public function new(s = "test", i = -5, b = true) {
this.s = s;
this.i = i;
this.b = b;
@@ -98,8 +98,8 @@ class SubConstrOpt2 extends BaseConstrOpt {
}
class SubConstrOpt3 extends BaseConstrOpt {
- public function new( s = "test2", i = -6 ) {
- super(s,i);
+ public function new(s = "test2", i = -6) {
+ super(s, i);
}
}
@@ -110,127 +110,125 @@ enum abstract MyEnumAbstract(Int) {
}
class TestMisc extends Test {
-
static var unit = "testing package conflict";
- function testPackageConflict()
- {
- eq( unit, "testing package conflict" );
+ function testPackageConflict() {
+ eq(unit, "testing package conflict");
var unit = unit;
- eq( unit, TestMisc.unit );
+ eq(unit, TestMisc.unit);
}
function testDate() {
var d = new Date(2012, 7, 17, 1, 2, 3);
- eq( d.getDay(), 5 );
+ eq(d.getDay(), 5);
- eq( d.getDate(), 17 );
- eq( d.getMonth(), 7 );
- eq( d.getFullYear(), 2012 );
+ eq(d.getDate(), 17);
+ eq(d.getMonth(), 7);
+ eq(d.getFullYear(), 2012);
- eq( d.getHours(), 1 );
- eq( d.getMinutes(), 2 );
- eq( d.getSeconds(), 3 );
+ eq(d.getHours(), 1);
+ eq(d.getMinutes(), 2);
+ eq(d.getSeconds(), 3);
- //seems to be system-dependent?
- //eq( d.getTime(), 1345158123000 );
- eq( d.toString(), "2012-08-17 01:02:03" );
+ // seems to be system-dependent?
+ // eq( d.getTime(), 1345158123000 );
+ eq(d.toString(), "2012-08-17 01:02:03");
}
function testClosure() {
var c = new MyClass(100);
var add = c.add;
- eq( c.add(1,2), 103 );
- eq( c.add.bind(1)(2), 103 );
- eq( add(1,2), 103 );
+ eq(c.add(1, 2), 103);
+ eq(c.add.bind(1)(2), 103);
+ eq(add(1, 2), 103);
var x = 4;
var f = function() return x;
- eq( f(), 4 );
+ eq(f(), 4);
x++;
- eq( f(), 5 );
+ eq(f(), 5);
- var o = { f : f };
- eq( o.f(), 5 );
- eq( o.f, o.f ); // we shouldn't create a new closure here
+ var o = {f: f};
+ eq(o.f(), 5);
+ eq(o.f, o.f); // we shouldn't create a new closure here
- var o = { add : c.add };
- eq( o.add(1,2), 103 );
- eq( o.add, o.add ); // we shouldn't create a new closure here
+ var o = {add: c.add};
+ eq(o.add(1, 2), 103);
+ eq(o.add, o.add); // we shouldn't create a new closure here
- var o = { cos : Math.cos };
- eq( o.cos(0), 1. );
+ var o = {cos: Math.cos};
+ eq(o.cos(0), 1.);
// check enum
var c = MyEnum.C;
- t( Type.enumEq(MyEnum.C(1,"hello"), c(1,"hello")) );
+ t(Type.enumEq(MyEnum.C(1, "hello"), c(1, "hello")));
}
// make sure that captured variables does not overlap each others even if in different scopes
function testCaptureUnique() {
var foo = null, bar = null;
var flag = true;
- if( flag ) {
+ if (flag) {
var x = 1;
foo = function() return x;
}
- if( flag ) {
+ if (flag) {
var x = 2;
bar = function() return x;
}
- eq( foo(), 1);
- eq( bar(), 2);
+ eq(foo(), 1);
+ eq(bar(), 2);
}
function testCaptureUnique2() {
// another more specialized test (was actually the original broken code - but not reproducible when optimization is off)
var foo = id.bind(3);
var bar = sq.bind(5);
- eq( foo(), 3 );
- eq( bar(), 25 );
+ eq(foo(), 3);
+ eq(bar(), 25);
}
function testSelfRef() {
// check for self-name binding
var bla = 55;
var bla = function() return bla;
- eq( bla(), 55);
+ eq(bla(), 55);
}
function testHiddenType() {
var haxe = 20;
- eq( std.haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
- eq( haxe, 20);
+ eq(std.haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
+ eq(haxe, 20);
var Std = 50;
- eq( std.Std.int(45.3), 45);
- eq( Std, 50);
+ eq(std.Std.int(45.3), 45);
+ eq(Std, 50);
}
function testHiddenTypeScope() {
var flag = true;
- if( flag ) {
+ if (flag) {
var haxe = 20;
var Std = 50;
- eq( haxe, 20);
- eq( Std, 50);
+ eq(haxe, 20);
+ eq(Std, 50);
}
- eq( std.haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
- eq( std.Std.int(45.3), 45);
+ eq(std.haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
+ eq(std.Std.int(45.3), 45);
}
function testHiddenTypeCapture() {
var flag = true;
var foo = null, bar = null;
- if( flag ) {
+ if (flag) {
var haxe = 20;
var Std = 50;
foo = function() return haxe;
bar = function() return Std;
}
- eq( std.haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
- eq( std.Std.int(45.3), 45);
- eq( foo(), 20);
- eq( bar(), 50);
+ eq(std.haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
+ eq(std.Std.int(45.3), 45);
+ eq(foo(), 20);
+ eq(bar(), 50);
}
function id(x:T) {
@@ -248,80 +246,83 @@ class TestMisc extends Test {
function testInlineClosure() {
var inst = new MyDynamicClass(100);
var add = inst.iadd;
- eq( inst.iadd(1,2), 103 );
- eq( add(1,2), 103 );
+ eq(inst.iadd(1, 2), 103);
+ eq(add(1, 2), 103);
}
function testDynamicClosure() {
var inst = new MyDynamicClass(100);
var add = inst.add;
- eq( inst.add(1,2), 103 );
- eq( inst.add.bind(1)(2), 103 );
- eq( add(1,2), 103 );
+ eq(inst.add(1, 2), 103);
+ eq(inst.add.bind(1)(2), 103);
+ eq(add(1, 2), 103);
// check overridden dynamic method
var inst = new MyDynamicSubClass(100);
var add = inst.add;
- eq( inst.add(1,2), 206 );
- eq( inst.add.bind(1)(2), 206 );
- eq( add(1,2), 206 );
+ eq(inst.add(1, 2), 206);
+ eq(inst.add.bind(1)(2), 206);
+ eq(add(1, 2), 206);
// check overridden dynamic method
var inst = new MyDynamicSubClass2(100);
var add = inst.add;
- eq( inst.add(1,2), 206 );
- eq( inst.add.bind(1)(2), 206 );
- eq( add(1,2), 206 );
+ eq(inst.add(1, 2), 206);
+ eq(inst.add.bind(1)(2), 206);
+ eq(add(1, 2), 206);
// check redefined dynamic method
- inst.add = function(x,y) return inst.get() * 2 + x + y;
+ inst.add = function(x, y) return inst.get() * 2 + x + y;
var add = inst.add;
- eq( inst.add(1,2), 203 );
- eq( inst.add.bind(1)(2), 203 );
- eq( add(1,2), 203 );
+ eq(inst.add(1, 2), 203);
+ eq(inst.add.bind(1)(2), 203);
+ eq(add(1, 2), 203);
// check inherited dynamic method
var inst = new MyOtherDynamicClass(0);
var add = inst.add;
- #if (!cs && !java) //see https://groups.google.com/d/msg/haxedev/TUaUykoTpq8/Q4XwcL4UyNUJ
- eq( inst.add(1,2), 13 );
- eq( inst.add.bind(1)(2), 13 );
- eq( add(1,2), 13 );
+ #if (!cs && (!java || jvm)) // see https://groups.google.com/d/msg/haxedev/TUaUykoTpq8/Q4XwcL4UyNUJ
+ eq(inst.add(1, 2), 13);
+ eq(inst.add.bind(1)(2), 13);
+ eq(add(1, 2), 13);
#end
// check static dynamic
- eq( MyDynamicClass.staticDynamic(1,2), 13 );
- MyDynamicClass.staticDynamic = function(x,y) return x + y + 100;
- eq( MyDynamicClass.staticDynamic(1,2), 103 );
+ eq(MyDynamicClass.staticDynamic(1, 2), 13);
+ MyDynamicClass.staticDynamic = function(x, y) return x + y + 100;
+ eq(MyDynamicClass.staticDynamic(1, 2), 103);
}
- function testMakeVarArgs () {
- var f = function (a:Array) {
+ function testMakeVarArgs() {
+ var f = function(a:Array) {
eq(a.length, 2);
return a[0] + a[1];
}
var g = Reflect.makeVarArgs(f);
- var res = g(1,2);
+ var res = g(1, 2);
eq(3, res);
}
function testMD5() {
- eq( haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e" );
- eq( haxe.crypto.Md5.encode("hello"), "5d41402abc4b2a76b9719d911017c592" );
+ eq(haxe.crypto.Md5.encode(""), "d41d8cd98f00b204e9800998ecf8427e");
+ eq(haxe.crypto.Md5.encode("hello"), "5d41402abc4b2a76b9719d911017c592");
// depending of ISO/UTF8 native
- allow( haxe.crypto.Md5.encode("héllo"), ["1a722f7e6c801d9e470a10cb91ba406d", "be50e8478cf24ff3595bc7307fb91b50"] );
+ allow(haxe.crypto.Md5.encode("héllo"), ["1a722f7e6c801d9e470a10cb91ba406d", "be50e8478cf24ff3595bc7307fb91b50"]);
- eq( haxe.io.Bytes.ofString("héllo").toHex(), "68c3a96c6c6f");
- eq( haxe.crypto.Md5.make(haxe.io.Bytes.ofString("héllo")).toHex(), "be50e8478cf24ff3595bc7307fb91b50" );
+ eq(haxe.io.Bytes.ofString("héllo").toHex(), "68c3a96c6c6f");
+ eq(haxe.crypto.Md5.make(haxe.io.Bytes.ofString("héllo")).toHex(), "be50e8478cf24ff3595bc7307fb91b50");
}
function testSHA1() {
- eq( haxe.crypto.Sha1.encode(""), "da39a3ee5e6b4b0d3255bfef95601890afd80709" );
- eq( haxe.crypto.Sha1.encode("hello"), "aaf4c61ddcc5e8a2dabede0f3b482cd9aea9434d" );
+ eq(haxe.crypto.Sha1.encode(""), "da39a3ee5e6b4b0d3255bfef95601890afd80709");
+ eq(haxe.crypto.Sha1.encode("hello"), "aaf4c61ddcc5e8a2dabede0f3b482cd9aea9434d");
// depending of ISO/UTF8 native
- allow( haxe.crypto.Sha1.encode("héllo"), ["028db752c14604d624e8b1c121d600c427b8a3ba","35b5ea45c5e41f78b46a937cc74d41dfea920890"] );
+ allow(haxe.crypto.Sha1.encode("héllo"), [
+ "028db752c14604d624e8b1c121d600c427b8a3ba",
+ "35b5ea45c5e41f78b46a937cc74d41dfea920890"
+ ]);
- eq( haxe.crypto.Sha1.make(haxe.io.Bytes.ofString("héllo")).toHex(), "35b5ea45c5e41f78b46a937cc74d41dfea920890" );
+ eq(haxe.crypto.Sha1.make(haxe.io.Bytes.ofString("héllo")).toHex(), "35b5ea45c5e41f78b46a937cc74d41dfea920890");
}
function testBaseCode() {
@@ -338,84 +339,84 @@ class TestMisc extends Test {
// alternative base64
var b = new haxe.crypto.BaseCode(haxe.io.Bytes.ofString("0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-"));
- eq( b.encodeString("Héllow"), "iceFr6NLtM" );
- eq( b.decodeString("iceFr6NLtM"), "Héllow" );
+ eq(b.encodeString("Héllow"), "iceFr6NLtM");
+ eq(b.decodeString("iceFr6NLtM"), "Héllow");
// base32-hex
var b = new haxe.crypto.BaseCode(haxe.io.Bytes.ofString("0123456789ABCDEFGHIJKLMNOPQRSTUV"));
- eq( b.encodeString("foo"), "CPNMU" );
- eq( b.decodeString("CPNMU"), "foo" );
+ eq(b.encodeString("foo"), "CPNMU");
+ eq(b.decodeString("CPNMU"), "foo");
}
function testUrlEncode() {
- eq( StringTools.urlEncode("é"), "%C3%A9" );
- eq( StringTools.urlDecode("%C3%A9"), "é" );
+ eq(StringTools.urlEncode("é"), "%C3%A9");
+ eq(StringTools.urlDecode("%C3%A9"), "é");
- eq( StringTools.urlEncode("a/b+c"), "a%2Fb%2Bc");
- eq( StringTools.urlDecode("a%2Fb%2Bc"), "a/b+c");
+ eq(StringTools.urlEncode("a/b+c"), "a%2Fb%2Bc");
+ eq(StringTools.urlDecode("a%2Fb%2Bc"), "a/b+c");
}
- function opt1( ?x : Int, ?y : String ) {
- return { x : x, y : y };
+ function opt1(?x:Int, ?y:String) {
+ return {x: x, y: y};
}
- function opt2( ?x = 5, ?y = "hello" ) {
- return { x : x, y : y };
+ function opt2(?x = 5, ?y = "hello") {
+ return {x: x, y: y};
}
- function opt3( ?x : Null = 5, ?y : Null = 6 ) {
- return { x : x, y : y };
+ function opt3(?x:Null = 5, ?y:Null = 6) {
+ return {x: x, y: y};
}
- function opt4( x = 10 ) : Null {
+ function opt4(x = 10):Null {
return x + 1;
}
function testOptionalParams() {
- eq( opt1().x, null );
- eq( opt1().y, null );
- eq( opt1(55).x, 55 );
- eq( opt1(55).y, null );
- eq( opt1("str").x, null );
- eq( opt1("str").y, "str" );
- eq( opt1(66,"hello").x, 66 );
- eq( opt1(66, "hello").y, "hello" );
-
- eq( opt2().x, 5 );
- eq( opt2().y, "hello" );
+ eq(opt1().x, null);
+ eq(opt1().y, null);
+ eq(opt1(55).x, 55);
+ eq(opt1(55).y, null);
+ eq(opt1("str").x, null);
+ eq(opt1("str").y, "str");
+ eq(opt1(66, "hello").x, 66);
+ eq(opt1(66, "hello").y, "hello");
+
+ eq(opt2().x, 5);
+ eq(opt2().y, "hello");
#if !(flash || cpp || cs || java)
- eq( opt2(null, null).x, 5 );
+ eq(opt2(null, null).x, 5);
#end
- eq( opt2(0, null).y, "hello" );
-
- eq( opt3().x, 5 );
- eq( opt3().y, 6 );
- eq( opt3(9).x, 9 );
- eq( opt3(9).y, 6 );
- eq( opt3(9,10).x, 9 );
- eq( opt3(9,10).y, 10 );
- eq( opt3(null,null).x, 5 );
- eq( opt3(null,null).y, 6 );
- eq( opt3(null).x, 5 );
- eq( opt3(null).y, 6 );
- eq( opt3(null,7).x, 5 );
- eq( opt3(null, 7).y, 7 );
+ eq(opt2(0, null).y, "hello");
+
+ eq(opt3().x, 5);
+ eq(opt3().y, 6);
+ eq(opt3(9).x, 9);
+ eq(opt3(9).y, 6);
+ eq(opt3(9, 10).x, 9);
+ eq(opt3(9, 10).y, 10);
+ eq(opt3(null, null).x, 5);
+ eq(opt3(null, null).y, 6);
+ eq(opt3(null).x, 5);
+ eq(opt3(null).y, 6);
+ eq(opt3(null, 7).x, 5);
+ eq(opt3(null, 7).y, 7);
// skipping
- eq( opt3(7.4).x, 5 );
- eq( opt3(7.4).y, 7.4 );
+ eq(opt3(7.4).x, 5);
+ eq(opt3(7.4).y, 7.4);
- eq( opt4(), 11 );
+ eq(opt4(), 11);
#if !static
- eq( opt4(null), 11 );
+ eq(opt4(null), 11);
#end
- var opt4b : ?Int -> Null = opt4;
- eq( opt4b(), 11 );
- eq( opt4b(3), 4 );
+ var opt4b:?Int->Null = opt4;
+ eq(opt4b(), 11);
+ eq(opt4b(3), 4);
#if !static
- eq( opt4b(null), 11 );
+ eq(opt4b(null), 11);
#end
// don't compile because we restrict nullability of function param or return type
@@ -430,107 +431,108 @@ class TestMisc extends Test {
function testIncr() {
var z = 0;
- eq( z++, 0 );
- eq( z, 1 );
- eq( ++z, 2 );
- eq( z, 2 );
+ eq(z++, 0);
+ eq(z, 1);
+ eq(++z, 2);
+ eq(z, 2);
z++;
- eq( z, 3 );
+ eq(z, 3);
++z;
- eq( z, 4 );
+ eq(z, 4);
- eq( z += 3, 7 );
+ eq(z += 3, 7);
var x = 0;
var arr = [3];
- eq( arr[x++]++, 3 );
- eq( x, 1 );
- eq( arr[0], 4 );
+ eq(arr[x++]++, 3);
+ eq(x, 1);
+ eq(arr[0], 4);
x = 0;
- eq( arr[x++] += 3, 7 );
- eq( arr[0], 7 );
+ eq(arr[x++] += 3, 7);
+ eq(arr[0], 7);
var x = 0;
- var arr = [{ v : 3 }];
- eq( arr[x++].v++, 3 );
- eq( x, 1 );
- eq( arr[0].v, 4 );
+ var arr = [{v: 3}];
+ eq(arr[x++].v++, 3);
+ eq(x, 1);
+ eq(arr[0].v, 4);
x = 0;
- eq( arr[x++].v += 3, 7 );
- eq( arr[0].v, 7 );
+ eq(arr[x++].v += 3, 7);
+ eq(arr[0].v, 7);
x = 0;
- var arr:Dynamic = [{ v : 3 }];
- eq( arr[x++].v++, 3 );
- eq( x, 1 );
- eq( arr[0].v, 4 );
+ var arr:Dynamic = [{v: 3}];
+ eq(arr[x++].v++, 3);
+ eq(x, 1);
+ eq(arr[0].v, 4);
x = 0;
- eq( arr[x++].v += 3, 7 );
- eq( arr[0].v, 7 );
+ eq(arr[x++].v += 3, 7);
+ eq(arr[0].v, 7);
}
function testInitOrder() {
var i = 0;
var o = {
- y : i++,
- x : i++,
- z : i++,
- blabla : i++,
+ y: i++,
+ x: i++,
+ z: i++,
+ blabla: i++,
};
- eq(o.y,0);
- eq(o.x,1);
- eq(o.z,2);
- eq(o.blabla,3);
+ eq(o.y, 0);
+ eq(o.x, 1);
+ eq(o.z, 2);
+ eq(o.blabla, 3);
}
- static inline function foo(x) return x + 5;
+ static inline function foo(x)
+ return x + 5;
function testInline() {
// check that operations are correctly generated
var x = 3; // prevent optimization
- eq( 2 * foo(x), 16 );
- eq( -foo(x), -8 );
+ eq(2 * foo(x), 16);
+ eq(-foo(x), -8);
}
function testEvalAccessOrder() {
- var a = [0,0];
+ var a = [0, 0];
var x = 0;
a[x++]++;
- eq(a[0],1);
- eq(a[1],0);
+ eq(a[0], 1);
+ eq(a[1], 0);
var x = 0;
var a = new Array();
a[x++] = x++;
- eq(a[0],1);
+ eq(a[0], 1);
var x = 0;
var foo = function() return x++;
a[foo()] = foo();
- eq(a[0],1);
+ eq(a[0], 1);
}
- static var add = function (x, y) return x + y;
+ static var add = function(x, y) return x + y;
function testStaticVarFun() {
- eq( add(2,3), 5);
+ eq(add(2, 3), 5);
}
function testDefArgs() {
var e = new ExtDefArgs();
- eq( e.get(), 7 );
- var b : BaseDefArgs = e;
- eq( b.get(), 7 );
- var i : IDefArgs = e;
- eq( i.get(), 7 );
+ eq(e.get(), 7);
+ var b:BaseDefArgs = e;
+ eq(b.get(), 7);
+ var i:IDefArgs = e;
+ eq(i.get(), 7);
}
function testStringBuf() {
var b = new StringBuf();
eq(b.length, 0);
- b.add( -45);
+ b.add(-45);
b.add(1.456);
b.add(null);
b.add(true);
@@ -542,26 +544,23 @@ class TestMisc extends Test {
eq(b.length, 30);
}
- function testToString():Void
- {
- var x = { toString : function() return "foo" };
- eq( Std.string(x), "foo" );
-
- //var x1:Dynamic = new MyDynamicChildWithToString();
- //eq( Std.string(x1), "Custom toString" );
-//
- //var x2:Dynamic = new MyDynamicChildWithoutToString();
- //x2.toString = function() return "foo";
- //eq( Std.string(x2), "foo" );
+ function testToString():Void {
+ var x = {toString: function() return "foo"};
+ eq(Std.string(x), "foo");
+ // var x1:Dynamic = new MyDynamicChildWithToString();
+ // eq( Std.string(x1), "Custom toString" );
+ //
+ // var x2:Dynamic = new MyDynamicChildWithoutToString();
+ // x2.toString = function() return "foo";
+ // eq( Std.string(x2), "foo" );
}
#if !macro
- function testFormat()
- {
+ function testFormat() {
var x = 5;
var y = 6;
- eq('$x${x+y}', "511");
+ eq('$x${x + y}', "511");
}
#end
@@ -596,16 +595,18 @@ class TestMisc extends Test {
function test():String {
throw "never call me";
};
- var s = try test() catch(e:String) e;
- eq(s,"never call me");
+ var s = try test() catch (e:String) e;
+ eq(s, "never call me");
- function test():String throw "never call me";
- var s = try test() catch(e:String) e;
- eq(s,"never call me");
+ function test():String
+ throw "never call me";
+ var s = try test() catch (e:String) e;
+ eq(s, "never call me");
}
static var nf1:Base = null;
static var nf2:{s:String} = null;
+
function testNullFieldAccess() {
eq("NPE", try nf1.s catch (e:Any) "NPE");
eq("NPE", try nf2.s catch (e:Any) "NPE");
diff --git a/tests/unit/src/unit/issues/Issue10783.hx b/tests/unit/src/unit/issues/Issue10783.hx
new file mode 100644
index 00000000000..c7ce2c8d41e
--- /dev/null
+++ b/tests/unit/src/unit/issues/Issue10783.hx
@@ -0,0 +1,17 @@
+package unit.issues;
+
+class Issue10783 extends Test {
+ function test() {
+ eq(4, log2Unsigned(16));
+ }
+
+ @:pure inline function log2Unsigned(n:Int):Int {
+ var res = 0;
+
+ while ((n >>>= 1) != 0) {
+ res++;
+ }
+
+ return res;
+ }
+}
diff --git a/tests/unit/src/unit/issues/Issue11488.hx b/tests/unit/src/unit/issues/Issue11488.hx
new file mode 100644
index 00000000000..859af58b326
--- /dev/null
+++ b/tests/unit/src/unit/issues/Issue11488.hx
@@ -0,0 +1,29 @@
+package unit.issues;
+
+private class Parent {
+ public var that:Parent;
+ public var visible(default, set) = true;
+
+ public function new()
+ that = this;
+
+ public function set_visible(v:Bool) {
+ throw "set_visible was called";
+ }
+
+ public function drawRec() {}
+}
+
+private class Child extends Parent {
+ override function drawRec() {
+ @:bypassAccessor that.visible = false;
+ }
+}
+
+class Issue11488 extends Test {
+ function test() {
+ var child = new Child();
+ child.drawRec();
+ f(child.visible);
+ }
+}
diff --git a/tests/unit/src/unit/issues/Issue5862.hx b/tests/unit/src/unit/issues/Issue5862.hx
index 1ff8e731372..5638da7465f 100644
--- a/tests/unit/src/unit/issues/Issue5862.hx
+++ b/tests/unit/src/unit/issues/Issue5862.hx
@@ -1,4 +1,5 @@
package unit.issues;
+
import haxe.ds.*;
#if java
import java.NativeArray;
@@ -7,105 +8,109 @@ import cs.NativeArray;
#end
class Issue5862 extends Test {
-#if (java || cs)
- public function test() {
- var imap = new IntMap();
- imap.set(0, "val1");
- imap.set(1, "val2");
- imap.set(2, "val3");
- imap.set(2, "changed_val3");
+ #if (java || cs)
+ public function test() {
+ var imap = new IntMap();
+ imap.set(0, "val1");
+ imap.set(1, "val2");
+ imap.set(2, "val3");
+ imap.set(2, "changed_val3");
- var v:Vector = cast @:privateAccess imap.vals;
- for (i in 0...v.length) {
- t(v[i] != "val3");
- }
+ #if !jvm
+ var v:Vector = cast @:privateAccess imap.vals;
+ for (i in 0...v.length) {
+ t(v[i] != "val3");
+ }
+ #end
- var smap = new StringMap();
- smap.set("v1", "val1");
- smap.set("v2", "val2");
- smap.set("v3", "val3");
- smap.set("v3", "changed_val3");
+ var smap = new StringMap();
+ smap.set("v1", "val1");
+ smap.set("v2", "val2");
+ smap.set("v3", "val3");
+ smap.set("v3", "changed_val3");
- #if !jvm
- var v:Vector = cast @:privateAccess smap.vals;
- for (i in 0...v.length) {
- t(v[i] != "val3");
- }
- #end
+ #if !jvm
+ var v:Vector = cast @:privateAccess smap.vals;
+ for (i in 0...v.length) {
+ t(v[i] != "val3");
+ }
+ #end
- var omap = new ObjectMap<{}, String>();
- omap.set(imap, "val1");
- omap.set(smap, "val2");
- omap.set(omap, "val3");
- omap.set(omap, "changed_val3");
+ var omap = new ObjectMap<{}, String>();
+ omap.set(imap, "val1");
+ omap.set(smap, "val2");
+ omap.set(omap, "val3");
+ omap.set(omap, "changed_val3");
- var v:Vector = cast @:privateAccess omap.vals;
- for (i in 0...v.length) {
- t(v[i] != "val3");
- }
-#if java
- var wmap = new WeakMap<{}, String>();
- wmap.set(imap, "val1");
- wmap.set(smap, "val2");
- wmap.set(omap, "val3");
- wmap.set(omap, "changed_val3");
+ var v:Vector = cast @:privateAccess omap.vals;
+ for (i in 0...v.length) {
+ t(v[i] != "val3");
+ }
+ #if java
+ var wmap = new WeakMap<{}, String>();
+ wmap.set(imap, "val1");
+ wmap.set(smap, "val2");
+ wmap.set(omap, "val3");
+ wmap.set(omap, "changed_val3");
- var v = @:privateAccess wmap.entries;
- for (i in 0...v.length) {
- t(v[i] == null || v[i].value != "val3");
- }
-#end
+ var v = @:privateAccess wmap.entries;
+ for (i in 0...v.length) {
+ t(v[i] == null || v[i].value != "val3");
+ }
+ #end
- var imap = new IntMap();
- imap.set(0, "val1");
- imap.set(1, "val2");
- imap.set(2, "val3");
- imap.set(2, "changed_val3");
- imap.set(1, "changed_val2");
+ var imap = new IntMap();
+ imap.set(0, "val1");
+ imap.set(1, "val2");
+ imap.set(2, "val3");
+ imap.set(2, "changed_val3");
+ imap.set(1, "changed_val2");
- var v:Vector = cast @:privateAccess imap.vals;
- for (i in 0...v.length) {
- t(v[i] != "val2");
- }
+ #if !jvm
+ var v:Vector = cast @:privateAccess imap.vals;
+ for (i in 0...v.length) {
+ t(v[i] != "val2");
+ }
+ #end
- var smap = new StringMap();
- smap.set("v1", "val1");
- smap.set("v2", "val2");
- smap.set("v3", "val3");
- smap.set("v3", "changed_val3");
- smap.set("v2", "changed_val2");
+ var smap = new StringMap();
+ smap.set("v1", "val1");
+ smap.set("v2", "val2");
+ smap.set("v3", "val3");
+ smap.set("v3", "changed_val3");
+ smap.set("v2", "changed_val2");
- #if !jvm
- var v:Vector = cast @:privateAccess smap.vals;
- for (i in 0...v.length) {
- t(v[i] != "val2");
- }
- #end
+ #if !jvm
+ var v:Vector = cast @:privateAccess smap.vals;
+ for (i in 0...v.length) {
+ t(v[i] != "val2");
+ }
+ #end
- var omap = new ObjectMap<{}, String>();
- omap.set(imap, "val1");
- omap.set(smap, "val2");
- omap.set(omap, "val3");
- omap.set(omap, "changed_val3");
- omap.set(smap, "changed_val2");
+ var omap = new ObjectMap<{}, String>();
+ omap.set(imap, "val1");
+ omap.set(smap, "val2");
+ omap.set(omap, "val3");
+ omap.set(omap, "changed_val3");
+ omap.set(smap, "changed_val2");
- var v:Vector = cast @:privateAccess omap.vals;
- for (i in 0...v.length) {
- t(v[i] != "val2");
- }
-#if java
- var wmap = new WeakMap<{}, String>();
- wmap.set(imap, "val1");
- wmap.set(smap, "val2");
- wmap.set(omap, "val3");
- wmap.set(omap, "changed_val3");
- wmap.set(smap, "changed_val2");
+ var v:Vector = cast @:privateAccess omap.vals;
+ for (i in 0...v.length) {
+ t(v[i] != "val2");
+ }
+ #if java
+ var wmap = new WeakMap<{}, String>();
+ wmap.set(imap, "val1");
+ wmap.set(smap, "val2");
+ wmap.set(omap, "val3");
+ wmap.set(omap, "changed_val3");
+ wmap.set(smap, "changed_val2");
- var v = @:privateAccess wmap.entries;
- for (i in 0...v.length) {
- t(v[i] == null || v[i].value != "val2");
- }
-#end
- }
-#end
+ var v = @:privateAccess wmap.entries;
+ for (i in 0...v.length) {
+ t(v[i] == null || v[i].value != "val2");
+ }
+ #end
+ }
+ #end
}
diff --git a/tests/unit/src/unit/issues/Issue8502.hx b/tests/unit/src/unit/issues/Issue8502.hx
index 495cde258db..140e1a31eb2 100644
--- a/tests/unit/src/unit/issues/Issue8502.hx
+++ b/tests/unit/src/unit/issues/Issue8502.hx
@@ -1,22 +1,23 @@
package unit.issues;
class Issue8502 extends Test {
-#if cpp
- public function test() {
+ #if cpp
+ public function test() {
var t:scripthost.Issue8502 = Type.createInstance(Type.resolveClass('unit.issues.Issue8502_2'), []);
- eq(t.doTest1(25), 'cppia 25');
- eq(t.doTest2(25), 'cppia 25');
- eq(t.doTest3(25), 'cppia 25');
- eq(t.doTest4(25), 'cppia 25');
- eq(t.doTest5(25), 'cppia 25');
- eq(t.doTest3u(25), 'cppia 25');
- eq(t.doTest4u(25), 'cppia 25');
- eq(t.doTest5u(25), 'cppia 25');
- }
-#end
+ eq(t.doTest1(25), 'cppia 25');
+ eq(t.doTest2(25), 'cppia 25');
+ eq(t.doTest3(25), 'cppia 25');
+ eq(t.doTest4(25), 'cppia 25');
+ eq(t.doTest5(25), 'cppia 25');
+ eq(t.doTest3u(25), 'cppia 25');
+ eq(t.doTest4u(25), 'cppia 25');
+ eq(t.doTest5u(25), 'cppia 25');
+ }
+ #end
}
#if cpp
+@:keep
class Issue8502_2 extends scripthost.Issue8502 {
override public function doTest1(f:cpp.Float32):String {
return 'cppia ' + super.doTest1(f);
@@ -50,5 +51,4 @@ class Issue8502_2 extends scripthost.Issue8502 {
return 'cppia ' + super.doTest5u(f);
}
}
-
-#end
\ No newline at end of file
+#end